packages feed

monad-state (empty) → 0.1.1.2

raw patch · 10 files changed

+486/−0 lines, 10 filesdep +AbortT-transformersdep +basedep +fclabelssetup-changed

Dependencies added: AbortT-transformers, base, fclabels, monads-tf, transformers

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2010, Byron James Johnson+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+   used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monad-state.cabal view
@@ -0,0 +1,25 @@+name:                  monad-state+version:               0.1.1.2+cabal-version:         >= 1.10+build-type:            Simple+license:               BSD3+license-file:          LICENSE+copyright:             Copyright (C) 2010 Byron James Johnson+author:                Byron James Johnson+maintainer:            KrabbyKrap@gmail.com+synopsis:              Utility library for monads, particularly those involving state+description:           Utility library for monads, particularly those involving state+category:              Control, Data, Monads+tested-with:           GHC == 7.0.2++library+    default-language:  Haskell2010+    hs-source-dirs:    src+    build-depends:     base >= 4 && < 5, fclabels, transformers, monads-tf, AbortT-transformers+    exposed-modules:   Control.Monad.Abort, Control.Monad.Abort.Class, Control.Monad.Abort.Instances, Control.Monad.Record, Control.Monad.Runnable, Control.Monad.Short, System.Timeout.Monad+    ghc-options:       -Wall+    other-extensions:  TypeFamilies, MultiParamTypeClasses, TypeOperators, PostfixOperators, FlexibleInstances, FlexibleContexts, TypeSynonymInstances++source-repository head+    type:              darcs+    location:          http://patch-tag.com/r/bob/monad-state
+ src/Control/Monad/Abort.hs view
@@ -0,0 +1,19 @@+module Control.Monad.Abort+    (+    -- * Monads that can immediately return a result+      MonadAbort(..)+    -- * The Abort monad+    , Abort+    , runAbort+    -- * The AbortT monad transformer+    , AbortT(..)+    , runAbortT+    -- * AbortT operations+    , mapAbortT+    ) where++import Control.Monad.Abort.Class+import Control.Monad.Abort.Instances (mapAbortT)+import Control.Monad.Trans.Abort (runAbort, runAbortT)++import Control.Monad.Instances ()
+ src/Control/Monad/Abort/Class.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TypeFamilies #-}++module Control.Monad.Abort.Class+    ( Abort+    , AbortT(..)+    , MonadAbort(..)+    ) where++import Control.Monad.Trans.Error (Error(..), ErrorT)+import Control.Monad.Trans.Abort as Abort hiding (abort)+import qualified Control.Monad.Trans.Abort as Abort+import Control.Monad.Trans.Identity as Identity+import Control.Monad.Trans.List as List+import Control.Monad.Trans.Maybe as Maybe+import Control.Monad.Trans.Reader as Reader+import Control.Monad.Trans.RWS.Lazy as LazyRWS+import Control.Monad.Trans.RWS.Strict as StrictRWS+import Control.Monad.Trans.State.Lazy as LazyState+import Control.Monad.Trans.State.Strict as StrictState+import Control.Monad.Trans.Writer.Lazy as LazyWriter+import Control.Monad.Trans.Writer.Strict as StrictWriter+import Control.Monad.Trans++import Control.Monad ()+import Control.Monad.Instances ()+import Data.Monoid++class (Monad m) => MonadAbort m where+    type AbortResultType m+    abort :: (AbortResultType m) -> m a++instance (Monad m) => MonadAbort (AbortT r m) where+    type AbortResultType (AbortT r m) = r+    abort = Abort.abort+instance (MonadAbort m) => MonadAbort (IdentityT m) where+    type AbortResultType (IdentityT m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m) => MonadAbort (ListT m) where+    type AbortResultType (ListT m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m) => MonadAbort (MaybeT m) where+    type AbortResultType (MaybeT m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m, Error e) => MonadAbort (ErrorT e m) where+    type AbortResultType (ErrorT e m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m) => MonadAbort (ReaderT r m) where+    type AbortResultType (ReaderT r m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m, Monoid w) => MonadAbort (LazyRWS.RWST r w s m) where+    type AbortResultType (LazyRWS.RWST r w s m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m, Monoid w) => MonadAbort (StrictRWS.RWST r w s m) where+    type AbortResultType (StrictRWS.RWST r w s m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m) => MonadAbort (LazyState.StateT s m) where+    type AbortResultType (LazyState.StateT s m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m) => MonadAbort (StrictState.StateT s m) where+    type AbortResultType (StrictState.StateT s m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m, Monoid w) => MonadAbort (LazyWriter.WriterT w m) where+    type AbortResultType (LazyWriter.WriterT w m) = AbortResultType m+    abort = lift . abort+instance (MonadAbort m, Monoid w) => MonadAbort (StrictWriter.WriterT w m) where+    type AbortResultType (StrictWriter.WriterT w m) = AbortResultType m+    abort = lift . abort
+ src/Control/Monad/Abort/Instances.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Control.Monad.Abort.Instances+    ( mapAbortT+    ) where++import Control.Monad.Trans.Abort++import Control.Monad.Cont+import Control.Monad.Error+import Control.Monad.RWS+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State++mapAbortT :: (m (Either r a) -> n (Either r' b)) -> AbortT r m a -> AbortT r' n b+mapAbortT f = AbortT . f . unwrapAbortT++instance (MonadCont m) => MonadCont (AbortT r m) where+    callCC f = AbortT $+        callCC $ \c ->+            unwrapAbortT . f $ \a -> AbortT $ c (Right a)++instance (MonadError m) => MonadError (AbortT r m) where+    type ErrorType (AbortT r m) = ErrorType m+    throwError = lift . throwError+    catchError m h = AbortT $ catchError (unwrapAbortT m) (unwrapAbortT . h)++instance (MonadRWS m) => MonadRWS (AbortT r m)++instance (MonadReader m) => MonadReader (AbortT r m) where+    type EnvType (AbortT r m) = EnvType m+    ask = lift ask+    local f = mapAbortT $ local f++instance (MonadState m) => MonadState (AbortT r m) where+    type StateType (AbortT r m) = StateType m+    get = lift get+    put = lift . put++instance (MonadWriter m) => MonadWriter (AbortT r m) where+    type WriterType (AbortT r m) = WriterType m+    tell   = lift . tell+    listen = mapAbortT $ \m -> do+        (a, w) <- listen m+        return $! fmap (\r -> (r, w)) a+    pass   = mapAbortT $ \m -> pass $ do+        a <- m+        return $! case a of+            --e@(Left _)      -> (e, id)+            (Left  l)      -> (Left  l,      id)+            (Right  (r, f)) -> (Right r, f)
+ src/Control/Monad/Record.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, TypeOperators, PostfixOperators, FlexibleInstances #-}++module Control.Monad.Record+    ( maybeAbort+    , maybeAbortM+    , MLens(..)+    , (:-->)(..)+    , getM+    , setM+    , modM+    , getMAbort+    , setMAbort+    , modMAbort+    , askM+    , liftState+    , liftSubState+    , liftSubMaybeState+    , (<:)+    , (=:)+    , ($:)+    , (<::)+    , (=::)+    , ($::)+    , (<<:)+    , (<=:)+    , (<$:)+    , (<<::)+    , (<->)+    , (<:<)+    , (>$<)+    , (>$>)+    , (>$$>)+    , module Data.Record.Label+    ) where++import Prelude hiding ((.), id)+import Control.Category+import Control.Monad.Abort+import Control.Monad.Reader+import Control.Monad.State.Strict+import Control.Monad.Trans.Maybe+import Data.Record.Label hiding (getM, setM, modM, (=:), askM, localM)++maybeAbort :: (Monad m) => r -> Maybe a -> AbortT r m a+maybeAbort _ (Just x)  = return x+maybeAbort r (Nothing) = abort r++maybeAbortM :: (MonadTrans t, Monad m, MonadAbort (t m)) => AbortResultType (t m) -> MaybeT m a -> t m a+maybeAbortM r m = do+    x <- lift . runMaybeT $ m+    case x of+        (Just a)  -> return a+        (Nothing) -> abort r++class MLens l a where+    type MLensA l a+    toLens :: l f a -> f :-> Maybe (MLensA l a)++instance MLens (:->) (Maybe a) where+    type MLensA (:->) (Maybe a) = a+    toLens = id++instance MLens (:-->) a where+    type MLensA (:-->) a = a+    toLens = unMaybeLens++newtype f :--> a = MaybeLens {unMaybeLens :: f :-> Maybe a}++instance Category (:-->) where+    id  = MaybeLens $ lens Just (\a f -> maybe f id a)+    MaybeLens a . MaybeLens b = MaybeLens $ lens getter setter+        where getter f = getL a =<< getL b f+              setter   = modL b . fmap . setL a++getM :: (MonadState m) => (StateType m :-> a) -> m a+getM = gets . getL++setM :: (MonadState m) => (StateType m :-> a) -> a -> m ()+setM l = modify . setL l++modM :: (MonadState m) => (StateType m :-> a) -> (a -> a) -> m ()+modM l = modify . modL l++getMAbort :: (MonadState m, MLens l b) => r -> l (StateType (AbortT r m)) b -> (MLensA l b :-> a) -> AbortT r m a+getMAbort r b l = liftM (getL l) $ maybeAbort r =<< gets (getL $ toLens b)++setMAbort :: (MonadState m, MLens l b) => l (StateType m) b -> (MLensA l b :-> a) -> a -> m ()+setMAbort b l x = modify . modL (toLens b) . fmap $ setL l x++modMAbort :: (MonadState m, MLens l b) => l (StateType m) b -> (MLensA l b :-> a) -> (a -> a) -> m ()+modMAbort b l f = modify . modL (toLens b) . fmap $ modL l f++askM :: (MonadReader m) => (EnvType m :-> a) -> m a+askM = asks . getL++liftState :: (MonadState m) => (StateType m :-> s) -> StateT s m a -> m a+liftState l n = do+    (a, s) <- runStateT n =<< (l <::)+    l =:: s+    return a++liftSubState :: (Monad m, MonadTrans t, MonadState (t m)) => (StateType (t m) :-> s) -> StateT s m a -> t m a+liftSubState l m = do+    s       <- getM l+    (a, s') <- lift . runStateT m $ s+    setM l s'+    return a++liftSubMaybeState :: (Monad m, MonadTrans t, MonadState (t m), MLens l a) => l (StateType (t m)) a -> StateT (MLensA l a) m a1 -> MaybeT (t m) a1+liftSubMaybeState l m = MaybeT $ do+    sw <- getM l'+    case sw of+        (Just s) -> do+            (a, s') <- lift . runStateT m $ s+            setM l' $ Just s'+            return $ Just a+        (Nothing) -> do+            return Nothing+    where l' =  toLens l++-- | 'getL'+infixr 8 <::+(<:) :: (f :-> a) -> f -> a+(<:) = getL+-- | 'setL'+infixr 5 =::+(=:) :: (f :-> a) -> a -> f -> f+(=:) = setL+-- | 'modL'+infixr 8 $::+($:) :: (f :-> a) -> (a -> a) -> f -> f+($:) = modL++-- | 'getM'+infixr 8 <:+(<::) :: (MonadState m) => (StateType m :-> a) -> m a+(<::) = getM+-- | 'setM'+infixr 5 =:+(=::) :: (MonadState m) => (StateType m :-> a) -> a -> m ()+(=::) = setM+-- | 'modM'+infixr 8 $:+($::) :: (MonadState m) => (StateType m :-> a) -> (a -> a) -> m ()+($::) = modM++-- | 'getMAbort'+infixr 8 <<:+(<<:) :: (MonadState m, MLens l b) => r -> l (StateType (AbortT r m)) b -> (MLensA l b :-> a) -> AbortT r m a+(<<:) = getMAbort+-- | 'setMAbort'+infixr 5 <=:+(<=:) :: (MonadState m, MLens l b) => l (StateType m) b -> (MLensA l b :-> a) -> a -> m ()+(<=:) = setMAbort+-- | 'modMAbort'+infixr 8 <$:+(<$:) :: (MonadState m, MLens l b) => l (StateType m) b -> (MLensA l b :-> a) -> (a -> a) -> m ()+(<$:) = modMAbort++-- | 'getMAbort' ()+infixr 8 <<::+(<<::) :: (MonadState m, MLens l b) => l (StateType (AbortT r m)) b -> (MLensA l b :-> a) -> AbortT () m a+(<<::) = getMAbort ()++infixr 5 <->+(<->) :: (MLens l a, MLens l' a') => l (MLensA l' a') a -> l' f a' -> (f :--> MLensA l a)+a <-> b = (MaybeLens . toLens $ a) . (MaybeLens . toLens $ b)++-- | 'askM'+infixr 5 <:<+(<:<) :: (MonadReader m) => (EnvType m :-> a) -> m a+(<:<) = askM++-- | 'liftState'+infixr 4 >$<+(>$<) :: (MonadState m) => (StateType m :-> s) -> StateT s m a -> m a+(>$<) = liftState++-- These functions have more restrictive types than the functions to which their functionality is equivalent, to resolve some errors caused by too general types++-- | 'liftSubState'+infixr 5 >$>+(>$>) :: (Monad m) => (s :-> s') -> StateT s' m a -> StateT s m a+(>$>) = liftSubState++-- | 'liftSubMaybeState'+infixr 4 >$$>+(>$$>) :: (Monad m, MLens l a) => l s a -> StateT (MLensA l a) m a1 -> MaybeT (StateT s m) a1+(>$$>) = liftSubMaybeState
+ src/Control/Monad/Runnable.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, TypeSynonymInstances #-}++module Control.Monad.Runnable+    ( MonadRunnable(..)+    , RunnableContainer(..)+    ) where++import Data.Functor.Identity++-- | Monads that can be run in the IO monad+class (Monad m, RunnableContainer (RunContainer m)) => MonadRunnable m where+    type RunData       m+    type ConstructType m :: * -> *+    type RunContainer  m :: * -> *+    run       :: m a -> RunData m -> (RunContainer m) ((ConstructType m) a)+    runData   :: m (RunData m)+    construct :: ((ConstructType m) a) -> m a++class RunnableContainer m where+    rcToIO :: m a -> IO a++instance RunnableContainer IO where+    rcToIO = id++instance RunnableContainer Identity where+    rcToIO = return . runIdentity
+ src/Control/Monad/Short.hs view
@@ -0,0 +1,31 @@+module Control.Monad.Short+    ( MonadShortable+    , MonadErrorShortable+    , short+    , unShort+    , MonadShort(..)+    ) where++import Control.Monad.Abort+import Control.Monad.Trans.Class++type MonadShortable r m a = AbortT r m a+type MonadErrorShortable m a = MonadShortable String m a++short :: (Monad m) => m a -> MonadShortable r m a+short = lift++unShort :: (Monad m) => MonadShortable r m r -> m r+unShort = runAbortT++-- | Minimal complete definition: unError+class (Monad m) => MonadShort m where+    unError       :: r -> MonadErrorShortable m a -> MonadShortable r m a++    unError_      :: MonadErrorShortable m a -> MonadShortable () m a+    unErrorShort  :: r -> MonadErrorShortable m r -> m r+    unErrorShort_ :: MonadErrorShortable m () -> m ()++    unError_        = unError ()+    unErrorShort  r = unShort . unError r+    unErrorShort_   = unShort . unError_
+ src/System/Timeout/Monad.hs view
@@ -0,0 +1,46 @@+module System.Timeout.Monad+    ( timeoutR+    , timeoutM+    , timeoutVoid+    ) where++import Control.Monad.IO.Class+import Control.Monad.Runnable+import System.Timeout++-- | Run an action that is runnable in the IO monad within a time limit+--+-- The time limit is specified in microseconds, and is subject to the same sas 'System.Timeout.timeout'.  +-- Finally, the action to be run itself is passed.  The result is an IO action, which is+-- normally lifted with 'liftIO' to be run in the same IO (see 'timeoutM').  The action,+-- when run, returns the resulting monadic value if it was run in time.  Conceptually,+-- one can think of this as running a local monad, perhaps a copy, in the IO monad;+-- the effects of running in the IO monad are unavoidably irreversible, but the resulting monadic+-- value can be optionally ignored, in which case it is not evaluated in the parent monad+-- and no effects are present in the outer layers of the monad.+timeoutR :: (Integral i, Monad m, MonadRunnable m) => i -> m a -> RunData m -> IO (Maybe (m a))+timeoutR i m d = do+    c <- timeout (fromIntegral i) . rcToIO $ run m d+    case c of+        (Just c') -> do+            return . Just $ construct c'+        (Nothing) -> do+            return $ Nothing++-- | Equivalent to 'timeoutM', but the result is the same monad, making passing the data needed to run the monad unnecessary+timeoutM :: (Integral i, Monad m, MonadIO m, MonadRunnable m) => i -> m a -> m (Maybe (m a))+timeoutM i m = liftIO . timeoutR i m =<< runData++-- | If the void action runs in time, it is run and 'True' is returned; otherwise 'False' is returned when running the action in time does not succeed+--+-- For example, to run a void action within one second,+-- one might write+--+-- > succeeded <- timeoutVoid+--+-- The effects of "action" will be fully executed if succeeded+-- is 'True'; if succeeded is 'False', the action could not run+-- in time, and only global IO actions that were performed while+-- the local monad was being evaluated will be run.+timeoutVoid :: (Integral i, Monad m, MonadIO m, MonadRunnable m) => i -> m () -> m Bool+timeoutVoid i m = maybe (return False) (>> return True) =<< timeoutM i m