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

-- |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
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
wordSizeInt -> 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
uInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
wordSizeInt -> 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
nInt -> 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
0Word -> 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
nInt -> 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
  -- let
  --   n' = n+usedBits s
  --   bytes = n' `unsafeShiftR` 3
  --   bits = n' .|. 7
  in 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
nInt -> 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
shInt -> 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
nInt -> 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
8Int -> 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
8Int -> 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
8Int -> 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
8Int -> 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
nInt -> 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
nInt -> 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
nInt -> 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
nInt -> [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)