{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

module Dahdit.Run
  ( GetError (..)
  , prettyGetError
  , runGetInternal
  , GetIncEnv (..)
  , newGetIncEnv
  , GetIncChunk (..)
  , GetIncRequest (..)
  , GetIncSuspend (..)
  , GetIncCb
  , runGetIncInternal
  , runCount
  , runPutInternal
  )
where

import Control.Applicative (Alternative (..))
import Control.Exception (Exception (..))
import Control.Monad (replicateM_, unless)
import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
import Control.Monad.Free.Church (F (..), iterM)
import Control.Monad.Free.Class (MonadFree (..))
import Control.Monad.Primitive (MonadPrim, PrimMonad (..))
import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
import Control.Monad.State.Strict (MonadState, State, runState)
import qualified Control.Monad.State.Strict as State
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Free.Church (FT (..), iterT)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Dahdit.Free
  ( Get (..)
  , GetF (..)
  , GetLookAheadF (..)
  , GetScopeF (..)
  , GetStaticArrayF (..)
  , GetStaticSeqF (..)
  , Put
  , PutF (..)
  , PutM (..)
  , PutStaticArrayF (..)
  , PutStaticHintF (..)
  , PutStaticSeqF (..)
  , ScopeMode (..)
  )
import Dahdit.LiftedPrimArray (LiftedPrimArray (..), sizeofLiftedPrimArray)
import Dahdit.Mem (ReadMem (..), WriteMem (..), readSBSMem, writeSBSMem)
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)
import Dahdit.Sizes (ByteCount (..), ElemCount (..), staticByteSize)
import Data.Coerce (coerce)
import Data.Foldable (for_, toList)
import Data.Int (Int8)
import Data.Maybe (fromJust)
import Data.Primitive.MutVar (MutVar, modifyMutVar', newMutVar, readMutVar, writeMutVar)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word8)

-- Sizes:

getStaticSeqSize :: GetStaticSeqF a -> ByteCount
getStaticSeqSize :: forall a. GetStaticSeqF a -> ByteCount
getStaticSeqSize (GetStaticSeqF ElemCount
ec Get z
g Seq z -> a
_) = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF Get z
g) forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
ec

getStaticArraySize :: GetStaticArrayF a -> ByteCount
getStaticArraySize :: forall a. GetStaticArrayF a -> ByteCount
getStaticArraySize (GetStaticArrayF ElemCount
n Proxy z
prox LiftedPrimArray z -> a
_) = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy z
prox forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n

putStaticSeqSize :: PutStaticSeqF a -> ByteCount
putStaticSeqSize :: forall a. PutStaticSeqF a -> ByteCount
putStaticSeqSize (PutStaticSeqF ElemCount
n Maybe z
_ z -> Put
_ Seq z
s a
_) = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF Seq z
s) forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n

putStaticArrayElemSize :: PutStaticArrayF a -> ByteCount
putStaticArrayElemSize :: forall a. PutStaticArrayF a -> ByteCount
putStaticArrayElemSize (PutStaticArrayF ElemCount
_ Maybe z
_ LiftedPrimArray z
a a
_) = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF LiftedPrimArray z
a)

putStaticArraySize :: PutStaticArrayF a -> ByteCount
putStaticArraySize :: forall a. PutStaticArrayF a -> ByteCount
putStaticArraySize (PutStaticArrayF ElemCount
n Maybe z
_ LiftedPrimArray z
a a
_) = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF LiftedPrimArray z
a) forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n

-- Get:

data GetError
  = GetErrorLocalCap !Text !ByteCount !ByteCount
  | GetErrorScopedMismatch !ScopeMode !ByteCount !ByteCount
  | GetErrorFail !Text
  | GetErrorGlobalCap !Text !ByteCount !ByteCount
  | GetErrorRemaining !ByteCount
  deriving stock (GetError -> GetError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetError -> GetError -> Bool
$c/= :: GetError -> GetError -> Bool
== :: GetError -> GetError -> Bool
$c== :: GetError -> GetError -> Bool
Eq, Int -> GetError -> ShowS
[GetError] -> ShowS
GetError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetError] -> ShowS
$cshowList :: [GetError] -> ShowS
show :: GetError -> String
$cshow :: GetError -> String
showsPrec :: Int -> GetError -> ShowS
$cshowsPrec :: Int -> GetError -> ShowS
Show)

instance Exception GetError where
  displayException :: GetError -> String
displayException = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetError -> Text
prettyGetError

prettyGetError :: GetError -> Text
prettyGetError :: GetError -> Text
prettyGetError = \case
  GetErrorLocalCap Text
nm ByteCount
ac ByteCount
bc ->
    Text
"End of chunk parsing "
      forall a. Semigroup a => a -> a -> a
<> Text
nm
      forall a. Semigroup a => a -> a -> a
<> Text
" (have "
      forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac))
      forall a. Semigroup a => a -> a -> a
<> Text
" bytes, need "
      forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
bc))
      forall a. Semigroup a => a -> a -> a
<> Text
")"
  GetErrorScopedMismatch ScopeMode
sm ByteCount
ac ByteCount
bc ->
    let ty :: Text
ty = case ScopeMode
sm of ScopeMode
ScopeModeExact -> Text
"exact"; ScopeMode
ScopeModeWithin -> Text
"within"
    in  Text
"Did not parse "
          forall a. Semigroup a => a -> a -> a
<> Text
ty
          forall a. Semigroup a => a -> a -> a
<> Text
" scoped input (read "
          forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac))
          forall a. Semigroup a => a -> a -> a
<> Text
" bytes, expected "
          forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
bc))
          forall a. Semigroup a => a -> a -> a
<> Text
")"
  GetErrorFail Text
msg -> Text
"User error: " forall a. Semigroup a => a -> a -> a
<> Text
msg
  GetErrorGlobalCap Text
nm ByteCount
ac ByteCount
bc ->
    Text
"Hit limit parsing "
      forall a. Semigroup a => a -> a -> a
<> Text
nm
      forall a. Semigroup a => a -> a -> a
<> Text
" (allowed "
      forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac))
      forall a. Semigroup a => a -> a -> a
<> Text
" bytes, need "
      forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
bc))
      forall a. Semigroup a => a -> a -> a
<> Text
")"
  GetErrorRemaining ByteCount
ac -> Text
"Cannot read remaining length in stream context (read " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac)) forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Get from a single buffer
runGetInternal :: (ReadMem r m) => ByteCount -> Get a -> ByteCount -> r -> m (Either GetError a, ByteCount)
runGetInternal :: forall r (m :: * -> *) a.
ReadMem r m =>
ByteCount
-> Get a -> ByteCount -> r -> m (Either GetError a, ByteCount)
runGetInternal ByteCount
off Get a
act ByteCount
cap r
mem = do
  let chunk :: GetIncChunk r
chunk = forall r. ByteCount -> ByteCount -> r -> GetIncChunk r
GetIncChunk ByteCount
off ByteCount
cap r
mem
  GetIncEnv (PrimState m) r
env <- forall s (m :: * -> *) r.
MonadPrim s m =>
Maybe ByteCount -> GetIncChunk r -> m (GetIncEnv s r)
newGetIncEnv (forall a. a -> Maybe a
Just (ByteCount
cap forall a. Num a => a -> a -> a
- ByteCount
off)) GetIncChunk r
chunk
  (Either GetError a
ea, ByteCount
_, ByteCount
off') <- forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a
-> GetIncEnv s r
-> GetIncCbChunk r m
-> m (Either GetError a, ByteCount, ByteCount)
runGetIncInternal Get a
act GetIncEnv (PrimState m) r
env (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GetError a
ea, ByteCount
off')

-- Get inc

data GetIncChunk r = GetIncChunk
  { forall r. GetIncChunk r -> ByteCount
gicLocalOff :: !ByteCount
  -- ^ Offset from start of local buffer to data
  , forall r. GetIncChunk r -> ByteCount
gicLocalCap :: !ByteCount
  -- ^ Capacity of local buffer
  , forall r. GetIncChunk r -> r
gicArray :: !r
  -- ^ Source buffer
  }

data GetIncEnv s r = GetIncEnv
  { forall s r. GetIncEnv s r -> MutVar s ByteCount
gieGlobalAbs :: !(MutVar s ByteCount)
  -- ^ Offset from start of parsing (0) to current position
  , forall s r. GetIncEnv s r -> MutVar s ByteCount
gieGlobalRel :: !(MutVar s ByteCount)
  -- ^ Offset from start of parsing (0) to start of buffer
  -- It will always be the case that gloRel <= gloAbs
  , forall s r. GetIncEnv s r -> MutVar s (Seq ByteCount)
gieGlobalCap :: !(MutVar s (Seq ByteCount))
  -- ^ Stack of maximum capcacity (across all chunks)
  -- Top of stack is end of sequence.
  -- This will be narrowed to check scoped length.
  , forall s r. GetIncEnv s r -> MutVar s (GetIncChunk r)
gieCurChunk :: !(MutVar s (GetIncChunk r))
  -- ^ Current chunk
  , forall s r. GetIncEnv s r -> MutVar s (Seq ByteCount)
gieLookAhead :: !(MutVar s (Seq ByteCount))
  -- ^ Stack of look ahead points (in absolute position)
  -- Top of stack is end of sequence.
  }

newGetIncEnv :: (MonadPrim s m) => Maybe ByteCount -> GetIncChunk r -> m (GetIncEnv s r)
newGetIncEnv :: forall s (m :: * -> *) r.
MonadPrim s m =>
Maybe ByteCount -> GetIncChunk r -> m (GetIncEnv s r)
newGetIncEnv Maybe ByteCount
mayCap GetIncChunk r
chunk = do
  MutVar s ByteCount
gloAbsVar <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar ByteCount
0
  MutVar s ByteCount
gloRelVar <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar ByteCount
0
  MutVar s (Seq ByteCount)
gloCapVar <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Seq a
Empty forall a. a -> Seq a
Seq.singleton Maybe ByteCount
mayCap)
  MutVar s (GetIncChunk r)
curChunkVar <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar GetIncChunk r
chunk
  MutVar s (Seq ByteCount)
lookAheadVar <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar forall a. Seq a
Empty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s r.
MutVar s ByteCount
-> MutVar s ByteCount
-> MutVar s (Seq ByteCount)
-> MutVar s (GetIncChunk r)
-> MutVar s (Seq ByteCount)
-> GetIncEnv s r
GetIncEnv MutVar s ByteCount
gloAbsVar MutVar s ByteCount
gloRelVar MutVar s (Seq ByteCount)
gloCapVar MutVar s (GetIncChunk r)
curChunkVar MutVar s (Seq ByteCount)
lookAheadVar)

-- | A request for more data. Includes absolute position, offset in the current buffer, and required length.
data GetIncRequest = GetIncRequest
  { GetIncRequest -> ByteCount
girAbsPos :: !ByteCount
  , GetIncRequest -> ByteCount
girBaseOff :: !ByteCount
  , GetIncRequest -> ByteCount
girNeedLength :: !ByteCount
  }
  deriving stock (GetIncRequest -> GetIncRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIncRequest -> GetIncRequest -> Bool
$c/= :: GetIncRequest -> GetIncRequest -> Bool
== :: GetIncRequest -> GetIncRequest -> Bool
$c== :: GetIncRequest -> GetIncRequest -> Bool
Eq, Eq GetIncRequest
GetIncRequest -> GetIncRequest -> Bool
GetIncRequest -> GetIncRequest -> Ordering
GetIncRequest -> GetIncRequest -> GetIncRequest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GetIncRequest -> GetIncRequest -> GetIncRequest
$cmin :: GetIncRequest -> GetIncRequest -> GetIncRequest
max :: GetIncRequest -> GetIncRequest -> GetIncRequest
$cmax :: GetIncRequest -> GetIncRequest -> GetIncRequest
>= :: GetIncRequest -> GetIncRequest -> Bool
$c>= :: GetIncRequest -> GetIncRequest -> Bool
> :: GetIncRequest -> GetIncRequest -> Bool
$c> :: GetIncRequest -> GetIncRequest -> Bool
<= :: GetIncRequest -> GetIncRequest -> Bool
$c<= :: GetIncRequest -> GetIncRequest -> Bool
< :: GetIncRequest -> GetIncRequest -> Bool
$c< :: GetIncRequest -> GetIncRequest -> Bool
compare :: GetIncRequest -> GetIncRequest -> Ordering
$ccompare :: GetIncRequest -> GetIncRequest -> Ordering
Ord, Int -> GetIncRequest -> ShowS
[GetIncRequest] -> ShowS
GetIncRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIncRequest] -> ShowS
$cshowList :: [GetIncRequest] -> ShowS
show :: GetIncRequest -> String
$cshow :: GetIncRequest -> String
showsPrec :: Int -> GetIncRequest -> ShowS
$cshowsPrec :: Int -> GetIncRequest -> ShowS
Show)

-- | See 'GetIncCb' - this is the functor-ized version so we can suspend execution.
data GetIncSuspend z x = GetIncSuspend !GetIncRequest !(Maybe z -> x)
  deriving stock (forall a b. a -> GetIncSuspend z b -> GetIncSuspend z a
forall a b. (a -> b) -> GetIncSuspend z a -> GetIncSuspend z b
forall z a b. a -> GetIncSuspend z b -> GetIncSuspend z a
forall z a b. (a -> b) -> GetIncSuspend z a -> GetIncSuspend z b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GetIncSuspend z b -> GetIncSuspend z a
$c<$ :: forall z a b. a -> GetIncSuspend z b -> GetIncSuspend z a
fmap :: forall a b. (a -> b) -> GetIncSuspend z a -> GetIncSuspend z b
$cfmap :: forall z a b. (a -> b) -> GetIncSuspend z a -> GetIncSuspend z b
Functor)

type GetIncSuspendChunk r = GetIncSuspend (GetIncChunk r)

-- Should not implement 'MonadReader' so we can prevent scoped operations like 'local'
newtype GetIncM s r m a = GetIncM {forall s r (m :: * -> *) a.
GetIncM s r m a
-> ReaderT
     (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
unGetIncM :: ReaderT (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a}
  deriving newtype
    ( forall a b. a -> GetIncM s r m b -> GetIncM s r m a
forall a b. (a -> b) -> GetIncM s r m a -> GetIncM s r m b
forall s r (m :: * -> *) a b.
a -> GetIncM s r m b -> GetIncM s r m a
forall s r (m :: * -> *) a b.
(a -> b) -> GetIncM s r m a -> GetIncM s r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GetIncM s r m b -> GetIncM s r m a
$c<$ :: forall s r (m :: * -> *) a b.
a -> GetIncM s r m b -> GetIncM s r m a
fmap :: forall a b. (a -> b) -> GetIncM s r m a -> GetIncM s r m b
$cfmap :: forall s r (m :: * -> *) a b.
(a -> b) -> GetIncM s r m a -> GetIncM s r m b
Functor
    , forall a. a -> GetIncM s r m a
forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m a
forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
forall a b.
GetIncM s r m (a -> b) -> GetIncM s r m a -> GetIncM s r m b
forall a b c.
(a -> b -> c)
-> GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m c
forall s r (m :: * -> *). Functor (GetIncM s r m)
forall s r (m :: * -> *) a. a -> GetIncM s r m a
forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m a
forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
forall s r (m :: * -> *) a b.
GetIncM s r m (a -> b) -> GetIncM s r m a -> GetIncM s r m b
forall s r (m :: * -> *) a b c.
(a -> b -> c)
-> GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m a
$c<* :: forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m a
*> :: forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
$c*> :: forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
liftA2 :: forall a b c.
(a -> b -> c)
-> GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m c
$cliftA2 :: forall s r (m :: * -> *) a b c.
(a -> b -> c)
-> GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m c
<*> :: forall a b.
GetIncM s r m (a -> b) -> GetIncM s r m a -> GetIncM s r m b
$c<*> :: forall s r (m :: * -> *) a b.
GetIncM s r m (a -> b) -> GetIncM s r m a -> GetIncM s r m b
pure :: forall a. a -> GetIncM s r m a
$cpure :: forall s r (m :: * -> *) a. a -> GetIncM s r m a
Applicative
    , forall a. a -> GetIncM s r m a
forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
forall a b.
GetIncM s r m a -> (a -> GetIncM s r m b) -> GetIncM s r m b
forall s r (m :: * -> *). Applicative (GetIncM s r m)
forall s r (m :: * -> *) a. a -> GetIncM s r m a
forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
forall s r (m :: * -> *) a b.
GetIncM s r m a -> (a -> GetIncM s r m b) -> GetIncM s r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> GetIncM s r m a
$creturn :: forall s r (m :: * -> *) a. a -> GetIncM s r m a
>> :: forall a b. GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
$c>> :: forall s r (m :: * -> *) a b.
GetIncM s r m a -> GetIncM s r m b -> GetIncM s r m b
>>= :: forall a b.
GetIncM s r m a -> (a -> GetIncM s r m b) -> GetIncM s r m b
$c>>= :: forall s r (m :: * -> *) a b.
GetIncM s r m a -> (a -> GetIncM s r m b) -> GetIncM s r m b
Monad
    , MonadError GetError
    , MonadFree (GetIncSuspendChunk r)
    )

instance MonadTrans (GetIncM s r) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> GetIncM s r m a
lift = forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Return new chunk containing enough data (or nothing).
type GetIncCb z m = GetIncRequest -> m (Maybe z)

type GetIncCbChunk r m = GetIncCb (GetIncChunk r) m

pushMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> a -> m ()
pushMutVar :: forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> a -> m ()
pushMutVar MutVar s (Seq a)
v a
a = forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar' MutVar s (Seq a)
v (forall a. Seq a -> a -> Seq a
:|> a
a)

popMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> m ()
popMutVar :: forall s (m :: * -> *) a. MonadPrim s m => MutVar s (Seq a) -> m ()
popMutVar MutVar s (Seq a)
v = forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar' MutVar s (Seq a)
v (\case Seq a
Empty -> forall a. Seq a
Empty; Seq a
as :|> a
_ -> Seq a
as)

peekMutVar :: (MonadPrim s m) => MutVar s (Seq a) -> m (Maybe a)
peekMutVar :: forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> m (Maybe a)
peekMutVar = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case Seq a
Empty -> forall a. Maybe a
Nothing; Seq a
_ :|> a
a -> forall a. a -> Maybe a
Just a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar

runGetIncM :: (MonadPrim s m) => GetIncM s r m a -> GetIncEnv s r -> GetIncCbChunk r m -> m (Either GetError a)
runGetIncM :: forall s (m :: * -> *) r a.
MonadPrim s m =>
GetIncM s r m a
-> GetIncEnv s r -> GetIncCbChunk r m -> m (Either GetError a)
runGetIncM GetIncM s r m a
m GetIncEnv s r
env GetIncCbChunk r m
cb =
  forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
   (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT
    (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall s r (m :: * -> *) a.
GetIncM s r m a
-> ReaderT
     (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
unGetIncM GetIncM s r m a
m) GetIncEnv s r
env))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (\x -> m (Either GetError a)
k2 (GetIncSuspend GetIncRequest
req Maybe (GetIncChunk r) -> x
k1) -> GetIncCbChunk r m
cb GetIncRequest
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m (Either GetError a)
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (GetIncChunk r) -> x
k1)

guardReadBytes :: (MonadPrim s m) => Text -> ByteCount -> GetIncM s r m (ByteCount, GetIncChunk r, ByteCount)
guardReadBytes :: forall s (m :: * -> *) r.
MonadPrim s m =>
Text
-> ByteCount -> GetIncM s r m (ByteCount, GetIncChunk r, ByteCount)
guardReadBytes Text
nm ByteCount
bc = do
  GetIncEnv MutVar s ByteCount
gloAbsRef MutVar s ByteCount
gloRelRef MutVar s (Seq ByteCount)
capStackRef MutVar s (GetIncChunk r)
chunkRef MutVar s (Seq ByteCount)
lookStackRef <- forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM forall r (m :: * -> *). MonadReader r m => m r
ask
  -- First check if we're in cap
  ByteCount
gloAbsStart <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloAbsRef)
  let gloAbsEnd :: ByteCount
gloAbsEnd = ByteCount
gloAbsStart forall a. Num a => a -> a -> a
+ ByteCount
bc
  Maybe ByteCount
mayCap <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> m (Maybe a)
peekMutVar MutVar s (Seq ByteCount)
capStackRef)
  case Maybe ByteCount
mayCap of
    Just ByteCount
cap | ByteCount
gloAbsEnd forall a. Ord a => a -> a -> Bool
> ByteCount
cap -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ByteCount -> ByteCount -> GetError
GetErrorGlobalCap Text
nm ByteCount
cap ByteCount
gloAbsEnd)
    Maybe ByteCount
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  -- Now check that we have enough in the local buf
  ByteCount
gloRel <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloRelRef)
  oldChunk :: GetIncChunk r
oldChunk@(GetIncChunk ByteCount
oldOff ByteCount
oldCap r
_) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (GetIncChunk r)
chunkRef)
  let oldLocOffStart :: ByteCount
oldLocOffStart = ByteCount
gloAbsStart forall a. Num a => a -> a -> a
- ByteCount
gloRel forall a. Num a => a -> a -> a
+ ByteCount
oldOff
      oldLocOffEnd :: ByteCount
oldLocOffEnd = ByteCount
oldLocOffStart forall a. Num a => a -> a -> a
+ ByteCount
bc
  (GetIncChunk r
newChunk, ByteCount
newLocOffStart) <-
    if ByteCount
oldLocOffEnd forall a. Ord a => a -> a -> Bool
<= ByteCount
oldCap
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetIncChunk r
oldChunk, ByteCount
oldLocOffStart)
      else do
        Seq ByteCount
lookStack <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Seq ByteCount)
lookStackRef)
        let gloBaseStart :: ByteCount
gloBaseStart = case Seq ByteCount
lookStack of Seq ByteCount
Empty -> ByteCount
gloAbsStart; ByteCount
x :<| Seq ByteCount
_ -> ByteCount
x
            baseOffStart :: ByteCount
baseOffStart = ByteCount
gloBaseStart forall a. Num a => a -> a -> a
- ByteCount
gloRel forall a. Num a => a -> a -> a
+ ByteCount
oldOff
            baseOffEnd :: ByteCount
baseOffEnd = ByteCount
gloAbsStart forall a. Num a => a -> a -> a
- ByteCount
gloRel forall a. Num a => a -> a -> a
+ ByteCount
oldOff forall a. Num a => a -> a -> a
+ ByteCount
bc
        let needLength :: ByteCount
needLength = ByteCount
baseOffEnd forall a. Num a => a -> a -> a
- ByteCount
baseOffStart
            req :: GetIncRequest
req = ByteCount -> ByteCount -> ByteCount -> GetIncRequest
GetIncRequest ByteCount
gloAbsStart ByteCount
baseOffStart ByteCount
needLength
        forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall z x. GetIncRequest -> (Maybe z -> x) -> GetIncSuspend z x
GetIncSuspend GetIncRequest
req forall a b. (a -> b) -> a -> b
$ \case
          Maybe (GetIncChunk r)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ByteCount -> ByteCount -> GetError
GetErrorLocalCap Text
nm ByteCount
oldCap ByteCount
baseOffEnd)
          Just newChunk :: GetIncChunk r
newChunk@(GetIncChunk ByteCount
newOff ByteCount
newCap r
_) -> do
            let newEnd :: ByteCount
newEnd = ByteCount
newOff forall a. Num a => a -> a -> a
+ ByteCount
needLength
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteCount
newEnd forall a. Ord a => a -> a -> Bool
<= ByteCount
newCap) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ByteCount -> ByteCount -> GetError
GetErrorLocalCap Text
nm ByteCount
newCap ByteCount
newOff))
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s (GetIncChunk r)
chunkRef GetIncChunk r
newChunk)
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s ByteCount
gloRelRef ByteCount
gloBaseStart)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetIncChunk r
newChunk, forall r. GetIncChunk r -> ByteCount
gicLocalOff GetIncChunk r
newChunk)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteCount
gloAbsEnd, GetIncChunk r
newChunk, ByteCount
newLocOffStart)

-- Memory read function takes local start offset
readBytes :: (MonadPrim s m) => Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes :: forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
nm ByteCount
bc r -> ByteCount -> m a
f = do
  (ByteCount
gloAbsEnd, GetIncChunk r
newChunk, ByteCount
newLocOffStart) <- forall s (m :: * -> *) r.
MonadPrim s m =>
Text
-> ByteCount -> GetIncM s r m (ByteCount, GetIncChunk r, ByteCount)
guardReadBytes Text
nm ByteCount
bc
  let mem :: r
mem = forall r. GetIncChunk r -> r
gicArray GetIncChunk r
newChunk
  a
a <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (r -> ByteCount -> m a
f r
mem ByteCount
newLocOffStart)
  MutVar s ByteCount
gloAbsRef <- forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall s r. GetIncEnv s r -> MutVar s ByteCount
gieGlobalAbs)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s ByteCount
gloAbsRef ByteCount
gloAbsEnd)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

readScope :: (MonadPrim s m, ReadMem r m) => GetScopeF (GetIncM s r m a) -> GetIncM s r m a
readScope :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetScopeF (GetIncM s r m a) -> GetIncM s r m a
readScope (GetScopeF ScopeMode
sm ByteCount
bc Get z
g z -> GetIncM s r m a
k) = do
  GetIncEnv MutVar s ByteCount
gloAbsRef MutVar s ByteCount
_ MutVar s (Seq ByteCount)
capStackRef MutVar s (GetIncChunk r)
_ MutVar s (Seq ByteCount)
_ <- forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM forall r (m :: * -> *). MonadReader r m => m r
ask
  ByteCount
gloAbsStart <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloAbsRef)
  let gloAbsMax :: ByteCount
gloAbsMax = ByteCount
gloAbsStart forall a. Num a => a -> a -> a
+ ByteCount
bc
  Maybe ByteCount
mayCap <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> m (Maybe a)
peekMutVar MutVar s (Seq ByteCount)
capStackRef)
  case Maybe ByteCount
mayCap of
    Just ByteCount
cap
      | ScopeMode
sm forall a. Eq a => a -> a -> Bool
== ScopeMode
ScopeModeExact Bool -> Bool -> Bool
&& ByteCount
gloAbsMax forall a. Ord a => a -> a -> Bool
> ByteCount
cap ->
          forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ByteCount -> ByteCount -> GetError
GetErrorGlobalCap Text
"scope" ByteCount
cap ByteCount
gloAbsMax)
    Maybe ByteCount
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> a -> m ()
pushMutVar MutVar s (Seq ByteCount)
capStackRef ByteCount
gloAbsMax)
  z
a <- forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a -> GetIncM s r m a
interpGetInc Get z
g
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadPrim s m => MutVar s (Seq a) -> m ()
popMutVar MutVar s (Seq ByteCount)
capStackRef)
  ByteCount
gloAbsEnd <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloAbsRef)
  let actualBc :: ByteCount
actualBc = ByteCount
gloAbsEnd forall a. Num a => a -> a -> a
- ByteCount
gloAbsStart
  if (ScopeMode
sm forall a. Eq a => a -> a -> Bool
== ScopeMode
ScopeModeExact Bool -> Bool -> Bool
&& ByteCount
actualBc forall a. Eq a => a -> a -> Bool
== ByteCount
bc) Bool -> Bool -> Bool
|| (ScopeMode
sm forall a. Eq a => a -> a -> Bool
== ScopeMode
ScopeModeWithin Bool -> Bool -> Bool
&& ByteCount
actualBc forall a. Ord a => a -> a -> Bool
<= ByteCount
bc)
    then z -> GetIncM s r m a
k z
a
    else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScopeMode -> ByteCount -> ByteCount -> GetError
GetErrorScopedMismatch ScopeMode
sm ByteCount
actualBc ByteCount
bc)

readStaticSeq :: (MonadPrim s m, ReadMem r m) => GetStaticSeqF (GetIncM s r m a) -> GetIncM s r m a
readStaticSeq :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetStaticSeqF (GetIncM s r m a) -> GetIncM s r m a
readStaticSeq gss :: GetStaticSeqF (GetIncM s r m a)
gss@(GetStaticSeqF ElemCount
ec Get z
g Seq z -> GetIncM s r m a
k) = do
  let bc :: ByteCount
bc = forall a. GetStaticSeqF a -> ByteCount
getStaticSeqSize GetStaticSeqF (GetIncM s r m a)
gss
  (ByteCount, GetIncChunk r, ByteCount)
_ <- forall s (m :: * -> *) r.
MonadPrim s m =>
Text
-> ByteCount -> GetIncM s r m (ByteCount, GetIncChunk r, ByteCount)
guardReadBytes Text
"static sequence" ByteCount
bc
  Seq z
ss <- forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
Seq.replicateA (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
ec) (forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a -> GetIncM s r m a
interpGetInc Get z
g)
  Seq z -> GetIncM s r m a
k Seq z
ss

readStaticArray :: (MonadPrim s m, ReadMem r m) => GetStaticArrayF (GetIncM s r m a) -> GetIncM s r m a
readStaticArray :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetStaticArrayF (GetIncM s r m a) -> GetIncM s r m a
readStaticArray gsa :: GetStaticArrayF (GetIncM s r m a)
gsa@(GetStaticArrayF ElemCount
_ Proxy z
_ LiftedPrimArray z -> GetIncM s r m a
k) = do
  let bc :: ByteCount
bc = forall a. GetStaticArrayF a -> ByteCount
getStaticArraySize GetStaticArrayF (GetIncM s r m a)
gsa
  ByteArray
sa <- forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"static vector" ByteCount
bc (\r
mem ByteCount
off -> forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes r
mem ByteCount
off ByteCount
bc)
  LiftedPrimArray z -> GetIncM s r m a
k (forall a. ByteArray -> LiftedPrimArray a
LiftedPrimArray ByteArray
sa)

readLookAhead :: (MonadPrim s m, ReadMem r m) => GetLookAheadF (GetIncM s r m a) -> GetIncM s r m a
readLookAhead :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetLookAheadF (GetIncM s r m a) -> GetIncM s r m a
readLookAhead (GetLookAheadF Get z
g z -> GetIncM s r m a
k) = do
  GetIncEnv MutVar s ByteCount
gloAbsRef MutVar s ByteCount
_ MutVar s (Seq ByteCount)
_ MutVar s (GetIncChunk r)
_ MutVar s (Seq ByteCount)
lookStackRef <- forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM forall r (m :: * -> *). MonadReader r m => m r
ask
  ByteCount
gloAbs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloAbsRef)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a.
MonadPrim s m =>
MutVar s (Seq a) -> a -> m ()
pushMutVar MutVar s (Seq ByteCount)
lookStackRef ByteCount
gloAbs)
  z
a <- forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a -> GetIncM s r m a
interpGetInc Get z
g
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadPrim s m => MutVar s (Seq a) -> m ()
popMutVar MutVar s (Seq ByteCount)
lookStackRef)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar s ByteCount
gloAbsRef ByteCount
gloAbs)
  z -> GetIncM s r m a
k z
a

interpGetInc :: (MonadPrim s m, ReadMem r m) => Get a -> GetIncM s r m a
interpGetInc :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a -> GetIncM s r m a
interpGetInc (Get F GetF a
g) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(f (m a) -> m a) -> F f a -> m a
iterM F GetF a
g forall a b. (a -> b) -> a -> b
$ \case
  GetFWord8 Word8 -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word8" ByteCount
1 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> GetIncM s r m a
k
  GetFInt8 Int8 -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int8" ByteCount
1 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int8 -> GetIncM s r m a
k
  GetFWord16LE Word16LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word16LE" ByteCount
2 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16LE -> GetIncM s r m a
k
  GetFInt16LE Int16LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int16LE" ByteCount
2 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16LE -> GetIncM s r m a
k
  GetFWord24LE Word24LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word24LE" ByteCount
3 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24LE -> GetIncM s r m a
k
  GetFInt24LE Int24LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int24LE" ByteCount
3 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24LE -> GetIncM s r m a
k
  GetFWord32LE Word32LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word32LE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32LE -> GetIncM s r m a
k
  GetFInt32LE Int32LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int32LE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32LE -> GetIncM s r m a
k
  GetFWord64LE Word64LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word64LE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word64LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64LE -> GetIncM s r m a
k
  GetFInt64LE Int64LE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int64LE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int64LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64LE -> GetIncM s r m a
k
  GetFFloatLE FloatLE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"FloatLE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @FloatLE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatLE -> GetIncM s r m a
k
  GetFDoubleLE DoubleLE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"DoubleLE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @DoubleLE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DoubleLE -> GetIncM s r m a
k
  GetFWord16BE Word16BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word16BE" ByteCount
2 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16BE -> GetIncM s r m a
k
  GetFInt16BE Int16BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int16BE" ByteCount
2 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16BE -> GetIncM s r m a
k
  GetFWord24BE Word24BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word24BE" ByteCount
3 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24BE -> GetIncM s r m a
k
  GetFInt24BE Int24BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int24BE" ByteCount
3 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24BE -> GetIncM s r m a
k
  GetFWord32BE Word32BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word32BE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32BE -> GetIncM s r m a
k
  GetFInt32BE Int32BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int32BE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32BE -> GetIncM s r m a
k
  GetFWord64BE Word64BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Word64BE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Word64BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64BE -> GetIncM s r m a
k
  GetFInt64BE Int64BE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"Int64BE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @Int64BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64BE -> GetIncM s r m a
k
  GetFFloatBE FloatBE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"FloatBE" ByteCount
4 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @FloatBE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatBE -> GetIncM s r m a
k
  GetFDoubleBE DoubleBE -> GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"DoubleBE" ByteCount
8 (forall r (m :: * -> *) a.
(ReadMem r m, LiftedPrim a) =>
r -> ByteCount -> m a
indexMemInBytes @_ @_ @DoubleBE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DoubleBE -> GetIncM s r m a
k
  GetFShortByteString ByteCount
bc ShortByteString -> GetIncM s r m a
k ->
    forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"ShortByteString" ByteCount
bc (\r
mem ByteCount
off -> forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ShortByteString
readSBSMem r
mem ByteCount
off ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ShortByteString -> GetIncM s r m a
k
  GetFStaticSeq GetStaticSeqF (GetIncM s r m a)
gss -> forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetStaticSeqF (GetIncM s r m a) -> GetIncM s r m a
readStaticSeq GetStaticSeqF (GetIncM s r m a)
gss
  GetFStaticArray GetStaticArrayF (GetIncM s r m a)
gsa -> forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetStaticArrayF (GetIncM s r m a) -> GetIncM s r m a
readStaticArray GetStaticArrayF (GetIncM s r m a)
gsa
  GetFByteArray ByteCount
bc ByteArray -> GetIncM s r m a
k ->
    forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"ByteArray" ByteCount
bc (\r
mem ByteCount
off -> forall r (m :: * -> *).
ReadMem r m =>
r -> ByteCount -> ByteCount -> m ByteArray
cloneArrayMemInBytes r
mem ByteCount
off ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteArray -> GetIncM s r m a
k
  GetFScope GetScopeF (GetIncM s r m a)
gs -> forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetScopeF (GetIncM s r m a) -> GetIncM s r m a
readScope GetScopeF (GetIncM s r m a)
gs
  GetFSkip ByteCount
bc GetIncM s r m a
k -> forall s (m :: * -> *) r a.
MonadPrim s m =>
Text -> ByteCount -> (r -> ByteCount -> m a) -> GetIncM s r m a
readBytes Text
"skip" ByteCount
bc (\r
_ ByteCount
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GetIncM s r m a
k
  GetFLookAhead GetLookAheadF (GetIncM s r m a)
gla -> forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
GetLookAheadF (GetIncM s r m a) -> GetIncM s r m a
readLookAhead GetLookAheadF (GetIncM s r m a)
gla
  GetFRemainingSize ByteCount -> GetIncM s r m a
k -> do
    GetIncEnv MutVar s ByteCount
gloAbsRef MutVar s ByteCount
_ MutVar s (Seq ByteCount)
capStackRef MutVar s (GetIncChunk r)
_ MutVar s (Seq ByteCount)
_ <- forall s r (m :: * -> *) a.
ReaderT
  (GetIncEnv s r) (ExceptT GetError (FT (GetIncSuspendChunk r) m)) a
-> GetIncM s r m a
GetIncM forall r (m :: * -> *). MonadReader r m => m r
ask
    ByteCount
gloAbs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s ByteCount
gloAbsRef)
    Seq ByteCount
capStack <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar s (Seq ByteCount)
capStackRef)
    case Seq ByteCount
capStack of
      Seq ByteCount
Empty -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ByteCount -> GetError
GetErrorRemaining ByteCount
gloAbs)
      Seq ByteCount
_ :|> ByteCount
cap -> ByteCount -> GetIncM s r m a
k (ByteCount
cap forall a. Num a => a -> a -> a
- ByteCount
gloAbs)
  GetFFail Text
msg -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GetError
GetErrorFail Text
msg)

runGetIncInternal
  :: (MonadPrim s m, ReadMem r m)
  => Get a
  -> GetIncEnv s r
  -> GetIncCbChunk r m
  -> m (Either GetError a, ByteCount, ByteCount)
runGetIncInternal :: forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a
-> GetIncEnv s r
-> GetIncCbChunk r m
-> m (Either GetError a, ByteCount, ByteCount)
runGetIncInternal Get a
getter GetIncEnv s r
env GetIncCbChunk r m
cb = do
  let m :: GetIncM s r m a
m = forall s (m :: * -> *) r a.
(MonadPrim s m, ReadMem r m) =>
Get a -> GetIncM s r m a
interpGetInc Get a
getter
  Either GetError a
res <- forall s (m :: * -> *) r a.
MonadPrim s m =>
GetIncM s r m a
-> GetIncEnv s r -> GetIncCbChunk r m -> m (Either GetError a)
runGetIncM GetIncM s r m a
m GetIncEnv s r
env GetIncCbChunk r m
cb
  ByteCount
gloAbs <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (forall s r. GetIncEnv s r -> MutVar s ByteCount
gieGlobalAbs GetIncEnv s r
env)
  ByteCount
gloRel <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (forall s r. GetIncEnv s r -> MutVar s ByteCount
gieGlobalRel GetIncEnv s r
env)
  GetIncChunk r
curChunk <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (forall s r. GetIncEnv s r -> MutVar s (GetIncChunk r)
gieCurChunk GetIncEnv s r
env)
  let baseOff :: ByteCount
baseOff = ByteCount
gloAbs forall a. Num a => a -> a -> a
- ByteCount
gloRel forall a. Num a => a -> a -> a
+ forall r. GetIncChunk r -> ByteCount
gicLocalOff GetIncChunk r
curChunk
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GetError a
res, ByteCount
gloAbs, ByteCount
baseOff)

-- Put:

data PutEnv s q = PutEnv
  { forall s (q :: * -> *). PutEnv s q -> MutVar s ByteCount
peOff :: !(MutVar s ByteCount)
  -- ^ Offset in bytes from start of buffer
  , forall s (q :: * -> *). PutEnv s q -> ByteCount
peCap :: !ByteCount
  -- ^ Capacity of buffer segment
  , forall s (q :: * -> *). PutEnv s q -> q s
peArray :: !(q s)
  -- ^ Destination buffer
  }

newPutEnv :: (PrimMonad m) => ByteCount -> ByteCount -> q (PrimState m) -> m (PutEnv (PrimState m) q)
newPutEnv :: forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> ByteCount -> q (PrimState m) -> m (PutEnv (PrimState m) q)
newPutEnv ByteCount
off ByteCount
cap q (PrimState m)
mem = do
  MutVar (PrimState m) ByteCount
offRef <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar ByteCount
off
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s (q :: * -> *).
MutVar s ByteCount -> ByteCount -> q s -> PutEnv s q
PutEnv MutVar (PrimState m) ByteCount
offRef ByteCount
cap q (PrimState m)
mem)

newtype PutEff q m a = PutEff {forall (q :: * -> *) (m :: * -> *) a.
PutEff q m a -> ReaderT (PutEnv (PrimState m) q) m a
unPutEff :: ReaderT (PutEnv (PrimState m) q) m a}
  deriving newtype (forall a b. a -> PutEff q m b -> PutEff q m a
forall a b. (a -> b) -> PutEff q m a -> PutEff q m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (q :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> PutEff q m b -> PutEff q m a
forall (q :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> PutEff q m a -> PutEff q m b
<$ :: forall a b. a -> PutEff q m b -> PutEff q m a
$c<$ :: forall (q :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> PutEff q m b -> PutEff q m a
fmap :: forall a b. (a -> b) -> PutEff q m a -> PutEff q m b
$cfmap :: forall (q :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> PutEff q m a -> PutEff q m b
Functor, forall a. a -> PutEff q m a
forall a b. PutEff q m a -> PutEff q m b -> PutEff q m a
forall a b. PutEff q m a -> PutEff q m b -> PutEff q m b
forall a b. PutEff q m (a -> b) -> PutEff q m a -> PutEff q m b
forall a b c.
(a -> b -> c) -> PutEff q m a -> PutEff q m b -> PutEff q m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {q :: * -> *} {m :: * -> *}.
Applicative m =>
Functor (PutEff q m)
forall (q :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> PutEff q m a
forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m a -> PutEff q m b -> PutEff q m a
forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m a -> PutEff q m b -> PutEff q m b
forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m (a -> b) -> PutEff q m a -> PutEff q m b
forall (q :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PutEff q m a -> PutEff q m b -> PutEff q m c
<* :: forall a b. PutEff q m a -> PutEff q m b -> PutEff q m a
$c<* :: forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m a -> PutEff q m b -> PutEff q m a
*> :: forall a b. PutEff q m a -> PutEff q m b -> PutEff q m b
$c*> :: forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m a -> PutEff q m b -> PutEff q m b
liftA2 :: forall a b c.
(a -> b -> c) -> PutEff q m a -> PutEff q m b -> PutEff q m c
$cliftA2 :: forall (q :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PutEff q m a -> PutEff q m b -> PutEff q m c
<*> :: forall a b. PutEff q m (a -> b) -> PutEff q m a -> PutEff q m b
$c<*> :: forall (q :: * -> *) (m :: * -> *) a b.
Applicative m =>
PutEff q m (a -> b) -> PutEff q m a -> PutEff q m b
pure :: forall a. a -> PutEff q m a
$cpure :: forall (q :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> PutEff q m a
Applicative, forall a. a -> PutEff q m a
forall a b. PutEff q m a -> PutEff q m b -> PutEff q m b
forall a b. PutEff q m a -> (a -> PutEff q m b) -> PutEff q m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall {q :: * -> *} {m :: * -> *}.
Monad m =>
Applicative (PutEff q m)
forall (q :: * -> *) (m :: * -> *) a. Monad m => a -> PutEff q m a
forall (q :: * -> *) (m :: * -> *) a b.
Monad m =>
PutEff q m a -> PutEff q m b -> PutEff q m b
forall (q :: * -> *) (m :: * -> *) a b.
Monad m =>
PutEff q m a -> (a -> PutEff q m b) -> PutEff q m b
return :: forall a. a -> PutEff q m a
$creturn :: forall (q :: * -> *) (m :: * -> *) a. Monad m => a -> PutEff q m a
>> :: forall a b. PutEff q m a -> PutEff q m b -> PutEff q m b
$c>> :: forall (q :: * -> *) (m :: * -> *) a b.
Monad m =>
PutEff q m a -> PutEff q m b -> PutEff q m b
>>= :: forall a b. PutEff q m a -> (a -> PutEff q m b) -> PutEff q m b
$c>>= :: forall (q :: * -> *) (m :: * -> *) a b.
Monad m =>
PutEff q m a -> (a -> PutEff q m b) -> PutEff q m b
Monad)

deriving newtype instance (Monad m, s ~ PrimState m) => MonadReader (PutEnv s q) (PutEff q m)

runPutEff :: PutEff q m a -> PutEnv (PrimState m) q -> m a
runPutEff :: forall (q :: * -> *) (m :: * -> *) a.
PutEff q m a -> PutEnv (PrimState m) q -> m a
runPutEff PutEff q m a
act = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (q :: * -> *) (m :: * -> *) a.
PutEff q m a -> ReaderT (PutEnv (PrimState m) q) m a
unPutEff PutEff q m a
act)

stPutEff :: (Monad m) => m a -> PutEff q m a
stPutEff :: forall (m :: * -> *) a (q :: * -> *).
Monad m =>
m a -> PutEff q m a
stPutEff = forall (q :: * -> *) (m :: * -> *) a.
ReaderT (PutEnv (PrimState m) q) m a -> PutEff q m a
PutEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

newtype PutRun q m a = PutRun {forall (q :: * -> *) (m :: * -> *) a.
PutRun q m a -> FT PutF (PutEff q m) a
unPutRun :: FT PutF (PutEff q m) a}
  deriving newtype (forall a b. a -> PutRun q m b -> PutRun q m a
forall a b. (a -> b) -> PutRun q m a -> PutRun q m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (q :: * -> *) (m :: * -> *) a b.
a -> PutRun q m b -> PutRun q m a
forall (q :: * -> *) (m :: * -> *) a b.
(a -> b) -> PutRun q m a -> PutRun q m b
<$ :: forall a b. a -> PutRun q m b -> PutRun q m a
$c<$ :: forall (q :: * -> *) (m :: * -> *) a b.
a -> PutRun q m b -> PutRun q m a
fmap :: forall a b. (a -> b) -> PutRun q m a -> PutRun q m b
$cfmap :: forall (q :: * -> *) (m :: * -> *) a b.
(a -> b) -> PutRun q m a -> PutRun q m b
Functor, forall a. a -> PutRun q m a
forall a b. PutRun q m a -> PutRun q m b -> PutRun q m a
forall a b. PutRun q m a -> PutRun q m b -> PutRun q m b
forall a b. PutRun q m (a -> b) -> PutRun q m a -> PutRun q m b
forall a b c.
(a -> b -> c) -> PutRun q m a -> PutRun q m b -> PutRun q m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (q :: * -> *) (m :: * -> *). Functor (PutRun q m)
forall (q :: * -> *) (m :: * -> *) a. a -> PutRun q m a
forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m a
forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m b
forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m (a -> b) -> PutRun q m a -> PutRun q m b
forall (q :: * -> *) (m :: * -> *) a b c.
(a -> b -> c) -> PutRun q m a -> PutRun q m b -> PutRun q m c
<* :: forall a b. PutRun q m a -> PutRun q m b -> PutRun q m a
$c<* :: forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m a
*> :: forall a b. PutRun q m a -> PutRun q m b -> PutRun q m b
$c*> :: forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m b
liftA2 :: forall a b c.
(a -> b -> c) -> PutRun q m a -> PutRun q m b -> PutRun q m c
$cliftA2 :: forall (q :: * -> *) (m :: * -> *) a b c.
(a -> b -> c) -> PutRun q m a -> PutRun q m b -> PutRun q m c
<*> :: forall a b. PutRun q m (a -> b) -> PutRun q m a -> PutRun q m b
$c<*> :: forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m (a -> b) -> PutRun q m a -> PutRun q m b
pure :: forall a. a -> PutRun q m a
$cpure :: forall (q :: * -> *) (m :: * -> *) a. a -> PutRun q m a
Applicative, forall a. a -> PutRun q m a
forall a b. PutRun q m a -> PutRun q m b -> PutRun q m b
forall a b. PutRun q m a -> (a -> PutRun q m b) -> PutRun q m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (q :: * -> *) (m :: * -> *). Applicative (PutRun q m)
forall (q :: * -> *) (m :: * -> *) a. a -> PutRun q m a
forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m b
forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> (a -> PutRun q m b) -> PutRun q m b
return :: forall a. a -> PutRun q m a
$creturn :: forall (q :: * -> *) (m :: * -> *) a. a -> PutRun q m a
>> :: forall a b. PutRun q m a -> PutRun q m b -> PutRun q m b
$c>> :: forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> PutRun q m b -> PutRun q m b
>>= :: forall a b. PutRun q m a -> (a -> PutRun q m b) -> PutRun q m b
$c>>= :: forall (q :: * -> *) (m :: * -> *) a b.
PutRun q m a -> (a -> PutRun q m b) -> PutRun q m b
Monad)

writeBytes :: (PrimMonad m) => ByteCount -> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes :: forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
bc q (PrimState m) -> ByteCount -> m ()
f = do
  PutEnv MutVar (PrimState m) ByteCount
offRef ByteCount
_ q (PrimState m)
mem <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a (q :: * -> *).
Monad m =>
m a -> PutEff q m a
stPutEff forall a b. (a -> b) -> a -> b
$ do
    ByteCount
off <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) ByteCount
offRef
    q (PrimState m) -> ByteCount -> m ()
f q (PrimState m)
mem ByteCount
off
    let newOff :: ByteCount
newOff = ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
bc
    forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) ByteCount
offRef ByteCount
newOff

writeStaticSeq :: (WriteMem q m) => PutStaticSeqF (PutEff q m a) -> PutEff q m a
writeStaticSeq :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutStaticSeqF (PutEff q m a) -> PutEff q m a
writeStaticSeq (PutStaticSeqF ElemCount
n Maybe z
mz z -> Put
p Seq z
s PutEff q m a
k) = do
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. Int -> [a] -> [a]
take (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq z
s)) forall a b. (a -> b) -> a -> b
$ \z
a -> do
    forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutM a -> PutEff q m a
mkPutEff (z -> Put
p z
a)
  let e :: Int
e = forall a. Seq a -> Int
Seq.length Seq z
s
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n forall a. Ord a => a -> a -> Bool
<= Int
e) forall a b. (a -> b) -> a -> b
$ do
    let q :: PutEff q m ()
q = forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutM a -> PutEff q m a
mkPutEff (z -> Put
p (forall a. HasCallStack => Maybe a -> a
fromJust Maybe z
mz))
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
n forall a. Num a => a -> a -> a
- Int
e) PutEff q m ()
q
  PutEff q m a
k

writeStaticArray :: (WriteMem q m) => PutStaticArrayF (PutEff q m a) -> PutEff q m a
writeStaticArray :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutStaticArrayF (PutEff q m a) -> PutEff q m a
writeStaticArray psa :: PutStaticArrayF (PutEff q m a)
psa@(PutStaticArrayF ElemCount
needElems Maybe z
mz a :: LiftedPrimArray z
a@(LiftedPrimArray ByteArray
ba) PutEff q m a
k) = do
  let elemSize :: ByteCount
elemSize = forall a. PutStaticArrayF a -> ByteCount
putStaticArrayElemSize PutStaticArrayF (PutEff q m a)
psa
      haveElems :: ByteCount
haveElems = forall a. LiftedPrimArray a -> ByteCount
sizeofLiftedPrimArray LiftedPrimArray z
a
      useElems :: ByteCount
useElems = forall a. Ord a => a -> a -> a
min ByteCount
haveElems (coerce :: forall a b. Coercible a b => a -> b
coerce ElemCount
needElems)
      useBc :: ByteCount
useBc = ByteCount
elemSize forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce ByteCount
useElems
  forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
useBc (forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ByteArray
-> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
copyArrayMemInBytes ByteArray
ba ByteCount
0 ByteCount
useBc)
  let needBc :: ByteCount
needBc = forall a. PutStaticArrayF a -> ByteCount
putStaticArraySize PutStaticArrayF (PutEff q m a)
psa
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteCount
useBc forall a. Eq a => a -> a -> Bool
== ByteCount
needBc) forall a b. (a -> b) -> a -> b
$ do
    let extraBc :: ByteCount
extraBc = ByteCount
needBc forall a. Num a => a -> a -> a
- ByteCount
useBc
    case Maybe z
mz of
      Maybe z
Nothing -> forall a. HasCallStack => String -> a
error String
"no default element for undersized static array"
      Just z
z -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
extraBc (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
ByteCount -> a -> q (PrimState m) -> ByteCount -> m ()
setMemInBytes ByteCount
extraBc z
z)
  PutEff q m a
k

execPutRun :: (WriteMem q m) => PutF (PutEff q m a) -> PutEff q m a
execPutRun :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutF (PutEff q m a) -> PutEff q m a
execPutRun = \case
  PutFWord8 Word8
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
1 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word8
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt8 Int8
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
1 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int8
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord16LE Word16LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
2 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word16LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt16LE Int16LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
2 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int16LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord24LE Word24LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
3 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word24LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt24LE Int24LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
3 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int24LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord32LE Word32LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word32LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt32LE Int32LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int32LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord64LE Word64LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word64LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt64LE Int64LE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int64LE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFFloatLE FloatLE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes FloatLE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFDoubleLE DoubleLE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes DoubleLE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord16BE Word16BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
2 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word16BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt16BE Int16BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
2 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int16BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord24BE Word24BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
3 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word24BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt24BE Int24BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
3 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int24BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord32BE Word32BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word32BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt32BE Int32BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int32BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFWord64BE Word64BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Word64BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFInt64BE Int64BE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes Int64BE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFFloatBE FloatBE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
4 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes FloatBE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFDoubleBE DoubleBE
x PutEff q m a
k -> forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
8 (forall (q :: * -> *) (m :: * -> *) a.
(WriteMem q m, LiftedPrim a) =>
a -> q (PrimState m) -> ByteCount -> m ()
writeMemInBytes DoubleBE
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFShortByteString ByteCount
bc ShortByteString
sbs PutEff q m a
k ->
    forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
bc (forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ShortByteString
-> ByteCount -> q (PrimState m) -> ByteCount -> m ()
writeSBSMem ShortByteString
sbs ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFStaticSeq PutStaticSeqF (PutEff q m a)
pss -> forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutStaticSeqF (PutEff q m a) -> PutEff q m a
writeStaticSeq PutStaticSeqF (PutEff q m a)
pss
  PutFStaticArray PutStaticArrayF (PutEff q m a)
psa -> forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutStaticArrayF (PutEff q m a) -> PutEff q m a
writeStaticArray PutStaticArrayF (PutEff q m a)
psa
  PutFByteArray ByteCount
bc ByteArray
barr PutEff q m a
k ->
    forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> (q (PrimState m) -> ByteCount -> m ()) -> PutEff q m ()
writeBytes ByteCount
bc (forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ByteArray
-> ByteCount -> ByteCount -> q (PrimState m) -> ByteCount -> m ()
copyArrayMemInBytes ByteArray
barr ByteCount
0 ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k
  PutFStaticHint (PutStaticHintF ByteCount
_ Put
p PutEff q m a
k) -> forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutM a -> PutEff q m a
mkPutEff Put
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutEff q m a
k

runPutRun :: (WriteMem q m) => PutRun q m a -> PutEnv (PrimState m) q -> m a
runPutRun :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutRun q m a -> PutEnv (PrimState m) q -> m a
runPutRun = forall (q :: * -> *) (m :: * -> *) a.
PutEff q m a -> PutEnv (PrimState m) q -> m a
runPutEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutRun q m a -> PutEff q m a
iterPutRun

iterPutRun :: (WriteMem q m) => PutRun q m a -> PutEff q m a
iterPutRun :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutRun q m a -> PutEff q m a
iterPutRun PutRun q m a
act = forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutF (PutEff q m a) -> PutEff q m a
execPutRun (forall (q :: * -> *) (m :: * -> *) a.
PutRun q m a -> FT PutF (PutEff q m) a
unPutRun PutRun q m a
act)

mkPutRun :: PutM a -> PutRun q m a
mkPutRun :: forall a (q :: * -> *) (m :: * -> *). PutM a -> PutRun q m a
mkPutRun (PutM (F forall r. (a -> r) -> (PutF r -> r) -> r
w)) = forall (q :: * -> *) (m :: * -> *) a.
FT PutF (PutEff q m) a -> PutRun q m a
PutRun (forall r. (a -> r) -> (PutF r -> r) -> r
w forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap)

mkPutEff :: (WriteMem q m) => PutM a -> PutEff q m a
mkPutEff :: forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutM a -> PutEff q m a
mkPutEff = forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutRun q m a -> PutEff q m a
iterPutRun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (q :: * -> *) (m :: * -> *). PutM a -> PutRun q m a
mkPutRun

runPutInternal :: (WriteMem q m) => ByteCount -> Put -> ByteCount -> q (PrimState m) -> m ByteCount
runPutInternal :: forall (q :: * -> *) (m :: * -> *).
WriteMem q m =>
ByteCount -> Put -> ByteCount -> q (PrimState m) -> m ByteCount
runPutInternal ByteCount
off Put
act ByteCount
len q (PrimState m)
mem = do
  let eff :: PutRun q m ()
eff = forall a (q :: * -> *) (m :: * -> *). PutM a -> PutRun q m a
mkPutRun Put
act
      cap :: ByteCount
cap = ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
len
  st :: PutEnv (PrimState m) q
st@(PutEnv MutVar (PrimState m) ByteCount
offRef ByteCount
_ q (PrimState m)
_) <- forall (m :: * -> *) (q :: * -> *).
PrimMonad m =>
ByteCount
-> ByteCount -> q (PrimState m) -> m (PutEnv (PrimState m) q)
newPutEnv ByteCount
off ByteCount
cap q (PrimState m)
mem
  forall (q :: * -> *) (m :: * -> *) a.
WriteMem q m =>
PutRun q m a -> PutEnv (PrimState m) q -> m a
runPutRun PutRun q m ()
eff PutEnv (PrimState m) q
st
  forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) ByteCount
offRef

-- Count:

newtype CountEff a = CountEff {forall a. CountEff a -> MaybeT (State ByteCount) a
unCountEff :: MaybeT (State ByteCount) a}
  deriving newtype (forall a b. a -> CountEff b -> CountEff a
forall a b. (a -> b) -> CountEff a -> CountEff b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CountEff b -> CountEff a
$c<$ :: forall a b. a -> CountEff b -> CountEff a
fmap :: forall a b. (a -> b) -> CountEff a -> CountEff b
$cfmap :: forall a b. (a -> b) -> CountEff a -> CountEff b
Functor, Functor CountEff
forall a. a -> CountEff a
forall a b. CountEff a -> CountEff b -> CountEff a
forall a b. CountEff a -> CountEff b -> CountEff b
forall a b. CountEff (a -> b) -> CountEff a -> CountEff b
forall a b c.
(a -> b -> c) -> CountEff a -> CountEff b -> CountEff c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. CountEff a -> CountEff b -> CountEff a
$c<* :: forall a b. CountEff a -> CountEff b -> CountEff a
*> :: forall a b. CountEff a -> CountEff b -> CountEff b
$c*> :: forall a b. CountEff a -> CountEff b -> CountEff b
liftA2 :: forall a b c.
(a -> b -> c) -> CountEff a -> CountEff b -> CountEff c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CountEff a -> CountEff b -> CountEff c
<*> :: forall a b. CountEff (a -> b) -> CountEff a -> CountEff b
$c<*> :: forall a b. CountEff (a -> b) -> CountEff a -> CountEff b
pure :: forall a. a -> CountEff a
$cpure :: forall a. a -> CountEff a
Applicative, Applicative CountEff
forall a. a -> CountEff a
forall a b. CountEff a -> CountEff b -> CountEff b
forall a b. CountEff a -> (a -> CountEff b) -> CountEff b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CountEff a
$creturn :: forall a. a -> CountEff a
>> :: forall a b. CountEff a -> CountEff b -> CountEff b
$c>> :: forall a b. CountEff a -> CountEff b -> CountEff b
>>= :: forall a b. CountEff a -> (a -> CountEff b) -> CountEff b
$c>>= :: forall a b. CountEff a -> (a -> CountEff b) -> CountEff b
Monad, Applicative CountEff
forall a. CountEff a
forall a. CountEff a -> CountEff [a]
forall a. CountEff a -> CountEff a -> CountEff a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. CountEff a -> CountEff [a]
$cmany :: forall a. CountEff a -> CountEff [a]
some :: forall a. CountEff a -> CountEff [a]
$csome :: forall a. CountEff a -> CountEff [a]
<|> :: forall a. CountEff a -> CountEff a -> CountEff a
$c<|> :: forall a. CountEff a -> CountEff a -> CountEff a
empty :: forall a. CountEff a
$cempty :: forall a. CountEff a
Alternative, MonadState ByteCount)

runCountEff :: CountEff a -> ByteCount -> (Maybe a, ByteCount)
runCountEff :: forall a. CountEff a -> ByteCount -> (Maybe a, ByteCount)
runCountEff CountEff a
act = forall s a. State s a -> s -> (a, s)
runState (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (forall a. CountEff a -> MaybeT (State ByteCount) a
unCountEff CountEff a
act))

newtype CountRun a = CountRun {forall a. CountRun a -> FT PutF CountEff a
unCountRun :: FT PutF CountEff a}
  deriving newtype (forall a b. a -> CountRun b -> CountRun a
forall a b. (a -> b) -> CountRun a -> CountRun b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CountRun b -> CountRun a
$c<$ :: forall a b. a -> CountRun b -> CountRun a
fmap :: forall a b. (a -> b) -> CountRun a -> CountRun b
$cfmap :: forall a b. (a -> b) -> CountRun a -> CountRun b
Functor, Functor CountRun
forall a. a -> CountRun a
forall a b. CountRun a -> CountRun b -> CountRun a
forall a b. CountRun a -> CountRun b -> CountRun b
forall a b. CountRun (a -> b) -> CountRun a -> CountRun b
forall a b c.
(a -> b -> c) -> CountRun a -> CountRun b -> CountRun c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. CountRun a -> CountRun b -> CountRun a
$c<* :: forall a b. CountRun a -> CountRun b -> CountRun a
*> :: forall a b. CountRun a -> CountRun b -> CountRun b
$c*> :: forall a b. CountRun a -> CountRun b -> CountRun b
liftA2 :: forall a b c.
(a -> b -> c) -> CountRun a -> CountRun b -> CountRun c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CountRun a -> CountRun b -> CountRun c
<*> :: forall a b. CountRun (a -> b) -> CountRun a -> CountRun b
$c<*> :: forall a b. CountRun (a -> b) -> CountRun a -> CountRun b
pure :: forall a. a -> CountRun a
$cpure :: forall a. a -> CountRun a
Applicative, Applicative CountRun
forall a. a -> CountRun a
forall a b. CountRun a -> CountRun b -> CountRun b
forall a b. CountRun a -> (a -> CountRun b) -> CountRun b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CountRun a
$creturn :: forall a. a -> CountRun a
>> :: forall a b. CountRun a -> CountRun b -> CountRun b
$c>> :: forall a b. CountRun a -> CountRun b -> CountRun b
>>= :: forall a b. CountRun a -> (a -> CountRun b) -> CountRun b
$c>>= :: forall a b. CountRun a -> (a -> CountRun b) -> CountRun b
Monad)

execCountRun :: PutF (CountEff a) -> CountEff a
execCountRun :: forall a. PutF (CountEff a) -> CountEff a
execCountRun = \case
  PutFWord8 Word8
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
1 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt8 Int8
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
1 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord16LE Word16LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
2 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt16LE Int16LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
2 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord24LE Word24LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
3 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt24LE Int24LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
3 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord32LE Word32LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt32LE Int32LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord64LE Word64LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt64LE Int64LE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFFloatLE FloatLE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFDoubleLE DoubleLE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord16BE Word16BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
2 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt16BE Int16BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
2 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord24BE Word24BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
3 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt24BE Int24BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
3 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord32BE Word32BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt32BE Int32BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFWord64BE Word64BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFInt64BE Int64BE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFFloatBE FloatBE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
4 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFDoubleBE DoubleBE
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
8 forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFShortByteString ByteCount
bc ShortByteString
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
bc forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFStaticSeq pss :: PutStaticSeqF (CountEff a)
pss@(PutStaticSeqF ElemCount
_ Maybe z
_ z -> Put
_ Seq z
_ CountEff a
k) ->
    let bc :: ByteCount
bc = forall a. PutStaticSeqF a -> ByteCount
putStaticSeqSize PutStaticSeqF (CountEff a)
pss
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
bc forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFStaticArray psv :: PutStaticArrayF (CountEff a)
psv@(PutStaticArrayF ElemCount
_ Maybe z
_ LiftedPrimArray z
_ CountEff a
k) ->
    let bc :: ByteCount
bc = forall a. PutStaticArrayF a -> ByteCount
putStaticArraySize PutStaticArrayF (CountEff a)
psv
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
bc forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFByteArray ByteCount
bc ByteArray
_ CountEff a
k -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
bc forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k
  PutFStaticHint (PutStaticHintF ByteCount
bc Put
_ CountEff a
k) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (ByteCount
bc forall a. Num a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CountEff a
k

runCountRun :: CountRun a -> ByteCount -> (Maybe a, ByteCount)
runCountRun :: forall a. CountRun a -> ByteCount -> (Maybe a, ByteCount)
runCountRun = forall a. CountEff a -> ByteCount -> (Maybe a, ByteCount)
runCountEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CountRun a -> CountEff a
iterCountRun

iterCountRun :: CountRun a -> CountEff a
iterCountRun :: forall a. CountRun a -> CountEff a
iterCountRun CountRun a
act = forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT forall a. PutF (CountEff a) -> CountEff a
execCountRun (forall a. CountRun a -> FT PutF CountEff a
unCountRun CountRun a
act)

mkCountRun :: PutM a -> CountRun a
mkCountRun :: forall a. PutM a -> CountRun a
mkCountRun (PutM (F forall r. (a -> r) -> (PutF r -> r) -> r
w)) = forall a. FT PutF CountEff a -> CountRun a
CountRun (forall r. (a -> r) -> (PutF r -> r) -> r
w forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap)

mkCountEff :: PutM a -> CountEff a
mkCountEff :: forall a. PutM a -> CountEff a
mkCountEff = forall a. CountRun a -> CountEff a
iterCountRun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PutM a -> CountRun a
mkCountRun

runCount :: Put -> ByteCount
runCount :: Put -> ByteCount
runCount Put
act =
  let eff :: CountRun ()
eff = forall a. PutM a -> CountRun a
mkCountRun Put
act
      (Maybe ()
_, ByteCount
bc) = forall a. CountRun a -> ByteCount -> (Maybe a, ByteCount)
runCountRun CountRun ()
eff ByteCount
0
  in  ByteCount
bc