StateMonad.hs

--
-- http://d.hatena.ne.jp/kazu-yamamoto/20080604/1212573964
--

data List a = Nil | Cons a (List a) deriving (Show)

cons :: a -> List a -> List a
cons x xs = Cons x xs

type Counter = Int
data Monadic a = Monadic (Counter -> (a, Counter))
instance Monad Monadic where
    Monadic f >>= g = Monadic $ \cnt0 -> let (result1, cnt1) = f cnt0
                                             Monadic h       = g result1
                                             (result2, cnt2) = h cnt1
                                         in (result2, cnt2)
    return x = Monadic $ \cnt -> (x, cnt)

cons0 :: a -> List a -> Monadic (List a)
cons0 x xs = Monadic $ \cnt -> (Cons x xs, cnt + 1)

run :: Monadic a -> Counter -> (a, Counter)
run (Monadic func) initCnt = func initCnt

triple :: Monadic (List String)
triple = do a <- cons0 "a" Nil
            b <- cons0 "b" a
            c <- cons0 "c" b
            return c

incr1 :: Monadic Int
incr1 = Monadic $ \cnt -> (999, cnt + 1)

cons1 :: a -> List a -> Monadic (List a)
cons1 x xs = do incr1
                return (Cons x xs)

incr2 :: Monadic Counter
incr2 = Monadic $ \cnt -> (cnt, cnt + 1)

cons2 :: a -> List (Counter, a) -> Monadic (List (Counter, a))
cons2 x xs = do cnt <- incr2
                return (Cons (cnt, x) xs)

get :: Monadic Counter
get = Monadic $ \cnt -> (cnt, cnt)

put :: Counter -> Monadic Counter
put x = Monadic $ \cnt -> (cnt, x)

cons3 :: a -> List (Counter, a) -> Monadic (List (Counter, a))
cons3 x xs = do cnt <- get
                put (cnt + 1)
                return (Cons (cnt, x) xs)

-- import Control.Monad.State
-- 
-- type Counter = Int
-- data List a = Nil | Cons a (List a) deriving Show
-- 
-- cons :: a -> List (Counter, a) -> State Counter (List (Counter, a))
-- cons x xs = do cnt <- get
--                put (cnt + 1)
--                return (Cons (cnt, x) xs)
-- 
-- evalState (cons "c" =<< cons "b" =<< cons "a" Nil) 0
-- → Cons (2,"c") (Cons (1,"b") (Cons (0,"a") Nil))