[Haskell-cafe] The Related monad and constant values in type
classes
Edward Kmett
ekmett at gmail.com
Thu Feb 18 09:02:11 EST 2010
I've needed something similar in the past.
I used it in the reflection library, and its present on its own on hackage
as 'tagged'.
http://hackage.haskell.org/packages/archive/tagged/0.0/doc/html/Data-Tagged.html
I talked a bit about using it here:
http://comonad.com/reader/2009/clearer-reflection/
-Edward Kmett
2010/2/17 Jonas Almström Duregård <jonas.duregard at gmail.com>
> 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
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100218/6e042c11/attachment.html
More information about the Haskell-Cafe
mailing list