{-# LANGUAGE CPP, MagicHash #-}
-- for unboxed shifts

-----------------------------------------------------------------------------
-- |
-- Module      : Data.Binary.Get
-- Copyright   : Lennart Kolmodin
-- License     : BSD3-style (see LICENSE)
-- 
-- Maintainer  : Lennart Kolmodin <kolmodin@dtek.chalmers.se>
-- Stability   : experimental
-- Portability : portable to Hugs and GHC.
--
-- The Get monad. A monad for efficiently building structures from
-- encoded lazy ByteStrings
--
-----------------------------------------------------------------------------

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif

module Data.Binary.Get (

    -- * The Get type
      Get
    , runGet
    , runGetState

    -- * Parsing
    , skip
    , uncheckedSkip
    , lookAhead
    , lookAheadM
    , lookAheadE
    , uncheckedLookAhead

    -- * Utility
    , bytesRead
    , getBytes
    , remaining
    , isEmpty

    -- * Parsing particular types
    , getWord8

    -- ** ByteStrings
    , getByteString
    , getLazyByteString
    , getLazyByteStringNul
    , getRemainingLazyByteString

    -- ** Big-endian reads
    , getWord16be
    , getWord32be
    , getWord64be

    -- ** Little-endian reads
    , getWord16le
    , getWord32le
    , getWord64le

    -- ** Host-endian, unaligned reads
    , getWordhost
    , getWord16host
    , getWord32host
    , getWord64host

  ) where

import Control.Monad (when,liftM, ap)
import Control.Monad.Fix
import Data.Maybe (isNothing)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

#ifdef BYTESTRING_IN_BASE
import qualified Data.ByteString.Base as B
#else
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy.Internal as L
#endif

import Control.Applicative (Applicative(..))

import Foreign

-- used by splitAtST
#if MIN_VERSION_base(4,6,0)
import Control.Monad.ST.Unsafe(unsafeInterleaveST)
#else
import Control.Monad.ST(unsafeInterleaveST)
#endif
import Control.Monad.ST(runST)
import Data.STRef

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
import GHC.Base
import GHC.Word
--import GHC.Int
#endif

-- Control.Monad.Fail import will become redundant in GHC 8.8+
import qualified Control.Monad.Fail as Fail


-- | The parse state
data S = S {-# UNPACK #-} !B.ByteString  -- current chunk
           L.ByteString                  -- the rest of the input
           {-# UNPACK #-} !Int64         -- bytes read

-- | The Get monad is just a State monad carrying around the input ByteString
newtype Get a = Get { Get a -> S -> (a, S)
unGet :: S -> (a, S) }

instance Functor Get where
    fmap :: (a -> b) -> Get a -> Get b
fmap a -> b
f Get a
m = (S -> (b, S)) -> Get b
forall a. (S -> (a, S)) -> Get a
Get (\S
s -> case Get a -> S -> (a, S)
forall a. Get a -> S -> (a, S)
unGet Get a
m S
s of
                            (a
a, S
s') -> (a -> b
f a
a, S
s'))
    {-# INLINE fmap #-}

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 Monad Get where
    return :: a -> Get a
return a
a  = (S -> (a, S)) -> Get a
forall a. (S -> (a, S)) -> Get a
Get (\S
s -> (a
a, S
s))
    {-# INLINE return #-}

    Get a
m >>= :: Get a -> (a -> Get b) -> Get b
>>= a -> Get b
k   = (S -> (b, S)) -> Get b
forall a. (S -> (a, S)) -> Get a
Get (\S
s -> case Get a -> S -> (a, S)
forall a. Get a -> S -> (a, S)
unGet Get a
m S
s of
                             (a
a, S
s') -> Get b -> S -> (b, S)
forall a. Get a -> S -> (a, S)
unGet (a -> Get b
k a
a) S
s')
    {-# INLINE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail      = failDesc
#endif

instance Fail.MonadFail Get where
    fail :: String -> Get a
fail      = String -> Get a
forall a. String -> Get a
failDesc

instance MonadFix Get where
    mfix :: (a -> Get a) -> Get a
mfix a -> Get a
f = (S -> (a, S)) -> Get a
forall a. (S -> (a, S)) -> Get a
Get (\S
s -> let (a
a,S
s') = Get a -> S -> (a, S)
forall a. Get a -> S -> (a, S)
unGet (a -> Get a
f a
a) S
s 
                        in (a
a,S
s'))

------------------------------------------------------------------------

get :: Get S
get :: Get S
get   = (S -> (S, S)) -> Get S
forall a. (S -> (a, S)) -> Get a
Get (\S
s -> (S
s, S
s))

put :: S -> Get ()
put :: S -> Get ()
put S
s = (S -> ((), S)) -> Get ()
forall a. (S -> (a, S)) -> Get a
Get (\S
_ -> ((), S
s))

------------------------------------------------------------------------
--
-- dons, GHC 6.10: explicit inlining disabled, was killing performance.
-- Without it, GHC seems to do just fine. And we get similar
-- performance with 6.8.2 anyway.
--

initState :: L.ByteString -> S
initState :: ByteString -> S
initState ByteString
xs = ByteString -> Int64 -> S
mkState ByteString
xs Int64
0
{- INLINE initState -}

{-
initState (B.LPS xs) =
    case xs of
      []      -> S B.empty L.empty 0
      (x:xs') -> S x (B.LPS xs') 0
-}

#ifndef BYTESTRING_IN_BASE
mkState :: L.ByteString -> Int64 -> S
mkState :: ByteString -> Int64 -> S
mkState ByteString
l = case ByteString
l of
    ByteString
L.Empty      -> ByteString -> ByteString -> Int64 -> S
S ByteString
B.empty ByteString
L.empty
    L.Chunk ByteString
x ByteString
xs -> ByteString -> ByteString -> Int64 -> S
S ByteString
x ByteString
xs
{- INLINE mkState -}

#else
mkState :: L.ByteString -> Int64 -> S
mkState (B.LPS xs) =
    case xs of
        [] -> S B.empty L.empty
        (x:xs') -> S x (B.LPS xs')
#endif

-- | Run the Get monad applies a 'get'-based parser on the input ByteString
runGet :: Get a -> L.ByteString -> a
runGet :: Get a -> ByteString -> a
runGet Get a
m ByteString
str = case Get a -> S -> (a, S)
forall a. Get a -> S -> (a, S)
unGet Get a
m (ByteString -> S
initState ByteString
str) of (a
a, S
_) -> a
a

-- | Run the Get monad applies a 'get'-based parser on the input
-- ByteString. Additional to the result of get it returns the number of
-- consumed bytes and the rest of the input.
runGetState :: Get a -> L.ByteString -> Int64 -> (a, L.ByteString, Int64)
runGetState :: Get a -> ByteString -> Int64 -> (a, ByteString, Int64)
runGetState Get a
m ByteString
str Int64
off =
    case Get a -> S -> (a, S)
forall a. Get a -> S -> (a, S)
unGet Get a
m (ByteString -> Int64 -> S
mkState ByteString
str Int64
off) of
      (a
a, ~(S ByteString
s ByteString
ss Int64
newOff)) -> (a
a, ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss, Int64
newOff)

------------------------------------------------------------------------

failDesc :: String -> Get a
failDesc :: String -> Get a
failDesc String
err = do
    S ByteString
_ ByteString
_ Int64
bytes <- Get S
get
    (S -> (a, S)) -> Get a
forall a. (S -> (a, S)) -> Get a
Get (String -> S -> (a, S)
forall a. HasCallStack => String -> a
error (String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Failed reading at byte position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
bytes))

-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.
skip :: Int -> Get ()
skip :: Int -> Get ()
skip Int
n = Int -> (ByteString -> ()) -> Get ()
forall a. Int -> (ByteString -> a) -> Get a
readN (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (() -> ByteString -> ()
forall a b. a -> b -> a
const ())

-- | Skip ahead @n@ bytes. No error if there isn't enough bytes.
uncheckedSkip :: Int64 -> Get ()
uncheckedSkip :: Int64 -> Get ()
uncheckedSkip Int64
n = do
    S ByteString
s ByteString
ss Int64
bytes <- Get S
get
    if Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
s) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
n
      then S -> Get ()
put (ByteString -> ByteString -> Int64 -> S
S (Int -> ByteString -> ByteString
B.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
s) ByteString
ss (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n))
      else do
        let rest :: ByteString
rest = Int64 -> ByteString -> ByteString
L.drop (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
s)) ByteString
ss
        S -> Get ()
put (S -> Get ()) -> S -> Get ()
forall a b. (a -> b) -> a -> b
$! ByteString -> Int64 -> S
mkState ByteString
rest (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n)

-- | Run @ga@, but return without consuming its input.
-- Fails if @ga@ fails.
lookAhead :: Get a -> Get a
lookAhead :: Get a -> Get a
lookAhead Get a
ga = do
    S
s <- Get S
get
    a
a <- Get a
ga
    S -> Get ()
put S
s
    a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Like 'lookAhead', but consume the input if @gma@ returns 'Just _'.
-- Fails if @gma@ fails.
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM Get (Maybe a)
gma = do
    S
s <- Get S
get
    Maybe a
ma <- Get (Maybe a)
gma
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
        S -> Get ()
put S
s
    Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
ma

-- | Like 'lookAhead', but consume the input if @gea@ returns 'Right _'.
-- Fails if @gea@ fails.
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE :: Get (Either a b) -> Get (Either a b)
lookAheadE Get (Either a b)
gea = do
    S
s <- Get S
get
    Either a b
ea <- Get (Either a b)
gea
    case Either a b
ea of
        Left a
_ -> S -> Get ()
put S
s
        Either a b
_      -> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Either a b -> Get (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return Either a b
ea

-- | Get the next up to @n@ bytes as a lazy ByteString, without consuming them. 
uncheckedLookAhead :: Int64 -> Get L.ByteString
uncheckedLookAhead :: Int64 -> Get ByteString
uncheckedLookAhead Int64
n = do
    S ByteString
s ByteString
ss Int64
_ <- Get S
get
    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
B.length ByteString
s)
        then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
L.fromChunks [Int -> ByteString -> ByteString
B.take (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
s])
        else 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
$ Int64 -> ByteString -> ByteString
L.take Int64
n (ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss)

------------------------------------------------------------------------
-- Utility

-- | Get the total number of bytes read to this point.
bytesRead :: Get Int64
bytesRead :: Get Int64
bytesRead = do
    S ByteString
_ ByteString
_ Int64
b <- Get S
get
    Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
b

-- | Get the number of remaining unparsed bytes.
-- Useful for checking whether all input has been consumed.
-- Note that this forces the rest of the input.
remaining :: Get Int64
remaining :: Get Int64
remaining = do
    S ByteString
s ByteString
ss Int64
_ <- Get S
get
    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
B.length ByteString
s) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
ss)

-- | Test whether all input has been consumed,
-- i.e. there are no remaining unparsed bytes.
isEmpty :: Get Bool
isEmpty :: Get Bool
isEmpty = do
    S ByteString
s ByteString
ss Int64
_ <- Get S
get
    Bool -> Get Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Bool
B.null ByteString
s Bool -> Bool -> Bool
&& ByteString -> Bool
L.null ByteString
ss)

------------------------------------------------------------------------
-- Utility with ByteStrings

-- | An efficient 'get' method for strict ByteStrings. Fails if fewer
-- than @n@ bytes are left in the input.
getByteString :: Int -> Get B.ByteString
getByteString :: Int -> Get ByteString
getByteString Int
n = Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
n ByteString -> ByteString
forall a. a -> a
id
{-# INLINE getByteString #-}

-- | An efficient 'get' method for lazy ByteStrings. Does not fail if fewer than
-- @n@ bytes are left in the input.
getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString :: Int64 -> Get ByteString
getLazyByteString Int64
n = do
    S ByteString
s ByteString
ss Int64
bytes <- Get S
get
    let big :: ByteString
big = ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss
    case Int64 -> ByteString -> (ByteString, ByteString)
splitAtST Int64
n ByteString
big of
      (ByteString
consume, ByteString
rest) -> do S -> Get ()
put (S -> Get ()) -> S -> Get ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> S
mkState ByteString
rest (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n)
                            ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
consume
{-# INLINE getLazyByteString #-}

-- | Get a lazy ByteString that is terminated with a NUL byte. Fails
-- if it reaches the end of input without hitting a NUL.
getLazyByteStringNul :: Get L.ByteString
getLazyByteStringNul :: Get ByteString
getLazyByteStringNul = do
    S ByteString
s ByteString
ss Int64
bytes <- Get S
get
    let big :: ByteString
big = ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss
        (ByteString
consume, ByteString
t) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
L.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
big
        (ByteString
h, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
1 ByteString
t
    if ByteString -> Bool
L.null ByteString
h
      then String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too few bytes"
      else do
        S -> Get ()
put (S -> Get ()) -> S -> Get ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> S
mkState ByteString
rest (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
consume Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)
        ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
consume
{-# INLINE getLazyByteStringNul #-}

-- | Get the remaining bytes as a lazy ByteString
getRemainingLazyByteString :: Get L.ByteString
getRemainingLazyByteString :: Get ByteString
getRemainingLazyByteString = do
    S ByteString
s ByteString
ss Int64
_ <- Get S
get
    ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss)

------------------------------------------------------------------------
-- Helpers

-- | Pull @n@ bytes from the input, as a strict ByteString.
getBytes :: Int -> Get B.ByteString
getBytes :: Int -> Get ByteString
getBytes Int
n = do
    S ByteString
s ByteString
ss Int64
bytes <- Get S
get
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
B.length ByteString
s
        then do let (ByteString
consume,ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
                S -> Get ()
put (S -> Get ()) -> S -> Get ()
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> Int64 -> S
S ByteString
rest ByteString
ss (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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
        else
              case Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (ByteString
s ByteString -> ByteString -> ByteString
`joinBS` ByteString
ss) of
                (ByteString
consuming, ByteString
rest) ->
                    do let now :: ByteString
now = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
consuming
                       S -> Get ()
put (S -> Get ()) -> S -> Get ()
forall a b. (a -> b) -> a -> b
$! ByteString -> Int64 -> S
mkState ByteString
rest (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                       -- forces the next chunk before this one is returned
                       if (ByteString -> Int
B.length ByteString
now Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n)
                         then
                            String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too few bytes"
                         else
                            ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
now
{- INLINE getBytes -}
-- ^ important

#ifndef BYTESTRING_IN_BASE
joinBS :: B.ByteString -> L.ByteString -> L.ByteString
joinBS :: ByteString -> ByteString -> ByteString
joinBS ByteString
bb ByteString
lb
    | ByteString -> Bool
B.null ByteString
bb = ByteString
lb
    | Bool
otherwise = ByteString -> ByteString -> ByteString
L.Chunk ByteString
bb ByteString
lb

#else
joinBS :: B.ByteString -> L.ByteString -> L.ByteString
joinBS bb (B.LPS lb)
    | B.null bb = B.LPS lb
    | otherwise = B.LPS (bb:lb)
#endif
    -- don't use L.append, it's strict in it's second argument :/
{- INLINE joinBS -}

-- | Split a ByteString. If the first result is consumed before the --
-- second, this runs in constant heap space.
--
-- You must force the returned tuple for that to work, e.g.
-- 
-- > case splitAtST n xs of
-- >    (ys,zs) -> consume ys ... consume zs
--
splitAtST :: Int64 -> L.ByteString -> (L.ByteString, L.ByteString)
splitAtST :: Int64 -> ByteString -> (ByteString, ByteString)
splitAtST Int64
i ByteString
ps | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = (ByteString
L.empty, ByteString
ps)
#ifndef BYTESTRING_IN_BASE
splitAtST Int64
i ByteString
ps          = (forall s. ST s (ByteString, ByteString))
-> (ByteString, ByteString)
forall a. (forall s. ST s a) -> a
runST (
     do STRef s ByteString
r  <- ByteString -> ST s (STRef s ByteString)
forall a s. a -> ST s (STRef s a)
newSTRef ByteString
forall a. HasCallStack => a
undefined
        ByteString
xs <- STRef s ByteString -> Int64 -> ByteString -> ST s ByteString
forall s.
STRef s ByteString -> Int64 -> ByteString -> ST s ByteString
first STRef s ByteString
r Int64
i ByteString
ps
        ByteString
ys <- ST s ByteString -> ST s ByteString
forall s a. ST s a -> ST s a
unsafeInterleaveST (STRef s ByteString -> ST s ByteString
forall s a. STRef s a -> ST s a
readSTRef STRef s ByteString
r)
        (ByteString, ByteString) -> ST s (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
xs, ByteString
ys))

  where
        first :: STRef s ByteString -> Int64 -> ByteString -> ST s ByteString
first STRef s ByteString
r Int64
0 xs :: ByteString
xs@(L.Chunk ByteString
_ ByteString
_) = STRef s ByteString -> ByteString -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteString
r ByteString
xs    ST s () -> ST s ByteString -> ST s ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ST s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.Empty
        first STRef s ByteString
r Int64
_ ByteString
L.Empty          = STRef s ByteString -> ByteString -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteString
r ByteString
L.Empty ST s () -> ST s ByteString -> ST s ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ST s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.Empty

        first STRef s ByteString
r Int64
n (L.Chunk ByteString
x ByteString
xs)
          | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
l     = do STRef s ByteString -> ByteString -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteString
r (ByteString -> ByteString -> ByteString
L.Chunk (Int -> ByteString -> ByteString
B.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
x) ByteString
xs)
                           ByteString -> ST s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ST s ByteString) -> ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
L.Chunk (Int -> ByteString -> ByteString
B.take (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
x) ByteString
L.Empty
          | Bool
otherwise = do STRef s ByteString -> ByteString -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteString
r (Int64 -> ByteString -> ByteString
L.drop (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
l) ByteString
xs)
                           (ByteString -> ByteString) -> ST s ByteString -> ST s ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> ByteString -> ByteString
L.Chunk ByteString
x) (ST s ByteString -> ST s ByteString)
-> ST s ByteString -> ST s ByteString
forall a b. (a -> b) -> a -> b
$ ST s ByteString -> ST s ByteString
forall s a. ST s a -> ST s a
unsafeInterleaveST (STRef s ByteString -> Int64 -> ByteString -> ST s ByteString
first STRef s ByteString
r (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
l) ByteString
xs)

         where l :: Int64
l = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
x)
#else
splitAtST i (B.LPS ps)  = runST (
     do r  <- newSTRef undefined
        xs <- first r i ps
        ys <- unsafeInterleaveST (readSTRef r)
        return (B.LPS xs, B.LPS ys))

  where first r 0 xs     = writeSTRef r xs >> return []
        first r _ []     = writeSTRef r [] >> return []
        first r n (x:xs)
          | n < l     = do writeSTRef r (B.drop (fromIntegral n) x : xs)
                           return [B.take (fromIntegral n) x]
          | otherwise = do writeSTRef r (L.toChunks (L.drop (n - l) (B.LPS xs)))
                           fmap (x:) $ unsafeInterleaveST (first r (n - l) xs)

         where l = fromIntegral (B.length x)
#endif
{- INLINE splitAtST -}

-- Pull n bytes from the input, and apply a parser to those bytes,
-- yielding a value. If less than @n@ bytes are available, fail with an
-- error. This wraps @getBytes@.
readN :: Int -> (B.ByteString -> a) -> Get a
readN :: Int -> (ByteString -> a) -> Get a
readN Int
n ByteString -> a
f = (ByteString -> a) -> Get ByteString -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> a
f (Get ByteString -> Get a) -> Get ByteString -> Get a
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getBytes Int
n
{- INLINE readN -}
-- ^ important

------------------------------------------------------------------------
-- Primtives

-- 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...

getPtr :: Storable a => Int -> Get a
getPtr :: Int -> Get a
getPtr Int
n = do
    (ForeignPtr Word8
fp,Int
o,Int
_) <- Int
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> Get (ForeignPtr Word8, Int, Int)
forall a. Int -> (ByteString -> a) -> Get a
readN Int
n ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr
    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
B.accursedUnutterablePerformIO (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 -}

------------------------------------------------------------------------

-- | Read a Word8 from the monad state
getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Int -> Get Word8
forall a. Storable a => Int -> Get a
getPtr (Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8))
{- INLINE getWord8 -}

-- | Read a Word16 in big endian format
getWord16be :: Get Word16
getWord16be :: Get Word16
getWord16be = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
2 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` Int
1))
{- INLINE getWord16be -}

-- | Read a Word16 in little endian format
getWord16le :: Get Word16
getWord16le :: Get Word16
getWord16le = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
2 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` Int
0) )
{- INLINE getWord16le -}

-- | Read a Word32 in big endian format
getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
4 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` Int
3) )
{- INLINE getWord32be -}

-- | Read a Word32 in little endian format
getWord32le :: Get Word32
getWord32le :: Get Word32
getWord32le = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
4 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` Int
0) )
{- INLINE getWord32le -}

-- | Read a Word64 in big endian format
getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
8 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` Int
7) )
{- INLINE getWord64be -}

-- | Read a Word64 in little endian format
getWord64le :: Get Word64
getWord64le :: Get Word64
getWord64le = do
    ByteString
s <- Int -> (ByteString -> ByteString) -> Get ByteString
forall a. Int -> (ByteString -> a) -> Get a
readN Int
8 ByteString -> ByteString
forall a. a -> a
id
    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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` 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
`B.index` Int
0) )
{- INLINE getWord64le -}

------------------------------------------------------------------------
-- Host-endian reads

-- | /O(1)./ Read a single native machine word. The word is read in
-- host order, host endian form, for the machine you're on. On a 64 bit
-- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.
getWordhost :: Get Word
getWordhost :: Get Word
getWordhost = Int -> Get Word
forall a. Storable a => Int -> Get a
getPtr (Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word))
{- INLINE getWordhost -}

-- | /O(1)./ Read a 2 byte Word16 in native host order and host endianness.
getWord16host :: Get Word16
getWord16host :: Get Word16
getWord16host = Int -> Get Word16
forall a. Storable a => Int -> Get a
getPtr (Word16 -> Int
forall a. Storable a => a -> Int
sizeOf (Word16
forall a. HasCallStack => a
undefined :: Word16))
{- INLINE getWord16host -}

-- | /O(1)./ Read a Word32 in native host order and host endianness.
getWord32host :: Get Word32
getWord32host :: Get Word32
getWord32host = Int -> Get Word32
forall a. Storable a => Int -> Get a
getPtr  (Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32))
{- INLINE getWord32host -}

-- | /O(1)./ Read a Word64 in native host order and host endianess.
getWord64host   :: Get Word64
getWord64host :: Get Word64
getWord64host = Int -> Get Word64
forall a. Storable a => Int -> Get a
getPtr  (Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (Word64
forall a. HasCallStack => a
undefined :: Word64))
{- INLINE getWord64host -}

------------------------------------------------------------------------
-- Unchecked shifts

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 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)

#if __GLASGOW_HASKELL__ <= 606
-- Exported by GHC.Word in GHC 6.8 and higher
foreign import ccall unsafe "stg_uncheckedShiftL64"
    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#
#endif

#else
shiftl_w64 :: Word64 -> Int -> Word64
shiftl_w64 (W64# Word#
w) (I# Int#
i) = Word# -> Word64
W64# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
i)
#endif

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