1{-# LANGUAGE Safe #-} 2{-# LANGUAGE CPP #-} 3{-# LANGUAGE FlexibleInstances #-} 4{-# LANGUAGE MultiParamTypeClasses #-} 5{-| This module contains a collection of monads that 6 are defined in terms of the monad transformers from 7 "MonadLib". The definitions in this module are 8 completely mechanical and so this module may become 9 obsolete if support for automated derivations for instances 10 becomes well supported across implementations. 11 -} 12module MonadLib.Monads ( 13 Reader, Writer, State, Exception, Cont, 14 runReader, runWriter, runState, runException, runCont, 15 module MonadLib 16) where 17import MonadLib 18import MonadLib.Derive 19import Control.Monad.Fix 20 21newtype Reader i a = R' { unR :: ReaderT i Id a } 22newtype Writer i a = W' { unW :: WriterT i Id a } 23newtype State i a = S' { unS :: StateT i Id a } 24newtype Exception i a = X' { unX :: ExceptionT i Id a } 25newtype Cont i a = C' { unC :: ContT i Id a } 26 27iso_R :: Iso (ReaderT i Id) (Reader i) 28iso_W :: Iso (WriterT i Id) (Writer i) 29iso_S :: Iso (StateT i Id) (State i) 30iso_X :: Iso (ExceptionT i Id) (Exception i) 31iso_C :: Iso (ContT i Id) (Cont i) 32 33iso_R = Iso R' unR 34iso_W = Iso W' unW 35iso_S = Iso S' unS 36iso_X = Iso X' unX 37iso_C = Iso C' unC 38 39instance BaseM (Reader i) (Reader i) where inBase = id 40instance (Monoid i) => BaseM (Writer i) (Writer i) where inBase = id 41instance BaseM (State i) (State i) where inBase = id 42instance BaseM (Exception i) (Exception i) where inBase = id 43instance BaseM (Cont i) (Cont i) where inBase = id 44 45instance Monad (Reader i) where 46 (>>=) = derive_bind iso_R 47 48#if !MIN_VERSION_base(4,11,0) 49 fail = error 50#endif 51 52instance (Monoid i) => Monad (Writer i) where 53 (>>=) = derive_bind iso_W 54 55#if !MIN_VERSION_base(4,11,0) 56 fail = error 57#endif 58 59instance Monad (State i) where 60 (>>=) = derive_bind iso_S 61 62#if !MIN_VERSION_base(4,11,0) 63 fail = error 64#endif 65 66 67instance Monad (Exception i) where 68 (>>=) = derive_bind iso_X 69 70#if !MIN_VERSION_base(4,11,0) 71 fail = error 72#endif 73 74instance Monad (Cont i) where 75 (>>=) = derive_bind iso_C 76 77#if !MIN_VERSION_base(4,11,0) 78 fail = error 79#endif 80 81instance Functor (Reader i) where fmap = derive_fmap iso_R 82instance (Monoid i) => Functor (Writer i) where fmap = derive_fmap iso_W 83instance Functor (State i) where fmap = derive_fmap iso_S 84instance Functor (Exception i) where fmap = derive_fmap iso_X 85instance Functor (Cont i) where fmap = derive_fmap iso_C 86 87instance Applicative (Reader i) where 88 pure = derive_return iso_R 89 (<*>) = ap 90 91instance (Monoid i) => Applicative (Writer i) where 92 pure = derive_return iso_W 93 (<*>) = ap 94 95instance Applicative (State i) where 96 pure = derive_return iso_S 97 (<*>) = ap 98 99instance Applicative (Exception i) where 100 pure = derive_return iso_X 101 (<*>) = ap 102 103instance Applicative (Cont i) where 104 pure = derive_return iso_C 105 (<*>) = ap 106 107instance MonadFix (Reader i) where mfix = derive_mfix iso_R 108instance (Monoid i) => MonadFix (Writer i) where mfix = derive_mfix iso_W 109instance MonadFix (State i) where mfix = derive_mfix iso_S 110instance MonadFix (Exception i) where mfix = derive_mfix iso_X 111 112instance ReaderM (Reader i) i where ask = derive_ask iso_R 113instance (Monoid i) => WriterM (Writer i) i where put = derive_put iso_W 114instance StateM (State i) i where get = derive_get iso_S; set = derive_set iso_S 115instance ExceptionM (Exception i) i where raise = derive_raise iso_X 116instance ContM (Cont i) where callWithCC = derive_callWithCC iso_C 117 118runReader :: i -> Reader i a -> a 119runWriter :: Writer i a -> (a,i) 120runState :: i -> State i a -> (a,i) 121runException :: Exception i a -> Either i a 122runCont :: (a -> i) -> Cont i a -> i 123 124runReader i = runId . runReaderT i . unR 125runWriter = runId . runWriterT . unW 126runState i = runId . runStateT i . unS 127runException = runId . runExceptionT . unX 128runCont i = runId . runContT (return . i) . unC 129 130instance RunReaderM (Reader i) i where 131 local = derive_local iso_R 132 133instance (Monoid i) => RunWriterM (Writer i) i where 134 collect = derive_collect iso_W 135 136instance RunExceptionM (Exception i) i where 137 try = derive_try iso_X 138 139 140 141