[Haskell-beginners] Question on data/type

Felipe Lessa felipe.lessa at gmail.com
Tue Nov 17 06:40:04 EST 2009


(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.


More information about the Beginners mailing list