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