{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
module Data.Serialize.Get (
Get
, runGet
, runGetLazy
, runGetState
, runGetLazyState
, Result(..)
, runGetPartial
, runGetChunk
, ensure
, isolate
, label
, skip
, uncheckedSkip
, lookAhead
, lookAheadM
, lookAheadE
, uncheckedLookAhead
, bytesRead
, getBytes
, remaining
, isEmpty
, getWord8
, getInt8
, getByteString
, getLazyByteString
, getShortByteString
, getWord16be
, getWord32be
, getWord64be
, getInt16be
, getInt32be
, getInt64be
, getWord16le
, getWord32le
, getWord64le
, getInt16le
, getInt32le
, getInt64le
, getWordhost
, getWord16host
, getWord32host
, getWord64host
, getTwoOf
, getListOf
, getIArrayOf
, getTreeOf
, getSeqOf
, getMapOf
, getIntMapOf
, getSetOf
, getIntSetOf
, getMaybeOf
, getEitherOf
, getNested
) where
import qualified Control.Applicative as A
import qualified Control.Monad as M
import Control.Monad (unless)
import qualified Control.Monad.Fail as Fail
import Data.Array.IArray (IArray,listArray)
import Data.Ix (Ix)
import Data.List (intercalate)
import Data.Maybe (isNothing,fromMaybe)
import Foreign
import System.IO.Unsafe (unsafeDupablePerformIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Short as BS
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Tree as T
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
import GHC.Base
import GHC.Word
#endif
data Result r = Fail String B.ByteString
| Partial (B.ByteString -> Result r)
| Done r B.ByteString
instance Show r => Show (Result r) where
show :: Result r -> String
show (Fail msg :: String
msg _) = "Fail " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
msg
show (Partial _) = "Partial _"
show (Done r :: r
r bs :: ByteString
bs) = "Done " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
forall a. Show a => a -> String
show r
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
instance Functor Result where
fmap :: (a -> b) -> Result a -> Result b
fmap _ (Fail msg :: String
msg rest :: ByteString
rest) = String -> ByteString -> Result b
forall r. String -> ByteString -> Result r
Fail String
msg ByteString
rest
fmap f :: a -> b
f (Partial k :: ByteString -> Result a
k) = (ByteString -> Result b) -> Result b
forall r. (ByteString -> Result r) -> Result r
Partial ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b)
-> (ByteString -> Result a) -> ByteString -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result a
k)
fmap f :: a -> b
f (Done r :: a
r bs :: ByteString
bs) = b -> ByteString -> Result b
forall r. r -> ByteString -> Result r
Done (a -> b
f a
r) ByteString
bs
newtype Get a = Get
{ Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet :: forall r. Input -> Buffer -> More
-> Int -> Failure r
-> Success a r -> Result r }
type Input = B.ByteString
type Buffer = Maybe B.ByteString
emptyBuffer :: Buffer
emptyBuffer :: Buffer
emptyBuffer = ByteString -> Buffer
forall a. a -> Maybe a
Just ByteString
B.empty
extendBuffer :: Buffer -> B.ByteString -> Buffer
extendBuffer :: Buffer -> ByteString -> Buffer
extendBuffer buf :: Buffer
buf chunk :: ByteString
chunk =
do ByteString
bs <- Buffer
buf
ByteString -> Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Buffer) -> ByteString -> Buffer
forall a b. (a -> b) -> a -> b
$! ByteString
bs ByteString -> ByteString -> ByteString
`B.append` ByteString
chunk
{-# INLINE extendBuffer #-}
append :: Buffer -> Buffer -> Buffer
append :: Buffer -> Buffer -> Buffer
append l :: Buffer
l r :: Buffer
r = ByteString -> ByteString -> ByteString
B.append (ByteString -> ByteString -> ByteString)
-> Buffer -> Maybe (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Buffer
l Maybe (ByteString -> ByteString) -> Buffer -> Buffer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> Buffer
r
{-# INLINE append #-}
bufferBytes :: Buffer -> B.ByteString
bufferBytes :: Buffer -> ByteString
bufferBytes = ByteString -> Buffer -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty
{-# INLINE bufferBytes #-}
type Failure r = Input -> Buffer -> More -> [String] -> String -> Result r
type Success a r = Input -> Buffer -> More -> Int -> a -> Result r
data More
= Complete
| Incomplete (Maybe Int)
deriving (More -> More -> Bool
(More -> More -> Bool) -> (More -> More -> Bool) -> Eq More
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: More -> More -> Bool
$c/= :: More -> More -> Bool
== :: More -> More -> Bool
$c== :: More -> More -> Bool
Eq)
moreLength :: More -> Int
moreLength :: More -> Int
moreLength m :: More
m = case More
m of
Complete -> 0
Incomplete mb :: Maybe Int
mb -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int
mb
instance Functor Get where
fmap :: (a -> b) -> Get a -> Get b
fmap p :: a -> b
p m :: Get a
m = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success b r
ks ->
Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Int
w0 Failure r
kf (Success a r -> Result r) -> Success a r -> Result r
forall a b. (a -> b) -> a -> b
$ \ s1 :: ByteString
s1 b1 :: Buffer
b1 m1 :: More
m1 w1 :: Int
w1 a :: a
a -> Success b r
ks ByteString
s1 Buffer
b1 More
m1 Int
w1 (a -> b
p a
a)
instance A.Applicative Get where
pure :: a -> Get a
pure a :: a
a = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w :: Int
w _ ks :: Success a r
ks -> Success a r
ks ByteString
s0 Buffer
b0 More
m0 Int
w a
a
{-# INLINE pure #-}
f :: Get (a -> b)
f <*> :: Get (a -> b) -> Get a -> Get b
<*> x :: Get a
x = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success b r
ks ->
Get (a -> b)
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success (a -> b) r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get (a -> b)
f ByteString
s0 Buffer
b0 More
m0 Int
w0 Failure r
kf (Success (a -> b) r -> Result r) -> Success (a -> b) r -> Result r
forall a b. (a -> b) -> a -> b
$ \ s1 :: ByteString
s1 b1 :: Buffer
b1 m1 :: More
m1 w1 :: Int
w1 g :: a -> b
g ->
Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
x ByteString
s1 Buffer
b1 More
m1 Int
w1 Failure r
kf (Success a r -> Result r) -> Success a r -> Result r
forall a b. (a -> b) -> a -> b
$ \ s2 :: ByteString
s2 b2 :: Buffer
b2 m2 :: More
m2 w2 :: Int
w2 y :: a
y -> Success b r
ks ByteString
s2 Buffer
b2 More
m2 Int
w2 (a -> b
g a
y)
{-# INLINE (<*>) #-}
m :: Get a
m *> :: Get a -> Get b -> Get b
*> k :: Get b
k = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success b r
ks ->
Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Int
w0 Failure r
kf (Success a r -> Result r) -> Success a r -> Result r
forall a b. (a -> b) -> a -> b
$ \ s1 :: ByteString
s1 b1 :: Buffer
b1 m1 :: More
m1 w1 :: Int
w1 _ -> Get b
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success b r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get b
k ByteString
s1 Buffer
b1 More
m1 Int
w1 Failure r
kf Success b r
ks
{-# INLINE (*>) #-}
instance A.Alternative Get where
empty :: Get a
empty = String -> Get a
forall a. String -> Get a
failDesc "empty"
{-# INLINE empty #-}
<|> :: Get a -> Get a -> Get a
(<|>) = Get a -> Get a -> Get a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
M.mplus
{-# INLINE (<|>) #-}
instance Monad Get where
return :: a -> Get a
return = a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
A.pure
{-# INLINE return #-}
m :: Get a
m >>= :: Get a -> (a -> Get b) -> Get b
>>= g :: a -> Get b
g = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success b r -> Result r)
-> Get b
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success b r
ks ->
Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Int
w0 Failure r
kf (Success a r -> Result r) -> Success a r -> Result r
forall a b. (a -> b) -> a -> b
$ \ s1 :: ByteString
s1 b1 :: Buffer
b1 m1 :: More
m1 w1 :: Int
w1 a :: a
a -> Get b
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success b r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet (a -> Get b
g a
a) ByteString
s1 Buffer
b1 More
m1 Int
w1 Failure r
kf Success b r
ks
{-# INLINE (>>=) #-}
>> :: Get a -> Get b -> Get b
(>>) = Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(A.*>)
{-# INLINE (>>) #-}
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
{-# INLINE fail #-}
#endif
instance Fail.MonadFail Get where
fail :: String -> Get a
fail = String -> Get a
forall a. String -> Get a
failDesc
{-# INLINE fail #-}
instance M.MonadPlus Get where
mzero :: Get a
mzero = String -> Get a
forall a. String -> Get a
failDesc "mzero"
{-# INLINE mzero #-}
mplus :: Get a -> Get a -> Get a
mplus a :: Get a
a b :: Get a
b =
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success a r
ks ->
let ks' :: Success a r
ks' s1 :: ByteString
s1 b1 :: Buffer
b1 = Success a r
ks ByteString
s1 (Buffer
b0 Buffer -> Buffer -> Buffer
`append` Buffer
b1)
kf' :: p -> Buffer -> More -> [String] -> String -> Result r
kf' _ b1 :: Buffer
b1 m1 :: More
m1 = Failure r
kf (ByteString
s0 ByteString -> ByteString -> ByteString
`B.append` Buffer -> ByteString
bufferBytes Buffer
b1)
(Buffer
b0 Buffer -> Buffer -> Buffer
`append` Buffer
b1) More
m1
try :: p -> Buffer -> More -> p -> p -> Result r
try _ b1 :: Buffer
b1 m1 :: More
m1 _ _ = Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
b (ByteString
s0 ByteString -> ByteString -> ByteString
`B.append` Buffer -> ByteString
bufferBytes Buffer
b1)
Buffer
b1 More
m1 Int
w0 Failure r
forall p. p -> Buffer -> More -> [String] -> String -> Result r
kf' Success a r
ks'
in Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
a ByteString
s0 Buffer
emptyBuffer More
m0 Int
w0 Failure r
forall p p p. p -> Buffer -> More -> p -> p -> Result r
try Success a r
ks'
{-# INLINE mplus #-}
formatTrace :: [String] -> String
formatTrace :: [String] -> String
formatTrace [] = "Empty call stack"
formatTrace ls :: [String]
ls = "From:\t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n\t" [String]
ls String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
get :: Get B.ByteString
get :: Get ByteString
get = (forall r.
ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w :: Int
w _ k :: Success ByteString r
k -> Success ByteString r
k ByteString
s0 Buffer
b0 More
m0 Int
w ByteString
s0)
{-# INLINE get #-}
put :: B.ByteString -> Int -> Get ()
put :: ByteString -> Int -> Get ()
put s :: ByteString
s !Int
w = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success () r -> Result r)
-> Get ()
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\_ b0 :: Buffer
b0 m :: More
m _ _ k :: Success () r
k -> Success () r
k ByteString
s Buffer
b0 More
m Int
w ())
{-# INLINE put #-}
label :: String -> Get a -> Get a
label :: String -> Get a -> Get a
label l :: String
l m :: Get a
m =
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success a r
ks ->
let kf' :: Failure r
kf' s1 :: ByteString
s1 b1 :: Buffer
b1 m1 :: More
m1 ls :: [String]
ls = Failure r
kf ByteString
s1 Buffer
b1 More
m1 (String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
in Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
s0 Buffer
b0 More
m0 Int
w0 Failure r
kf' Success a r
ks
finalK :: Success a a
finalK :: Success a a
finalK s :: ByteString
s _ _ _ a :: a
a = a -> ByteString -> Result a
forall r. r -> ByteString -> Result r
Done a
a ByteString
s
failK :: Failure a
failK :: Failure a
failK s :: ByteString
s b :: Buffer
b _ ls :: [String]
ls msg :: String
msg =
String -> ByteString -> Result a
forall r. String -> ByteString -> Result r
Fail ([String] -> String
unlines [String
msg, [String] -> String
formatTrace [String]
ls]) (ByteString
s ByteString -> ByteString -> ByteString
`B.append` Buffer -> ByteString
bufferBytes Buffer
b)
runGet :: Get a -> B.ByteString -> Either String a
runGet :: Get a -> ByteString -> Either String a
runGet m :: Get a
m str :: ByteString
str =
case Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure a
-> Success a a
-> Result a
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
str Buffer
forall a. Maybe a
Nothing More
Complete 0 Failure a
forall a. Failure a
failK Success a a
forall a. Success a a
finalK of
Fail i :: String
i _ -> String -> Either String a
forall a b. a -> Either a b
Left String
i
Done a :: a
a _ -> a -> Either String a
forall a b. b -> Either a b
Right a
a
Partial{} -> String -> Either String a
forall a b. a -> Either a b
Left "Failed reading: Internal error: unexpected Partial."
{-# INLINE runGet #-}
runGetChunk :: Get a -> Maybe Int -> B.ByteString -> Result a
runGetChunk :: Get a -> Maybe Int -> ByteString -> Result a
runGetChunk m :: Get a
m mbLen :: Maybe Int
mbLen str :: ByteString
str = Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure a
-> Success a a
-> Result a
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m ByteString
str Buffer
forall a. Maybe a
Nothing (Maybe Int -> More
Incomplete Maybe Int
mbLen) 0 Failure a
forall a. Failure a
failK Success a a
forall a. Success a a
finalK
{-# INLINE runGetChunk #-}
runGetPartial :: Get a -> B.ByteString -> Result a
runGetPartial :: Get a -> ByteString -> Result a
runGetPartial m :: Get a
m = Get a -> Maybe Int -> ByteString -> Result a
forall a. Get a -> Maybe Int -> ByteString -> Result a
runGetChunk Get a
m Maybe Int
forall a. Maybe a
Nothing
{-# INLINE runGetPartial #-}
runGetState :: Get a -> B.ByteString -> Int
-> Either String (a, B.ByteString)
runGetState :: Get a -> ByteString -> Int -> Either String (a, ByteString)
runGetState m :: Get a
m str :: ByteString
str off :: Int
off = case Get a -> ByteString -> Int -> (Either String a, ByteString)
forall a.
Get a -> ByteString -> Int -> (Either String a, ByteString)
runGetState' Get a
m ByteString
str Int
off of
(Right a :: a
a,bs :: ByteString
bs) -> (a, ByteString) -> Either String (a, ByteString)
forall a b. b -> Either a b
Right (a
a,ByteString
bs)
(Left i :: String
i,_) -> String -> Either String (a, ByteString)
forall a b. a -> Either a b
Left String
i
{-# INLINE runGetState #-}
runGetState' :: Get a -> B.ByteString -> Int
-> (Either String a, B.ByteString)
runGetState' :: Get a -> ByteString -> Int -> (Either String a, ByteString)
runGetState' m :: Get a
m str :: ByteString
str off :: Int
off =
case Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure a
-> Success a a
-> Result a
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
m (Int -> ByteString -> ByteString
B.drop Int
off ByteString
str) Buffer
forall a. Maybe a
Nothing More
Complete 0 Failure a
forall a. Failure a
failK Success a a
forall a. Success a a
finalK of
Fail i :: String
i bs :: ByteString
bs -> (String -> Either String a
forall a b. a -> Either a b
Left String
i,ByteString
bs)
Done a :: a
a bs :: ByteString
bs -> (a -> Either String a
forall a b. b -> Either a b
Right a
a, ByteString
bs)
Partial{} -> (String -> Either String a
forall a b. a -> Either a b
Left "Failed reading: Internal error: unexpected Partial.",ByteString
B.empty)
{-# INLINE runGetState' #-}
runGetLazy' :: Get a -> L.ByteString -> (Either String a,L.ByteString)
runGetLazy' :: Get a -> ByteString -> (Either String a, ByteString)
runGetLazy' m :: Get a
m lstr :: ByteString
lstr =
case ByteString -> [ByteString]
L.toChunks ByteString
lstr of
[c :: ByteString
c] -> (Either String a, ByteString) -> (Either String a, ByteString)
forall a. (a, ByteString) -> (a, ByteString)
wrapStrict (Get a -> ByteString -> Int -> (Either String a, ByteString)
forall a.
Get a -> ByteString -> Int -> (Either String a, ByteString)
runGetState' Get a
m ByteString
c 0)
[] -> (Either String a, ByteString) -> (Either String a, ByteString)
forall a. (a, ByteString) -> (a, ByteString)
wrapStrict (Get a -> ByteString -> Int -> (Either String a, ByteString)
forall a.
Get a -> ByteString -> Int -> (Either String a, ByteString)
runGetState' Get a
m ByteString
B.empty 0)
c :: ByteString
c:cs :: [ByteString]
cs -> Result a -> [ByteString] -> (Either String a, ByteString)
forall b. Result b -> [ByteString] -> (Either String b, ByteString)
loop (Get a -> Maybe Int -> ByteString -> Result a
forall a. Get a -> Maybe Int -> ByteString -> Result a
runGetChunk Get a
m (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
c)) ByteString
c) [ByteString]
cs
where
len :: Int
len = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
L.length ByteString
lstr)
wrapStrict :: (a, ByteString) -> (a, ByteString)
wrapStrict (e :: a
e,s :: ByteString
s) = (a
e,[ByteString] -> ByteString
L.fromChunks [ByteString
s])
loop :: Result b -> [ByteString] -> (Either String b, ByteString)
loop result :: Result b
result chunks :: [ByteString]
chunks = case Result b
result of
Fail str :: String
str rest :: ByteString
rest -> (String -> Either String b
forall a b. a -> Either a b
Left String
str, [ByteString] -> ByteString
L.fromChunks (ByteString
rest ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks))
Partial k :: ByteString -> Result b
k -> case [ByteString]
chunks of
c :: ByteString
c:cs :: [ByteString]
cs -> Result b -> [ByteString] -> (Either String b, ByteString)
loop (ByteString -> Result b
k ByteString
c) [ByteString]
cs
[] -> Result b -> [ByteString] -> (Either String b, ByteString)
loop (ByteString -> Result b
k ByteString
B.empty) []
Done r :: b
r rest :: ByteString
rest -> (b -> Either String b
forall a b. b -> Either a b
Right b
r, [ByteString] -> ByteString
L.fromChunks (ByteString
rest ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks))
{-# INLINE runGetLazy' #-}
runGetLazy :: Get a -> L.ByteString -> Either String a
runGetLazy :: Get a -> ByteString -> Either String a
runGetLazy m :: Get a
m lstr :: ByteString
lstr = (Either String a, ByteString) -> Either String a
forall a b. (a, b) -> a
fst (Get a -> ByteString -> (Either String a, ByteString)
forall a. Get a -> ByteString -> (Either String a, ByteString)
runGetLazy' Get a
m ByteString
lstr)
{-# INLINE runGetLazy #-}
runGetLazyState :: Get a -> L.ByteString -> Either String (a,L.ByteString)
runGetLazyState :: Get a -> ByteString -> Either String (a, ByteString)
runGetLazyState m :: Get a
m lstr :: ByteString
lstr = case Get a -> ByteString -> (Either String a, ByteString)
forall a. Get a -> ByteString -> (Either String a, ByteString)
runGetLazy' Get a
m ByteString
lstr of
(Right a :: a
a,rest :: ByteString
rest) -> (a, ByteString) -> Either String (a, ByteString)
forall a b. b -> Either a b
Right (a
a,ByteString
rest)
(Left err :: String
err,_) -> String -> Either String (a, ByteString)
forall a b. a -> Either a b
Left String
err
{-# INLINE runGetLazyState #-}
{-# INLINE ensure #-}
ensure :: Int -> Get B.ByteString
ensure :: Int -> Get ByteString
ensure n0 :: Int
n0 = Int
n0 Int -> Get ByteString -> Get ByteString
forall a b. a -> b -> b
`seq` (forall r.
ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString)
-> (forall r.
ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success ByteString r
-> Result r)
-> Get ByteString
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success ByteString r
ks -> let
n' :: Int
n' = Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
s0
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then Success ByteString r
ks ByteString
s0 Buffer
b0 More
m0 Int
w0 ByteString
s0
else Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> Int
-> Failure r
-> Success ByteString r
-> Result r
forall t r.
Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> t
-> (ByteString -> Buffer -> More -> [String] -> String -> Result r)
-> (ByteString -> Buffer -> More -> t -> ByteString -> Result r)
-> Result r
getMore Int
n' ByteString
s0 [] Buffer
b0 More
m0 Int
w0 Failure r
kf Success ByteString r
ks
where
finalInput :: ByteString -> [ByteString] -> ByteString
finalInput s0 :: ByteString
s0 ss :: [ByteString]
ss = [ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
s0 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ss))
finalBuffer :: Buffer -> ByteString -> [ByteString] -> Buffer
finalBuffer b0 :: Buffer
b0 s0 :: ByteString
s0 ss :: [ByteString]
ss = Buffer -> ByteString -> Buffer
extendBuffer Buffer
b0 ([ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]
forall a. [a] -> [a]
init (ByteString
s0 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ss))))
getMore :: Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> t
-> (ByteString -> Buffer -> More -> [String] -> String -> Result r)
-> (ByteString -> Buffer -> More -> t -> ByteString -> Result r)
-> Result r
getMore !Int
n s0 :: ByteString
s0 ss :: [ByteString]
ss b0 :: Buffer
b0 m0 :: More
m0 w0 :: t
w0 kf :: ByteString -> Buffer -> More -> [String] -> String -> Result r
kf ks :: ByteString -> Buffer -> More -> t -> ByteString -> Result r
ks = let
tooFewBytes :: Result r
tooFewBytes = let
!s :: ByteString
s = ByteString -> [ByteString] -> ByteString
finalInput ByteString
s0 [ByteString]
ss
!b :: Buffer
b = Buffer -> ByteString -> [ByteString] -> Buffer
finalBuffer Buffer
b0 ByteString
s0 [ByteString]
ss
in ByteString -> Buffer -> More -> [String] -> String -> Result r
kf ByteString
s Buffer
b More
m0 ["demandInput"] "too few bytes"
in case More
m0 of
Complete -> Result r
tooFewBytes
Incomplete mb :: Maybe Int
mb -> (ByteString -> Result r) -> Result r
forall r. (ByteString -> Result r) -> Result r
Partial ((ByteString -> Result r) -> Result r)
-> (ByteString -> Result r) -> Result r
forall a b. (a -> b) -> a -> b
$ \s :: ByteString
s ->
if ByteString -> Bool
B.null ByteString
s
then Result r
tooFewBytes
else let
!mb' :: Maybe Int
mb' = case Maybe Int
mb of
Just l :: Int
l -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
s
Nothing -> Maybe Int
forall a. Maybe a
Nothing
in Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> t
-> (ByteString -> Buffer -> More -> [String] -> String -> Result r)
-> (ByteString -> Buffer -> More -> t -> ByteString -> Result r)
-> Result r
checkIfEnough Int
n ByteString
s (ByteString
s0 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ss) Buffer
b0 (Maybe Int -> More
Incomplete Maybe Int
mb') t
w0 ByteString -> Buffer -> More -> [String] -> String -> Result r
kf ByteString -> Buffer -> More -> t -> ByteString -> Result r
ks
checkIfEnough :: Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> t
-> (ByteString -> Buffer -> More -> [String] -> String -> Result r)
-> (ByteString -> Buffer -> More -> t -> ByteString -> Result r)
-> Result r
checkIfEnough !Int
n s0 :: ByteString
s0 ss :: [ByteString]
ss b0 :: Buffer
b0 m0 :: More
m0 w0 :: t
w0 kf :: ByteString -> Buffer -> More -> [String] -> String -> Result r
kf ks :: ByteString -> Buffer -> More -> t -> ByteString -> Result r
ks = let
n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
s0
in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then let
!s :: ByteString
s = ByteString -> [ByteString] -> ByteString
finalInput ByteString
s0 [ByteString]
ss
!b :: Buffer
b = Buffer -> ByteString -> [ByteString] -> Buffer
finalBuffer Buffer
b0 ByteString
s0 [ByteString]
ss
in ByteString -> Buffer -> More -> t -> ByteString -> Result r
ks ByteString
s Buffer
b More
m0 t
w0 ByteString
s
else Int
-> ByteString
-> [ByteString]
-> Buffer
-> More
-> t
-> (ByteString -> Buffer -> More -> [String] -> String -> Result r)
-> (ByteString -> Buffer -> More -> t -> ByteString -> Result r)
-> Result r
getMore Int
n' ByteString
s0 [ByteString]
ss Buffer
b0 More
m0 t
w0 ByteString -> Buffer -> More -> [String] -> String -> Result r
kf ByteString -> Buffer -> More -> t -> ByteString -> Result r
ks
isolate :: Int -> Get a -> Get a
isolate :: Int -> Get a -> Get a
isolate n :: Int
n m :: Get a
m = do
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
M.when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Attempted to isolate a negative number of bytes")
ByteString
s <- Int -> Get ByteString
ensure Int
n
let (s' :: ByteString
s',rest :: ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
n ByteString
s
Int
cur <- Get Int
bytesRead
ByteString -> Int -> Get ()
put ByteString
s' Int
cur
a
a <- Get a
m
ByteString
used <- Get ByteString
get
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
used) (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "not all bytes parsed in isolate")
ByteString -> Int -> Get ()
put ByteString
rest (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
failDesc :: String -> Get a
failDesc :: String -> Get a
failDesc err :: String
err = do
let msg :: String
msg = "Failed reading: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 _ kf :: Failure r
kf _ -> Failure r
kf ByteString
s0 Buffer
b0 More
m0 [] String
msg)
skip :: Int -> Get ()
skip :: Int -> Get ()
skip n :: Int
n = do
ByteString
s <- Int -> Get ByteString
ensure Int
n
Int
cur <- Get Int
bytesRead
ByteString -> Int -> Get ()
put (Int -> ByteString -> ByteString
B.drop Int
n ByteString
s) (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
uncheckedSkip :: Int -> Get ()
uncheckedSkip :: Int -> Get ()
uncheckedSkip n :: Int
n = do
ByteString
s <- Get ByteString
get
Int
cur <- Get Int
bytesRead
ByteString -> Int -> Get ()
put (Int -> ByteString -> ByteString
B.drop Int
n ByteString
s) (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
lookAhead :: Get a -> Get a
lookAhead :: Get a -> Get a
lookAhead ga :: Get a
ga = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get ((forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a)
-> (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
forall a b. (a -> b) -> a -> b
$ \ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 kf :: Failure r
kf ks :: Success a r
ks ->
let ks' :: p -> Buffer -> More -> Int -> a -> Result r
ks' _ b1 :: Buffer
b1 = Success a r
ks (ByteString
s0 ByteString -> ByteString -> ByteString
`B.append` Buffer -> ByteString
bufferBytes Buffer
b1) (Buffer
b0 Buffer -> Buffer -> Buffer
`append` Buffer
b1)
kf' :: p -> Buffer -> More -> [String] -> String -> Result r
kf' _ b1 :: Buffer
b1 = Failure r
kf ByteString
s0 (Buffer
b0 Buffer -> Buffer -> Buffer
`append` Buffer
b1)
in Get a
-> ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success a r
-> Result r
forall a.
Get a
-> forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r
unGet Get a
ga ByteString
s0 Buffer
emptyBuffer More
m0 Int
w0 Failure r
forall p. p -> Buffer -> More -> [String] -> String -> Result r
kf' Success a r
forall p. p -> Buffer -> More -> Int -> a -> Result r
ks'
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM :: Get (Maybe a) -> Get (Maybe a)
lookAheadM gma :: Get (Maybe a)
gma = do
ByteString
s <- Get ByteString
get
Int
pre <- Get Int
bytesRead
Maybe a
ma <- Get (Maybe a)
gma
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
M.when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma) (ByteString -> Int -> Get ()
put ByteString
s Int
pre)
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 gea :: Get (Either a b)
gea = do
ByteString
s <- Get ByteString
get
Int
pre <- Get Int
bytesRead
Either a b
ea <- Get (Either a b)
gea
case Either a b
ea of
Left _ -> ByteString -> Int -> Get ()
put ByteString
s Int
pre
_ -> () -> 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 :: Int -> Get B.ByteString
uncheckedLookAhead :: Int -> Get ByteString
uncheckedLookAhead n :: Int
n = do
ByteString
s <- Get ByteString
get
ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> ByteString
B.take Int
n ByteString
s)
remaining :: Get Int
remaining :: Get Int
remaining = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success Int r -> Result r)
-> Get Int
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 _ ks :: Success Int r
ks -> Success Int r
ks ByteString
s0 Buffer
b0 More
m0 Int
w0 (ByteString -> Int
B.length ByteString
s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ More -> Int
moreLength More
m0))
isEmpty :: Get Bool
isEmpty :: Get Bool
isEmpty = (forall r.
ByteString
-> Buffer
-> More
-> Int
-> Failure r
-> Success Bool r
-> Result r)
-> Get Bool
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\ s0 :: ByteString
s0 b0 :: Buffer
b0 m0 :: More
m0 w0 :: Int
w0 _ ks :: Success Bool r
ks -> Success Bool r
ks ByteString
s0 Buffer
b0 More
m0 Int
w0 (ByteString -> Bool
B.null ByteString
s0 Bool -> Bool -> Bool
&& More -> Int
moreLength More
m0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0))
getByteString :: Int -> Get B.ByteString
getByteString :: Int -> Get ByteString
getByteString n :: Int
n = do
ByteString
bs <- Int -> Get ByteString
getBytes 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 -> ByteString
B.copy ByteString
bs
getLazyByteString :: Int64 -> Get L.ByteString
getLazyByteString :: Int64 -> Get ByteString
getLazyByteString n :: Int64
n = ByteString -> ByteString
f (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Get ByteString
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)
where f :: ByteString -> ByteString
f bs :: ByteString
bs = [ByteString] -> ByteString
L.fromChunks [ByteString
bs]
getShortByteString :: Int -> Get BS.ShortByteString
getShortByteString :: Int -> Get ShortByteString
getShortByteString n :: Int
n = do
ByteString
bs <- Int -> Get ByteString
getBytes Int
n
ShortByteString -> Get ShortByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> Get ShortByteString)
-> ShortByteString -> Get ShortByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ShortByteString
BS.toShort ByteString
bs
getBytes :: Int -> Get B.ByteString
getBytes :: Int -> Get ByteString
getBytes n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "getBytes: negative length requested"
getBytes n :: Int
n = do
ByteString
s <- Int -> Get ByteString
ensure Int
n
let consume :: ByteString
consume = Int -> ByteString -> ByteString
B.unsafeTake Int
n ByteString
s
rest :: ByteString
rest = Int -> ByteString -> ByteString
B.unsafeDrop Int
n ByteString
s
Int
cur <- Get Int
bytesRead
ByteString -> Int -> Get ()
put ByteString
rest (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
consume
{-# INLINE getBytes #-}
getPtr :: Storable a => Int -> Get a
getPtr :: Int -> Get a
getPtr n :: Int
n = do
(fp :: ForeignPtr Word8
fp,o :: Int
o,_) <- ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> Get ByteString -> Get (ForeignPtr Word8, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Get ByteString
getBytes Int
n
let k :: Ptr a -> IO a
k p :: Ptr a
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 a
p Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o))
a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (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
forall a a. Storable a => Ptr a -> IO a
k))
{-# INLINE getPtr #-}
getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = do
ByteString
s <- Int -> Get ByteString
getBytes 1
Int8 -> Get Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> Get Int8) -> Int8 -> Get Int8
forall a b. (a -> b) -> a -> b
$! Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word8
B.unsafeHead ByteString
s)
getInt16be :: Get Int16
getInt16be :: Get Int16
getInt16be = do
ByteString
s <- Int -> Get ByteString
getBytes 2
Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Get Int16) -> Int16 -> Get Int16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) )
getInt16le :: Get Int16
getInt16le :: Get Int16
getInt16le = do
ByteString
s <- Int -> Get ByteString
getBytes 2
Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> Get Int16) -> Int16 -> Get Int16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) )
getInt32be :: Get Int32
getInt32be :: Get Int32
getInt32be = do
ByteString
s <- Int -> Get ByteString
getBytes 4
Int32 -> Get Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Get Int32) -> Int32 -> Get Int32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 24) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 16) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 2) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 3) )
getInt32le :: Get Int32
getInt32le :: Get Int32
getInt32le = do
ByteString
s <- Int -> Get ByteString
getBytes 4
Int32 -> Get Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Get Int32) -> Int32 -> Get Int32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 3) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 24) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 2) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 16) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) )
getInt64be :: Get Int64
getInt64be :: Get Int64
getInt64be = do
ByteString
s <- Int -> Get ByteString
getBytes 8
Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Get Int64) -> Int64 -> Get Int64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 56) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 48) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 2) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 40) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 3) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 32) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 4) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 24) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 5) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 16) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 6) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 7) )
getInt64le :: Get Int64
getInt64le :: Get Int64
getInt64le = do
ByteString
s <- Int -> Get ByteString
getBytes 8
Int64 -> Get Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Get Int64) -> Int64 -> Get Int64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 7) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 56) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 6) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 48) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 5) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 40) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 4) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 32) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 3) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 24) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 2) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 16) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 1) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` 8) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.|.
(Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`B.unsafeIndex` 0) )
{-# INLINE getInt8 #-}
{-# INLINE getInt16be #-}
{-# INLINE getInt16le #-}
{-# INLINE getInt32be #-}
{-# INLINE getInt32le #-}
{-# INLINE getInt64be #-}
{-# INLINE getInt64le #-}
getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = do
ByteString
s <- Int -> Get ByteString
getBytes 1
Word8 -> Get Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Word8
B.unsafeHead ByteString
s)
getWord16be :: Get Word16
getWord16be :: Get Word16
getWord16be = do
ByteString
s <- Int -> Get ByteString
getBytes 2
Word16 -> Get Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Get Word16) -> Word16 -> Get Word16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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))
getWord16le :: Get Word16
getWord16le :: Get Word16
getWord16le = do
ByteString
s <- Int -> Get ByteString
getBytes 2
Word16 -> Get Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Get Word16) -> Word16 -> Get Word16
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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) )
getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = do
ByteString
s <- Int -> Get ByteString
getBytes 4
Word32 -> Get Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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) )
getWord32le :: Get Word32
getWord32le :: Get Word32
getWord32le = do
ByteString
s <- Int -> Get ByteString
getBytes 4
Word32 -> Get Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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) )
getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = do
ByteString
s <- Int -> Get ByteString
getBytes 8
Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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) )
getWord64le :: Get Word64
getWord64le :: Get Word64
getWord64le = do
ByteString
s <- Int -> Get ByteString
getBytes 8
Word64 -> Get Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$! (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s ByteString -> Int -> Word8
`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 getWord8 #-}
{-# INLINE getWord16be #-}
{-# INLINE getWord16le #-}
{-# INLINE getWord32be #-}
{-# INLINE getWord32le #-}
{-# INLINE getWord64be #-}
{-# INLINE getWord64le #-}
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# 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 :: Word64 -> Int -> Word64
shiftl_w64 (W64# w :: Word64#
w) (I# i :: Int#
i) = Word64# -> Word64
W64# (Word64#
w Word64# -> Int# -> Word64#
`uncheckedShiftL64#` Int#
i)
#if __GLASGOW_HASKELL__ <= 606
foreign import ccall unsafe "stg_uncheckedShiftL64"
uncheckedShiftL64# :: Word64# -> Int# -> Word64#
#endif
#else
shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)
#endif
#else
shiftl_w16 = shiftL
shiftl_w32 = shiftL
shiftl_w64 = shiftL
#endif
getTwoOf :: Get a -> Get b -> Get (a,b)
getTwoOf :: Get a -> Get b -> Get (a, b)
getTwoOf ma :: Get a
ma mb :: Get b
mb = (a -> b -> (a, b)) -> Get a -> Get b -> Get (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
M.liftM2 (,) Get a
ma Get b
mb
getListOf :: Get a -> Get [a]
getListOf :: Get a -> Get [a]
getListOf m :: Get a
m = [a] -> Word64 -> Get [a]
forall t. (Eq t, Num t) => [a] -> t -> Get [a]
go [] (Word64 -> Get [a]) -> Get Word64 -> Get [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word64
getWord64be
where
go :: [a] -> t -> Get [a]
go as :: [a]
as 0 = [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$! [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as
go as :: [a]
as i :: t
i = do a
x <- Get a
m
a
x a -> Get [a] -> Get [a]
forall a b. a -> b -> b
`seq` [a] -> t -> Get [a]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) (t
i t -> t -> t
forall a. Num a => a -> a -> a
- 1)
getIArrayOf :: (Ix i, IArray a e) => Get i -> Get e -> Get (a i e)
getIArrayOf :: Get i -> Get e -> Get (a i e)
getIArrayOf ix :: Get i
ix e :: Get e
e = ((i, i) -> [e] -> a i e) -> Get (i, i) -> Get [e] -> Get (a i e)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
M.liftM2 (i, i) -> [e] -> a i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Get i -> Get i -> Get (i, i)
forall a b. Get a -> Get b -> Get (a, b)
getTwoOf Get i
ix Get i
ix) (Get e -> Get [e]
forall a. Get a -> Get [a]
getListOf Get e
e)
getSeqOf :: Get a -> Get (Seq.Seq a)
getSeqOf :: Get a -> Get (Seq a)
getSeqOf m :: Get a
m = Seq a -> Word64 -> Get (Seq a)
forall t. (Eq t, Num t) => Seq a -> t -> Get (Seq a)
go Seq a
forall a. Seq a
Seq.empty (Word64 -> Get (Seq a)) -> Get Word64 -> Get (Seq a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word64
getWord64be
where
go :: Seq a -> t -> Get (Seq a)
go xs :: Seq a
xs 0 = Seq a -> Get (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> Get (Seq a)) -> Seq a -> Get (Seq a)
forall a b. (a -> b) -> a -> b
$! Seq a
xs
go xs :: Seq a
xs n :: t
n = Seq a
xs Seq a -> Get (Seq a) -> Get (Seq a)
forall a b. a -> b -> b
`seq` t
n t -> Get (Seq a) -> Get (Seq a)
forall a b. a -> b -> b
`seq` do
a
x <- Get a
m
Seq a -> t -> Get (Seq a)
go (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- 1)
getTreeOf :: Get a -> Get (T.Tree a)
getTreeOf :: Get a -> Get (Tree a)
getTreeOf m :: Get a
m = (a -> Forest a -> Tree a)
-> Get a -> Get (Forest a) -> Get (Tree a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
M.liftM2 a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
T.Node Get a
m (Get (Tree a) -> Get (Forest a)
forall a. Get a -> Get [a]
getListOf (Get a -> Get (Tree a)
forall a. Get a -> Get (Tree a)
getTreeOf Get a
m))
getMapOf :: Ord k => Get k -> Get a -> Get (Map.Map k a)
getMapOf :: Get k -> Get a -> Get (Map k a)
getMapOf k :: Get k
k m :: Get a
m = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, a)] -> Map k a) -> Get [(k, a)] -> Get (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get (k, a) -> Get [(k, a)]
forall a. Get a -> Get [a]
getListOf (Get k -> Get a -> Get (k, a)
forall a b. Get a -> Get b -> Get (a, b)
getTwoOf Get k
k Get a
m)
getIntMapOf :: Get Int -> Get a -> Get (IntMap.IntMap a)
getIntMapOf :: Get Int -> Get a -> Get (IntMap a)
getIntMapOf i :: Get Int
i m :: Get a
m = [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, a)] -> IntMap a) -> Get [(Int, a)] -> Get (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get (Int, a) -> Get [(Int, a)]
forall a. Get a -> Get [a]
getListOf (Get Int -> Get a -> Get (Int, a)
forall a b. Get a -> Get b -> Get (a, b)
getTwoOf Get Int
i Get a
m)
getSetOf :: Ord a => Get a -> Get (Set.Set a)
getSetOf :: Get a -> Get (Set a)
getSetOf m :: Get a
m = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Get [a] -> Get (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get a -> Get [a]
forall a. Get a -> Get [a]
getListOf Get a
m
getIntSetOf :: Get Int -> Get IntSet.IntSet
getIntSetOf :: Get Int -> Get IntSet
getIntSetOf m :: Get Int
m = [Int] -> IntSet
IntSet.fromList ([Int] -> IntSet) -> Get [Int] -> Get IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get Int -> Get [Int]
forall a. Get a -> Get [a]
getListOf Get Int
m
getMaybeOf :: Get a -> Get (Maybe a)
getMaybeOf :: Get a -> Get (Maybe a)
getMaybeOf m :: Get a
m = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
0 -> Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Get a -> Get (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get a
m
getEitherOf :: Get a -> Get b -> Get (Either a b)
getEitherOf :: Get a -> Get b -> Get (Either a b)
getEitherOf ma :: Get a
ma mb :: Get b
mb = do
Word8
tag <- Get Word8
getWord8
case Word8
tag of
0 -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Get a -> Get (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get a
ma
_ -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Get b -> Get (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get b
mb
getNested :: Get Int -> Get a -> Get a
getNested :: Get Int -> Get a -> Get a
getNested getLen :: Get Int
getLen getVal :: Get a
getVal = do
Int
n <- Get Int
getLen
Int -> Get a -> Get a
forall a. Int -> Get a -> Get a
isolate Int
n Get a
getVal
bytesRead :: Get Int
bytesRead :: Get Int
bytesRead = (forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success Int r -> Result r)
-> Get Int
forall a.
(forall r.
ByteString
-> Buffer -> More -> Int -> Failure r -> Success a r -> Result r)
-> Get a
Get (\i :: ByteString
i b :: Buffer
b m :: More
m w :: Int
w _ k :: Success Int r
k -> Success Int r
k ByteString
i Buffer
b More
m Int
w Int
w)