-- Various Applicatives
-- They are standard and could have been in the standard applicative
-- library

module Applicatives where

import Control.Applicative

newtype Identity a = Identity{runIdentity:: a}

instance Functor Identity where
    fmap f = Identity . f . runIdentity

instance Applicative Identity where
    pure = Identity
    Identity x <*> Identity y = Identity (x y)


newtype State s a = State{unState :: s -> (a,s)}

instance Functor (State s) where
    fmap f (State e) = State $ \s -> let (a,s') = e s in (f a,s')

instance Applicative (State s) where
    pure x = State (\s -> (x,s))
    State e1 <*> State e2 = 
	State $ \s -> let (v1,s1) = e1 s
			  (v2,s2) = e2 s1
		      in (v1 v2, s2)


-- State + CPS applicative

newtype CPSA s w a = CPSA{unCPSA :: (a -> s -> w) -> s -> w}

instance Applicative (CPSA s w) where
    pure x = CPSA (\k -> k x)
    (CPSA e1) <*> (CPSA e2) = CPSA $ \k ->
			      e1 (\v1 -> e2 (\v2 -> k (v1 v2)))

instance Functor (CPSA s w) where
    fmap f m = pure f <*> m

{-
instance Monad (CPSA s w) where
    return = pure
    CPSA e >>= f = CPSA $ \k -> e (\v -> unCPSA (f v) k)
-}

reset :: CPSA s w w -> CPSA s w' w
reset (CPSA e) = CPSA $ \k s -> k (e (\v s' -> v) s) s