module Monads where

type ST s a = s -> (a, s)

unitST :: a -> ST s a
unitST a = \ s -> (a, s)

bindST :: ST s a -> (a -> ST s b) -> ST s b
m `bindST` k = \ s -> let (a, s1) = m s in k a s1

tickST :: ST Integer ()
tickST = \ n -> ((), n+1)

type K r a = (a -> r) -> r

unitK :: a -> K r a
unitK a = \ c -> c a

bindK :: K r a -> (a -> K r b) -> K r b
m `bindK` k = \ c -> m (\ a -> k a c) 

type KST r s a  = K (ST s r) a

unitKST :: a -> KST r s a
unitKST = unitK

bindKST :: KST r s a -> (a -> KST r s b) -> KST r s b
bindKST = bindK

tickKST :: KST r Integer ()
tickKST = \ c -> tickST `bindST` c

type STK r s a = s -> K r (a, s)

unitSTK :: a -> STK r s a
unitSTK a = \ s c -> c (a, s)

bindSTK :: STK r s a -> (a -> STK r s b) -> STK r s b
m `bindSTK` k = \ s c -> m s (\ (a, s1) -> k a s1 c)

tickSTK :: STK r Integer ()
tickSTK = \ s c -> c (tickST s)

type E a = Either String a

unitE :: a -> E a
unitE a = Right a

bindE :: E a -> (a -> E b) -> E b
(Right a) `bindE` k = k a
(Left s)  `bindE` k = Left s

type STE s a = s -> E (a, s)

unitSTE :: a -> STE s a
unitSTE a = \ s -> unitE (a, s)

bindSTE :: STE s a -> (a -> STE s b) -> STE s b
m `bindSTE` k = \ s -> m s `bindE` \ (a, s1) -> k a s1

type EST s a = s -> (E a, s)

unitEST :: a -> EST s a
unitEST a = \ s -> (unitE a, s)

bindEST :: EST s a -> (a -> EST s b) -> EST s b 
m `bindEST` k = \ s -> let (ma, s1) = m s in
                       case ma of
                         Right a -> k a s1
                         Left s  -> (Left s, s1)

type L a = [a]

unitL :: a -> L a
unitL a = [a]

bindL :: L a -> (a -> L b) -> L b
[] `bindL` k = []
(x:xs) `bindL` k = k x ++ (xs `bindL` k)

type STL s a = s -> [(a, s)]

unitSTL :: a -> STL s a
unitSTL a = \ s -> [(a, s)]

bindSTL :: STL s a -> (a -> STL s b) -> STL s b
m `bindSTL` k = \ s -> m s `bindL` \ (a, s1) -> k a s1

type LST s a = s -> ([a], s)

unitLST :: a -> LST s a
unitLST a = unitST (unitL a)

bindLST :: LST s a -> (a -> LST s b) -> LST s b
m `bindLST` k = m          `bindST` \ as ->
                mapST k as `bindST` \ bs ->   
                unitST (concat bs)  

mapST f []     = unitST []
mapST f (a:as) = f a        `bindST` \ b ->
                 mapST f as `bindST` \ bs ->   
                 unitST (b:bs)