Content-Length: 442620 | pFad | http://hackage.haskell.org/package/dahdit-0.2.0/docs/src/Dahdit.Funs.html#putStaticHint

module Dahdit.Funs
  ( getWord8
  , getInt8
  , getWord16LE
  , getInt16LE
  , getWord24LE
  , getInt24LE
  , getWord32LE
  , getInt32LE
  , getWord64LE
  , getInt64LE
  , getFloatLE
  , getDoubleLE
  , getWord16BE
  , getInt16BE
  , getWord24BE
  , getInt24BE
  , getWord32BE
  , getInt32BE
  , getWord64BE
  , getInt64BE
  , getFloatBE
  , getDoubleBE
  , getByteString
  , getSkip
  , getExact
  , getWithin
  , getList
  , getSeq
  , getStaticSeq
  , getStaticArray
  , getByteArray
  , getLiftedPrimArray
  , getExpect
  , getLookAhead
  , getRemainingSize
  , getRemainingString
  , getRemainingSeq
  , getRemainingStaticSeq
  , getRemainingStaticArray
  , getRemainingByteArray
  , getRemainingLiftedPrimArray
  , getUnfold
  , putWord8
  , putInt8
  , putWord16LE
  , putInt16LE
  , putWord24LE
  , putInt24LE
  , putWord32LE
  , putInt32LE
  , putWord64LE
  , putInt64LE
  , putFloatLE
  , putDoubleLE
  , putWord16BE
  , putInt16BE
  , putWord24BE
  , putInt24BE
  , putWord32BE
  , putInt32BE
  , putWord64BE
  , putInt64BE
  , putFloatBE
  , putDoubleBE
  , putByteString
  , putFixedString
  , putList
  , putSeq
  , putStaticSeq
  , unsafePutStaticSeqN
  , putStaticArray
  , unsafePutStaticArrayN
  , putByteArray
  , putLiftedPrimArray
  , putStaticHint
  )
where

import Control.Monad (replicateM_, unless)
import Control.Monad.Free.Church (F (..))
import Dahdit.Free
  ( Get (..)
  , GetF (..)
  , GetLookAheadF (..)
  , GetScopeF (..)
  , GetStaticArrayF (..)
  , GetStaticSeqF (..)
  , Put
  , PutF (..)
  , PutM (..)
  , PutStaticArrayF (..)
  , PutStaticHintF (..)
  , PutStaticSeqF (..)
  , ScopeMode (..)
  )
import Dahdit.LiftedPrim (LiftedPrim (..))
import Dahdit.LiftedPrimArray (LiftedPrimArray (..), lengthLiftedPrimArray)
import Dahdit.Nums
  ( DoubleBE
  , DoubleLE
  , FloatBE
  , FloatLE
  , Int16BE
  , Int16LE
  , Int24BE
  , Int24LE
  , Int32BE
  , Int32LE
  , Int64BE
  , Int64LE
  , Word16BE
  , Word16LE
  , Word24BE
  , Word24LE
  , Word32BE
  , Word32LE
  , Word64BE
  , Word64LE
  )
import Dahdit.Proxy (proxyForF, proxyForFun)
import Dahdit.Sizes (ByteCount (..), ElemCount (..), StaticByteSized (..))
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS
import Data.Coerce (coerce)
import Data.Foldable (traverse_)
import Data.Int (Int8)
import Data.Primitive (sizeofByteArray)
import Data.Primitive.ByteArray (ByteArray)
import Data.Proxy (Proxy (..))
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Word (Word8)

getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word8 -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word8 -> a) -> GetF a
GetFWord8 Word8 -> r
x)))

getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int8 -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int8 -> a) -> GetF a
GetFInt8 Int8 -> r
x)))

getWord16LE :: Get Word16LE
getWord16LE :: Get Word16LE
getWord16LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word16LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word16LE -> a) -> GetF a
GetFWord16LE Word16LE -> r
x)))

getInt16LE :: Get Int16LE
getInt16LE :: Get Int16LE
getInt16LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int16LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int16LE -> a) -> GetF a
GetFInt16LE Int16LE -> r
x)))

getWord24LE :: Get Word24LE
getWord24LE :: Get Word24LE
getWord24LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word24LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word24LE -> a) -> GetF a
GetFWord24LE Word24LE -> r
x)))

getInt24LE :: Get Int24LE
getInt24LE :: Get Int24LE
getInt24LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int24LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int24LE -> a) -> GetF a
GetFInt24LE Int24LE -> r
x)))

getWord32LE :: Get Word32LE
getWord32LE :: Get Word32LE
getWord32LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word32LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word32LE -> a) -> GetF a
GetFWord32LE Word32LE -> r
x)))

getInt32LE :: Get Int32LE
getInt32LE :: Get Int32LE
getInt32LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int32LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int32LE -> a) -> GetF a
GetFInt32LE Int32LE -> r
x)))

getWord64LE :: Get Word64LE
getWord64LE :: Get Word64LE
getWord64LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word64LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word64LE -> a) -> GetF a
GetFWord64LE Word64LE -> r
x)))

getInt64LE :: Get Int64LE
getInt64LE :: Get Int64LE
getInt64LE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int64LE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int64LE -> a) -> GetF a
GetFInt64LE Int64LE -> r
x)))

getFloatLE :: Get FloatLE
getFloatLE :: Get FloatLE
getFloatLE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\FloatLE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (FloatLE -> a) -> GetF a
GetFFloatLE FloatLE -> r
x)))

getDoubleLE :: Get DoubleLE
getDoubleLE :: Get DoubleLE
getDoubleLE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\DoubleLE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (DoubleLE -> a) -> GetF a
GetFDoubleLE DoubleLE -> r
x)))

getWord16BE :: Get Word16BE
getWord16BE :: Get Word16BE
getWord16BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word16BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word16BE -> a) -> GetF a
GetFWord16BE Word16BE -> r
x)))

getInt16BE :: Get Int16BE
getInt16BE :: Get Int16BE
getInt16BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int16BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int16BE -> a) -> GetF a
GetFInt16BE Int16BE -> r
x)))

getWord24BE :: Get Word24BE
getWord24BE :: Get Word24BE
getWord24BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word24BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word24BE -> a) -> GetF a
GetFWord24BE Word24BE -> r
x)))

getInt24BE :: Get Int24BE
getInt24BE :: Get Int24BE
getInt24BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int24BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int24BE -> a) -> GetF a
GetFInt24BE Int24BE -> r
x)))

getWord32BE :: Get Word32BE
getWord32BE :: Get Word32BE
getWord32BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word32BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word32BE -> a) -> GetF a
GetFWord32BE Word32BE -> r
x)))

getInt32BE :: Get Int32BE
getInt32BE :: Get Int32BE
getInt32BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int32BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int32BE -> a) -> GetF a
GetFInt32BE Int32BE -> r
x)))

getWord64BE :: Get Word64BE
getWord64BE :: Get Word64BE
getWord64BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Word64BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Word64BE -> a) -> GetF a
GetFWord64BE Word64BE -> r
x)))

getInt64BE :: Get Int64BE
getInt64BE :: Get Int64BE
getInt64BE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Int64BE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (Int64BE -> a) -> GetF a
GetFInt64BE Int64BE -> r
x)))

getFloatBE :: Get FloatBE
getFloatBE :: Get FloatBE
getFloatBE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\FloatBE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (FloatBE -> a) -> GetF a
GetFFloatBE FloatBE -> r
x)))

getDoubleBE :: Get DoubleBE
getDoubleBE :: Get DoubleBE
getDoubleBE = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\DoubleBE -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (DoubleBE -> a) -> GetF a
GetFDoubleBE DoubleBE -> r
x)))

getByteString :: ByteCount -> Get ShortByteString
getByteString :: ByteCount -> Get ShortByteString
getByteString ByteCount
bc = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\ShortByteString -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. ByteCount -> (ShortByteString -> a) -> GetF a
GetFShortByteString ByteCount
bc ShortByteString -> r
x)))

getSkip :: ByteCount -> Get ()
getSkip :: ByteCount -> Get ()
getSkip ByteCount
bc = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. ByteCount -> a -> GetF a
GetFSkip ByteCount
bc (() -> r
x ()))))

getExact :: ByteCount -> Get a -> Get a
getExact :: forall a. ByteCount -> Get a -> Get a
getExact ByteCount
bc Get a
g = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\a -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. GetScopeF a -> GetF a
GetFScope (forall z a.
ScopeMode -> ByteCount -> Get z -> (z -> a) -> GetScopeF a
GetScopeF ScopeMode
ScopeModeExact ByteCount
bc Get a
g a -> r
x))))

getWithin :: ByteCount -> Get a -> Get a
getWithin :: forall a. ByteCount -> Get a -> Get a
getWithin ByteCount
bc Get a
g = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\a -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. GetScopeF a -> GetF a
GetFScope (forall z a.
ScopeMode -> ByteCount -> Get z -> (z -> a) -> GetScopeF a
GetScopeF ScopeMode
ScopeModeWithin ByteCount
bc Get a
g a -> r
x))))

-- | Get List of dynamically-sized elements
getList :: ElemCount -> Get a -> Get [a]
getList :: forall a. ElemCount -> Get a -> Get [a]
getList ElemCount
ec Get a
g = [a] -> ElemCount -> Get [a]
go [] ElemCount
0
 where
  go :: [a] -> ElemCount -> Get [a]
go ![a]
acc !ElemCount
i =
    if ElemCount
i forall a. Eq a => a -> a -> Bool
== ElemCount
ec
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse [a]
acc)
      else do
        a
x <- Get a
g
        [a] -> ElemCount -> Get [a]
go (a
x forall a. a -> [a] -> [a]
: [a]
acc) (ElemCount
i forall a. Num a => a -> a -> a
+ ElemCount
1)

-- | Get Seq of dynamically-sized elements
getSeq :: ElemCount -> Get a -> Get (Seq a)
getSeq :: forall a. ElemCount -> Get a -> Get (Seq a)
getSeq ElemCount
ec Get a
g = Seq a -> ElemCount -> Get (Seq a)
go forall a. Seq a
Empty ElemCount
0
 where
  go :: Seq a -> ElemCount -> Get (Seq a)
go !Seq a
acc !ElemCount
i =
    if ElemCount
i forall a. Eq a => a -> a -> Bool
== ElemCount
ec
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      else do
        a
x <- Get a
g
        Seq a -> ElemCount -> Get (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
x) (ElemCount
i forall a. Num a => a -> a -> a
+ ElemCount
1)

-- | Get Seq of statically-sized elements
getStaticSeq :: StaticByteSized a => ElemCount -> Get a -> Get (Seq a)
getStaticSeq :: forall a. StaticByteSized a => ElemCount -> Get a -> Get (Seq a)
getStaticSeq ElemCount
n Get a
g = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\Seq a -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. GetStaticSeqF a -> GetF a
GetFStaticSeq (forall z a.
StaticByteSized z =>
ElemCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a
GetStaticSeqF ElemCount
n Get a
g Seq a -> r
x))))

-- | Get PrimArray of statically-sized elements
getStaticArray :: LiftedPrim a => ElemCount -> Get (LiftedPrimArray a)
getStaticArray :: forall a. LiftedPrim a => ElemCount -> Get (LiftedPrimArray a)
getStaticArray ElemCount
n = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\LiftedPrimArray a -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. GetStaticArrayF a -> GetF a
GetFStaticArray (forall z a.
LiftedPrim z =>
ElemCount
-> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a
GetStaticArrayF ElemCount
n (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) LiftedPrimArray a -> r
x))))

getByteArray :: ByteCount -> Get ByteArray
getByteArray :: ByteCount -> Get ByteArray
getByteArray ByteCount
bc = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\ByteArray -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. ByteCount -> (ByteArray -> a) -> GetF a
GetFByteArray ByteCount
bc ByteArray -> r
x)))

getLiftedPrimArray :: LiftedPrim a => Proxy a -> ElemCount -> Get (LiftedPrimArray a)
getLiftedPrimArray :: forall a.
LiftedPrim a =>
Proxy a -> ElemCount -> Get (LiftedPrimArray a)
getLiftedPrimArray Proxy a
prox ElemCount
ec =
  let bc :: ByteCount
bc = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy a
prox forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
ec
  in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ByteArray -> LiftedPrimArray a
LiftedPrimArray (ByteCount -> Get ByteArray
getByteArray ByteCount
bc)

getLookAhead :: Get a -> Get a
getLookAhead :: forall a. Get a -> Get a
getLookAhead Get a
g = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\a -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. GetLookAheadF a -> GetF a
GetFLookAhead (forall z a. Get z -> (z -> a) -> GetLookAheadF a
GetLookAheadF Get a
g a -> r
x))))

getRemainingSize :: Get ByteCount
getRemainingSize :: Get ByteCount
getRemainingSize = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\ByteCount -> r
x GetF r -> r
y -> GetF r -> r
y (forall a. (ByteCount -> a) -> GetF a
GetFRemainingSize ByteCount -> r
x)))

getRemainingString :: Get ShortByteString
getRemainingString :: Get ShortByteString
getRemainingString = Get ByteCount
getRemainingSize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteCount -> Get ShortByteString
getByteString

getRemainingSeq :: Get a -> Get (Seq a)
getRemainingSeq :: forall a. Get a -> Get (Seq a)
getRemainingSeq Get a
g = Seq a -> Get (Seq a)
go forall a. Seq a
Empty
 where
  go :: Seq a -> Get (Seq a)
go !Seq a
acc = do
    ByteCount
bc <- Get ByteCount
getRemainingSize
    if ByteCount
bc forall a. Eq a => a -> a -> Bool
== ByteCount
0
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      else do
        a
x <- Get a
g
        Seq a -> Get (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
x)

getRemainingStaticSeq :: StaticByteSized a => Get a -> Get (Seq a)
getRemainingStaticSeq :: forall a. StaticByteSized a => Get a -> Get (Seq a)
getRemainingStaticSeq Get a
g = do
  let ebc :: ByteCount
ebc = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF Get a
g)
  ByteCount
bc <- Get ByteCount
getRemainingSize
  let left :: ByteCount
left = forall a. Integral a => a -> a -> a
rem ByteCount
bc ByteCount
ebc
  if ByteCount
left forall a. Eq a => a -> a -> Bool
== ByteCount
0
    then forall a. StaticByteSized a => ElemCount -> Get a -> Get (Seq a)
getStaticSeq (coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
div ByteCount
bc ByteCount
ebc)) Get a
g
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Leftover bytes for remaining static seq (have " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
left) forall a. [a] -> [a] -> [a]
++ String
", need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ebc) forall a. [a] -> [a] -> [a]
++ String
")")

getRemainingStaticArray :: LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)
getRemainingStaticArray :: forall a. LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)
getRemainingStaticArray Proxy a
prox = do
  let ebc :: ByteCount
ebc = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy a
prox
  ByteCount
bc <- Get ByteCount
getRemainingSize
  let left :: ByteCount
left = forall a. Integral a => a -> a -> a
rem ByteCount
bc ByteCount
ebc
  if ByteCount
left forall a. Eq a => a -> a -> Bool
== ByteCount
0
    then forall a. LiftedPrim a => ElemCount -> Get (LiftedPrimArray a)
getStaticArray (coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
div ByteCount
bc ByteCount
ebc))
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Leftover bytes for remaining static array (have " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
left) forall a. [a] -> [a] -> [a]
++ String
", need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ebc) forall a. [a] -> [a] -> [a]
++ String
")")

getRemainingByteArray :: Get ByteArray
getRemainingByteArray :: Get ByteArray
getRemainingByteArray = Get ByteCount
getRemainingSize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteCount -> Get ByteArray
getByteArray

getRemainingLiftedPrimArray :: LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)
getRemainingLiftedPrimArray :: forall a. LiftedPrim a => Proxy a -> Get (LiftedPrimArray a)
getRemainingLiftedPrimArray Proxy a
prox = do
  let ebc :: ByteCount
ebc = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy a
prox
  ByteCount
bc <- Get ByteCount
getRemainingSize
  let left :: ByteCount
left = forall a. Integral a => a -> a -> a
rem ByteCount
bc ByteCount
ebc
  if ByteCount
left forall a. Eq a => a -> a -> Bool
== ByteCount
0
    then do
      let ec :: ElemCount
ec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
div ByteCount
bc ByteCount
ebc)
      forall a.
LiftedPrim a =>
Proxy a -> ElemCount -> Get (LiftedPrimArray a)
getLiftedPrimArray Proxy a
prox ElemCount
ec
    else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Leftover bytes for remaining lifted prim array (have " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
left) forall a. [a] -> [a] -> [a]
++ String
", need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ebc) forall a. [a] -> [a] -> [a]
++ String
")")

getExpect :: (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect :: forall a. (Eq a, Show a) => String -> Get a -> a -> Get ()
getExpect String
typ Get a
getter a
expec = do
  a
actual <- Get a
getter
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (a
expec forall a. Eq a => a -> a -> Bool
== a
actual)
    (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected " forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
typ forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
expec forall a. [a] -> [a] -> [a]
++ String
" but found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
actual))

getUnfold :: b -> (b -> Get (Either b a)) -> Get a
getUnfold :: forall b a. b -> (b -> Get (Either b a)) -> Get a
getUnfold b
b0 b -> Get (Either b a)
f = b -> Get a
go b
b0
 where
  go :: b -> Get a
go !b
b = do
    Either b a
eba <- b -> Get (Either b a)
f b
b
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Get a
go forall (f :: * -> *) a. Applicative f => a -> f a
pure Either b a
eba

putWord8 :: Word8 -> Put
putWord8 :: Word8 -> Put
putWord8 Word8
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word8 -> a -> PutF a
PutFWord8 Word8
d (() -> r
x ()))))

putInt8 :: Int8 -> Put
putInt8 :: Int8 -> Put
putInt8 Int8
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int8 -> a -> PutF a
PutFInt8 Int8
d (() -> r
x ()))))

putWord16LE :: Word16LE -> Put
putWord16LE :: Word16LE -> Put
putWord16LE Word16LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word16LE -> a -> PutF a
PutFWord16LE Word16LE
d (() -> r
x ()))))

putInt16LE :: Int16LE -> Put
putInt16LE :: Int16LE -> Put
putInt16LE Int16LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int16LE -> a -> PutF a
PutFInt16LE Int16LE
d (() -> r
x ()))))

putWord24LE :: Word24LE -> Put
putWord24LE :: Word24LE -> Put
putWord24LE Word24LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word24LE -> a -> PutF a
PutFWord24LE Word24LE
d (() -> r
x ()))))

putInt24LE :: Int24LE -> Put
putInt24LE :: Int24LE -> Put
putInt24LE Int24LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int24LE -> a -> PutF a
PutFInt24LE Int24LE
d (() -> r
x ()))))

putWord32LE :: Word32LE -> Put
putWord32LE :: Word32LE -> Put
putWord32LE Word32LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word32LE -> a -> PutF a
PutFWord32LE Word32LE
d (() -> r
x ()))))

putInt32LE :: Int32LE -> Put
putInt32LE :: Int32LE -> Put
putInt32LE Int32LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int32LE -> a -> PutF a
PutFInt32LE Int32LE
d (() -> r
x ()))))

putWord64LE :: Word64LE -> Put
putWord64LE :: Word64LE -> Put
putWord64LE Word64LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word64LE -> a -> PutF a
PutFWord64LE Word64LE
d (() -> r
x ()))))

putInt64LE :: Int64LE -> Put
putInt64LE :: Int64LE -> Put
putInt64LE Int64LE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int64LE -> a -> PutF a
PutFInt64LE Int64LE
d (() -> r
x ()))))

putFloatLE :: FloatLE -> Put
putFloatLE :: FloatLE -> Put
putFloatLE FloatLE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. FloatLE -> a -> PutF a
PutFFloatLE FloatLE
d (() -> r
x ()))))

putDoubleLE :: DoubleLE -> Put
putDoubleLE :: DoubleLE -> Put
putDoubleLE DoubleLE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. DoubleLE -> a -> PutF a
PutFDoubleLE DoubleLE
d (() -> r
x ()))))

putWord16BE :: Word16BE -> Put
putWord16BE :: Word16BE -> Put
putWord16BE Word16BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word16BE -> a -> PutF a
PutFWord16BE Word16BE
d (() -> r
x ()))))

putInt16BE :: Int16BE -> Put
putInt16BE :: Int16BE -> Put
putInt16BE Int16BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int16BE -> a -> PutF a
PutFInt16BE Int16BE
d (() -> r
x ()))))

putWord24BE :: Word24BE -> Put
putWord24BE :: Word24BE -> Put
putWord24BE Word24BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word24BE -> a -> PutF a
PutFWord24BE Word24BE
d (() -> r
x ()))))

putInt24BE :: Int24BE -> Put
putInt24BE :: Int24BE -> Put
putInt24BE Int24BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int24BE -> a -> PutF a
PutFInt24BE Int24BE
d (() -> r
x ()))))

putWord32BE :: Word32BE -> Put
putWord32BE :: Word32BE -> Put
putWord32BE Word32BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word32BE -> a -> PutF a
PutFWord32BE Word32BE
d (() -> r
x ()))))

putInt32BE :: Int32BE -> Put
putInt32BE :: Int32BE -> Put
putInt32BE Int32BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int32BE -> a -> PutF a
PutFInt32BE Int32BE
d (() -> r
x ()))))

putWord64BE :: Word64BE -> Put
putWord64BE :: Word64BE -> Put
putWord64BE Word64BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Word64BE -> a -> PutF a
PutFWord64BE Word64BE
d (() -> r
x ()))))

putInt64BE :: Int64BE -> Put
putInt64BE :: Int64BE -> Put
putInt64BE Int64BE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. Int64BE -> a -> PutF a
PutFInt64BE Int64BE
d (() -> r
x ()))))

putFloatBE :: FloatBE -> Put
putFloatBE :: FloatBE -> Put
putFloatBE FloatBE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. FloatBE -> a -> PutF a
PutFFloatBE FloatBE
d (() -> r
x ()))))

putDoubleBE :: DoubleBE -> Put
putDoubleBE :: DoubleBE -> Put
putDoubleBE DoubleBE
d = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. DoubleBE -> a -> PutF a
PutFDoubleBE DoubleBE
d (() -> r
x ()))))

putByteString :: ShortByteString -> Put
putByteString :: ShortByteString -> Put
putByteString ShortByteString
sbs =
  let bc :: ByteCount
bc = coerce :: forall a b. Coercible a b => a -> b
coerce (ShortByteString -> Int
BSS.length ShortByteString
sbs)
  in  forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. ByteCount -> ShortByteString -> a -> PutF a
PutFShortByteString ByteCount
bc ShortByteString
sbs (() -> r
x ()))))

putFixedString :: Word8 -> ByteCount -> ShortByteString -> Put
putFixedString :: Word8 -> ByteCount -> ShortByteString -> Put
putFixedString Word8
pad ByteCount
bc ShortByteString
sbs = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteCount
bc forall a. Eq a => a -> a -> Bool
== ByteCount
0) forall a b. (a -> b) -> a -> b
$ do
    let len :: Int
len = coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
bc
        lenSbs :: Int
lenSbs = ShortByteString -> Int
BSS.length ShortByteString
sbs
        mostLen :: Int
mostLen = forall a. Ord a => a -> a -> a
min Int
len Int
lenSbs
        mostBc :: ByteCount
mostBc = coerce :: forall a b. Coercible a b => a -> b
coerce Int
mostLen
    forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. ByteCount -> ShortByteString -> a -> PutF a
PutFShortByteString ByteCount
mostBc ShortByteString
sbs (() -> r
x ()))))
    let diff :: Int
diff = Int
len forall a. Num a => a -> a -> a
- Int
lenSbs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
diff forall a. Ord a => a -> a -> Bool
<= Int
0) (forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
diff (Word8 -> Put
putWord8 Word8
pad))

-- | Put List of dynamically-sized elements
putList :: (a -> Put) -> [a] -> Put
putList :: forall a. (a -> Put) -> [a] -> Put
putList = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_

-- | Put Seq of dynamically-sized elements
putSeq :: (a -> Put) -> Seq a -> Put
putSeq :: forall a. (a -> Put) -> Seq a -> Put
putSeq = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_

-- | Put Seq of statically-sized elements
putStaticSeq :: StaticByteSized a => (a -> Put) -> Seq a -> Put
putStaticSeq :: forall a. StaticByteSized a => (a -> Put) -> Seq a -> Put
putStaticSeq a -> Put
p Seq a
s =
  let n :: ElemCount
n = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Seq a -> Int
Seq.length Seq a
s)
  in  forall a.
StaticByteSized a =>
ElemCount -> Maybe a -> (a -> Put) -> Seq a -> Put
unsafePutStaticSeqN ElemCount
n forall a. Maybe a
Nothing a -> Put
p Seq a
s

unsafePutStaticSeqN :: StaticByteSized a => ElemCount -> Maybe a -> (a -> Put) -> Seq a -> Put
unsafePutStaticSeqN :: forall a.
StaticByteSized a =>
ElemCount -> Maybe a -> (a -> Put) -> Seq a -> Put
unsafePutStaticSeqN ElemCount
n Maybe a
mz a -> Put
p Seq a
s = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. PutStaticSeqF a -> PutF a
PutFStaticSeq (forall z a.
StaticByteSized z =>
ElemCount -> Maybe z -> (z -> Put) -> Seq z -> a -> PutStaticSeqF a
PutStaticSeqF ElemCount
n Maybe a
mz a -> Put
p Seq a
s (() -> r
x ())))))

-- | Put Array of statically-sized elements
putStaticArray :: LiftedPrim a => LiftedPrimArray a -> Put
putStaticArray :: forall a. LiftedPrim a => LiftedPrimArray a -> Put
putStaticArray LiftedPrimArray a
a =
  let ec :: ElemCount
ec = forall a. LiftedPrim a => LiftedPrimArray a -> ElemCount
lengthLiftedPrimArray LiftedPrimArray a
a
  in  forall a.
LiftedPrim a =>
ElemCount -> Maybe a -> LiftedPrimArray a -> Put
unsafePutStaticArrayN ElemCount
ec forall a. Maybe a
Nothing LiftedPrimArray a
a

unsafePutStaticArrayN :: LiftedPrim a => ElemCount -> Maybe a -> LiftedPrimArray a -> Put
unsafePutStaticArrayN :: forall a.
LiftedPrim a =>
ElemCount -> Maybe a -> LiftedPrimArray a -> Put
unsafePutStaticArrayN ElemCount
n Maybe a
mz LiftedPrimArray a
a = forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. PutStaticArrayF a -> PutF a
PutFStaticArray (forall z a.
LiftedPrim z =>
ElemCount -> Maybe z -> LiftedPrimArray z -> a -> PutStaticArrayF a
PutStaticArrayF ElemCount
n Maybe a
mz LiftedPrimArray a
a (() -> r
x ())))))

putByteArray :: ByteArray -> Put
putByteArray :: ByteArray -> Put
putByteArray ByteArray
arr =
  let bc :: ByteCount
bc = coerce :: forall a b. Coercible a b => a -> b
coerce (ByteArray -> Int
sizeofByteArray ByteArray
arr)
  in  forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. ByteCount -> ByteArray -> a -> PutF a
PutFByteArray ByteCount
bc ByteArray
arr (() -> r
x ()))))

putLiftedPrimArray :: LiftedPrimArray a -> Put
putLiftedPrimArray :: forall a. LiftedPrimArray a -> Put
putLiftedPrimArray = ByteArray -> Put
putByteArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LiftedPrimArray a -> ByteArray
unLiftedPrimArray

putStaticHint :: StaticByteSized a => (a -> Put) -> a -> Put
putStaticHint :: forall a. StaticByteSized a => (a -> Put) -> a -> Put
putStaticHint a -> Put
p a
a =
  let bc :: ByteCount
bc = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall a x. (a -> x) -> Proxy a
proxyForFun a -> Put
p)
  in  forall a. F PutF a -> PutM a
PutM (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\() -> r
x PutF r -> r
y -> PutF r -> r
y (forall a. PutStaticHintF a -> PutF a
PutFStaticHint (forall a. ByteCount -> Put -> a -> PutStaticHintF a
PutStaticHintF ByteCount
bc (a -> Put
p a
a) (() -> r
x ())))))