{-# LANGUAGE CPP, MagicHash #-}
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
module Data.Binary.Get (
Get
, runGet
, runGetState
, skip
, uncheckedSkip
, lookAhead
, lookAheadM
, lookAheadE
, uncheckedLookAhead
, bytesRead
, getBytes
, remaining
, isEmpty
, getWord8
, getByteString
, getLazyByteString
, getLazyByteStringNul
, getRemainingLazyByteString
, getWord16be
, getWord32be
, getWord64be
, getWord16le
, getWord32le
, getWord64le
, 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
#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
#endif
import qualified Control.Monad.Fail as Fail
data S = S {-# UNPACK #-} !B.ByteString
L.ByteString
{-# UNPACK #-} !Int64
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))
initState :: L.ByteString -> S
initState :: ByteString -> S
initState ByteString
xs = ByteString -> Int64 -> S
mkState ByteString
xs Int64
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
#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
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
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 :: 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 ())
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)
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
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
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
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)
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
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)
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)
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 #-}
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 #-}
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 #-}
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)
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)
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
#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
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
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
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)
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))
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))
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) )
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) )
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) )
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) )
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) )
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))
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))
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))
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))
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
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