module StateParser where
import UU_Parsing 


newtype Input inp st s = Input (inp s,st)

instance InputState inp s => InputState  (Input inp state) s where
  splitStateE (Input (inp,st)) = case splitStateE inp of
                  Left'   x xs   -> Left'  x (Input (xs,st))
                  Right'  xs     -> Right'   (Input (xs,st))
  splitState (Input (inp,st)) = case splitState inp of
                  (x,xs) -> (x,Input (xs,st))
  firstState (Input (inp,_)) = firstState inp
  getPosition (Input (inp,_)) = getPosition inp

class StateParser p st | p -> st where
  get :: p st
  change :: (st -> st) -> p ()
  set :: st -> p ()
  set x = change (const x)

fconst x y = y

instance (InputState inp s ,OutputState out) =>
          StateParser (AnaParser (Input inp st) out s) st where
  get = pDynE (PR (rp,rr))
    where f addRes k state = let steps =  k state
                                 Input ~(_,st) = state
                             in (val (addRes st) steps)
          rp = P f
          rr = R (f fconst )
  change ch = pDynE (PR (rp,rr))
    where f addRes k state = let steps =  k (Input (inp,ch st))
                                 Input ~(inp,st) = state
                             in (val (addRes ()) steps)

          rp = P f 
          rr = R (f fconst )