module Dahdit.Run
  ( GetError (..)
  , prettyGetError
  , runGet
  , runGetIO
  , runGetFile
  , runCount
  , runPut
  , runPutFile
  )
where

import Control.Applicative (Alternative (..))
import Control.Exception (Exception (..), throwIO)
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.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.LiftedPrim (LiftedPrim (..))
import Dahdit.Nums
  ( FloatBE
  , FloatLE
  , Int16BE
  , Int16LE (..)
  , Int24BE
  , Int24LE
  , Int32BE
  , Int32LE
  , Word16BE
  , Word16LE (..)
  , Word24BE
  , Word24LE
  , Word32BE
  , Word32LE
  )
import Dahdit.Proxy (proxyForF)
import Dahdit.Sizes (ByteCount (..), staticByteSize)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as BSS
import Data.ByteString.Short.Internal (ShortByteString (..))
import Data.Foldable (for_, toList)
import Data.Int (Int8)
import Data.Maybe (fromJust)
import Data.Primitive.ByteArray
  ( ByteArray (..)
  , MutableByteArray
  , cloneByteArray
  , copyByteArray
  , indexByteArray
  , newByteArray
  , setByteArray
  , unsafeFreezeByteArray
  , writeByteArray
  )
import Data.Primitive.PrimArray (PrimArray (..), sizeofPrimArray)
import Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)
import qualified Data.Sequence as Seq
import Data.Word (Word8)

-- Sizes:

getStaticSeqSize :: GetStaticSeqF a -> Int
getStaticSeqSize :: forall a. GetStaticSeqF a -> Int
getStaticSeqSize (GetStaticSeqF ElementCount
ec Get z
g Seq z -> a
_) =
  let !z :: Int
z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF Get z
g))
  in  Int
z forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
ec

getStaticArraySize :: GetStaticArrayF a -> Int
getStaticArraySize :: forall a. GetStaticArrayF a -> Int
getStaticArraySize (GetStaticArrayF ElementCount
n Proxy z
prox PrimArray z -> a
_) =
  let !z :: Int
z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize Proxy z
prox)
  in  Int
z forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
n

putStaticSeqSize :: PutStaticSeqF a -> Int
putStaticSeqSize :: forall a. PutStaticSeqF a -> Int
putStaticSeqSize (PutStaticSeqF ElementCount
n Maybe z
_ z -> Put
_ Seq z
s a
_) =
  let !z :: Int
z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF Seq z
s))
  in  Int
z forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
n

putStaticArrayElemSize :: PutStaticArrayF a -> Int
putStaticArrayElemSize :: forall a. PutStaticArrayF a -> Int
putStaticArrayElemSize (PutStaticArrayF ElementCount
_ Maybe z
_ PrimArray z
a a
_) =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF PrimArray z
a))

putStaticArraySize :: PutStaticArrayF a -> Int
putStaticArraySize :: forall a. PutStaticArrayF a -> Int
putStaticArraySize (PutStaticArrayF ElementCount
n Maybe z
_ PrimArray z
a a
_) =
  let !z :: Int
z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF PrimArray z
a))
  in  Int
z forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
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 -> Word64
unByteCount ByteCount
ac) forall a. [a] -> [a] -> [a]
++ String
" bytes, need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Word64
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 -> Word64
unByteCount ByteCount
ac) forall a. [a] -> [a] -> [a]
++ String
" bytes, expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteCount -> Word64
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 = GetEnv
  { forall s. GetEnv s -> Int
geLen :: !Int
  , forall s. GetEnv s -> STRef s Int
gePos :: !(STRef s Int)
  , forall s. GetEnv s -> ByteArray
geArray :: !ByteArray
  }

newGetEnv :: ShortByteString -> ST s (GetEnv s)
newGetEnv :: forall s. ShortByteString -> ST s (GetEnv s)
newGetEnv sbs :: ShortByteString
sbs@(SBS ByteArray#
arr) = do
  let !len :: Int
len = ShortByteString -> Int
BSS.length ShortByteString
sbs
  STRef s Int
pos <- forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall s. Int -> STRef s Int -> ByteArray -> GetEnv s
GetEnv Int
len STRef s Int
pos (ByteArray# -> ByteArray
ByteArray ByteArray#
arr)

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

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

instance MonadFail (GetEff s) where
  fail :: forall a. String -> GetEff s a
fail = forall s a.
ReaderT (GetEnv s) (ExceptT GetError (ST s)) a -> GetEff s 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 a
stGetEff :: forall s a. ST s a -> GetEff s a
stGetEff = forall s a.
ReaderT (GetEnv s) (ExceptT GetError (ST s)) a -> GetEff s 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 a = GetRun {forall s a. GetRun s a -> FreeT GetF (GetEff s) a
unGetRun :: FreeT GetF (GetEff s) a}
  deriving newtype (forall a b. a -> GetRun s b -> GetRun s a
forall a b. (a -> b) -> GetRun s a -> GetRun s b
forall s a b. a -> GetRun s b -> GetRun s a
forall s a b. (a -> b) -> GetRun s a -> GetRun s 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 b -> GetRun s a
$c<$ :: forall s a b. a -> GetRun s b -> GetRun s a
fmap :: forall a b. (a -> b) -> GetRun s a -> GetRun s b
$cfmap :: forall s a b. (a -> b) -> GetRun s a -> GetRun s b
Functor, forall s. Functor (GetRun s)
forall a. a -> GetRun s a
forall s a. a -> GetRun s a
forall a b. GetRun s a -> GetRun s b -> GetRun s a
forall a b. GetRun s a -> GetRun s b -> GetRun s b
forall a b. GetRun s (a -> b) -> GetRun s a -> GetRun s b
forall s a b. GetRun s a -> GetRun s b -> GetRun s a
forall s a b. GetRun s a -> GetRun s b -> GetRun s b
forall s a b. GetRun s (a -> b) -> GetRun s a -> GetRun s b
forall a b c.
(a -> b -> c) -> GetRun s a -> GetRun s b -> GetRun s c
forall s a b c.
(a -> b -> c) -> GetRun s a -> GetRun s b -> GetRun s 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 a -> GetRun s b -> GetRun s a
$c<* :: forall s a b. GetRun s a -> GetRun s b -> GetRun s a
*> :: forall a b. GetRun s a -> GetRun s b -> GetRun s b
$c*> :: forall s a b. GetRun s a -> GetRun s b -> GetRun s b
liftA2 :: forall a b c.
(a -> b -> c) -> GetRun s a -> GetRun s b -> GetRun s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> GetRun s a -> GetRun s b -> GetRun s c
<*> :: forall a b. GetRun s (a -> b) -> GetRun s a -> GetRun s b
$c<*> :: forall s a b. GetRun s (a -> b) -> GetRun s a -> GetRun s b
pure :: forall a. a -> GetRun s a
$cpure :: forall s a. a -> GetRun s a
Applicative, forall s. Applicative (GetRun s)
forall a. a -> GetRun s a
forall s a. a -> GetRun s a
forall a b. GetRun s a -> GetRun s b -> GetRun s b
forall a b. GetRun s a -> (a -> GetRun s b) -> GetRun s b
forall s a b. GetRun s a -> GetRun s b -> GetRun s b
forall s a b. GetRun s a -> (a -> GetRun s b) -> GetRun s 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 a
$creturn :: forall s a. a -> GetRun s a
>> :: forall a b. GetRun s a -> GetRun s b -> GetRun s b
$c>> :: forall s a b. GetRun s a -> GetRun s b -> GetRun s b
>>= :: forall a b. GetRun s a -> (a -> GetRun s b) -> GetRun s b
$c>>= :: forall s a b. GetRun s a -> (a -> GetRun s b) -> GetRun s b
Monad)

guardReadBytes :: String -> Int -> GetEff s Int
guardReadBytes :: forall s. String -> Int -> GetEff s Int
guardReadBytes String
nm Int
bc = do
  GetEnv Int
l STRef s Int
posRef ByteArray
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
pos <- forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef)
  let !ac :: Int
ac = Int
l forall a. Num a => a -> a -> a
- Int
pos
  if Int
bc forall a. Ord a => a -> a -> Bool
> Int
ac
    then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ByteCount -> ByteCount -> GetError
GetErrorParseNeed String
nm (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ac) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc))
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
pos

readBytes :: String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes :: forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
nm Int
bc ByteArray -> Int -> a
f = do
  Int
pos <- forall s. String -> Int -> GetEff s Int
guardReadBytes String
nm Int
bc
  GetEnv Int
_ STRef s Int
posRef ByteArray
arr <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall s a. ST s a -> GetEff s a
stGetEff forall a b. (a -> b) -> a -> b
$ do
    let !a :: a
a = ByteArray -> Int -> a
f ByteArray
arr Int
pos
        !newPos :: Int
newPos = Int
pos forall a. Num a => a -> a -> a
+ Int
bc
    forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
posRef Int
newPos
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

readShortByteString :: Int -> ByteArray -> Int -> ShortByteString
readShortByteString :: Int -> ByteArray -> Int -> ShortByteString
readShortByteString Int
len ByteArray
arr Int
pos = let !(ByteArray ByteArray#
frozArr) = ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
arr Int
pos Int
len in ByteArray# -> ShortByteString
SBS ByteArray#
frozArr

readScope :: GetScopeF (GetEff s a) -> GetEff s a
readScope :: forall s a. GetScopeF (GetEff s a) -> GetEff s a
readScope (GetScopeF ScopeMode
sm ByteCount
bc Get z
g z -> GetEff s a
k) = do
  let intBc :: Int
intBc = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
  GetEnv Int
oldLen STRef s Int
posRef ByteArray
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
oldPos <- forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef)
  let !oldAvail :: Int
oldAvail = Int
oldLen forall a. Num a => a -> a -> a
- Int
oldPos
  if Int
intBc forall a. Ord a => a -> a -> Bool
> Int
oldAvail
    then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ByteCount -> ByteCount -> GetError
GetErrorParseNeed String
"scope" (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oldAvail) ByteCount
bc)
    else do
      let !newLen :: Int
newLen = Int
oldPos forall a. Num a => a -> a -> a
+ Int
intBc
      z
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\GetEnv s
ge -> GetEnv s
ge {geLen :: Int
geLen = Int
newLen}) (forall a s. Get a -> GetEff s a
mkGetEff Get z
g)
      case ScopeMode
sm of
        ScopeMode
ScopeModeWithin -> z -> GetEff s a
k z
a
        ScopeMode
ScopeModeExact -> do
          Int
newPos <- forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef)
          let !actualBc :: Int
actualBc = Int
newPos forall a. Num a => a -> a -> a
- Int
oldPos
          if Int
actualBc forall a. Eq a => a -> a -> Bool
== Int
intBc
            then z -> GetEff s a
k z
a
            else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ByteCount -> ByteCount -> GetError
GetErrorScopedMismatch (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
actualBc) ByteCount
bc)

readStaticSeq :: GetStaticSeqF (GetEff s a) -> GetEff s a
readStaticSeq :: forall s a. GetStaticSeqF (GetEff s a) -> GetEff s a
readStaticSeq gss :: GetStaticSeqF (GetEff s a)
gss@(GetStaticSeqF ElementCount
ec Get z
g Seq z -> GetEff s a
k) = do
  let !bc :: Int
bc = forall a. GetStaticSeqF a -> Int
getStaticSeqSize GetStaticSeqF (GetEff s a)
gss
  Int
_ <- forall s. String -> Int -> GetEff s Int
guardReadBytes String
"static sequence" Int
bc
  Seq z
ss <- forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
Seq.replicateA (forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
ec) (forall a s. Get a -> GetEff s a
mkGetEff Get z
g)
  Seq z -> GetEff s a
k Seq z
ss

readStaticArray :: GetStaticArrayF (GetEff s a) -> GetEff s a
readStaticArray :: forall s a. GetStaticArrayF (GetEff s a) -> GetEff s a
readStaticArray gsa :: GetStaticArrayF (GetEff s a)
gsa@(GetStaticArrayF ElementCount
_ Proxy z
_ PrimArray z -> GetEff s a
k) = do
  let !bc :: Int
bc = forall a. GetStaticArrayF a -> Int
getStaticArraySize GetStaticArrayF (GetEff s a)
gsa
  PrimArray z
sa <- forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"static vector" Int
bc (\ByteArray
arr Int
pos -> let !(ByteArray ByteArray#
frozArr) = ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
arr Int
pos Int
bc in forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
frozArr)
  PrimArray z -> GetEff s a
k PrimArray z
sa

readLookAhead :: GetLookAheadF (GetEff s a) -> GetEff s a
readLookAhead :: forall s a. GetLookAheadF (GetEff s a) -> GetEff s a
readLookAhead (GetLookAheadF Get z
g z -> GetEff s a
k) = do
  STRef s Int
posRef <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall s. GetEnv s -> STRef s Int
gePos
  Int
startPos <- forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef)
  z
a <- forall a s. Get a -> GetEff s a
mkGetEff Get z
g
  forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
posRef Int
startPos)
  z -> GetEff s a
k z
a

execGetRun :: GetF (GetEff s a) -> GetEff s a
execGetRun :: forall s a. GetF (GetEff s a) -> GetEff s a
execGetRun = \case
  GetFWord8 Word8 -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word8" Int
1 (forall a. Prim a => ByteArray -> Int -> a
indexByteArray @Word8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> GetEff s a
k
  GetFInt8 Int8 -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int8" Int
1 (forall a. Prim a => ByteArray -> Int -> a
indexByteArray @Int8) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int8 -> GetEff s a
k
  GetFWord16LE Word16LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word16LE" Int
2 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16LE -> GetEff s a
k
  GetFInt16LE Int16LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int16LE" Int
2 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int16LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16LE -> GetEff s a
k
  GetFWord24LE Word24LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word24LE" Int
3 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24LE -> GetEff s a
k
  GetFInt24LE Int24LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int24LE" Int
3 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int24LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24LE -> GetEff s a
k
  GetFWord32LE Word32LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word32LE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32LE -> GetEff s a
k
  GetFInt32LE Int32LE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int32LE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int32LE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32LE -> GetEff s a
k
  GetFFloatLE FloatLE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"FloatLE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @FloatLE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatLE -> GetEff s a
k
  GetFWord16BE Word16BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word16BE" Int
2 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16BE -> GetEff s a
k
  GetFInt16BE Int16BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int16BE" Int
2 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int16BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int16BE -> GetEff s a
k
  GetFWord24BE Word24BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word24BE" Int
3 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word24BE -> GetEff s a
k
  GetFInt24BE Int24BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int24BE" Int
3 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int24BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int24BE -> GetEff s a
k
  GetFWord32BE Word32BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Word32BE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Word32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32BE -> GetEff s a
k
  GetFInt32BE Int32BE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"Int32BE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @Int32BE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int32BE -> GetEff s a
k
  GetFFloatBE FloatBE -> GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"FloatBE" Int
4 (forall a. LiftedPrim a => ByteArray -> Int -> a
indexByteArrayLiftedInBytes @FloatBE) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatBE -> GetEff s a
k
  GetFShortByteString ByteCount
bc ShortByteString -> GetEff s a
k ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"ShortByteString" Int
len (Int -> ByteArray -> Int -> ShortByteString
readShortByteString Int
len) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ShortByteString -> GetEff s a
k
  GetFStaticSeq GetStaticSeqF (GetEff s a)
gss -> forall s a. GetStaticSeqF (GetEff s a) -> GetEff s a
readStaticSeq GetStaticSeqF (GetEff s a)
gss
  GetFStaticArray GetStaticArrayF (GetEff s a)
gsa -> forall s a. GetStaticArrayF (GetEff s a) -> GetEff s a
readStaticArray GetStaticArrayF (GetEff s a)
gsa
  GetFByteArray ByteCount
bc ByteArray -> GetEff s a
k ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"ByteArray" Int
len (\ByteArray
arr Int
pos -> ByteArray -> Int -> Int -> ByteArray
cloneByteArray ByteArray
arr Int
pos Int
len) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteArray -> GetEff s a
k
  GetFScope GetScopeF (GetEff s a)
gs -> forall s a. GetScopeF (GetEff s a) -> GetEff s a
readScope GetScopeF (GetEff s a)
gs
  GetFSkip ByteCount
bc GetEff s a
k -> forall a s. String -> Int -> (ByteArray -> Int -> a) -> GetEff s a
readBytes String
"skip" (forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc) (\ByteArray
_ Int
_ -> ()) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GetEff s a
k
  GetFLookAhead GetLookAheadF (GetEff s a)
gla -> forall s a. GetLookAheadF (GetEff s a) -> GetEff s a
readLookAhead GetLookAheadF (GetEff s a)
gla
  GetFRemainingSize ByteCount -> GetEff s a
k -> do
    GetEnv Int
len STRef s Int
posRef ByteArray
_ <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Int
pos <- forall s a. ST s a -> GetEff s a
stGetEff (forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef)
    let !bc :: ByteCount
bc = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len forall a. Num a => a -> a -> a
- Int
pos)
    ByteCount -> GetEff s a
k ByteCount
bc
  GetFFail String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

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

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

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

runGet :: Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGet :: forall a.
Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGet Get a
m ShortByteString
bs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let !n :: GetEff s a
n = forall a s. Get a -> GetEff s a
mkGetEff Get a
m
  GetEnv s
env <- forall s. ShortByteString -> ST s (GetEnv s)
newGetEnv ShortByteString
bs
  Either GetError a
ea <- forall s a. GetEff s a -> GetEnv s -> ST s (Either GetError a)
runGetEff GetEff s a
n GetEnv s
env
  Int
bc <- forall s a. STRef s a -> ST s a
readSTRef (forall s. GetEnv s -> STRef s Int
gePos GetEnv s
env)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either GetError a
ea, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc)

runGetIO :: Get a -> ShortByteString -> IO (a, ByteCount)
runGetIO :: forall a. Get a -> ShortByteString -> IO (a, ByteCount)
runGetIO Get a
m ShortByteString
bs =
  let (!Either GetError a
ea, !ByteCount
bc) = forall a.
Get a -> ShortByteString -> (Either GetError a, ByteCount)
runGet Get a
m ShortByteString
bs
  in  case Either GetError a
ea of
        Left GetError
e -> forall e a. Exception e => e -> IO a
throwIO GetError
e
        Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ByteCount
bc)

runGetFile :: Get a -> FilePath -> IO (a, ByteCount)
runGetFile :: forall a. Get a -> String -> IO (a, ByteCount)
runGetFile Get a
m String
fp = do
  ByteString
bs <- String -> IO ByteString
BS.readFile String
fp
  let !bss :: ShortByteString
bss = ByteString -> ShortByteString
BSS.toShort ByteString
bs
  forall a. Get a -> ShortByteString -> IO (a, ByteCount)
runGetIO Get a
m ShortByteString
bss

-- Put unsafe:

data PutEnv s = PutEnv
  { forall s. PutEnv s -> Int
peLen :: !Int
  , forall s. PutEnv s -> STRef s Int
pePos :: !(STRef s Int)
  , forall s. PutEnv s -> MutableByteArray s
peArray :: !(MutableByteArray s)
  }

newPutEnv :: Int -> ST s (PutEnv s)
newPutEnv :: forall s. Int -> ST s (PutEnv s)
newPutEnv Int
len = forall s. Int -> STRef s Int -> MutableByteArray s -> PutEnv s
PutEnv Int
len forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. a -> ST s (STRef s a)
newSTRef Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
len

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

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

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

writeBytes :: Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes :: forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
bc MutableByteArray s -> Int -> ST s ()
f = do
  PutEnv Int
_ STRef s Int
posRef MutableByteArray s
arr <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall s a. ST s a -> PutEff s a
stPutEff forall a b. (a -> b) -> a -> b
$ do
    Int
pos <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef
    MutableByteArray s -> Int -> ST s ()
f MutableByteArray s
arr Int
pos
    let !newPos :: Int
newPos = Int
pos forall a. Num a => a -> a -> a
+ Int
bc
    forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
posRef Int
newPos

writeShortByteString :: ShortByteString -> Int -> MutableByteArray s -> Int -> ST s ()
writeShortByteString :: forall s.
ShortByteString -> Int -> MutableByteArray s -> Int -> ST s ()
writeShortByteString (SBS ByteArray#
frozArr) Int
len MutableByteArray s
arr Int
pos = forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
arr Int
pos (ByteArray# -> ByteArray
ByteArray ByteArray#
frozArr) Int
0 Int
len

writeStaticSeq :: PutStaticSeqF (PutEff s a) -> PutEff s a
writeStaticSeq :: forall s a. PutStaticSeqF (PutEff s a) -> PutEff s a
writeStaticSeq (PutStaticSeqF ElementCount
n Maybe z
mz z -> Put
p Seq z
s PutEff s a
k) = do
  let n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
n
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. Int -> [a] -> [a]
take Int
n' (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq z
s)) forall a b. (a -> b) -> a -> b
$ \z
a -> do
    let !x :: Put
x = z -> Put
p z
a
    forall a s. PutM a -> PutEff s a
mkPutEff Put
x
  let !e :: Int
e = forall a. Seq a -> Int
Seq.length Seq z
s
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n' forall a. Ord a => a -> a -> Bool
<= Int
e) forall a b. (a -> b) -> a -> b
$ do
    let !q :: PutEff s ()
q = forall a s. PutM a -> PutEff s 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_ (Int
n' forall a. Num a => a -> a -> a
- Int
e) PutEff s ()
q
  PutEff s a
k

writeStaticArray :: PutStaticArrayF (PutEff s a) -> PutEff s a
writeStaticArray :: forall s a. PutStaticArrayF (PutEff s a) -> PutEff s a
writeStaticArray psa :: PutStaticArrayF (PutEff s a)
psa@(PutStaticArrayF ElementCount
needElems Maybe z
mz a :: PrimArray z
a@(PrimArray ByteArray#
frozArr) PutEff s a
k) = do
  let !elemSize :: Int
elemSize = forall a. PutStaticArrayF a -> Int
putStaticArrayElemSize PutStaticArrayF (PutEff s a)
psa
      !haveElems :: Int
haveElems = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray z
a
      !useElems :: Int
useElems = forall a. Ord a => a -> a -> a
min Int
haveElems (forall a b. (Integral a, Num b) => a -> b
fromIntegral ElementCount
needElems)
      !useBc :: Int
useBc = Int
elemSize forall a. Num a => a -> a -> a
* Int
useElems
  forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
useBc (\MutableByteArray s
arr Int
pos -> forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
arr Int
pos (ByteArray# -> ByteArray
ByteArray ByteArray#
frozArr) Int
0 Int
useBc)
  let !needBc :: Int
needBc = forall a. PutStaticArrayF a -> Int
putStaticArraySize PutStaticArrayF (PutEff s a)
psa
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
useBc forall a. Eq a => a -> a -> Bool
== Int
needBc) forall a b. (a -> b) -> a -> b
$ do
    let !extraBc :: Int
extraBc = Int
needBc forall a. Num a => a -> a -> a
- Int
useBc
    forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
extraBc (\MutableByteArray s
arr Int
pos -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr (Int
pos forall a. Num a => a -> a -> a
+ Int
useBc) (Int
pos forall a. Num a => a -> a -> a
+ Int
extraBc) (forall a. HasCallStack => Maybe a -> a
fromJust Maybe z
mz))
  PutEff s a
k

execPutRun :: PutF (PutEff s a) -> PutEff s a
execPutRun :: forall s a. PutF (PutEff s a) -> PutEff s a
execPutRun = \case
  PutFWord8 Word8
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
1 (\MutableByteArray s
arr Int
pos -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
arr Int
pos Word8
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt8 Int8
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
1 (\MutableByteArray s
arr Int
pos -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
arr Int
pos Int8
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord16LE Word16LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
2 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word16LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt16LE Int16LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
2 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int16LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord24LE Word24LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
3 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word24LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt24LE Int24LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
3 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int24LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord32LE Word32LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word32LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt32LE Int32LE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int32LE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFFloatLE FloatLE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes FloatLE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord16BE Word16BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
2 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word16BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt16BE Int16BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
2 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int16BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord24BE Word24BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
3 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word24BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt24BE Int24BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
3 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int24BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFWord32BE Word32BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Word32BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFInt32BE Int32BE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes Int32BE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFFloatBE FloatBE
x PutEff s a
k -> forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
4 (forall a (m :: * -> *).
(LiftedPrim a, PrimMonad m) =>
a -> MutableByteArray (PrimState m) -> Int -> m ()
writeByteArrayLiftedInBytes FloatBE
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFShortByteString ByteCount
bc ShortByteString
sbs PutEff s a
k ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
len (forall s.
ShortByteString -> Int -> MutableByteArray s -> Int -> ST s ()
writeShortByteString ShortByteString
sbs Int
len) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFStaticSeq PutStaticSeqF (PutEff s a)
pss -> forall s a. PutStaticSeqF (PutEff s a) -> PutEff s a
writeStaticSeq PutStaticSeqF (PutEff s a)
pss
  PutFStaticArray PutStaticArrayF (PutEff s a)
psa -> forall s a. PutStaticArrayF (PutEff s a) -> PutEff s a
writeStaticArray PutStaticArrayF (PutEff s a)
psa
  PutFByteArray ByteCount
bc ByteArray
barr PutEff s a
k ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall s.
Int -> (MutableByteArray s -> Int -> ST s ()) -> PutEff s ()
writeBytes Int
len (\MutableByteArray s
arr Int
pos -> forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray MutableByteArray s
arr Int
pos ByteArray
barr Int
0 Int
len) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k
  PutFStaticHint (PutStaticHintF ByteCount
_ Put
p PutEff s a
k) -> forall a s. PutM a -> PutEff s a
mkPutEff Put
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutEff s a
k

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

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

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

runPutUnsafe :: Put -> ByteCount -> ShortByteString
runPutUnsafe :: Put -> ByteCount -> ShortByteString
runPutUnsafe Put
m ByteCount
bc = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
      !n :: PutRun s ()
n = forall a s. PutM a -> PutRun s a
mkPutRun Put
m
  st :: PutEnv s
st@(PutEnv Int
_ STRef s Int
posRef MutableByteArray s
arr) <- forall s. Int -> ST s (PutEnv s)
newPutEnv Int
len
  forall s a. PutRun s a -> PutEnv s -> ST s a
runPutRun PutRun s ()
n PutEnv s
st
  Int
pos <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
posRef
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
pos forall a. Eq a => a -> a -> Bool
== Int
len) (forall a. HasCallStack => String -> a
error (String
"Invalid put length: (given " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
len forall a. [a] -> [a] -> [a]
++ String
", used " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
pos forall a. [a] -> [a] -> [a]
++ String
")"))
  ByteArray ByteArray#
frozArr <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
arr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! ByteArray# -> ShortByteString
SBS ByteArray#
frozArr

-- Count:

newtype CountEff a = CountEff {forall a. CountEff a -> MaybeT (State Int) a
unCountEff :: MaybeT (State Int) 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 Int)

runCountEff :: CountEff a -> Int -> (Maybe a, Int)
runCountEff :: forall a. CountEff a -> Int -> (Maybe a, Int)
runCountEff CountEff a
m = 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 Int) a
unCountEff CountEff a
m))

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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
4 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' (Int
4 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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
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' (Int
4 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' (Int
4 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 ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (Int
len 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 ElementCount
_ Maybe z
_ z -> Put
_ Seq z
_ CountEff a
k) ->
    let !len :: Int
len = forall a. PutStaticSeqF a -> Int
putStaticSeqSize PutStaticSeqF (CountEff a)
pss
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (Int
len 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 ElementCount
_ Maybe z
_ PrimArray z
_ CountEff a
k) ->
    let !len :: Int
len = forall a. PutStaticArrayF a -> Int
putStaticArraySize PutStaticArrayF (CountEff a)
psv
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (Int
len 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 ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (Int
len 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) ->
    let !len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
bc
    in  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (Int
len 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 -> Int -> (Maybe a, Int)
runCountRun :: forall a. CountRun a -> Int -> (Maybe a, Int)
runCountRun = forall a. CountEff a -> Int -> (Maybe a, Int)
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
m = 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
m)

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
m =
  let !n :: CountRun ()
n = forall a. PutM a -> CountRun a
mkCountRun Put
m
      (Maybe ()
_, !Int
bc) = forall a. CountRun a -> Int -> (Maybe a, Int)
runCountRun CountRun ()
n Int
0
  in  forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc

-- Put safe:

runPut :: Put -> ShortByteString
runPut :: Put -> ShortByteString
runPut Put
m = let !bc :: ByteCount
bc = Put -> ByteCount
runCount Put
m in Put -> ByteCount -> ShortByteString
runPutUnsafe Put
m ByteCount
bc

-- Put file:

runPutFile :: FilePath -> Put -> IO ()
runPutFile :: String -> Put -> IO ()
runPutFile String
fp Put
m =
  let !bs :: ShortByteString
bs = Put -> ShortByteString
runPut Put
m
      !bs' :: ByteString
bs' = ShortByteString -> ByteString
BSS.fromShort ShortByteString
bs
  in  String -> ByteString -> IO ()
BS.writeFile String
fp ByteString
bs'