(This e-mail is literate Haskell) Not that this is the right solution to your problems, but...
{-# LANGUAGE GADTs, EmptyDataDecls, FlexibleInstances, FlexibleContexts #-}
import Control.Applicative
This requires EmptyDataDecls:
data TypeConA data TypeConB data TypeConC
We're gonna use those empty data types as phantom types in our data type below. This requires GADTs:
data TypeCon t a where ValConA :: a -> TypeCon TypeConA a ValConB :: [TypeCon TypeConA a] -> TypeCon TypeConB a ValConC :: [TypeCon TypeConB a] -> TypeCon TypeConC a
Using the phantom types we tell the type system what kind of value we want. Now, some useful instances because we can't derive them:
instance Show a => Show (TypeCon t a) where showsPrec n x = showParen (n > 10) $ case x of ValConA a -> showString "ValConA " . showsPrec 11 a ValConB a -> showString "ValConB " . showsPrec 11 a ValConC a -> showString "ValConC " . showsPrec 11 a
instance Eq a => Eq (TypeCon t a) where (ValConA a) == (ValConA b) = (a == b) (ValConB a) == (ValConB b) = (a == b) (ValConC a) == (ValConC b) = (a == b) _ == _ = error "never here"
The 't' phantom type guarantees that we'll never reach that last definition, e.g. *Main> (ValConA True) == (ValConB []) <interactive>:1:19: Couldn't match expected type `TypeConA' against inferred type `TypeConB' Expected type: TypeCon TypeConA Bool Inferred type: TypeCon TypeConB a In the second argument of `(==)', namely `(ValConB [])' In the expression: (ValConA True) == (ValConB [])
instance Functor (TypeCon t) where fmap f (ValConA a) = ValConA (f a) fmap f (ValConB a) = ValConB (fmap (fmap f) a) fmap f (ValConC a) = ValConC (fmap (fmap f) a)
Now, if you want applicative then you'll need FlexibleInstances because we can't write 'pure :: a -> TypeCon t a'; this signature means that the user of the function may choose any 't' he wants, but we can give him only one of the 't's that appear in the constructors above.
instance Applicative (TypeCon TypeConA) where pure x = ValConA x (ValConA f) <*> (ValConA x) = ValConA (f x) _ <*> _ = error "never here"
instance Applicative (TypeCon TypeConB) where pure x = ValConB [pure x] (ValConB fs) <*> (ValConB xs) = ValConB (fmap (<*>) fs <*> xs) _ <*> _ = error "never here"
instance Applicative (TypeCon TypeConC) where pure x = ValConC [pure x] (ValConC fs) <*> (ValConC xs) = ValConC (fmap (<*>) fs <*> xs) _ <*> _ = error "never here"
Now that we have applicative we can also write, using FlexibleContexts,
liftBinOp :: Applicative (TypeCon t) => (a->b->c) -> TypeCon t a -> TypeCon t b -> TypeCon t c liftBinOp = liftA2
We need that 'Applicative' constraint because the type system doesn't know that we have already defined all possible 'Applicative' instances, so we have to live with that :). And then we can simply write
instance (Applicative (TypeCon t), Num a) => Num (TypeCon t a) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*) negate = fmap negate abs = fmap abs signum = fmap signum fromInteger = pure . fromInteger
Finally, *Main> let x1 = ValConB [ValConA 10, ValConA 7] *Main> let x2 = ValConB [ValConA 5, ValConA 13] *Main> x1 * x2 ValConB [ValConA 50,ValConA 130,ValConA 35,ValConA 91] HTH, -- Felipe.