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

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

-----------------------------------------------------------------------------
-- |
-- Module      : Data.Binary.Get
-- Copyright   : Lennart Kolmodin
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Lennart Kolmodin <kolmodin@gmail.com>
-- Stability   : experimental
-- Portability : portable to Hugs and GHC.
--
-- The 'Get' monad. A monad for efficiently building structures from
-- encoded lazy ByteStrings.
--
-- Primitives are available to decode words of various sizes, both big and
-- little endian.
--
-- Let's decode binary data representing illustrated here.
-- In this example the values are in little endian.
--
-- > +------------------+--------------+-----------------+
-- > | 32 bit timestamp | 32 bit price | 16 bit quantity |
-- > +------------------+--------------+-----------------+
--
-- A corresponding Haskell value looks like this:
--
-- @
--data Trade = Trade
--  { timestamp :: !'Word32'
--  , price     :: !'Word32'
--  , qty       :: !'Word16'
--  } deriving ('Show')
-- @
--
-- The fields in @Trade@ are marked as strict (using @!@) since we don't need
-- laziness here. In practise, you would probably consider using the UNPACK
-- pragma as well.
-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#unpack-pragma>
--
-- Now, let's have a look at a decoder for this format.
--
-- @
--getTrade :: 'Get' Trade
--getTrade = do
--  timestamp <- 'getWord32le'
--  price     <- 'getWord32le'
--  quantity  <- 'getWord16le'
--  return '$!' Trade timestamp price quantity
-- @
--
-- Or even simpler using applicative style:
--
-- @
--getTrade' :: 'Get' Trade
--getTrade' = Trade '<$>' 'getWord32le' '<*>' 'getWord32le' '<*>' 'getWord16le'
-- @
--
-- There are two kinds of ways to execute this decoder, the lazy input
-- method and the incremental input method. Here we will use the lazy
-- input method.
--
-- Let's first define a function that decodes many @Trade@s.
--
-- @
--getTrades :: Get [Trade]
--getTrades = do
--  empty <- 'isEmpty'
--  if empty
--    then return []
--    else do trade <- getTrade
--            trades <- getTrades
--            return (trade:trades)
-- @
--
-- Finally, we run the decoder:
--
-- @
--lazyIOExample :: IO [Trade]
--lazyIOExample = do
--  input <- BL.readFile \"trades.bin\"
--  return ('runGet' getTrades input)
-- @
--
-- This decoder has the downside that it will need to read all the input before
-- it can return. On the other hand, it will not return anything until
-- it knows it could decode without any decoder errors.
--
-- You could also refactor to a left-fold, to decode in a more streaming fashion,
-- and get the following decoder. It will start to return data without knowing
-- that it can decode all input.
--
-- @
--incrementalExample :: BL.ByteString -> [Trade]
--incrementalExample input0 = go decoder input0
--  where
--    decoder = 'runGetIncremental' getTrade
--    go :: 'Decoder' Trade -> BL.ByteString -> [Trade]
--    go ('Done' leftover _consumed trade) input =
--      trade : go decoder (BL.chunk leftover input)
--    go ('Partial' k) input                     =
--      go (k . takeHeadChunk $ input) (dropHeadChunk input)
--    go ('Fail' _leftover _consumed msg) _input =
--      error msg
--
--takeHeadChunk :: BL.ByteString -> Maybe BS.ByteString
--takeHeadChunk lbs =
--  case lbs of
--    (BL.Chunk bs _) -> Just bs
--    _ -> Nothing
--
--dropHeadChunk :: BL.ByteString -> BL.ByteString
--dropHeadChunk lbs =
--  case lbs of
--    (BL.Chunk _ lbs') -> lbs'
--    _ -> BL.Empty
-- @
--
-- The @lazyIOExample@ uses lazy I/O to read the file from the disk, which is
-- not suitable in all applications, and certainly not if you need to read
-- from a socket which has higher likelihood to fail. To address these needs,
-- use the incremental input method like in @incrementalExample@.
-- For an example of how to read incrementally from a Handle,
-- see the implementation of 'Data.Binary.decodeFileOrFail'.
-----------------------------------------------------------------------------


module Data.Binary.Get (

    -- * The Get monad
      Get

    -- * The lazy input interface
    -- $lazyinterface
    , runGet
    , runGetOrFail
    , ByteOffset

    -- * The incremental input interface
    -- $incrementalinterface
    , Decoder(..)
    , runGetIncremental

    -- ** Providing input
    , pushChunk
    , pushChunks
    , pushEndOfInput

    -- * Decoding
    , skip
    , isEmpty
    , bytesRead
    , isolate
    , lookAhead
    , lookAheadM
    , lookAheadE
    , label

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

    -- ** Decoding Words
    , getWord8

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

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

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

    -- ** Decoding Ints
    , getInt8

    -- *** Big-endian decoding
    , getInt16be
    , getInt32be
    , getInt64be

    -- *** Little-endian decoding
    , getInt16le
    , getInt32le
    , getInt64le

    -- *** Host-endian, unaligned decoding
    , getInthost
    , getInt16host
    , getInt32host
    , getInt64host

    -- ** Decoding Floats/Doubles
    , getFloatbe
    , getFloatle
    , getFloathost
    , getDoublebe
    , getDoublele
    , getDoublehost

    -- * Deprecated functions
    , runGetState -- DEPRECATED
    , remaining -- DEPRECATED
    , getBytes -- DEPRECATED
    ) where
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

import Foreign
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L

import Data.Binary.Get.Internal hiding ( Decoder(..), runGetIncremental )
import qualified Data.Binary.Get.Internal as I

#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
-- needed for (# unboxing #) with magic hash
import GHC.Base
import GHC.Word
#endif

-- needed for casting words to float/double
import Data.Binary.FloatCast (wordToFloat, wordToDouble)

-- $lazyinterface
-- The lazy interface consumes a single lazy 'L.ByteString'. It's the easiest
-- interface to get started with, but it doesn't support interleaving I\/O and
-- parsing, unless lazy I/O is used.
--
-- There is no way to provide more input other than the initial data. To be
-- able to incrementally give more data, see the incremental input interface.

-- $incrementalinterface
-- The incremental interface gives you more control over how input is
-- provided during parsing. This lets you e.g. interleave parsing and
-- I\/O.
--
-- The incremental interface consumes a strict 'B.ByteString' at a time, each
-- being part of the total amount of input. If your decoder needs more input to
-- finish it will return a 'Partial' with a continuation.
-- If there is no more input, provide it 'Nothing'.
--
-- 'Fail' will be returned if it runs into an error, together with a message,
-- the position and the remaining input.
-- If it succeeds it will return 'Done' with the resulting value,
-- the position and the remaining input.

-- | A decoder procuced by running a 'Get' monad.
data Decoder a = Fail !B.ByteString {-# UNPACK #-} !ByteOffset String
              -- ^ The decoder ran into an error. The decoder either used
              -- 'fail' or was not provided enough input. Contains any
              -- unconsumed input and the number of bytes consumed.
              | Partial (Maybe B.ByteString -> Decoder a)
              -- ^ The decoder has consumed the available input and needs
              -- more to continue. Provide 'Just' if more input is available
              -- and 'Nothing' otherwise, and you will get a new 'Decoder'.
              | Done !B.ByteString {-# UNPACK #-} !ByteOffset a
              -- ^ The decoder has successfully finished. Except for the
              -- output value you also get any unused input as well as the
              -- number of bytes consumed.

-- | Run a 'Get' monad. See 'Decoder' for what to do next, like providing
-- input, handling decoder errors and to get the output value.
-- Hint: Use the helper functions 'pushChunk', 'pushChunks' and
-- 'pushEndOfInput'.
runGetIncremental :: Get a -> Decoder a
runGetIncremental :: Get a -> Decoder a
runGetIncremental = Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
calculateOffset (Decoder a -> Decoder a)
-> (Get a -> Decoder a) -> Get a -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> Decoder a
forall a. Get a -> Decoder a
I.runGetIncremental

calculateOffset :: I.Decoder a -> Decoder a
calculateOffset :: Decoder a -> Decoder a
calculateOffset r0 :: Decoder a
r0 = Decoder a -> ByteOffset -> Decoder a
forall a. Decoder a -> ByteOffset -> Decoder a
go Decoder a
r0 0
  where
  go :: Decoder a -> ByteOffset -> Decoder a
go r :: Decoder a
r !ByteOffset
acc = case Decoder a
r of
                I.Done inp :: ByteString
inp a :: a
a -> ByteString -> ByteOffset -> a -> Decoder a
forall a. ByteString -> ByteOffset -> a -> Decoder a
Done ByteString
inp (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) a
a
                I.Fail inp :: ByteString
inp s :: String
s -> ByteString -> ByteOffset -> String -> Decoder a
forall a. ByteString -> ByteOffset -> String -> Decoder a
Fail ByteString
inp (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
inp)) String
s
                I.Partial k :: Maybe ByteString -> Decoder a
k ->
                    (Maybe ByteString -> Decoder a) -> Decoder a
forall a. (Maybe ByteString -> Decoder a) -> Decoder a
Partial ((Maybe ByteString -> Decoder a) -> Decoder a)
-> (Maybe ByteString -> Decoder a) -> Decoder a
forall a b. (a -> b) -> a -> b
$ \ms :: Maybe ByteString
ms ->
                      case Maybe ByteString
ms of
                        Nothing -> Decoder a -> ByteOffset -> Decoder a
go (Maybe ByteString -> Decoder a
k Maybe ByteString
forall a. Maybe a
Nothing) ByteOffset
acc
                        Just i :: ByteString
i -> Decoder a -> ByteOffset -> Decoder a
go (Maybe ByteString -> Decoder a
k Maybe ByteString
ms) (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
i))
                I.BytesRead unused :: ByteOffset
unused k :: ByteOffset -> Decoder a
k ->
                    Decoder a -> ByteOffset -> Decoder a
go (ByteOffset -> Decoder a
k (ByteOffset -> Decoder a) -> ByteOffset -> Decoder a
forall a b. (a -> b) -> a -> b
$! (ByteOffset
acc ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- ByteOffset
unused)) ByteOffset
acc

-- | DEPRECATED. Provides compatibility with previous versions of this library.
-- Run a 'Get' monad and return a tuple with three values.
-- The first value is the result of the decoder. The second and third are the
-- unused input, and the number of consumed bytes.
{-# DEPRECATED runGetState "Use runGetIncremental instead. This function will be removed." #-}
runGetState :: Get a -> L.ByteString -> ByteOffset -> (a, L.ByteString, ByteOffset)
runGetState :: Get a -> ByteString -> ByteOffset -> (a, ByteString, ByteOffset)
runGetState g :: Get a
g lbs0 :: ByteString
lbs0 pos' :: ByteOffset
pos' = Decoder a -> ByteString -> (a, ByteString, ByteOffset)
forall a. Decoder a -> ByteString -> (a, ByteString, ByteOffset)
go (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
g) ByteString
lbs0
  where
  go :: Decoder a -> ByteString -> (a, ByteString, ByteOffset)
go (Done s :: ByteString
s pos :: ByteOffset
pos a :: a
a) lbs :: ByteString
lbs = (a
a, ByteString -> ByteString -> ByteString
L.chunk ByteString
s ByteString
lbs, ByteOffset
posByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ByteOffset
pos')
  go (Partial k :: Maybe ByteString -> Decoder a
k) lbs :: ByteString
lbs = Decoder a -> ByteString -> (a, ByteString, ByteOffset)
go (Maybe ByteString -> Decoder a
k (ByteString -> Maybe ByteString
takeHeadChunk ByteString
lbs)) (ByteString -> ByteString
dropHeadChunk ByteString
lbs)
  go (Fail _ pos :: ByteOffset
pos msg :: String
msg) _ =
    String -> (a, ByteString, ByteOffset)
forall a. HasCallStack => String -> a
error ("Data.Binary.Get.runGetState at position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)

takeHeadChunk :: L.ByteString -> Maybe B.ByteString
takeHeadChunk :: ByteString -> Maybe ByteString
takeHeadChunk lbs :: ByteString
lbs =
  case ByteString
lbs of
    (L.Chunk bs :: ByteString
bs _) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
    _ -> Maybe ByteString
forall a. Maybe a
Nothing

dropHeadChunk :: L.ByteString -> L.ByteString
dropHeadChunk :: ByteString -> ByteString
dropHeadChunk lbs :: ByteString
lbs =
  case ByteString
lbs of
    (L.Chunk _ lbs' :: ByteString
lbs') -> ByteString
lbs'
    _ -> ByteString
L.Empty

-- | Run a 'Get' monad and return 'Left' on failure and 'Right' on
-- success. In both cases any unconsumed input and the number of bytes
-- consumed is returned. In the case of failure, a human-readable
-- error message is included as well.
--
-- @since 0.6.4.0
runGetOrFail :: Get a -> L.ByteString
             -> Either (L.ByteString, ByteOffset, String) (L.ByteString, ByteOffset, a)
runGetOrFail :: Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail g :: Get a
g lbs0 :: ByteString
lbs0 = Decoder a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall c.
Decoder c
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, c)
feedAll (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
g) ByteString
lbs0
  where
  feedAll :: Decoder c
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, c)
feedAll (Done bs :: ByteString
bs pos :: ByteOffset
pos x :: c
x) lbs :: ByteString
lbs = (ByteString, ByteOffset, c)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, c)
forall a b. b -> Either a b
Right (ByteString -> ByteString -> ByteString
L.chunk ByteString
bs ByteString
lbs, ByteOffset
pos, c
x)
  feedAll (Partial k :: Maybe ByteString -> Decoder c
k) lbs :: ByteString
lbs = Decoder c
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, c)
feedAll (Maybe ByteString -> Decoder c
k (ByteString -> Maybe ByteString
takeHeadChunk ByteString
lbs)) (ByteString -> ByteString
dropHeadChunk ByteString
lbs)
  feedAll (Fail x :: ByteString
x pos :: ByteOffset
pos msg :: String
msg) xs :: ByteString
xs = (ByteString, ByteOffset, String)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, c)
forall a b. a -> Either a b
Left (ByteString -> ByteString -> ByteString
L.chunk ByteString
x ByteString
xs, ByteOffset
pos, String
msg)

-- | An offset, counted in bytes.
type ByteOffset = Int64

-- | The simplest interface to run a 'Get' decoder. If the decoder runs into
-- an error, calls 'fail', or runs out of input, it will call 'error'.
runGet :: Get a -> L.ByteString -> a
runGet :: Get a -> ByteString -> a
runGet g :: Get a
g lbs0 :: ByteString
lbs0 = Decoder a -> ByteString -> a
forall p. Decoder p -> ByteString -> p
feedAll (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
g) ByteString
lbs0
  where
  feedAll :: Decoder p -> ByteString -> p
feedAll (Done _ _ x :: p
x) _ = p
x
  feedAll (Partial k :: Maybe ByteString -> Decoder p
k) lbs :: ByteString
lbs = Decoder p -> ByteString -> p
feedAll (Maybe ByteString -> Decoder p
k (ByteString -> Maybe ByteString
takeHeadChunk ByteString
lbs)) (ByteString -> ByteString
dropHeadChunk ByteString
lbs)
  feedAll (Fail _ pos :: ByteOffset
pos msg :: String
msg) _ =
    String -> p
forall a. HasCallStack => String -> a
error ("Data.Binary.Get.runGet at position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)


-- | Feed a 'Decoder' with more input. If the 'Decoder' is 'Done' or 'Fail' it
-- will add the input to 'B.ByteString' of unconsumed input.
--
-- @
--    'runGetIncremental' myParser \`pushChunk\` myInput1 \`pushChunk\` myInput2
-- @
pushChunk :: Decoder a -> B.ByteString -> Decoder a
pushChunk :: Decoder a -> ByteString -> Decoder a
pushChunk r :: Decoder a
r inp :: ByteString
inp =
  case Decoder a
r of
    Done inp0 :: ByteString
inp0 p :: ByteOffset
p a :: a
a -> ByteString -> ByteOffset -> a -> Decoder a
forall a. ByteString -> ByteOffset -> a -> Decoder a
Done (ByteString
inp0 ByteString -> ByteString -> ByteString
`B.append` ByteString
inp) ByteOffset
p a
a
    Partial k :: Maybe ByteString -> Decoder a
k -> Maybe ByteString -> Decoder a
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
inp)
    Fail inp0 :: ByteString
inp0 p :: ByteOffset
p s :: String
s -> ByteString -> ByteOffset -> String -> Decoder a
forall a. ByteString -> ByteOffset -> String -> Decoder a
Fail (ByteString
inp0 ByteString -> ByteString -> ByteString
`B.append` ByteString
inp) ByteOffset
p String
s


-- | Feed a 'Decoder' with more input. If the 'Decoder' is 'Done' or 'Fail' it
-- will add the input to 'L.ByteString' of unconsumed input.
--
-- @
--    'runGetIncremental' myParser \`pushChunks\` myLazyByteString
-- @
pushChunks :: Decoder a -> L.ByteString -> Decoder a
pushChunks :: Decoder a -> ByteString -> Decoder a
pushChunks r0 :: Decoder a
r0 = Decoder a -> [ByteString] -> Decoder a
forall a. Decoder a -> [ByteString] -> Decoder a
go Decoder a
r0 ([ByteString] -> Decoder a)
-> (ByteString -> [ByteString]) -> ByteString -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
  where
  go :: Decoder a -> [ByteString] -> Decoder a
go r :: Decoder a
r [] = Decoder a
r
  go (Done inp :: ByteString
inp pos :: ByteOffset
pos a :: a
a) xs :: [ByteString]
xs = ByteString -> ByteOffset -> a -> Decoder a
forall a. ByteString -> ByteOffset -> a -> Decoder a
Done ([ByteString] -> ByteString
B.concat (ByteString
inpByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xs)) ByteOffset
pos a
a
  go (Fail inp :: ByteString
inp pos :: ByteOffset
pos s :: String
s) xs :: [ByteString]
xs = ByteString -> ByteOffset -> String -> Decoder a
forall a. ByteString -> ByteOffset -> String -> Decoder a
Fail ([ByteString] -> ByteString
B.concat (ByteString
inpByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xs)) ByteOffset
pos String
s
  go (Partial k :: Maybe ByteString -> Decoder a
k) (x :: ByteString
x:xs :: [ByteString]
xs) = Decoder a -> [ByteString] -> Decoder a
go (Maybe ByteString -> Decoder a
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x)) [ByteString]
xs

-- | Tell a 'Decoder' that there is no more input. This passes 'Nothing' to a
-- 'Partial' decoder, otherwise returns the decoder unchanged.
pushEndOfInput :: Decoder a -> Decoder a
pushEndOfInput :: Decoder a -> Decoder a
pushEndOfInput r :: Decoder a
r =
  case Decoder a
r of
    Done _ _ _ -> Decoder a
r
    Partial k :: Maybe ByteString -> Decoder a
k -> Maybe ByteString -> Decoder a
k Maybe ByteString
forall a. Maybe a
Nothing
    Fail _ _ _ -> Decoder a
r

-- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.
skip :: Int -> Get ()
skip :: Int -> Get ()
skip n :: Int
n = ByteOffset
-> Consume ByteOffset
-> ([ByteString] -> ())
-> ([ByteString] -> Get ())
-> Get ()
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Consume ByteOffset
consumeBytes (() -> [ByteString] -> ()
forall a b. a -> b -> a
const ()) [ByteString] -> Get ()
forall a. [ByteString] -> Get a
failOnEOF

-- | An efficient get method for lazy ByteStrings. Fails if fewer than @n@
-- bytes are left in the input.
getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString :: ByteOffset -> Get ByteString
getLazyByteString n0 :: ByteOffset
n0 = ByteOffset
-> Consume ByteOffset
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks ByteOffset
n0 Consume ByteOffset
consumeBytes [ByteString] -> ByteString
L.fromChunks [ByteString] -> Get ByteString
forall a. [ByteString] -> Get a
failOnEOF

consumeBytes :: Consume Int64
consumeBytes :: Consume ByteOffset
consumeBytes n :: ByteOffset
n str :: ByteString
str
  | Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
str) ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteOffset
n = (ByteString, ByteString)
-> Either ByteOffset (ByteString, ByteString)
forall a b. b -> Either a b
Right (Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
n) ByteString
str)
  | Bool
otherwise = ByteOffset -> Either ByteOffset (ByteString, ByteString)
forall a b. a -> Either a b
Left (ByteOffset
n ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
str))

consumeUntilNul :: Consume ()
consumeUntilNul :: Consume ()
consumeUntilNul _ str :: ByteString
str =
  case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==0) ByteString
str of
    (want :: ByteString
want, rest :: ByteString
rest) | ByteString -> Bool
B.null ByteString
rest -> () -> Either () (ByteString, ByteString)
forall a b. a -> Either a b
Left ()
                 | Bool
otherwise -> (ByteString, ByteString) -> Either () (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
want, Int -> ByteString -> ByteString
B.drop 1 ByteString
rest)

consumeAll :: Consume ()
consumeAll :: Consume ()
consumeAll _ _ = () -> Either () (ByteString, ByteString)
forall a b. a -> Either a b
Left ()

resumeOnEOF :: [B.ByteString] -> Get L.ByteString
resumeOnEOF :: [ByteString] -> Get ByteString
resumeOnEOF = ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Get ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks

-- | Get a lazy ByteString that is terminated with a NUL byte.
-- The returned string does not contain the NUL byte. Fails
-- if it reaches the end of input without finding a NUL.
getLazyByteStringNul :: Get L.ByteString
getLazyByteStringNul :: Get ByteString
getLazyByteStringNul = ()
-> Consume ()
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks () Consume ()
consumeUntilNul [ByteString] -> ByteString
L.fromChunks [ByteString] -> Get ByteString
forall a. [ByteString] -> Get a
failOnEOF

-- | Get the remaining bytes as a lazy ByteString.
-- Note that this can be an expensive function to use as it forces reading
-- all input and keeping the string in-memory.
getRemainingLazyByteString :: Get L.ByteString
getRemainingLazyByteString :: Get ByteString
getRemainingLazyByteString = ()
-> Consume ()
-> ([ByteString] -> ByteString)
-> ([ByteString] -> Get ByteString)
-> Get ByteString
forall s b.
s
-> Consume s
-> ([ByteString] -> b)
-> ([ByteString] -> Get b)
-> Get b
withInputChunks () Consume ()
consumeAll [ByteString] -> ByteString
L.fromChunks [ByteString] -> Get ByteString
resumeOnEOF

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

-- helper, get a raw Ptr onto a strict ByteString copied out of the
-- underlying lazy byteString.

getPtr :: Storable a => Int -> Get a
getPtr :: Int -> Get a
getPtr n :: Int
n = Int -> (Ptr a -> IO a) -> Get a
forall a. Int -> (Ptr a -> IO a) -> Get a
readNWith Int
n Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek
{-# INLINE getPtr #-}

-- | Read a Word8 from the monad state
getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Int -> (ByteString -> Word8) -> Get Word8
forall a. Int -> (ByteString -> a) -> Get a
readN 1 ByteString -> Word8
B.unsafeHead
{-# INLINE[2] getWord8 #-}

-- | Read an Int8 from the monad state
getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> Get Word8 -> Get Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
{-# INLINE getInt8 #-}


-- force GHC to inline getWordXX
{-# RULES
"getWord8/readN" getWord8 = readN 1 B.unsafeHead
"getWord16be/readN" getWord16be = readN 2 word16be
"getWord16le/readN" getWord16le = readN 2 word16le
"getWord32be/readN" getWord32be = readN 4 word32be
"getWord32le/readN" getWord32le = readN 4 word32le
"getWord64be/readN" getWord64be = readN 8 word64be
"getWord64le/readN" getWord64le = readN 8 word64le #-}

-- | Read a Word16 in big endian format
getWord16be :: Get Word16
getWord16be :: Get Word16
getWord16be = Int -> (ByteString -> Word16) -> Get Word16
forall a. Int -> (ByteString -> a) -> Get a
readN 2 ByteString -> Word16
word16be

word16be :: B.ByteString -> Word16
word16be :: ByteString -> Word16
word16be = \s :: ByteString
s ->
        (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Word16 -> Int -> Word16
`shiftl_w16` 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.unsafeIndex` 1))
{-# INLINE[2] getWord16be #-}
{-# INLINE word16be #-}

-- | Read a Word16 in little endian format
getWord16le :: Get Word16
getWord16le :: Get Word16
getWord16le = Int -> (ByteString -> Word16) -> Get Word16
forall a. Int -> (ByteString -> a) -> Get a
readN 2 ByteString -> Word16
word16le

word16le :: B.ByteString -> Word16
word16le :: ByteString -> Word16
word16le = \s :: ByteString
s ->
              (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Word16 -> Int -> Word16
`shiftl_w16` 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.unsafeIndex` 0) )
{-# INLINE[2] getWord16le #-}
{-# INLINE word16le #-}

-- | Read a Word32 in big endian format
getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = Int -> (ByteString -> Word32) -> Get Word32
forall a. Int -> (ByteString -> a) -> Get a
readN 4 ByteString -> Word32
word32be

word32be :: B.ByteString -> Word32
word32be :: ByteString -> Word32
word32be = \s :: ByteString
s ->
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Word32 -> Int -> Word32
`shiftl_w32` 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.unsafeIndex` 1) Word32 -> Int -> Word32
`shiftl_w32` 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.unsafeIndex` 2) Word32 -> Int -> Word32
`shiftl_w32`  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.unsafeIndex` 3) )
{-# INLINE[2] getWord32be #-}
{-# INLINE word32be #-}

-- | Read a Word32 in little endian format
getWord32le :: Get Word32
getWord32le :: Get Word32
getWord32le = Int -> (ByteString -> Word32) -> Get Word32
forall a. Int -> (ByteString -> a) -> Get a
readN 4 ByteString -> Word32
word32le

word32le :: B.ByteString -> Word32
word32le :: ByteString -> Word32
word32le = \s :: ByteString
s ->
              (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 3) Word32 -> Int -> Word32
`shiftl_w32` 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.unsafeIndex` 2) Word32 -> Int -> Word32
`shiftl_w32` 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.unsafeIndex` 1) Word32 -> Int -> Word32
`shiftl_w32`  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.unsafeIndex` 0) )
{-# INLINE[2] getWord32le #-}
{-# INLINE word32le #-}

-- | Read a Word64 in big endian format
getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = Int -> (ByteString -> Word64) -> Get Word64
forall a. Int -> (ByteString -> a) -> Get a
readN 8 ByteString -> Word64
word64be

word64be :: B.ByteString -> Word64
word64be :: ByteString -> Word64
word64be = \s :: ByteString
s ->
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 1) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 2) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 3) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 4) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 5) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 6) Word64 -> Int -> Word64
`shiftl_w64`  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.unsafeIndex` 7) )
{-# INLINE[2] getWord64be #-}
{-# INLINE word64be #-}

-- | Read a Word64 in little endian format
getWord64le :: Get Word64
getWord64le :: Get Word64
getWord64le = Int -> (ByteString -> Word64) -> Get Word64
forall a. Int -> (ByteString -> a) -> Get a
readN 8 ByteString -> Word64
word64le

word64le :: B.ByteString -> Word64
word64le :: ByteString -> Word64
word64le = \s :: ByteString
s ->
              (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 7) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 6) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 5) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 4) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 3) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 2) Word64 -> Int -> Word64
`shiftl_w64` 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.unsafeIndex` 1) Word64 -> Int -> Word64
`shiftl_w64`  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.unsafeIndex` 0) )
{-# INLINE[2] getWord64le #-}
{-# INLINE word64le #-}


-- | Read an Int16 in big endian format.
getInt16be :: Get Int16
getInt16be :: Get Int16
getInt16be = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> Get Word16 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
{-# INLINE getInt16be #-}

-- | Read an Int32 in big endian format.
getInt32be :: Get Int32
getInt32be :: Get Int32
getInt32be =  Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
{-# INLINE getInt32be #-}

-- | Read an Int64 in big endian format.
getInt64be :: Get Int64
getInt64be :: Get ByteOffset
getInt64be = Word64 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> ByteOffset) -> Get Word64 -> Get ByteOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
{-# INLINE getInt64be #-}


-- | Read an Int16 in little endian format.
getInt16le :: Get Int16
getInt16le :: Get Int16
getInt16le = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> Get Word16 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
{-# INLINE getInt16le #-}

-- | Read an Int32 in little endian format.
getInt32le :: Get Int32
getInt32le :: Get Int32
getInt32le =  Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
{-# INLINE getInt32le #-}

-- | Read an Int64 in little endian format.
getInt64le :: Get Int64
getInt64le :: Get ByteOffset
getInt64le = Word64 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> ByteOffset) -> Get Word64 -> Get ByteOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
{-# INLINE getInt64le #-}


------------------------------------------------------------------------
-- 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 #-}

-- | /O(1)./ Read a single native machine word in native host
-- order. It works in the same way as 'getWordhost'.
getInthost :: Get Int
getInthost :: Get Int
getInthost = Int -> Get Int
forall a. Storable a => Int -> Get a
getPtr (Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int))
{-# INLINE getInthost #-}

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

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

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


------------------------------------------------------------------------
-- Double/Float reads

-- | Read a 'Float' in big endian IEEE-754 format.
getFloatbe :: Get Float
getFloatbe :: Get Float
getFloatbe = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
{-# INLINE getFloatbe #-}

-- | Read a 'Float' in little endian IEEE-754 format.
getFloatle :: Get Float
getFloatle :: Get Float
getFloatle = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
{-# INLINE getFloatle #-}

-- | Read a 'Float' in IEEE-754 format and host endian.
getFloathost :: Get Float
getFloathost :: Get Float
getFloathost = Word32 -> Float
wordToFloat (Word32 -> Float) -> Get Word32 -> Get Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32host
{-# INLINE getFloathost #-}

-- | Read a 'Double' in big endian IEEE-754 format.
getDoublebe :: Get Double
getDoublebe :: Get Double
getDoublebe = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
{-# INLINE getDoublebe #-}

-- | Read a 'Double' in little endian IEEE-754 format.
getDoublele :: Get Double
getDoublele :: Get Double
getDoublele = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
{-# INLINE getDoublele #-}

-- | Read a 'Double' in IEEE-754 format and host endian.
getDoublehost :: Get Double
getDoublehost :: Get Double
getDoublehost = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64host
{-# INLINE getDoublehost #-}

------------------------------------------------------------------------
-- 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# w :: Word#
w) (I# i :: Int#
i) = Word# -> Word16
W16# (Word#
w Word# -> Int# -> Word#
`uncheckedShiftL#`   Int#
i)
shiftl_w32 :: Word32 -> Int -> Word32
shiftl_w32 (W32# w :: Word#
w) (I# 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)

#else
shiftl_w64 :: Word64 -> Int -> Word64
shiftl_w64 (W64# w :: Word#
w) (I# 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