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