[Haskell-cafe] The Related monad and constant values in type classes
Jonas Almström Duregård
jonas.duregard at gmail.com
Wed Feb 17 10:48:45 EST 2010
Hi,
This literate haskell file was intended to be a quick question about a
problem i have been pondering, but it developed into a short
presentation instead. What i want to know is if there is already
something like this (and suggestions for improvement of course).
>{-#LANGUAGE GeneralizedNewtypeDeriving#-}
Sometimes i find myself needing to associate a constant with a type
or, more precisely, with a type class instance. Something like this
would be nice:
class Sized a where
size :: Int
instance Sized Int where
size = 32
Of course this will not work since there is no way of knowing which
instance i refer to when i use "size". A common work-around is to use
a dummy parameter:
>class SizedDummy a where
> sizeDummy :: a -> Int
>
>instance SizedDummy Int where
> sizeDummy = const 32
The size function is typically passed an undefined value. This is not
very pretty, and somewhat unsafe. Another workaround is to define a
newtype with a type parameter.
>newtype SizeOf a = MkSize {toInt :: Int}
>class SizedNewType a where
> sizeNewType :: SizeOf a
>
>instance SizedNewType Int where
> sizeNewType = MkSize 32
If we want the size of a pair to be the sum of it's components,
something like this is needed:
>instance (SizedNewType a, SizedNewType b) => SizedNewType (a,b) where
> sizeNewType = sizeNewType' sizeNewType sizeNewType where
> sizeNewType' :: SizeOf a -> SizeOf b -> SizeOf (a,b)
> sizeNewType' a b = MkSize $ toInt a + toInt b
This is way to much code say that "size = size a + size b". A more
general solution can be achieved by making "Int" another type variable
of "SizeOf". I call the resulting type "Related":
>newtype Related a b = Related {unrelated :: b} deriving
> (Eq,Ord,Show,Read,Bounded,Enum,Fractional,Num,
> Real,Integral,RealFrac,Floating,RealFloat)
This type is highly reusable and the GeneralizedNewtypeDeriving
language extension is very practical (although the instances could be
written manually). It can also be used as an Identity monad:
>instance Functor (Related a) where
> fmap f (Related a) = Related $ f a
>
>instance Monad (Related a) where
> return = Related
> (Related a) >>= f = f a
This allows the Sized class and instances to be specified in a slim
fashion using a familiar monadic interface:
>class Sized a where
> size :: Related a Int
>
>instance Sized Int where
> size = return 32
>
>instance (Sized a, Sized b) => Sized (a,b) where
> size = do
> a <- return size :: Sized a => Related (a,b) (Related a Int)
> b <- return size :: Sized b => Related (a,b) (Related b Int)
> return $ unrelated a + unrelated b
This still requires a lot of type signatures, some additional magic is
required. It is possible to write general versions of the type
signatures above, which allows the following instance definition for
(,,):
>instance (Sized a, Sized b, Sized c) => Sized (a,b,c) where
> size = do
> a <- on3 size
> b <- on2 size
> c <- on1 size
> return $ a + b + c
With the derivation of Num, this can be done even more compact:
>instance (Sized a, Sized b, Sized c, Sized d) => Sized (a,b,c,d) where
> size = on1 size + on2 size + on3 size + on4 size
The code for the onN functions:
>rerelate :: Related a b -> Related c b
>rerelate = return . unrelated
>on1 :: Related a v -> Related (x a) v
>on1 = rerelate
>on2 :: Related a v -> Related (x a x0) v
>on2 = rerelate
>on3 :: Related a v -> Related (x a x0 x1) v
>on3 = rerelate
>on4 :: Related a v -> Related (x a x0 x1 x2) v
>on4 = rerelate
Regards,
Jonas Almström Duregård
More information about the Haskell-Cafe
mailing list