Skip to content

Instantly share code, notes, and snippets.

@twanvl
Created October 11, 2012 15:28
Show Gist options
  • Save twanvl/3873221 to your computer and use it in GitHub Desktop.
Save twanvl/3873221 to your computer and use it in GitHub Desktop.
MonadTrans with explicit dictionaries
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment