{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns, TypeFamilies #-}
module Data.Binary.Get.Internal (
Get
, runCont
, Decoder(..)
, runGetIncremental
, readN
, readNWith
, bytesRead
, isolate
, withInputChunks
, Consume
, failOnEOF
, get
, put
, ensureN
, remaining
, getBytes
, isEmpty
, lookAhead
, lookAheadM
, lookAheadE
, label
, getByteString
) where
import Foreign
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Data.Binary.Internal ( accursedUnutterablePerformIO )
data Decoder a = Fail !B.ByteString String
| Partial (Maybe B.ByteString -> Decoder a)
| Done !B.ByteString a
| BytesRead {-# UNPACK #-} !Int64 (Int64 -> Decoder a)
newtype Get a = C { Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont :: forall r.
B.ByteString ->
Success a r ->
Decoder r }
type Success a r = B.ByteString -> a -> Decoder r
instance Monad Get where
return :: a -> Get a
return = a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: Get a -> (a -> Get b) -> Get b
(>>=) = Get a -> (a -> Get b) -> Get b
forall a b. Get a -> (a -> Get b) -> Get b
bindG
#if !(MIN_VERSION_base(4,9,0))
fail = failG
#elif !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Get where
fail :: String -> Get a
fail = String -> Get a
forall a. String -> Get a
failG
#endif
bindG :: Get a -> (a -> Get b) -> Get b
bindG :: Get a -> (a -> Get b) -> Get b
bindG (C forall r. ByteString -> Success a r -> Decoder r
c) a -> Get b
f = (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success b r -> Decoder r) -> Get b)
-> (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a b. (a -> b) -> a -> b
$ \ByteString
i Success b r
ks -> ByteString -> Success a r -> Decoder r
forall r. ByteString -> Success a r -> Decoder r
c ByteString
i (\ByteString
i' a
a -> (Get b -> ByteString -> Success b r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont (a -> Get b
f a
a)) ByteString
i' Success b r
ks)
{-# INLINE bindG #-}
failG :: String -> Get a
failG :: String -> Get a
failG String
str = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
i Success a r
_ks -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ByteString
i String
str
apG :: Get (a -> b) -> Get a -> Get b
apG :: Get (a -> b) -> Get a -> Get b
apG Get (a -> b)
d Get a
e = do
a -> b
b <- Get (a -> b)
d
a
a <- Get a
e
b -> Get b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
{-# INLINE [0] apG #-}
fmapG :: (a -> b) -> Get a -> Get b
fmapG :: (a -> b) -> Get a -> Get b
fmapG a -> b
f Get a
m = (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success b r -> Decoder r) -> Get b)
-> (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a b. (a -> b) -> a -> b
$ \ByteString
i Success b r
ks -> Get a -> ByteString -> Success a r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
m ByteString
i (\ByteString
i' a
a -> Success b r
ks ByteString
i' (a -> b
f a
a))
{-# INLINE fmapG #-}
instance Applicative Get where
pure :: a -> Get a
pure = \a
x -> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
s Success a r
ks -> Success a r
ks ByteString
s a
x
{-# INLINE [0] pure #-}
<*> :: Get (a -> b) -> Get a -> Get b
(<*>) = Get (a -> b) -> Get a -> Get b
forall a b. Get (a -> b) -> Get a -> Get b
apG
{-# INLINE (<*>) #-}
instance MonadPlus Get where
mzero :: Get a
mzero = Get a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Get a -> Get a -> Get a
mplus = Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance Functor Get where
fmap :: (a -> b) -> Get a -> Get b
fmap = (a -> b) -> Get a -> Get b
forall a b. (a -> b) -> Get a -> Get b
fmapG
instance Functor Decoder where
fmap :: (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f (Done ByteString
s a
a) = ByteString -> b -> Decoder b
forall a. ByteString -> a -> Decoder a
Done ByteString
s (a -> b
f a
a)
fmap a -> b
f (Partial Maybe ByteString -> Decoder a
k) = (Maybe ByteString -> Decoder b) -> Decoder b
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Decoder a -> Decoder b)
-> (Maybe ByteString -> Decoder a) -> Maybe ByteString -> Decoder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Decoder a
k)
fmap a -> b
_ (Fail ByteString
s String
msg) = ByteString -> String -> Decoder b
forall a. ByteString -> String -> Decoder a
Fail ByteString
s String
msg
fmap a -> b
f (BytesRead Int64
b Int64 -> Decoder a
k) = Int64 -> (Int64 -> Decoder b) -> Decoder b
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
b ((a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Decoder a -> Decoder b)
-> (Int64 -> Decoder a) -> Int64 -> Decoder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
instance (Show a) => Show (Decoder a) where
show :: Decoder a -> String
show (Fail ByteString
_ String
msg) = String
"Fail: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
show (Partial Maybe ByteString -> Decoder a
_) = String
"Partial _"
show (Done ByteString
_ a
a) = String
"Done: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a
show (BytesRead Int64
_ Int64 -> Decoder a
_) = String
"BytesRead"
runGetIncremental :: Get a -> Decoder a
runGetIncremental :: Get a -> Decoder a
runGetIncremental Get a
g = Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
noMeansNo (Decoder a -> Decoder a) -> Decoder a -> Decoder a
forall a b. (a -> b) -> a -> b
$
Get a -> ByteString -> Success a a -> Decoder a
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
g ByteString
B.empty (\ByteString
i a
a -> Success a a
forall a. ByteString -> a -> Decoder a
Done ByteString
i a
a)
noMeansNo :: Decoder a -> Decoder a
noMeansNo :: Decoder a -> Decoder a
noMeansNo Decoder a
r0 = Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
go Decoder a
r0
where
go :: Decoder a -> Decoder a
go Decoder a
r =
case Decoder a
r of
Partial Maybe ByteString -> Decoder a
k -> (Maybe ByteString -> Decoder a) -> Decoder a
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder a) -> Decoder a)
-> (Maybe ByteString -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
ms ->
case Maybe ByteString
ms of
Just ByteString
_ -> Decoder a -> Decoder a
go (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
Maybe ByteString
Nothing -> Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
neverAgain (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
BytesRead Int64
n Int64 -> Decoder a
k -> Int64 -> (Int64 -> Decoder a) -> Decoder a
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
n (Decoder a -> Decoder a
go (Decoder a -> Decoder a)
-> (Int64 -> Decoder a) -> Int64 -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
Done ByteString
_ a
_ -> Decoder a
r
Fail ByteString
_ String
_ -> Decoder a
r
neverAgain :: Decoder a -> Decoder a
neverAgain Decoder a
r =
case Decoder a
r of
Partial Maybe ByteString -> Decoder a
k -> Decoder a -> Decoder a
neverAgain (Maybe ByteString -> Decoder a
k Maybe ByteString
forall a. Maybe a
Nothing)
BytesRead Int64
n Int64 -> Decoder a
k -> Int64 -> (Int64 -> Decoder a) -> Decoder a
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
n (Decoder a -> Decoder a
neverAgain (Decoder a -> Decoder a)
-> (Int64 -> Decoder a) -> Int64 -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
Fail ByteString
_ String
_ -> Decoder a
r
Done ByteString
_ a
_ -> Decoder a
r
prompt :: B.ByteString -> Decoder a -> (B.ByteString -> Decoder a) -> Decoder a
prompt :: ByteString -> Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt ByteString
inp Decoder a
kf ByteString -> Decoder a
ks = Decoder a -> (ByteString -> Decoder a) -> Decoder a
forall a. Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt' Decoder a
kf (\ByteString
inp' -> ByteString -> Decoder a
ks (ByteString
inp ByteString -> ByteString -> ByteString
`B.append` ByteString
inp'))
prompt' :: Decoder a -> (B.ByteString -> Decoder a) -> Decoder a
prompt' :: Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt' Decoder a
kf ByteString -> Decoder a
ks =
let loop :: Decoder a
loop =
(Maybe ByteString -> Decoder a) -> Decoder a
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder a) -> Decoder a)
-> (Maybe ByteString -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
sm ->
case Maybe ByteString
sm of
Just ByteString
s | ByteString -> Bool
B.null ByteString
s -> Decoder a
loop
| Bool
otherwise -> ByteString -> Decoder a
ks ByteString
s
Maybe ByteString
Nothing -> Decoder a
kf
in Decoder a
loop
bytesRead :: Get Int64
bytesRead :: Get Int64
bytesRead = (forall r. ByteString -> Success Int64 r -> Decoder r) -> Get Int64
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success Int64 r -> Decoder r)
-> Get Int64)
-> (forall r. ByteString -> Success Int64 r -> Decoder r)
-> Get Int64
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success Int64 r
k -> Int64 -> (Int64 -> Decoder r) -> Decoder r
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
inp) (Success Int64 r
k ByteString
inp)
isolate :: Int
-> Get a
-> Get a
isolate :: Int -> Get a -> Get a
isolate Int
n0 Get a
act
| Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"isolate: negative size"
| Bool
otherwise = Int -> Decoder a -> Get a
go Int
n0 (Get a -> ByteString -> Success a a -> Decoder a
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
act ByteString
B.empty Success a a
forall a. ByteString -> a -> Decoder a
Done)
where
go :: Int -> Decoder a -> Get a
go !Int
n (Done ByteString
left a
x)
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& ByteString -> Bool
B.null ByteString
left = a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
| Bool
otherwise = do
ByteString -> Get ()
pushFront ByteString
left
let consumed :: Int
consumed = Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
left
String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"isolate: the decoder consumed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
consumed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" which is less than the expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes"
go Int
0 (Partial Maybe ByteString -> Decoder a
resume) = Int -> Decoder a -> Get a
go Int
0 (Maybe ByteString -> Decoder a
resume Maybe ByteString
forall a. Maybe a
Nothing)
go Int
n (Partial Maybe ByteString -> Decoder a
resume) = do
Maybe ByteString
inp <- (forall r. ByteString -> Success (Maybe ByteString) r -> Decoder r)
-> Get (Maybe ByteString)
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r.
ByteString -> Success (Maybe ByteString) r -> Decoder r)
-> Get (Maybe ByteString))
-> (forall r.
ByteString -> Success (Maybe ByteString) r -> Decoder r)
-> Get (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success (Maybe ByteString) r
k -> do
let takeLimited :: ByteString -> Decoder r
takeLimited ByteString
str =
let (ByteString
inp', ByteString
out) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
str
in Success (Maybe ByteString) r
k ByteString
out (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
inp')
case Bool -> Bool
not (ByteString -> Bool
B.null ByteString
inp) of
Bool
True -> ByteString -> Decoder r
takeLimited ByteString
inp
Bool
False -> ByteString -> Decoder r -> (ByteString -> Decoder r) -> Decoder r
forall a.
ByteString -> Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt ByteString
inp (Success (Maybe ByteString) r
k ByteString
B.empty Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Decoder r
takeLimited
case Maybe ByteString
inp of
Maybe ByteString
Nothing -> Int -> Decoder a -> Get a
go Int
n (Maybe ByteString -> Decoder a
resume Maybe ByteString
forall a. Maybe a
Nothing)
Just ByteString
str -> Int -> Decoder a -> Get a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
str) (Maybe ByteString -> Decoder a
resume (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
str))
go Int
_ (Fail ByteString
bs String
err) = ByteString -> Get ()
pushFront ByteString
bs Get () -> Get a -> Get a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
go Int
n (BytesRead Int64
r Int64 -> Decoder a
resume) =
Int -> Decoder a -> Get a
go Int
n (Int64 -> Decoder a
resume (Int64 -> Decoder a) -> Int64 -> Decoder a
forall a b. (a -> b) -> a -> b
$! Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n0 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
r)
type Consume s = s -> B.ByteString -> Either s (B.ByteString, B.ByteString)
withInputChunks :: s -> Consume s -> ([B.ByteString] -> b) -> ([B.ByteString] -> Get b) -> Get b
withInputChunks :: s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks s
initS Consume s
consume [ByteString] -> b
onSucc [ByteString] -> Get b
onFail = s -> [ByteString] -> Get b
go s
initS []
where
go :: s -> [ByteString] -> Get b
go s
state [ByteString]
acc = (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success b r -> Decoder r) -> Get b)
-> (forall r. ByteString -> Success b r -> Decoder r) -> Get b
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success b r
ks ->
case Consume s
consume s
state ByteString
inp of
Left s
state' -> do
let acc' :: [ByteString]
acc' = ByteString
inp ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc
Decoder r -> (ByteString -> Decoder r) -> Decoder r
forall a. Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt'
(Get b -> ByteString -> Success b r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont ([ByteString] -> Get b
onFail ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc')) ByteString
B.empty Success b r
ks)
(\ByteString
str' -> Get b -> ByteString -> Success b r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont (s -> [ByteString] -> Get b
go s
state' [ByteString]
acc') ByteString
str' Success b r
ks)
Right (ByteString
want,ByteString
rest) -> do
Success b r
ks ByteString
rest ([ByteString] -> b
onSucc ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
wantByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)))
failOnEOF :: [B.ByteString] -> Get a
failOnEOF :: [ByteString] -> Get a
failOnEOF [ByteString]
bs = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
_ -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ([ByteString] -> ByteString
B.concat [ByteString]
bs) String
"not enough bytes"
isEmpty :: Get Bool
isEmpty :: Get Bool
isEmpty = (forall r. ByteString -> Success Bool r -> Decoder r) -> Get Bool
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success Bool r -> Decoder r) -> Get Bool)
-> (forall r. ByteString -> Success Bool r -> Decoder r)
-> Get Bool
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success Bool r
ks ->
if ByteString -> Bool
B.null ByteString
inp
then ByteString -> Decoder r -> (ByteString -> Decoder r) -> Decoder r
forall a.
ByteString -> Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt ByteString
inp (Success Bool r
ks ByteString
inp Bool
True) (\ByteString
inp' -> Success Bool r
ks ByteString
inp' Bool
False)
else Success Bool r
ks ByteString
inp Bool
False
{-# DEPRECATED getBytes "Use 'getByteString' instead of 'getBytes'." #-}
getBytes :: Int -> Get B.ByteString
getBytes :: Int -> Get ByteString
getBytes = Int -> Get ByteString
getByteString
{-# INLINE getBytes #-}
instance Alternative Get where
empty :: Get a
empty = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success a r
_ks -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
"Data.Binary.Get(Alternative).empty"
{-# INLINE empty #-}
<|> :: Get a -> Get a -> Get a
(<|>) Get a
f Get a
g = do
(Decoder a
decoder, [ByteString]
bs) <- Get a -> Get (Decoder a, [ByteString])
forall a. Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get a
f
case Decoder a
decoder of
Done ByteString
inp a
x -> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
ks -> Success a r
ks ByteString
inp a
x
Fail ByteString
_ String
_ -> [ByteString] -> Get ()
pushBack [ByteString]
bs Get () -> Get a -> Get a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get a
g
Decoder a
_ -> String -> Get a
forall a. HasCallStack => String -> a
error String
"Binary: impossible"
{-# INLINE (<|>) #-}
some :: Get a -> Get [a]
some Get a
p = (:) (a -> [a] -> [a]) -> Get a -> Get ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p Get ([a] -> [a]) -> Get [a] -> Get [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
p
{-# INLINE some #-}
many :: Get a -> Get [a]
many Get a
p = do
Maybe a
v <- (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Get a -> Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p) Get (Maybe a) -> Get (Maybe a) -> Get (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Get (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
case Maybe a
v of
Maybe a
Nothing -> [a] -> Get [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just a
x -> (:) a
x ([a] -> [a]) -> Get [a] -> Get [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
p
{-# INLINE many #-}
runAndKeepTrack :: Get a -> Get (Decoder a, [B.ByteString])
runAndKeepTrack :: Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get a
g = (forall r.
ByteString -> Success (Decoder a, [ByteString]) r -> Decoder r)
-> Get (Decoder a, [ByteString])
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r.
ByteString -> Success (Decoder a, [ByteString]) r -> Decoder r)
-> Get (Decoder a, [ByteString]))
-> (forall r.
ByteString -> Success (Decoder a, [ByteString]) r -> Decoder r)
-> Get (Decoder a, [ByteString])
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success (Decoder a, [ByteString]) r
ks ->
let r0 :: Decoder a
r0 = Get a -> ByteString -> Success a a -> Decoder a
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
g ByteString
inp (\ByteString
inp' a
a -> Success a a
forall a. ByteString -> a -> Decoder a
Done ByteString
inp' a
a)
go :: [ByteString] -> Decoder a -> Decoder r
go ![ByteString]
acc Decoder a
r = case Decoder a
r of
Done ByteString
inp' a
a -> Success (Decoder a, [ByteString]) r
ks ByteString
inp (Success a a
forall a. ByteString -> a -> Decoder a
Done ByteString
inp' a
a, [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
Partial Maybe ByteString -> Decoder a
k -> (Maybe ByteString -> Decoder r) -> Decoder r
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder r) -> Decoder r)
-> (Maybe ByteString -> Decoder r) -> Decoder r
forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
minp -> [ByteString] -> Decoder a -> Decoder r
go ([ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
acc (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) Maybe ByteString
minp) (Maybe ByteString -> Decoder a
k Maybe ByteString
minp)
Fail ByteString
inp' String
s -> Success (Decoder a, [ByteString]) r
ks ByteString
inp (ByteString -> String -> Decoder a
forall a. ByteString -> String -> Decoder a
Fail ByteString
inp' String
s, [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
BytesRead Int64
unused Int64 -> Decoder a
k -> Int64 -> (Int64 -> Decoder r) -> Decoder r
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
unused ([ByteString] -> Decoder a -> Decoder r
go [ByteString]
acc (Decoder a -> Decoder r)
-> (Int64 -> Decoder a) -> Int64 -> Decoder r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
in [ByteString] -> Decoder a -> Decoder r
go [] Decoder a
r0
{-# INLINE runAndKeepTrack #-}
pushBack :: [B.ByteString] -> Get ()
pushBack :: [ByteString] -> Get ()
pushBack [] = (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success () r -> Decoder r) -> Get ())
-> (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success () r
ks -> Success () r
ks ByteString
inp ()
pushBack [ByteString]
bs = (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success () r -> Decoder r) -> Get ())
-> (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success () r
ks -> Success () r
ks ([ByteString] -> ByteString
B.concat (ByteString
inp ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bs)) ()
{-# INLINE pushBack #-}
pushFront :: B.ByteString -> Get ()
pushFront :: ByteString -> Get ()
pushFront ByteString
bs = (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success () r -> Decoder r) -> Get ())
-> (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success () r
ks -> Success () r
ks (ByteString -> ByteString -> ByteString
B.append ByteString
bs ByteString
inp) ()
{-# INLINE pushFront #-}
lookAhead :: Get a -> Get a
lookAhead :: Get a -> Get a
lookAhead Get a
g = do
(Decoder a
decoder, [ByteString]
bs) <- Get a -> Get (Decoder a, [ByteString])
forall a. Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get a
g
case Decoder a
decoder of
Done ByteString
_ a
a -> [ByteString] -> Get ()
pushBack [ByteString]
bs Get () -> Get a -> Get a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Fail ByteString
inp String
s -> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
_ -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
s
Decoder a
_ -> String -> Get a
forall a. HasCallStack => String -> a
error String
"Binary: impossible"
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM Get (Maybe a)
g = do
let g' :: Get (Either () a)
g' = Either () a -> (a -> Either () a) -> Maybe a -> Either () a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () a
forall a b. a -> Either a b
Left ()) a -> Either () a
forall a b. b -> Either a b
Right (Maybe a -> Either () a) -> Get (Maybe a) -> Get (Either () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe a)
g
(() -> Maybe a) -> (a -> Maybe a) -> Either () a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either () a -> Maybe a) -> Get (Either () a) -> Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Either () a) -> Get (Either () a)
forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either () a)
g'
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either a b)
g = do
(Decoder (Either a b)
decoder, [ByteString]
bs) <- Get (Either a b) -> Get (Decoder (Either a b), [ByteString])
forall a. Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get (Either a b)
g
case Decoder (Either a b)
decoder of
Done ByteString
_ (Left a
x) -> [ByteString] -> Get ()
pushBack [ByteString]
bs Get () -> Get (Either a b) -> Get (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either a b -> Get (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either a b
forall a b. a -> Either a b
Left a
x)
Done ByteString
inp (Right b
x) -> (forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b)
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b))
-> (forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b)
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success (Either a b) r
ks -> Success (Either a b) r
ks ByteString
inp (b -> Either a b
forall a b. b -> Either a b
Right b
x)
Fail ByteString
inp String
s -> (forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b)
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b))
-> (forall r. ByteString -> Success (Either a b) r -> Decoder r)
-> Get (Either a b)
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success (Either a b) r
_ -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
s
Decoder (Either a b)
_ -> String -> Get (Either a b)
forall a. HasCallStack => String -> a
error String
"Binary: impossible"
label :: String -> Get a -> Get a
label :: String -> Get a -> Get a
label String
msg Get a
decoder = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success a r
ks ->
let r0 :: Decoder a
r0 = Get a -> ByteString -> Success a a -> Decoder a
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
decoder ByteString
inp (\ByteString
inp' a
a -> Success a a
forall a. ByteString -> a -> Decoder a
Done ByteString
inp' a
a)
go :: Decoder a -> Decoder r
go Decoder a
r = case Decoder a
r of
Done ByteString
inp' a
a -> Success a r
ks ByteString
inp' a
a
Partial Maybe ByteString -> Decoder a
k -> (Maybe ByteString -> Decoder r) -> Decoder r
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial (Decoder a -> Decoder r
go (Decoder a -> Decoder r)
-> (Maybe ByteString -> Decoder a) -> Maybe ByteString -> Decoder r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Decoder a
k)
Fail ByteString
inp' String
s -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ByteString
inp' (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
BytesRead Int64
u Int64 -> Decoder a
k -> Int64 -> (Int64 -> Decoder r) -> Decoder r
forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
u (Decoder a -> Decoder r
go (Decoder a -> Decoder r)
-> (Int64 -> Decoder a) -> Int64 -> Decoder r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
in Decoder a -> Decoder r
go Decoder a
r0
{-# DEPRECATED remaining "This will force all remaining input, don't use it." #-}
remaining :: Get Int64
remaining :: Get Int64
remaining = (forall r. ByteString -> Success Int64 r -> Decoder r) -> Get Int64
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success Int64 r -> Decoder r)
-> Get Int64)
-> (forall r. ByteString -> Success Int64 r -> Decoder r)
-> Get Int64
forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success Int64 r
ks ->
let loop :: [ByteString] -> Decoder r
loop [ByteString]
acc = (Maybe ByteString -> Decoder r) -> Decoder r
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder r) -> Decoder r)
-> (Maybe ByteString -> Decoder r) -> Decoder r
forall a b. (a -> b) -> a -> b
$ \ Maybe ByteString
minp ->
case Maybe ByteString
minp of
Maybe ByteString
Nothing -> let all_inp :: ByteString
all_inp = [ByteString] -> ByteString
B.concat (ByteString
inp ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc))
in Success Int64 r
ks ByteString
all_inp (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
all_inp)
Just ByteString
inp' -> [ByteString] -> Decoder r
loop (ByteString
inp'ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
in [ByteString] -> Decoder r
loop []
getByteString :: Int -> Get B.ByteString
getByteString :: Int -> Get ByteString
getByteString Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
n (Int -> ByteString -> ByteString
B.unsafeTake Int
n)
| Bool
otherwise = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
{-# INLINE getByteString #-}
get :: Get B.ByteString
get :: Get ByteString
get = (forall r. ByteString -> Success ByteString r -> Decoder r)
-> Get ByteString
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success ByteString r -> Decoder r)
-> Get ByteString)
-> (forall r. ByteString -> Success ByteString r -> Decoder r)
-> Get ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success ByteString r
ks -> Success ByteString r
ks ByteString
inp ByteString
inp
put :: B.ByteString -> Get ()
put :: ByteString -> Get ()
put ByteString
s = (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success () r -> Decoder r) -> Get ())
-> (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a b. (a -> b) -> a -> b
$ \ByteString
_inp Success () r
ks -> Success () r
ks ByteString
s ()
readN :: Int -> (B.ByteString -> a) -> Get a
readN :: Int -> (ByteString -> a) -> Get a
readN !Int
n ByteString -> a
f = Int -> Get ()
ensureN Int
n Get () -> Get a -> Get a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> (ByteString -> a) -> Get a
forall a. Int -> (ByteString -> a) -> Get a
unsafeReadN Int
n ByteString -> a
f
{-# INLINE [0] readN #-}
{-# RULES
"readN/readN merge" forall n m f g.
apG (readN n f) (readN m g) = readN (n+m) (\bs -> f bs $ g (B.unsafeDrop n bs)) #-}
ensureN :: Int -> Get ()
ensureN :: Int -> Get ()
ensureN !Int
n0 = (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success () r -> Decoder r) -> Get ())
-> (forall r. ByteString -> Success () r -> Decoder r) -> Get ()
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success () r
ks -> do
if ByteString -> Int
B.length ByteString
inp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n0
then Success () r
ks ByteString
inp ()
else Get () -> ByteString -> Success () r -> Decoder r
forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont (Int
-> Consume Int
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks Int
n0 Consume Int
enoughChunks [ByteString] -> ByteString
onSucc [ByteString] -> Get ByteString
forall a. [ByteString] -> Get a
onFail Get ByteString -> (ByteString -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get ()
put) ByteString
inp Success () r
ks
where
enoughChunks :: Consume Int
enoughChunks Int
n ByteString
str
| ByteString -> Int
B.length ByteString
str Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = (ByteString, ByteString) -> Either Int (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
str,ByteString
B.empty)
| Bool
otherwise = Int -> Either Int (ByteString, ByteString)
forall a b. a -> Either a b
Left (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
str)
onSucc :: [ByteString] -> ByteString
onSucc = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ByteString -> Bool
B.null
onFail :: [ByteString] -> Get a
onFail [ByteString]
bss = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
_ -> ByteString -> String -> Decoder r
forall a. ByteString -> String -> Decoder a
Fail ([ByteString] -> ByteString
B.concat [ByteString]
bss) String
"not enough bytes"
{-# INLINE ensureN #-}
unsafeReadN :: Int -> (B.ByteString -> a) -> Get a
unsafeReadN :: Int -> (ByteString -> a) -> Get a
unsafeReadN !Int
n ByteString -> a
f = (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C ((forall r. ByteString -> Success a r -> Decoder r) -> Get a)
-> (forall r. ByteString -> Success a r -> Decoder r) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success a r
ks -> do
Success a r
ks (Int -> ByteString -> ByteString
B.unsafeDrop Int
n ByteString
inp) (a -> Decoder r) -> a -> Decoder r
forall a b. (a -> b) -> a -> b
$! ByteString -> a
f ByteString
inp
readNWith :: Int -> (Ptr a -> IO a) -> Get a
readNWith :: Int -> (Ptr a -> IO a) -> Get a
readNWith Int
n Ptr a -> IO a
f = do
Int -> (ByteString -> a) -> Get a
forall a. Int -> (ByteString -> a) -> Get a
readN Int
n ((ByteString -> a) -> Get a) -> (ByteString -> a) -> Get a
forall a b. (a -> b) -> a -> b
$ \ByteString
s -> IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s (Ptr a -> IO a
f (Ptr a -> IO a) -> (CString -> Ptr a) -> CString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)
{-# INLINE readNWith #-}