Stateモナドの整理

State.hs

import System.Random
import Control.Monad.State hiding (modify')

{-
newtype State s a = State { runState :: s -> (a, s) }

instance Monad (State s) where
  return x  = State $ \s -> (x, s)
  (State h) >>= f = State $ \s -> let (v, newState) = h s
                                      (State g)     = f v
                                  in g newState
-}

-- Stateは状態を表すデータ(ここでは[Int])を受け取り、計算結果(ここではInt)と計算後の状態を表すデータを返す。
-- State自身が状態を表しているわけではない。状態の計算方法を表している。
pop :: State [Int] Int
pop = state $ \(x:xs) -> (x, xs)

push :: Int -> State [Int] ()
push x = state $ \xs -> ((), x:xs)

-- do構文例
playStackD :: State [Int] Int
playStackD = do
               push 1
               x1 <- pop
               push (2 * x1)
               pop

-- 明示的なbindによる例
-- (>>=)の左辺はState、右辺の関数の引数は左辺のStateの計算結果
playStackB :: State [Int] Int
playStackB = push 1 >>= \_ -> pop >>= \y -> push (2 * y) >>= \_ -> pop

-- bindの実装
bind' :: State s a -> (a -> State s b) -> State s b
bind' s f = state $ \x -> let (a, newState) = runState s x
                              g             = f a
                          in  runState g newState

-- getの実装
get' :: State s s
get' = state $ \s -> (s, s)

-- modifyの実装
modify' :: (s -> s) -> State s ()
modify' f = state $ \s -> ((), f s)

playStackV :: State [Int] Int
playStackV = do
  push 1
  s <- get'
  modify' (\x -> [100, 200, 300] ++ x)
  push (s !! 0)
  pop


{-
newType StateT s m a = StateT { runStateT :: (s -> m (a, s)) }

instance (Monad m) => Monad (StateT s m) where
  return x = StateT $ \s -> return (x, s)
  (StateT h) >>= f = StateT $ \s -> do (v, s') <- h s
                                       (StateT g) <- return $ f v
                                       g s'

instance (Monad m) => MonadState s (StateT s m) where
  get = StateT $ \s -> return (s, s)
  put s = StateT $ \s -> return ((), s)

instance MonadTrans (StateT s) where
  lift c = StateT $ \s -> c >>= (\x -> return (x, s))
-}

popT :: StateT [Int] IO Int
popT = StateT $ \(x:xs) -> do
  return (x, xs)

pushT :: Int -> StateT [Int] IO ()
pushT x = StateT $ \xs -> do
  return ((), x:xs)

playStackDT :: StateT [Int] IO Int
playStackDT = do
  x1 <- lift (readLn :: IO Int)
  pushT x1
  return (x1 * 2)

*Main> runState playStackD [1,2,3]
(2,[1,2,3])