1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26   module MonadState (
   27         MonadState(..),
   28         modify,
   29         State,          -- abstract
   30         runState,
   31         mapState,
   32         evalState,
   33         execState,
   34         StateT,         -- abstract
   35         runStateT,
   36         mapStateT,
   37         evalStateT,
   38         execStateT,
   39         module MonadTrans
   40         ) where
   41 
   42   import Monad
   43   import MonadTrans
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52 
   53 
   54   class (Monad m) => MonadState s m where
   55         get :: m s
   56         put :: s -> m ()
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 
   68 
   69 
   70 
   71 
   72 
   73 
   74 
   75   modify :: (MonadState s m) => (s -> s) -> m ()
   76   modify f = do s <- get
   77                 put (f s)
   78 
   79 
   80 
   81 
   82 
   83   newtype State s a = State { runState :: s -> (a,s) }
   84 
   85 
   86 
   87 
   88 
   89 
   90   instance Functor (State s) where
   91         fmap f p = State (\ s ->
   92                 let (x,s') = runState p s
   93                 in  (f x,s'))
   94 
   95   instance Monad (State s) where
   96      return v  = State (\ s -> (v,s))
   97      p  >>= f  = State (\ s -> let (r,s') = runState p s
   98                              in runState (f r) s')
   99      fail str  = State (\ s -> error str)
  100 
  101   instance MonadState s (State s) where
  102         get   = State (\ s -> (s,s))
  103         put v = State (\ _ -> ((),v))
  104 
  105 
  106   mapState :: ((a,s) -> (b,s)) -> State s a -> State s b
  107   mapState f m = State (f . runState m)
  108 
  109   evalState :: State s a -> s -> a
  110   evalState m s = fst (runState m s)
  111 
  112   execState :: State s a -> s -> s
  113   execState m s = snd (runState m s)  
  114 
  115 
  116 
  117 
  118 
  119   newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
  120 
  121 
  122 
  123 
  124 
  125 
  126 
  127 
  128 
  129 
  130 
  131 
  132 
  133 
  134 
  135 
  136 
  137 
  138 
  139 
  140 
  141 
  142 
  143 
  144 
  145 
  146   instance (Monad m) => Functor (StateT s m) where
  147         -- fmap :: (a -> b) -> StateT s m a -> StateT s m b
  148         fmap f p = StateT (\ s ->
  149                 do (x,s') <- runStateT p s
  150                    return (f x,s'))
  151   
  152   instance (Monad m) => Monad (StateT s m) where
  153      return v  = StateT (\ s -> return (v,s))
  154      p  >>= f  = StateT (\ s -> do (r,s') <- runStateT p s
  155                                    runStateT (f r) s')
  156      fail str  = StateT (\ s -> fail str)
  157   
  158   instance (MonadPlus m) => MonadPlus (StateT s m) where
  159         mzero       = StateT (\ s -> mzero)
  160         p `mplus` q = StateT (\ s -> runStateT p s `mplus` runStateT q s)
  161   
  162   instance (Monad m) => MonadState s (StateT s m) where
  163         get   = StateT (\ s -> return (s,s))
  164         put v = StateT (\ _ -> return ((),v))
  165   
  166   instance MonadTrans (StateT s) where
  167      lift f = StateT ( \ s -> do { r <- f ; runStateT (return r) s })
  168 
  169   mapStateT :: (m (a,s) -> n (b,s)) -> StateT s m a -> StateT s n b
  170   mapStateT f m = StateT (f . runStateT m)
  171   
  172   evalStateT :: (Monad m) => StateT s m a -> s -> m a
  173   evalStateT m s =  
  174         do (r,_) <- runStateT m s
  175            return r
  176   
  177   execStateT :: (Monad m) => StateT s m a -> s -> m s
  178   execStateT m s =  
  179         do (_,s) <- runStateT m s
  180            return s
  181 
  182 
  183 
  184