[Haskell-cafe] Monad transformers, design
Tony Morris
tonymorris at gmail.com
Sat Jul 31 08:56:31 EDT 2010
Hello I have a question regarding monad transformers and how to design
an API with a transformer. I have a narrowed code example of the
question. Please see the questions in the comments below.
import Data.Monoid
import Control.Monad
-- Suppose some data type
newtype Inter a = Inter (Int -> a)
-- and a monad transformer for that data type.
newtype InterT m a = InterT (m (Inter a))
-- It's easy to implement this type-class
instance (Monoid a) => Monoid (Inter a) where
mempty = Inter (const mempty)
Inter a `mappend` Inter b = Inter (a `mappend` b)
-- and for the transformer too by lifting into the monad
instance (Monad m, Monoid a) => Monoid (InterT m a) where
mempty = InterT (return mempty)
InterT a `mappend` InterT b = InterT (liftM2 mappend a b)
-- But what about this type-class?
class Ints a where
ints :: a -> Int -> Int
-- Seems easy enough
instance (Integral a) => Ints (Inter a) where
ints (Inter a) n = fromIntegral (a n)
-- OH NO!
{-
instance (Monad m, Integral a) => Ints (InterT m a) where
ints (InterT a) n = error "OH NO!"
-}
-- We could try this
class Copointed f where
copoint :: f a -> a
-- but it seems rather impractical
instance (Copointed m, Integral a) => Ints (InterT m a) where
ints (InterT a) = ints (copoint a)
{-
So it seems that for some type-classes it is possible to implement
for both the data type and the transformer, but not all type-classes.
Is there a general approach to this problem?
-}
--
Tony Morris
http://tmorris.net/
More information about the Haskell-Cafe
mailing list