{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables       #-}
-- |Strict Decoder Primitives
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)

-- $setup
-- >>> :set -XBinaryLiterals
-- >>> import Data.Word
-- >>> import Data.Int
-- >>> import Flat.Run
-- >>> import Flat.Bits
-- >>> import Text.PrettyPrint.HughesPJClass (Pretty (pPrint))

{- |A special state, optimised for constructor decoding.

It consists of:

* The bits to parse, the top bit being the first to parse (could use a Word16 instead, no difference in performance)

* The number of decoded bits

Supports up to 512 constructors (9 bits).
-}
data ConsState =
  ConsState {-# UNPACK #-} !Word !Int

-- |Switch to constructor decoding
-- {-# INLINE consOpen  #-}
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 -- two different bytes
          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 -- single last byte left
                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)

-- |Switch back to normal decoding
-- {-# NOINLINE consClose  #-}
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}) ()

  {- ensureBits endPtr s n = when ((endPtr `minusPtr` currPtr s) * 8 - usedBits s < n) $ notEnoughSpace endPtr s
  dropBits8 s n =
    let u' = n+usedBits s
    in if u' < 8
        then s {usedBits=u'}
        else s {currPtr=currPtr s `plusPtr` 1,usedBits=u'-8}
  -}

  --ensureBits endPtr s n
  --return $ GetResult (dropBits8 s n) ()

-- |Decode a single bit
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

-- consBool (ConsState w usedBits) = (ConsState (w `unsafeShiftL` 1) (1+usedBits),0 /= 32768 .&. w)

-- |Decode from 1 to 3 bits
--
-- It could read more bits that are available, but it doesn't matter, errors will be checked in consClose.
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)

-- Different decoding primitives
-- All with equivalent performance
-- #define CONS_ROT
-- #define CONS_SHL
#define CONS_STA

#ifdef CONS_ROT
consBits_ (ConsState w usedBits) numBits mask =
  let usedBits' = numBits+usedBits
      w' = w `rotateL` numBits -- compiles to an or+shiftl+shiftr
  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 #-}
-- |Ensure that the specified number of bits is available
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 #-}
-- |Drop the specified number of bits
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
  -- let
  --   n' = n+usedBits s
  --   bytes = n' `unsafeShiftR` 3
  --   bits = n' .|. 7
  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 #-}
-- Inlining dBool massively increases compilation time but decreases run time by a third
-- TODO: test dBool inlining for ghc >= 8.8.4
-- |Decode a boolean
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  #-}
{- | Return the n most significant bits (up to maximum of 8)

The bits are returned right shifted:

>>> unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111
True

>>> unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111]
Left (BadOp "read8: cannot read 9 bits")
-}
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  #-}
{- | Return the n most significant bits (up to maximum of 16)

The bits are returned right shifted:

>>> pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001]
Right 00000101 10111111

If more than 16 bits are requested, only the last 16 are returned:

>>> pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001]
Right 00000111 11111111
-}
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  #-}
-- |Return the n most significant bits (up to maximum of 32)
-- The bits are returned right shifted.
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  #-}
-- |Return the n most significant bits (up to maximum of 64)
-- The bits are returned right shifted.
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 :: Int -> S -> IO (GetResult Word8)
-- take8 n s
--   | n == 0 = return $ GetResult s 0

--   -- all bits in the same byte
--   | n <= 8 - usedBits s = do
--       w <- peek (currPtr s)
--       let (bytes,bits) = (n+usedBits s) `divMod` 8
--       return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n))

--   -- two different bytes
--   | n <= 8 = do
--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)
--       return $ GetResult (S {currPtr=currPtr s `plusPtr` 1,usedBits=(usedBits s + n) `mod` 8}) (fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n))

--   | otherwise = error $ unwords ["take8: cannot take",show n,"bits"]

{-# INLINE take8 #-}
take8 :: S -> Int -> IO (GetResult Word8)
-- take8 s n = GetResult (dropBits_ s n) <$> read8 s n
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
    --{-# INLINE read8 #-}
    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  -- all bits in the same byte
                      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 -- two different bytes
                      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"]
    -- {-# INLINE dropBits8 #-}
    -- -- Assume n <= 8
    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)

-- takeN n = Get $ \endPtr s -> do
--   ensureBits endPtr s n
--   let (bytes,bits) = (n+usedBits s) `divMod` 8
--   r <- case bytes of
--     0 -> do
--       w <- peek (currPtr s)
--       return . fromIntegral $ ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n))
--     1 -> do
--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)
--       return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n)
--     2 -> do
--       let r = 0
--       w1 <- fromIntegral <$> r8 s
--       w2 <- fromIntegral <$> r16 s
--       w1
--   return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) r

-- r8 s = peek (currPtr s)
-- r16 s = toBE16 <$> peek (castPtr $ currPtr s)

-- |Return the 8 most significant bits (same as dBE8)
dWord8 :: Get Word8
dWord8 :: Get Word8
dWord8 = Get Word8
dBE8

{-# INLINE dBE8  #-}
-- |Return the 8 most significant bits
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 #-}
-- |Return the 16 most significant bits
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 #-}
-- |Return the 32 most significant bits
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 #-}
-- |Return the 64 most significant bits
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
  -- !w1 <- toBE64 <$> peek (castPtr $ currPtr s)
  !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
      -- {-# INLINE peek64 #-}
      peek64 :: Ptr Word64 -> IO Word64
      peek64 :: Ptr Word64 -> IO Word64
peek64 = forall a. Storable a => Ptr a -> IO a
peek
      -- peek64 ptr = fix64 <$> peek ptr

{-# INLINE dFloat #-}
-- |Decode a Float
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 #-}
-- |Decode a Double
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

-- |Decode a Lazy ByteString
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_

-- |Decode a ByteString
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

-- |Decode a ByteArray and its length
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

-- |Decode an Array (a list of chunks up to 255 bytes long) returning the pointer to the first data byte and a list of chunk sizes
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]
:)) -- ETA: stack overflow (missing tail call optimisation)

   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)

{- | Given a value's decoder, returns the size in bits of the encoded value

@since 0.6
-}
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'

{- | Given a value's decoder, returns the value's bit encoding.

The encoding starts at the returned bit position in the return bytestring's first byte
and ends in an unspecified bit position in its final byte

@since 0.6
-}
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)