{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Flat.Decoder.Prim (
dBool,
dWord8,
dBE8,
dBE16,
dBE32,
dBE64,
dBEBits8,
dBEBits16,
dBEBits32,
dBEBits64,
dropBits,
dFloat,
dDouble,
getChunksInfo,
dByteString_,
dLazyByteString_,
dByteArray_,
ConsState(..),consOpen,consClose,consBool,consBits,
sizeOf,binOf
) where
import Control.Monad (when)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.FloatCast (wordToDouble, wordToFloat)
import Data.Word (Word16, Word32, Word64, Word8)
import Flat.Decoder.Types (Get (Get, runGet), GetResult (..),
S (..), badEncoding, badOp,
notEnoughSpace)
import Flat.Endian (toBE16, toBE32, toBE64)
import Flat.Memory (ByteArray, chunksToByteArray,
chunksToByteString, minusPtr,
peekByteString)
import Foreign (Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.)),
FiniteBits (finiteBitSize), Ptr,
Storable (peek), castPtr, plusPtr,
ptrToIntPtr)
data ConsState =
ConsState {-# UNPACK #-} !Word !Int
consOpen :: Get ConsState
consOpen :: Get ConsState
consOpen = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
let u :: Int
u = S -> Int
usedBits S
s
let d :: IntPtr
d = forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr Word8
endPtr forall a. Num a => a -> a -> a
- forall a. Ptr a -> IntPtr
ptrToIntPtr (S -> Ptr Word8
currPtr S
s)
Word
w <- if IntPtr
d forall a. Ord a => a -> a -> Bool
> IntPtr
1 then do
Word16
w16::Word16 <- Word16 -> Word16
toBE16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w16 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
uforall a. Num a => a -> a -> a
+(Int
wordSizeforall a. Num a => a -> a -> a
-Int
16))
else if IntPtr
d forall a. Eq a => a -> a -> Bool
== IntPtr
1 then do
Word8
w8 :: Word8 <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
uforall a. Num a => a -> a -> a
+(Int
wordSizeforall a. Num a => a -> a -> a
-Int
8))
else forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s (Word -> Int -> ConsState
ConsState Word
w Int
0)
consClose :: Int -> Get ()
consClose :: Int -> Get ()
consClose Int
n = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
let u' :: Int
u' = Int
nforall a. Num a => a -> a -> a
+S -> Int
usedBits S
s
if Int
u' forall a. Ord a => a -> a -> Bool
< Int
8
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {usedBits :: Int
usedBits=Int
u'}) ()
else if S -> Ptr Word8
currPtr S
s forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
then forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,usedBits :: Int
usedBits=Int
u'forall a. Num a => a -> a -> a
-Int
8}) ()
consBool :: ConsState -> (ConsState,Bool)
consBool :: ConsState -> (ConsState, Bool)
consBool ConsState
cs = (Word
0forall a. Eq a => a -> a -> Bool
/=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Int -> (ConsState, Word)
consBits ConsState
cs Int
1
consBits :: ConsState -> Int -> (ConsState, Word)
consBits :: ConsState -> Int -> (ConsState, Word)
consBits ConsState
cs Int
3 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
3 Word
7
consBits ConsState
cs Int
2 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
2 Word
3
consBits ConsState
cs Int
1 = ConsState -> Int -> Word -> (ConsState, Word)
consBits_ ConsState
cs Int
1 Word
1
consBits ConsState
_ Int
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"
consBits_ :: ConsState -> Int -> Word -> (ConsState, Word)
#define CONS_STA
#ifdef CONS_ROT
consBits_ (ConsState w usedBits) numBits mask =
let usedBits' = numBits+usedBits
w' = w `rotateL` numBits
in (ConsState w' usedBits',w' .&. mask)
#endif
#ifdef CONS_SHL
consBits_ (ConsState w usedBits) numBits mask =
let usedBits' = numBits+usedBits
w' = w `unsafeShiftL` numBits
in (ConsState w' usedBits', (w `unsafeShiftR` (wordSize - numBits)) .&. mask)
#endif
#ifdef CONS_STA
consBits_ :: ConsState -> Int -> Word -> (ConsState, Word)
consBits_ (ConsState Word
w Int
usedBits) Int
numBits Word
mask =
let usedBits' :: Int
usedBits' = Int
numBitsforall a. Num a => a -> a -> a
+Int
usedBits
in (Word -> Int -> ConsState
ConsState Word
w Int
usedBits', (Word
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize forall a. Num a => a -> a -> a
- Int
usedBits')) forall a. Bits a => a -> a -> a
.&. Word
mask)
#endif
wordSize :: Int
wordSize :: Int
wordSize = forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
{-# INLINE ensureBits #-}
ensureBits :: Ptr Word8 -> S -> Int -> IO ()
ensureBits :: Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Ptr Word8
endPtr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s) forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s forall a. Ord a => a -> a -> Bool
< Int
n) forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
{-# INLINE dropBits #-}
dropBits :: Int -> Get ()
dropBits :: Int -> Get ()
dropBits Int
n
| Int
n forall a. Ord a => a -> a -> Bool
> Int
0 = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits_ S
s Int
n) ()
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"dropBits",forall a. Show a => a -> [Char]
show Int
n]
{-# INLINE dropBits_ #-}
dropBits_ :: S -> Int -> S
dropBits_ :: S -> Int -> S
dropBits_ S
s Int
n =
let (Int
bytes,Int
bits) = (Int
nforall a. Num a => a -> a -> a
+S -> Int
usedBits S
s) forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
in S {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytes,usedBits :: Int
usedBits=Int
bits}
{-# INLINE dBool #-}
dBool :: Get Bool
dBool :: Get Bool
dBool = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s ->
if S -> Ptr Word8
currPtr S
s forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
then forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
else do
!Word8
w <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
let !b :: Bool
b = Word8
0 forall a. Eq a => a -> a -> Bool
/= (Word8
w forall a. Bits a => a -> a -> a
.&. (Word8
128 forall a. Bits a => a -> Int -> a
`unsafeShiftR` S -> Int
usedBits S
s))
let !s' :: S
s' = if S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
== Int
7
then S
s { currPtr :: Ptr Word8
currPtr = S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1, usedBits :: Int
usedBits = Int
0 }
else S
s { usedBits :: Int
usedBits = S -> Int
usedBits S
s forall a. Num a => a -> a -> a
+ Int
1 }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s' Bool
b
{-# INLINE dBEBits8 #-}
dBEBits8 :: Int -> Get Word8
dBEBits8 :: Int -> Get Word8
dBEBits8 Int
n = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
S -> Int -> IO (GetResult Word8)
take8 S
s Int
n
{-# INLINE dBEBits16 #-}
dBEBits16 :: Int -> Get Word16
dBEBits16 :: Int -> Get Word16
dBEBits16 Int
n = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s
{-# INLINE dBEBits32 #-}
dBEBits32 :: Int -> Get Word32
dBEBits32 :: Int -> Get Word32
dBEBits32 Int
n = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s
{-# INLINE dBEBits64 #-}
dBEBits64 :: Int -> Get Word64
dBEBits64 :: Int -> Get Word64
dBEBits64 Int
n = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
n
forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s
{-# INLINE take8 #-}
take8 :: S -> Int -> IO (GetResult Word8)
take8 :: S -> Int -> IO (GetResult Word8)
take8 S
s Int
n = forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits8 S
s Int
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> S -> Int -> IO Word8
read8 S
s Int
n
where
read8 :: S -> Int -> IO Word8
read8 :: S -> Int -> IO Word8
read8 S
s Int
n | Int
n forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<=Int
8 =
if Int
n forall a. Ord a => a -> a -> Bool
<= Int
8 forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s
then do
Word8
w <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Word8
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 forall a. Num a => a -> a -> a
- Int
n)
else do
Word16
w::Word16 <- Word16 -> Word16
toBE16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
16 forall a. Num a => a -> a -> a
- Int
n)
| Bool
otherwise = forall a. [Char] -> IO a
badOp forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"read8: cannot read",forall a. Show a => a -> [Char]
show Int
n,[Char]
"bits"]
dropBits8 :: S -> Int -> S
dropBits8 :: S -> Int -> S
dropBits8 S
s Int
n =
let u' :: Int
u' = Int
nforall a. Num a => a -> a -> a
+S -> Int
usedBits S
s
in if Int
u' forall a. Ord a => a -> a -> Bool
< Int
8
then S
s {usedBits :: Int
usedBits=Int
u'}
else S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,usedBits :: Int
usedBits=Int
u'forall a. Num a => a -> a -> a
-Int
8}
{-# INLINE takeN #-}
takeN :: (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN :: forall a. (Num a, Bits a) => Int -> S -> IO (GetResult a)
takeN Int
n S
s = forall {t}.
(Bits t, Num t) =>
S -> t -> Int -> Int -> IO (GetResult t)
read S
s a
0 (Int
n forall a. Num a => a -> a -> a
- (Int
n forall a. Ord a => a -> a -> a
`min` Int
8)) Int
n
where
read :: S -> t -> Int -> Int -> IO (GetResult t)
read S
s t
r Int
sh Int
n | Int
n forall a. Ord a => a -> a -> Bool
<=Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s t
r
| Bool
otherwise = do
let m :: Int
m = Int
n forall a. Ord a => a -> a -> a
`min` Int
8
GetResult S
s' Word8
b <- S -> Int -> IO (GetResult Word8)
take8 S
s Int
m
S -> t -> Int -> Int -> IO (GetResult t)
read S
s' (t
r forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)) ((Int
shforall a. Num a => a -> a -> a
-Int
8) forall a. Ord a => a -> a -> a
`max` Int
0) (Int
nforall a. Num a => a -> a -> a
-Int
8)
dWord8 :: Get Word8
dWord8 :: Get Word8
dWord8 = Get Word8
dBE8
{-# INLINE dBE8 #-}
dBE8 :: Get Word8
dBE8 :: Get Word8
dBE8 = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
8
!Word8
w1 <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
!Word8
w <- if S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w1
else do
!Word8
w2 <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Word8
w1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) forall a. Bits a => a -> a -> a
.|. (Word8
w2 forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1}) Word8
w
{-# INLINE dBE16 #-}
dBE16 :: Get Word16
dBE16 :: Get Word16
dBE16 = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
16
!Word16
w1 <- Word16 -> Word16
toBE16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
!Word16
w <- if S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w1
else do
!(Word8
w2::Word8) <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word16
w1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2}) Word16
w
{-# INLINE dBE32 #-}
dBE32 :: Get Word32
dBE32 :: Get Word32
dBE32 = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
32
!Word32
w1 <- Word32 -> Word32
toBE32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
!Word32
w <- if S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w1
else do
!(Word8
w2::Word8) <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32
w1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4}) Word32
w
{-# INLINE dBE64 #-}
dBE64 :: Get Word64
dBE64 :: Get Word64
dBE64 = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
64
!Word64
w1 <- Word64 -> Word64
toBE64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
peek64 (forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
!Word64
w <- if S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w1
else do
!(Word8
w2::Word8) <- forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word64
w1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8forall a. Num a => a -> a -> a
-S -> Int
usedBits S
s))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8}) Word64
w
where
peek64 :: Ptr Word64 -> IO Word64
peek64 :: Ptr Word64 -> IO Word64
peek64 = forall a. Storable a => Ptr a -> IO a
peek
{-# INLINE dFloat #-}
dFloat :: Get Float
dFloat :: Get Float
dFloat = Word32 -> Float
wordToFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
dBE32
{-# INLINE dDouble #-}
dDouble :: Get Double
dDouble :: Get Double
dDouble = Word64 -> Double
wordToDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
dBE64
dLazyByteString_ :: Get L.ByteString
dLazyByteString_ :: Get ByteString
dLazyByteString_ = ByteString -> ByteString
L.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
dByteString_
dByteString_ :: Get B.ByteString
dByteString_ :: Get ByteString
dByteString_ = (Ptr Word8, [Int]) -> ByteString
chunksToByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Ptr Word8, [Int])
getChunksInfo
dByteArray_ :: Get (ByteArray,Int)
dByteArray_ :: Get (ByteArray, Int)
dByteArray_ = (Ptr Word8, [Int]) -> (ByteArray, Int)
chunksToByteArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Ptr Word8, [Int])
getChunksInfo
getChunksInfo :: Get (Ptr Word8, [Int])
getChunksInfo :: Get (Ptr Word8, [Int])
getChunksInfo = forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
let getChunks :: Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks Ptr b
srcPtr [Int] -> c
l = do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s Int
8
!Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr b
srcPtr
if Int
nforall a. Eq a => a -> a -> Bool
==Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b
srcPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,[Int] -> c
l [])
else do
Ptr Word8 -> S -> Int -> IO ()
ensureBits Ptr Word8
endPtr S
s ((Int
nforall a. Num a => a -> a -> a
+Int
1)forall a. Num a => a -> a -> a
*Int
8)
Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (Ptr b
srcPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
nforall a. Num a => a -> a -> a
+Int
1)) ([Int] -> c
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
nforall a. a -> [a] -> [a]
:))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (S -> Int
usedBits S
s forall a. Eq a => a -> a -> Bool
/=Int
0) forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> S -> [Char] -> IO a
badEncoding Ptr Word8
endPtr S
s [Char]
"usedBits /= 0"
(Ptr Word8
currPtr',[Int]
ns) <- forall {b} {c} {b}.
(Integral b, Storable b) =>
Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (S -> Ptr Word8
currPtr S
s) forall a. a -> a
id
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult (S
s {currPtr :: Ptr Word8
currPtr=Ptr Word8
currPtr'}) (S -> Ptr Word8
currPtr S
s forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1,[Int]
ns)
sizeOf :: Get a -> Get Int
sizeOf :: forall a. Get a -> Get Int
sizeOf Get a
g =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
GetResult S
s' a
_ <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
g Ptr Word8
end S
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s' forall a b. (a -> b) -> a -> b
$ (S -> Ptr Word8
currPtr S
s' forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s) forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s forall a. Num a => a -> a -> a
+ S -> Int
usedBits S
s'
binOf :: Get a -> Get (B.ByteString,Int)
binOf :: forall a. Get a -> Get (ByteString, Int)
binOf Get a
g =
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
GetResult S
s' a
_ <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
g Ptr Word8
end S
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. S -> a -> GetResult a
GetResult S
s' (Ptr Word8 -> Int -> ByteString
peekByteString (S -> Ptr Word8
currPtr S
s) (S -> Ptr Word8
currPtr S
s' forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s forall a. Num a => a -> a -> a
+ if S -> Int
usedBits S
s' forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1),S -> Int
usedBits S
s)