{-# LANGUAGE CPP,MagicHash,ScopedTypeVariables,FlexibleInstances,RankNTypes,TypeSynonymInstances,MultiParamTypeClasses,BangPatterns,CPP #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- | By Chris Kuklewicz, drawing heavily from binary and binary-strict,
-- but all the bugs are my own.
--
-- This file is under the usual BSD3 licence, copyright 2008.
--
-- Modified the monad to be strict for version 2.0.0
--
-- This started out as an improvement to
-- "Data.Binary.Strict.IncrementalGet" with slightly better internals.
-- The simplified 'Get', 'runGet', 'Result' trio with the
-- "Data.Binary.Strict.Class.BinaryParser" instance are an _untested_
-- upgrade from IncrementalGet.  Especially untested are the
-- strictness properties.
--
-- 'Get' usefully implements Applicative and Monad, MonadError,
-- Alternative and MonadPlus.  Unhandled errors are reported along
-- with the number of bytes successfully consumed.  Effects of
-- 'suspend' and 'putAvailable' are visible after
-- fail/throwError/mzero.
--
-- Each time the parser reaches the end of the input it will return a
-- Partial wrapped continuation which requests a (Maybe
-- Lazy.ByteString).  Passing (Just bs) will append bs to the input so
-- far and continue processing.  If you pass Nothing to the
-- continuation then you are declaring that there will never be more
-- input and that the parser should never again return a partial
-- contination; it should return failure or finished.
--
-- 'suspendUntilComplete' repeatedly uses a partial continuation to
-- ask for more input until 'Nothing' is passed and then it proceeds
-- with parsing.
--
-- The 'getAvailable' command returns the lazy byte string the parser
-- has remaining before calling 'suspend'.  The 'putAvailable'
-- replaces this input and is a bit fancy: it also replaces the input
-- at the current offset for all the potential catchError/mplus
-- handlers.  This change is _not_ reverted by fail/throwError/mzero.
--
-- The three 'lookAhead' and 'lookAheadM' and 'lookAheadE' functions are
-- very similar to the ones in binary's Data.Binary.Get.
--
--
-- Add specialized high-bit-run
module Text.ProtocolBuffers.Get
    (Get,runGet,runGetAll,Result(..)
     -- main primitives
    ,ensureBytes,getStorable,getLazyByteString,suspendUntilComplete
     -- parser state manipulation
    ,getAvailable,putAvailable
     -- lookAhead capabilities
    ,lookAhead,lookAheadM,lookAheadE
     -- below is for implementation of BinaryParser (for Int64 and Lazy bytestrings)
    ,skip,bytesRead,isEmpty,isReallyEmpty,remaining,spanOf,highBitRun
    ,getWord8,getByteString
    ,getWord16be,getWord32be,getWord64be
    ,getWord16le,getWord32le,getWord64le
    ,getWordhost,getWord16host,getWord32host,getWord64host
    --
    -- ,scan
    ,decode7,decode7size,decode7unrolled
    ) where

-- The Get monad is an instance of binary-strict's BinaryParser:
-- import qualified Data.Binary.Strict.Class as P(BinaryParser(..))
-- The Get monad is an instance of all of these library classes:
import Control.Applicative(Alternative(empty,(<|>)))
import Control.Monad(MonadPlus(mzero,mplus),when)
import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg))
-- It can be a MonadCont, but the semantics are too broken without a ton of work.

-- implementation imports
--import Control.Monad(replicateM,(>=>))           -- XXX testing
--import qualified Data.ByteString as S(unpack)    -- XXX testing
--import qualified Data.ByteString.Lazy as L(pack) -- XXX testing
import Control.Monad(ap)                             -- instead of Functor.fmap; ap for Applicative
import qualified Control.Monad.Fail as Fail
import Data.Bits(Bits((.|.),(.&.)),shiftL)
import qualified Data.ByteString as S(concat,length,null,splitAt,findIndex)
import qualified Data.ByteString.Internal as S(ByteString(..),toForeignPtr,inlinePerformIO)
import qualified Data.ByteString.Unsafe as S(unsafeIndex,unsafeDrop {-,unsafeTake-})
import qualified Data.ByteString.Lazy as L(take,drop,length,span,toChunks,fromChunks,null,findIndex)
import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk)
import qualified Data.Foldable as F(foldr,foldr1)    -- used with Seq
import Data.Int(Int32,Int64)                         -- index type for L.ByteString
import Data.Word(Word8,Word16,Word32,Word64)
import Data.Sequence(Seq,null,(|>))                  -- used for future queue in handler state
import Foreign.ForeignPtr(withForeignPtr)
import Foreign.Ptr(Ptr,castPtr,plusPtr,minusPtr,nullPtr)
import Foreign.Storable(Storable(peek,sizeOf))
import System.IO.Unsafe(unsafePerformIO)
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
import GHC.Base(Int(..),uncheckedShiftL#)
import GHC.Word(Word16(..),Word32(..),Word64(..),uncheckedShiftL64#)
#endif
--import Debug.Trace(trace)

trace :: a -> b -> b
trace :: a -> b -> b
trace a
_ = b -> b
forall a. a -> a
id

-- Simple external return type
data Result a = Failed {-# UNPACK #-} !Int64 String
              | Finished !L.ByteString {-# UNPACK #-} !Int64 a
              | Partial (Maybe L.ByteString -> Result a)

-- Internal state type, not exposed to the user.
-- Invariant: (S.null _top) implies (L.null _current)
data S = S { S -> ByteString
_top :: {-# UNPACK #-} !S.ByteString
           , S -> ByteString
_current :: !L.ByteString
           , S -> Int64
consumed :: {-# UNPACK #-} !Int64
           } deriving Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S] -> ShowS
$cshowList :: [S] -> ShowS
show :: S -> String
$cshow :: S -> String
showsPrec :: Int -> S -> ShowS
$cshowsPrec :: Int -> S -> ShowS
Show

data T3 s = T3 !Int !s !Int

--data TU s = TU'OK !s !Int | TU'DO (Get s)
data TU s = TU'OK !s !Int

{-# SPECIALIZE decode7unrolled :: Get Int64 #-}
{-# SPECIALIZE decode7unrolled :: Get Int32 #-}
{-# SPECIALIZE decode7unrolled :: Get Word64 #-}
{-# SPECIALIZE decode7unrolled :: Get Word32 #-}
{-# SPECIALIZE decode7unrolled :: Get Int #-}
{-# SPECIALIZE decode7unrolled :: Get Integer #-}
decode7unrolled :: forall s. (Num s,Integral s, Bits s) => Get s
-- NOINLINE decode7unrolled removed to allow SPECIALIZE to work
decode7unrolled :: Get s
decode7unrolled = (forall b. Success b s -> S -> FrameStack b -> Result b) -> Get s
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b s -> S -> FrameStack b -> Result b) -> Get s)
-> (forall b. Success b s -> S -> FrameStack b -> Result b)
-> Get s
forall a b. (a -> b) -> a -> b
$ \ Success b s
sc sIn :: S
sIn@(S ss :: ByteString
ss@(S.PS ForeignPtr Word8
fp Int
off Int
len) ByteString
bs Int64
n) FrameStack b
pc -> String -> Result b -> Result b
forall a b. a -> b -> b
trace (String
"decode7unrolled: "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int, Int64) -> String
forall a. Show a => a -> String
show (Int
len,Int64
n)) (Result b -> Result b) -> Result b -> Result b
forall a b. (a -> b) -> a -> b
$
  if ByteString -> Bool
S.null ByteString
ss
    then String -> Result b -> Result b
forall a b. a -> b -> b
trace (String
"decode7unrolled: S.null ss") (Result b -> Result b) -> Result b -> Result b
forall a b. (a -> b) -> a -> b
$ Get s -> Success b s -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet Get s
forall s. (Integral s, Bits s) => Get s
decode7 Success b s
sc S
sIn FrameStack b
pc -- decode7 will try suspend then will fail if still bad
    else
      let (TU'OK s
x Int
i) =
            IO (TU s) -> TU s
forall a. IO a -> a
unsafePerformIO (IO (TU s) -> TU s) -> IO (TU s) -> TU s
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (TU s)) -> IO (TU s)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (TU s)) -> IO (TU s))
-> (Ptr Word8 -> IO (TU s)) -> IO (TU s)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 -> do
                if Ptr Word8
ptr0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then String -> IO (TU s)
forall a. HasCallStack => String -> a
error String
"Get.decode7unrolled: ByteString invariant failed" else do
                  let ok :: s -> Int -> IO (TU s)
                      ok :: s -> Int -> IO (TU s)
ok s
x0 Int
i0 = TU s -> IO (TU s)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Int -> TU s
forall s. s -> Int -> TU s
TU'OK s
x0 Int
i0)
                      more,err :: IO (TU s)
                      more :: IO (TU s)
more = TU s -> IO (TU s)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Int -> TU s
forall s. s -> Int -> TU s
TU'OK s
0 Int
0)  -- decode7
                      err :: IO (TU s)
err = TU s -> IO (TU s)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Int -> TU s
forall s. s -> Int -> TU s
TU'OK s
0 (-Int
1))  -- throwError
                      {-# INLINE ok #-}
                      {-# INLINE more #-}
                      {-# INLINE err #-}

  --                -- Next line is segfault fix for null bytestrings from Nathan Howell <nhowell@alphaheavy.com>
  --                if ptr0 == nullPtr then more else do

                  let start :: Ptr Word8
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off :: Ptr Word8
                  Word8
b'1 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
start
                  if Word8
b'1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'1) Int
1 else do
                    let !val'1 :: s
val'1 = Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F)
                        !end :: Ptr Word8
end = Ptr Word8
start Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
                        !ptr2 :: Ptr Word8
ptr2 = Ptr Word8
start Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 :: Ptr Word8
                    if Ptr Word8
ptr2 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                      Word8
b'2 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr2
                      if Word8
b'2 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'1 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'2 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
7)) Int
2 else do
                        let !val'2 :: s
val'2 = (s
val'1 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
7))
                            !ptr3 :: Ptr Word8
ptr3 = Ptr Word8
ptr2 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                        if Ptr Word8
ptr3 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                          Word8
b'3::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr3
                          if Word8
b'3 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'2 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'3 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
14)) Int
3 else do
                            let !val'3 :: s
val'3 = (s
val'2 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
14))
                                !ptr4 :: Ptr Word8
ptr4 = Ptr Word8
ptr3 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                            if Ptr Word8
ptr4 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                              Word8
b'4::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr4
                              if Word8
b'4 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'3 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'4 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
21)) Int
4 else do
                                let !val'4 :: s
val'4 = (s
val'3 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
21))
                                    !ptr5 :: Ptr Word8
ptr5 = Ptr Word8
ptr4 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                if Ptr Word8
ptr5 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                  Word8
b'5::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr5
                                  if Word8
b'5 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'4 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'5 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
28)) Int
5 else do
                                    let !val'5 :: s
val'5 = (s
val'4 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'5 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
28))
                                        !ptr6 :: Ptr Word8
ptr6 = Ptr Word8
ptr5 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                    if Ptr Word8
ptr6 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                      Word8
b'6::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr6
                                      if Word8
b'6 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'5 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'6 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
35)) Int
6 else do
                                        let !val'6 :: s
val'6 = (s
val'5 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
35))
                                            !ptr7 :: Ptr Word8
ptr7 = Ptr Word8
ptr6 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                        if Ptr Word8
ptr7 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                          Word8
b'7::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr7
                                          if Word8
b'7 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'6 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'7 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
42)) Int
7 else do
                                            let !val'7 :: s
val'7 = (s
val'6 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
42))
                                                !ptr8 :: Ptr Word8
ptr8 = Ptr Word8
ptr7 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                            if Ptr Word8
ptr8 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                              Word8
b'8::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr8
                                              if Word8
b'8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'7 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'8 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
49)) Int
8 else do
                                                let !val'8 :: s
val'8 = (s
val'7 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
49))
                                                    !ptr9 :: Ptr Word8
ptr9 = Ptr Word8
ptr8 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                                if Ptr Word8
ptr9 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                                  Word8
b'9::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr9
                                                  if Word8
b'9 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'8 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'9 s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)) Int
9 else do
                                                    let !val'9 :: s
val'9 = (s
val'8 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b'9 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
56))
                                                        !ptrA :: Ptr Word8
ptrA = Ptr Word8
ptr9 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
                                                    if Ptr Word8
ptrA Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
end then IO (TU s)
more else do

                                                      Word8
b'A::Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptrA
                                                      if Word8
b'A Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then s -> Int -> IO (TU s)
ok (s
val'9 s -> s -> s
forall a. Bits a => a -> a -> a
.|. (Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b'A s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
63)) Int
10 else do
                                                        IO (TU s)
err

      in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           then let ss' :: ByteString
ss' = (Int -> ByteString -> ByteString
S.unsafeDrop Int
i ByteString
ss)
                    n' :: Int64
n' = Int64
nInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
                    s'safe :: S
s'safe = S -> S
make_safe (ByteString -> ByteString -> Int64 -> S
S ByteString
ss' ByteString
bs Int64
n')
                in Success b s
sc s
x S
s'safe FrameStack b
pc
           else if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then Get s -> Success b s -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet Get s
forall s. (Integral s, Bits s) => Get s
decode7 Success b s
sc S
sIn FrameStack b
pc
                        else Get s -> Success b s -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet (String -> Get s
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get s) -> String -> Get s
forall a b. (a -> b) -> a -> b
$ String
"Text.ProtocolBuffers.Get.decode7unrolled: more than 10 bytes needed at bytes read of "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int64 -> String
forall a. Show a => a -> String
show Int64
n) Success b s
sc S
sIn FrameStack b
pc

{-# SPECIALIZE decode7 :: Get Int64 #-}
{-# SPECIALIZE decode7 :: Get Int32 #-}
{-# SPECIALIZE decode7 :: Get Word64 #-}
{-# SPECIALIZE decode7 :: Get Word32 #-}
{-# SPECIALIZE decode7 :: Get Int #-}
{-# SPECIALIZE decode7 :: Get Integer #-}
decode7 :: forall s. (Integral s, Bits s) => Get s
-- NOINLINE decode7 removed to allow SPECIALIZE to work
decode7 :: Get s
decode7 = s -> Int -> Get s
go s
0 Int
0
 where
  go :: s -> Int -> Get s
go !s
s1 !Int
shift1 = String -> Get s -> Get s
forall a b. a -> b -> b
trace (String
"decode7.go: "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Integer, Int) -> String
forall a. Show a => a -> String
show (s -> Integer
forall a. Integral a => a -> Integer
toInteger s
s1, Int
shift1)) (Get s -> Get s) -> Get s -> Get s
forall a b. (a -> b) -> a -> b
$ do
    let -- scanner's inner loop decodes only in current top strict bytestring, does not advance input state
        scanner :: ByteString -> IO (T3 s)
scanner (S.PS ForeignPtr Word8
fp Int
off Int
len) =
          ForeignPtr Word8 -> (Ptr Word8 -> IO (T3 s)) -> IO (T3 s)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (T3 s)) -> IO (T3 s))
-> (Ptr Word8 -> IO (T3 s)) -> IO (T3 s)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 -> do
           if Ptr Word8
ptr0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then String -> IO (T3 s)
forall a. HasCallStack => String -> a
error String
"Get.decode7: ByteString invariant failed" else do
            let start :: Ptr Word8
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off   -- start is a pointer to the next valid byte
                end :: Ptr Word8
end   = Ptr Word8
start Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len  -- end is a pointer one byte past the last valid byte
                inner :: (Ptr Word8) -> s -> Int -> IO (T3 s)
                inner :: Ptr Word8 -> s -> Int -> IO (T3 s)
inner !Ptr Word8
ptr !s
s !Int
shift
                  | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
                      Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
                      String -> IO (T3 s) -> IO (T3 s)
forall a b. a -> b -> b
trace (String
"w: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w) (IO (T3 s) -> IO (T3 s)) -> IO (T3 s) -> IO (T3 s)
forall a b. (a -> b) -> a -> b
$ do
                        if (Word8
128Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>) Word8
w
                          then T3 s -> IO (T3 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (T3 s -> IO (T3 s)) -> T3 s -> IO (T3 s)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Int -> T3 s
forall s. Int -> s -> Int -> T3 s
T3 (Int -> Int
forall a. Enum a => a -> a
succ (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start) )            -- length of capture
                                           (s
s s -> s -> s
forall a. Bits a => a -> a -> a
.|. ((Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift)) -- put the last bits into high position
                                           (-Int
1)                                      -- negative shift indicates satisfied
                          else Ptr Word8 -> s -> Int -> IO (T3 s)
inner (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)  -- loop on next byte
                                     (s
s s -> s -> s
forall a. Bits a => a -> a -> a
.|. ((Word8 -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F)) s -> Int -> s
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift)) -- put the new bits into high position
                                     (Int
shiftInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7)          -- increase high position for next loop
                  | Bool
otherwise = T3 s -> IO (T3 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (T3 s -> IO (T3 s)) -> T3 s -> IO (T3 s)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Int -> T3 s
forall s. Int -> s -> Int -> T3 s
T3 (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start)  -- length so far (ptr past end-of-string so no succ)
                                            s
s                       -- value so far
                                            Int
shift                   -- next shift to use
            Ptr Word8 -> s -> Int -> IO (T3 s)
inner Ptr Word8
start s
s1 Int
shift1
    (S ByteString
ss ByteString
bs Int64
n) <- Get S
getFull
    String -> Get s -> Get s
forall a b. a -> b -> b
trace (String
"getFull says: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Int, ByteString), Int64, Int64) -> String
forall a. Show a => a -> String
show ((ByteString -> Int
S.length ByteString
ss,ByteString
ss),(ByteString -> Int64
L.length ByteString
bs),Int64
n)) (Get s -> Get s) -> Get s -> Get s
forall a b. (a -> b) -> a -> b
$ do
      if ByteString -> Bool
S.null ByteString
ss
        then do
          Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
          if Bool
continue
            then s -> Int -> Get s
go s
s1 Int
shift1
            else String -> Get s
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Get.decode7: Zero length input" -- XXX can be triggered!
        else do
          let (T3 Int
i s
sOut Int
shiftOut) = IO (T3 s) -> T3 s
forall a. IO a -> a
unsafePerformIO (IO (T3 s) -> T3 s) -> IO (T3 s) -> T3 s
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (T3 s)
scanner ByteString
ss
              t :: ByteString
t = Int -> ByteString -> ByteString
S.unsafeDrop Int
i ByteString
ss -- Warning: 't' may be mempty
              n' :: Int64
n' = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
          String -> Get s -> Get s
forall a b. a -> b -> b
trace (String
"scanner says "String -> ShowS
forall a. [a] -> [a] -> [a]
++((Int, Integer, Int), (Int, Int64)) -> String
forall a. Show a => a -> String
show ((Int
i,s -> Integer
forall a. Integral a => a -> Integer
toInteger s
sOut,Int
shiftOut),(ByteString -> Int
S.length ByteString
t,Int64
n'))) (Get s -> Get s) -> Get s -> Get s
forall a b. (a -> b) -> a -> b
$ do
            if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
shiftOut
              then do
                S -> Get ()
putFull_unsafe (ByteString -> Int64 -> S
make_state ByteString
bs Int64
n')
                if ByteString -> Bool
L.null ByteString
bs
                  then do
                    Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
                    if Bool
continue
                      then s -> Int -> Get s
go s
sOut Int
shiftOut
                      else s -> Get s
forall (m :: * -> *) a. Monad m => a -> m a
return s
sOut
                  else do
                    s -> Int -> Get s
go s
sOut Int
shiftOut
              else do
                S -> Get ()
putFull_safe (ByteString -> ByteString -> Int64 -> S
S ByteString
t ByteString
bs Int64
n') -- bs from getFull is still valid
                s -> Get s
forall (m :: * -> *) a. Monad m => a -> m a
return s
sOut

data T2 = T2 !Int64 !Bool

decode7size :: Get Int64
decode7size :: Get Int64
decode7size = Int64 -> Get Int64
go Int64
0
 where
  go :: Int64 -> Get Int64
go !Int64
len1 = do
    let scanner :: ByteString -> IO T2
scanner (S.PS ForeignPtr Word8
fp Int
off Int
len) =
          ForeignPtr Word8 -> (Ptr Word8 -> IO T2) -> IO T2
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO T2) -> IO T2) -> (Ptr Word8 -> IO T2) -> IO T2
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr0 -> do
           if Ptr Word8
ptr0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then String -> IO T2
forall a. HasCallStack => String -> a
error String
"Get.decode7size: ByteString invariant failed" else do
            let start :: Ptr Word8
start = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
                end :: Ptr Word8
end   = Ptr Word8
start Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
                inner :: (Ptr Word8) -> IO T2
                inner :: Ptr Word8 -> IO T2
inner !Ptr Word8
ptr
                  | Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr Word8
end = do
                      Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
                      if (Word8
128Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>) Word8
w
                        then T2 -> IO T2
forall (m :: * -> *) a. Monad m => a -> m a
return (T2 -> IO T2) -> T2 -> IO T2
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> T2
T2 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start)) Bool
True
                        else Ptr Word8 -> IO T2
inner (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
                  | Bool
otherwise = T2 -> IO T2
forall (m :: * -> *) a. Monad m => a -> m a
return (T2 -> IO T2) -> T2 -> IO T2
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> T2
T2 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
start)) Bool
False
            Ptr Word8 -> IO T2
inner Ptr Word8
start
    (S ByteString
ss ByteString
bs Int64
n) <- Get S
getFull
    if ByteString -> Bool
S.null ByteString
ss
      then do
        Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
        if Bool
continue
          then Int64 -> Get Int64
go Int64
len1
          else String -> Get Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Get.decode7size: zero length input"
      else do
        let (T2 Int64
i Bool
ok) = IO T2 -> T2
forall a. IO a -> a
unsafePerformIO (IO T2 -> T2) -> IO T2 -> T2
forall a b. (a -> b) -> a -> b
$ ByteString -> IO T2
scanner ByteString
ss
            t :: ByteString
t = Int -> ByteString -> ByteString
S.unsafeDrop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i) ByteString
ss
            n' :: Int64
n' = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i
            len2 :: Int64
len2 = Int64
len1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
i
        if Bool
ok
          then do
            S -> Get ()
putFull_unsafe (ByteString -> ByteString -> Int64 -> S
S ByteString
t ByteString
bs Int64
n')
            Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
len2
          else do
            S -> Get ()
putFull_unsafe (ByteString -> Int64 -> S
make_state ByteString
bs Int64
n')
            if ByteString -> Bool
L.null ByteString
bs
              then do
                Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
                if Bool
continue
                  then Int64 -> Get Int64
go Int64
len2
                  else Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
len2
              else
                Int64 -> Get Int64
go Int64
len2

-- Private Internal error handling stack type
-- This must NOT be exposed by this module
--
-- The ErrorFrame is the top-level error handler setup when execution begins.
-- It starts with the Bool set to True: meaning suspend can ask for more input.
-- Once suspend get 'Nothing' in reply the Bool is set to False, which means
-- that 'suspend' should no longer ask for input -- the input is finished.
-- Why store the Bool there?  It was handy when I needed to add it.
data FrameStack b = ErrorFrame (String -> S -> Result b) -- top level handler
                               Bool -- True at start, False if Nothing passed to suspend continuation
                  | HandlerFrame (Maybe ( S -> FrameStack b -> String -> Result b ))  -- encapsulated handler
                                 S  -- stored state to pass to handler
                                 (Seq L.ByteString)  -- additional input to hass to handler
                                 (FrameStack b)  -- earlier/shallower/outer handlers

type Success b a = (a -> S -> FrameStack b -> Result b)

-- Internal monad type
newtype Get a = Get {
  Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet :: forall b.    -- the forall hides the CPS style (and prevents use of MonadCont)
           Success b a  -- main continuation
        -> S            -- parser state
        -> FrameStack b -- error handler stack
        -> Result b     -- operation
    }

-- These implement the checkponting needed to store and revive the
-- state for lookAhead.  They are fragile because the setCheckpoint
-- must preceed either useCheckpoint or clearCheckpoint but not both.
-- The FutureFrame must be the most recent handler, so the commands
-- must be in the same scope depth.  Because of these constraints, the reader
-- value 'r' does not need to be stored and can be taken from the Get
-- parameter.
--
-- IMPORTANT: Any FutureFrame at the top level(s) is discarded by throwError.
setCheckpoint,useCheckpoint,clearCheckpoint :: Get ()
setCheckpoint :: Get ()
setCheckpoint = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc S
s FrameStack b
pc -> Success b ()
sc () S
s (Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
forall b.
Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
forall a. Maybe a
Nothing S
s Seq ByteString
forall a. Monoid a => a
mempty FrameStack b
pc)

useCheckpoint :: Get ()
useCheckpoint = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc (S ByteString
_ ByteString
_ Int64
_) FrameStack b
frame ->
  case FrameStack b
frame of
    (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
Nothing S
s Seq ByteString
future FrameStack b
pc) -> Success b ()
sc () (S -> Seq ByteString -> S
collect S
s Seq ByteString
future) FrameStack b
pc
    FrameStack b
_ -> String -> Result b
forall a. HasCallStack => String -> a
error String
"Text.ProtocolBuffers.Get: Impossible useCheckpoint frame!"

clearCheckpoint :: Get ()
clearCheckpoint = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc S
s FrameStack b
frame ->
   case FrameStack b
frame of
     (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
Nothing S
_s Seq ByteString
_future FrameStack b
pc) -> Success b ()
sc () S
s FrameStack b
pc
     FrameStack b
_ -> String -> Result b
forall a. HasCallStack => String -> a
error String
"Text.ProtocolBuffers.Get: Impossible clearCheckpoint frame!"

-- | 'lookAhead' runs the @todo@ action and then rewinds only the
-- BinaryParser state.  Any new input from 'suspend' or changes from
-- 'putAvailable' are kept.  Changes to the user state (MonadState)
-- are kept.  The MonadWriter output is retained.
--
-- If an error is thrown then the entire monad state is reset to last
-- catchError as usual.
lookAhead :: Get a -> Get a
lookAhead :: Get a -> Get a
lookAhead Get a
todo = do
  Get ()
setCheckpoint
  a
a <- Get a
todo
  Get ()
useCheckpoint
  a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | 'lookAheadM' runs the @todo@ action. If the action returns 'Nothing' then the
-- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Just' then
-- the BinaryParser is not rewound, and lookAheadM acts as an identity.
--
-- If an error is thrown then the entire monad state is reset to last
-- catchError as usual.
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM Get (Maybe a)
todo = do
  Get ()
setCheckpoint
  Maybe a
a <- Get (Maybe a)
todo
  Get () -> (a -> Get ()) -> Maybe a -> Get ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get ()
useCheckpoint (Get () -> a -> Get ()
forall a b. a -> b -> a
const Get ()
clearCheckpoint) Maybe a
a
  Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a

-- | 'lookAheadE' runs the @todo@ action. If the action returns 'Left' then the
-- BinaryParser state is rewound (as in 'lookAhead').  If the action return 'Right' then
-- the BinaryParser is not rewound, and lookAheadE acts as an identity.
--
-- If an error is thrown then the entire monad state is reset to last
-- catchError as usual.
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either a b)
todo = do
  Get ()
setCheckpoint
  Either a b
a <- Get (Either a b)
todo
  (a -> Get ()) -> (b -> Get ()) -> Either a b -> Get ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Get () -> a -> Get ()
forall a b. a -> b -> a
const Get ()
useCheckpoint) (Get () -> b -> Get ()
forall a b. a -> b -> a
const Get ()
clearCheckpoint) Either a b
a
  Either a b -> Get (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return Either a b
a

-- 'collect' is used by 'putCheckpoint' and 'throwError'
collect :: S -> Seq L.ByteString -> S
collect :: S -> Seq ByteString -> S
collect s :: S
s@(S ByteString
ss ByteString
bs Int64
n) Seq ByteString
future | Seq ByteString -> Bool
forall a. Seq a -> Bool
Data.Sequence.null Seq ByteString
future = S -> S
make_safe (S -> S) -> S -> S
forall a b. (a -> b) -> a -> b
$ S
s
                             | Bool
otherwise = S -> S
make_safe (S -> S) -> S -> S
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Int64 -> S
S ByteString
ss (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
bs ((ByteString -> ByteString -> ByteString)
-> Seq ByteString -> ByteString
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1 ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend Seq ByteString
future)) Int64
n

-- Put the Show instances here

instance (Show a) => Show (Result a) where
  showsPrec :: Int -> Result a -> ShowS
showsPrec Int
_ (Failed Int64
n String
msg) = (String
"(Failed "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ShowS
forall a. Show a => a -> ShowS
shows Int64
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
msg ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  showsPrec Int
_ (Finished ByteString
bs Int64
n a
a) =
    (String
"(CFinished ("String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShowS
forall a. Show a => a -> ShowS
shows ByteString
bs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") ("String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ShowS
forall a. Show a => a -> ShowS
shows Int64
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") ("String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"))"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  showsPrec Int
_ (Partial {}) = (String
"(Partial <Maybe Data.ByteString.Lazy.ByteString-> Result a)"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Show (FrameStack b) where
  showsPrec :: Int -> FrameStack b -> ShowS
showsPrec Int
_ (ErrorFrame String -> S -> Result b
_ Bool
p) =String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"(ErrorFrame <e->s->m b> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS
forall a. Show a => a -> ShowS
shows Bool
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  showsPrec Int
_ (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
_ S
s Seq ByteString
future FrameStack b
pc) = (String
"(HandlerFrame <> ("String -> ShowS
forall a. [a] -> [a] -> [a]
++)
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> ShowS
forall a. Show a => a -> ShowS
shows S
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") ("String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq ByteString -> ShowS
forall a. Show a => a -> ShowS
shows Seq ByteString
future ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") ("String -> ShowS
forall a. [a] -> [a] -> [a]
++)
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FrameStack b -> ShowS
forall a. Show a => a -> ShowS
shows FrameStack b
pc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | 'runGet' is the simple executor
runGet :: Get a -> L.ByteString -> Result a
runGet :: Get a -> ByteString -> Result a
runGet (Get forall b. Success b a -> S -> FrameStack b -> Result b
f) ByteString
bsIn = Success a a -> S -> FrameStack a -> Result a
forall b. Success b a -> S -> FrameStack b -> Result b
f Success a a
forall a p. a -> S -> p -> Result a
scIn S
sIn ((String -> S -> Result a) -> Bool -> FrameStack a
forall b. (String -> S -> Result b) -> Bool -> FrameStack b
ErrorFrame String -> S -> Result a
forall a. String -> S -> Result a
ec Bool
True)
  where scIn :: a -> S -> p -> Result a
scIn a
a (S ByteString
ss ByteString
bs Int64
n) p
_pc = ByteString -> Int64 -> a -> Result a
forall a. ByteString -> Int64 -> a -> Result a
Finished (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs) Int64
n a
a
        sIn :: S
sIn = ByteString -> Int64 -> S
make_state ByteString
bsIn Int64
0
        ec :: String -> S -> Result a
ec String
msg S
sOut = Int64 -> String -> Result a
forall a. Int64 -> String -> Result a
Failed (S -> Int64
consumed S
sOut) String
msg

-- | 'runGetAll' is the simple executor, and will not ask for any continuation because this lazy bytestring is all the input
runGetAll :: Get a -> L.ByteString -> Result a
runGetAll :: Get a -> ByteString -> Result a
runGetAll (Get forall b. Success b a -> S -> FrameStack b -> Result b
f) ByteString
bsIn = Success a a -> S -> FrameStack a -> Result a
forall b. Success b a -> S -> FrameStack b -> Result b
f Success a a
forall a p. a -> S -> p -> Result a
scIn S
sIn ((String -> S -> Result a) -> Bool -> FrameStack a
forall b. (String -> S -> Result b) -> Bool -> FrameStack b
ErrorFrame String -> S -> Result a
forall a. String -> S -> Result a
ec Bool
False)
  where scIn :: a -> S -> p -> Result a
scIn a
a (S ByteString
ss ByteString
bs Int64
n) p
_pc = ByteString -> Int64 -> a -> Result a
forall a. ByteString -> Int64 -> a -> Result a
Finished (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs) Int64
n a
a
        sIn :: S
sIn = ByteString -> Int64 -> S
make_state ByteString
bsIn Int64
0
        ec :: String -> S -> Result a
ec String
msg S
sOut = Int64 -> String -> Result a
forall a. Int64 -> String -> Result a
Failed (S -> Int64
consumed S
sOut) String
msg

-- | Get the input currently available to the parser.
getAvailable :: Get L.ByteString
getAvailable :: Get ByteString
getAvailable = (forall b. Success b ByteString -> S -> FrameStack b -> Result b)
-> Get ByteString
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b ByteString -> S -> FrameStack b -> Result b)
 -> Get ByteString)
-> (forall b.
    Success b ByteString -> S -> FrameStack b -> Result b)
-> Get ByteString
forall a b. (a -> b) -> a -> b
$ \ Success b ByteString
sc s :: S
s@(S ByteString
ss ByteString
bs Int64
_) FrameStack b
pc -> Success b ByteString
sc (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs) S
s FrameStack b
pc

-- | 'putAvailable' replaces the bytestream past the current # of read
-- bytes.  This will also affect pending MonadError handler and
-- MonadPlus branches.  I think all pending branches have to have
-- fewer bytesRead than the current one.  If this is wrong then an
-- error will be thrown.
--
-- WARNING : 'putAvailable' is still untested.
putAvailable :: L.ByteString -> Get ()
putAvailable :: ByteString -> Get ()
putAvailable !ByteString
bsNew = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc (S ByteString
_ss ByteString
_bs Int64
n) FrameStack b
pc ->
  let !s' :: S
s' = ByteString -> Int64 -> S
make_state ByteString
bsNew Int64
n
      rebuild :: FrameStack b -> FrameStack b
rebuild (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher (S ByteString
ss1 ByteString
bs1 Int64
n1) Seq ByteString
future FrameStack b
pc') =
               Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
forall b.
Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher S
sNew Seq ByteString
forall a. Monoid a => a
mempty (FrameStack b -> FrameStack b
rebuild FrameStack b
pc')
        where balance :: Int64
balance = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
n1
              whole :: ByteString
whole | Int64
balance Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = String -> ByteString
forall a. HasCallStack => String -> a
error String
"Impossible? Cannot rebuild HandlerFrame in MyGet.putAvailable: balance is negative!"
                    | Bool
otherwise = Int64 -> ByteString -> ByteString
L.take Int64
balance (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.chunk ByteString
ss1 ByteString
bs1 ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` (ByteString -> ByteString -> ByteString)
-> ByteString -> Seq ByteString -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
forall a. Monoid a => a
mempty Seq ByteString
future
              sNew :: S
sNew | Int64
balance Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int64
L.length ByteString
whole = String -> S
forall a. HasCallStack => String -> a
error String
"Impossible? MyGet.putAvailable.rebuild.sNew HandlerFrame assertion failed."
                   | Bool
otherwise = ByteString -> Int64 -> S
make_state (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
whole ByteString
bsNew) Int64
n1
      rebuild x :: FrameStack b
x@(ErrorFrame {}) = FrameStack b
x
  in Success b ()
sc () S
s' (FrameStack b -> FrameStack b
rebuild FrameStack b
pc)

-- Internal access to full internal state, as helper functions
getFull :: Get S
getFull :: Get S
getFull = (forall b. Success b S -> S -> FrameStack b -> Result b) -> Get S
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b S -> S -> FrameStack b -> Result b) -> Get S)
-> (forall b. Success b S -> S -> FrameStack b -> Result b)
-> Get S
forall a b. (a -> b) -> a -> b
$ \ Success b S
sc S
s FrameStack b
pc -> Success b S
sc S
s S
s FrameStack b
pc

{-# INLINE putFull_unsafe #-}
putFull_unsafe :: S -> Get ()
putFull_unsafe :: S -> Get ()
putFull_unsafe !S
s = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc S
_s FrameStack b
pc -> Success b ()
sc () S
s FrameStack b
pc

{-# INLINE make_safe #-}
make_safe :: S -> S
make_safe :: S -> S
make_safe s :: S
s@(S ByteString
ss ByteString
bs Int64
n) =
  if ByteString -> Bool
S.null ByteString
ss
    then ByteString -> Int64 -> S
make_state ByteString
bs Int64
n
    else S
s

{-# INLINE make_state #-}
make_state :: L.ByteString -> Int64 -> S
make_state :: ByteString -> Int64 -> S
make_state ByteString
L.Empty Int64
n = ByteString -> ByteString -> Int64 -> S
S ByteString
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty Int64
n
make_state (L.Chunk ByteString
ss ByteString
bs) Int64
n = ByteString -> ByteString -> Int64 -> S
S ByteString
ss ByteString
bs Int64
n

putFull_safe :: S -> Get ()
putFull_safe :: S -> Get ()
putFull_safe= S -> Get ()
putFull_unsafe (S -> Get ()) -> (S -> S) -> S -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> S
make_safe

-- | Keep calling 'suspend' until Nothing is passed to the 'Partial'
-- continuation.  This ensures all the data has been loaded into the
-- state of the parser.
suspendUntilComplete :: Get ()
suspendUntilComplete :: Get ()
suspendUntilComplete = do
  Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue Get ()
suspendUntilComplete

-- | Call suspend and throw and error with the provided @msg@ if
-- Nothing has been passed to the 'Partial' continuation.  Otherwise
-- return ().
suspendMsg :: String -> Get ()
suspendMsg :: String -> Get ()
suspendMsg String
msg = do Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
                    if Bool
continue then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      else String -> Get ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
msg

-- | check that there are at least @n@ bytes available in the input.
-- This will suspend if there is to little data.
ensureBytes :: Int64 -> Get ()
ensureBytes :: Int64 -> Get ()
ensureBytes Int64
n = do
  (S ByteString
ss ByteString
bs Int64
_read) <- Get S
getFull
  if ByteString -> Bool
S.null ByteString
ss
    then String -> Get ()
suspendMsg String
"ensureBytes failed" Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get ()
ensureBytes Int64
n
    else do
      if Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
ss)
        then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do if Int64
n Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
L.length (Int64 -> ByteString -> ByteString
L.take Int64
n (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs))
                  then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  else String -> Get ()
suspendMsg String
"ensureBytes failed" Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get ()
ensureBytes Int64
n
{-# INLINE ensureBytes #-}

-- | Pull @n@ bytes from the input, as a lazy ByteString.  This will
-- suspend if there is too little data.
getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString :: Int64 -> Get ByteString
getLazyByteString Int64
n | Int64
nInt64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int64
0 = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
                    | Bool
otherwise = do
  (S ByteString
ss ByteString
bs Int64
offset) <- Get S
getFull
  if ByteString -> Bool
S.null ByteString
ss
    then do
      String -> Get ()
suspendMsg (String
"getLazyByteString S.null ss failed with "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int64, (Int, Int64, Int64)) -> String
forall a. Show a => a -> String
show (Int64
n,(ByteString -> Int
S.length ByteString
ss,ByteString -> Int64
L.length ByteString
bs,Int64
offset)))
      Int64 -> Get ByteString
getLazyByteString Int64
n
    else do
      case Int64 -> ByteString -> Maybe (ByteString, ByteString)
splitAtOrDie Int64
n (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs) of  -- safe use of L.chunk because of S.null ss check above
        Just (ByteString
consume,ByteString
rest) -> do
           S -> Get ()
putFull_unsafe (ByteString -> Int64 -> S
make_state ByteString
rest (Int64
offsetInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
n))
           ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$! ByteString
consume
        Maybe (ByteString, ByteString)
Nothing -> do
           String -> Get ()
suspendMsg (String
"getLazyByteString (Nothing from splitAtOrDie) failed with "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int64, (Int, Int64, Int64)) -> String
forall a. Show a => a -> String
show (Int64
n,(ByteString -> Int
S.length ByteString
ss,ByteString -> Int64
L.length ByteString
bs,Int64
offset)))
           Int64 -> Get ByteString
getLazyByteString Int64
n
{-# INLINE getLazyByteString #-} -- important

-- | 'suspend' is supposed to allow the execution of the monad to be
-- halted, awaiting more input.  The computation is supposed to
-- continue normally if this returns True, and is supposed to halt
-- without calling suspend again if this returns False.  All future
-- calls to suspend will return False automatically and no nothing
-- else.
--
-- These semantics are too specialized to let this escape this module.
class MonadSuspend m where
  suspend :: m Bool

-- The instance here is fairly specific to the stack manipluation done
-- by 'addFuture' to ('S' user) and to the packaging of the resumption
-- function in 'IResult'('IPartial').
instance MonadSuspend Get where
    suspend :: Get Bool
suspend = (forall b. Success b Bool -> S -> FrameStack b -> Result b)
-> Get Bool
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get (
      let checkBool :: FrameStack b -> Bool
checkBool (ErrorFrame String -> S -> Result b
_ Bool
b) = Bool
b
          checkBool (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
_ S
_ Seq ByteString
_ FrameStack b
pc) = FrameStack b -> Bool
checkBool FrameStack b
pc
          -- addFuture puts the new data in 'future' where throwError's collect can find and use it
          addFuture :: ByteString -> FrameStack b -> FrameStack b
addFuture ByteString
bs (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher S
s Seq ByteString
future FrameStack b
pc) =
                        Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
forall b.
Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher S
s (Seq ByteString
future Seq ByteString -> ByteString -> Seq ByteString
forall a. Seq a -> a -> Seq a
|> ByteString
bs) (ByteString -> FrameStack b -> FrameStack b
addFuture ByteString
bs FrameStack b
pc)
          addFuture ByteString
_bs x :: FrameStack b
x@(ErrorFrame {}) = FrameStack b
x
          -- Once suspend is given Nothing, it remembers this and always returns False
          rememberFalse :: FrameStack b -> FrameStack b
rememberFalse (ErrorFrame String -> S -> Result b
ec Bool
_) = (String -> S -> Result b) -> Bool -> FrameStack b
forall b. (String -> S -> Result b) -> Bool -> FrameStack b
ErrorFrame String -> S -> Result b
ec Bool
False
          rememberFalse (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher S
s Seq ByteString
future FrameStack b
pc) =
                         Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
forall b.
Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
catcher S
s Seq ByteString
future (FrameStack b -> FrameStack b
rememberFalse FrameStack b
pc)
      in \ Success b Bool
sc S
sIn FrameStack b
pcIn ->
      if FrameStack b -> Bool
forall b. FrameStack b -> Bool
checkBool FrameStack b
pcIn -- Has Nothing ever been given to a partial continuation?
        then let f :: Maybe ByteString -> Result b
f Maybe ByteString
Nothing = let pcOut :: FrameStack b
pcOut = FrameStack b -> FrameStack b
forall b. FrameStack b -> FrameStack b
rememberFalse FrameStack b
pcIn
                             in Success b Bool
sc Bool
False S
sIn FrameStack b
pcOut
                 f (Just ByteString
bs') = let sOut :: S
sOut = S -> ByteString -> S
appendBS S
sIn ByteString
bs'
                                    pcOut :: FrameStack b
pcOut = ByteString -> FrameStack b -> FrameStack b
forall b. ByteString -> FrameStack b -> FrameStack b
addFuture ByteString
bs' FrameStack b
pcIn
                                in Success b Bool
sc Bool
True S
sOut FrameStack b
pcOut
             in (Maybe ByteString -> Result b) -> Result b
forall a. (Maybe ByteString -> Result a) -> Result a
Partial Maybe ByteString -> Result b
f
        else Success b Bool
sc Bool
False S
sIn FrameStack b
pcIn  -- once Nothing has been given suspend is a no-op
                  )
     where appendBS :: S -> ByteString -> S
appendBS (S ByteString
ss ByteString
bs Int64
n) ByteString
bs' = S -> S
make_safe (ByteString -> ByteString -> Int64 -> S
S ByteString
ss (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
bs ByteString
bs') Int64
n)

-- A unique sort of command...

-- | 'discardInnerHandler' causes the most recent catchError to be
-- discarded, i.e. this reduces the stack of error handlers by removing
-- the top one.  These are the same handlers which Alternative((<|>)) and
-- MonadPlus(mplus) use.  This is useful to commit to the current branch and let
-- the garbage collector release the suspended handler and its hold on
-- the earlier input.
discardInnerHandler :: Get ()
discardInnerHandler :: Get ()
discardInnerHandler = (forall b. Success b () -> S -> FrameStack b -> Result b) -> Get ()
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b () -> S -> FrameStack b -> Result b)
 -> Get ())
-> (forall b. Success b () -> S -> FrameStack b -> Result b)
-> Get ()
forall a b. (a -> b) -> a -> b
$ \ Success b ()
sc S
s FrameStack b
pcIn ->
  let pcOut :: FrameStack b
pcOut = case FrameStack b
pcIn of ErrorFrame {} -> FrameStack b
pcIn
                           HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
_ S
_ Seq ByteString
_ FrameStack b
pc' -> FrameStack b
pc'
  in Success b ()
sc () S
s FrameStack b
pcOut
{-# INLINE discardInnerHandler #-}

{- Currently unused, commented out to satisfy -Wall

-- | 'discardAllHandlers' causes all catchError handler to be
-- discarded, i.e. this reduces the stack of error handlers to the top
-- level handler.  These are the same handlers which Alternative((<|>))
-- and MonadPlus(mplus) use.  This is useful to commit to the current
-- branch and let the garbage collector release the suspended handlers
-- and their hold on the earlier input.
discardAllHandlers :: Get ()
discardAllHandlers = Get $ \ sc s pcIn ->
  let base pc@(ErrorFrame {}) = pc
      base (HandlerFrame _ _ _ pc) = base pc
  in sc () s (base pcIn)
{-# INLINE discardAllHandlers #-}
-}
-- The BinaryParser instance:

-- | Discard the next @m@ bytes
skip :: Int64 -> Get ()
skip :: Int64 -> Get ()
skip Int64
m | Int64
m Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int64
0 = () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       | Bool
otherwise = do
  Int64 -> Get ()
ensureBytes Int64
m
  (S ByteString
ss ByteString
bs Int64
n) <- Get S
getFull
  -- Could ignore impossible S.null ss due to (ensureBytes m) and (0 < m) but be paranoid
  let lbs :: ByteString
lbs = ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs -- L.chunk is safe
  S -> Get ()
putFull_unsafe (ByteString -> Int64 -> S
make_state (Int64 -> ByteString -> ByteString
L.drop Int64
m ByteString
lbs) (Int64
nInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
m))  -- drop will not perform less than 'm' bytes due to ensureBytes above

-- | Return the number of 'bytesRead' so far.  Initially 0, never negative.
bytesRead :: Get Int64
bytesRead :: Get Int64
bytesRead = (S -> Int64) -> Get S -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap S -> Int64
consumed Get S
getFull

-- | Return the number of bytes 'remaining' before the current input
-- runs out and 'suspend' might be called.
remaining :: Get Int64
remaining :: Get Int64
remaining = do (S ByteString
ss ByteString
bs Int64
_) <- Get S
getFull
               Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Get Int64) -> Int64 -> Get Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
ss) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (ByteString -> Int64
L.length ByteString
bs)

-- | Return True if the number of bytes 'remaining' is 0.  Any futher
-- attempts to read an empty parser will call 'suspend' which might
-- result in more input to consume.
--
-- Compare with 'isReallyEmpty'
isEmpty :: Get Bool
isEmpty :: Get Bool
isEmpty = do (S ByteString
ss ByteString
_bs Int64
_n) <- Get S
getFull
             Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Bool
S.null ByteString
ss) --  && (L.null bs)

-- | Return True if the input is exhausted and will never be added to.
-- Returns False if there is input left to consume.
--
-- Compare with 'isEmpty'
isReallyEmpty :: Get Bool
isReallyEmpty :: Get Bool
isReallyEmpty = Get Bool
isEmpty Get Bool -> (Bool -> Get Bool) -> Get Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Get Bool
loop
 where loop :: Bool -> Get Bool
loop Bool
False = Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       loop Bool
True = do
         Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
         if Bool
continue
           then Get Bool
isReallyEmpty
           else Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | get the longest prefix of the input where the high bit is set as well as following byte.
-- This made getVarInt slower.
highBitRun :: Get Int64
{-# INLINE highBitRun #-}
highBitRun :: Get Int64
highBitRun = Get Int64
loop where
  loop :: Get Int64
  {-# INLINE loop #-}
  loop :: Get Int64
loop = do
    (S ByteString
ss ByteString
bs Int64
_n) <- Get S
getFull
    -- S.null ss is okay, will lead to Nothing, Nothing, suspend below
    let mi :: Maybe Int
mi = (Word8 -> Bool) -> ByteString -> Maybe Int
S.findIndex (Word8
128Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>) ByteString
ss
    case Maybe Int
mi of
      Just Int
i -> Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Int64
forall a. Enum a => a -> a
succ (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
      Maybe Int
Nothing -> do
        let mj :: Maybe Int64
mj = (Word8 -> Bool) -> ByteString -> Maybe Int64
L.findIndex (Word8
128Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>) ByteString
bs
        case Maybe Int64
mj of
          Just Int64
j -> Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
ss) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
j)
          Maybe Int64
Nothing -> do
            Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
            if Bool
continue then Get Int64
loop
              else String -> Get Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"highBitRun has failed"

-- | get the longest prefix of the input where all the bytes satisfy the predicate.
spanOf :: (Word8 -> Bool) ->  Get (L.ByteString)
spanOf :: (Word8 -> Bool) -> Get ByteString
spanOf Word8 -> Bool
f = do let loop :: Get [ByteString]
loop = do (S ByteString
ss ByteString
bs Int64
n) <- Get S
getFull
                            let (ByteString
pre,ByteString
post) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
L.span Word8 -> Bool
f (ByteString -> ByteString -> ByteString
L.chunk ByteString
ss ByteString
bs) -- L.chunk is safe
                            S -> Get ()
putFull_unsafe (ByteString -> Int64 -> S
make_state ByteString
post (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
pre))
                            if ByteString -> Bool
L.null ByteString
post
                              then do Bool
continue <- Get Bool
forall (m :: * -> *). MonadSuspend m => m Bool
suspend
                                      if Bool
continue then ([ByteString] -> [ByteString])
-> Get [ByteString] -> Get [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> [ByteString]
L.toChunks ByteString
pre)[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++) Get [ByteString]
loop
                                        else [ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [ByteString]
L.toChunks ByteString
pre)
                              else [ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [ByteString]
L.toChunks ByteString
pre)
              ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
L.fromChunks Get [ByteString]
loop
{-# INLINE spanOf #-}

-- | Pull @n@ bytes from the input, as a strict ByteString.  This will
-- suspend if there is too little data.  If the result spans multiple
-- lazy chunks then the result occupies a freshly allocated strict
-- bytestring, otherwise it fits in a single chunk and refers to the
-- same immutable memory block as the whole chunk.
getByteString :: Int -> Get S.ByteString
getByteString :: Int -> Get ByteString
getByteString Int
nIn | Int
nIn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
                  | Bool
otherwise = do
  (S ByteString
ss ByteString
bs Int64
n) <- Get S
getFull
  if Int
nIn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
S.length ByteString
ss -- Leave at least one character of 'ss' in 'post' allowing putFull_unsafe below
    then do let (ByteString
pre,ByteString
post) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
nIn ByteString
ss
            S -> Get ()
putFull_unsafe (ByteString -> ByteString -> Int64 -> S
S ByteString
post ByteString
bs (Int64
nInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nIn))
            ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$! ByteString
pre
    -- Expect nIn to be less than S.length ss the vast majority of times
    -- so do not worry about doing anything fancy here.
    else do ByteString
now <- (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks) (Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nIn))
            ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$! ByteString
now
{-# INLINE getByteString #-} -- important

getWordhost :: Get Word
getWordhost :: Get Word
getWordhost = Get Word
forall a. Storable a => Get a
getStorable
{-# INLINE getWordhost #-}

getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Int -> Get Word8
forall a. Storable a => Int -> Get a
getPtr Int
1
{-# INLINE getWord8 #-}

getWord16be,getWord16le,getWord16host :: Get Word16
getWord16be :: Get Word16
getWord16be = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
2
    Word16 -> Get Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Get Word16) -> Word16 -> Get Word16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) Word16 -> Int -> Word16
`shiftl_w16` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1))
{-# INLINE getWord16be #-}
getWord16le :: Get Word16
getWord16le = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
2
    Word16 -> Get Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Get Word16) -> Word16 -> Get Word16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1) Word16 -> Int -> Word16
`shiftl_w16` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) )
{-# INLINE getWord16le #-}
getWord16host :: Get Word16
getWord16host = Get Word16
forall a. Storable a => Get a
getStorable
{-# INLINE getWord16host #-}

getWord32be,getWord32le,getWord32host :: Get Word32
getWord32be :: Get Word32
getWord32be = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
4
    Word32 -> Get Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) Word32 -> Int -> Word32
`shiftl_w32` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1) Word32 -> Int -> Word32
`shiftl_w32` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
2) Word32 -> Int -> Word32
`shiftl_w32`  Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
3) )
{-# INLINE getWord32be #-}
getWord32le :: Get Word32
getWord32le = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
4
    Word32 -> Get Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
3) Word32 -> Int -> Word32
`shiftl_w32` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
2) Word32 -> Int -> Word32
`shiftl_w32` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1) Word32 -> Int -> Word32
`shiftl_w32`  Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) )
{-# INLINE getWord32le #-}
getWord32host :: Get Word32
getWord32host = Get Word32
forall a. Storable a => Get a
getStorable
{-# INLINE getWord32host #-}


getWord64be,getWord64le,getWord64host :: Get Word64
getWord64be :: Get Word64
getWord64be = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
8
    Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) Word64 -> Int -> Word64
`shiftl_w64` Int
56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1) Word64 -> Int -> Word64
`shiftl_w64` Int
48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
2) Word64 -> Int -> Word64
`shiftl_w64` Int
40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
3) Word64 -> Int -> Word64
`shiftl_w64` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
4) Word64 -> Int -> Word64
`shiftl_w64` Int
24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
5) Word64 -> Int -> Word64
`shiftl_w64` Int
16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
6) Word64 -> Int -> Word64
`shiftl_w64`  Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
7) )
{-# INLINE getWord64be #-}
getWord64le :: Get Word64
getWord64le = do
    ByteString
s <- Int -> Get ByteString
getByteString Int
8
    Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
7) Word64 -> Int -> Word64
`shiftl_w64` Int
56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
6) Word64 -> Int -> Word64
`shiftl_w64` Int
48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
5) Word64 -> Int -> Word64
`shiftl_w64` Int
40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
4) Word64 -> Int -> Word64
`shiftl_w64` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
3) Word64 -> Int -> Word64
`shiftl_w64` Int
24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
2) Word64 -> Int -> Word64
`shiftl_w64` Int
16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
1) Word64 -> Int -> Word64
`shiftl_w64`  Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`S.unsafeIndex` Int
0) )
{-# INLINE getWord64le #-}
getWord64host :: Get Word64
getWord64host = Get Word64
forall a. Storable a => Get a
getStorable
{-# INLINE getWord64host #-}

-- Below here are the class instances

instance Functor Get where
  fmap :: (a -> b) -> Get a -> Get b
fmap a -> b
f Get a
m = (forall b. Success b b -> S -> FrameStack b -> Result b) -> Get b
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get (\Success b b
sc -> Get a -> Success b a -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet Get a
m (Success b b
sc Success b b -> (a -> b) -> Success b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
  {-# INLINE fmap #-}

instance Monad Get where
  return :: a -> Get a
return a
a = a -> Get a -> Get a
seq a
a (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ (forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get (\Success b a
sc -> Success b a
sc a
a)
  {-# INLINE return #-}
  Get a
m >>= :: Get a -> (a -> Get b) -> Get b
>>= a -> Get b
k  = (forall b. Success b b -> S -> FrameStack b -> Result b) -> Get b
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get (\Success b b
sc -> Get a -> Success b a -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet Get a
m (\ a
a -> a
-> (S -> FrameStack b -> Result b) -> S -> FrameStack b -> Result b
seq a
a ((S -> FrameStack b -> Result b) -> S -> FrameStack b -> Result b)
-> (S -> FrameStack b -> Result b) -> S -> FrameStack b -> Result b
forall a b. (a -> b) -> a -> b
$ Get b -> Success b b -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet (a -> Get b
k a
a) Success b b
sc))
  {-# INLINE (>>=) #-}
#if !MIN_VERSION_base(4,11,0)
  fail = Fail.fail
#endif

instance Fail.MonadFail Get where
  fail :: String -> Get a
fail = String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Get a) -> ShowS -> String -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Error a => String -> a
strMsg

instance MonadError String Get where
  throwError :: String -> Get a
throwError String
msg = (forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a)
-> (forall b. Success b a -> S -> FrameStack b -> Result b)
-> Get a
forall a b. (a -> b) -> a -> b
$ \Success b a
_sc  S
s FrameStack b
pcIn ->
    let go :: FrameStack b -> Result b
go (ErrorFrame String -> S -> Result b
ec Bool
_) = String -> S -> Result b
ec String
msg S
s
        go (HandlerFrame (Just S -> FrameStack b -> String -> Result b
catcher) S
s1 Seq ByteString
future FrameStack b
pc1) = S -> FrameStack b -> String -> Result b
catcher (S -> Seq ByteString -> S
collect S
s1 Seq ByteString
future) FrameStack b
pc1 String
msg
        go (HandlerFrame Maybe (S -> FrameStack b -> String -> Result b)
Nothing S
_s1 Seq ByteString
_future FrameStack b
pc1) = FrameStack b -> Result b
go FrameStack b
pc1
    in FrameStack b -> Result b
go FrameStack b
pcIn

  catchError :: Get a -> (String -> Get a) -> Get a
catchError Get a
mayFail String -> Get a
handler = (forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
forall a.
(forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a
Get ((forall b. Success b a -> S -> FrameStack b -> Result b) -> Get a)
-> (forall b. Success b a -> S -> FrameStack b -> Result b)
-> Get a
forall a b. (a -> b) -> a -> b
$ \Success b a
sc S
s FrameStack b
pc ->
    let pcWithHandler :: FrameStack b
pcWithHandler = let catcher :: S -> FrameStack b -> String -> Result b
catcher S
s1 FrameStack b
pc1 String
e1 = Get a -> Success b a -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet (String -> Get a
handler String
e1) Success b a
sc S
s1 FrameStack b
pc1
                        in Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
forall b.
Maybe (S -> FrameStack b -> String -> Result b)
-> S -> Seq ByteString -> FrameStack b -> FrameStack b
HandlerFrame ((S -> FrameStack b -> String -> Result b)
-> Maybe (S -> FrameStack b -> String -> Result b)
forall a. a -> Maybe a
Just S -> FrameStack b -> String -> Result b
catcher) S
s Seq ByteString
forall a. Monoid a => a
mempty FrameStack b
pc
        actionWithCleanup :: Get a
actionWithCleanup = Get a
mayFail Get a -> (a -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> Get ()
discardInnerHandler 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
    in Get a -> Success b a -> S -> FrameStack b -> Result b
forall a.
Get a -> forall b. Success b a -> S -> FrameStack b -> Result b
unGet Get a
actionWithCleanup Success b a
sc S
s FrameStack b
pcWithHandler

instance MonadPlus Get where
  mzero :: Get a
mzero = String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ShowS
forall a. Error a => String -> a
strMsg String
"[mzero:no message]")
  mplus :: Get a -> Get a -> Get a
mplus Get a
m1 Get a
m2 = Get a -> (String -> Get a) -> Get a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError Get a
m1 (Get a -> String -> Get a
forall a b. a -> b -> a
const Get a
m2)

instance Applicative Get where
  pure :: a -> Get a
pure = a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: Get (a -> b) -> Get a -> Get b
(<*>) = Get (a -> b) -> Get a -> Get b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

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

-- | I use "splitAt" without tolerating too few bytes, so write a Maybe version.
-- This is the only place I invoke L.Chunk as constructor instead of pattern matching.
-- I claim that the first argument cannot be empty.
splitAtOrDie :: Int64 -> L.ByteString -> Maybe (L.ByteString, L.ByteString)
splitAtOrDie :: Int64 -> ByteString -> Maybe (ByteString, ByteString)
splitAtOrDie Int64
i ByteString
ps | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
forall a. Monoid a => a
mempty, ByteString
ps)
splitAtOrDie Int64
_i ByteString
L.Empty = Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
splitAtOrDie Int64
i (L.Chunk ByteString
x ByteString
xs) | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
len = let (ByteString
pre,ByteString
post) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i) ByteString
x
                                          in (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString -> ByteString -> ByteString
L.chunk ByteString
pre ByteString
forall a. Monoid a => a
mempty, ByteString -> ByteString -> ByteString
L.chunk ByteString
post ByteString
xs)
                              | Bool
otherwise = case Int64 -> ByteString -> Maybe (ByteString, ByteString)
splitAtOrDie (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
len) ByteString
xs of
                                              Maybe (ByteString, ByteString)
Nothing -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
                                              Just (ByteString
y1,ByteString
y2) -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString -> ByteString -> ByteString
L.chunk ByteString
x ByteString
y1,ByteString
y2)
  where len :: Int64
len = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
x)
{-# INLINE splitAtOrDie #-}

------------------------------------------------------------------------
-- getPtr copied from binary's Get.hs

-- helper, get a raw Ptr onto a strict ByteString copied out of the
-- underlying lazy byteString. So many indirections from the raw parser
-- state that my head hurts...

-- Assume n>0
getPtr :: (Storable a) => Int -> Get a
getPtr :: Int -> Get a
getPtr Int
n = do
    (ForeignPtr Word8
fp,Int
o,Int
_) <- (ByteString -> (ForeignPtr Word8, Int, Int))
-> Get ByteString -> Get (ForeignPtr Word8, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> (ForeignPtr Word8, Int, Int)
S.toForeignPtr (Int -> Get ByteString
getByteString Int
n)
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> (IO a -> a) -> IO a -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> a
forall a. IO a -> a
S.inlinePerformIO (IO a -> Get a) -> IO a -> Get a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr a) -> Ptr Any -> Ptr a
forall a b. (a -> b) -> a -> b
$ Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o)
{-# INLINE getPtr #-}

-- I pushed the sizeOf into here (uses ScopedTypeVariables)
-- Assume sizeOf (undefined :: a)) > 0
getStorable :: forall a. (Storable a) => Get a
getStorable :: Get a
getStorable = do
    (ForeignPtr Word8
fp,Int
o,Int
_) <- (ByteString -> (ForeignPtr Word8, Int, Int))
-> Get ByteString -> Get (ForeignPtr Word8, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> (ForeignPtr Word8, Int, Int)
S.toForeignPtr (Int -> Get ByteString
getByteString (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)))
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> (IO a -> a) -> IO a -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> a
forall a. IO a -> a
S.inlinePerformIO (IO a -> Get a) -> IO a -> Get a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr (Ptr Any -> Ptr a) -> Ptr Any -> Ptr a
forall a b. (a -> b) -> a -> b
$ Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o)
{-# INLINE getStorable #-}

------------------------------------------------------------------------
------------------------------------------------------------------------
-- Unchecked shifts copied from binary's Get.hs

shiftl_w16 :: Word16 -> Int -> Word16
shiftl_w32 :: Word32 -> Int -> Word32
shiftl_w64 :: Word64 -> Int -> Word64

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
shiftl_w16 :: Word16 -> Int -> Word16
shiftl_w16 (W16# Word#
w) (I# Int#
i) = Word# -> Word16
W16# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftL#`   Int#
i)
shiftl_w32 :: Word32 -> Int -> Word32
shiftl_w32 (W32# Word#
w) (I# Int#
i) = Word# -> Word32
W32# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftL#`   Int#
i)

#if WORD_SIZE_IN_BITS < 64
shiftl_w64 :: Word64 -> Int -> Word64
shiftl_w64 (W64# Word#
w) (I# Int#
i) = Word# -> Word64
W64# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftL64#` Int#
i)

#else
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
#endif

#else
shiftl_w16 = shiftL
shiftl_w32 = shiftL
shiftl_w64 = shiftL
#endif