I've used TypeFamilies numerous times in code and library APIs to get more powerful and creative type-checking, and I seem to always use it in the same way that ends up feeling like abuse.
For instance here's an example I started to sketch up for a talk I'm giving; this is to be a type-checked RPN calculator, used e.g. like `eval () (1,(2,((+),())))`:
```
{-# LANGUAGE TypeFamilies , MultiParamTypeClasses , FlexibleInstances
, UndecidableInstances
#-}
type family EvaledStack x stack
type instance EvaledStack Int st = (Int,st)
type instance EvaledStack (Int -> x) (Int,st) = EvaledStack x st
type family FinalStack string initialStack
type instance FinalStack () st = st
type instance FinalStack (x,xs) st = FinalStack xs (EvaledStack x st)
class EvalStep x stack where
evalStep :: x -> stack -> EvaledStack x stack
instance (EvalStep x st)=> EvalStep (Int -> x) (Int,st) where
evalStep f (int,st) = evalStep (f int) st
instance EvalStep Int st where
evalStep int st = (int,st)
class Eval string initialStack where
eval :: initialStack -> string -> FinalStack string initialStack
instance Eval () st where
eval st () = st
instance (EvalStep x st, Eval xs (EvaledStack x st))=> Eval (x,xs) st where
eval st (x, xs) = eval (evalStep x st) xs
```
The code above is just a WIP, but notice several things:
1) It's intended to be "closed" but I can't express that
2) I need to use UndecidableInstances for the nested type family instances, even though the recursion I'm doing is simple
3) The classes are "ugly" with arbitrary instance heads
4) If I want to support polymorphic operators/operands I need to use OverlappingInstances, which is another layer of hack
5) Users get an unhelpful error from the type-checker if their RPN expression is ill-typed
I think what I'm trying to do is fundamentally pretty simple, but I only have the tools to do it in the very ad-hoc way I've described.
I think the new closed type families help me here, but I'm wondering:
- have there been any proposals or discussions about this use case, or a name given to it?
- do closed type families provide an elegant solution and I just don't realize it yet?
- do other people find themselves using this pattern as well, or have I just gotten caught up in a strange way of abusing these extensions?
Thanks a lot,
Brandon