{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns, TypeFamilies #-}

-- CPP C style pre-precessing, the #if defined lines
-- RankNTypes forall r. statement
-- MagicHash the (# unboxing #), also needs GHC.primitives

module Data.Binary.Get.Internal (

    -- * The Get type
      Get
    , runCont
    , Decoder(..)
    , runGetIncremental

    , readN
    , readNWith

    -- * Parsing
    , bytesRead
    , isolate

    -- * With input chunks
    , withInputChunks
    , Consume
    , failOnEOF

    , get
    , put
    , ensureN

    -- * Utility
    , remaining
    , getBytes
    , isEmpty
    , lookAhead
    , lookAheadM
    , lookAheadE
    , label

    -- ** ByteStrings
    , 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 )

-- Kolmodin 20100427: at zurihac we discussed of having partial take a
-- "Maybe ByteString" and implemented it in this way.
-- The reasoning was that you could accidently provide an empty bytestring,
-- and it should not terminate the decoding (empty would mean eof).
-- However, I'd say that it's also a risk that you get stuck in a loop,
-- where you keep providing an empty string. Anyway, no new input should be
-- rare, as the RTS should only wake you up if you actually have some data
-- to read from your fd.

-- | A decoder produced by running a 'Get' monad.
data Decoder a = Fail !B.ByteString String
              -- ^ The decoder ran into an error. The decoder either used
              -- 'fail' or was not provided enough input.
              | Partial (Maybe B.ByteString -> Decoder a)
              -- ^ The decoder has consumed the available input and needs
              -- more to continue. Provide 'Just' if more input is available
              -- and 'Nothing' otherwise, and you will get a new 'Decoder'.
              | Done !B.ByteString a
              -- ^ The decoder has successfully finished. Except for the
              -- output value you also get the unused input.
              | BytesRead {-# UNPACK #-} !Int64 (Int64 -> Decoder a)
              -- ^ The decoder needs to know the current position in the input.
              -- Given the number of bytes remaning in the decoder, the outer
              -- decoder runner needs to calculate the position and
              -- resume the decoding.

-- unrolled codensity/state monad
newtype Get a = C { forall a. 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 :: forall a. a -> Get a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: forall a 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 -- base < 4.9
#elif !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail -- base < 4.13
#endif
-- NB: Starting with base-4.13, the `fail` method
--     has been removed from the `Monad`-class
--     according to the MonadFail proposal (MFP) schedule
--     which completes the process that started with base-4.9.

#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Get where
  fail :: forall a. String -> Get a
fail = forall a. String -> Get a
failG
#endif

bindG :: Get a -> (a -> Get b) -> Get b
bindG :: forall a b. Get a -> (a -> Get b) -> Get b
bindG (C forall r. ByteString -> Success a r -> Decoder r
c) a -> Get b
f = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
i Success b r
ks -> forall r. ByteString -> Success a r -> Decoder r
c ByteString
i (\ByteString
i' a
a -> (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 :: forall a. String -> Get a
failG String
str = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
i Success a r
_ks -> forall a. ByteString -> String -> Decoder a
Fail ByteString
i String
str

apG :: Get (a -> b) -> Get a -> Get b
apG :: forall a b. 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
  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 :: forall a b. (a -> b) -> Get a -> Get b
fmapG a -> b
f Get a
m = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
i Success b r
ks -> 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 :: forall a. a -> Get a
pure = \a
x -> forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
s Success a r
ks -> Success a r
ks ByteString
s a
x
  {-# INLINE [0] pure #-}
  <*> :: forall a b. Get (a -> b) -> Get a -> Get b
(<*>) = forall a b. Get (a -> b) -> Get a -> Get b
apG
  {-# INLINE (<*>) #-}

-- | @since 0.7.1.0
instance MonadPlus Get where
  mzero :: forall a. Get a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. Get a -> Get a -> Get a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Functor Get where
  fmap :: forall a b. (a -> b) -> Get a -> Get b
fmap = forall a b. (a -> b) -> Get a -> Get b
fmapG

instance Functor Decoder where
  fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f (Done ByteString
s a
a) = forall a. ByteString -> a -> Decoder a
Done ByteString
s (a -> b
f a
a)
  fmap a -> b
f (Partial Maybe ByteString -> Decoder a
k) = forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Decoder a
k)
  fmap a -> b
_ (Fail ByteString
s String
msg) = forall a. ByteString -> String -> Decoder a
Fail ByteString
s String
msg
  fmap a -> b
f (BytesRead Int64
b Int64 -> Decoder a
k) = forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
b (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f 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: " forall a. [a] -> [a] -> [a]
++ String
msg
  show (Partial Maybe ByteString -> Decoder a
_) = String
"Partial _"
  show (Done ByteString
_ a
a) = String
"Done: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a
  show (BytesRead Int64
_ Int64 -> Decoder a
_) = String
"BytesRead"

-- | Run a 'Get' monad. See 'Decoder' for what to do next, like providing
-- input, handling decoding errors and to get the output value.
runGetIncremental :: Get a -> Decoder a
runGetIncremental :: forall a. Get a -> Decoder a
runGetIncremental Get a
g = forall a. Decoder a -> Decoder a
noMeansNo forall a b. (a -> b) -> a -> b
$
  forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
g ByteString
B.empty (\ByteString
i a
a -> forall a. ByteString -> a -> Decoder a
Done ByteString
i a
a)

-- | Make sure we don't have to pass Nothing to a Partial twice.
-- This way we don't need to pass around an EOF value in the Get monad, it
-- can safely ask several times if it needs to.
noMeansNo :: Decoder a -> Decoder a
noMeansNo :: forall a. Decoder a -> Decoder a
noMeansNo Decoder a
r0 = 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 -> forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial 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 -> forall a. Decoder a -> Decoder a
neverAgain (Maybe ByteString -> Decoder a
k Maybe ByteString
ms)
      BytesRead Int64
n Int64 -> Decoder a
k -> forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
n (Decoder a -> Decoder a
go 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 forall a. Maybe a
Nothing)
      BytesRead Int64
n Int64 -> Decoder a
k -> forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
n (Decoder a -> Decoder a
neverAgain 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 :: forall a.
ByteString -> Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt ByteString
inp Decoder a
kf ByteString -> Decoder a
ks = 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' :: forall a. Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt' Decoder a
kf ByteString -> Decoder a
ks =
  let loop :: Decoder a
loop =
        forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial 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

-- | Get the total number of bytes read to this point.
bytesRead :: Get Int64
bytesRead :: Get Int64
bytesRead = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success Int64 r
k -> forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
inp) (Success Int64 r
k ByteString
inp)

-- | Isolate a decoder to operate with a fixed number of bytes, and fail if
-- fewer bytes were consumed, or more bytes were attempted to be consumed.
-- If the given decoder fails, 'isolate' will also fail.
-- Offset from 'bytesRead' will be relative to the start of 'isolate', not the
-- absolute of the input.
--
-- @since 0.7.2.0
isolate :: Int   -- ^ The number of bytes that must be consumed
        -> Get a -- ^ The decoder to isolate
        -> Get a
isolate :: forall a. Int -> Get a -> Get a
isolate Int
n0 Get a
act
  | Int
n0 forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"isolate: negative size"
  | Bool
otherwise = Int -> Decoder a -> Get a
go Int
n0 (forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
act ByteString
B.empty forall a. ByteString -> a -> Decoder a
Done)
  where
  go :: Int -> Decoder a -> Get a
go !Int
n (Done ByteString
left a
x)
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& ByteString -> Bool
B.null ByteString
left = 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 forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
left
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"isolate: the decoder consumed " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
consumed forall a. [a] -> [a] -> [a]
++ String
" bytes" forall a. [a] -> [a] -> [a]
++
                 String
" which is less than the expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n0 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 forall a. Maybe a
Nothing)
  go Int
n (Partial Maybe ByteString -> Decoder a
resume) = do
    Maybe ByteString
inp <- forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C 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 (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 -> forall a.
ByteString -> Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt ByteString
inp (Success (Maybe ByteString) r
k ByteString
B.empty 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 forall a. Maybe a
Nothing)
      Just ByteString
str -> Int -> Decoder a -> Get a
go (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
str) (Maybe ByteString -> Decoder a
resume (forall a. a -> Maybe a
Just ByteString
str))
  go Int
_ (Fail ByteString
bs String
err) = ByteString -> Get ()
pushFront ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n0 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n 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 :: forall s b.
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 a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C 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 forall a. a -> [a] -> [a]
: [ByteString]
acc
        forall a. Decoder a -> (ByteString -> Decoder a) -> Decoder a
prompt'
          (forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont ([ByteString] -> Get b
onFail (forall a. [a] -> [a]
reverse [ByteString]
acc')) ByteString
B.empty Success b r
ks)
          (\ByteString
str' -> 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 (forall a. [a] -> [a]
reverse (ByteString
wantforall a. a -> [a] -> [a]
:[ByteString]
acc)))

failOnEOF :: [B.ByteString] -> Get a
failOnEOF :: forall a. [ByteString] -> Get a
failOnEOF [ByteString]
bs = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
_ -> forall a. ByteString -> String -> Decoder a
Fail ([ByteString] -> ByteString
B.concat [ByteString]
bs) String
"not enough bytes"

-- | Test whether all input has been consumed, i.e. there are no remaining
-- undecoded bytes.
isEmpty :: Get Bool
isEmpty :: Get Bool
isEmpty = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success Bool r
ks ->
    if ByteString -> Bool
B.null ByteString
inp
      then 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. Same as 'getByteString'.
{-# DEPRECATED getBytes "Use 'getByteString' instead of 'getBytes'." #-}
getBytes :: Int -> Get B.ByteString
getBytes :: Int -> Get ByteString
getBytes = Int -> Get ByteString
getByteString
{-# INLINE getBytes #-}

-- | @since 0.7.0.0
instance Alternative Get where
  empty :: forall a. Get a
empty = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success a r
_ks -> forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
"Data.Binary.Get(Alternative).empty"
  {-# INLINE empty #-}
  <|> :: forall a. Get a -> Get a -> Get a
(<|>) Get a
f Get a
g = do
    (Decoder a
decoder, [ByteString]
bs) <- forall a. Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get a
f
    case Decoder a
decoder of
      Done ByteString
inp a
x -> forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get a
g
      Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"Binary: impossible"
  {-# INLINE (<|>) #-}
  some :: forall a. Get a -> Get [a]
some Get a
p = (:) 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
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
p
  {-# INLINE some #-}
  many :: forall a. Get a -> Get [a]
many Get a
p = do
    Maybe a
v <- (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    case Maybe a
v of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just a
x -> (:) a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
p
  {-# INLINE many #-}

-- | Run a decoder and keep track of all the input it consumes.
-- Once it's finished, return the final decoder (always 'Done' or 'Fail'),
-- and unconsume all the the input the decoder required to run.
-- Any additional chunks which was required to run the decoder
-- will also be returned.
runAndKeepTrack :: Get a -> Get (Decoder a, [B.ByteString])
runAndKeepTrack :: forall a. Get a -> Get (Decoder a, [ByteString])
runAndKeepTrack Get a
g = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success (Decoder a, [ByteString]) r
ks ->
  let r0 :: Decoder a
r0 = forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
g ByteString
inp (\ByteString
inp' 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 (forall a. ByteString -> a -> Decoder a
Done ByteString
inp' a
a, forall a. [a] -> [a]
reverse [ByteString]
acc)
                    Partial Maybe ByteString -> Decoder a
k -> forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
minp -> [ByteString] -> Decoder a -> Decoder r
go (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
acc (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 (forall a. ByteString -> String -> Decoder a
Fail ByteString
inp' String
s, forall a. [a] -> [a]
reverse [ByteString]
acc)
                    BytesRead Int64
unused Int64 -> Decoder a
k -> forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
unused ([ByteString] -> Decoder a -> Decoder r
go [ByteString]
acc 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 a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success () r
ks -> Success () r
ks ByteString
inp ()
pushBack [ByteString]
bs = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success () r
ks -> Success () r
ks ([ByteString] -> ByteString
B.concat (ByteString
inp forall a. a -> [a] -> [a]
: [ByteString]
bs)) ()
{-# INLINE pushBack #-}

pushFront :: B.ByteString -> Get ()
pushFront :: ByteString -> Get ()
pushFront ByteString
bs = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C 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 #-}

-- | Run the given decoder, but without consuming its input. If the given
-- decoder fails, then so will this function.
--
-- @since 0.7.0.0
lookAhead :: Get a -> Get a
lookAhead :: forall a. Get a -> Get a
lookAhead Get a
g = do
  (Decoder a
decoder, [ByteString]
bs) <- 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Fail ByteString
inp String
s -> forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a r
_ -> forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
s
    Decoder a
_ -> forall a. HasCallStack => String -> a
error String
"Binary: impossible"

-- | Run the given decoder, and only consume its input if it returns 'Just'.
-- If 'Nothing' is returned, the input will be unconsumed.
-- If the given decoder fails, then so will this function.
--
-- @since 0.7.0.0
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM :: forall a. Get (Maybe a) -> Get (Maybe a)
lookAheadM Get (Maybe a)
g = do
  let g' :: Get (Either () a)
g' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ()) forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe a)
g
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either () a)
g'

-- | Run the given decoder, and only consume its input if it returns 'Right'.
-- If 'Left' is returned, the input will be unconsumed.
-- If the given decoder fails, then so will this function.
--
-- @since 0.7.1.0
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE :: forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either a b)
g = do
  (Decoder (Either a b)
decoder, [ByteString]
bs) <- 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
x)
    Done ByteString
inp (Right b
x) -> forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success (Either a b) r
ks -> Success (Either a b) r
ks ByteString
inp (forall a b. b -> Either a b
Right b
x)
    Fail ByteString
inp String
s -> forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success (Either a b) r
_ -> forall a. ByteString -> String -> Decoder a
Fail ByteString
inp String
s
    Decoder (Either a b)
_ -> forall a. HasCallStack => String -> a
error String
"Binary: impossible"

-- | Label a decoder. If the decoder fails, the label will be appended on
-- a new line to the error message string.
--
-- @since 0.7.2.0
label :: String -> Get a -> Get a
label :: forall a. String -> Get a -> Get a
label String
msg Get a
decoder = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success a r
ks ->
  let r0 :: Decoder a
r0 = forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont Get a
decoder ByteString
inp (\ByteString
inp' 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 -> forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial (Decoder a -> Decoder r
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Decoder a
k)
                 Fail ByteString
inp' String
s -> forall a. ByteString -> String -> Decoder a
Fail ByteString
inp' (String
s forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
msg)
                 BytesRead Int64
u Int64 -> Decoder a
k -> forall a. Int64 -> (Int64 -> Decoder a) -> Decoder a
BytesRead Int64
u (Decoder a -> Decoder r
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Decoder a
k)
  in Decoder a -> Decoder r
go Decoder a
r0

-- | DEPRECATED. Get the number of bytes of remaining input.
-- Note that this is an expensive function to use as in order to calculate how
-- much input remains, all input has to be read and kept in-memory.
-- The decoder keeps the input as a strict bytestring, so you are likely better
-- off by calculating the remaining input in another way.
{-# DEPRECATED remaining "This will force all remaining input, don't use it." #-}
remaining :: Get Int64
remaining :: Get Int64
remaining = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ ByteString
inp Success Int64 r
ks ->
  let loop :: [ByteString] -> Decoder r
loop [ByteString]
acc = forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial 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 forall a. a -> [a] -> [a]
: (forall a. [a] -> [a]
reverse [ByteString]
acc))
                               in Success Int64 r
ks ByteString
all_inp (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
all_inp)
                    Just ByteString
inp' -> [ByteString] -> Decoder r
loop (ByteString
inp'forall a. a -> [a] -> [a]
:[ByteString]
acc)
  in [ByteString] -> Decoder r
loop []

------------------------------------------------------------------------
-- ByteStrings
--

-- | An efficient get method for strict ByteStrings. Fails if fewer than @n@
-- bytes are left in the input. If @n <= 0@ then the empty string is returned.
getByteString :: Int -> Get B.ByteString
getByteString :: Int -> Get ByteString
getByteString Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. Int -> (ByteString -> a) -> Get a
readN Int
n (Int -> ByteString -> ByteString
B.unsafeTake Int
n)
                | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
{-# INLINE getByteString #-}

-- | Get the current chunk.
get :: Get B.ByteString
get :: Get ByteString
get = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success ByteString r
ks -> Success ByteString r
ks ByteString
inp ByteString
inp

-- | Replace the current chunk.
put :: B.ByteString -> Get ()
put :: ByteString -> Get ()
put ByteString
s = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_inp Success () r
ks -> Success () r
ks ByteString
s ()

-- | Return at least @n@ bytes, maybe more. If not enough data is available
-- the computation will escape with 'Partial'.
readN :: Int -> (B.ByteString -> a) -> Get a
readN :: forall a. Int -> (ByteString -> a) -> Get a
readN !Int
n ByteString -> a
f = Int -> Get ()
ensureN Int
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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)) #-}

-- | Ensure that there are at least @n@ bytes available. If not, the
-- computation will escape with 'Partial'.
ensureN :: Int -> Get ()
ensureN :: Int -> Get ()
ensureN !Int
n0 = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
inp Success () r
ks -> do
  if ByteString -> Int
B.length ByteString
inp forall a. Ord a => a -> a -> Bool
>= Int
n0
    then Success () r
ks ByteString
inp ()
    else forall a. Get a -> forall r. ByteString -> Success a r -> Decoder r
runCont (forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks Int
n0 Int -> ByteString -> Either Int (ByteString, ByteString)
enoughChunks [ByteString] -> ByteString
onSucc forall a. [ByteString] -> Get a
onFail forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Get ()
put) ByteString
inp Success () r
ks
  where -- might look a bit funny, but plays very well with GHC's inliner.
        -- GHC won't inline recursive functions, so we make ensureN non-recursive
    enoughChunks :: Int -> ByteString -> Either Int (ByteString, ByteString)
enoughChunks Int
n ByteString
str
      | ByteString -> Int
B.length ByteString
str forall a. Ord a => a -> a -> Bool
>= Int
n = forall a b. b -> Either a b
Right (ByteString
str,ByteString
B.empty)
      | Bool
otherwise = forall a b. a -> Either a b
Left (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
str)
    -- Sometimes we will produce leftovers lists of the form [B.empty, nonempty]
    -- where `nonempty` is a non-empty ByteString. In this case we can avoid a copy
    -- by simply dropping the empty prefix. In principle ByteString might want
    -- to gain this optimization as well
    onSucc :: [ByteString] -> ByteString
onSucc = [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile ByteString -> Bool
B.null
    onFail :: [ByteString] -> Get a
onFail [ByteString]
bss = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C forall a b. (a -> b) -> a -> b
$ \ByteString
_ Success a 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 :: forall a. Int -> (ByteString -> a) -> Get a
unsafeReadN !Int
n ByteString -> a
f = forall a.
(forall r. ByteString -> Success a r -> Decoder r) -> Get a
C 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) forall a b. (a -> b) -> a -> b
$! ByteString -> a
f ByteString
inp -- strict return

-- | @readNWith n f@ where @f@ must be deterministic and not have side effects.
readNWith :: Int -> (Ptr a -> IO a) -> Get a
readNWith :: forall a. Int -> (Ptr a -> IO a) -> Get a
readNWith Int
n Ptr a -> IO a
f = do
    -- It should be safe to use accursedUnutterablePerformIO here.
    -- The action must be deterministic and not have any external side effects.
    -- It depends on the value of the ByteString so the value dependencies look OK.
    forall a. Int -> (ByteString -> a) -> Get a
readN Int
n forall a b. (a -> b) -> a -> b
$ \ByteString
s -> forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s (Ptr a -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
{-# INLINE readNWith #-}