1{-# LANGUAGE Rank2Types #-}
2{-# LANGUAGE Safe #-}
3
4{-| This module defines a number of functions that make it easy
5to get the functionality of MonadLib for user-defined newtypes.
6-}
7module MonadLib.Derive (
8  Iso(Iso),
9  derive_fmap,
10  derive_pure, derive_apply,
11  derive_empty, derive_or,
12  derive_return, derive_bind, derive_fail,
13  derive_mzero, derive_mplus,
14  derive_mfix,
15  derive_ask,
16  derive_local,
17  derive_put,
18  derive_collect,
19  derive_get,
20  derive_set,
21  derive_raise,
22  derive_try,
23  derive_callWithCC,
24  derive_abort,
25  derive_lift,
26  derive_inBase,
27  derive_runM,
28) where
29
30
31import MonadLib
32import Control.Applicative
33import Control.Monad.Fix
34import Prelude hiding (Ordering(..))
35import Control.Monad.Fail as MF
36
37-- | An isomorphism between (usually) monads.
38-- Typically the constructor and selector of a newtype delcaration.
39data Iso m n = Iso { close :: forall a. m a -> n a,
40                     open  :: forall a. n a -> m a }
41
42-- | Derive the implementation of 'fmap' from 'Functor'.
43derive_fmap :: (Functor m) => Iso m n -> (a -> b) -> n a -> n b
44derive_fmap iso f m = close iso (fmap f (open iso m))
45
46-- | Derive the implementation of 'pure' from 'Applicative'.
47derive_pure :: (Applicative m) => Iso m n -> a -> n a
48derive_pure iso a = close iso (pure a)
49
50-- | Derive the implementation of '<*>' from 'Applicative'.
51derive_apply :: (Applicative m) => Iso m n -> n (a -> b) -> (n a -> n b)
52derive_apply iso f x = close iso (open iso f <*> open iso x)
53
54-- | Derive the implementation of 'empty' from 'Alternative'.
55derive_empty :: (Alternative m) => Iso m n -> n a
56derive_empty iso = close iso empty
57
58-- | Derive the implementation of '<|>' from 'Alternative'.
59derive_or :: (Alternative m) => Iso m n -> n a -> n a -> n a
60derive_or iso a b = close iso (open iso a <|> open iso b)
61
62-- | Derive the implementation of 'return' from 'Monad'.
63derive_return :: (Monad m) => Iso m n -> (a -> n a)
64derive_return iso a = close iso (return a)
65
66-- | Derive the implementation of '>>=' from 'Monad'.
67derive_bind :: (Monad m) => Iso m n -> n a -> (a -> n b) -> n b
68derive_bind iso m k = close iso ((open iso m) >>= \x -> open iso (k x))
69
70derive_fail :: (MF.MonadFail m) => Iso m n -> String -> n a
71derive_fail iso a = close iso (MF.fail a)
72
73-- | Derive the implementation of 'mfix' from 'MonadFix'.
74derive_mfix :: (MonadFix m) => Iso m n -> (a -> n a) -> n a
75derive_mfix iso f = close iso (mfix (open iso . f))
76
77-- | Derive the implementation of 'ask' from 'ReaderM'.
78derive_ask :: (ReaderM m i) => Iso m n -> n i
79derive_ask iso = close iso ask
80
81-- | Derive the implementation of 'put' from 'WriterM'.
82derive_put :: (WriterM m i) => Iso m n -> i -> n ()
83derive_put iso x = close iso (put x)
84
85-- | Derive the implementation of 'get' from 'StateM'.
86derive_get :: (StateM m i) => Iso m n -> n i
87derive_get iso = close iso get
88
89-- | Derive the implementation of 'set' from 'StateM'.
90derive_set :: (StateM m i) => Iso m n -> i -> n ()
91derive_set iso x = close iso (set x)
92
93-- | Derive the implementation of 'raise' from 'ExceptionM'.
94derive_raise :: (ExceptionM m i) => Iso m n -> i -> n a
95derive_raise iso x = close iso (raise x)
96
97-- | Derive the implementation of 'callWithCC' from 'ContM'.
98derive_callWithCC :: (ContM m) => Iso m n -> ((a -> Label n) -> n a) -> n a
99derive_callWithCC iso f = close iso $ callWithCC $ open iso . f . relab
100  where relab k a = labelC (close iso $ jump $ k a)
101
102derive_abort :: (AbortM m i) => Iso m n -> i -> n a
103derive_abort iso i = close iso (abort i)
104
105-- | Derive the implementation of 'local' from 'RunReaderM'.
106derive_local :: (RunReaderM m i) => Iso m n -> i -> n a -> n a
107derive_local iso i = close iso . local i . open iso
108
109-- | Derive the implementation of 'collect' from 'RunWriterM'.
110derive_collect :: (RunWriterM m i) => Iso m n -> n a -> n (a,i)
111derive_collect iso = close iso . collect . open iso
112
113-- | Derive the implementation of 'try' from 'RunExceptionM'.
114derive_try :: (RunExceptionM m i) => Iso m n -> n a -> n (Either i a)
115derive_try iso = close iso . try . open iso
116
117-- | Derive the implementation of 'mzero' from 'MonadPlus'.
118derive_mzero :: (MonadPlus m) => Iso m n -> n a
119derive_mzero iso = close iso mzero
120
121-- | Derive the implementation of 'mplus' from 'MonadPlus'.
122derive_mplus :: (MonadPlus m) => Iso m n -> n a -> n a -> n a
123derive_mplus iso n1 n2 = close iso (mplus (open iso n1) (open iso n2))
124
125-- | Derive the implementation of 'lift' from 'MonadT'.
126derive_lift :: (MonadT t, Monad m) => Iso (t m) n -> m a -> n a
127derive_lift iso m = close iso (lift m)
128
129-- | Derive the implementation of 'inBase' from 'BaseM'.
130derive_inBase :: (BaseM m x) => Iso m n -> x a -> n a
131derive_inBase iso m = close iso (inBase m)
132
133-- | Derive the implementation of the 'runM' function from 'RunM'.
134derive_runM :: (RunM m a r) => Iso m n -> n a -> r
135derive_runM iso m = runM (open iso m)
136