monadLib (empty) → 3.0.0
raw patch · 6 files changed
+615/−0 lines, 6 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- LICENSE +7/−0
- README +39/−0
- Setup.hs +3/−0
- monadLib.cabal +16/−0
- src/MonadLib.hs +458/−0
- src/Monads.hs +92/−0
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright (c) 2006 Iavor S. Diatchki++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README view
@@ -0,0 +1,39 @@+This is version 3 of 'monadLib'.+The library is in the directory 'src'.+In this directory we have bureaucratic overhead.++Files+~~~~~++LICENSE The license for the library.+README This file.+Setup.hs Used by the Cabal framework.+monadLib.cabal Used by the Cabal framework.++src/MonadLib.hs The library.+src/Monads.hs Definitions for some more base monads (optional).+++Simple Installation+~~~~~~~~~~~~~~~~~~~++To use 'monadLib' you should place the file 'MonadLib.hs'+(and perhaps also 'Monads.hs') in a place where your+implementation can find it.+++Cabal Installation+~~~~~~~~~~~~~~~~~~++The library supports the Cabal framework which has many options.+To see the available commands try:+> runhaskell Setup.hs --help++A typical installation might look something like this:+> runhaskell Setup.hs configure+> runhaskell Setup.hs build+> runhaskell Setup.hs haddock -- if you have haddock, else skip+> runhaskell Setup.hs install+++
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ monadLib.cabal view
@@ -0,0 +1,16 @@+Name: monadLib+Version: 3.0.0+License: BSD3+Author: Iavor S. Diatchki+Maintainer: diatchki@csee.ogi.edu+Homepage: http://www.csee.ogi.edu/~diacthki/monadLib+Category: Monads+Synopsis: A collection of monad transformers.+hs-source-dirs: src+Build-Depends: base+Extra-source-files: LICENSE README+Exposed-modules: MonadLib Monads+Extensions: + MultiParamTypeClasses, FunctionalDependencies, PolymorphicComponents +GHC-options: -O2 -W -fallow-undecidable-instances+
+ src/MonadLib.hs view
@@ -0,0 +1,458 @@+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}+{-| This library provides a collection of monad transformers that+ can be combined to produce various monads.+-}+module MonadLib (+ -- * Types+ -- $Types+ Id, ReaderT, WriterT, StateT, ExceptionT, ContT,++ -- * Lifting + -- $Lifting+ MonadT(..), BaseM(..),++ -- * Effect Classes+ -- $Effects+ ReaderM(..), WriterM(..), StateM(..), ExceptionM(..), ContM(..),+ Label, labelCC, jump,++ -- * Execution+ + -- ** Eliminating Effects+ -- $Execution+ runId, runReaderT, runWriterT, runStateT, runExceptionT, runContT, ++ -- ** Nested Execution+ -- $Nested_Exec+ RunReaderM(..), RunWriterM(..), RunStateM(..), RunExceptionM(..),++ -- * Miscellaneous+ version,+ module Control.Monad+) where++import Control.Monad+import Control.Monad.Fix+import Data.Monoid++-- | The current version of the library.+version :: (Int,Int,Int)+version = (3,0,0)+++-- $Types+-- +-- The following types define the representations of the+-- computation types supported by the library.+-- Each type adds support for a different effect.++-- | Computations with no effects.+newtype Id a = I a ++-- | Add support for propagating a context.+newtype ReaderT i m a = R (i -> m a) ++-- | Add support for collecting values.+newtype WriterT i m a = W (m (a,i)) ++-- | Add support for threading state.+newtype StateT i m a = S (i -> m (a,i)) ++-- | Add support for exceptions.+newtype ExceptionT i m a = X (m (Either i a)) ++-- | Add support for jumps.+newtype ContT i m a = C ((a -> m i) -> m i) ++++-- $Execution+-- +-- The following functions eliminate the outermost effect+-- of a computation by translating a computation into an+-- equivalent computation in the underlying monad. +-- (The exception is 'Id' which is not a monad transformer +-- but an ordinary monad, and so, its run operation simply+-- eliminates the monad.)+++-- | Get the result of a pure computation.+runId :: Id a -> a+runId (I a) = a++-- | Execute a reader computation in the given context.+runReaderT :: i -> ReaderT i m a -> m a+runReaderT i (R m) = m i++-- | Execute a writer computation.+-- Returns the result and the collected output.+runWriterT :: WriterT i m a -> m (a,i)+runWriterT (W m) = m++-- | Execute a stateful computation in the given initial state.+-- The second component of the result is the final state.+runStateT :: i -> StateT i m a -> m (a,i)+runStateT i (S m) = m i++-- | Execute a computation with exceptions.+-- Successful results are tagged with 'Right', +-- exceptional results are tagged with 'Left'.+runExceptionT :: ExceptionT i m a -> m (Either i a)+runExceptionT (X m) = m++-- | Execute a computation with the given continuation.+runContT :: (a -> m i) -> ContT i m a -> m i+runContT i (C m) = m i++++-- $Lifting+-- +-- The following operations allow us to promote computations+-- in the underlying monad to computations that support an extra+-- effect. Computations defined in this way do not make use of+-- the new effect but can be combined with other operations that +-- utilize the effect.++class MonadT t where+ -- | Promote a computation from the underlying monad.+ lift :: (Monad m) => m a -> t m a++-- It is interesting to note that these use something the resembles+-- the non-transformer 'return's.++instance MonadT (ReaderT i) where lift m = R (\_ -> m)+instance MonadT (StateT i) where lift m = S (\s -> liftM (\a -> (a,s)) m)+instance (Monoid i) => + MonadT (WriterT i) where lift m = W (liftM (\a -> (a,mempty)) m)+instance MonadT (ExceptionT i) where lift m = X (liftM Right m)+instance MonadT (ContT i) where lift m = C (m >>=)+++class (Monad m, Monad n) => BaseM m n | m -> n where+ -- | Promote a computation from the base monad.+ inBase :: n a -> m a+ +instance BaseM IO IO where inBase = id+instance BaseM Maybe Maybe where inBase = id+instance BaseM [] [] where inBase = id+instance BaseM Id Id where inBase = id+ +instance (BaseM m n) => BaseM (ReaderT i m) n where inBase = lift . inBase+instance (BaseM m n) => BaseM (StateT i m) n where inBase = lift . inBase+instance (BaseM m n,Monoid i) => BaseM (WriterT i m) n where inBase = lift . inBase+instance (BaseM m n) => BaseM (ExceptionT i m) n where inBase = lift . inBase+instance (BaseM m n) => BaseM (ContT i m) n where inBase = lift . inBase+++instance Monad Id where+ return x = I x+ fail x = error x+ m >>= k = k (runId m)++-- For the monad transformers, the definition of 'return' +-- is completely determined by the 'lift' operations.++-- None of the transformers make essential use of the 'fail' method.+-- Instead they delegate its behavior to the underlying monad.++instance (Monad m) => Monad (ReaderT i m) where+ return x = lift (return x)+ fail x = lift (fail x)+ m >>= k = R $ \r -> runReaderT r m >>= \a -> + runReaderT r (k a)++instance (Monad m) => Monad (StateT i m) where+ return x = lift (return x)+ fail x = lift (fail x)+ m >>= k = S $ \s -> runStateT s m >>= \ ~(a,s') -> + runStateT s' (k a)++instance (Monad m,Monoid i) => Monad (WriterT i m) where+ return x = lift (return x)+ fail x = lift (fail x)+ m >>= k = W $ runWriterT m >>= \ ~(a,w1) -> + runWriterT (k a) >>= \ ~(b,w2) -> + return (b,mappend w1 w2)++instance (Monad m) => Monad (ExceptionT i m) where+ return x = lift (return x)+ fail x = lift (fail x)+ m >>= k = X $ runExceptionT m >>= \a -> + case a of+ Left x -> return (Left x)+ Right a -> runExceptionT (k a)++instance (Monad m) => Monad (ContT i m) where+ return x = lift (return x)+ fail x = lift (fail x)+ m >>= k = C $ \c -> runContT (\a -> runContT c (k a)) m++instance Functor Id where fmap = liftM+instance (Monad m) => Functor (ReaderT i m) where fmap = liftM+instance (Monad m) => Functor (StateT i m) where fmap = liftM+instance (Monad m,Monoid i) => Functor (WriterT i m) where fmap = liftM+instance (Monad m) => Functor (ExceptionT i m) where fmap = liftM+instance (Monad m) => Functor (ContT i m) where fmap = liftM+++-- $Monadic_Value_Recursion+-- +-- Recursion that does not duplicate side-effects.+-- For details see Levent Erkok's dissertation.+-- +-- Monadic types built with 'ContT' do not support +-- monadic value recursion.++instance MonadFix Id where+ mfix f = let m = f (runId m) in m++instance (MonadFix m) => MonadFix (ReaderT i m) where+ mfix f = R $ \r -> mfix (runReaderT r . f)++instance (MonadFix m) => MonadFix (StateT i m) where+ mfix f = S $ \s -> mfix (runStateT s . f . fst)++instance (MonadFix m,Monoid i) => MonadFix (WriterT i m) where+ mfix f = W $ mfix (runWriterT . f . fst)++instance (MonadFix m) => MonadFix (ExceptionT i m) where+ mfix f = X $ mfix (runExceptionT . f . fromRight)+ where fromRight (Right a) = a+ fromRight _ = error "ExceptionT: mfix looped."++++instance (MonadPlus m) => MonadPlus (ReaderT i m) where+ mzero = lift mzero+ mplus (R m) (R n) = R (\r -> mplus (m r) (n r))+ +instance (MonadPlus m) => MonadPlus (StateT i m) where+ mzero = lift mzero+ mplus (S m) (S n) = S (\s -> mplus (m s) (n s))+ +instance (MonadPlus m,Monoid i) => MonadPlus (WriterT i m) where+ mzero = lift mzero+ mplus (W m) (W n) = W (mplus m n)++instance (MonadPlus m) => MonadPlus (ExceptionT i m) where+ mzero = lift mzero+ mplus (X m) (X n) = X (mplus m n)+++-- $Effects+-- +-- The following classes define overloaded operations+-- that can be used to define effectful computations.+++-- | Classifies monads that provide access to a context of type 'i'.+class (Monad m) => ReaderM m i | m -> i where+ -- | Get the context.+ ask :: m i++instance (Monad m) => ReaderM (ReaderT i m) i where+ ask = R return++instance (ReaderM m j,Monoid i) + => ReaderM (WriterT i m) j where ask = lift ask+instance (ReaderM m j) => ReaderM (StateT i m) j where ask = lift ask+instance (ReaderM m j) => ReaderM (ExceptionT i m) j where ask = lift ask+instance (ReaderM m j) => ReaderM (ContT i m) j where ask = lift ask+++-- | Classifies monads that can collect values of type 'i'.+class (Monad m) => WriterM m i | m -> i where+ -- | Add a value to the collection.+ put :: i -> m ()++instance (Monad m,Monoid i) => WriterM (WriterT i m) i where + put x = W (return ((),x))++instance (WriterM m j) => WriterM (ReaderT i m) j where put = lift . put+instance (WriterM m j) => WriterM (StateT i m) j where put = lift . put+instance (WriterM m j) => WriterM (ExceptionT i m) j where put = lift . put+instance (WriterM m j) => WriterM (ContT i m) j where put = lift . put+++-- | Classifies monads that propagate a state component of type 'i'.+class (Monad m) => StateM m i | m -> i where+ -- | Get the state. + get :: m i+ -- | Set the state.+ set :: i -> m ()++instance (Monad m) => StateM (StateT i m) i where+ get = S (\s -> return (s,s))+ set s = S (\_ -> return ((),s))++instance (StateM m j) => StateM (ReaderT i m) j where+ get = lift get+ set = lift . set +instance (StateM m j,Monoid i) => StateM (WriterT i m) j where+ get = lift get+ set = lift . set+instance (StateM m j) => StateM (ExceptionT i m) j where+ get = lift get+ set = lift . set+instance (StateM m j) => StateM (ContT i m) j where+ get = lift get+ set = lift . set+++-- | Classifies monads that support raising exceptions of type 'i'.+class (Monad m) => ExceptionM m i | m -> i where+ -- | Raise an exception. + raise :: i -> m a++instance (Monad m) => ExceptionM (ExceptionT i m) i where + raise x = X (return (Left x)) ++instance (ExceptionM m j) => ExceptionM (ReaderT i m) j where+ raise = lift . raise+instance (ExceptionM m j,Monoid i) => ExceptionM (WriterT i m) j where+ raise = lift . raise+instance (ExceptionM m j) => ExceptionM (StateT i m) j where+ raise = lift . raise+instance (ExceptionM m j) => ExceptionM (ContT i m) j where+ raise = lift . raise+++-- The following instances differ from the others because the+-- liftings are not as uniform (although they certainly follow a pattern).++-- | Classifies monads that provide access to a computation's continuation.+class Monad m => ContM m where+ -- | Capture the current continuation.+ callCC :: ((a -> m b) -> m a) -> m a++instance (ContM m) => ContM (ReaderT i m) where+ callCC f = R $ \r -> callCC $ \k -> runReaderT r $ f $ \a -> lift $ k a++instance (ContM m) => ContM (StateT i m) where+ callCC f = S $ \s -> callCC $ \k -> runStateT s $ f $ \a -> lift $ k (a,s)++instance (ContM m,Monoid i) => ContM (WriterT i m) where+ callCC f = W $ callCC $ \k -> runWriterT $ f $ \a -> lift $ k (a,mempty)+ +instance (ContM m) => ContM (ExceptionT i m) where+ callCC f = X $ callCC $ \k -> runExceptionT $ f $ \a -> lift $ k $ Right a+ +instance (Monad m) => ContM (ContT i m) where+ callCC f = C $ \k -> runContT k $ f $ \a -> C $ \_ -> k a+++-- $Nested_Exec+--+-- The following classes define operations that are overloaded+-- versions of the 'run' operations. Unlike the 'run' operations,+-- functions do not change the type of the computation (i.e, they+-- do not remove a layer). However, they do not perform any+-- side-effects in the corresponding layer. Instead, they execute+-- a computation in a ``separate thread'' with respect to the+-- corresponding effect. ++-- | Classifies monads that support changing the context for a+-- sub-computation.+class (ReaderM m i) => RunReaderM m i | m -> i where+ -- | Change the context for the duration of a computation.+ local :: i -> m a -> m a++instance (Monad m) => RunReaderM (ReaderT i m) i where+ local i m = lift (runReaderT i m)+instance (RunReaderM m j,Monoid i) => RunReaderM (WriterT i m) j where+ local i (W m) = W (local i m)+instance (RunReaderM m j) => RunReaderM (StateT i m) j where+ local i (S m) = S (local i . m)+instance (RunReaderM m j) => RunReaderM (ExceptionT i m) j where+ local i (X m) = X (local i m)++-- | Classifies monads that support collecting the output of +-- a sub-computation.+class WriterM m i => RunWriterM m i | m -> i where+ -- | Collect the output from a computation. + collect :: m a -> m (a,i)++instance (RunWriterM m j) => RunWriterM (ReaderT i m) j where+ collect (R m) = R (collect . m)++instance (Monad m,Monoid i) => RunWriterM (WriterT i m) i where+ collect (W m) = lift m++instance (RunWriterM m j) => RunWriterM (StateT i m) j where+ collect (S m) = S (liftM swap . collect . m)+ where swap (~(a,s),w) = ((a,w),s)++instance (RunWriterM m j) => RunWriterM (ExceptionT i m) j where+ collect (X m) = X (liftM swap (collect m))+ where swap (Right a,w) = Right (a,w)+ swap (Left x,_) = Left x + -- NOTE: If the local computation fails, then the output+ -- is discarded because the result type cannot accommodate it.+++-- | Classifies monads that support separate state threads.+class (StateM m i) => RunStateM m i | m -> i where+ -- | Modify the state for the duration of a computation.+ -- Returns the final state.+ runS :: i -> m a -> m (a,i) ++instance (RunStateM m j) => RunStateM (ReaderT i m) j where+ runS s (R m) = R (runS s . m)++instance (RunStateM m j,Monoid i) => RunStateM (WriterT i m) j where+ runS s (W m) = W (liftM swap (runS s m))+ where swap (~(a,s),w) = ((a,w),s)++instance (Monad m) => RunStateM (StateT i m) i where+ runS s m = lift (runStateT s m)++instance (RunStateM m j) => RunStateM (ExceptionT i m) j where+ runS s (X m) = X (liftM swap (runS s m))+ where swap (Left e,_) = Left e + swap (Right a,s) = Right (a,s)+ -- NOTE: If the local computation fails, then the modifications+ -- are discarded because the result type cannot accommodate it.++-- | Classifies monads that support handling of exceptions.+class ExceptionM m i => RunExceptionM m i | m -> i where+ -- | Exceptions are explicit in the result.+ try :: m a -> m (Either i a) ++instance (RunExceptionM m i) => RunExceptionM (ReaderT j m) i where+ try (R m) = R (try . m)++instance (RunExceptionM m i,Monoid j) => RunExceptionM (WriterT j m) i where+ try (W m) = W (liftM swap (try m))+ where swap (Right ~(a,w)) = (Right a,w) + swap (Left e) = (Left e, mempty)++instance (RunExceptionM m i) => RunExceptionM (StateT j m) i where+ try (S m) = S (\s -> liftM (swap s) (try (m s)))+ where swap _ (Right ~(a,s)) = (Right a,s) + swap s (Left e) = (Left e, s)++instance (Monad m) => RunExceptionM (ExceptionT i m) i where+ try m = lift (runExceptionT m)+++-- Some convenient functions for working with continuations.++-- | An explicit representation for continuations that store a value.+newtype Label m a = L ((a, Label m a) -> m ())++-- | Capture the current continuation. +-- This function is like 'return', except that it also captures+-- the current continuation. Later we can use 'jump' to go back to+-- the continuation with a possibly different value.+labelCC :: (ContM m) => a -> m (a, Label m a)+labelCC x = callCC (\k -> return (x, L k))++-- | Change the value passed to a previously captured continuation.+jump :: (ContM m) => a -> Label m a -> m b+jump x (L k) = k (x, L k) >> return unreachable+ where unreachable = error "(bug) jump: unreachable"++++
+ src/Monads.hs view
@@ -0,0 +1,92 @@+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}+{-| This module contains a collection of monads that + are defined in terms of the monad transformers from+ "MonadLib". The definitions in this module are+ completely mechanical and so this module may become+ obsolete if support for automated derivations for instances+ becomes well supported across implementations.+ -}+module Monads (+ Reader, Writer, State, Exception, Cont, + runReader, runWriter, runState, runException, runCont,+ module MonadLib+) where+import MonadLib+import Control.Monad+import Control.Monad.Fix+import Data.Monoid++newtype Reader i a = R' { unR :: ReaderT i Id a }+newtype Writer i a = W' { unW :: WriterT i Id a }+newtype State i a = S' { unS :: StateT i Id a }+newtype Exception i a = X' { unX :: ExceptionT i Id a }+newtype Cont i a = C' { unC :: ContT i Id a }++instance BaseM (Reader i) (Reader i) where inBase = id+instance (Monoid i) => BaseM (Writer i) (Writer i) where inBase = id+instance BaseM (State i) (State i) where inBase = id+instance BaseM (Exception i) (Exception i) where inBase = id+instance BaseM (Cont i) (Cont i) where inBase = id++instance Monad (Reader i) where+ return x = R' (return x)+ fail x = R' (fail x)+ m >>= f = R' (unR m >>= (unR . f))++instance (Monoid i) => Monad (Writer i) where+ return x = W' (return x)+ fail x = W' (fail x)+ m >>= f = W' (unW m >>= (unW . f))++instance Monad (State i) where+ return x = S' (return x)+ fail x = S' (fail x)+ m >>= f = S' (unS m >>= (unS . f))++instance Monad (Exception i) where+ return x = X' (return x)+ fail x = X' (fail x)+ m >>= f = X' (unX m >>= (unX . f))++instance Monad (Cont i) where+ return x = C' (return x)+ fail x = C' (fail x)+ m >>= f = C' (unC m >>= (unC . f))++instance Functor (Reader i) where fmap = liftM+instance (Monoid i) => Functor (Writer i) where fmap = liftM+instance Functor (State i) where fmap = liftM+instance Functor (Exception i) where fmap = liftM+instance Functor (Cont i) where fmap = liftM++instance MonadFix (Reader i) where mfix f = R' (mfix (unR . f))+instance (Monoid i) => MonadFix (Writer i) where mfix f = W' (mfix (unW . f))+instance MonadFix (State i) where mfix f = S' (mfix (unS . f))+instance MonadFix (Exception i) where mfix f = X' (mfix (unX . f))++instance ReaderM (Reader i) i where ask = R' ask+instance (Monoid i) => WriterM (Writer i) i where put = W' . put +instance StateM (State i) i where get = S' get; set = S' . set +instance ExceptionM (Exception i) i where raise = X' . raise +instance ContM (Cont i) where callCC f = C' (callCC (unC . f . (C' .)))++runReader :: i -> Reader i a -> a+runWriter :: Writer i a -> (a,i)+runState :: i -> State i a -> (a,i)+runException :: Exception i a -> Either i a+runCont :: (a -> i) -> Cont i a -> i++runReader i = runId . runReaderT i . unR +runWriter = runId . runWriterT . unW+runState i = runId . runStateT i . unS+runException = runId . runExceptionT . unX+runCont i = runId . runContT (return . i) . unC ++instance RunReaderM (Reader i) i where local i = R' . local i . unR+instance RunStateM (State i) i where runS i = S' . runS i . unS+instance (Monoid i) => RunWriterM (Writer i) i where+ collect = W' . collect . unW+instance RunExceptionM (Exception i) i where try = X' . try . unX+++