{-# LANGUAGE CPP #-}
module BinaryParser
(
  BinaryParser,
  run,
  failure,
  byte,
  matchingByte,
  bytesOfSize,
  bytesWhile,
  unitOfSize,
  unitOfBytes,
  unitWhile,
  remainders,
  fold,
  endOfInput,
  sized,
  -- * Extras
  storableOfSize,
  beWord16,
  leWord16,
  beWord32,
  leWord32,
  beWord64,
  leWord64,
  asciiIntegral,
)
where

import BinaryParser.Prelude hiding (fold)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.ByteString.Internal as A
import qualified BinaryParser.Prelude as B


-- |
-- A highly-efficient parser specialised for strict 'ByteString's.
-- 
-- Supports the roll-back and alternative branching
-- on the basis of the 'Alternative' interface.
-- 
-- Does not generate fancy error-messages,
-- which contributes to its efficiency.
newtype BinaryParser a =
  BinaryParser ( ByteString -> Either Text ( a , ByteString ) )
  deriving ( a -> BinaryParser b -> BinaryParser a
(a -> b) -> BinaryParser a -> BinaryParser b
(forall a b. (a -> b) -> BinaryParser a -> BinaryParser b)
-> (forall a b. a -> BinaryParser b -> BinaryParser a)
-> Functor BinaryParser
forall a b. a -> BinaryParser b -> BinaryParser a
forall a b. (a -> b) -> BinaryParser a -> BinaryParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinaryParser b -> BinaryParser a
$c<$ :: forall a b. a -> BinaryParser b -> BinaryParser a
fmap :: (a -> b) -> BinaryParser a -> BinaryParser b
$cfmap :: forall a b. (a -> b) -> BinaryParser a -> BinaryParser b
Functor , Functor BinaryParser
a -> BinaryParser a
Functor BinaryParser
-> (forall a. a -> BinaryParser a)
-> (forall a b.
    BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b)
-> (forall a b c.
    (a -> b -> c)
    -> BinaryParser a -> BinaryParser b -> BinaryParser c)
-> (forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b)
-> (forall a b. BinaryParser a -> BinaryParser b -> BinaryParser a)
-> Applicative BinaryParser
BinaryParser a -> BinaryParser b -> BinaryParser b
BinaryParser a -> BinaryParser b -> BinaryParser a
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
(a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
forall a. a -> BinaryParser a
forall a b. BinaryParser a -> BinaryParser b -> BinaryParser a
forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
forall a b c.
(a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BinaryParser a -> BinaryParser b -> BinaryParser a
$c<* :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser a
*> :: BinaryParser a -> BinaryParser b -> BinaryParser b
$c*> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
liftA2 :: (a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
<*> :: BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
$c<*> :: forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
pure :: a -> BinaryParser a
$cpure :: forall a. a -> BinaryParser a
$cp1Applicative :: Functor BinaryParser
Applicative , Applicative BinaryParser
BinaryParser a
Applicative BinaryParser
-> (forall a. BinaryParser a)
-> (forall a. BinaryParser a -> BinaryParser a -> BinaryParser a)
-> (forall a. BinaryParser a -> BinaryParser [a])
-> (forall a. BinaryParser a -> BinaryParser [a])
-> Alternative BinaryParser
BinaryParser a -> BinaryParser a -> BinaryParser a
BinaryParser a -> BinaryParser [a]
BinaryParser a -> BinaryParser [a]
forall a. BinaryParser a
forall a. BinaryParser a -> BinaryParser [a]
forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: BinaryParser a -> BinaryParser [a]
$cmany :: forall a. BinaryParser a -> BinaryParser [a]
some :: BinaryParser a -> BinaryParser [a]
$csome :: forall a. BinaryParser a -> BinaryParser [a]
<|> :: BinaryParser a -> BinaryParser a -> BinaryParser a
$c<|> :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
empty :: BinaryParser a
$cempty :: forall a. BinaryParser a
$cp1Alternative :: Applicative BinaryParser
Alternative , Applicative BinaryParser
a -> BinaryParser a
Applicative BinaryParser
-> (forall a b.
    BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b)
-> (forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b)
-> (forall a. a -> BinaryParser a)
-> Monad BinaryParser
BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
BinaryParser a -> BinaryParser b -> BinaryParser b
forall a. a -> BinaryParser a
forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
forall a b.
BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> BinaryParser a
$creturn :: forall a. a -> BinaryParser a
>> :: BinaryParser a -> BinaryParser b -> BinaryParser b
$c>> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
>>= :: BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
$c>>= :: forall a b.
BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
$cp1Monad :: Applicative BinaryParser
Monad , Monad BinaryParser
Alternative BinaryParser
BinaryParser a
Alternative BinaryParser
-> Monad BinaryParser
-> (forall a. BinaryParser a)
-> (forall a. BinaryParser a -> BinaryParser a -> BinaryParser a)
-> MonadPlus BinaryParser
BinaryParser a -> BinaryParser a -> BinaryParser a
forall a. BinaryParser a
forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: BinaryParser a -> BinaryParser a -> BinaryParser a
$cmplus :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
mzero :: BinaryParser a
$cmzero :: forall a. BinaryParser a
$cp2MonadPlus :: Monad BinaryParser
$cp1MonadPlus :: Alternative BinaryParser
MonadPlus , MonadError Text )
    via ( StateT ByteString ( Except Text ) )

type role BinaryParser representational

instance MonadFail BinaryParser where
  fail :: String -> BinaryParser a
fail = Text -> BinaryParser a
forall a. Text -> BinaryParser a
failure (Text -> BinaryParser a)
-> (String -> Text) -> String -> BinaryParser a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString

-- |
-- Apply a parser to bytes.
{-# INLINE run #-}
run :: BinaryParser a -> ByteString -> Either Text a
run :: BinaryParser a -> ByteString -> Either Text a
run (BinaryParser ByteString -> Either Text (a, ByteString)
parser) ByteString
input =
  ((a, ByteString) -> a)
-> Either Text (a, ByteString) -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ByteString) -> a
forall a b. (a, b) -> a
fst (Either Text (a, ByteString) -> Either Text a)
-> Either Text (a, ByteString) -> Either Text a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text (a, ByteString)
parser ByteString
input

-- |
-- Fail with a message.
{-# INLINE failure #-}
failure :: Text -> BinaryParser a
failure :: Text -> BinaryParser a
failure Text
text =
  (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser (Either Text (a, ByteString)
-> ByteString -> Either Text (a, ByteString)
forall a b. a -> b -> a
const (Text -> Either Text (a, ByteString)
forall a b. a -> Either a b
Left Text
text))

-- |
-- Consume a single byte.
{-# INLINE byte #-}
byte :: BinaryParser Word8
byte :: BinaryParser Word8
byte =
  (ByteString -> Either Text (Word8, ByteString))
-> BinaryParser Word8
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (Word8, ByteString))
 -> BinaryParser Word8)
-> (ByteString -> Either Text (Word8, ByteString))
-> BinaryParser Word8
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    if ByteString -> Bool
ByteString.null ByteString
remainders
      then Text -> Either Text (Word8, ByteString)
forall a b. a -> Either a b
Left Text
"End of input"
      else (Word8, ByteString) -> Either Text (Word8, ByteString)
forall a b. b -> Either a b
Right (ByteString -> Word8
ByteString.unsafeHead ByteString
remainders, Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
1 ByteString
remainders)

-- |
-- Consume a single byte, which satisfies the predicate.
{-# INLINE satisfyingByte #-}
satisfyingByte :: (Word8 -> Bool) -> BinaryParser Word8
satisfyingByte :: (Word8 -> Bool) -> BinaryParser Word8
satisfyingByte Word8 -> Bool
predicate =
  (ByteString -> Either Text (Word8, ByteString))
-> BinaryParser Word8
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (Word8, ByteString))
 -> BinaryParser Word8)
-> (ByteString -> Either Text (Word8, ByteString))
-> BinaryParser Word8
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
remainders of
      Maybe (Word8, ByteString)
Nothing -> Text -> Either Text (Word8, ByteString)
forall a b. a -> Either a b
Left Text
"End of input"
      Just (Word8
head, ByteString
tail) ->
        if Word8 -> Bool
predicate Word8
head
          then (Word8, ByteString) -> Either Text (Word8, ByteString)
forall a b. b -> Either a b
Right (Word8
head, ByteString
tail)
          else Text -> Either Text (Word8, ByteString)
forall a b. a -> Either a b
Left Text
"Byte doesn't satisfy a predicate"

-- |
-- Consume a single byte, which satisfies the predicate.
{-# INLINE matchingByte #-}
matchingByte :: (Word8 -> Either Text a) -> BinaryParser a
matchingByte :: (Word8 -> Either Text a) -> BinaryParser a
matchingByte Word8 -> Either Text a
matcher =
  (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (a, ByteString)) -> BinaryParser a)
-> (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
remainders of
      Maybe (Word8, ByteString)
Nothing -> Text -> Either Text (a, ByteString)
forall a b. a -> Either a b
Left Text
"End of input"
      Just (Word8
head, ByteString
tail) ->
        case Word8 -> Either Text a
matcher Word8
head of
          Right a
result -> (a, ByteString) -> Either Text (a, ByteString)
forall a b. b -> Either a b
Right (a
result, ByteString
tail)
          Left Text
error -> Text -> Either Text (a, ByteString)
forall a b. a -> Either a b
Left Text
error

-- |
-- Consume an amount of bytes.
{-# INLINE bytesOfSize #-}
bytesOfSize :: Int -> BinaryParser ByteString
bytesOfSize :: Int -> BinaryParser ByteString
bytesOfSize Int
size =
  (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (ByteString, ByteString))
 -> BinaryParser ByteString)
-> (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    if ByteString -> Int
ByteString.length ByteString
remainders Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
      then (ByteString, ByteString) -> Either Text (ByteString, ByteString)
forall a b. b -> Either a b
Right (Int -> ByteString -> ByteString
ByteString.unsafeTake Int
size ByteString
remainders, Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
size ByteString
remainders)
      else Text -> Either Text (ByteString, ByteString)
forall a b. a -> Either a b
Left Text
"End of input"

-- |
-- Consume multiple bytes, which satisfy the predicate.
{-# INLINE bytesWhile #-}
bytesWhile :: (Word8 -> Bool) -> BinaryParser ByteString
bytesWhile :: (Word8 -> Bool) -> BinaryParser ByteString
bytesWhile Word8 -> Bool
predicate =
  (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (ByteString, ByteString))
 -> BinaryParser ByteString)
-> (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    (ByteString, ByteString) -> Either Text (ByteString, ByteString)
forall a b. b -> Either a b
Right ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
predicate ByteString
remainders)

-- |
-- Skip an amount of bytes.
{-# INLINE unitOfSize #-}
unitOfSize :: Int -> BinaryParser ()
unitOfSize :: Int -> BinaryParser ()
unitOfSize Int
size =
  (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text ((), ByteString)) -> BinaryParser ())
-> (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    if ByteString -> Int
ByteString.length ByteString
remainders Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
      then ((), ByteString) -> Either Text ((), ByteString)
forall a b. b -> Either a b
Right ((), Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
size ByteString
remainders)
      else Text -> Either Text ((), ByteString)
forall a b. a -> Either a b
Left Text
"End of input"

-- |
-- Skip specific bytes, while failing if they don't match.
{-# INLINE unitOfBytes #-}
unitOfBytes :: ByteString -> BinaryParser ()
unitOfBytes :: ByteString -> BinaryParser ()
unitOfBytes ByteString
bytes =
  (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text ((), ByteString)) -> BinaryParser ())
-> (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    if ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
bytes ByteString
remainders
      then ((), ByteString) -> Either Text ((), ByteString)
forall a b. b -> Either a b
Right ((), Int -> ByteString -> ByteString
ByteString.unsafeDrop (ByteString -> Int
ByteString.length ByteString
bytes) ByteString
remainders)
      else Text -> Either Text ((), ByteString)
forall a b. a -> Either a b
Left Text
"Bytes don't match"

-- |
-- Skip bytes, which satisfy the predicate.
{-# INLINE unitWhile #-}
unitWhile :: (Word8 -> Bool) -> BinaryParser ()
unitWhile :: (Word8 -> Bool) -> BinaryParser ()
unitWhile Word8 -> Bool
predicate =
  (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text ((), ByteString)) -> BinaryParser ())
-> (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    ((), ByteString) -> Either Text ((), ByteString)
forall a b. b -> Either a b
Right ((), (Word8 -> Bool) -> ByteString -> ByteString
ByteString.dropWhile Word8 -> Bool
predicate ByteString
remainders)

-- |
-- Consume all the remaining bytes.
{-# INLINE remainders #-}
remainders :: BinaryParser ByteString
remainders :: BinaryParser ByteString
remainders =
  (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (ByteString, ByteString))
 -> BinaryParser ByteString)
-> (ByteString -> Either Text (ByteString, ByteString))
-> BinaryParser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders -> (ByteString, ByteString) -> Either Text (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
remainders, ByteString
ByteString.empty)

-- |
-- Fail if the input hasn't ended.
{-# INLINE endOfInput #-}
endOfInput :: BinaryParser ()
endOfInput :: BinaryParser ()
endOfInput =
  (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text ((), ByteString)) -> BinaryParser ())
-> (ByteString -> Either Text ((), ByteString)) -> BinaryParser ()
forall a b. (a -> b) -> a -> b
$ \case
    ByteString
"" -> ((), ByteString) -> Either Text ((), ByteString)
forall a b. b -> Either a b
Right ((), ByteString
ByteString.empty)
    ByteString
_ -> Text -> Either Text ((), ByteString)
forall a b. a -> Either a b
Left Text
"Not the end of input"

-- |
-- Left-fold the bytes, terminating before the byte,
-- on which the step function returns Nothing.
{-# INLINE fold #-}
fold :: (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold :: (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold a -> Word8 -> Maybe a
step a
init =
  (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (a, ByteString)) -> BinaryParser a)
-> (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a b. (a -> b) -> a -> b
$ (a, ByteString) -> Either Text (a, ByteString)
forall a b. b -> Either a b
Right ((a, ByteString) -> Either Text (a, ByteString))
-> (ByteString -> (a, ByteString))
-> ByteString
-> Either Text (a, ByteString)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString -> (a, ByteString)
loop a
init
  where
    loop :: a -> ByteString -> (a, ByteString)
loop !a
accumulator ByteString
remainders =
      case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
remainders of
        Maybe (Word8, ByteString)
Nothing -> (a
accumulator, ByteString
remainders)
        Just (Word8
head, ByteString
tail) ->
          case a -> Word8 -> Maybe a
step a
accumulator Word8
head of
            Just a
newAccumulator ->
              a -> ByteString -> (a, ByteString)
loop a
newAccumulator ByteString
tail
            Maybe a
Nothing -> (a
accumulator, ByteString
remainders)

-- |
-- Run a subparser passing it a chunk of the current input of the specified size.
{-# INLINE sized #-}
sized :: Int -> BinaryParser a -> BinaryParser a
sized :: Int -> BinaryParser a -> BinaryParser a
sized Int
size (BinaryParser ByteString -> Either Text (a, ByteString)
parser) =
  (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (a, ByteString)) -> BinaryParser a)
-> (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
    if ByteString -> Int
ByteString.length ByteString
remainders Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
      then
        ByteString -> Either Text (a, ByteString)
parser (Int -> ByteString -> ByteString
ByteString.unsafeTake Int
size ByteString
remainders) Either Text (a, ByteString)
-> (Either Text (a, ByteString) -> Either Text (a, ByteString))
-> Either Text (a, ByteString)
forall a b. a -> (a -> b) -> b
&
        ((a, ByteString) -> (a, ByteString))
-> Either Text (a, ByteString) -> Either Text (a, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a, ByteString)
result -> ((a, ByteString) -> a
forall a b. (a, b) -> a
fst (a, ByteString)
result, Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
size ByteString
remainders))
      else Text -> Either Text (a, ByteString)
forall a b. a -> Either a b
Left Text
"End of input"

-- |
-- Storable value of the given amount of bytes.
{-# INLINE storableOfSize #-}
storableOfSize :: Storable a => Int -> BinaryParser a
storableOfSize :: Int -> BinaryParser a
storableOfSize Int
size =
  (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser ((ByteString -> Either Text (a, ByteString)) -> BinaryParser a)
-> (ByteString -> Either Text (a, ByteString)) -> BinaryParser a
forall a b. (a -> b) -> a -> b
$ \(A.PS ForeignPtr Word8
payloadFP Int
offset Int
length) ->
    if Int
length Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
      then let result :: a
result =
                 IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
payloadFP ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Any -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
offset
               newRemainder :: ByteString
newRemainder =
                 ForeignPtr Word8 -> Int -> Int -> ByteString
A.PS ForeignPtr Word8
payloadFP (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) (Int
length Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size)
               in (a, ByteString) -> Either Text (a, ByteString)
forall a b. b -> Either a b
Right (a
result, ByteString
newRemainder)
      else Text -> Either Text (a, ByteString)
forall a b. a -> Either a b
Left Text
"End of input" 

-- | Big-endian word of 2 bytes.
{-# INLINE beWord16 #-}
beWord16 :: BinaryParser Word16
#ifdef WORDS_BIGENDIAN
beWord16 =
  storableOfSize 2
#else
beWord16 :: BinaryParser Word16
beWord16 =
  Word16 -> Word16
byteSwap16 (Word16 -> Word16) -> BinaryParser Word16 -> BinaryParser Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser Word16
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
2
#endif

-- | Little-endian word of 2 bytes.
{-# INLINE leWord16 #-}
leWord16 :: BinaryParser Word16
#ifdef WORDS_BIGENDIAN
leWord16 =
  byteSwap16 <$> storableOfSize 2
#else
leWord16 :: BinaryParser Word16
leWord16 =
  Int -> BinaryParser Word16
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
2
#endif

-- | Big-endian word of 4 bytes.
{-# INLINE beWord32 #-}
beWord32 :: BinaryParser Word32
#ifdef WORDS_BIGENDIAN
beWord32 =
  storableOfSize 4
#else
beWord32 :: BinaryParser Word32
beWord32 =
  Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> BinaryParser Word32 -> BinaryParser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser Word32
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
4
#endif

-- | Little-endian word of 4 bytes.
{-# INLINE leWord32 #-}
leWord32 :: BinaryParser Word32
#ifdef WORDS_BIGENDIAN
leWord32 =
  byteSwap32 <$> storableOfSize 4
#else
leWord32 :: BinaryParser Word32
leWord32 =
  Int -> BinaryParser Word32
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
4
#endif

-- | Big-endian word of 8 bytes.
{-# INLINE beWord64 #-}
beWord64 :: BinaryParser Word64
#ifdef WORDS_BIGENDIAN
beWord64 =
  storableOfSize 8
#else
beWord64 :: BinaryParser Word64
beWord64 =
  Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> BinaryParser Word64 -> BinaryParser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser Word64
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
8
#endif

-- | Little-endian word of 8 bytes.
{-# INLINE leWord64 #-}
leWord64 :: BinaryParser Word64
#ifdef WORDS_BIGENDIAN
leWord64 =
  byteSwap64 <$> storableOfSize 8
#else
leWord64 :: BinaryParser Word64
leWord64 =
  Int -> BinaryParser Word64
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
8
#endif

-- |
-- Integral number encoded in ASCII.
{-# INLINE asciiIntegral #-}
asciiIntegral :: Integral a => BinaryParser a
asciiIntegral :: BinaryParser a
asciiIntegral = 
  do
    a
firstDigit <- (Word8 -> Either Text a) -> BinaryParser a
forall a. (Word8 -> Either Text a) -> BinaryParser a
matchingByte Word8 -> Either Text a
forall a b a. (Integral a, Num b, IsString a) => a -> Either a b
byteDigit
    (a -> Word8 -> Maybe a) -> a -> BinaryParser a
forall a. (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold a -> Word8 -> Maybe a
forall a a. (Integral a, Num a) => a -> a -> Maybe a
step a
firstDigit
  where
    byteDigit :: a -> Either a b
byteDigit a
byte =
      case a
byte a -> a -> a
forall a. Num a => a -> a -> a
- a
48 of
        a
subtracted ->
          if a
subtracted a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9
            then b -> Either a b
forall a b. b -> Either a b
Right (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
subtracted)
            else a -> Either a b
forall a b. a -> Either a b
Left a
"Not an ASCII decimal byte"
    step :: a -> a -> Maybe a
step a
state a
byte =
      case a -> Either String a
forall a b a. (Integral a, Num b, IsString a) => a -> Either a b
byteDigit a
byte of
        Right a
digit -> a -> Maybe a
forall a. a -> Maybe a
Just (a
state a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
digit)
        Either String a
_ -> Maybe a
forall a. Maybe a
Nothing