{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- | Strict Decoder Primitives
module PlutusCore.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 Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as L
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign
  ( Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.))
  , FiniteBits (finiteBitSize)
  , Ptr
  , Storable (peek)
  , castPtr
  , plusPtr
  , ptrToIntPtr
  )
import PlutusCore.Flat.Data.FloatCast (wordToDouble, wordToFloat)
import PlutusCore.Flat.Decoder.Types
  ( Get (Get, runGet)
  , GetResult (..)
  , S (..)
  , badEncoding
  , badOp
  , notEnoughSpace
  )
import PlutusCore.Flat.Endian (toBE16, toBE32, toBE64)
import PlutusCore.Flat.Memory
  ( ByteArray
  , chunksToByteArray
  , chunksToByteString
  , minusPtr
  , peekByteString
  )

{-$setup
>>> :set -XBinaryLiterals
>>> import Data.Word
>>> import Data.Int
>>> import PlutusCore.Flat.Run
>>> import PlutusCore.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 = (Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState)
-> (Ptr Word8 -> S -> IO (GetResult ConsState)) -> Get ConsState
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 = Ptr Word8 -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr Word8
endPtr IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
- Ptr Word8 -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr (S -> Ptr Word8
currPtr S
s)
  Word
w <-
    if IntPtr
d IntPtr -> IntPtr -> Bool
forall a. Ord a => a -> a -> Bool
> IntPtr
1
      then do
        -- two different bytes
        Word16
w16 :: Word16 <- Word16 -> Word16
toBE16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
        Word -> IO Word
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> IO Word) -> Word -> IO Word
forall a b. (a -> b) -> a -> b
$ Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w16 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16))
      else
        if IntPtr
d IntPtr -> IntPtr -> Bool
forall a. Eq a => a -> a -> Bool
== IntPtr
1
          then do
            -- single last byte left
            Word8
w8 :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
            Word -> IO Word
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> IO Word) -> Word -> IO Word
forall a b. (a -> b) -> a -> b
$ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8))
          else Ptr Word8 -> S -> IO Word
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
  GetResult ConsState -> IO (GetResult ConsState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult ConsState -> IO (GetResult ConsState))
-> GetResult ConsState -> IO (GetResult ConsState)
forall a b. (a -> b) -> a -> b
$ S -> ConsState -> GetResult ConsState
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 = (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ())) -> Get ())
-> (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s -> do
  let u' :: Int
u' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ S -> Int
usedBits S
s
  if Int
u' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
    then GetResult () -> IO (GetResult ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S
s {usedBits = u'}) ()
    else
      if S -> Ptr Word8
currPtr S
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
        then Ptr Word8 -> S -> IO (GetResult ())
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
        else GetResult () -> IO (GetResult ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr s `plusPtr` 1, usedBits = u' - 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
0 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Word -> Bool) -> (ConsState, Word) -> (ConsState, 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
_ = [Char] -> (ConsState, Word)
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
numBitsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
usedBits
  in (Word -> Int -> ConsState
ConsState Word
w Int
usedBits', (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
usedBits')) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
mask)
#endif

wordSize :: Int
wordSize :: Int
wordSize = Word -> Int
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 = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Ptr Word8
endPtr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> S -> IO ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (Ptr Word8 -> S -> IO (GetResult ())) -> Get ()
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult ())) -> Get ())
-> (Ptr Word8 -> S -> IO (GetResult ())) -> 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
      GetResult () -> IO (GetResult ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult () -> IO (GetResult ()))
-> GetResult () -> IO (GetResult ())
forall a b. (a -> b) -> a -> b
$ S -> () -> GetResult ()
forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits_ S
s Int
n) ()
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = [Char] -> Get ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Get ()) -> [Char] -> Get ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"dropBits", Int -> [Char]
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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ S -> Int
usedBits S
s) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
   in -- let
      --   n' = n+usedBits s
      --   bytes = n' `unsafeShiftR` 3
      --   bits = n' .|. 7
      S {currPtr :: Ptr Word8
currPtr = S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
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 = (Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool)
-> (Ptr Word8 -> S -> IO (GetResult Bool)) -> Get Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
endPtr S
s ->
  if S -> Ptr Word8
currPtr S
s Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
endPtr
    then Ptr Word8 -> S -> IO (GetResult Bool)
forall a. Ptr Word8 -> S -> IO a
notEnoughSpace Ptr Word8
endPtr S
s
    else do
      !Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
      let !b :: Bool
b = Word8
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. (Word8
128 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` S -> Int
usedBits S
s))
      let !s' :: S
s' =
            if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7
              then S
s {currPtr = currPtr s `plusPtr` 1, usedBits = 0}
              else S
s {usedBits = usedBits s + 1}
      GetResult Bool -> IO (GetResult Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Bool -> IO (GetResult Bool))
-> GetResult Bool -> IO (GetResult Bool)
forall a b. (a -> b) -> a -> b
$ S -> Bool -> GetResult Bool
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 = (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8)
-> (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
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 = (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16)
-> (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
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
  Int -> S -> IO (GetResult Word16)
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 = (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32)
-> (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
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
  Int -> S -> IO (GetResult Word32)
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 = (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64)
-> (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
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
  Int -> S -> IO (GetResult Word64)
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 = S -> Word8 -> GetResult Word8
forall a. S -> a -> GetResult a
GetResult (S -> Int -> S
dropBits8 S
s Int
n) (Word8 -> GetResult Word8) -> IO Word8 -> IO (GetResult Word8)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 =
          if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s
            then do
              -- all bits in the same byte
              Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
              Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
            else do
              -- two different bytes
              Word16
w :: Word16 <- Word16 -> Word16
toBE16 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
              Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
w Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
      | Bool
otherwise = [Char] -> IO Word8
forall a. [Char] -> IO a
badOp ([Char] -> IO Word8) -> [Char] -> IO Word8
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"read8: cannot read", Int -> [Char]
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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ S -> Int
usedBits S
s
       in if Int
u' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
            then S
s {usedBits = u'}
            else S
s {currPtr = currPtr s `plusPtr` 1, usedBits = u' - 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 = S -> a -> Int -> Int -> IO (GetResult a)
forall {t}.
(Bits t, Num t) =>
S -> t -> Int -> Int -> IO (GetResult t)
read S
s a
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = GetResult t -> IO (GetResult t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult t -> IO (GetResult t))
-> GetResult t -> IO (GetResult t)
forall a b. (a -> b) -> a -> b
$ S -> t -> GetResult t
forall a. S -> a -> GetResult a
GetResult S
s t
r
      | Bool
otherwise = do
          let m :: Int
m = Int
n Int -> Int -> Int
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 t -> t -> t
forall a. Bits a => a -> a -> a
.|. (Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)) ((Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) (Int
n Int -> Int -> Int
forall 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 = (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8)
-> (Ptr Word8 -> S -> IO (GetResult Word8)) -> Get Word8
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 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s)
  !Word8
w <-
    if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
w1
      else do
        !Word8
w2 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
        Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> IO Word8) -> Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ (Word8
w1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s))
  GetResult Word8 -> IO (GetResult Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word8 -> IO (GetResult Word8))
-> GetResult Word8 -> IO (GetResult Word8)
forall a b. (a -> b) -> a -> b
$ S -> Word8 -> GetResult Word8
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr s `plusPtr` 1}) Word8
w

{-# INLINE dBE16 #-}

-- | Return the 16 most significant bits
dBE16 :: Get Word16
dBE16 :: Get Word16
dBE16 = (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16)
-> (Ptr Word8 -> S -> IO (GetResult Word16)) -> Get Word16
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 (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word16
w <-
    if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w1
      else do
        !(Word8
w2 :: Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2)
        Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> IO Word16) -> Word16 -> IO Word16
forall a b. (a -> b) -> a -> b
$ Word16
w1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s))
  GetResult Word16 -> IO (GetResult Word16)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word16 -> IO (GetResult Word16))
-> GetResult Word16 -> IO (GetResult Word16)
forall a b. (a -> b) -> a -> b
$ S -> Word16 -> GetResult Word16
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr s `plusPtr` 2}) Word16
w

{-# INLINE dBE32 #-}

-- | Return the 32 most significant bits
dBE32 :: Get Word32
dBE32 :: Get Word32
dBE32 = (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32)
-> (Ptr Word8 -> S -> IO (GetResult Word32)) -> Get Word32
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 (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word32) -> Ptr Word8 -> Ptr Word32
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word32
w <-
    if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
w1
      else do
        !(Word8
w2 :: Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ Word32
w1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s))
  GetResult Word32 -> IO (GetResult Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word32 -> IO (GetResult Word32))
-> GetResult Word32 -> IO (GetResult Word32)
forall a b. (a -> b) -> a -> b
$ S -> Word32 -> GetResult Word32
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr s `plusPtr` 4}) Word32
w

{-# INLINE dBE64 #-}

-- | Return the 64 most significant bits
dBE64 :: Get Word64
dBE64 :: Get Word64
dBE64 = (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64)
-> (Ptr Word8 -> S -> IO (GetResult Word64)) -> Get Word64
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 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word64 -> IO Word64
peek64 (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word64) -> Ptr Word8 -> Ptr Word64
forall a b. (a -> b) -> a -> b
$ S -> Ptr Word8
currPtr S
s)
  !Word64
w <-
    if S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
w1
      else do
        !(Word8
w2 :: Word8) <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
        Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Word64
w1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` S -> Int
usedBits S
s Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s))
  GetResult Word64 -> IO (GetResult Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Word64 -> IO (GetResult Word64))
-> GetResult Word64 -> IO (GetResult Word64)
forall a b. (a -> b) -> a -> b
$ S -> Word64 -> GetResult Word64
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr s `plusPtr` 8}) Word64
w
  where
    -- {-# INLINE peek64 #-}
    peek64 :: Ptr Word64 -> IO Word64
    peek64 :: Ptr Word64 -> IO Word64
peek64 = Ptr Word64 -> IO Word64
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 (Word32 -> Float) -> Get Word32 -> Get Float
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 (Word64 -> Double) -> Get Word64 -> Get Double
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 (ByteString -> ByteString) -> Get ByteString -> Get ByteString
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 ((Ptr Word8, [Int]) -> ByteString)
-> Get (Ptr Word8, [Int]) -> Get ByteString
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 ((Ptr Word8, [Int]) -> (ByteArray, Int))
-> Get (Ptr Word8, [Int]) -> Get (ByteArray, Int)
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 = (Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
-> Get (Ptr Word8, [Int])
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
 -> Get (Ptr Word8, [Int]))
-> (Ptr Word8 -> S -> IO (GetResult (Ptr Word8, [Int])))
-> Get (Ptr Word8, [Int])
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 <- b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> Int) -> IO b -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
srcPtr
        if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then (Ptr b, c) -> IO (Ptr b, c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b
srcPtr Ptr b -> Int -> Ptr b
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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
            Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (Ptr b
srcPtr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ([Int] -> c
l ([Int] -> c) -> ([Int] -> [Int]) -> [Int] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) -- ETA: stack overflow (missing tail call optimisation)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (S -> Int
usedBits S
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> S -> [Char] -> IO ()
forall a. Ptr Word8 -> S -> [Char] -> IO a
badEncoding Ptr Word8
endPtr S
s [Char]
"usedBits /= 0"
  (Ptr Word8
currPtr', [Int]
ns) <- Ptr Word8 -> ([Int] -> [Int]) -> IO (Ptr Word8, [Int])
forall {b} {c} {b}.
(Integral b, Storable b) =>
Ptr b -> ([Int] -> c) -> IO (Ptr b, c)
getChunks (S -> Ptr Word8
currPtr S
s) [Int] -> [Int]
forall a. a -> a
id
  GetResult (Ptr Word8, [Int]) -> IO (GetResult (Ptr Word8, [Int]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult (Ptr Word8, [Int]) -> IO (GetResult (Ptr Word8, [Int])))
-> GetResult (Ptr Word8, [Int])
-> IO (GetResult (Ptr Word8, [Int]))
forall a b. (a -> b) -> a -> b
$ S -> (Ptr Word8, [Int]) -> GetResult (Ptr Word8, [Int])
forall a. S -> a -> GetResult a
GetResult (S
s {currPtr = currPtr'}) (S -> Ptr Word8
currPtr S
s Ptr Word8 -> Int -> Ptr Word8
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 =
  (Ptr Word8 -> S -> IO (GetResult Int)) -> Get Int
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult Int)) -> Get Int)
-> (Ptr Word8 -> S -> IO (GetResult Int)) -> Get Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
    GetResult S
s' a
_ <- Get a -> Ptr Word8 -> S -> IO (GetResult a)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
g Ptr Word8
end S
s
    GetResult Int -> IO (GetResult Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult Int -> IO (GetResult Int))
-> GetResult Int -> IO (GetResult Int)
forall a b. (a -> b) -> a -> b
$ S -> Int -> GetResult Int
forall a. S -> a -> GetResult a
GetResult S
s' (Int -> GetResult Int) -> Int -> GetResult Int
forall a b. (a -> b) -> a -> b
$ (S -> Ptr Word8
currPtr S
s' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- S -> Int
usedBits S
s Int -> Int -> Int
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 =
  (Ptr Word8 -> S -> IO (GetResult (ByteString, Int)))
-> Get (ByteString, Int)
forall a. (Ptr Word8 -> S -> IO (GetResult a)) -> Get a
Get ((Ptr Word8 -> S -> IO (GetResult (ByteString, Int)))
 -> Get (ByteString, Int))
-> (Ptr Word8 -> S -> IO (GetResult (ByteString, Int)))
-> Get (ByteString, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end S
s -> do
    GetResult S
s' a
_ <- Get a -> Ptr Word8 -> S -> IO (GetResult a)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
g Ptr Word8
end S
s
    GetResult (ByteString, Int) -> IO (GetResult (ByteString, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetResult (ByteString, Int) -> IO (GetResult (ByteString, Int)))
-> GetResult (ByteString, Int) -> IO (GetResult (ByteString, Int))
forall a b. (a -> b) -> a -> b
$ S -> (ByteString, Int) -> GetResult (ByteString, Int)
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' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` S -> Ptr Word8
currPtr S
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if S -> Int
usedBits S
s' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1), S -> Int
usedBits S
s)