-- This file:
--   http://angg.twu.net/HASKELL/State1.hs.html
--   http://angg.twu.net/HASKELL/State1.hs
--           (find-angg "HASKELL/State1.hs")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun st () (interactive) (find-angg "HASKELL/State1.hs"))
-- (find-books "__comp/__comp.el" "haskell-hutton" "The state monad")
-- (find-huttonbookpage 198           "The state monad")
-- (find-huttonbooktext 198           "The state monad")

import Prelude hiding (fst, snd)

type State = Int

newtype ST a = S (State -> (a,State))

app :: ST a -> State -> (a,State)
app (S st) x = st x

instance Functor ST where
  -- fmap :: (a -> b) -> ST a -> ST b
  fmap g st = S (\s -> let (x,s') = app st s in (g x, s'))

instance Applicative ST where
  -- pure :: a -> St a
  pure x = S (\s -> (x,s))
  -- <*> :: ST (a -> b) -> ST a -> ST b
  stf <*> stx = S (\s ->
    let (f,s') = app stf s
        (x,s'') = app stx s' in (f x, s''))

instance Monad ST where
  -- (>>=) :: ST a -> (a -> ST b) -> ST b
  st >>= f = S (\s -> let (x,s') = app st s in app (f x) s')

fst :: (a,b) -> a
fst (va,vb) = va

snd :: (a,b) -> b
snd (va,vb) = vb

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load State1.hs
:t fst
:t Main.fst

-}


{-
-- (find-huttonbookpage 200 "fmap g st =")
-- (find-huttonbooktext 200 "fmap g st =")


fmap   g      st   = S (\   s    -> let (x  ,   s'  ) = app   st      s    in (g  x ,    s'  ))
     ====== ======       =======         === =======        ====== =======       ===  =======
     ::a->b ::ST a       ::State         ::a ::State        ::ST a ::State       ::a  ::State
==================                      =============   ==================     =====
     ::ST b                              ::(a,State)        ::(a,State)         ::b
                                                                              ================
                                                                                 ::(b,State)
                                    ==========================================================
                                                            ::(b,State)
                        ======================================================================
                                                         ::State->(b,State)
                     ==========================================================================
                                                        ::ST b



                 __________________________________
                |                                  |
                |          fmap g st               |
                |           ::ST b                 |
                |                                  |                  x = fst (app st s)
                |    ________          ________    |                 s' = snd (app st s)
                |   |        |   x    |        |   |   g x
                |   |   st   |  ::a   |    g   |   |   ::b
                |   | ::ST a |------->| ::a->b |--------------->
                |   |        |        |        |   |
                |   |        |        |________|   |
                |   |        |                     |
                |   |        |                     |
    --------------->|        |--------------------------------->
         s      |   |        |                     |     s'
      ::State   |   |        |                     |  ::State
                |   |________|                     |
                |                                  |
                |__________________________________|

-}




-- Local Variables:
-- coding:  utf-8-unix
-- indent-tabs-mode: nil
-- End: