module Data.ParserCombinators.KangarooState
(
Kangaroo
, parse
, runKangaroo
, evalKangaroo
, execKangaroo
, put
, get
, modify
, gets
, ParseErr
, RegionCoda(..)
, RegionName
, liftIOAction
, reportError
, substError
, word8
, satisfy
, checkWord8
, opt
, skip
, position
, region
, atEnd
, lengthRemaining
, regionSize
, intraparse
, advance
, advanceRelative
, restrict
, restrictToPos
, printHexAll
, printHexRange
, printRegionStack
, module Data.ParserCombinators.Kangaroo.Combinators
, module Data.ParserCombinators.Kangaroo.Prim
) where
import Data.ParserCombinators.Kangaroo.Combinators
import Data.ParserCombinators.Kangaroo.ParseMonad
import Data.ParserCombinators.Kangaroo.Prim
import Data.ParserCombinators.Kangaroo.Utils
import Control.Monad
type Kangaroo st a = GenKangaroo st a
parse :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a)
parse = evalKangaroo
runKangaroo :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a,st)
runKangaroo p st filename = runGenKangaroo p st filename
evalKangaroo :: Kangaroo st a -> st -> FilePath -> IO (Either ParseErr a)
evalKangaroo = liftM fst `ooo` runKangaroo
execKangaroo :: Kangaroo st a -> st -> FilePath -> IO st
execKangaroo = liftM snd `ooo` runKangaroo
put :: st -> Kangaroo st ()
put = putUserSt
get :: Kangaroo st st
get = getUserSt
modify :: (st -> st) -> Kangaroo st ()
modify = modifyUserSt
gets :: (st -> a) -> Kangaroo st a
gets f = liftM f get