Portability | to be determined. |
---|---|
Stability | highly unstable |
Maintainer | Stephen Tetley <stephen.tetley@gmail.com> |
Data.ParserCombinators.KangarooRWS
Description
Kangaroo parse monad with user env, logging and state.
- satisfy :: (Word8 -> Bool) -> GenKangaroo ust Word8
- manyTill :: GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust [a]
- genericManyTill :: (a -> c -> c) -> c -> GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust c
- manyTillPC :: GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust ([a], a)
- genericManyTillPC :: (a -> b -> b) -> b -> GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust (b, a)
- count :: Int -> GenKangaroo ust a -> GenKangaroo ust [a]
- countPrefixed :: Integral i => GenKangaroo ust i -> GenKangaroo ust a -> GenKangaroo ust (i, [a])
- genericCount :: (a -> b -> b) -> b -> Int -> GenKangaroo ust a -> GenKangaroo ust b
- runOn :: GenKangaroo ust a -> GenKangaroo ust [a]
- genericRunOn :: (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust b
- postCheck :: GenKangaroo ust a -> (a -> Bool) -> String -> GenKangaroo ust a
- buildWhile :: (a -> Bool) -> (a -> b -> b) -> (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust b
- buildPrimitive :: Int -> (Word8 -> Bool) -> (Word8 -> b -> b) -> b -> GenKangaroo ust b
- data GenKangaroo ust a
- type ParseErr = String
- data RegionCoda
- type RegionName = String
- getUserSt :: GenKangaroo ust ust
- putUserSt :: ust -> GenKangaroo ust ()
- modifyUserSt :: (ust -> ust) -> GenKangaroo ust ()
- throwErr :: ParseErr -> GenKangaroo ust a
- liftIOAction :: IO a -> GenKangaroo ust a
- withSuccess :: Bool -> ParseErr -> GenKangaroo ust a -> GenKangaroo ust a
- runGenKangaroo :: GenKangaroo ust a -> ust -> FilePath -> IO (Either ParseErr a, ust)
- reportError :: ParseErr -> GenKangaroo ust a
- substError :: GenKangaroo ust a -> ParseErr -> GenKangaroo ust a
- word8 :: GenKangaroo ust Word8
- checkWord8 :: (Word8 -> Bool) -> GenKangaroo ust (Maybe Word8)
- opt :: GenKangaroo ust a -> GenKangaroo ust (Maybe a)
- position :: GenKangaroo ust Int
- region :: GenKangaroo ust (Int, Int, Int)
- atEnd :: GenKangaroo ust Bool
- lengthRemaining :: GenKangaroo ust Int
- regionSize :: GenKangaroo ust Int
- intraparse :: RegionName -> RegionCoda -> RegionStart -> Int -> GenKangaroo ust a -> GenKangaroo ust a
- advance :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust a
- advanceRelative :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust a
- restrict :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust a
- restrictToPos :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust a
- printHexAll :: GenKangaroo ust ()
- printRegionStack :: GenKangaroo ust ()
- cstring :: GenKangaroo ust String
- w8Zero :: GenKangaroo ust Word8
- getBytes :: Integral a => a -> GenKangaroo ust [Word8]
- char :: GenKangaroo ust Char
- text :: Int -> GenKangaroo ust String
- int8 :: GenKangaroo ust Int8
- word16be :: GenKangaroo ust Word16
- word32be :: GenKangaroo ust Word32
- word64be :: GenKangaroo ust Word64
- word16le :: GenKangaroo ust Word16
- word32le :: GenKangaroo ust Word32
- int16be :: GenKangaroo ust Int16
- int32be :: GenKangaroo ust Int32
- int16le :: GenKangaroo ust Int16
- int32le :: GenKangaroo ust Int32
- ieeeFloatSP :: Fractional a => GenKangaroo ust a
- type Kangaroo r w st a = GenKangaroo (r, w, st) a
- parse :: Monoid w => Kangaroo r w st a -> r -> st -> FilePath -> IO (Either ParseErr a)
- runKangaroo :: Monoid w => Kangaroo r w st a -> r -> st -> FilePath -> IO (Either ParseErr a, w, st)
- evalKangaroo :: Monoid w => Kangaroo r w st a -> r -> st -> FilePath -> IO (Either ParseErr a, w)
- execKangaroo :: Monoid w => Kangaroo r w st a -> r -> st -> FilePath -> IO st
- put :: st -> Kangaroo r w st ()
- get :: Kangaroo r w st st
- modify :: (st -> st) -> Kangaroo r w st ()
- gets :: (st -> a) -> Kangaroo r w st a
- tell :: Monoid w => w -> Kangaroo r w st ()
- ask :: Kangaroo r w st r
Documentation
manyTill :: GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust [a]Source
genericManyTill :: (a -> c -> c) -> c -> GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust cSource
manyTillPC :: GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust ([a], a)Source
genericManyTillPC :: (a -> b -> b) -> b -> GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust (b, a)Source
count :: Int -> GenKangaroo ust a -> GenKangaroo ust [a]Source
countPrefixed :: Integral i => GenKangaroo ust i -> GenKangaroo ust a -> GenKangaroo ust (i, [a])Source
genericCount :: (a -> b -> b) -> b -> Int -> GenKangaroo ust a -> GenKangaroo ust bSource
runOn :: GenKangaroo ust a -> GenKangaroo ust [a]Source
genericRunOn :: (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust bSource
postCheck :: GenKangaroo ust a -> (a -> Bool) -> String -> GenKangaroo ust aSource
Apply parse then apply the check, if the check fails report the error message.
buildWhile :: (a -> Bool) -> (a -> b -> b) -> (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust bSource
Build a value by while the test holds. When the test fails
the position is not backtracked, instead we use the "failing"
element with lastOp
potentially still building the value
with it.
buildPrimitive :: Int -> (Word8 -> Bool) -> (Word8 -> b -> b) -> b -> GenKangaroo ust bSource
data GenKangaroo ust a Source
Instances
Monad (GenKangaroo ust) | |
Functor (GenKangaroo ust) | |
Applicative (GenKangaroo ust) |
data RegionCoda Source
RegionCoda
- represents three useful final positions:
- dalpunto - 'from the point' - Run the parser within a region and return to where you came from.
- alfermata - 'to the stop' - Run the parser within a region, the cursor remains wherever the parse finished.
- alfine - 'to the end' - Run the parser within a region and jump to the right-end of the region after the parse.
Instances
type RegionName = StringSource
getUserSt :: GenKangaroo ust ustSource
putUserSt :: ust -> GenKangaroo ust ()Source
modifyUserSt :: (ust -> ust) -> GenKangaroo ust ()Source
throwErr :: ParseErr -> GenKangaroo ust aSource
liftIOAction :: IO a -> GenKangaroo ust aSource
withSuccess :: Bool -> ParseErr -> GenKangaroo ust a -> GenKangaroo ust aSource
runGenKangaroo :: GenKangaroo ust a -> ust -> FilePath -> IO (Either ParseErr a, ust)Source
reportError :: ParseErr -> GenKangaroo ust aSource
substError :: GenKangaroo ust a -> ParseErr -> GenKangaroo ust aSource
Primitive parsers
word8 :: GenKangaroo ust Word8Source
checkWord8 :: (Word8 -> Bool) -> GenKangaroo ust (Maybe Word8)Source
opt :: GenKangaroo ust a -> GenKangaroo ust (Maybe a)Source
Query the cursor position
position :: GenKangaroo ust IntSource
position
: -> cursor-position
Return the current cursor position
region :: GenKangaroo ust (Int, Int, Int)Source
region
: -> (region-start, cursor-position, region-end)
Return the current parse region and the current position of the cursor within it.
atEnd :: GenKangaroo ust BoolSource
atEnd
- is the cursor at the end of the current region?
lengthRemaining :: GenKangaroo ust IntSource
lengthRemaining
: -> distance-to-region-end
Distance from the current cursor position to the end of the current region
regionSize :: GenKangaroo ust IntSource
regionSize
: -> region-length
Size of the current region.
Parse within a region
intraparse :: RegionName -> RegionCoda -> RegionStart -> Int -> GenKangaroo ust a -> GenKangaroo ust aSource
intraparse
: name * coda * abs_region_start * region_length * parser -> parser
Create a new region within the current one and run the
supplied parser. The cursor position is moved to the start
of the new region. The value of coda
determines where the
cursor is positioned after a successful parse.
intraparse
throws a parse error if the supplied
absolute-region-start is not located within the current region,
or if the right-boundary of the new region
(abs_region_start + region_length
) extends beyond the
right-boundary of the current region.
advance :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust aSource
advance
: name * coda * abs_region_start * parser -> parser
A variation of intraparse
- the new region starts at the
supplied abs_region_start
and continues to the end of the
current region.
advance
throws a parse error if the new start position is
not within the current region.
advanceRelative :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust aSource
advanceRelative
: name * coda * distance * parser -> parser
A variation of advance
- the start of the new region is
calculated from the current-cursor-position
+ the supplied
distance
.
advanceRelative
throws a parse error if the new start
position is not within the current region.
restrict :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust aSource
restrict
: name * coda * distance * parser -> parser
A variation of intraparse
- create a new region as a
restriction of the current one and run the supplied parser.
The new region starts at the current coursor position, the
right-boundary is restricted to the current-cursor-position
+ the supplied distance
.
restrict
throws a parse error if the right-boundary of the
new region extends beyond the current region.
restrictToPos :: RegionName -> RegionCoda -> Int -> GenKangaroo ust a -> GenKangaroo ust aSource
restrictToPos
: region-name * coda * abs-end-pos * parser -> parser
A variantion of restrict
- the new region takes the current
cursor position for the left-boundary and the supplied
absolute-end-position (abs-end-pos
) as the right-boundary.
restrictToPos
throws a parse error if the abs-end-pos
extends beyond the right-boundary of the current region.
Debug
printHexAll :: GenKangaroo ust ()Source
printRegionStack :: GenKangaroo ust ()Source
cstring :: GenKangaroo ust StringSource
Read a null-terminated string
w8Zero :: GenKangaroo ust Word8Source
getBytes :: Integral a => a -> GenKangaroo ust [Word8]Source
char :: GenKangaroo ust CharSource
text :: Int -> GenKangaroo ust StringSource
int8 :: GenKangaroo ust Int8Source
word16be :: GenKangaroo ust Word16Source
word32be :: GenKangaroo ust Word32Source
word64be :: GenKangaroo ust Word64Source
word16le :: GenKangaroo ust Word16Source
word32le :: GenKangaroo ust Word32Source
int16be :: GenKangaroo ust Int16Source
int32be :: GenKangaroo ust Int32Source
int16le :: GenKangaroo ust Int16Source
int32le :: GenKangaroo ust Int32Source
ieeeFloatSP :: Fractional a => GenKangaroo ust aSource
type Kangaroo r w st a = GenKangaroo (r, w, st) aSource
runKangaroo :: Monoid w => Kangaroo r w st a -> r -> st -> FilePath -> IO (Either ParseErr a, w, st)Source