-- |
-- Module      : OAlg.Control.Action
-- Description : statefull evaluation
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
-- 
-- Actions over a state type, i.e. statefull evaluation.
module OAlg.Control.Action
  ( Action(..), run, getState, setState
  )
  where

--------------------------------------------------------------------------------
-- Action -

-- | action over a state @__s__@.
newtype Action s x = Action (s -> (x,s))


instance Functor (Action s)  where
  fmap :: forall a b. (a -> b) -> Action s a -> Action s b
fmap a -> b
f (Action s -> (a, s)
r) = forall s x. (s -> (x, s)) -> Action s x
Action (\s
s -> let (a
x,s
s') = s -> (a, s)
r s
s in (a -> b
f a
x,s
s'))


instance Applicative (Action s) where
  pure :: forall a. a -> Action s a
pure a
x = forall s x. (s -> (x, s)) -> Action s x
Action (\s
s -> (a
x,s
s))
  Action s (a -> b)
mf <*> :: forall a b. Action s (a -> b) -> Action s a -> Action s b
<*> Action s a
mx = do
    a -> b
f <- Action s (a -> b)
mf
    a
x <- Action s a
mx
    forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)

instance Monad (Action s) where
  return :: forall a. a -> Action s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure 
  Action s -> (a, s)
ax >>= :: forall a b. Action s a -> (a -> Action s b) -> Action s b
>>= a -> Action s b
f = forall s x. (s -> (x, s)) -> Action s x
Action
    (\s
s -> let (a
a,s
s') = s -> (a, s)
ax s
s
               Action s -> (b, s)
ay = a -> Action s b
f a
a
           in s -> (b, s)
ay s
s'
    )

-- | running an action on the gicen state.
run :: Action s x -> s -> (x,s)
run :: forall s x. Action s x -> s -> (x, s)
run (Action s -> (x, s)
a) s
s = s -> (x, s)
a s
s

-- | sets the state.
setState :: s -> Action s s
setState :: forall s. s -> Action s s
setState s
s = forall s x. (s -> (x, s)) -> Action s x
Action (\s
s' -> (s
s',s
s))

-- | gets the state.
getState :: Action s s
getState :: forall s. Action s s
getState = forall s x. (s -> (x, s)) -> Action s x
Action (\s
s -> (s
s,s
s))