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