module Dahdit.Run
  ( GetError (..)
  , prettyGetError
  , runGetInternal
  , runCount
  , runPutInternal
  )
where

import Control.Applicative (Alternative (..))
import Control.Exception (Exception (..), onException)
import Control.Monad (replicateM_, unless)
import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)
import Control.Monad.Free.Church (F (..))
import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
import Control.Monad.ST.Strict (ST, runST)
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Control.Monad.State.Strict (MonadState, State, runState)
import qualified Control.Monad.State.Strict as State
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Free (FreeT (..), iterT, wrap)
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.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)
import qualified Data.Sequence as Seq
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
  = GetErrorParseNeed !String !ByteCount !ByteCount
  | GetErrorScopedMismatch !ByteCount !ByteCount
  | GetErrorFail !String
  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 = GetError -> String
prettyGetError

prettyGetError :: GetError -> String
prettyGetError :: GetError -> String
prettyGetError = \case
  GetErrorParseNeed String
nm ByteCount
ac ByteCount
bc -> String
"End of input parsing " forall a. [a] -> [a] -> [a]
++ String
nm forall a. [a] -> [a] -> [a]
++ String
" (have " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac) forall a. [a] -> [a] -> [a]
++ String
" bytes, need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
bc) forall a. [a] -> [a] -> [a]
++ String
")"
  GetErrorScopedMismatch ByteCount
ac ByteCount
bc -> String
"Did not parse enough scoped input (read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
ac) forall a. [a] -> [a] -> [a]
++ String
" bytes, expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Int
unByteCount ByteCount
bc) forall a. [a] -> [a] -> [a]
++ String
")"
  GetErrorFail String
msg -> String
"User error: " forall a. [a] -> [a] -> [a]
++ String
msg

data GetEnv s r = GetEnv
  { forall s r. GetEnv s r -> STRef s ByteCount
geOff :: !(STRef s ByteCount)
  -- ^ Offset from buffer start (in bytes)
  , forall s r. GetEnv s r -> ByteCount
geCap :: !ByteCount
  -- ^ Capacity of buffer segment
  , forall s r. GetEnv s r -> r
geArray :: !r
  -- ^ Source buffer
  }

newGetEnv :: ByteCount -> ByteCount -> r -> ST s (GetEnv s r)
newGetEnv :: forall r s. ByteCount -> ByteCount -> r -> ST s (GetEnv s r)
newGetEnv ByteCount
off ByteCount
cap r
mem = do
  STRef s ByteCount
offRef <- forall a s. a -> ST s (STRef s a)
newSTRef ByteCount
off
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s r. STRef s ByteCount -> ByteCount -> r -> GetEnv s r
GetEnv STRef s ByteCount
offRef ByteCount
cap r
mem)

newtype GetEff s r a = GetEff {forall s r a.
GetEff s r a -> ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a
unGetEff :: ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a}
  deriving newtype (forall a b. a -> GetEff s r b -> GetEff s r a
forall a b. (a -> b) -> GetEff s r a -> GetEff s r b
forall s r a b. a -> GetEff s r b -> GetEff s r a
forall s r a b. (a -> b) -> GetEff s r a -> GetEff s r 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 -> GetEff s r b -> GetEff s r a
$c<$ :: forall s r a b. a -> GetEff s r b -> GetEff s r a
fmap :: forall a b. (a -> b) -> GetEff s r a -> GetEff s r b
$cfmap :: forall s r a b. (a -> b) -> GetEff s r a -> GetEff s r b
Functor, forall a. a -> GetEff s r a
forall s r. Functor (GetEff s r)
forall a b. GetEff s r a -> GetEff s r b -> GetEff s r a
forall a b. GetEff s r a -> GetEff s r b -> GetEff s r b
forall a b. GetEff s r (a -> b) -> GetEff s r a -> GetEff s r b
forall s r a. a -> GetEff s r a
forall a b c.
(a -> b -> c) -> GetEff s r a -> GetEff s r b -> GetEff s r c
forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r a
forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r b
forall s r a b. GetEff s r (a -> b) -> GetEff s r a -> GetEff s r b
forall s r a b c.
(a -> b -> c) -> GetEff s r a -> GetEff s r b -> GetEff s r 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. GetEff s r a -> GetEff s r b -> GetEff s r a
$c<* :: forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r a
*> :: forall a b. GetEff s r a -> GetEff s r b -> GetEff s r b
$c*> :: forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r b
liftA2 :: forall a b c.
(a -> b -> c) -> GetEff s r a -> GetEff s r b -> GetEff s r c
$cliftA2 :: forall s r a b c.
(a -> b -> c) -> GetEff s r a -> GetEff s r b -> GetEff s r c
<*> :: forall a b. GetEff s r (a -> b) -> GetEff s r a -> GetEff s r b
$c<*> :: forall s r a b. GetEff s r (a -> b) -> GetEff s r a -> GetEff s r b
pure :: forall a. a -> GetEff s r a
$cpure :: forall s r a. a -> GetEff s r a
Applicative, forall a. a -> GetEff s r a
forall s r. Applicative (GetEff s r)
forall a b. GetEff s r a -> GetEff s r b -> GetEff s r b
forall a b. GetEff s r a -> (a -> GetEff s r b) -> GetEff s r b
forall s r a. a -> GetEff s r a
forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r b
forall s r a b. GetEff s r a -> (a -> GetEff s r b) -> GetEff s r 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 -> GetEff s r a
$creturn :: forall s r a. a -> GetEff s r a
>> :: forall a b. GetEff s r a -> GetEff s r b -> GetEff s r b
$c>> :: forall s r a b. GetEff s r a -> GetEff s r b -> GetEff s r b
>>= :: forall a b. GetEff s r a -> (a -> GetEff s r b) -> GetEff s r b
$c>>= :: forall s r a b. GetEff s r a -> (a -> GetEff s r b) -> GetEff s r b
Monad, MonadReader (GetEnv s r), MonadError GetError)

runGetEff :: GetEff s r a -> GetEnv s r -> ST s (Either GetError a)
runGetEff :: forall s r a.
GetEff s r a -> GetEnv s r -> ST s (Either GetError a)
runGetEff GetEff s r a
act GetEnv s r
env = 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 a.
GetEff s r a -> ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a
unGetEff GetEff s r a
act) GetEnv s r
env)

instance MonadFail (GetEff s r) where
  fail :: forall a. String -> GetEff s r a
fail = forall s r a.
ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a -> GetEff s r a
GetEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GetError
GetErrorFail

stGetEff :: ST s a -> GetEff s r a
stGetEff :: forall s a r. ST s a -> GetEff s r a
stGetEff = forall s r a.
ReaderT (GetEnv s r) (ExceptT GetError (ST s)) a -> GetEff s r a
GetEff 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

newtype GetRun s r a = GetRun {forall s r a. GetRun s r a -> FreeT GetF (GetEff s r) a
unGetRun :: FreeT GetF (GetEff s r) a}
  deriving newtype (forall a b. a -> GetRun s r b -> GetRun s r a
forall a b. (a -> b) -> GetRun s r a -> GetRun s r b
forall s r a b. a -> GetRun s r b -> GetRun s r a
forall s r a b. (a -> b) -> GetRun s r a -> GetRun s r 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 -> GetRun s r b -> GetRun s r a
$c<$ :: forall s r a b. a -> GetRun s r b -> GetRun s r a
fmap :: forall a b. (a -> b) -> GetRun s r a -> GetRun s r b
$cfmap :: forall s r a b. (a -> b) -> GetRun s r a -> GetRun s r b
Functor, forall a. a -> GetRun s r a
forall s r. Functor (GetRun s r)
forall a b. GetRun s r a -> GetRun s r b -> GetRun s r a
forall a b. GetRun s r a -> GetRun s r b -> GetRun s r b
forall a b. GetRun s r (a -> b) -> GetRun s r a -> GetRun s r b
forall s r a. a -> GetRun s r a
forall a b c.
(a -> b -> c) -> GetRun s r a -> GetRun s r b -> GetRun s r c
forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r a
forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r b
forall s r a b. GetRun s r (a -> b) -> GetRun s r a -> GetRun s r b
forall s r a b c.
(a -> b -> c) -> GetRun s r a -> GetRun s r b -> GetRun s r 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. GetRun s r a -> GetRun s r b -> GetRun s r a
$c<* :: forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r a
*> :: forall a b. GetRun s r a -> GetRun s r b -> GetRun s r b
$c*> :: forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r b
liftA2 :: forall a b c.
(a -> b -> c) -> GetRun s r a -> GetRun s r b -> GetRun s r c
$cliftA2 :: forall s r a b c.
(a -> b -> c) -> GetRun s r a -> GetRun s r b -> GetRun s r c
<*> :: forall a b. GetRun s r (a -> b) -> GetRun s r a -> GetRun s r b
$c<*> :: forall s r a b. GetRun s r (a -> b) -> GetRun s r a -> GetRun s r b
pure :: forall a. a -> GetRun s r a
$cpure :: forall s r a. a -> GetRun s r a
Applicative, forall a. a -> GetRun s r a
forall s r. Applicative (GetRun s r)
forall a b. GetRun s r a -> GetRun s r b -> GetRun s r b
forall a b. GetRun s r a -> (a -> GetRun s r b) -> GetRun s r b
forall s r a. a -> GetRun s r a
forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r b
forall s r a b. GetRun s r a -> (a -> GetRun s r b) -> GetRun s r 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 -> GetRun s r a
$creturn :: forall s r a. a -> GetRun s r a
>> :: forall a b. GetRun s r a -> GetRun s r b -> GetRun s r b
$c>> :: forall s r a b. GetRun s r a -> GetRun s r b -> GetRun s r b
>>= :: forall a b. GetRun s r a -> (a -> GetRun s r b) -> GetRun s r b
$c>>= :: forall s r a b. GetRun s r a -> (a -> GetRun s r b) -> GetRun s r b
Monad)

guardReadBytes :: String -> ByteCount -> GetEff s r ByteCount
guardReadBytes :: forall s r. String -> ByteCount -> GetEff s r ByteCount
guardReadBytes String
nm ByteCount
bc = do
  GetEnv STRef s ByteCount
offRef ByteCount
cap r
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
  ByteCount
off <- forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef)
  let ac :: ByteCount
ac = ByteCount
cap forall a. Num a => a -> a -> a
- ByteCount
off
  if ByteCount
bc forall a. Ord a => a -> a -> Bool
> ByteCount
ac
    then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ByteCount -> ByteCount -> GetError
GetErrorParseNeed String
nm ByteCount
ac ByteCount
bc)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteCount
off

readBytes :: String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes :: forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
nm ByteCount
bc r -> ByteCount -> a
f = do
  ByteCount
off <- forall s r. String -> ByteCount -> GetEff s r ByteCount
guardReadBytes String
nm ByteCount
bc
  GetEnv STRef s ByteCount
offRef ByteCount
_ r
mem <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall s a r. ST s a -> GetEff s r a
stGetEff forall a b. (a -> b) -> a -> b
$ do
    let a :: a
a = r -> ByteCount -> a
f r
mem ByteCount
off
        newOff :: ByteCount
newOff = ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
bc
    forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteCount
offRef ByteCount
newOff
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

readScope :: ReadMem r => GetScopeF (GetEff s r a) -> GetEff s r a
readScope :: forall r s a. ReadMem r => GetScopeF (GetEff s r a) -> GetEff s r a
readScope (GetScopeF ScopeMode
sm ByteCount
bc Get z
g z -> GetEff s r a
k) = do
  GetEnv STRef s ByteCount
offRef ByteCount
oldCap r
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
  ByteCount
oldOff <- forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef)
  let oldAvail :: ByteCount
oldAvail = ByteCount
oldCap forall a. Num a => a -> a -> a
- ByteCount
oldOff
  if ByteCount
bc forall a. Ord a => a -> a -> Bool
> ByteCount
oldAvail
    then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ByteCount -> ByteCount -> GetError
GetErrorParseNeed String
"scope" ByteCount
oldAvail ByteCount
bc)
    else do
      let newCap :: ByteCount
newCap = ByteCount
oldOff forall a. Num a => a -> a -> a
+ ByteCount
bc
      z
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\GetEnv s r
ge -> GetEnv s r
ge {geCap :: ByteCount
geCap = ByteCount
newCap}) (forall r a s. ReadMem r => Get a -> GetEff s r a
mkGetEff Get z
g)
      case ScopeMode
sm of
        ScopeMode
ScopeModeWithin -> z -> GetEff s r a
k z
a
        ScopeMode
ScopeModeExact -> do
          ByteCount
newOff <- forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef)
          let actualBc :: ByteCount
actualBc = ByteCount
newOff forall a. Num a => a -> a -> a
- ByteCount
oldOff
          if ByteCount
actualBc forall a. Eq a => a -> a -> Bool
== ByteCount
bc
            then z -> GetEff s r a
k z
a
            else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ByteCount -> ByteCount -> GetError
GetErrorScopedMismatch ByteCount
actualBc ByteCount
bc)

readStaticSeq :: ReadMem r => GetStaticSeqF (GetEff s r a) -> GetEff s r a
readStaticSeq :: forall r s a.
ReadMem r =>
GetStaticSeqF (GetEff s r a) -> GetEff s r a
readStaticSeq gss :: GetStaticSeqF (GetEff s r a)
gss@(GetStaticSeqF ElemCount
ec Get z
g Seq z -> GetEff s r a
k) = do
  let bc :: ByteCount
bc = forall a. GetStaticSeqF a -> ByteCount
getStaticSeqSize GetStaticSeqF (GetEff s r a)
gss
  ByteCount
_ <- forall s r. String -> ByteCount -> GetEff s r ByteCount
guardReadBytes String
"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 r a s. ReadMem r => Get a -> GetEff s r a
mkGetEff Get z
g)
  Seq z -> GetEff s r a
k Seq z
ss

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

readLookAhead :: ReadMem r => GetLookAheadF (GetEff s r a) -> GetEff s r a
readLookAhead :: forall r s a.
ReadMem r =>
GetLookAheadF (GetEff s r a) -> GetEff s r a
readLookAhead (GetLookAheadF Get z
g z -> GetEff s r a
k) = do
  STRef s ByteCount
offRef <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall s r. GetEnv s r -> STRef s ByteCount
geOff
  ByteCount
startOff <- forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef)
  z
a <- forall r a s. ReadMem r => Get a -> GetEff s r a
mkGetEff Get z
g
  forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteCount
offRef ByteCount
startOff)
  z -> GetEff s r a
k z
a

execGetRun :: ReadMem r => GetF (GetEff s r a) -> GetEff s r a
execGetRun :: forall r s a. ReadMem r => GetF (GetEff s r a) -> GetEff s r a
execGetRun = \case
  GetFWord8 Word8 -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word8" ByteCount
1 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> GetEff s r a
k
  GetFInt8 Int8 -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int8" ByteCount
1 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int8 -> GetEff s r a
k
  GetFWord16LE Word16LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word16LE" ByteCount
2 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16LE -> GetEff s r a
k
  GetFInt16LE Int16LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int16LE" ByteCount
2 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16LE -> GetEff s r a
k
  GetFWord24LE Word24LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word24LE" ByteCount
3 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24LE -> GetEff s r a
k
  GetFInt24LE Int24LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int24LE" ByteCount
3 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24LE -> GetEff s r a
k
  GetFWord32LE Word32LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word32LE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32LE -> GetEff s r a
k
  GetFInt32LE Int32LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int32LE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32LE -> GetEff s r a
k
  GetFWord64LE Word64LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word64LE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word64LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64LE -> GetEff s r a
k
  GetFInt64LE Int64LE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int64LE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int64LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64LE -> GetEff s r a
k
  GetFFloatLE FloatLE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"FloatLE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @FloatLE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatLE -> GetEff s r a
k
  GetFDoubleLE DoubleLE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"DoubleLE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @DoubleLE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DoubleLE -> GetEff s r a
k
  GetFWord16BE Word16BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word16BE" ByteCount
2 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16BE -> GetEff s r a
k
  GetFInt16BE Int16BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int16BE" ByteCount
2 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16BE -> GetEff s r a
k
  GetFWord24BE Word24BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word24BE" ByteCount
3 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24BE -> GetEff s r a
k
  GetFInt24BE Int24BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int24BE" ByteCount
3 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24BE -> GetEff s r a
k
  GetFWord32BE Word32BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word32BE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32BE -> GetEff s r a
k
  GetFInt32BE Int32BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int32BE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32BE -> GetEff s r a
k
  GetFWord64BE Word64BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Word64BE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Word64BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64BE -> GetEff s r a
k
  GetFInt64BE Int64BE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"Int64BE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @Int64BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64BE -> GetEff s r a
k
  GetFFloatBE FloatBE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"FloatBE" ByteCount
4 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @FloatBE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatBE -> GetEff s r a
k
  GetFDoubleBE DoubleBE -> GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"DoubleBE" ByteCount
8 (forall r a. (ReadMem r, LiftedPrim a) => r -> ByteCount -> a
indexMemInBytes @_ @DoubleBE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DoubleBE -> GetEff s r a
k
  GetFShortByteString ByteCount
bc ShortByteString -> GetEff s r a
k ->
    forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"ShortByteString" ByteCount
bc (\r
mem ByteCount
off -> forall r.
ReadMem r =>
r -> ByteCount -> ByteCount -> ShortByteString
readSBSMem r
mem ByteCount
off ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ShortByteString -> GetEff s r a
k
  GetFStaticSeq GetStaticSeqF (GetEff s r a)
gss -> forall r s a.
ReadMem r =>
GetStaticSeqF (GetEff s r a) -> GetEff s r a
readStaticSeq GetStaticSeqF (GetEff s r a)
gss
  GetFStaticArray GetStaticArrayF (GetEff s r a)
gsa -> forall r s a.
ReadMem r =>
GetStaticArrayF (GetEff s r a) -> GetEff s r a
readStaticArray GetStaticArrayF (GetEff s r a)
gsa
  GetFByteArray ByteCount
bc ByteArray -> GetEff s r a
k ->
    forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"ByteArray" ByteCount
bc (\r
mem ByteCount
off -> forall r. ReadMem r => r -> ByteCount -> ByteCount -> ByteArray
cloneArrayMemInBytes r
mem ByteCount
off ByteCount
bc) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteArray -> GetEff s r a
k
  GetFScope GetScopeF (GetEff s r a)
gs -> forall r s a. ReadMem r => GetScopeF (GetEff s r a) -> GetEff s r a
readScope GetScopeF (GetEff s r a)
gs
  GetFSkip ByteCount
bc GetEff s r a
k -> forall r a s.
String -> ByteCount -> (r -> ByteCount -> a) -> GetEff s r a
readBytes String
"skip" ByteCount
bc (\r
_ ByteCount
_ -> ()) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GetEff s r a
k
  GetFLookAhead GetLookAheadF (GetEff s r a)
gla -> forall r s a.
ReadMem r =>
GetLookAheadF (GetEff s r a) -> GetEff s r a
readLookAhead GetLookAheadF (GetEff s r a)
gla
  GetFRemainingSize ByteCount -> GetEff s r a
k -> do
    GetEnv STRef s ByteCount
offRef ByteCount
cap r
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
    ByteCount
off <- forall s a r. ST s a -> GetEff s r a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef)
    ByteCount -> GetEff s r a
k (ByteCount
cap forall a. Num a => a -> a -> a
- ByteCount
off)
  GetFFail String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

runGetRun :: ReadMem r => GetRun s r a -> GetEnv s r -> ST s (Either GetError a)
runGetRun :: forall r s a.
ReadMem r =>
GetRun s r a -> GetEnv s r -> ST s (Either GetError a)
runGetRun = forall s r a.
GetEff s r a -> GetEnv s r -> ST s (Either GetError a)
runGetEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r s a. ReadMem r => GetRun s r a -> GetEff s r a
iterGetRun

iterGetRun :: ReadMem r => GetRun s r a -> GetEff s r a
iterGetRun :: forall r s a. ReadMem r => GetRun s r a -> GetEff s r a
iterGetRun GetRun s r a
act = forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT forall r s a. ReadMem r => GetF (GetEff s r a) -> GetEff s r a
execGetRun (forall s r a. GetRun s r a -> FreeT GetF (GetEff s r) a
unGetRun GetRun s r a
act)

mkGetRun :: Get a -> GetRun s r a
mkGetRun :: forall a s r. Get a -> GetRun s r a
mkGetRun (Get (F forall r. (a -> r) -> (GetF r -> r) -> r
w)) = forall s r a. FreeT GetF (GetEff s r) a -> GetRun s r a
GetRun (forall r. (a -> r) -> (GetF 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)

mkGetEff :: ReadMem r => Get a -> GetEff s r a
mkGetEff :: forall r a s. ReadMem r => Get a -> GetEff s r a
mkGetEff = forall r s a. ReadMem r => GetRun s r a -> GetEff s r a
iterGetRun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s r. Get a -> GetRun s r a
mkGetRun

runGetInternal :: ReadMem r => ByteCount -> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)
runGetInternal :: forall r a.
ReadMem r =>
ByteCount
-> Get a -> ByteCount -> r -> (Either GetError a, ByteCount)
runGetInternal ByteCount
off Get a
act ByteCount
cap r
mem = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let eff :: GetEff s r a
eff = forall r a s. ReadMem r => Get a -> GetEff s r a
mkGetEff Get a
act
  GetEnv s r
env <- forall r s. ByteCount -> ByteCount -> r -> ST s (GetEnv s r)
newGetEnv ByteCount
off ByteCount
cap r
mem
  Either GetError a
ea <- forall s r a.
GetEff s r a -> GetEnv s r -> ST s (Either GetError a)
runGetEff GetEff s r a
eff GetEnv s r
env
  ByteCount
bc <- forall s a. STRef s a -> ST s a
readSTRef (forall s r. GetEnv s r -> STRef s ByteCount
geOff GetEnv s r
env)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GetError a
ea, ByteCount
bc)

-- Put unsafe:

data PutEnv s q = PutEnv
  { forall s (q :: * -> *). PutEnv s q -> STRef s ByteCount
peOff :: !(STRef 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 :: ByteCount -> q s -> ST s (PutEnv s q)
newPutEnv :: forall (q :: * -> *) s. ByteCount -> q s -> ST s (PutEnv s q)
newPutEnv ByteCount
cap q s
mem = do
  STRef s ByteCount
offRef <- forall a s. a -> ST s (STRef s a)
newSTRef ByteCount
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s (q :: * -> *).
STRef s ByteCount -> ByteCount -> q s -> PutEnv s q
PutEnv STRef s ByteCount
offRef ByteCount
cap q s
mem)

newtype PutEff s q a = PutEff {forall s (q :: * -> *) a.
PutEff s q a -> ReaderT (PutEnv s q) (ST s) a
unPutEff :: ReaderT (PutEnv s q) (ST s) a}
  deriving newtype (forall a b. a -> PutEff s q b -> PutEff s q a
forall a b. (a -> b) -> PutEff s q a -> PutEff s q b
forall s (q :: * -> *) a b. a -> PutEff s q b -> PutEff s q a
forall s (q :: * -> *) a b.
(a -> b) -> PutEff s q a -> PutEff s q 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 -> PutEff s q b -> PutEff s q a
$c<$ :: forall s (q :: * -> *) a b. a -> PutEff s q b -> PutEff s q a
fmap :: forall a b. (a -> b) -> PutEff s q a -> PutEff s q b
$cfmap :: forall s (q :: * -> *) a b.
(a -> b) -> PutEff s q a -> PutEff s q b
Functor, forall a. a -> PutEff s q a
forall a b. PutEff s q a -> PutEff s q b -> PutEff s q a
forall a b. PutEff s q a -> PutEff s q b -> PutEff s q b
forall a b. PutEff s q (a -> b) -> PutEff s q a -> PutEff s q b
forall a b c.
(a -> b -> c) -> PutEff s q a -> PutEff s q b -> PutEff s q c
forall s (q :: * -> *). Functor (PutEff s q)
forall s (q :: * -> *) a. a -> PutEff s q a
forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q a
forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q b
forall s (q :: * -> *) a b.
PutEff s q (a -> b) -> PutEff s q a -> PutEff s q b
forall s (q :: * -> *) a b c.
(a -> b -> c) -> PutEff s q a -> PutEff s q b -> PutEff s q 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. PutEff s q a -> PutEff s q b -> PutEff s q a
$c<* :: forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q a
*> :: forall a b. PutEff s q a -> PutEff s q b -> PutEff s q b
$c*> :: forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q b
liftA2 :: forall a b c.
(a -> b -> c) -> PutEff s q a -> PutEff s q b -> PutEff s q c
$cliftA2 :: forall s (q :: * -> *) a b c.
(a -> b -> c) -> PutEff s q a -> PutEff s q b -> PutEff s q c
<*> :: forall a b. PutEff s q (a -> b) -> PutEff s q a -> PutEff s q b
$c<*> :: forall s (q :: * -> *) a b.
PutEff s q (a -> b) -> PutEff s q a -> PutEff s q b
pure :: forall a. a -> PutEff s q a
$cpure :: forall s (q :: * -> *) a. a -> PutEff s q a
Applicative, forall a. a -> PutEff s q a
forall a b. PutEff s q a -> PutEff s q b -> PutEff s q b
forall a b. PutEff s q a -> (a -> PutEff s q b) -> PutEff s q b
forall s (q :: * -> *). Applicative (PutEff s q)
forall s (q :: * -> *) a. a -> PutEff s q a
forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q b
forall s (q :: * -> *) a b.
PutEff s q a -> (a -> PutEff s q b) -> PutEff s q 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 -> PutEff s q a
$creturn :: forall s (q :: * -> *) a. a -> PutEff s q a
>> :: forall a b. PutEff s q a -> PutEff s q b -> PutEff s q b
$c>> :: forall s (q :: * -> *) a b.
PutEff s q a -> PutEff s q b -> PutEff s q b
>>= :: forall a b. PutEff s q a -> (a -> PutEff s q b) -> PutEff s q b
$c>>= :: forall s (q :: * -> *) a b.
PutEff s q a -> (a -> PutEff s q b) -> PutEff s q b
Monad, MonadReader (PutEnv s q))

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

stPutEff :: ST s a -> PutEff s q a
stPutEff :: forall s a (q :: * -> *). ST s a -> PutEff s q a
stPutEff = forall s (q :: * -> *) a.
ReaderT (PutEnv s q) (ST s) a -> PutEff s q 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 s q a = PutRun {forall s (q :: * -> *) a. PutRun s q a -> FreeT PutF (PutEff s q) a
unPutRun :: FreeT PutF (PutEff s q) a}
  deriving newtype (forall a b. a -> PutRun s q b -> PutRun s q a
forall a b. (a -> b) -> PutRun s q a -> PutRun s q b
forall s (q :: * -> *) a b. a -> PutRun s q b -> PutRun s q a
forall s (q :: * -> *) a b.
(a -> b) -> PutRun s q a -> PutRun s q 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 -> PutRun s q b -> PutRun s q a
$c<$ :: forall s (q :: * -> *) a b. a -> PutRun s q b -> PutRun s q a
fmap :: forall a b. (a -> b) -> PutRun s q a -> PutRun s q b
$cfmap :: forall s (q :: * -> *) a b.
(a -> b) -> PutRun s q a -> PutRun s q b
Functor, forall a. a -> PutRun s q a
forall a b. PutRun s q a -> PutRun s q b -> PutRun s q a
forall a b. PutRun s q a -> PutRun s q b -> PutRun s q b
forall a b. PutRun s q (a -> b) -> PutRun s q a -> PutRun s q b
forall a b c.
(a -> b -> c) -> PutRun s q a -> PutRun s q b -> PutRun s q c
forall s (q :: * -> *). Functor (PutRun s q)
forall s (q :: * -> *) a. a -> PutRun s q a
forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q a
forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q b
forall s (q :: * -> *) a b.
PutRun s q (a -> b) -> PutRun s q a -> PutRun s q b
forall s (q :: * -> *) a b c.
(a -> b -> c) -> PutRun s q a -> PutRun s q b -> PutRun s q 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. PutRun s q a -> PutRun s q b -> PutRun s q a
$c<* :: forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q a
*> :: forall a b. PutRun s q a -> PutRun s q b -> PutRun s q b
$c*> :: forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q b
liftA2 :: forall a b c.
(a -> b -> c) -> PutRun s q a -> PutRun s q b -> PutRun s q c
$cliftA2 :: forall s (q :: * -> *) a b c.
(a -> b -> c) -> PutRun s q a -> PutRun s q b -> PutRun s q c
<*> :: forall a b. PutRun s q (a -> b) -> PutRun s q a -> PutRun s q b
$c<*> :: forall s (q :: * -> *) a b.
PutRun s q (a -> b) -> PutRun s q a -> PutRun s q b
pure :: forall a. a -> PutRun s q a
$cpure :: forall s (q :: * -> *) a. a -> PutRun s q a
Applicative, forall a. a -> PutRun s q a
forall a b. PutRun s q a -> PutRun s q b -> PutRun s q b
forall a b. PutRun s q a -> (a -> PutRun s q b) -> PutRun s q b
forall s (q :: * -> *). Applicative (PutRun s q)
forall s (q :: * -> *) a. a -> PutRun s q a
forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q b
forall s (q :: * -> *) a b.
PutRun s q a -> (a -> PutRun s q b) -> PutRun s q 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 -> PutRun s q a
$creturn :: forall s (q :: * -> *) a. a -> PutRun s q a
>> :: forall a b. PutRun s q a -> PutRun s q b -> PutRun s q b
$c>> :: forall s (q :: * -> *) a b.
PutRun s q a -> PutRun s q b -> PutRun s q b
>>= :: forall a b. PutRun s q a -> (a -> PutRun s q b) -> PutRun s q b
$c>>= :: forall s (q :: * -> *) a b.
PutRun s q a -> (a -> PutRun s q b) -> PutRun s q b
Monad)

writeBytes :: ByteCount -> (q s -> ByteCount -> ST s ()) -> PutEff s q ()
writeBytes :: forall (q :: * -> *) s.
ByteCount -> (q s -> ByteCount -> ST s ()) -> PutEff s q ()
writeBytes ByteCount
bc q s -> ByteCount -> ST s ()
f = do
  PutEnv STRef s ByteCount
offRef ByteCount
_ q s
mem <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall s a (q :: * -> *). ST s a -> PutEff s q a
stPutEff forall a b. (a -> b) -> a -> b
$ do
    ByteCount
off <- forall s a. STRef s a -> ST s a
readSTRef STRef s ByteCount
offRef
    q s -> ByteCount -> ST s ()
f q s
mem ByteCount
off
    let newOff :: ByteCount
newOff = ByteCount
off forall a. Num a => a -> a -> a
+ ByteCount
bc
    forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s ByteCount
offRef ByteCount
newOff

writeStaticSeq :: WriteMem q => PutStaticSeqF (PutEff s q a) -> PutEff s q a
writeStaticSeq :: forall (q :: * -> *) s a.
WriteMem q =>
PutStaticSeqF (PutEff s q a) -> PutEff s q a
writeStaticSeq (PutStaticSeqF ElemCount
n Maybe z
mz z -> Put
p Seq z
s PutEff s q 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 :: * -> *) a s. WriteMem q => PutM a -> PutEff s q 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 s q ()
q = forall (q :: * -> *) a s. WriteMem q => PutM a -> PutEff s q 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 s q ()
q
  PutEff s q a
k

writeStaticArray :: WriteMem q => PutStaticArrayF (PutEff s q a) -> PutEff s q a
writeStaticArray :: forall (q :: * -> *) s a.
WriteMem q =>
PutStaticArrayF (PutEff s q a) -> PutEff s q a
writeStaticArray psa :: PutStaticArrayF (PutEff s q a)
psa@(PutStaticArrayF ElemCount
needElems Maybe z
mz a :: LiftedPrimArray z
a@(LiftedPrimArray ByteArray
ba) PutEff s q a
k) = do
  let elemSize :: ByteCount
elemSize = forall a. PutStaticArrayF a -> ByteCount
putStaticArrayElemSize PutStaticArrayF (PutEff s q 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 (q :: * -> *) s.
ByteCount -> (q s -> ByteCount -> ST s ()) -> PutEff s q ()
writeBytes ByteCount
useBc (forall (q :: * -> *) s.
WriteMem q =>
ByteArray -> ByteCount -> ByteCount -> q s -> ByteCount -> ST s ()
copyArrayMemInBytes ByteArray
ba ByteCount
0 ByteCount
useBc)
  let needBc :: ByteCount
needBc = forall a. PutStaticArrayF a -> ByteCount
putStaticArraySize PutStaticArrayF (PutEff s q 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 (q :: * -> *) s.
ByteCount -> (q s -> ByteCount -> ST s ()) -> PutEff s q ()
writeBytes ByteCount
extraBc (forall (q :: * -> *) a s.
(WriteMem q, LiftedPrim a) =>
ByteCount -> a -> q s -> ByteCount -> ST s ()
setMemInBytes ByteCount
extraBc z
z)
  PutEff s q a
k

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

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

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

mkPutRun :: PutM a -> PutRun s q a
mkPutRun :: forall a s (q :: * -> *). PutM a -> PutRun s q a
mkPutRun (PutM (F forall r. (a -> r) -> (PutF r -> r) -> r
w)) = forall s (q :: * -> *) a. FreeT PutF (PutEff s q) a -> PutRun s q 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 => PutM a -> PutEff s q a
mkPutEff :: forall (q :: * -> *) a s. WriteMem q => PutM a -> PutEff s q a
mkPutEff = forall (q :: * -> *) s a.
WriteMem q =>
PutRun s q a -> PutEff s q a
iterPutRun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s (q :: * -> *). PutM a -> PutRun s q a
mkPutRun

runPutUnsafe :: WriteMem q => Put -> ByteCount -> q s -> ST s ByteCount
runPutUnsafe :: forall (q :: * -> *) s.
WriteMem q =>
Put -> ByteCount -> q s -> ST s ByteCount
runPutUnsafe Put
act ByteCount
len q s
mem = do
  let eff :: PutRun s q ()
eff = forall a s (q :: * -> *). PutM a -> PutRun s q a
mkPutRun Put
act
  st :: PutEnv s q
st@(PutEnv STRef s ByteCount
offRef ByteCount
_ q s
_) <- forall (q :: * -> *) s. ByteCount -> q s -> ST s (PutEnv s q)
newPutEnv ByteCount
len q s
mem
  forall (q :: * -> *) s a.
WriteMem q =>
PutRun s q a -> PutEnv s q -> ST s a
runPutRun PutRun s q ()
eff PutEnv s q
st
  forall s a. STRef s a -> ST s a
readSTRef STRef s 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 -> FreeT PutF CountEff a
unCountRun :: FreeT 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f 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) -> FreeT f m a -> m a
iterT forall a. PutF (CountEff a) -> CountEff a
execCountRun (forall a. CountRun a -> FreeT 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. FreeT 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

-- Put safe:

runPutInternal :: WriteMem q => Put -> ByteCount -> (forall s. ByteCount -> ST s (q s)) -> (forall s. q s -> ByteCount -> ByteCount -> ST s z) -> z
runPutInternal :: forall (q :: * -> *) z.
WriteMem q =>
Put
-> ByteCount
-> (forall s. ByteCount -> ST s (q s))
-> (forall s. q s -> ByteCount -> ByteCount -> ST s z)
-> z
runPutInternal Put
act ByteCount
cap forall s. ByteCount -> ST s (q s)
mkMem forall s. q s -> ByteCount -> ByteCount -> ST s z
useMem = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  q s
mem <- forall s. ByteCount -> ST s (q s)
mkMem ByteCount
cap
  case forall (q :: * -> *) s. WriteMem q => q s -> Maybe (IO ())
releaseMem q s
mem of
    Maybe (IO ())
Nothing -> forall (q :: * -> *) s.
WriteMem q =>
Put -> ByteCount -> q s -> ST s ByteCount
runPutUnsafe Put
act ByteCount
cap q s
mem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. q s -> ByteCount -> ByteCount -> ST s z
useMem q s
mem ByteCount
cap
    Just IO ()
rel -> forall a s. IO a -> ST s a
unsafeIOToST (forall a b. IO a -> IO b -> IO a
onException (forall s a. ST s a -> IO a
unsafeSTToIO (forall (q :: * -> *) s.
WriteMem q =>
Put -> ByteCount -> q s -> ST s ByteCount
runPutUnsafe Put
act ByteCount
cap q s
mem forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. q s -> ByteCount -> ByteCount -> ST s z
useMem q s
mem ByteCount
cap)) IO ()
rel)