{-# LANGUAGE CPP, RankNTypes, MagicHash, BangPatterns #-}
{-# LANGUAGE Trustworthy #-}
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
module Data.Binary.Get (
Get
, runGet
, runGetOrFail
, ByteOffset
, Decoder(..)
, runGetIncremental
, pushChunk
, pushChunks
, pushEndOfInput
, skip
, isEmpty
, bytesRead
, isolate
, lookAhead
, lookAheadM
, lookAheadE
, label
, getByteString
, getLazyByteString
, getLazyByteStringNul
, getRemainingLazyByteString
, getWord8
, getWord16be
, getWord32be
, getWord64be
, getWord16le
, getWord32le
, getWord64le
, getWordhost
, getWord16host
, getWord32host
, getWord64host
, getInt8
, getInt16be
, getInt32be
, getInt64be
, getInt16le
, getInt32le
, getInt64le
, getInthost
, getInt16host
, getInt32host
, getInt64host
, getFloatbe
, getFloatle
, getFloathost
, getDoublebe
, getDoublele
, getDoublehost
, runGetState
, remaining
, getBytes
) 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__)
import GHC.Base
import GHC.Word
#endif
import Data.Binary.FloatCast (wordToFloat, wordToDouble)
data Decoder a = Fail !B.ByteString {-# UNPACK #-} !ByteOffset String
| Partial (Maybe B.ByteString -> Decoder a)
| Done !B.ByteString {-# UNPACK #-} !ByteOffset a
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 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
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)
type ByteOffset = Int64
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)
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
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
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 :: 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
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
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
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
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 #-}
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 #-}
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 #-}
{-# 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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