{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} {-| This module contains a collection of monads that are defined in terms of the monad transformers from "MonadLib". The definitions in this module are completely mechanical and so this module may become obsolete if support for automated derivations for instances becomes well supported across implementations. -} module Monads ( Reader, Writer, State, Exception, Cont, runReader, runWriter, runState, runException, runCont, module MonadLib ) where import MonadLib import Control.Monad import Control.Monad.Fix import Data.Monoid newtype Reader i a = R' { unR :: ReaderT i Id a } newtype Writer i a = W' { unW :: WriterT i Id a } newtype State i a = S' { unS :: StateT i Id a } newtype Exception i a = X' { unX :: ExceptionT i Id a } newtype Cont i a = C' { unC :: ContT i Id a } instance BaseM (Reader i) (Reader i) where inBase = id instance (Monoid i) => BaseM (Writer i) (Writer i) where inBase = id instance BaseM (State i) (State i) where inBase = id instance BaseM (Exception i) (Exception i) where inBase = id instance BaseM (Cont i) (Cont i) where inBase = id instance Monad (Reader i) where return x = R' (return x) fail x = R' (fail x) m >>= f = R' (unR m >>= (unR . f)) instance (Monoid i) => Monad (Writer i) where return x = W' (return x) fail x = W' (fail x) m >>= f = W' (unW m >>= (unW . f)) instance Monad (State i) where return x = S' (return x) fail x = S' (fail x) m >>= f = S' (unS m >>= (unS . f)) instance Monad (Exception i) where return x = X' (return x) fail x = X' (fail x) m >>= f = X' (unX m >>= (unX . f)) instance Monad (Cont i) where return x = C' (return x) fail x = C' (fail x) m >>= f = C' (unC m >>= (unC . f)) instance Functor (Reader i) where fmap = liftM instance (Monoid i) => Functor (Writer i) where fmap = liftM instance Functor (State i) where fmap = liftM instance Functor (Exception i) where fmap = liftM instance Functor (Cont i) where fmap = liftM instance MonadFix (Reader i) where mfix f = R' (mfix (unR . f)) instance (Monoid i) => MonadFix (Writer i) where mfix f = W' (mfix (unW . f)) instance MonadFix (State i) where mfix f = S' (mfix (unS . f)) instance MonadFix (Exception i) where mfix f = X' (mfix (unX . f)) instance ReaderM (Reader i) i where ask = R' ask instance (Monoid i) => WriterM (Writer i) i where put = W' . put instance StateM (State i) i where get = S' get; set = S' . set instance ExceptionM (Exception i) i where raise = X' . raise instance ContM (Cont i) where callCC f = C' (callCC (unC . f . (C' .))) runReader :: i -> Reader i a -> a runWriter :: Writer i a -> (a,i) runState :: i -> State i a -> (a,i) runException :: Exception i a -> Either i a runCont :: (a -> i) -> Cont i a -> i runReader i = runId . runReaderT i . unR runWriter = runId . runWriterT . unW runState i = runId . runStateT i . unS runException = runId . runExceptionT . unX runCont i = runId . runContT (return . i) . unC instance RunReaderM (Reader i) i where local i = R' . local i . unR instance RunStateM (State i) i where runS i = S' . runS i . unS instance (Monoid i) => RunWriterM (Writer i) i where collect = W' . collect . unW instance RunExceptionM (Exception i) i where try = X' . try . unX