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
  , getText
  , 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
  , putText
  , 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.Text (Text)
import qualified Data.Text.Encoding as TE
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)))

getText :: ByteCount -> Get Text
getText :: ByteCount -> Get Text
getText = ByteCount -> Get ShortByteString
getByteString forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Invalid UTF-8: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
BSS.fromShort

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 ()))))

putText :: Text -> Put
putText :: Text -> Put
putText = ShortByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
BSS.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

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 ())))))