-- |
-- Module      : Data.ByteArray.Parse
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- A very simple bytearray parser related to Parsec and Attoparsec
--
-- Simple example:
--
-- > > parse ((,,) <$> take 2 <*> byte 0x20 <*> (bytes "abc" *> anyByte)) "xx abctest"
-- > ParseOK "est" ("xx", 116)
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.ByteArray.Parse
    ( Parser
    , Result(..)
    -- * run the Parser
    , parse
    , parseFeed
    -- * Parser methods
    , hasMore
    , byte
    , anyByte
    , bytes
    , take
    , takeWhile
    , takeAll
    , skip
    , skipWhile
    , skipAll
    , takeStorable
    ) where

import           Control.Monad
import qualified Control.Monad.Fail as Fail
import           Foreign.Storable              (Storable, peek, sizeOf)
import           Data.Word

import           Data.Memory.Internal.Imports
import           Data.Memory.Internal.Compat
import           Data.ByteArray.Types          (ByteArrayAccess, ByteArray)
import qualified Data.ByteArray.Types     as B
import qualified Data.ByteArray.Methods   as B

import           Prelude hiding (take, takeWhile)

-- | Simple parsing result, that represent respectively:
--
-- * failure: with the error message
--
-- * continuation: that need for more input data
--
-- * success: the remaining unparsed data and the parser value
data Result byteArray a =
      ParseFail String
    | ParseMore (Maybe byteArray -> Result byteArray a)
    | ParseOK   byteArray a

instance (Show ba, Show a) => Show (Result ba a) where
    show :: Result ba a -> String
show (ParseFail String
err) = String
"ParseFailure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
    show (ParseMore Maybe ba -> Result ba a
_)   = String
"ParseMore _"
    show (ParseOK ba
b a
a)   = String
"ParseOK " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ba -> String
forall a. Show a => a -> String
show ba
b

-- | The continuation of the current buffer, and the error string
type Failure byteArray r = byteArray -> String -> Result byteArray r

-- | The continuation of the next buffer value, and the parsed value
type Success byteArray a r = byteArray -> a -> Result byteArray r

-- | Simple ByteString parser structure
newtype Parser byteArray a = Parser
    { Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser :: forall r . byteArray
                           -> Failure byteArray r
                           -> Success byteArray a r
                           -> Result byteArray r }

instance Functor (Parser byteArray) where
    fmap :: (a -> b) -> Parser byteArray a -> Parser byteArray b
fmap a -> b
f Parser byteArray a
p = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray b r
 -> Result byteArray r)
-> Parser byteArray b
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray b r
  -> Result byteArray r)
 -> Parser byteArray b)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray b r
    -> Result byteArray r)
-> Parser byteArray b
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray b r
ok ->
        Parser byteArray a
-> byteArray
-> Failure byteArray r
-> Success byteArray a r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray a
p byteArray
buf Failure byteArray r
err (\byteArray
b a
a -> Success byteArray b r
ok byteArray
b (a -> b
f a
a))
instance Applicative (Parser byteArray) where
    pure :: a -> Parser byteArray a
pure a
v    = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray a r
  -> Result byteArray r)
 -> Parser byteArray a)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray a r
    -> Result byteArray r)
-> Parser byteArray a
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
_ Success byteArray a r
ok -> Success byteArray a r
ok byteArray
buf a
v
    <*> :: Parser byteArray (a -> b)
-> Parser byteArray a -> Parser byteArray b
(<*>) Parser byteArray (a -> b)
d Parser byteArray a
e = Parser byteArray (a -> b)
d Parser byteArray (a -> b)
-> ((a -> b) -> Parser byteArray b) -> Parser byteArray b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
b -> Parser byteArray a
e Parser byteArray a
-> (a -> Parser byteArray b) -> Parser byteArray b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> b -> Parser byteArray b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
instance Monad (Parser byteArray) where
#if !(MIN_VERSION_base(4,13,0))
    fail          = Fail.fail
#endif
    return :: a -> Parser byteArray a
return        = a -> Parser byteArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Parser byteArray a
m >>= :: Parser byteArray a
-> (a -> Parser byteArray b) -> Parser byteArray b
>>= a -> Parser byteArray b
k       = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray b r
 -> Result byteArray r)
-> Parser byteArray b
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray b r
  -> Result byteArray r)
 -> Parser byteArray b)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray b r
    -> Result byteArray r)
-> Parser byteArray b
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray b r
ok ->
         Parser byteArray a
-> byteArray
-> Failure byteArray r
-> Success byteArray a r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray a
m byteArray
buf Failure byteArray r
err (\byteArray
buf' a
a -> Parser byteArray b
-> byteArray
-> Failure byteArray r
-> Success byteArray b r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (a -> Parser byteArray b
k a
a) byteArray
buf' Failure byteArray r
err Success byteArray b r
ok)
instance Fail.MonadFail (Parser byteArray) where
    fail :: String -> Parser byteArray a
fail String
errorMsg = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray a r
  -> Result byteArray r)
 -> Parser byteArray a)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray a r
    -> Result byteArray r)
-> Parser byteArray a
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray a r
_ -> Failure byteArray r
err byteArray
buf (String
"Parser failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errorMsg)
instance MonadPlus (Parser byteArray) where
    mzero :: Parser byteArray a
mzero = String -> Parser byteArray a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"MonadPlus.mzero"
    mplus :: Parser byteArray a -> Parser byteArray a -> Parser byteArray a
mplus Parser byteArray a
f Parser byteArray a
g = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray a r
  -> Result byteArray r)
 -> Parser byteArray a)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray a r
    -> Result byteArray r)
-> Parser byteArray a
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray a r
ok ->
        -- rewrite the err callback of @f to call @g
        Parser byteArray a
-> byteArray
-> Failure byteArray r
-> Success byteArray a r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray a
f byteArray
buf (\byteArray
_ String
_ -> Parser byteArray a
-> byteArray
-> Failure byteArray r
-> Success byteArray a r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray a
g byteArray
buf Failure byteArray r
err Success byteArray a r
ok) Success byteArray a r
ok
instance Alternative (Parser byteArray) where
    empty :: Parser byteArray a
empty = String -> Parser byteArray a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Alternative.empty"
    <|> :: Parser byteArray a -> Parser byteArray a -> Parser byteArray a
(<|>) = Parser byteArray a -> Parser byteArray a -> Parser byteArray a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

-- | Run a parser on an @initial byteArray.
--
-- If the Parser need more data than available, the @feeder function
-- is automatically called and fed to the More continuation.
parseFeed :: (ByteArrayAccess byteArray, Monad m)
          => m (Maybe byteArray)
          -> Parser byteArray a
          -> byteArray
          -> m (Result byteArray a)
parseFeed :: m (Maybe byteArray)
-> Parser byteArray a -> byteArray -> m (Result byteArray a)
parseFeed m (Maybe byteArray)
feeder Parser byteArray a
p byteArray
initial = Result byteArray a -> m (Result byteArray a)
forall a. Result byteArray a -> m (Result byteArray a)
loop (Result byteArray a -> m (Result byteArray a))
-> Result byteArray a -> m (Result byteArray a)
forall a b. (a -> b) -> a -> b
$ Parser byteArray a -> byteArray -> Result byteArray a
forall byteArray a.
ByteArrayAccess byteArray =>
Parser byteArray a -> byteArray -> Result byteArray a
parse Parser byteArray a
p byteArray
initial
  where loop :: Result byteArray a -> m (Result byteArray a)
loop (ParseMore Maybe byteArray -> Result byteArray a
k) = m (Maybe byteArray)
feeder m (Maybe byteArray)
-> (Maybe byteArray -> m (Result byteArray a))
-> m (Result byteArray a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Result byteArray a -> m (Result byteArray a)
loop (Result byteArray a -> m (Result byteArray a))
-> (Maybe byteArray -> Result byteArray a)
-> Maybe byteArray
-> m (Result byteArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe byteArray -> Result byteArray a
k)
        loop Result byteArray a
r             = Result byteArray a -> m (Result byteArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result byteArray a
r

-- | Run a Parser on a ByteString and return a 'Result'
parse :: ByteArrayAccess byteArray
      => Parser byteArray a -> byteArray -> Result byteArray a
parse :: Parser byteArray a -> byteArray -> Result byteArray a
parse Parser byteArray a
p byteArray
s = Parser byteArray a
-> byteArray
-> Failure byteArray a
-> Success byteArray a a
-> Result byteArray a
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray a
p byteArray
s (\byteArray
_ String
msg -> String -> Result byteArray a
forall byteArray a. String -> Result byteArray a
ParseFail String
msg) (\byteArray
b a
a -> Success byteArray a a
forall byteArray a. byteArray -> a -> Result byteArray a
ParseOK byteArray
b a
a)

------------------------------------------------------------

-- When needing more data, getMore append the next data
-- to the current buffer. if no further data, then
-- the err callback is called.
getMore :: ByteArray byteArray => Parser byteArray ()
getMore :: Parser byteArray ()
getMore = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok -> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall byteArray a.
(Maybe byteArray -> Result byteArray a) -> Result byteArray a
ParseMore ((Maybe byteArray -> Result byteArray r) -> Result byteArray r)
-> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall a b. (a -> b) -> a -> b
$ \Maybe byteArray
nextChunk ->
    case Maybe byteArray
nextChunk of
        Maybe byteArray
Nothing -> Failure byteArray r
err byteArray
buf String
"EOL: need more data"
        Just byteArray
nc
            | byteArray -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null byteArray
nc -> Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore byteArray
buf Failure byteArray r
err Success byteArray () r
ok
            | Bool
otherwise -> Success byteArray () r
ok (byteArray -> byteArray -> byteArray
forall bs. ByteArray bs => bs -> bs -> bs
B.append byteArray
buf byteArray
nc) ()

-- Only used by takeAll, which accumulate all the remaining data
-- until ParseMore is fed a Nothing value.
--
-- getAll cannot fail.
getAll :: ByteArray byteArray => Parser byteArray ()
getAll :: Parser byteArray ()
getAll = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok -> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall byteArray a.
(Maybe byteArray -> Result byteArray a) -> Result byteArray a
ParseMore ((Maybe byteArray -> Result byteArray r) -> Result byteArray r)
-> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall a b. (a -> b) -> a -> b
$ \Maybe byteArray
nextChunk ->
    case Maybe byteArray
nextChunk of
        Maybe byteArray
Nothing -> Success byteArray () r
ok byteArray
buf ()
        Just byteArray
nc -> Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getAll (byteArray -> byteArray -> byteArray
forall bs. ByteArray bs => bs -> bs -> bs
B.append byteArray
buf byteArray
nc) Failure byteArray r
err Success byteArray () r
ok

-- Only used by skipAll, which flush all the remaining data
-- until ParseMore is fed a Nothing value.
--
-- flushAll cannot fail.
flushAll :: ByteArray byteArray => Parser byteArray ()
flushAll :: Parser byteArray ()
flushAll = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok -> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall byteArray a.
(Maybe byteArray -> Result byteArray a) -> Result byteArray a
ParseMore ((Maybe byteArray -> Result byteArray r) -> Result byteArray r)
-> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall a b. (a -> b) -> a -> b
$ \Maybe byteArray
nextChunk ->
    case Maybe byteArray
nextChunk of
        Maybe byteArray
Nothing -> Success byteArray () r
ok byteArray
buf ()
        Just byteArray
_  -> Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
flushAll byteArray
forall a. ByteArray a => a
B.empty Failure byteArray r
err Success byteArray () r
ok

------------------------------------------------------------
hasMore :: ByteArray byteArray => Parser byteArray Bool
hasMore :: Parser byteArray Bool
hasMore = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray Bool r
 -> Result byteArray r)
-> Parser byteArray Bool
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray Bool r
  -> Result byteArray r)
 -> Parser byteArray Bool)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray Bool r
    -> Result byteArray r)
-> Parser byteArray Bool
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray Bool r
ok ->
    if byteArray -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null byteArray
buf
        then (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall byteArray a.
(Maybe byteArray -> Result byteArray a) -> Result byteArray a
ParseMore ((Maybe byteArray -> Result byteArray r) -> Result byteArray r)
-> (Maybe byteArray -> Result byteArray r) -> Result byteArray r
forall a b. (a -> b) -> a -> b
$ \Maybe byteArray
nextChunk ->
                case Maybe byteArray
nextChunk of
                    Maybe byteArray
Nothing -> Success byteArray Bool r
ok byteArray
buf Bool
False
                    Just byteArray
nc -> Parser byteArray Bool
-> byteArray
-> Failure byteArray r
-> Success byteArray Bool r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray Bool
forall byteArray. ByteArray byteArray => Parser byteArray Bool
hasMore byteArray
nc Failure byteArray r
err Success byteArray Bool r
ok
        else Success byteArray Bool r
ok byteArray
buf Bool
True

-- | Get the next byte from the parser
anyByte :: ByteArray byteArray => Parser byteArray Word8
anyByte :: Parser byteArray Word8
anyByte = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray Word8 r
 -> Result byteArray r)
-> Parser byteArray Word8
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray Word8 r
  -> Result byteArray r)
 -> Parser byteArray Word8)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray Word8 r
    -> Result byteArray r)
-> Parser byteArray Word8
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray Word8 r
ok ->
    case byteArray -> Maybe (Word8, byteArray)
forall a. ByteArray a => a -> Maybe (Word8, a)
B.uncons byteArray
buf of
        Maybe (Word8, byteArray)
Nothing      -> Parser byteArray Word8
-> byteArray
-> Failure byteArray r
-> Success byteArray Word8 r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray ()
-> Parser byteArray Word8 -> Parser byteArray Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser byteArray Word8
forall byteArray. ByteArray byteArray => Parser byteArray Word8
anyByte) byteArray
buf Failure byteArray r
err Success byteArray Word8 r
ok
        Just (Word8
c1,byteArray
b2) -> Success byteArray Word8 r
ok byteArray
b2 Word8
c1

-- | Parse a specific byte at current position
--
-- if the byte is different than the expected on,
-- this parser will raise a failure.
byte :: ByteArray byteArray => Word8 -> Parser byteArray ()
byte :: Word8 -> Parser byteArray ()
byte Word8
w = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok ->
    case byteArray -> Maybe (Word8, byteArray)
forall a. ByteArray a => a -> Maybe (Word8, a)
B.uncons byteArray
buf of
        Maybe (Word8, byteArray)
Nothing      -> Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray () -> Parser byteArray () -> Parser byteArray ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Parser byteArray ()
forall byteArray.
ByteArray byteArray =>
Word8 -> Parser byteArray ()
byte Word8
w) byteArray
buf Failure byteArray r
err Success byteArray () r
ok
        Just (Word8
c1,byteArray
b2) | Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w   -> Success byteArray () r
ok byteArray
b2 ()
                     | Bool
otherwise -> Failure byteArray r
err byteArray
buf (String
"byte " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : failed : got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c1)

-- | Parse a sequence of bytes from current position
--
-- if the following bytes don't match the expected
-- bytestring completely, the parser will raise a failure
bytes :: (Show ba, Eq ba, ByteArray ba) => ba -> Parser ba ()
bytes :: ba -> Parser ba ()
bytes ba
allExpected = ba -> Parser ba ()
forall byteArray.
ByteArray byteArray =>
byteArray -> Parser byteArray ()
consumeEq ba
allExpected
  where errMsg :: String
errMsg = String
"bytes " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ba -> String
forall a. Show a => a -> String
show ba
allExpected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : failed"

        -- partially consume as much as possible or raise an error.
        consumeEq :: byteArray -> Parser byteArray ()
consumeEq byteArray
expected = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
actual Failure byteArray r
err Success byteArray () r
ok ->
            let eLen :: Int
eLen = byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
expected in
            if byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
actual Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
eLen
                then    -- enough data for doing a full match
                        let (byteArray
aMatch,byteArray
aRem) = Int -> byteArray -> (byteArray, byteArray)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
eLen byteArray
actual
                         in if byteArray
aMatch byteArray -> byteArray -> Bool
forall a. Eq a => a -> a -> Bool
== byteArray
expected
                                then Success byteArray () r
ok byteArray
aRem ()
                                else Failure byteArray r
err byteArray
actual String
errMsg
                else    -- not enough data, match as much as we have, and then recurse.
                        let (byteArray
eMatch, byteArray
eRem) = Int -> byteArray -> (byteArray, byteArray)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
actual) byteArray
expected
                         in if byteArray
actual byteArray -> byteArray -> Bool
forall a. Eq a => a -> a -> Bool
== byteArray
eMatch
                                then Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray () -> Parser byteArray () -> Parser byteArray ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> byteArray -> Parser byteArray ()
consumeEq byteArray
eRem) byteArray
forall a. ByteArray a => a
B.empty Failure byteArray r
err Success byteArray () r
ok
                                else Failure byteArray r
err byteArray
actual String
errMsg

------------------------------------------------------------

-- | Take a storable from the current position in the stream
takeStorable :: (ByteArray byteArray, Storable d)
             => Parser byteArray d
takeStorable :: Parser byteArray d
takeStorable = d -> Parser byteArray d
forall byteArray d.
(ByteArray byteArray, Storable d) =>
d -> Parser byteArray d
anyStorable d
forall a. HasCallStack => a
undefined
  where
    anyStorable :: ByteArray byteArray => Storable d => d -> Parser byteArray d
    anyStorable :: d -> Parser byteArray d
anyStorable d
a = do
        byteArray
buf <- Int -> Parser byteArray byteArray
forall byteArray.
ByteArray byteArray =>
Int -> Parser byteArray byteArray
take (d -> Int
forall a. Storable a => a -> Int
sizeOf d
a)
        d -> Parser byteArray d
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> Parser byteArray d) -> d -> Parser byteArray d
forall a b. (a -> b) -> a -> b
$ IO d -> d
forall a. IO a -> a
unsafeDoIO (IO d -> d) -> IO d -> d
forall a b. (a -> b) -> a -> b
$ byteArray -> (Ptr d -> IO d) -> IO d
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray byteArray
buf ((Ptr d -> IO d) -> IO d) -> (Ptr d -> IO d) -> IO d
forall a b. (a -> b) -> a -> b
$ \Ptr d
ptr -> Ptr d -> IO d
forall a. Storable a => Ptr a -> IO a
peek Ptr d
ptr

-- | Take @n bytes from the current position in the stream
take :: ByteArray byteArray => Int -> Parser byteArray byteArray
take :: Int -> Parser byteArray byteArray
take Int
n = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray byteArray r
 -> Result byteArray r)
-> Parser byteArray byteArray
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray byteArray r
  -> Result byteArray r)
 -> Parser byteArray byteArray)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray byteArray r
    -> Result byteArray r)
-> Parser byteArray byteArray
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok ->
    if byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
        then let (byteArray
b1,byteArray
b2) = Int -> byteArray -> (byteArray, byteArray)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
n byteArray
buf in Success byteArray byteArray r
ok byteArray
b2 byteArray
b1
        else Parser byteArray byteArray
-> byteArray
-> Failure byteArray r
-> Success byteArray byteArray r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray ()
-> Parser byteArray byteArray -> Parser byteArray byteArray
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser byteArray byteArray
forall byteArray.
ByteArray byteArray =>
Int -> Parser byteArray byteArray
take Int
n) byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok

-- | Take bytes while the @predicate hold from the current position in the stream
takeWhile :: ByteArray byteArray => (Word8 -> Bool) -> Parser byteArray byteArray
takeWhile :: (Word8 -> Bool) -> Parser byteArray byteArray
takeWhile Word8 -> Bool
predicate = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray byteArray r
 -> Result byteArray r)
-> Parser byteArray byteArray
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray byteArray r
  -> Result byteArray r)
 -> Parser byteArray byteArray)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray byteArray r
    -> Result byteArray r)
-> Parser byteArray byteArray
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok ->
    let (byteArray
b1, byteArray
b2) = (Word8 -> Bool) -> byteArray -> (byteArray, byteArray)
forall bs. ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs)
B.span Word8 -> Bool
predicate byteArray
buf
     in if byteArray -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null byteArray
b2
            then Parser byteArray byteArray
-> byteArray
-> Failure byteArray r
-> Success byteArray byteArray r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray ()
-> Parser byteArray byteArray -> Parser byteArray byteArray
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Bool) -> Parser byteArray byteArray
forall byteArray.
ByteArray byteArray =>
(Word8 -> Bool) -> Parser byteArray byteArray
takeWhile Word8 -> Bool
predicate) byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok
            else Success byteArray byteArray r
ok byteArray
b2 byteArray
b1

-- | Take the remaining bytes from the current position in the stream
takeAll :: ByteArray byteArray => Parser byteArray byteArray
takeAll :: Parser byteArray byteArray
takeAll = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray byteArray r
 -> Result byteArray r)
-> Parser byteArray byteArray
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray byteArray r
  -> Result byteArray r)
 -> Parser byteArray byteArray)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray byteArray r
    -> Result byteArray r)
-> Parser byteArray byteArray
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok ->
    Parser byteArray byteArray
-> byteArray
-> Failure byteArray r
-> Success byteArray byteArray r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getAll Parser byteArray ()
-> Parser byteArray byteArray -> Parser byteArray byteArray
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser byteArray byteArray
returnBuffer) byteArray
buf Failure byteArray r
err Success byteArray byteArray r
ok
  where
    returnBuffer :: Parser byteArray byteArray
returnBuffer = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray byteArray r
 -> Result byteArray r)
-> Parser byteArray byteArray
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray byteArray r
  -> Result byteArray r)
 -> Parser byteArray byteArray)
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray byteArray r
    -> Result byteArray r)
-> Parser byteArray byteArray
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
_ Success byteArray byteArray r
ok -> Success byteArray byteArray r
ok byteArray
forall a. ByteArray a => a
B.empty byteArray
buf

-- | Skip @n bytes from the current position in the stream
skip :: ByteArray byteArray => Int -> Parser byteArray ()
skip :: Int -> Parser byteArray ()
skip Int
n = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok ->
    if byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
        then Success byteArray () r
ok (Int -> byteArray -> byteArray
forall bs. ByteArray bs => Int -> bs -> bs
B.drop Int
n byteArray
buf) ()
        else Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray () -> Parser byteArray () -> Parser byteArray ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser byteArray ()
forall byteArray. ByteArray byteArray => Int -> Parser byteArray ()
skip (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- byteArray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length byteArray
buf)) byteArray
forall a. ByteArray a => a
B.empty Failure byteArray r
err Success byteArray () r
ok

-- | Skip bytes while the @predicate hold from the current position in the stream
skipWhile :: ByteArray byteArray => (Word8 -> Bool) -> Parser byteArray ()
skipWhile :: (Word8 -> Bool) -> Parser byteArray ()
skipWhile Word8 -> Bool
p = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok ->
    let (byteArray
_, byteArray
b2) = (Word8 -> Bool) -> byteArray -> (byteArray, byteArray)
forall bs. ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs)
B.span Word8 -> Bool
p byteArray
buf 
     in if byteArray -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null byteArray
b2
            then Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser (Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
getMore Parser byteArray () -> Parser byteArray () -> Parser byteArray ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Bool) -> Parser byteArray ()
forall byteArray.
ByteArray byteArray =>
(Word8 -> Bool) -> Parser byteArray ()
skipWhile Word8 -> Bool
p) byteArray
forall a. ByteArray a => a
B.empty Failure byteArray r
err Success byteArray () r
ok
            else Success byteArray () r
ok byteArray
b2 ()

-- | Skip all the remaining bytes from the current position in the stream
skipAll :: ByteArray byteArray => Parser byteArray ()
skipAll :: Parser byteArray ()
skipAll = (forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray () r
 -> Result byteArray r)
-> Parser byteArray ()
forall byteArray a.
(forall r.
 byteArray
 -> Failure byteArray r
 -> Success byteArray a r
 -> Result byteArray r)
-> Parser byteArray a
Parser ((forall r.
  byteArray
  -> Failure byteArray r
  -> Success byteArray () r
  -> Result byteArray r)
 -> Parser byteArray ())
-> (forall r.
    byteArray
    -> Failure byteArray r
    -> Success byteArray () r
    -> Result byteArray r)
-> Parser byteArray ()
forall a b. (a -> b) -> a -> b
$ \byteArray
buf Failure byteArray r
err Success byteArray () r
ok -> Parser byteArray ()
-> byteArray
-> Failure byteArray r
-> Success byteArray () r
-> Result byteArray r
forall byteArray a.
Parser byteArray a
-> forall r.
   byteArray
   -> Failure byteArray r
   -> Success byteArray a r
   -> Result byteArray r
runParser Parser byteArray ()
forall byteArray. ByteArray byteArray => Parser byteArray ()
flushAll byteArray
buf Failure byteArray r
err Success byteArray () r
ok