backward-state (empty) → 0.1.0.0

raw patch · 4 files changed

+159/−0 lines, 4 filesdep +basedep +transformerssetup-changed

Dependencies added: base, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
backward-state.cabal +22/−0
src/Control/Monad/Trans/BackwardState.hs +105/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Luke Palmer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Luke Palmer nor the names of other+      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

+ backward-state.cabal view

@@ -0,0 +1,22 @@+-- Initial backward-state.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                backward-state+version:             0.1.0.0+synopsis:            A state monad that runs the state in reverse through the computation+-- description:         +homepage:            https://github.com/luqui/backward-state+license:             BSD3+license-file:        LICENSE+author:              Luke Palmer+maintainer:          lrpalmer@gmail.com+-- copyright:           +category:            Control, Monads+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     Control.Monad.Trans.BackwardState+  -- other-modules:       +  build-depends:       base ==4.5.*, transformers ==0.3.*+  hs-source-dirs:      src

+ src/Control/Monad/Trans/BackwardState.hs view

@@ -0,0 +1,105 @@+{-# LANGUAGE DoRec #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.BackwardState+-- Copyright   :  (c) Luke Palmer, 2013+-- License     :  BSD3+--+-- Maintainer  :  Luke Palmer <lrpalmer@gmail.com>+-- Stability   :  experimental+-- Portability :  needs DoRec+--+-- Backward state monad and transformer, in which @m >> n@ passes the incoming+-- state to n, then passes @n@\'s resulting state to @m@.  This can only work+-- lazily.+-----------------------------------------------------------------------------+++module Control.Monad.Trans.BackwardState +    ( BackwardState+    , runBackwardState+    , evalBackwardState+    , execBackwardState+    +    , BackwardStateT(..)+    , evalBackwardStateT+    , execBackwardStateT++    , get+    , put+    , modify+    )+where++import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import Control.Monad.Fix (MonadFix(..))+import Control.Applicative (Applicative(..), Alternative(..))+import Control.Monad (ap, MonadPlus(..), liftM)+import Control.Arrow (first)++type BackwardState s = BackwardStateT s Identity++runBackwardState :: BackwardState s a -> s -> (a, s)+runBackwardState m = runIdentity . runBackwardStateT m++evalBackwardState :: BackwardState s a -> s -> a+evalBackwardState m = fst . runBackwardState m ++execBackwardState :: BackwardState s a -> s -> s+execBackwardState m = snd . runBackwardState m ++newtype BackwardStateT s m a = BackwardStateT { runBackwardStateT :: s -> m (a, s) }++evalBackwardStateT :: (Functor m) => BackwardStateT s m a -> s -> m a+evalBackwardStateT m = fmap fst . runBackwardStateT m++execBackwardStateT :: (Functor m) => BackwardStateT s m a -> s -> m s+execBackwardStateT m = fmap snd . runBackwardStateT m++get :: (Monad m) => BackwardStateT s m s+get = BackwardStateT $ \s -> return (s, s)++put :: (Monad m) => s -> BackwardStateT s m ()+put s' = BackwardStateT $ \s -> return ((), s')++modify :: (Monad m) => (s -> s) -> BackwardStateT s m ()+modify f = BackwardStateT $ \s -> return ((), f s)++instance (Functor m) => Functor (BackwardStateT s m) where+    fmap f b = BackwardStateT $ fmap (first f) . runBackwardStateT b++instance (Functor m, MonadFix m) => Applicative (BackwardStateT s m) where+    pure = return+    (<*>) = ap++instance (Functor m, MonadFix m, MonadPlus m) => Alternative (BackwardStateT s m) where+    empty = mzero+    (<|>) = mplus+ ++instance (MonadFix m) => Monad (BackwardStateT s m) where +    return x = BackwardStateT $ \s -> return (x, s)+    m >>= f = BackwardStateT $ \s'' -> do +        rec (x, s) <- runBackwardStateT m s'+            (y, s') <- runBackwardStateT (f x) s''+        return (y, s)++instance MonadTrans (BackwardStateT s) where+    lift m = BackwardStateT $ \s -> liftM (flip (,) s) m++++instance (MonadFix m, MonadPlus m) => MonadPlus (BackwardStateT s m) where+    mzero = BackwardStateT $ const mzero+    m `mplus` n = BackwardStateT $ \s -> runBackwardStateT m s `mplus` runBackwardStateT n s++instance (MonadFix m) => MonadFix (BackwardStateT s m) where+    mfix f = BackwardStateT $ \s -> mfix $ \ ~(a, _) -> runBackwardStateT (f a) s+        -- same as StateT... I think. Seems like it follows from the+        -- first MonadFix law (mfix (return . h) = return (fix h))++instance (MonadFix m, MonadIO m) => MonadIO (BackwardStateT s m) where+    liftIO = lift . liftIO