{-# LANGUAGE BangPatterns #-}
module Data.Binary.Parser
(
Parser
, parseOnly
, parseLazy
, parseDetail
, parseDetailLazy
, parse
, maybeDecoder
, eitherDecoder
, (<?>)
, endOfInput
, option
, eitherP
, match
, many'
, some'
, sepBy
, sepBy'
, sepBy1
, sepBy1'
, manyTill
, manyTill'
, skipMany
, skipMany1
, module Data.Binary.Get
, module Data.Binary.Parser.Word8
, module Data.Binary.Parser.Numeric
) where
import Control.Applicative
import Control.Monad
import Data.Binary.Get
import qualified Data.Binary.Get.Internal as I
import Data.Binary.Parser.Numeric
import Data.Binary.Parser.Word8
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L (ByteString(..))
type Parser a = Get a
parseOnly :: Get a -> B.ByteString -> Either String a
parseOnly :: forall a. Get a -> ByteString -> Either String a
parseOnly Get a
g ByteString
bs =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) of
Fail ByteString
_ ByteOffset
_ String
err -> forall a b. a -> Either a b
Left String
err
Done ByteString
_ ByteOffset
_ a
a -> forall a b. b -> Either a b
Right a
a
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseOnly #-}
parseLazy :: Get a -> L.ByteString -> Either String a
parseLazy :: forall a. Get a -> ByteString -> Either String a
parseLazy Get a
g (L.Chunk ByteString
bs ByteString
lbs) =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Decoder a -> ByteString -> Decoder a
pushChunks (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) ByteString
lbs) of
Fail ByteString
_ ByteOffset
_ String
err -> forall a b. a -> Either a b
Left String
err
Done ByteString
_ ByteOffset
_ a
a -> forall a b. b -> Either a b
Right a
a
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
parseLazy Get a
g ByteString
L.Empty =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
B.empty) of
Fail ByteString
_ ByteOffset
_ String
err -> forall a b. a -> Either a b
Left String
err
Done ByteString
_ ByteOffset
_ a
a -> forall a b. b -> Either a b
Right a
a
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseLazy #-}
parseDetail :: Get a
-> B.ByteString
-> Either (B.ByteString, ByteOffset, String) (B.ByteString, ByteOffset, a)
parseDetail :: forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
parseDetail Get a
g ByteString
bs =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) of
Fail ByteString
rest ByteOffset
offset String
err -> forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
Done ByteString
rest ByteOffset
offset a
a -> forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseDetail #-}
parseDetailLazy :: Get a
-> L.ByteString
-> Either (B.ByteString, ByteOffset, String) (B.ByteString, ByteOffset, a)
parseDetailLazy :: forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
parseDetailLazy Get a
g (L.Chunk ByteString
bs ByteString
lbs) =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Decoder a -> ByteString -> Decoder a
pushChunks (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs) ByteString
lbs) of
Fail ByteString
rest ByteOffset
offset String
err -> forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
Done ByteString
rest ByteOffset
offset a
a -> forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
parseDetailLazy Get a
g ByteString
L.Empty =
case forall a. Decoder a -> Decoder a
pushEndOfInput (forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
B.empty) of
Fail ByteString
rest ByteOffset
offset String
err -> forall a b. a -> Either a b
Left (ByteString
rest, ByteOffset
offset, String
err)
Done ByteString
rest ByteOffset
offset a
a -> forall a b. b -> Either a b
Right (ByteString
rest, ByteOffset
offset, a
a)
Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
{-# INLINE parseDetailLazy #-}
parse :: Get a -> B.ByteString -> Decoder a
parse :: forall a. Get a -> ByteString -> Decoder a
parse Get a
g ByteString
bs = forall {a}. Decoder a -> ByteOffset -> Decoder a
calculateOffset (forall {a}. Decoder a -> Decoder a
loop (forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
I.runCont Get a
g ByteString
bs forall a. ByteString -> a -> Decoder a
I.Done)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs)
where
calculateOffset :: Decoder a -> ByteOffset -> Decoder a
calculateOffset Decoder a
r !ByteOffset
acc = case Decoder a
r of
I.Done ByteString
inp a
a -> forall a. ByteString -> ByteOffset -> a -> Decoder a
Done ByteString
inp (ByteOffset
acc forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) a
a
I.Fail ByteString
inp String
s -> forall a. ByteString -> ByteOffset -> String -> Decoder a
Fail ByteString
inp (ByteOffset
acc forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) String
s
I.Partial Maybe ByteString -> Decoder a
k -> forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
ms -> case Maybe ByteString
ms of
Maybe ByteString
Nothing -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (Maybe ByteString -> Decoder a
k forall a. Maybe a
Nothing) ByteOffset
acc
Just ByteString
i -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (Maybe ByteString -> Decoder a
k Maybe ByteString
ms) (ByteOffset
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
i))
I.BytesRead ByteOffset
unused ByteOffset -> Decoder a
k -> Decoder a -> ByteOffset -> Decoder a
calculateOffset (ByteOffset -> Decoder a
k forall a b. (a -> b) -> a -> b
$! (ByteOffset
acc forall a. Num a => a -> a -> a
- ByteOffset
unused)) ByteOffset
acc
loop :: Decoder a -> Decoder a
loop Decoder a
r = case Decoder a
r of
I.Partial Maybe ByteString -> Decoder a
k -> forall a. (Maybe ByteString -> Decoder a) -> Decoder a
I.Partial forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
ms -> case Maybe ByteString
ms of Just ByteString
_ -> Decoder a -> Decoder a
loop (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
Maybe ByteString
Nothing -> forall {a}. Decoder a -> Decoder a
completeLoop (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
I.BytesRead ByteOffset
n ByteOffset -> Decoder a
k -> forall a. ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
I.BytesRead ByteOffset
n (Decoder a -> Decoder a
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> Decoder a
k)
I.Done ByteString
_ a
_ -> Decoder a
r
I.Fail ByteString
_ String
_ -> Decoder a
r
completeLoop :: Decoder a -> Decoder a
completeLoop Decoder a
r = case Decoder a
r of
I.Partial Maybe ByteString -> Decoder a
k -> Decoder a -> Decoder a
completeLoop (Maybe ByteString -> Decoder a
k forall a. Maybe a
Nothing)
I.BytesRead ByteOffset
n ByteOffset -> Decoder a
k -> forall a. ByteOffset -> (ByteOffset -> Decoder a) -> Decoder a
I.BytesRead ByteOffset
n (Decoder a -> Decoder a
completeLoop forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> Decoder a
k)
I.Fail ByteString
_ String
_ -> Decoder a
r
I.Done ByteString
_ a
_ -> Decoder a
r
maybeDecoder :: Decoder r -> Maybe r
maybeDecoder :: forall r. Decoder r -> Maybe r
maybeDecoder (Done ByteString
_ ByteOffset
_ r
r) = forall a. a -> Maybe a
Just r
r
maybeDecoder Decoder r
_ = forall a. Maybe a
Nothing
{-# INLINE maybeDecoder #-}
eitherDecoder :: Decoder r -> Either String r
eitherDecoder :: forall r. Decoder r -> Either String r
eitherDecoder (Done ByteString
_ ByteOffset
_ r
r) = forall a b. b -> Either a b
Right r
r
eitherDecoder (Fail ByteString
_ ByteOffset
_ String
msg) = forall a b. a -> Either a b
Left String
msg
eitherDecoder Decoder r
_ = forall a b. a -> Either a b
Left String
"Decoder: incomplete input"
{-# INLINE eitherDecoder #-}
(<?>) :: Get a -> String -> Get a
<?> :: forall a. Get a -> String -> Get a
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> Get a -> Get a
label
infix 0 <?>
{-# INLINE (<?>) #-}
endOfInput :: Get ()
endOfInput :: Get ()
endOfInput = do
Bool
e <- Get Bool
isEmpty
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"endOfInput")
{-# INLINE endOfInput #-}
option :: Alternative f => a -> f a -> f a
option :: forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option a
x f a
p = f a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# SPECIALIZE option :: a -> Get a -> Get a #-}
eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
eitherP :: forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP f a
a f b
b = (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b)
{-# INLINE eitherP #-}
match :: Get a -> Get (B.ByteString, a)
match :: forall a. Get a -> Get (ByteString, a)
match Get a
p = do
ByteOffset
pos1 <- Get ByteOffset
bytesRead
(a
x, ByteOffset
pos2) <- forall a. Get a -> Get a
lookAhead forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteOffset
bytesRead
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ByteString
getByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteOffset
pos2 forall a. Num a => a -> a -> a
- ByteOffset
pos1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE match #-}
liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
liftM2' :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' a -> b -> c
f m a
a m b
b = do
!a
x <- m a
a
b
y <- m b
b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
x b
y)
{-# INLINE liftM2' #-}
many' :: (MonadPlus m) => m a -> m [a]
many' :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' m a
p = m [a]
many_p
where many_p :: m [a]
many_p = m [a]
some_p forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return []
some_p :: m [a]
some_p = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p m [a]
many_p
{-# INLINE many' #-}
some' :: (MonadPlus m) => m a -> m [a]
some' :: forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some' m a
p = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' m a
p)
{-# INLINE some' #-}
sepBy :: Alternative f => f a -> f s -> f [a]
sepBy :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy f a
p f s
s = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p ((f s
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
p f s
s) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# SPECIALIZE sepBy :: Get a -> Get s -> Get [a] #-}
sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy' m a
p m s
s = m [a]
go forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return []
where go :: m [a]
go = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p ((m s
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy1' m a
p m s
s) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy' :: Get a -> Get s -> Get [a] #-}
sepBy1 :: Alternative f => f a -> f s -> f [a]
sepBy1 :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
p f s
s = f [a]
go
where go :: f [a]
go = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p ((f s
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f [a]
go) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
{-# SPECIALIZE sepBy1 :: Get a -> Get s -> Get [a] #-}
sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
sepBy1' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
sepBy1' m a
p m s
s = m [a]
go
where go :: m [a]
go = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p ((m s
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [a]
go) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return [])
{-# SPECIALIZE sepBy1' :: Get a -> Get s -> Get [a] #-}
manyTill :: Alternative f => f a -> f b -> f [a]
manyTill :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
manyTill f a
p f b
end = f [a]
go
where go :: f [a]
go = (f b
end forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
p f [a]
go
{-# SPECIALIZE manyTill :: Get a -> Get b -> Get [a] #-}
manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
manyTill' :: forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
manyTill' m a
p m b
end = m [a]
go
where go :: m [a]
go = (m b
end forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2' (:) m a
p m [a]
go
{-# SPECIALIZE manyTill' :: Get a -> Get b -> Get [a] #-}
skipMany :: Alternative f => f a -> f ()
skipMany :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p = f ()
go
where go :: f ()
go = (f a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
go) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# SPECIALIZE skipMany :: Get a -> Get () #-}
skipMany1 :: Alternative f => f a -> f ()
skipMany1 :: forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 f a
p = f a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany f a
p
{-# SPECIALIZE skipMany1 :: Get a -> Get () #-}