content: module StateMonad where
  
  -- General purpose state monad -----------------------------------------------
  
  type SM s a       = s -> (s, a)
  
  -- Primitive monad operators -------------------------------------------------
  
  retURN           :: a -> SM s a
  retURN x          = \s -> (s, x)
  
  bind             :: SM s a -> (a -> SM s b) -> SM s b
  m `bind` f        = \s -> let (s',a) = m s in f a s'
  
  join             :: SM s (SM s a) -> SM s a
  join m            = \s -> let (s',ma) = m s in ma s'
  
  mmap             :: (a -> b) -> (SM s a -> SM s b)
  mmap f m          = \s -> let (s',a)  = m s in (s', f a)
  
  -- General monad operators ---------------------------------------------------
  
  mmapl            :: (a -> SM s b) -> ([a] -> SM s [b])
  mmapl f []        = retURN []
  mmapl f (a:as)    = f a             `bind` \b ->
                      mmapl f as      `bind` \bs ->
                      retURN (b:bs)
  
  mmapr            :: (a -> SM s b) -> ([a] -> SM s [b])
  mmapr f []        = retURN []
  mmapr f (x:xs)    = mmapr f xs      `bind` \ys ->
                      f x             `bind` \y  ->
                      retURN (y:ys)
  
  mfoldl           :: (a -> b -> SM s a) -> a -> [b] -> SM s a
  mfoldl f a []     = retURN a
  mfoldl f a (x:xs) = f a x           `bind` \fax ->
                      mfoldl f fax xs
  
  mfoldr           :: (a -> b -> SM s b) -> b -> [a] -> SM s b
  mfoldr f a []     = retURN a
  mfoldr f a (x:xs) = mfoldr f a xs   `bind` \y ->
                      f x y
  
  mif              :: SM s Bool -> SM s a -> SM s a -> SM s a
  mif c t f         = c               `bind` \cond ->
                      if cond then t
                              else f
  
  -- Specific utilities for state monads ---------------------------------------
  
  startingWith      :: SM s a -> s -> a
  m `startingWith` v = answer where (final,answer) = m v
  
  fetch             :: SM s s
  fetch              = \s -> (s,s)
  
  fetchWith         :: (s -> a) -> SM s a
  fetchWith f        = \s -> (s, f s)
  
  update            :: (s -> s) -> SM s s
  update f           = \s -> (f s, s)
  
  set               :: s -> SM s s
  set s'             = \s -> (s',s)
  
  -- Common use of state monad: counter ----------------------------------------
  
  incr              :: SM Int Int
  incr               = update (1+)
  