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