Control/Monad/State.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Monad.State
   4 -- Copyright   :  (c) Andy Gill 2001,
   5 --                (c) Oregon Graduate Institute of Science and Technology, 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable ( requires mulit-parameter type classes,
  11 --                               requires functional dependencies )
  12 --
  13 -- $Id: State.hs,v 1.2 2002/04/24 16:31:38 simonmar Exp $
  14 --
  15 -- State monads.
  16 --
  17 --        Inspired by the paper
  18 --        \em{Functional Programming with Overloading and
  19 --            Higher-Order Polymorphism},
  20 --          \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
  21 --                Advanced School of Functional Programming, 1995.}
  22 -----------------------------------------------------------------------------
  23
  24 module Control.Monad.State (
  25         MonadState(..),
  26         modify,
  27         gets,
  28         State(..),
  29         runState,
  30         evalState,
  31         execState,
  32         mapState,
  33         withState,
  34         StateT(..),
  35         runStateT,
  36         evalStateT,
  37         execStateT,
  38         mapStateT,
  39         withStateT,
  40         module Control.Monad,
  41         module Control.Monad.Fix,
  42         module Control.Monad.Trans,
  43   ) where
  44
  45 import Prelude
  46
  47 import Control.Monad
  48 import Control.Monad.Fix
  49 import Control.Monad.Trans
  50 import Control.Monad.Reader
  51 import Control.Monad.Writer
  52
  53 -- ---------------------------------------------------------------------------
  54 -- MonadState class
  55 --
  56 --  get: returns the state from the internals of the monad.
  57 --  put: changes (replaces) the state inside the monad.
  58
  59 class (Monad m) => MonadState s m | m -> s where
  60         get :: m s
  61         put :: s -> m ()
  62
  63 -- Monadic state transformer.
  64 --
  65 --      Maps an old state to a new state inside a state monad.
  66 --      The old state is thrown away.}
  67 --
  68 --        Main> :t modify ((+1) :: Int -> Int)
  69 --        modify (...) :: (MonadState Int a) => a ()
  70 --
  71 --      This says that modify (+1) acts over any
  72 --      Monad that is a member of the MonadState class,
  73 --      with an Int state.
  74
  75 modify :: (MonadState s m) => (s -> s) -> m ()
  76 modify f = do
  77         s <- get
  78         put (f s)
  79
  80 -- Get part of the state
  81 --
  82 --      gets specific component of the state,
  83 --      using a projection function supplied.
  84
  85 gets :: (MonadState s m) => (s -> a) -> m a
  86 gets f = do
  87         s <- get
  88         return (f s)
  89
  90 -- ---------------------------------------------------------------------------
  91 -- Our parameterizable state monad
  92
  93 newtype State s a = State { runState :: s -> (a, s) }
  94
  95 -- The State Monad structure is paramterized over just the state.
  96
  97 instance Functor (State s) where
  98         fmap f m = State $ \s -> let
  99                 (a, s') = runState m s
 100                 in (f a, s')
 101
 102 instance Monad (State s) where
 103         return a = State $ \s -> (a, s)
 104         m >>= k  = State $ \s -> let
 105                 (a, s') = runState m s
 106                 in runState (k a) s'
 107
 108 instance MonadFix (State s) where
 109         mfix f = State $ \s -> let (a, s') = runState (f a) s in (a, s')
 110
 111 instance MonadState s (State s) where
 112         get   = State $ \s -> (s, s)
 113         put s = State $ \_ -> ((), s)
 114
 115
 116 evalState :: State s a -> s -> a
 117 evalState m s = fst (runState m s)
 118
 119 execState :: State s a -> s -> s
 120 execState m s = snd (runState m s)
 121
 122 mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
 123 mapState f m = State $ f . runState m
 124
 125 withState :: (s -> s) -> State s a -> State s a
 126 withState f m = State $ runState m . f
 127
 128 -- ---------------------------------------------------------------------------
 129 -- Our parameterizable state monad, with an inner monad
 130
 131 newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
 132
 133 --The StateT Monad structure is parameterized over two things:
 134 --
 135 --   * s - The state.
 136 --   * m - The inner monad.
 137
 138 -- Here are some examples of use:
 139
 140 -- (Parser from ParseLib with Hugs)
 141 --   type Parser a = StateT String [] a
 142 --      ==> StateT (String -> [(a,String)])
 143 -- For example, item can be written as:
 144 --      item = do (x:xs) <- get
 145 --                put xs
 146 --                return x
 147
 148 --   type BoringState s a = StateT s Indentity a
 149 --      ==> StateT (s -> Identity (a,s))
 150 --
 151 --   type StateWithIO s a = StateT s IO a
 152 --      ==> StateT (s -> IO (a,s))
 153 --
 154 --   type StateWithErr s a = StateT s Maybe a
 155 --      ==> StateT (s -> Maybe (a,s))
 156
 157 instance (Monad m) => Functor (StateT s m) where
 158         fmap f m = StateT $ \s -> do
 159                 (x, s') <- runStateT m s
 160                 return (f x, s')
 161
 162 instance (Monad m) => Monad (StateT s m) where
 163         return a = StateT $ \s -> return (a, s)
 164         m >>= k  = StateT $ \s -> do
 165                 (a, s') <- runStateT m s
 166                 runStateT (k a) s'
 167         fail str = StateT $ \_ -> fail str
 168
 169 instance (MonadPlus m) => MonadPlus (StateT s m) where
 170         mzero       = StateT $ \_ -> mzero
 171         m `mplus` n = StateT $ \s -> runStateT m s `mplus` runStateT n s
 172
 173 instance (MonadFix m) => MonadFix (StateT s m) where
 174         mfix f = StateT $ \s -> mfix $ \ ~(a, _) -> runStateT (f a) s
 175
 176 instance (Monad m) => MonadState s (StateT s m) where
 177         get   = StateT $ \s -> return (s, s)
 178         put s = StateT $ \_ -> return ((), s)
 179
 180 instance MonadTrans (StateT s) where
 181         lift m = StateT $ \s -> do
 182                 a <- m
 183                 return (a, s)
 184
 185 instance (MonadIO m) => MonadIO (StateT s m) where
 186         liftIO = lift . liftIO
 187
 188 instance (MonadReader r m) => MonadReader r (StateT s m) where
 189         ask       = lift ask
 190         local f m = StateT $ \s -> local f (runStateT m s)
 191
 192 instance (MonadWriter w m) => MonadWriter w (StateT s m) where
 193         tell     = lift . tell
 194         listen m = StateT $ \s -> do
 195                 ((a, s'), w) <- listen (runStateT m s)
 196                 return ((a, w), s')
 197         pass   m = StateT $ \s -> pass $ do
 198                 ((a, f), s') <- runStateT m s
 199                 return ((a, s'), f)
 200
 201
 202 evalStateT :: (Monad m) => StateT s m a -> s -> m a
 203 evalStateT m s = do
 204         (a, _) <- runStateT m s
 205         return a
 206
 207 execStateT :: (Monad m) => StateT s m a -> s -> m s
 208 execStateT m s = do
 209         (_, s') <- runStateT m s
 210         return s'
 211
 212 mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
 213 mapStateT f m = StateT $ f . runStateT m
 214
 215 withStateT :: (s -> s) -> StateT s m a -> StateT s m a
 216 withStateT f m = StateT $ runStateT m . f
 217
 218 -- ---------------------------------------------------------------------------
 219 -- MonadState instances for other monad transformers
 220
 221 instance (MonadState s m) => MonadState s (ReaderT r m) where
 222         get = lift get
 223         put = lift . put
 224
 225 instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) where
 226         get = lift get
 227         put = lift . put