Safe Haskell | None |
---|---|
Language | Haskell98 |
By Chris Kuklewicz, drawing heavily from binary and binary-strict, but all the bugs are my own.
This file is under the usual BSD3 licence, copyright 2008.
Modified the monad to be strict for version 2.0.0
This started out as an improvement to
Data.Binary.Strict.IncrementalGet with slightly better internals.
The simplified Get
, runGet
, Result
trio with the
Data.Binary.Strict.Class.BinaryParser instance are an _untested_
upgrade from IncrementalGet. Especially untested are the
strictness properties.
Get
usefully implements Applicative and Monad, MonadError,
Alternative and MonadPlus. Unhandled errors are reported along
with the number of bytes successfully consumed. Effects of
suspend
and putAvailable
are visible after
failthrowErrormzero.
Each time the parser reaches the end of the input it will return a Partial wrapped continuation which requests a (Maybe Lazy.ByteString). Passing (Just bs) will append bs to the input so far and continue processing. If you pass Nothing to the continuation then you are declaring that there will never be more input and that the parser should never again return a partial contination; it should return failure or finished.
suspendUntilComplete
repeatedly uses a partial continuation to
ask for more input until Nothing
is passed and then it proceeds
with parsing.
The getAvailable
command returns the lazy byte string the parser
has remaining before calling suspend
. The putAvailable
replaces this input and is a bit fancy: it also replaces the input
at the current offset for all the potential catchError/mplus
handlers. This change is _not_ reverted by failthrowErrormzero.
The three lookAhead
and lookAheadM
and lookAheadE
functions are
very similar to the ones in binary's Data.Binary.Get.
Add specialized high-bit-run
- data Get a
- runGet :: Get a -> ByteString -> Result a
- runGetAll :: Get a -> ByteString -> Result a
- data Result a
- = Failed !Int64 String
- | Finished !ByteString !Int64 a
- | Partial (Maybe ByteString -> Result a)
- ensureBytes :: Int64 -> Get ()
- getStorable :: forall a. Storable a => Get a
- getLazyByteString :: Int64 -> Get ByteString
- suspendUntilComplete :: Get ()
- getAvailable :: Get ByteString
- putAvailable :: ByteString -> Get ()
- lookAhead :: Get a -> Get a
- lookAheadM :: Get (Maybe a) -> Get (Maybe a)
- lookAheadE :: Get (Either a b) -> Get (Either a b)
- skip :: Int64 -> Get ()
- bytesRead :: Get Int64
- isEmpty :: Get Bool
- isReallyEmpty :: Get Bool
- remaining :: Get Int64
- spanOf :: (Word8 -> Bool) -> Get ByteString
- highBitRun :: Get Int64
- getWord8 :: Get Word8
- getByteString :: Int -> Get ByteString
- getWord16be :: Get Word16
- getWord32be :: Get Word32
- getWord64be :: Get Word64
- getWord16le :: Get Word16
- getWord32le :: Get Word32
- getWord64le :: Get Word64
- getWordhost :: Get Word
- getWord16host :: Get Word16
- getWord32host :: Get Word32
- getWord64host :: Get Word64
- decode7 :: forall s. (Integral s, Bits s) => Get s
- decode7size :: Get Int64
- decode7unrolled :: forall s. (Num s, Integral s, Bits s) => Get s
Documentation
runGetAll :: Get a -> ByteString -> Result a Source
runGetAll
is the simple executor, and will not ask for any continuation because this lazy bytestring is all the input
Failed !Int64 String | |
Finished !ByteString !Int64 a | |
Partial (Maybe ByteString -> Result a) |
ensureBytes :: Int64 -> Get () Source
check that there are at least n
bytes available in the input.
This will suspend if there is to little data.
getStorable :: forall a. Storable a => Get a Source
getLazyByteString :: Int64 -> Get ByteString Source
Pull n
bytes from the input, as a lazy ByteString. This will
suspend if there is too little data.
suspendUntilComplete :: Get () Source
Keep calling suspend
until Nothing is passed to the Partial
continuation. This ensures all the data has been loaded into the
state of the parser.
getAvailable :: Get ByteString Source
Get the input currently available to the parser.
putAvailable :: ByteString -> Get () Source
putAvailable
replaces the bytestream past the current # of read
bytes. This will also affect pending MonadError handler and
MonadPlus branches. I think all pending branches have to have
fewer bytesRead than the current one. If this is wrong then an
error will be thrown.
WARNING : putAvailable
is still untested.
lookAhead :: Get a -> Get a Source
lookAhead
runs the todo
action and then rewinds only the
BinaryParser state. Any new input from suspend
or changes from
putAvailable
are kept. Changes to the user state (MonadState)
are kept. The MonadWriter output is retained.
If an error is thrown then the entire monad state is reset to last catchError as usual.
lookAheadM :: Get (Maybe a) -> Get (Maybe a) Source
lookAheadM
runs the todo
action. If the action returns Nothing
then the
BinaryParser state is rewound (as in lookAhead
). If the action return Just
then
the BinaryParser is not rewound, and lookAheadM acts as an identity.
If an error is thrown then the entire monad state is reset to last catchError as usual.
lookAheadE :: Get (Either a b) -> Get (Either a b) Source
lookAheadE
runs the todo
action. If the action returns Left
then the
BinaryParser state is rewound (as in lookAhead
). If the action return Right
then
the BinaryParser is not rewound, and lookAheadE acts as an identity.
If an error is thrown then the entire monad state is reset to last catchError as usual.
Return True if the number of bytes remaining
is 0. Any futher
attempts to read an empty parser will call suspend
which might
result in more input to consume.
Compare with isReallyEmpty
isReallyEmpty :: Get Bool Source
Return True if the input is exhausted and will never be added to. Returns False if there is input left to consume.
Compare with isEmpty
Return the number of bytes remaining
before the current input
runs out and suspend
might be called.
spanOf :: (Word8 -> Bool) -> Get ByteString Source
get the longest prefix of the input where all the bytes satisfy the predicate.
highBitRun :: Get Int64 Source
get the longest prefix of the input where the high bit is set as well as following byte. This made getVarInt slower.
getByteString :: Int -> Get ByteString Source
Pull n
bytes from the input, as a strict ByteString. This will
suspend if there is too little data. If the result spans multiple
lazy chunks then the result occupies a freshly allocated strict
bytestring, otherwise it fits in a single chunk and refers to the
same immutable memory block as the whole chunk.
getWordhost :: Get Word Source