import qualified Control.Monad.State as S
 
main :: IO ()
main = 
    do
        print $ S.evalState (playGame "abcaaacbbcabbab") startState
        print $ S.evalState playGame2 startState
 
-- Example use of State monad
-- applying two methods
-- 1'st method passes a string of dictionary {a,b,c} (playGame)
-- 2'nd method passes character by character in a do block (playGame2)
-- Both produce a number that is represented by a string
-- Both share function "pass" to manipulate the state according to the following rules:
-- By default the game is off, a C toggles the
-- game on and off. A 'a' gives +1 and a 'b' gives -1.
-- E.g 
-- 'ab'    = 0
-- 'ca'    = 1
-- 'cabca' = 0
-- State = game is on or off & current score
--       = (Bool, Int)
 
type GameScore = Int
type GameState = (Bool, GameScore)
 
playGame :: String -> S.State GameState String
playGame [] = 
    do
        (_, score) <- S.get
        return (show score)
playGame (ch:rlch) = 
    do
        pass ch
        playGame rlch
 
pass :: Char -> S.State GameState ()
pass ch = 
    do
        (on, score) <- S.get
        case ch of
            'a' | on -> S.put (on, score + 1)
            'b' | on -> S.put (on, score - 1)
            'c'      -> S.put (not on, score)
            _        -> S.put (on, score)
 
result :: S.State GameState String
result = S.gets result'
    where
        result' :: GameState -> String
        result' (_,nScore) = show nScore
 
playGame2 :: S.State GameState String
playGame2 = 
    do
        pass 'a'
        pass 'b'
        pass 'c'
        pass 'a'
        pass 'a'
        pass 'a'
        pass 'c'
        pass 'b'
        pass 'b'
        pass 'c'
        pass 'a'
        pass 'b'
        pass 'b'
        pass 'a'
        pass 'b'
        r <- result
        return r
 
startState :: GameState
startState = (False, 0)

"2"
"2"

import qualified Control.Monad.State as S (State, put, get, gets, modify, runState, execState, evalState)
-- in package mtl-2.2.2, the line above seems to be the same as "import qualified mtl-2.2.2Control.Monad.State.Lazy ..."
{-
type signatures and descriptions of functions in
Control.Monad.State
from package: mtl-2.2.2
 
type State s = StateT s Identity???
 
put    :: MonadState s m => s -> m ()          -- set the state value
get    :: MonadState s m => m s                -- get the state
gets   :: MonadState s m => (s -> a) -> m a    -- apply a function over the state, and return the result
modify :: MonadState s m => (s -> s) -> m ()   -- set the state, using a modifier function
 
runState  :: State s a -> s -> (a, s) -- Unwrap a state monad computation as a function. (The inverse of state.)
evalState :: State s a -> s -> a      -- Evaluate a state computation with the given initial state and return the final value, discarding the final state.
execState :: State s a -> s -> s      -- Evaluate a state computation with the given initial state and return the final state, discarding the final value.
-}
 
main :: IO ()
main = 
    do
        putStrLn "test1:"
        putStrLn $ "   " ++ (show (S.runState  test1 (Pos 0 0)))
        putStrLn $ "   " ++ (show (S.execState test1 (Pos 0 0)))
        putStrLn $ "   " ++ (show (S.evalState test1 (Pos 0 0)))
        putStrLn "test2:"
        putStrLn $ "   " ++ (show (S.runState  test2 (Pos 0 0)))
        putStrLn $ "   " ++ (show (S.execState test2 (Pos 0 0)))
        putStrLn $ "   " ++ (show (S.evalState test2 (Pos 0 0)))
        putStrLn "test3:"
        putStrLn $ "   " ++ (show (S.evalState test3 (Pos 0 0)))
 
data Direction = North | East | South | West
    deriving Show
 
data Pos = Pos { rnLat :: Integer, rnLon :: Integer }
    deriving Show
 
go :: Direction -> S.State Pos ()
go d = S.modify (go' d)
    where
        go' :: Direction -> Pos -> Pos
        go' North (Pos nLat nLon) = Pos (nLat + 1) nLon
        go' East  (Pos nLat nLon) = Pos nLat       (nLon + 1)
        go' South (Pos nLat nLon) = Pos (nLat - 1) nLon
        go' West  (Pos nLat nLon) = Pos nLat       (nLon - 1)
 
test1 :: S.State Pos Pos
test1 = do
    go North
    go East
    go East
    go East
    go South
    go South
    S.gets (\pos -> (Pos ((rnLat pos) + 10) ((rnLon pos) + 10)))
 
test2 :: S.State Pos Pos
test2 = do
    go North
    go East
    go East
    go East
    go South
    go South
    S.gets (\pos -> (Pos ((rnLat pos) + 10) ((rnLon pos) + 10)))
 
test3 :: S.State Pos Pos
test3 = do
    S.put (Pos 10 10)        -- resets the state to (Pos 10 10)
    go North
    go East
    go East
    go East
    go South
    go South
    S.get                    -- returns the state

test1:
   (Pos {rnLat = 9, rnLon = 13},Pos {rnLat = -1, rnLon = 3})
   Pos {rnLat = -1, rnLon = 3}
   Pos {rnLat = 9, rnLon = 13}
test2:
   (Pos {rnLat = 9, rnLon = 13},Pos {rnLat = -1, rnLon = 3})
   Pos {rnLat = -1, rnLon = 3}
   Pos {rnLat = 9, rnLon = 13}
test3:
   Pos {rnLat = 9, rnLon = 13}

import qualified Control.Monad.State as S
-- in package mtl-2.2.2, the line above seems to be the same as "import qualified mtl-2.2.2Control.Monad.State.Lazy ..."
import Prelude hiding (div)
 
{-
type signatures and descriptions of functions in
Control.Monad.State
from package: mtl-2.2.2
 
type State s = StateT s Identity
 
put    :: MonadState s m => s -> m ()          -- set the state value
get    :: MonadState s m => m s                -- get the state
gets   :: MonadState s m => (s -> a) -> m a    -- apply a function over the state, and return the result
modify :: MonadState s m => (s -> s) -> m ()   -- set the state, using a modifier function
 
runState  :: State s a -> s -> (a, s) -- Unwrap a state monad computation as a function. (The inverse of state.)
evalState :: State s a -> s -> a      -- Evaluate a state computation with the given initial state and return the final value, discarding the final state.
execState :: State s a -> s -> s      -- Evaluate a state computation with the given initial state and return the final state, discarding the final value.
-}
 
main :: IO ()
main = 
    do
        putStrLn "test1:"
        putStrLn $ "   " ++ (show (S.runState  test1 []))
        putStrLn $ "   " ++ (show (S.execState test1 []))
        putStrLn $ "   " ++ (show (S.evalState test1 []))
 
push :: Double -> S.State [Double] ()
push n = S.modify (push' n)
    where
        push' :: Double -> [Double] -> [Double]
        push' nToPush ln' = nToPush : ln'
 
add :: S.State [Double] ()
add = S.modify add'
    where
        add' :: [Double] -> [Double]
        add' [] = []
        add' (na:nb:rln) = (nb + na) : rln
        add' (_:_) = []
 
sub :: S.State [Double] ()
sub = S.modify sub'
    where
        sub' :: [Double] -> [Double]
        sub' [] = []
        sub' (na:nb:rln) = (nb - na) : rln
        sub' (_:_) = []
 
mul :: S.State [Double] ()
mul = S.modify mul'
    where
        mul' :: [Double] -> [Double]
        mul' [] = []
        mul' (na:nb:rln) = (nb * na) : rln
        mul' (_:_) = []
 
div :: S.State [Double] ()
div = S.modify div'
    where
        div' :: [Double] -> [Double]
        div' [] = []
        div' (na:nb:rln) = (nb / na) : rln
        div' (_:_) = []
 
result :: S.State [Double] Double
result = S.gets result'
    where
        result' :: [Double] -> Double
        result' [] = 0
        result' (n:_) = n
 
test1 :: S.State [Double] Double
test1 = 
    do -- ((3 + 5) * (7 - 11)) / 13 = 2,461...
        push 3
        push 5
        add
        push 7
        push 11
        sub
        mul
        push 13
        div
        r <- result
        return r

test1:
   (-2.4615384615384617,[-2.4615384615384617])
   [-2.4615384615384617]
   -2.4615384615384617