{-# LANGUAGE CPP #-}
module BinaryParser
( BinaryParser,
run,
failure,
byte,
matchingByte,
bytesOfSize,
bytesWhile,
unitOfSize,
unitOfBytes,
unitWhile,
remainders,
fold,
endOfInput,
sized,
storableOfSize,
beWord16,
leWord16,
beWord32,
leWord32,
beWord64,
leWord64,
asciiIntegral,
)
where
import BinaryParser.Prelude hiding (fold)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Internal as ByteString
import qualified Data.ByteString.Unsafe as ByteString
newtype BinaryParser a
= BinaryParser (ByteString -> Either Text (a, ByteString))
deriving
(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
<$ :: forall a b. a -> BinaryParser b -> BinaryParser a
$c<$ :: forall a b. a -> BinaryParser b -> BinaryParser a
fmap :: forall a b. (a -> b) -> BinaryParser a -> BinaryParser b
$cfmap :: forall a b. (a -> b) -> BinaryParser a -> BinaryParser b
Functor, Functor BinaryParser
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
<* :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser a
$c<* :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser a
*> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
$c*> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
liftA2 :: forall a b c.
(a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BinaryParser a -> BinaryParser b -> BinaryParser c
<*> :: forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
$c<*> :: forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
pure :: forall a. a -> BinaryParser a
$cpure :: forall a. a -> BinaryParser a
Applicative, Applicative BinaryParser
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 :: forall a. BinaryParser a -> BinaryParser [a]
$cmany :: forall a. BinaryParser a -> BinaryParser [a]
some :: forall a. BinaryParser a -> BinaryParser [a]
$csome :: forall a. BinaryParser a -> BinaryParser [a]
<|> :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
$c<|> :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
empty :: forall a. BinaryParser a
$cempty :: forall a. BinaryParser a
Alternative, Applicative BinaryParser
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 :: forall a. a -> BinaryParser a
$creturn :: forall a. a -> BinaryParser a
>> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
$c>> :: forall a b. BinaryParser a -> BinaryParser b -> BinaryParser b
>>= :: forall a b.
BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
$c>>= :: forall a b.
BinaryParser a -> (a -> BinaryParser b) -> BinaryParser b
Monad, Monad BinaryParser
Alternative BinaryParser
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 :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
$cmplus :: forall a. BinaryParser a -> BinaryParser a -> BinaryParser a
mzero :: forall a. BinaryParser a
$cmzero :: forall a. BinaryParser a
MonadPlus, MonadError Text)
via (StateT ByteString (Except Text))
type role BinaryParser representational
instance MonadFail BinaryParser where
fail :: forall a. String -> BinaryParser a
fail = forall a. Text -> BinaryParser a
failure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString
{-# INLINE run #-}
run :: BinaryParser a -> ByteString -> Either Text a
run :: forall a. BinaryParser a -> ByteString -> Either Text a
run (BinaryParser ByteString -> Either Text (a, ByteString)
parser) ByteString
input =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text (a, ByteString)
parser ByteString
input
{-# INLINE failure #-}
failure :: Text -> BinaryParser a
failure :: forall a. Text -> BinaryParser a
failure Text
text =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser (forall a b. a -> b -> a
const (forall a b. a -> Either a b
Left Text
text))
{-# INLINE byte #-}
byte :: BinaryParser Word8
byte :: BinaryParser Word8
byte =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
if ByteString -> Bool
ByteString.null ByteString
remainders
then forall a b. a -> Either a b
Left Text
"End of input"
else forall a b. b -> Either a b
Right (ByteString -> Word8
ByteString.unsafeHead ByteString
remainders, Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
1 ByteString
remainders)
{-# INLINE matchingByte #-}
matchingByte :: (Word8 -> Either Text a) -> BinaryParser a
matchingByte :: forall a. (Word8 -> Either Text a) -> BinaryParser a
matchingByte Word8 -> Either Text a
matcher =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
case ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
remainders of
Maybe (Word8, ByteString)
Nothing -> 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 -> forall a b. b -> Either a b
Right (a
result, ByteString
tail)
Left Text
error -> forall a b. a -> Either a b
Left Text
error
{-# INLINE bytesOfSize #-}
bytesOfSize :: Int -> BinaryParser ByteString
bytesOfSize :: Int -> BinaryParser ByteString
bytesOfSize Int
size =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
if ByteString -> Int
ByteString.length ByteString
remainders forall a. Ord a => a -> a -> Bool
>= Int
size
then 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 forall a b. a -> Either a b
Left Text
"End of input"
{-# INLINE bytesWhile #-}
bytesWhile :: (Word8 -> Bool) -> BinaryParser ByteString
bytesWhile :: (Word8 -> Bool) -> BinaryParser ByteString
bytesWhile Word8 -> Bool
predicate =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
forall a b. b -> Either a b
Right ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.span Word8 -> Bool
predicate ByteString
remainders)
{-# INLINE unitOfSize #-}
unitOfSize :: Int -> BinaryParser ()
unitOfSize :: Int -> BinaryParser ()
unitOfSize Int
size =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
if ByteString -> Int
ByteString.length ByteString
remainders forall a. Ord a => a -> a -> Bool
>= Int
size
then forall a b. b -> Either a b
Right ((), Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
size ByteString
remainders)
else forall a b. a -> Either a b
Left Text
"End of input"
{-# INLINE unitOfBytes #-}
unitOfBytes :: ByteString -> BinaryParser ()
unitOfBytes :: ByteString -> BinaryParser ()
unitOfBytes ByteString
bytes =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
if ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
bytes ByteString
remainders
then forall a b. b -> Either a b
Right ((), Int -> ByteString -> ByteString
ByteString.unsafeDrop (ByteString -> Int
ByteString.length ByteString
bytes) ByteString
remainders)
else forall a b. a -> Either a b
Left Text
"Bytes don't match"
{-# INLINE unitWhile #-}
unitWhile :: (Word8 -> Bool) -> BinaryParser ()
unitWhile :: (Word8 -> Bool) -> BinaryParser ()
unitWhile Word8 -> Bool
predicate =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
forall a b. b -> Either a b
Right ((), (Word8 -> Bool) -> ByteString -> ByteString
ByteString.dropWhile Word8 -> Bool
predicate ByteString
remainders)
{-# INLINE remainders #-}
remainders :: BinaryParser ByteString
remainders :: BinaryParser ByteString
remainders =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders -> forall a b. b -> Either a b
Right (ByteString
remainders, ByteString
ByteString.empty)
{-# INLINE endOfInput #-}
endOfInput :: BinaryParser ()
endOfInput :: BinaryParser ()
endOfInput =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \case
ByteString
"" -> forall a b. b -> Either a b
Right ((), ByteString
ByteString.empty)
ByteString
_ -> forall a b. a -> Either a b
Left Text
"Not the end of input"
{-# INLINE fold #-}
fold :: (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold :: forall a. (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold a -> Word8 -> Maybe a
step a
init =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right 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)
{-# INLINE sized #-}
sized :: Int -> BinaryParser a -> BinaryParser a
sized :: forall a. Int -> BinaryParser a -> BinaryParser a
sized Int
size (BinaryParser ByteString -> Either Text (a, ByteString)
parser) =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \ByteString
remainders ->
if ByteString -> Int
ByteString.length ByteString
remainders 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)
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a, ByteString)
result -> (forall a b. (a, b) -> a
fst (a, ByteString)
result, Int -> ByteString -> ByteString
ByteString.unsafeDrop Int
size ByteString
remainders))
else forall a b. a -> Either a b
Left Text
"End of input"
{-# INLINE storableOfSize #-}
storableOfSize :: (Storable a) => Int -> BinaryParser a
storableOfSize :: forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
size =
forall a.
(ByteString -> Either Text (a, ByteString)) -> BinaryParser a
BinaryParser forall a b. (a -> b) -> a -> b
$ \(ByteString.PS ForeignPtr Word8
payloadFP Int
offset Int
length) ->
if Int
length forall a. Ord a => a -> a -> Bool
>= Int
size
then
let result :: a
result =
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
payloadFP forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
offset
newRemainder :: ByteString
newRemainder =
ForeignPtr Word8 -> Int -> Int -> ByteString
ByteString.PS ForeignPtr Word8
payloadFP (Int
offset forall a. Num a => a -> a -> a
+ Int
size) (Int
length forall a. Num a => a -> a -> a
- Int
size)
in forall a b. b -> Either a b
Right (a
result, ByteString
newRemainder)
else forall a b. a -> Either a b
Left Text
"End of input"
{-# INLINE beWord16 #-}
beWord16 :: BinaryParser Word16
#ifdef WORDS_BIGENDIAN
beWord16 =
storableOfSize 2
#else
beWord16 :: BinaryParser Word16
beWord16 =
Word16 -> Word16
byteSwap16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
2
#endif
{-# INLINE leWord16 #-}
leWord16 :: BinaryParser Word16
#ifdef WORDS_BIGENDIAN
leWord16 =
byteSwap16 <$> storableOfSize 2
#else
leWord16 :: BinaryParser Word16
leWord16 =
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
2
#endif
{-# INLINE beWord32 #-}
beWord32 :: BinaryParser Word32
#ifdef WORDS_BIGENDIAN
beWord32 =
storableOfSize 4
#else
beWord32 :: BinaryParser Word32
beWord32 =
Word32 -> Word32
byteSwap32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
4
#endif
{-# INLINE leWord32 #-}
leWord32 :: BinaryParser Word32
#ifdef WORDS_BIGENDIAN
leWord32 =
byteSwap32 <$> storableOfSize 4
#else
leWord32 :: BinaryParser Word32
leWord32 =
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
4
#endif
{-# INLINE beWord64 #-}
beWord64 :: BinaryParser Word64
#ifdef WORDS_BIGENDIAN
beWord64 =
storableOfSize 8
#else
beWord64 :: BinaryParser Word64
beWord64 =
Word64 -> Word64
byteSwap64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
8
#endif
{-# INLINE leWord64 #-}
leWord64 :: BinaryParser Word64
#ifdef WORDS_BIGENDIAN
leWord64 =
byteSwap64 <$> storableOfSize 8
#else
leWord64 :: BinaryParser Word64
leWord64 =
forall a. Storable a => Int -> BinaryParser a
storableOfSize Int
8
#endif
{-# INLINE asciiIntegral #-}
asciiIntegral :: (Integral a) => BinaryParser a
asciiIntegral :: forall a. Integral a => BinaryParser a
asciiIntegral =
do
a
firstDigit <- forall a. (Word8 -> Either Text a) -> BinaryParser a
matchingByte forall {a} {b} {a}.
(Integral a, Num b, IsString a) =>
a -> Either a b
byteDigit
forall a. (a -> Word8 -> Maybe a) -> a -> BinaryParser a
fold 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 forall a. Num a => a -> a -> a
- a
48 of
a
subtracted ->
if a
subtracted forall a. Ord a => a -> a -> Bool
<= a
9
then forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
subtracted)
else 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 forall {a} {b} {a}.
(Integral a, Num b, IsString a) =>
a -> Either a b
byteDigit a
byte of
Right a
digit -> forall a. a -> Maybe a
Just (a
state forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ a
digit)
Either String a
_ -> forall a. Maybe a
Nothing