module MonadLib.Derive (
Iso(Iso), derive_fmap, derive_return, derive_bind, derive_fail, derive_mfix,
derive_ask, derive_put, derive_get, derive_set, derive_raise, derive_callCC,
derive_abort,
derive_local, derive_collect, derive_try,
derive_mzero, derive_mplus,
derive_lift, derive_inBase,
) where
import MonadLib
import Control.Monad
import Control.Monad.Fix
import Prelude hiding (Ordering(..))
data Iso m n = Iso { close :: forall a. m a -> n a,
open :: forall a. n a -> m a }
derive_fmap :: (Functor m) => Iso m n -> (a -> b) -> n a -> n b
derive_fmap iso f m = close iso (fmap f (open iso m))
derive_return :: (Monad m) => Iso m n -> (a -> n a)
derive_return iso a = close iso (return a)
derive_bind :: (Monad m) => Iso m n -> n a -> (a -> n b) -> n b
derive_bind iso m k = close iso ((open iso m) >>= \x -> open iso (k x))
derive_fail :: (Monad m) => Iso m n -> String -> n a
derive_fail iso a = close iso (fail a)
derive_mfix :: (MonadFix m) => Iso m n -> (a -> n a) -> n a
derive_mfix iso f = close iso (mfix (open iso . f))
derive_ask :: (ReaderM m i) => Iso m n -> n i
derive_ask iso = close iso ask
derive_put :: (WriterM m i) => Iso m n -> i -> n ()
derive_put iso x = close iso (put x)
derive_get :: (StateM m i) => Iso m n -> n i
derive_get iso = close iso get
derive_set :: (StateM m i) => Iso m n -> i -> n ()
derive_set iso x = close iso (set x)
derive_raise :: (ExceptionM m i) => Iso m n -> i -> n a
derive_raise iso x = close iso (raise x)
derive_callCC :: (ContM m) => Iso m n -> ((a -> n b) -> n a) -> n a
derive_callCC iso f = close iso (callCC (open iso . f . (close iso .)))
derive_abort :: (AbortM m i) => Iso m n -> i -> n a
derive_abort iso i = close iso (abort i)
derive_local :: (RunReaderM m i) => Iso m n -> i -> n a -> n a
derive_local iso i = close iso . local i . open iso
derive_collect :: (RunWriterM m i) => Iso m n -> n a -> n (a,i)
derive_collect iso = close iso . collect . open iso
derive_try :: (RunExceptionM m i) => Iso m n -> n a -> n (Either i a)
derive_try iso = close iso . try . open iso
derive_mzero :: (MonadPlus m) => Iso m n -> n a
derive_mzero iso = close iso mzero
derive_mplus :: (MonadPlus m) => Iso m n -> n a -> n a -> n a
derive_mplus iso n1 n2 = close iso (mplus (open iso n1) (open iso n2))
derive_lift :: (MonadT t, Monad m) => Iso (t m) n -> m a -> n a
derive_lift iso m = close iso (lift m)
derive_inBase :: (BaseM m x) => Iso m n -> x a -> n a
derive_inBase iso m = close iso (inBase m)