{-# options -fglasgow-exts -farrows #-}

module Data.State where

import Control.Arrow
import qualified Control.Arrow.Operations as AO
import Control.Monad.State as ST
import Data.Dynamic

class LocalState sg sl where
 getState :: sg -> sl
 putState :: sl -> sg -> sg

instance LocalState a a where
 getState = id
 putState a _ = a

class DynamicState sg where
 getDynamic :: sg -> Dynamic
 putDynamic :: Dynamic -> sg -> sg

class ZeroState sl where
 zeroState :: sl

get :: (ST.MonadState sg m, LocalState sg sl) => m sl
get = liftM getState ST.get

put :: (ST.MonadState sg m, LocalState sg sl) => sl -> m ()
put sl = do
 sg <- ST.get
 ST.put (putState sl sg)

fetch :: (AO.ArrowState sg a, LocalState sg sl) => a e sl
fetch = getState ^<< AO.fetch

store :: (ArrowApply a, AO.ArrowState sg a, LocalState sg sl) => a sl ()
store = proc sl -> AO.store <<< putState sl ^<< AO.fetch -<< ()