public
Created

MonadTrans with explicit dictionaries

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ConstraintKinds, GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
 
import GHC.Exts
 
-- see http://www.reddit.com/r/haskell/comments/117r1p/whats_wrong_with_ghc_haskells_current_constraint/
 
data Dict :: Constraint -> * where
Dict :: c => Dict c
 
class MonadTrans (t :: (* -> *) -> (* -> *)) where
lift :: Monad m => m r -> t m r
isMonadTrans :: Dict (Monad m) -> Dict (Monad (t m))
 
-- MonadTrans for composition
 
data Compose (t1 :: (* -> *) -> (* -> *)) (t2 :: (* -> *) -> (* -> *)) m r = C { unC :: t1 (t2 m) r }
 
instance Monad (t1 (t2 m)) => Monad (Compose t1 t2 m) where
return = C . return
x >>= y = C ((unC x) >>= (unC . y))
 
instance (MonadTrans t1, MonadTrans t2) => MonadTrans (Compose t1 t2) where
lift = C . liftD (isMonadTrans Dict) . liftD Dict
where
liftD :: MonadTrans t => Dict (Monad m) -> m a -> t m a
liftD Dict = lift
isMonadTrans = aux . isMonadTrans . isMonadTrans
where
aux :: Dict (Monad (t1 (t2 m))) -> Dict (Monad (Compose t1 t2 m))
aux Dict = Dict
 
-- just as an example
 
data ReaderT e m r = R { unR :: e -> m r }
 
instance Monad m => Monad (ReaderT e m) where
return = R . const . return
x >>= y = R (\ e -> (unR x e) >>= (($e) . unR . y))
 
instance MonadTrans (ReaderT e) where
lift = R . const
isMonadTrans Dict = Dict

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.