{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- Module      : Data.MemPack
-- Copyright   : (c) Alexey Kuleshevich 2024
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
module Data.MemPack (
  Pack (..),
  Unpack (..),
  MemPack (..),

  -- * Packing
  pack,
  packByteString,
  packShortByteString,

  -- ** Generalized
  packByteArray,
  packWithByteArray,
  packMutableByteArray,
  packWithMutableByteArray,

  -- ** Helpers
  packIncrement,
  guardAdvanceUnpack,

  -- * Unpacking
  unpack,
  unpackFail,
  unpackMonadFail,
  unpackError,
  unpackLeftOver,

  -- ** Helpers
  failUnpack,
  unpackByteArray,
  unpackByteArrayLen,
  packByteStringM,
  unpackByteStringM,

  -- * Helper packers
  VarLen (..),
  Length (..),
  Tag (..),
  packTagM,
  unpackTagM,
  unknownTagM,
  packedTagByteCount,

  -- * Internal utilities
  replicateTailM,
  lift_#,
  st_,

  -- * Re-exports for @GeneralizedNewtypeDeriving@
  StateT (..),
  FailT (..),
) where

#include "MachDeps.h"

import Control.Applicative (Alternative (..))
import Control.Monad (join, unless, when)
import qualified Control.Monad.Fail as F
import Control.Monad.Reader (MonadReader (..), lift)
import Control.Monad.State.Strict (MonadState (..), StateT (..), execStateT)
import Control.Monad.Trans.Fail (Fail, FailT (..), errorFail, failT, runFailAgg)
import Data.Array.Byte (ByteArray (..), MutableByteArray (..))
import Data.Bifunctor (first)
import Data.Bits (Bits (..), FiniteBits (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Internal as BSL
import Data.ByteString.Short (ShortByteString)
import Data.Char (ord)
import Data.Complex (Complex (..))
import Data.List (intercalate)
import Data.MemPack.Buffer
import Data.MemPack.Error
import Data.Ratio
import Data.Semigroup (Sum (..))
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Array as T
#endif
import qualified Data.Text.Encoding as T
import Data.Text.Internal (Text (..))
import Data.Typeable
import Data.Void (Void, absurd)
import GHC.Exts
import GHC.Int
import GHC.ST (ST (..), runST)
import GHC.Stable (StablePtr (..))
import GHC.Stack (HasCallStack)
import GHC.Word
import Numeric (showHex)
import Prelude hiding (fail)
#if __GLASGOW_HASKELL__ >= 900
import GHC.Num.Integer (Integer (..), integerCheck)
import GHC.Num.Natural (Natural (..), naturalCheck)
#elif defined(MIN_VERSION_integer_gmp)
import GHC.Integer.GMP.Internals (Integer (..), BigNat(BN#), isValidInteger#)
import GHC.Natural (Natural (..), isValidNatural)
#else
#error "Only integer-gmp is supported for now for older compilers"
#endif
#if !(MIN_VERSION_base(4,13,0))
import Prelude (fail)
#endif

-- | Monad that is used for serializing data into a `MutableByteArray`. It is based on
-- `StateT` that tracks the current index into the `MutableByteArray` where next write is
-- expected to happen.
newtype Pack s a = Pack
  { forall s a. Pack s a -> MutableByteArray s -> StateT Int (ST s) a
runPack :: MutableByteArray s -> StateT Int (ST s) a
  }

instance Functor (Pack s) where
  fmap :: forall a b. (a -> b) -> Pack s a -> Pack s b
fmap a -> b
f (Pack MutableByteArray s -> StateT Int (ST s) a
p) = (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) b) -> Pack s b)
-> (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
buf -> (a -> b) -> StateT Int (ST s) a -> StateT Int (ST s) b
forall a b. (a -> b) -> StateT Int (ST s) a -> StateT Int (ST s) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (MutableByteArray s -> StateT Int (ST s) a
p MutableByteArray s
buf)
  {-# INLINE fmap #-}
instance Applicative (Pack s) where
  pure :: forall a. a -> Pack s a
pure = (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) a) -> Pack s a)
-> (a -> MutableByteArray s -> StateT Int (ST s) a)
-> a
-> Pack s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (ST s) a -> MutableByteArray s -> StateT Int (ST s) a
forall a b. a -> b -> a
const (StateT Int (ST s) a -> MutableByteArray s -> StateT Int (ST s) a)
-> (a -> StateT Int (ST s) a)
-> a
-> MutableByteArray s
-> StateT Int (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT Int (ST s) a
forall a. a -> StateT Int (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  Pack MutableByteArray s -> StateT Int (ST s) (a -> b)
a1 <*> :: forall a b. Pack s (a -> b) -> Pack s a -> Pack s b
<*> Pack MutableByteArray s -> StateT Int (ST s) a
a2 =
    (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) b) -> Pack s b)
-> (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
buf -> MutableByteArray s -> StateT Int (ST s) (a -> b)
a1 MutableByteArray s
buf StateT Int (ST s) (a -> b)
-> StateT Int (ST s) a -> StateT Int (ST s) b
forall a b.
StateT Int (ST s) (a -> b)
-> StateT Int (ST s) a -> StateT Int (ST s) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MutableByteArray s -> StateT Int (ST s) a
a2 MutableByteArray s
buf
  {-# INLINE (<*>) #-}
  Pack MutableByteArray s -> StateT Int (ST s) a
a1 *> :: forall a b. Pack s a -> Pack s b -> Pack s b
*> Pack MutableByteArray s -> StateT Int (ST s) b
a2 =
    (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) b) -> Pack s b)
-> (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
buf -> MutableByteArray s -> StateT Int (ST s) a
a1 MutableByteArray s
buf StateT Int (ST s) a -> StateT Int (ST s) b -> StateT Int (ST s) b
forall a b.
StateT Int (ST s) a -> StateT Int (ST s) b -> StateT Int (ST s) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MutableByteArray s -> StateT Int (ST s) b
a2 MutableByteArray s
buf
  {-# INLINE (*>) #-}
instance Monad (Pack s) where
  Pack MutableByteArray s -> StateT Int (ST s) a
m1 >>= :: forall a b. Pack s a -> (a -> Pack s b) -> Pack s b
>>= a -> Pack s b
p =
    (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) b) -> Pack s b)
-> (MutableByteArray s -> StateT Int (ST s) b) -> Pack s b
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
buf -> MutableByteArray s -> StateT Int (ST s) a
m1 MutableByteArray s
buf StateT Int (ST s) a
-> (a -> StateT Int (ST s) b) -> StateT Int (ST s) b
forall a b.
StateT Int (ST s) a
-> (a -> StateT Int (ST s) b) -> StateT Int (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
res -> Pack s b -> MutableByteArray s -> StateT Int (ST s) b
forall s a. Pack s a -> MutableByteArray s -> StateT Int (ST s) a
runPack (a -> Pack s b
p a
res) MutableByteArray s
buf
  {-# INLINE (>>=) #-}
instance MonadReader (MutableByteArray s) (Pack s) where
  ask :: Pack s (MutableByteArray s)
ask = (MutableByteArray s -> StateT Int (ST s) (MutableByteArray s))
-> Pack s (MutableByteArray s)
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack MutableByteArray s -> StateT Int (ST s) (MutableByteArray s)
forall a. a -> StateT Int (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE ask #-}
  local :: forall a.
(MutableByteArray s -> MutableByteArray s) -> Pack s a -> Pack s a
local MutableByteArray s -> MutableByteArray s
f (Pack MutableByteArray s -> StateT Int (ST s) a
p) = (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack (MutableByteArray s -> StateT Int (ST s) a
p (MutableByteArray s -> StateT Int (ST s) a)
-> (MutableByteArray s -> MutableByteArray s)
-> MutableByteArray s
-> StateT Int (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableByteArray s -> MutableByteArray s
f)
  {-# INLINE local #-}
  reader :: forall a. (MutableByteArray s -> a) -> Pack s a
reader MutableByteArray s -> a
f = (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack (a -> StateT Int (ST s) a
forall a. a -> StateT Int (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StateT Int (ST s) a)
-> (MutableByteArray s -> a)
-> MutableByteArray s
-> StateT Int (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableByteArray s -> a
f)
  {-# INLINE reader #-}
instance MonadState Int (Pack s) where
  get :: Pack s Int
get = (MutableByteArray s -> StateT Int (ST s) Int) -> Pack s Int
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) Int) -> Pack s Int)
-> (MutableByteArray s -> StateT Int (ST s) Int) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ StateT Int (ST s) Int
-> MutableByteArray s -> StateT Int (ST s) Int
forall a b. a -> b -> a
const StateT Int (ST s) Int
forall s (m :: * -> *). MonadState s m => m s
get
  {-# INLINE get #-}
  put :: Int -> Pack s ()
put = (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ())
-> (Int -> MutableByteArray s -> StateT Int (ST s) ())
-> Int
-> Pack s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (ST s) () -> MutableByteArray s -> StateT Int (ST s) ()
forall a b. a -> b -> a
const (StateT Int (ST s) ()
 -> MutableByteArray s -> StateT Int (ST s) ())
-> (Int -> StateT Int (ST s) ())
-> Int
-> MutableByteArray s
-> StateT Int (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StateT Int (ST s) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  {-# INLINE put #-}
  state :: forall a. (Int -> (a, Int)) -> Pack s a
state = (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) a) -> Pack s a)
-> ((Int -> (a, Int)) -> MutableByteArray s -> StateT Int (ST s) a)
-> (Int -> (a, Int))
-> Pack s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (ST s) a -> MutableByteArray s -> StateT Int (ST s) a
forall a b. a -> b -> a
const (StateT Int (ST s) a -> MutableByteArray s -> StateT Int (ST s) a)
-> ((Int -> (a, Int)) -> StateT Int (ST s) a)
-> (Int -> (a, Int))
-> MutableByteArray s
-> StateT Int (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (a, Int)) -> StateT Int (ST s) a
forall a. (Int -> (a, Int)) -> StateT Int (ST s) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
  {-# INLINE state #-}

-- | Monad that is used for deserializing data from a memory `Buffer`. It is based on
-- `StateT` that tracks the current index into the @`Buffer` a@, from where the next read
-- suppose to happen. Unpacking can `F.fail` with `F.MonadFail` instance or with
-- `failUnpack` that provides a more type safe way of failing using `Error` interface.
newtype Unpack b a = Unpack
  { forall b a. Unpack b a -> b -> StateT Int (Fail SomeError) a
runUnpack :: b -> StateT Int (Fail SomeError) a
  }

instance Functor (Unpack s) where
  fmap :: forall a b. (a -> b) -> Unpack s a -> Unpack s b
fmap a -> b
f (Unpack s -> StateT Int (Fail SomeError) a
p) = (s -> StateT Int (Fail SomeError) b) -> Unpack s b
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((s -> StateT Int (Fail SomeError) b) -> Unpack s b)
-> (s -> StateT Int (Fail SomeError) b) -> Unpack s b
forall a b. (a -> b) -> a -> b
$ \s
buf -> (a -> b)
-> StateT Int (Fail SomeError) a -> StateT Int (Fail SomeError) b
forall a b.
(a -> b)
-> StateT Int (Fail SomeError) a -> StateT Int (Fail SomeError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (s -> StateT Int (Fail SomeError) a
p s
buf)
  {-# INLINE fmap #-}
instance Applicative (Unpack b) where
  pure :: forall a. a -> Unpack b a
pure = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> (a -> b -> StateT Int (Fail SomeError) a) -> a -> Unpack b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (Fail SomeError) a -> b -> StateT Int (Fail SomeError) a
forall a b. a -> b -> a
const (StateT Int (Fail SomeError) a
 -> b -> StateT Int (Fail SomeError) a)
-> (a -> StateT Int (Fail SomeError) a)
-> a
-> b
-> StateT Int (Fail SomeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT Int (Fail SomeError) a
forall a. a -> StateT Int (Fail SomeError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  Unpack b -> StateT Int (Fail SomeError) (a -> b)
a1 <*> :: forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
<*> Unpack b -> StateT Int (Fail SomeError) a
a2 =
    (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) b) -> Unpack b b)
-> (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall a b. (a -> b) -> a -> b
$ \b
buf -> b -> StateT Int (Fail SomeError) (a -> b)
a1 b
buf StateT Int (Fail SomeError) (a -> b)
-> StateT Int (Fail SomeError) a -> StateT Int (Fail SomeError) b
forall a b.
StateT Int (Fail SomeError) (a -> b)
-> StateT Int (Fail SomeError) a -> StateT Int (Fail SomeError) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> StateT Int (Fail SomeError) a
a2 b
buf
  {-# INLINE (<*>) #-}
  Unpack b -> StateT Int (Fail SomeError) a
a1 *> :: forall a b. Unpack b a -> Unpack b b -> Unpack b b
*> Unpack b -> StateT Int (Fail SomeError) b
a2 =
    (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) b) -> Unpack b b)
-> (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall a b. (a -> b) -> a -> b
$ \b
buf -> b -> StateT Int (Fail SomeError) a
a1 b
buf StateT Int (Fail SomeError) a
-> StateT Int (Fail SomeError) b -> StateT Int (Fail SomeError) b
forall a b.
StateT Int (Fail SomeError) a
-> StateT Int (Fail SomeError) b -> StateT Int (Fail SomeError) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> b -> StateT Int (Fail SomeError) b
a2 b
buf
  {-# INLINE (*>) #-}
instance Monad (Unpack b) where
  Unpack b -> StateT Int (Fail SomeError) a
m1 >>= :: forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
>>= a -> Unpack b b
p =
    (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) b) -> Unpack b b)
-> (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall a b. (a -> b) -> a -> b
$ \b
buf -> b -> StateT Int (Fail SomeError) a
m1 b
buf StateT Int (Fail SomeError) a
-> (a -> StateT Int (Fail SomeError) b)
-> StateT Int (Fail SomeError) b
forall a b.
StateT Int (Fail SomeError) a
-> (a -> StateT Int (Fail SomeError) b)
-> StateT Int (Fail SomeError) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
res -> Unpack b b -> b -> StateT Int (Fail SomeError) b
forall b a. Unpack b a -> b -> StateT Int (Fail SomeError) a
runUnpack (a -> Unpack b b
p a
res) b
buf
  {-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
  fail = Unpack . const . F.fail
#endif
instance F.MonadFail (Unpack b) where
  fail :: forall a. String -> Unpack b a
fail = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> (String -> b -> StateT Int (Fail SomeError) a)
-> String
-> Unpack b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (Fail SomeError) a -> b -> StateT Int (Fail SomeError) a
forall a b. a -> b -> a
const (StateT Int (Fail SomeError) a
 -> b -> StateT Int (Fail SomeError) a)
-> (String -> StateT Int (Fail SomeError) a)
-> String
-> b
-> StateT Int (Fail SomeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StateT Int (Fail SomeError) a
forall a. String -> StateT Int (Fail SomeError) a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail
instance MonadReader b (Unpack b) where
  ask :: Unpack b b
ask = (b -> StateT Int (Fail SomeError) b) -> Unpack b b
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack b -> StateT Int (Fail SomeError) b
forall a. a -> StateT Int (Fail SomeError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE ask #-}
  local :: forall a. (b -> b) -> Unpack b a -> Unpack b a
local b -> b
f (Unpack b -> StateT Int (Fail SomeError) a
p) = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack (b -> StateT Int (Fail SomeError) a
p (b -> StateT Int (Fail SomeError) a)
-> (b -> b) -> b -> StateT Int (Fail SomeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
f)
  {-# INLINE local #-}
  reader :: forall a. (b -> a) -> Unpack b a
reader b -> a
f = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack (a -> StateT Int (Fail SomeError) a
forall a. a -> StateT Int (Fail SomeError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> StateT Int (Fail SomeError) a)
-> (b -> a) -> b -> StateT Int (Fail SomeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  {-# INLINE reader #-}
instance MonadState Int (Unpack b) where
  get :: Unpack b Int
get = (b -> StateT Int (Fail SomeError) Int) -> Unpack b Int
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) Int) -> Unpack b Int)
-> (b -> StateT Int (Fail SomeError) Int) -> Unpack b Int
forall a b. (a -> b) -> a -> b
$ StateT Int (Fail SomeError) Int
-> b -> StateT Int (Fail SomeError) Int
forall a b. a -> b -> a
const StateT Int (Fail SomeError) Int
forall s (m :: * -> *). MonadState s m => m s
get
  {-# INLINE get #-}
  put :: Int -> Unpack b ()
put = (b -> StateT Int (Fail SomeError) ()) -> Unpack b ()
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) ()) -> Unpack b ())
-> (Int -> b -> StateT Int (Fail SomeError) ())
-> Int
-> Unpack b ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (Fail SomeError) ()
-> b -> StateT Int (Fail SomeError) ()
forall a b. a -> b -> a
const (StateT Int (Fail SomeError) ()
 -> b -> StateT Int (Fail SomeError) ())
-> (Int -> StateT Int (Fail SomeError) ())
-> Int
-> b
-> StateT Int (Fail SomeError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StateT Int (Fail SomeError) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  {-# INLINE put #-}
  state :: forall a. (Int -> (a, Int)) -> Unpack b a
state = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> ((Int -> (a, Int)) -> b -> StateT Int (Fail SomeError) a)
-> (Int -> (a, Int))
-> Unpack b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Int (Fail SomeError) a -> b -> StateT Int (Fail SomeError) a
forall a b. a -> b -> a
const (StateT Int (Fail SomeError) a
 -> b -> StateT Int (Fail SomeError) a)
-> ((Int -> (a, Int)) -> StateT Int (Fail SomeError) a)
-> (Int -> (a, Int))
-> b
-> StateT Int (Fail SomeError) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (a, Int)) -> StateT Int (Fail SomeError) a
forall a. (Int -> (a, Int)) -> StateT Int (Fail SomeError) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
  {-# INLINE state #-}

instance Alternative (Unpack b) where
  empty :: forall a. Unpack b a
empty = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall a b. (a -> b) -> a -> b
$ \b
_ -> Fail SomeError a -> StateT Int (Fail SomeError) a
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Fail SomeError a
forall a. Fail SomeError a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE empty #-}
  Unpack b -> StateT Int (Fail SomeError) a
r1 <|> :: forall a. Unpack b a -> Unpack b a -> Unpack b a
<|> Unpack b -> StateT Int (Fail SomeError) a
r2 =
    (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall a b. (a -> b) -> a -> b
$ \b
buf ->
      case b -> StateT Int (Fail SomeError) a
r1 b
buf of
        StateT Int -> Fail SomeError (a, Int)
m1 ->
          case b -> StateT Int (Fail SomeError) a
r2 b
buf of
            StateT Int -> Fail SomeError (a, Int)
m2 -> (Int -> Fail SomeError (a, Int)) -> StateT Int (Fail SomeError) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Int -> Fail SomeError (a, Int)) -> StateT Int (Fail SomeError) a)
-> (Int -> Fail SomeError (a, Int))
-> StateT Int (Fail SomeError) a
forall a b. (a -> b) -> a -> b
$ \Int
s -> Int -> Fail SomeError (a, Int)
m1 Int
s Fail SomeError (a, Int)
-> Fail SomeError (a, Int) -> Fail SomeError (a, Int)
forall a.
FailT SomeError Identity a
-> FailT SomeError Identity a -> FailT SomeError Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Fail SomeError (a, Int)
m2 Int
s
  {-# INLINE (<|>) #-}

-- | Failing unpacking with an `Error`.
failUnpack :: Error e => e -> Unpack b a
failUnpack :: forall e b a. Error e => e -> Unpack b a
failUnpack e
e = (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall b a. (b -> StateT Int (Fail SomeError) a) -> Unpack b a
Unpack ((b -> StateT Int (Fail SomeError) a) -> Unpack b a)
-> (b -> StateT Int (Fail SomeError) a) -> Unpack b a
forall a b. (a -> b) -> a -> b
$ \b
_ -> Fail SomeError a -> StateT Int (Fail SomeError) a
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Fail SomeError a -> StateT Int (Fail SomeError) a)
-> Fail SomeError a -> StateT Int (Fail SomeError) a
forall a b. (a -> b) -> a -> b
$ SomeError -> Fail SomeError a
forall (m :: * -> *) e a. Applicative m => e -> FailT e m a
failT (e -> SomeError
forall e. Error e => e -> SomeError
toSomeError e
e)

-- | Efficient serialization interface that operates directly on memory buffers.
class MemPack a where
  -- | Name of the type that is being deserialized for error reporting. Default
  -- implementation relies on `Typeable`.
  typeName :: String
  default typeName :: Typeable a => String
  typeName = TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

  -- | Report the exact size in number of bytes that packed version of this type will
  -- occupy. It is very important to get this right, otherwise `packM` will result in a
  -- runtime exception. Another words this is the expected property that it should hold:
  --
  -- prop> packedByteCount a == bufferByteCount (pack a)
  packedByteCount :: a -> Int

  -- | Write binary representation of a type into the `MutableByteArray` which can be
  -- accessed with `ask`, whenever direct operations on it are necessary.
  packM :: a -> Pack s ()

  -- | Read binary representation of the type directly from the buffer, which can be
  -- accessed with `ask` when necessary. Direct reads from the buffer should be preceded
  -- with advancing the buffer offset with `MonadState` by the number of bytes that will
  -- be consumed from the buffer and making sure that no reads outside of the buffer can
  -- happen. Violation of these rules will lead to segfaults.
  unpackM :: Buffer b => Unpack b a

instance MemPack () where
  packedByteCount :: () -> Int
packedByteCount ()
_ = Int
0
  {-# INLINE packedByteCount #-}
  packM :: forall s. () -> Pack s ()
packM () = () -> Pack s ()
forall a. a -> Pack s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b ()
unpackM = () -> Unpack b ()
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE unpackM #-}

instance MemPack Void where
  packedByteCount :: Void -> Int
packedByteCount Void
_ = Int
0
  packM :: forall s. Void -> Pack s ()
packM = Void -> Pack s ()
forall a. Void -> a
absurd
  unpackM :: forall b. Buffer b => Unpack b Void
unpackM = String -> Unpack b Void
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
"Void is unpackable"

instance MemPack Bool where
  packedByteCount :: Bool -> Int
packedByteCount Bool
_ = Int
packedTagByteCount
  {-# INLINE packedByteCount #-}
  packM :: forall s. Bool -> Pack s ()
packM Bool
x = Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM (Tag -> Pack s ()) -> Tag -> Pack s ()
forall a b. (a -> b) -> a -> b
$ if Bool
x then Tag
1 else Tag
0
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Bool
unpackM =
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag -> (Tag -> Unpack b Bool) -> Unpack b Bool
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> Bool -> Unpack b Bool
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Tag
1 -> Bool -> Unpack b Bool
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Tag
n -> String -> Unpack b Bool
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b Bool) -> String -> Unpack b Bool
forall a b. (a -> b) -> a -> b
$ String
"Invalid value detected for Bool: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tag -> String
forall a. Show a => a -> String
show Tag
n
  {-# INLINE unpackM #-}

instance MemPack a => MemPack (Maybe a) where
  typeName :: String
typeName = String
"Maybe " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a
  packedByteCount :: Maybe a -> Int
packedByteCount = \case
    Maybe a
Nothing -> Int
packedTagByteCount
    Just a
a -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a
  {-# INLINE packedByteCount #-}
  packM :: forall s. Maybe a -> Pack s ()
packM = \case
    Maybe a
Nothing -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0
    Just a
a -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Maybe a)
unpackM =
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag -> (Tag -> Unpack b (Maybe a)) -> Unpack b (Maybe a)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> Maybe a -> Unpack b (Maybe a)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      Tag
1 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Unpack b a -> Unpack b (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(Maybe a) Tag
n
  {-# INLINE unpackM #-}

instance (MemPack a, MemPack b) => MemPack (Either a b) where
  typeName :: String
typeName = String
"Either " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @b
  packedByteCount :: Either a b -> Int
packedByteCount = \case
    Left a
a -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a
    Right b
b -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b
  {-# INLINE packedByteCount #-}
  packM :: forall s. Either a b -> Pack s ()
packM = \case
    Left a
a -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a
    Right b
b -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Either a b)
unpackM =
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag
-> (Tag -> Unpack b (Either a b)) -> Unpack b (Either a b)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Unpack b a -> Unpack b (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
1 -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Unpack b b -> Unpack b (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(Either a b) Tag
n
  {-# INLINE unpackM #-}

instance MemPack Char where
  packedByteCount :: Char -> Int
packedByteCount Char
_ = SIZEOF_HSCHAR
  {-# INLINE packedByteCount #-}
  packM :: forall s. Char -> Pack s ()
packM a :: Char
a@(C# Char#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Char -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Char
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWord8ArrayAsWideChar# MutableByteArray# s
mba# Int#
i# Char#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Char
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_HSCHAR
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    let c :: Char
c =
          b -> (ByteArray# -> Char) -> (Addr# -> Char) -> Char
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
            b
buf
            (\ByteArray#
ba# -> Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexWord8ArrayAsWideChar# ByteArray#
ba# Int#
i#))
            (\Addr#
addr# -> Char# -> Char
C# (Addr# -> Int# -> Char#
indexWideCharOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
    Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x10FFFF) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$
      String -> Unpack b ()
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b ()) -> String -> Unpack b ()
forall a b. (a -> b) -> a -> b
$
        String
"Out of bounds Char was detected: '\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Integral a => a -> String -> String
showHex (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String
"'"
    Char -> Unpack b Char
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
  {-# INLINE unpackM #-}

instance MemPack Float where
  packedByteCount :: Float -> Int
packedByteCount Float
_ = SIZEOF_FLOAT
  {-# INLINE packedByteCount #-}
  packM :: forall s. Float -> Pack s ()
packM a :: Float
a@(F# Float#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Float -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Float
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeWord8ArrayAsFloat# MutableByteArray# s
mba# Int#
i# Float#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Float
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_FLOAT
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Float -> Unpack b Float
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Unpack b Float) -> Float -> Unpack b Float
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Float) -> (Addr# -> Float) -> Float
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexWord8ArrayAsFloat# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Float# -> Float
F# (Addr# -> Int# -> Float#
indexFloatOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Double where
  packedByteCount :: Double -> Int
packedByteCount Double
_ = SIZEOF_DOUBLE
  {-# INLINE packedByteCount #-}
  packM :: forall s. Double -> Pack s ()
packM a :: Double
a@(D# Double#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Double -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Double
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeWord8ArrayAsDouble# MutableByteArray# s
mba# Int#
i# Double#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Double
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_DOUBLE
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Double -> Unpack b Double
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Unpack b Double) -> Double -> Unpack b Double
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Double) -> (Addr# -> Double) -> Double
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Double# -> Double
D# (ByteArray# -> Int# -> Double#
indexWord8ArrayAsDouble# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Double# -> Double
D# (Addr# -> Int# -> Double#
indexDoubleOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack (Ptr a) where
  typeName :: String
typeName = String
"Ptr"
  packedByteCount :: Ptr a -> Int
packedByteCount Ptr a
_ = SIZEOF_HSPTR
  {-# INLINE packedByteCount #-}
  packM :: forall s. Ptr a -> Pack s ()
packM a :: Ptr a
a@(Ptr Addr#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Ptr a -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Ptr a
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeWord8ArrayAsAddr# MutableByteArray# s
mba# Int#
i# Addr#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Ptr a)
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_HSPTR
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Ptr a -> Unpack b (Ptr a)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr a -> Unpack b (Ptr a)) -> Ptr a -> Unpack b (Ptr a)
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Ptr a) -> (Addr# -> Ptr a) -> Ptr a
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Int# -> Addr#
indexWord8ArrayAsAddr# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (Addr# -> Int# -> Addr#
indexAddrOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack (StablePtr a) where
  typeName :: String
typeName = String
"StablePtr"
  packedByteCount :: StablePtr a -> Int
packedByteCount StablePtr a
_ = SIZEOF_HSSTABLEPTR
  {-# INLINE packedByteCount #-}
  packM :: forall s. StablePtr a -> Pack s ()
packM a :: StablePtr a
a@(StablePtr StablePtr# a
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- StablePtr a -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement StablePtr a
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
forall d a.
MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeWord8ArrayAsStablePtr# MutableByteArray# s
mba# Int#
i# StablePtr# a
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (StablePtr a)
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_HSSTABLEPTR
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    StablePtr a -> Unpack b (StablePtr a)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StablePtr a -> Unpack b (StablePtr a))
-> StablePtr a -> Unpack b (StablePtr a)
forall a b. (a -> b) -> a -> b
$!
      b
-> (ByteArray# -> StablePtr a)
-> (Addr# -> StablePtr a)
-> StablePtr a
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (ByteArray# -> Int# -> StablePtr# a
forall a. ByteArray# -> Int# -> StablePtr# a
indexWord8ArrayAsStablePtr# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (Addr# -> Int# -> StablePtr# a
forall a. Addr# -> Int# -> StablePtr# a
indexStablePtrOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Int where
  packedByteCount :: Int -> Int
packedByteCount Int
_ = SIZEOF_HSINT
  {-# INLINE packedByteCount #-}
  packM :: forall s. Int -> Pack s ()
packM a :: Int
a@(I# Int#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Int
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt# MutableByteArray# s
mba# Int#
i# Int#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Int
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_HSINT
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Int -> Unpack b Int
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Unpack b Int) -> Int -> Unpack b Int
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Int) -> (Addr# -> Int) -> Int
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Int# -> Int
I# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Int# -> Int
I# (Addr# -> Int# -> Int#
indexIntOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Int8 where
  packedByteCount :: Int8 -> Int
packedByteCount Int8
_ = SIZEOF_INT8
  {-# INLINE packedByteCount #-}
  packM :: forall s. Int8 -> Pack s ()
packM a :: Int8
a@(I8# Int8#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int8 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Int8
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int8# -> State# d -> State# d
writeInt8Array# MutableByteArray# s
mba# Int#
i# Int8#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Int8
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_INT8
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Int8 -> Unpack b Int8
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int8 -> Unpack b Int8) -> Int8 -> Unpack b Int8
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Int8) -> (Addr# -> Int8) -> Int8
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Int8# -> Int8
I8# (ByteArray# -> Int# -> Int8#
indexInt8Array# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Int8# -> Int8
I8# (Addr# -> Int# -> Int8#
indexInt8OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Int16 where
  packedByteCount :: Int16 -> Int
packedByteCount Int16
_ = SIZEOF_INT16
  {-# INLINE packedByteCount #-}
  packM :: forall s. Int16 -> Pack s ()
packM a :: Int16
a@(I16# Int16#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int16 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Int16
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int16# -> State# d -> State# d
writeWord8ArrayAsInt16# MutableByteArray# s
mba# Int#
i# Int16#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Int16
unpackM = do
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_INT16
    Int16 -> Unpack b Int16
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int16 -> Unpack b Int16) -> Int16 -> Unpack b Int16
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Int16) -> (Addr# -> Int16) -> Int16
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Int16# -> Int16
I16# (ByteArray# -> Int# -> Int16#
indexWord8ArrayAsInt16# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Int16# -> Int16
I16# (Addr# -> Int# -> Int16#
indexInt16OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Int32 where
  packedByteCount :: Int32 -> Int
packedByteCount Int32
_ = SIZEOF_INT32
  {-# INLINE packedByteCount #-}
  packM :: forall s. Int32 -> Pack s ()
packM a :: Int32
a@(I32# Int32#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int32 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Int32
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int32# -> State# d -> State# d
writeWord8ArrayAsInt32# MutableByteArray# s
mba# Int#
i# Int32#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Int32
unpackM = do
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_INT32
    Int32 -> Unpack b Int32
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Unpack b Int32) -> Int32 -> Unpack b Int32
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Int32) -> (Addr# -> Int32) -> Int32
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Int32# -> Int32
I32# (ByteArray# -> Int# -> Int32#
indexWord8ArrayAsInt32# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Int32# -> Int32
I32# (Addr# -> Int# -> Int32#
indexInt32OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Int64 where
  packedByteCount :: Int64 -> Int
packedByteCount Int64
_ = SIZEOF_INT64
  {-# INLINE packedByteCount #-}
  packM :: forall s. Int64 -> Pack s ()
packM a :: Int64
a@(I64# Int64#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int64 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Int64
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int64# -> State# d -> State# d
writeWord8ArrayAsInt64# MutableByteArray# s
mba# Int#
i# Int64#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Int64
unpackM = do
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_INT64
    Int64 -> Unpack b Int64
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Unpack b Int64) -> Int64 -> Unpack b Int64
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Int64) -> (Addr# -> Int64) -> Int64
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Int64# -> Int64
I64# (ByteArray# -> Int# -> Int64#
indexWord8ArrayAsInt64# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Int64# -> Int64
I64# (Addr# -> Int# -> Int64#
indexInt64OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Word where
  packedByteCount :: Word -> Int
packedByteCount Word
_ = SIZEOF_HSWORD
  {-# INLINE packedByteCount #-}
  packM :: forall s. Word -> Pack s ()
packM a :: Word
a@(W# Word#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Word -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Word
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord# MutableByteArray# s
mba# Int#
i# Word#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Word
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_HSWORD
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Word -> Unpack b Word
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Unpack b Word) -> Word -> Unpack b Word
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Word) -> (Addr# -> Word) -> Word
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Word# -> Word
W# (Addr# -> Int# -> Word#
indexWordOffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Word8 where
  packedByteCount :: Word8 -> Int
packedByteCount Word8
_ = SIZEOF_WORD8
  {-# INLINE packedByteCount #-}
  packM :: forall s. Word8 -> Pack s ()
packM a :: Word8
a@(W8# Word8#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Word8 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Word8
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# Int#
i# Word8#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Word8
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_WORD8
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Word8 -> Unpack b Word8
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Unpack b Word8) -> Word8 -> Unpack b Word8
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Word8) -> (Addr# -> Word8) -> Word8
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr# Int#
i#))
  {-# INLINE unpackM #-}

instance MemPack Word16 where
  packedByteCount :: Word16 -> Int
packedByteCount Word16
_ = SIZEOF_WORD16
  {-# INLINE packedByteCount #-}
  packM :: forall s. Word16 -> Pack s ()
packM a :: Word16
a@(W16# Word16#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Word16 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Word16
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word16# -> State# d -> State# d
writeWord8ArrayAsWord16# MutableByteArray# s
mba# Int#
i# Word16#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Word16
unpackM = do
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_WORD16
    Word16 -> Unpack b Word16
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Unpack b Word16) -> Word16 -> Unpack b Word16
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Word16) -> (Addr# -> Word16) -> Word16
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Word16# -> Word16
W16# (ByteArray# -> Int# -> Word16#
indexWord8ArrayAsWord16# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Word16# -> Word16
W16# (Addr# -> Int# -> Word16#
indexWord16OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Word32 where
  packedByteCount :: Word32 -> Int
packedByteCount Word32
_ = SIZEOF_WORD32
  {-# INLINE packedByteCount #-}
  packM :: forall s. Word32 -> Pack s ()
packM a :: Word32
a@(W32# Word32#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Word32 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Word32
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# Word32#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Word32
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_WORD32
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Word32 -> Unpack b Word32
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Unpack b Word32) -> Word32 -> Unpack b Word32
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Word32) -> (Addr# -> Word32) -> Word32
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Word32# -> Word32
W32# (ByteArray# -> Int# -> Word32#
indexWord8ArrayAsWord32# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Word32# -> Word32
W32# (Addr# -> Int# -> Word32#
indexWord32OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

instance MemPack Word64 where
  packedByteCount :: Word64 -> Int
packedByteCount Word64
_ = SIZEOF_WORD64
  {-# INLINE packedByteCount #-}
  packM :: forall s. Word64 -> Pack s ()
packM a :: Word64
a@(W64# Word64#
a#) = do
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    I# Int#
i# <- Word64 -> Pack s Int
forall a s. MemPack a => a -> Pack s Int
packIncrement Word64
a
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word64# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# Word64#
a#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Word64
unpackM = do
    I# Int#
i# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack SIZEOF_WORD64
    b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
    Word64 -> Unpack b Word64
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Unpack b Word64) -> Word64 -> Unpack b Word64
forall a b. (a -> b) -> a -> b
$!
      b -> (ByteArray# -> Word64) -> (Addr# -> Word64) -> Word64
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
        b
buf
        (\ByteArray#
ba# -> Word64# -> Word64
W64# (ByteArray# -> Int# -> Word64#
indexWord8ArrayAsWord64# ByteArray#
ba# Int#
i#))
        (\Addr#
addr# -> Word64# -> Word64
W64# (Addr# -> Int# -> Word64#
indexWord64OffAddr# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
i#) Int#
0#))
  {-# INLINE unpackM #-}

#if __GLASGOW_HASKELL__ >= 900
instance MemPack Integer where
  packedByteCount :: Integer -> Int
packedByteCount =
    (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
packedTagByteCount) (Int -> Int) -> (Integer -> Int) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      IS Int#
i# -> Int -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int# -> Int
I# Int#
i#)
      IP ByteArray#
ba# -> ByteArray -> Int
forall a. MemPack a => a -> Int
packedByteCount (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
      IN ByteArray#
ba# -> ByteArray -> Int
forall a. MemPack a => a -> Int
packedByteCount (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE packedByteCount #-}
  packM :: forall s. Integer -> Pack s ()
packM = \case
    IS Int#
i# -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Pack s ()
forall s. Int -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int# -> Int
I# Int#
i#)
    IP ByteArray#
ba# -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteArray -> Pack s ()
forall s. ByteArray -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
    IN ByteArray#
ba# -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
2 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteArray -> Pack s ()
forall s. ByteArray -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Integer
unpackM = do
    Integer
i <-
      Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag -> (Tag -> Unpack b Integer) -> Unpack b Integer
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Tag
0 -> do
          I# Int#
i# <- Unpack b Int
forall b. Buffer b => Unpack b Int
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
          Integer -> Unpack b Integer
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Unpack b Integer) -> Integer -> Unpack b Integer
forall a b. (a -> b) -> a -> b
$ Int# -> Integer
IS Int#
i#
        Tag
1 -> do
          ByteArray ByteArray#
ba# <- Unpack b ByteArray
forall b. Buffer b => Unpack b ByteArray
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
          Integer -> Unpack b Integer
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Unpack b Integer) -> Integer -> Unpack b Integer
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Integer
IP ByteArray#
ba#
        Tag
2 -> do
          ByteArray ByteArray#
ba# <- Unpack b ByteArray
forall b. Buffer b => Unpack b ByteArray
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
          Integer -> Unpack b Integer
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Unpack b Integer) -> Integer -> Unpack b Integer
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Integer
IN ByteArray#
ba#
        Tag
t -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @Integer Tag
t
    Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer -> Bool
integerCheck Integer
i) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String -> Unpack b ()
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b ()) -> String -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid Integer decoded " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
showInteger Integer
i
    Integer -> Unpack b Integer
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
    where
      showInteger :: Integer -> String
showInteger = \case
        IS Int#
i# -> String
"IS " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int# -> Int
I# Int#
i#)
        IP ByteArray#
ba# -> String
"IP " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteArray -> String
forall a. Show a => a -> String
show (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
        IN ByteArray#
ba# -> String
"IN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteArray -> String
forall a. Show a => a -> String
show (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE unpackM #-}

instance MemPack Natural where
  packedByteCount :: Natural -> Int
packedByteCount =
    (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
packedTagByteCount) (Int -> Int) -> (Natural -> Int) -> Natural -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      NS Word#
w# -> Word -> Int
forall a. MemPack a => a -> Int
packedByteCount (Word# -> Word
W# Word#
w#)
      NB ByteArray#
ba# -> ByteArray -> Int
forall a. MemPack a => a -> Int
packedByteCount (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE packedByteCount #-}
  packM :: forall s. Natural -> Pack s ()
packM = \case
    NS Word#
w# -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word -> Pack s ()
forall s. Word -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Word# -> Word
W# Word#
w#)
    NB ByteArray#
ba# -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteArray -> Pack s ()
forall s. ByteArray -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Natural
unpackM = do
    Natural
n <-
      Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag -> (Tag -> Unpack b Natural) -> Unpack b Natural
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Tag
0 -> do
          W# Word#
w# <- Unpack b Word
forall b. Buffer b => Unpack b Word
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
          Natural -> Unpack b Natural
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Unpack b Natural) -> Natural -> Unpack b Natural
forall a b. (a -> b) -> a -> b
$ Word# -> Natural
NS Word#
w#
        Tag
1 -> do
          ByteArray ByteArray#
ba# <- Unpack b ByteArray
forall b. Buffer b => Unpack b ByteArray
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
          Natural -> Unpack b Natural
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Unpack b Natural) -> Natural -> Unpack b Natural
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Natural
NB ByteArray#
ba#
        Tag
t -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @Natural Tag
t
    Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Natural -> Bool
naturalCheck Natural
n) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String -> Unpack b ()
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b ()) -> String -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid Natural decoded " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Natural -> String
showNatural Natural
n
    Natural -> Unpack b Natural
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
n
    where
      showNatural :: Natural -> String
showNatural = \case
        NS Word#
w# -> String
"NS " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show (Word# -> Word
W# Word#
w#)
        NB ByteArray#
ba# -> String
"NB " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteArray -> String
forall a. Show a => a -> String
show (ByteArray# -> ByteArray
ByteArray ByteArray#
ba#)
  {-# INLINE unpackM #-}

#elif defined(MIN_VERSION_integer_gmp)

instance MemPack Integer where
  packedByteCount =
    (+ packedTagByteCount) . \case
      S# i# -> packedByteCount (I# i#)
      Jp# (BN# ba#) -> packedByteCount (ByteArray ba#)
      Jn# (BN# ba#) -> packedByteCount (ByteArray ba#)
  {-# INLINE packedByteCount #-}
  packM = \case
    S# i# -> packTagM 0 >> packM (I# i#)
    Jp# (BN# ba#) -> packTagM 1 >> packM (ByteArray ba#)
    Jn# (BN# ba#) -> packTagM 2 >> packM (ByteArray ba#)
  {-# INLINE packM #-}
  unpackM = do
    i <-
      unpackTagM >>= \case
        0 -> do
          I# i# <- unpackM
          pure $ S# i#
        1 -> do
          ByteArray ba# <- unpackM
          pure $ Jp# (BN# ba#)
        2 -> do
          ByteArray ba# <- unpackM
          pure $ Jn# (BN# ba#)
        t -> unknownTagM @Integer t
    unless (isTrue# (isValidInteger# i)) $ F.fail $ "Invalid Integer decoded " ++ showInteger i
    pure i
    where
      showInteger = \case
        S# i# -> "S# " ++ show (I# i#)
        Jp# (BN# ba#) -> "Jp# " ++ show (ByteArray ba#)
        Jn# (BN# ba#) -> "Jn# " ++ show (ByteArray ba#)
  {-# INLINE unpackM #-}

instance MemPack Natural where
  packedByteCount =
    (+ packedTagByteCount) . \case
      NatS# w# -> packedByteCount (W# w#)
      NatJ# (BN# ba#) -> packedByteCount (ByteArray ba#)
  {-# INLINE packedByteCount #-}
  packM = \case
    NatS# w# -> packTagM 0 >> packM (W# w#)
    NatJ# (BN# ba#) -> packTagM 1 >> packM (ByteArray ba#)
  {-# INLINE packM #-}
  unpackM = do
    n <-
      unpackTagM >>= \case
        0 -> do
          W# w# <- unpackM
          pure $ NatS# w#
        1 -> do
          ByteArray ba# <- unpackM
          pure $ NatJ# (BN# ba#)
        t -> unknownTagM @Natural t
    unless (isValidNatural n) $ F.fail $ "Invalid Natural decoded " ++ showNatural n
    pure n
    where
      showNatural = \case
        NatS# w# -> "NatS# " ++ show (W# w#)
        NatJ# (BN#  ba#) -> "NatJ# " ++ show (ByteArray ba#)
  {-# INLINE unpackM #-}

#endif

instance MemPack a => MemPack (Complex a) where
  typeName :: String
typeName = String
"Complex " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a
  packedByteCount :: Complex a -> Int
packedByteCount (a
a :+ a
b) = a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
b
  {-# INLINE packedByteCount #-}
  packM :: forall s. Complex a -> Pack s ()
packM (a
a :+ a
b) = a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
b
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Complex a)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !a
b <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    Complex a -> Unpack b (Complex a)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
b)
  {-# INLINE unpackM #-}

instance (MemPack a, Integral a) => MemPack (Ratio a) where
  typeName :: String
typeName = String
"Ratio " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a
  packedByteCount :: Ratio a -> Int
packedByteCount Ratio a
r = a -> Int
forall a. MemPack a => a -> Int
packedByteCount (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. MemPack a => a -> Int
packedByteCount (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
  {-# INLINE packedByteCount #-}
  packM :: forall s. Ratio a -> Pack s ()
packM Ratio a
r = a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Ratio a)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !a
b <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String -> Unpack b ()
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b ()) -> String -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String
"Zero denominator was detected when unpacking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @(Ratio a)
    Ratio a -> Unpack b (Ratio a)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
b)
  {-# INLINE unpackM #-}

instance (MemPack a, MemPack b) => MemPack (a, b) where
  typeName :: String
typeName = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b) -> Int
packedByteCount (a
a, b
b) = a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b) -> Pack s ()
packM (a
a, b
b) = a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b) -> Unpack b (a, b)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
  {-# INLINEABLE unpackM #-}

instance (MemPack a, MemPack b, MemPack c) => MemPack (a, b, c) where
  typeName :: String
typeName = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b, c) -> Int
packedByteCount (a
a, b
b, c
c) = a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall a. MemPack a => a -> Int
packedByteCount c
c
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b, c) -> Pack s ()
packM (a
a, b
b, c
c) = a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Pack s ()
forall s. c -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM c
c
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b, c)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !c
c <- Unpack b c
forall b. Buffer b => Unpack b c
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b, c) -> Unpack b (a, b, c)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)
  {-# INLINEABLE unpackM #-}

instance (MemPack a, MemPack b, MemPack c, MemPack d) => MemPack (a, b, c, d) where
  typeName :: String
typeName = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b, c, d) -> Int
packedByteCount (a
a, b
b, c
c, d
d) = a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall a. MemPack a => a -> Int
packedByteCount c
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ d -> Int
forall a. MemPack a => a -> Int
packedByteCount d
d
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b, c, d) -> Pack s ()
packM (a
a, b
b, c
c, d
d) =
    a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Pack s ()
forall s. c -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM c
c Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> Pack s ()
forall s. d -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM d
d
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b, c, d)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !c
c <- Unpack b c
forall b. Buffer b => Unpack b c
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !d
d <- Unpack b d
forall b. Buffer b => Unpack b d
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b, c, d) -> Unpack b (a, b, c, d)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d)
  {-# INLINEABLE unpackM #-}

instance (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e) => MemPack (a, b, c, d, e) where
  typeName :: String
typeName =
    String
"("
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
        String
","
        [ forall a. MemPack a => String
typeName @a
        , forall a. MemPack a => String
typeName @b
        , forall a. MemPack a => String
typeName @c
        , forall a. MemPack a => String
typeName @d
        , forall a. MemPack a => String
typeName @e
        ]
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b, c, d, e) -> Int
packedByteCount (a
a, b
b, c
c, d
d, e
e) =
    a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall a. MemPack a => a -> Int
packedByteCount c
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ d -> Int
forall a. MemPack a => a -> Int
packedByteCount d
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ e -> Int
forall a. MemPack a => a -> Int
packedByteCount e
e
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b, c, d, e) -> Pack s ()
packM (a
a, b
b, c
c, d
d, e
e) =
    a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Pack s ()
forall s. c -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM c
c Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> Pack s ()
forall s. d -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM d
d Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> Pack s ()
forall s. e -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM e
e
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b, c, d, e)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !c
c <- Unpack b c
forall b. Buffer b => Unpack b c
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !d
d <- Unpack b d
forall b. Buffer b => Unpack b d
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !e
e <- Unpack b e
forall b. Buffer b => Unpack b e
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b, c, d, e) -> Unpack b (a, b, c, d, e)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d, e
e)
  {-# INLINEABLE unpackM #-}

instance (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e, MemPack f) => MemPack (a, b, c, d, e, f) where
  typeName :: String
typeName =
    String
"("
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
        String
","
        [ forall a. MemPack a => String
typeName @a
        , forall a. MemPack a => String
typeName @b
        , forall a. MemPack a => String
typeName @c
        , forall a. MemPack a => String
typeName @d
        , forall a. MemPack a => String
typeName @e
        , forall a. MemPack a => String
typeName @f
        ]
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b, c, d, e, f) -> Int
packedByteCount (a
a, b
b, c
c, d
d, e
e, f
f) =
    a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall a. MemPack a => a -> Int
packedByteCount c
c
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ d -> Int
forall a. MemPack a => a -> Int
packedByteCount d
d
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ e -> Int
forall a. MemPack a => a -> Int
packedByteCount e
e
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ f -> Int
forall a. MemPack a => a -> Int
packedByteCount f
f
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b, c, d, e, f) -> Pack s ()
packM (a
a, b
b, c
c, d
d, e
e, f
f) =
    a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Pack s ()
forall s. c -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM c
c Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> Pack s ()
forall s. d -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM d
d Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> Pack s ()
forall s. e -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM e
e Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> f -> Pack s ()
forall s. f -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM f
f
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b, c, d, e, f)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !c
c <- Unpack b c
forall b. Buffer b => Unpack b c
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !d
d <- Unpack b d
forall b. Buffer b => Unpack b d
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !e
e <- Unpack b e
forall b. Buffer b => Unpack b e
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !f
f <- Unpack b f
forall b. Buffer b => Unpack b f
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b, c, d, e, f) -> Unpack b (a, b, c, d, e, f)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d, e
e, f
f)
  {-# INLINEABLE unpackM #-}

instance
  (MemPack a, MemPack b, MemPack c, MemPack d, MemPack e, MemPack f, MemPack g) =>
  MemPack (a, b, c, d, e, f, g)
  where
  typeName :: String
typeName =
    String
"("
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
        String
","
        [ forall a. MemPack a => String
typeName @a
        , forall a. MemPack a => String
typeName @b
        , forall a. MemPack a => String
typeName @c
        , forall a. MemPack a => String
typeName @d
        , forall a. MemPack a => String
typeName @e
        , forall a. MemPack a => String
typeName @f
        , forall a. MemPack a => String
typeName @g
        ]
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  packedByteCount :: (a, b, c, d, e, f, g) -> Int
packedByteCount (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. MemPack a => a -> Int
packedByteCount b
b
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall a. MemPack a => a -> Int
packedByteCount c
c
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ d -> Int
forall a. MemPack a => a -> Int
packedByteCount d
d
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ e -> Int
forall a. MemPack a => a -> Int
packedByteCount e
e
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ f -> Int
forall a. MemPack a => a -> Int
packedByteCount f
f
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ g -> Int
forall a. MemPack a => a -> Int
packedByteCount g
g
  {-# INLINE packedByteCount #-}
  packM :: forall s. (a, b, c, d, e, f, g) -> Pack s ()
packM (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Pack s ()
forall s. b -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM b
b Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Pack s ()
forall s. c -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM c
c Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> Pack s ()
forall s. d -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM d
d Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> Pack s ()
forall s. e -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM e
e Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> f -> Pack s ()
forall s. f -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM f
f Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> g -> Pack s ()
forall s. g -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM g
g
  {-# INLINEABLE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (a, b, c, d, e, f, g)
unpackM = do
    !a
a <- Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !b
b <- Unpack b b
forall b. Buffer b => Unpack b b
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !c
c <- Unpack b c
forall b. Buffer b => Unpack b c
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !d
d <- Unpack b d
forall b. Buffer b => Unpack b d
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !e
e <- Unpack b e
forall b. Buffer b => Unpack b e
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !f
f <- Unpack b f
forall b. Buffer b => Unpack b f
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    !g
g <- Unpack b g
forall b. Buffer b => Unpack b g
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    (a, b, c, d, e, f, g) -> Unpack b (a, b, c, d, e, f, g)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d, e
e, f
f, g
g)
  {-# INLINEABLE unpackM #-}

instance MemPack a => MemPack [a] where
  typeName :: String
typeName = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  packedByteCount :: [a] -> Int
packedByteCount [a]
es = Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
es)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum ((a -> Sum Int) -> [a] -> Sum Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (a -> Int) -> a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. MemPack a => a -> Int
packedByteCount) [a]
es)
  {-# INLINE packedByteCount #-}
  packM :: forall s. [a] -> Pack s ()
packM [a]
as = do
    Length -> Pack s ()
forall s. Length -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int -> Length
Length ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as))
    (a -> Pack s ()) -> [a] -> Pack s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM [a]
as
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b [a]
unpackM = do
    Length Int
n <- Unpack b Length
forall b. Buffer b => Unpack b Length
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    Int -> Unpack b a -> Unpack b [a]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
replicateTailM Int
n Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
  {-# INLINE unpackM #-}

-- | Tail recursive version of `replicateM`
replicateTailM :: Monad m => Int -> m a -> m [a]
replicateTailM :: forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
replicateTailM Int
n m a
f = Int -> [a] -> m [a]
forall {t}. (Ord t, Num t) => t -> [a] -> m [a]
go Int
n []
  where
    go :: t -> [a] -> m [a]
go t
i ![a]
acc
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc
      | Bool
otherwise = m a
f m a -> (a -> m [a]) -> m [a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> t -> [a] -> m [a]
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
{-# INLINE replicateTailM #-}

instance MemPack ByteArray where
  packedByteCount :: ByteArray -> Int
packedByteCount ByteArray
ba =
    let len :: Int
len = ByteArray -> Int
forall b. Buffer b => b -> Int
bufferByteCount ByteArray
ba
     in Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length Int
len) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
  {-# INLINE packedByteCount #-}
  packM :: forall s. ByteArray -> Pack s ()
packM ba :: ByteArray
ba@(ByteArray ByteArray#
ba#) = do
    let !len :: Int
len@(I# Int#
len#) = ByteArray -> Int
forall b. Buffer b => b -> Int
bufferByteCount ByteArray
ba
    Length -> Pack s ()
forall s. Length -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int -> Length
Length Int
len)
    I# Int#
curPos# <- (Int -> (Int, Int)) -> Pack s Int
forall a. (Int -> (a, Int)) -> Pack s a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Int, Int)) -> Pack s Int)
-> (Int -> (Int, Int)) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba# Int#
0# MutableByteArray# s
mba# Int#
curPos# Int#
len#)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b ByteArray
unpackM = Bool -> Unpack b ByteArray
forall b. Buffer b => Bool -> Unpack b ByteArray
unpackByteArray Bool
False
  {-# INLINE unpackM #-}

instance MemPack ShortByteString where
  packedByteCount :: ShortByteString -> Int
packedByteCount ShortByteString
ba =
    let len :: Int
len = ShortByteString -> Int
forall b. Buffer b => b -> Int
bufferByteCount ShortByteString
ba
     in Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length Int
len) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
  {-# INLINE packedByteCount #-}
  packM :: forall s. ShortByteString -> Pack s ()
packM = ByteArray -> Pack s ()
forall s. ByteArray -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (ByteArray -> Pack s ())
-> (ShortByteString -> ByteArray) -> ShortByteString -> Pack s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteArray
byteArrayFromShortByteString
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b ShortByteString
unpackM = ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray -> ShortByteString)
-> Unpack b ByteArray -> Unpack b ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Unpack b ByteArray
forall b. Buffer b => Bool -> Unpack b ByteArray
unpackByteArray Bool
False
  {-# INLINE unpackM #-}

instance MemPack ByteString where
  packedByteCount :: ByteString -> Int
packedByteCount ByteString
ba =
    let len :: Int
len = ByteString -> Int
forall b. Buffer b => b -> Int
bufferByteCount ByteString
ba
     in Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length Int
len) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
  {-# INLINE packedByteCount #-}
  packM :: forall s. ByteString -> Pack s ()
packM ByteString
bs = Length -> Pack s ()
forall s. Length -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int -> Length
Length (ByteString -> Int
forall b. Buffer b => b -> Int
bufferByteCount ByteString
bs)) Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Pack s ()
forall s. ByteString -> Pack s ()
packByteStringM ByteString
bs
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b ByteString
unpackM = ByteArray -> ByteString
pinnedByteArrayToByteString (ByteArray -> ByteString)
-> Unpack b ByteArray -> Unpack b ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Unpack b ByteArray
forall b. Buffer b => Bool -> Unpack b ByteArray
unpackByteArray Bool
True
  {-# INLINE unpackM #-}

{- FOURMOLU_DISABLE -}
instance MemPack BSL.ByteString where
#if WORD_SIZE_IN_BITS == 32
  packedByteCount bsl =
    let len64 = BSL.length bsl
        len = fromIntegral len64
     in if len64 <= fromIntegral (maxBound :: Int)
        then packedByteCount (Length len) + len
        else error $ mconcat [ "Cannot pack more that '2 ^ 31 - 1' bytes on a 32bit architecture, "
                             , "but tried to pack a lazy ByteString with "
                             , show len64
                             , " bytes"
                             ]
#elif WORD_SIZE_IN_BITS == 64
  packedByteCount :: ByteString -> Int
packedByteCount ByteString
bsl =
    let len :: Int
len = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
bsl)
     in Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length Int
len) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
#else
#error "Only 32bit and 64bit systems are supported"
#endif
  {-# INLINE packedByteCount #-}
  packM :: forall s. ByteString -> Pack s ()
packM ByteString
bsl = do
    let !len :: Int
len = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
bsl)
        go :: ByteString -> Pack s ()
go ByteString
BSL.Empty = () -> Pack s ()
forall a. a -> Pack s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        go (BSL.Chunk ByteString
bs ByteString
rest) = ByteString -> Pack s ()
forall s. ByteString -> Pack s ()
packByteStringM ByteString
bs Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Pack s ()
go ByteString
rest
    Length -> Pack s ()
forall s. Length -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int -> Length
Length Int
len)
    ByteString -> Pack s ()
forall s. ByteString -> Pack s ()
go ByteString
bsl
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b ByteString
unpackM = do
    Length Int
len <- Unpack b Length
forall b. Buffer b => Unpack b Length
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    let c :: Int
c = Int
BSL.defaultChunkSize
        go :: Int -> Unpack b ByteString
go Int
n
          | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> Unpack b ByteString
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BSL.Empty
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c = ByteString -> ByteString -> ByteString
BSL.Chunk (ByteString -> ByteString -> ByteString)
-> Unpack b ByteString -> Unpack b (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Unpack b ByteString
forall b. Buffer b => Int -> Unpack b ByteString
unpackByteStringM Int
n Unpack b (ByteString -> ByteString)
-> Unpack b ByteString -> Unpack b ByteString
forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Unpack b ByteString
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BSL.Empty
          | Bool
otherwise = ByteString -> ByteString -> ByteString
BSL.Chunk (ByteString -> ByteString -> ByteString)
-> Unpack b ByteString -> Unpack b (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Unpack b ByteString
forall b. Buffer b => Int -> Unpack b ByteString
unpackByteStringM Int
c Unpack b (ByteString -> ByteString)
-> Unpack b ByteString -> Unpack b ByteString
forall a b. Unpack b (a -> b) -> Unpack b a -> Unpack b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Unpack b ByteString
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c)
    Int -> Unpack b ByteString
forall {b}. Buffer b => Int -> Unpack b ByteString
go Int
len
  {-# INLINE unpackM #-}

instance MemPack Text where
#if MIN_VERSION_text(2,0,0)
  packedByteCount :: Text -> Int
packedByteCount (Text Array
_ Int
_ Int
byteCount) = Length -> Int
forall a. MemPack a => a -> Int
packedByteCount (Int -> Length
Length Int
byteCount) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteCount
  packM :: forall s. Text -> Pack s ()
packM (Text (T.ByteArray ByteArray#
ba#) (I# Int#
offset#) len :: Int
len@(I# Int#
len#)) = do
    Length -> Pack s ()
forall s. Length -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Int -> Length
Length Int
len)
    I# Int#
curPos# <- (Int -> (Int, Int)) -> Pack s Int
forall a. (Int -> (a, Int)) -> Pack s a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Int, Int)) -> Pack s Int)
-> (Int -> (Int, Int)) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
    MutableByteArray MutableByteArray# s
mba# <- Pack s (MutableByteArray s)
forall r (m :: * -> *). MonadReader r m => m r
ask
    (State# s -> State# s) -> Pack s ()
forall s. (State# s -> State# s) -> Pack s ()
lift_# (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba# Int#
offset# MutableByteArray# s
mba# Int#
curPos# Int#
len#)
#else
  -- FIXME: This is very inefficient and shall be fixed in the next major version
  packedByteCount = packedByteCount . T.encodeUtf8
  packM = packM . T.encodeUtf8
#endif
  {-# INLINE packedByteCount #-}
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Text
unpackM = do
    ByteString
bs <- Unpack b ByteString
forall b. Buffer b => Unpack b ByteString
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
      Right Text
txt -> Text -> Unpack b Text
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt
      Left UnicodeException
exc -> String -> Unpack b Text
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> Unpack b Text) -> String -> Unpack b Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
exc
  {-# INLINE unpackM #-}
{- FOURMOLU_ENABLE -}

-- | This is the implementation of `unpackM` for `ByteArray`, `ByteString` and `ShortByteString`
unpackByteArray :: Buffer b => Bool -> Unpack b ByteArray
unpackByteArray :: forall b. Buffer b => Bool -> Unpack b ByteArray
unpackByteArray Bool
isPinned = Bool -> Int -> Unpack b ByteArray
forall b. Buffer b => Bool -> Int -> Unpack b ByteArray
unpackByteArrayLen Bool
isPinned (Int -> Unpack b ByteArray)
-> (Length -> Int) -> Length -> Unpack b ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> Int
unLength (Length -> Unpack b ByteArray)
-> Unpack b Length -> Unpack b ByteArray
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Unpack b Length
forall b. Buffer b => Unpack b Length
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
{-# INLINE unpackByteArray #-}

-- | Unpack a `ByteArray` with supplied number of bytes.
--
-- Similar to `unpackByteArray`, except it does not unpack a length.
--
-- @since 0.1.1
unpackByteArrayLen :: Buffer b => Bool -> Int -> Unpack b ByteArray
unpackByteArrayLen :: forall b. Buffer b => Bool -> Int -> Unpack b ByteArray
unpackByteArrayLen Bool
isPinned len :: Int
len@(I# Int#
len#) = do
  I# Int#
curPos# <- Int -> Unpack b Int
forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack Int
len
  b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
  ByteArray -> Unpack b ByteArray
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray -> Unpack b ByteArray)
-> ByteArray -> Unpack b ByteArray
forall a b. (a -> b) -> a -> b
$! (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    mba :: MutableByteArray s
mba@(MutableByteArray MutableByteArray# s
mba#) <- Bool -> Int -> ST s (MutableByteArray s)
forall s. Bool -> Int -> ST s (MutableByteArray s)
newMutableByteArray Bool
isPinned Int
len
    b -> (ByteArray# -> ST s ()) -> (Addr# -> ST s ()) -> ST s ()
forall a. b -> (ByteArray# -> a) -> (Addr# -> a) -> a
forall b a. Buffer b => b -> (ByteArray# -> a) -> (Addr# -> a) -> a
buffer
      b
buf
      (\ByteArray#
ba# -> (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba# Int#
curPos# MutableByteArray# s
mba# Int#
0# Int#
len#))
      (\Addr#
addr# -> (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ (Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
curPos#) MutableByteArray# s
mba# Int#
0# Int#
len#))
    MutableByteArray s -> ST s ByteArray
forall d. MutableByteArray d -> ST d ByteArray
freezeMutableByteArray MutableByteArray s
mba
{-# INLINE unpackByteArrayLen #-}

-- | Increment the offset counter of `Pack` monad by then number of `packedByteCount` and
-- return the starting offset.
packIncrement :: MemPack a => a -> Pack s Int
packIncrement :: forall a s. MemPack a => a -> Pack s Int
packIncrement a
a =
  (Int -> (Int, Int)) -> Pack s Int
forall a. (Int -> (a, Int)) -> Pack s a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Int, Int)) -> Pack s Int)
-> (Int -> (Int, Int)) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    let !n :: Int
n = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a
     in (Int
i, Int
n)
{-# INLINE packIncrement #-}

-- | Increment the offset counter of `Unpack` monad by the supplied number of
-- bytes. Returns the original offset or fails with `RanOutOfBytesError` whenever there is
-- not enough bytes in the `Buffer`.
guardAdvanceUnpack :: Buffer b => Int -> Unpack b Int
guardAdvanceUnpack :: forall b. Buffer b => Int -> Unpack b Int
guardAdvanceUnpack n :: Int
n@(I# Int#
n#) = do
  b
buf <- Unpack b b
forall r (m :: * -> *). MonadReader r m => m r
ask
  let !len :: Int
len = b -> Int
forall b. Buffer b => b -> Int
bufferByteCount b
buf
  -- Check that we still have enough bytes, while guarding against integer overflow.
  Unpack b (Unpack b Int) -> Unpack b Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Unpack b (Unpack b Int) -> Unpack b Int)
-> Unpack b (Unpack b Int) -> Unpack b Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Unpack b Int, Int)) -> Unpack b (Unpack b Int)
forall a. (Int -> (a, Int)) -> Unpack b a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Unpack b Int, Int)) -> Unpack b (Unpack b Int))
-> (Int -> (Unpack b Int, Int)) -> Unpack b (Unpack b Int)
forall a b. (a -> b) -> a -> b
$ \i :: Int
i@(I# Int#
i#) ->
    case Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
i# Int#
n# of
      (# Int#
adv#, Int#
0# #)
        | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int# -> Int
I# Int#
adv# -> (Int -> Unpack b Int
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i, Int# -> Int
I# Int#
adv#)
      (# Int#, Int# #)
_ -> (Int -> Int -> Int -> Unpack b Int
forall b a. Int -> Int -> Int -> Unpack b a
failOutOfBytes Int
i Int
len Int
n, Int
i)
{-# INLINE guardAdvanceUnpack #-}

failOutOfBytes :: Int -> Int -> Int -> Unpack b a
failOutOfBytes :: forall b a. Int -> Int -> Int -> Unpack b a
failOutOfBytes Int
i Int
len Int
n =
  SomeError -> Unpack b a
forall e b a. Error e => e -> Unpack b a
failUnpack (SomeError -> Unpack b a) -> SomeError -> Unpack b a
forall a b. (a -> b) -> a -> b
$
    RanOutOfBytesError -> SomeError
forall e. Error e => e -> SomeError
toSomeError (RanOutOfBytesError -> SomeError)
-> RanOutOfBytesError -> SomeError
forall a b. (a -> b) -> a -> b
$
      RanOutOfBytesError
        { ranOutOfBytesRead :: Int
ranOutOfBytesRead = Int
i
        , ranOutOfBytesAvailable :: Int
ranOutOfBytesAvailable = Int
len
        , ranOutOfBytesRequested :: Int
ranOutOfBytesRequested = Int
n
        }
{-# NOINLINE failOutOfBytes #-}

-- | Serialize a type into an unpinned `ByteArray`
--
-- ====__Examples__
--
-- >>> :set -XTypeApplications
-- >>> unpack @[Int] $ pack ([1,2,3,4,5] :: [Int])
-- Right [1,2,3,4,5]
pack :: forall a. (MemPack a, HasCallStack) => a -> ByteArray
pack :: forall a. (MemPack a, HasCallStack) => a -> ByteArray
pack = Bool -> a -> ByteArray
forall a. (MemPack a, HasCallStack) => Bool -> a -> ByteArray
packByteArray Bool
False
{-# INLINE pack #-}

-- | Serialize a type into a pinned `ByteString`
packByteString :: forall a. (MemPack a, HasCallStack) => a -> ByteString
packByteString :: forall a. (MemPack a, HasCallStack) => a -> ByteString
packByteString = ByteArray -> ByteString
pinnedByteArrayToByteString (ByteArray -> ByteString) -> (a -> ByteArray) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> ByteArray
forall a. (MemPack a, HasCallStack) => Bool -> a -> ByteArray
packByteArray Bool
True
{-# INLINE packByteString #-}

-- | Serialize a type into an unpinned `ShortByteString`
packShortByteString :: forall a. (MemPack a, HasCallStack) => a -> ShortByteString
packShortByteString :: forall a. (MemPack a, HasCallStack) => a -> ShortByteString
packShortByteString = ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray -> ShortByteString)
-> (a -> ByteArray) -> a -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteArray
forall a. (MemPack a, HasCallStack) => a -> ByteArray
pack
{-# INLINE packShortByteString #-}

-- | Same as `pack`, but allows controlling the pinnedness of allocated memory
packByteArray ::
  forall a.
  (MemPack a, HasCallStack) =>
  -- | Should the array be allocated in pinned memory?
  Bool ->
  a ->
  ByteArray
packByteArray :: forall a. (MemPack a, HasCallStack) => Bool -> a -> ByteArray
packByteArray Bool
isPinned a
a =
  HasCallStack =>
Bool -> String -> Int -> (forall s. Pack s ()) -> ByteArray
Bool -> String -> Int -> (forall s. Pack s ()) -> ByteArray
packWithByteArray Bool
isPinned (forall a. MemPack a => String
typeName @a) (a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a) (a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a)
{-# INLINE packByteArray #-}

-- | Allocate a `MutableByteArray` and run the supplied `Pack` action on it. Freezes the
-- allocated `MutableByteArray` at the end yielding the immutable `ByteArray` with
-- serialization packed into it.
packWithByteArray ::
  HasCallStack =>
  -- | Should the array be allocated in pinned memory?
  Bool ->
  -- | Name of the type that is being serialized. Used for error reporting
  String ->
  -- | Size of the array to be allocated
  Int ->
  (forall s. Pack s ()) ->
  ByteArray
packWithByteArray :: HasCallStack =>
Bool -> String -> Int -> (forall s. Pack s ()) -> ByteArray
packWithByteArray Bool
isPinned String
name Int
len forall s. Pack s ()
packerM =
  (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Int -> Pack s () -> ST s (MutableByteArray s)
forall s.
HasCallStack =>
Bool -> String -> Int -> Pack s () -> ST s (MutableByteArray s)
packWithMutableByteArray Bool
isPinned String
name Int
len Pack s ()
forall s. Pack s ()
packerM ST s (MutableByteArray s)
-> (MutableByteArray s -> ST s ByteArray) -> ST s ByteArray
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableByteArray s -> ST s ByteArray
forall d. MutableByteArray d -> ST d ByteArray
freezeMutableByteArray
{-# INLINE packWithByteArray #-}

-- | Same as `packByteArray`, but produces a mutable array instead
packMutableByteArray ::
  forall a s.
  (MemPack a, HasCallStack) =>
  -- | Should the array be allocated in pinned memory?
  Bool ->
  a ->
  ST s (MutableByteArray s)
packMutableByteArray :: forall a s.
(MemPack a, HasCallStack) =>
Bool -> a -> ST s (MutableByteArray s)
packMutableByteArray Bool
isPinned a
a =
  Bool -> String -> Int -> Pack s () -> ST s (MutableByteArray s)
forall s.
HasCallStack =>
Bool -> String -> Int -> Pack s () -> ST s (MutableByteArray s)
packWithMutableByteArray Bool
isPinned (forall a. MemPack a => String
typeName @a) (a -> Int
forall a. MemPack a => a -> Int
packedByteCount a
a) (a -> Pack s ()
forall s. a -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM a
a)
{-# INLINE packMutableByteArray #-}

-- | Allocate a `MutableByteArray` and run the supplied `Pack` action on it.
packWithMutableByteArray ::
  forall s.
  HasCallStack =>
  -- | Should the array be allocated in pinned memory?
  Bool ->
  -- | Name of the type that is being serialized. Used for error reporting
  String ->
  -- | Size of the mutable array to be allocated
  Int ->
  -- | Packing action to be executed on the mutable buffer
  Pack s () ->
  ST s (MutableByteArray s)
packWithMutableByteArray :: forall s.
HasCallStack =>
Bool -> String -> Int -> Pack s () -> ST s (MutableByteArray s)
packWithMutableByteArray Bool
isPinned String
name Int
len Pack s ()
packerM = do
  MutableByteArray s
mba <- Bool -> Int -> ST s (MutableByteArray s)
forall s. Bool -> Int -> ST s (MutableByteArray s)
newMutableByteArray Bool
isPinned Int
len
  Int
filledBytes <- StateT Int (ST s) () -> Int -> ST s Int
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (Pack s () -> MutableByteArray s -> StateT Int (ST s) ()
forall s a. Pack s a -> MutableByteArray s -> StateT Int (ST s) a
runPack Pack s ()
packerM MutableByteArray s
mba) Int
0
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
filledBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> ST s ()
forall a. HasCallStack => String -> Int -> Int -> a
errorFilledBytes String
name Int
filledBytes Int
len
  MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableByteArray s
mba
{-# INLINEABLE packWithMutableByteArray #-}

-- | This is a critical error, therefore we are not gracefully failing this unpacking
errorFilledBytes :: HasCallStack => [Char] -> Int -> Int -> a
errorFilledBytes :: forall a. HasCallStack => String -> Int -> Int -> a
errorFilledBytes String
name Int
filledBytes Int
len =
  if Int
filledBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
    then
      String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
        String
"Some bug in 'packM' was detected. Buffer of length " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes Int
len
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was not fully filled while packing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Unfilled " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
filledBytes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
    else
      String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
        String
"Potential buffer overflow. Some bug in 'packM' was detected while packing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Filled " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes (Int
filledBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" more than allowed into a buffer of length "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
{-# NOINLINE errorFilledBytes #-}

-- | Helper function for packing a `ByteString` without its length being packed first.
--
-- @since 0.1.1
packByteStringM :: ByteString -> Pack s ()
packByteStringM :: forall s. ByteString -> Pack s ()
packByteStringM ByteString
bs = do
  let !len :: Int
len@(I# Int#
len#) = ByteString -> Int
forall b. Buffer b => b -> Int
bufferByteCount ByteString
bs
  I# Int#
curPos# <- (Int -> (Int, Int)) -> Pack s Int
forall a. (Int -> (a, Int)) -> Pack s a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Int -> (Int, Int)) -> Pack s Int)
-> (Int -> (Int, Int)) -> Pack s Int
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ())
-> (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall a b. (a -> b) -> a -> b
$ \(MutableByteArray MutableByteArray# s
mba#) -> ST s () -> StateT Int (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> StateT Int (ST s) ())
-> ST s () -> StateT Int (ST s) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Any -> ST s ()) -> ST s ()
forall a s b. ByteString -> (Ptr a -> ST s b) -> ST s b
withPtrByteStringST ByteString
bs ((Ptr Any -> ST s ()) -> ST s ())
-> (Ptr Any -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
addr#) ->
    (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ (Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr# MutableByteArray# s
mba# Int#
curPos# Int#
len#)
{-# INLINE packByteStringM #-}

-- | Unpack a `ByteString` of a specified size.
--
-- @since 0.1.1
unpackByteStringM ::
  Buffer b =>
  -- | number of bytes to unpack
  Int ->
  Unpack b ByteString
unpackByteStringM :: forall b. Buffer b => Int -> Unpack b ByteString
unpackByteStringM Int
len = ByteArray -> ByteString
pinnedByteArrayToByteString (ByteArray -> ByteString)
-> Unpack b ByteArray -> Unpack b ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Int -> Unpack b ByteArray
forall b. Buffer b => Bool -> Int -> Unpack b ByteArray
unpackByteArrayLen Bool
True Int
len
{-# INLINE unpackByteStringM #-}

-- | Unpack a memory `Buffer` into a type using its `MemPack` instance. Besides the
-- unpacked type it also returns an index into a buffer where unpacked has stopped.
unpackLeftOver :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Fail SomeError (a, Int)
unpackLeftOver :: forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Fail SomeError (a, Int)
unpackLeftOver b
b = do
  let len :: Int
len = b -> Int
forall b. Buffer b => b -> Int
bufferByteCount b
b
  res :: (a, Int)
res@(a
_, Int
consumedBytes) <- StateT Int (Fail SomeError) a -> Int -> Fail SomeError (a, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Unpack b a -> b -> StateT Int (Fail SomeError) a
forall b a. Unpack b a -> b -> StateT Int (Fail SomeError) a
runUnpack Unpack b a
forall b. Buffer b => Unpack b a
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM b
b) Int
0
  Bool -> FailT SomeError Identity () -> FailT SomeError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
consumedBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len) (FailT SomeError Identity () -> FailT SomeError Identity ())
-> FailT SomeError Identity () -> FailT SomeError Identity ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> FailT SomeError Identity ()
forall a. HasCallStack => String -> Int -> Int -> a
errorLeftOver (forall a. MemPack a => String
typeName @a) Int
consumedBytes Int
len
  (a, Int) -> Fail SomeError (a, Int)
forall a. a -> FailT SomeError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, Int)
res
{-# INLINEABLE unpackLeftOver #-}

-- | This is a critical error, therefore we are not gracefully failing this unpacking
errorLeftOver :: HasCallStack => String -> Int -> Int -> a
errorLeftOver :: forall a. HasCallStack => String -> Int -> Int -> a
errorLeftOver String
name Int
consumedBytes Int
len =
  String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
    String
"Potential buffer overflow. Some bug in 'unpackM' was detected while unpacking " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Consumed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
showBytes (Int
consumedBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" more than allowed from a buffer of length "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
{-# NOINLINE errorLeftOver #-}

-- | Unpack a memory `Buffer` into a type using its `MemPack` instance. Besides potential
-- unpacking failures due to a malformed buffer it will also fail the supplied `Buffer`
-- was not fully consumed. Use `unpackLeftOver`, whenever a partially consumed buffer is
-- possible.
unpack :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Either SomeError a
unpack :: forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Either SomeError a
unpack = ([SomeError] -> SomeError)
-> Either [SomeError] a -> Either SomeError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [SomeError] -> SomeError
fromMultipleErrors (Either [SomeError] a -> Either SomeError a)
-> (b -> Either [SomeError] a) -> b -> Either SomeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fail SomeError a -> Either [SomeError] a
forall e a. Fail e a -> Either [e] a
runFailAgg (Fail SomeError a -> Either [SomeError] a)
-> (b -> Fail SomeError a) -> b -> Either [SomeError] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Fail SomeError a
forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Fail SomeError a
unpackFail
{-# INLINEABLE unpack #-}

-- | Same as `unpack` except fails in a `Fail` monad, instead of `Either`.
unpackFail :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> Fail SomeError a
unpackFail :: forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Fail SomeError a
unpackFail b
b = do
  let len :: Int
len = b -> Int
forall b. Buffer b => b -> Int
bufferByteCount b
b
  (a
a, Int
consumedBytes) <- b -> Fail SomeError (a, Int)
forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Fail SomeError (a, Int)
unpackLeftOver b
b
  Bool -> FailT SomeError Identity () -> FailT SomeError Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
consumedBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len) (FailT SomeError Identity () -> FailT SomeError Identity ())
-> FailT SomeError Identity () -> FailT SomeError Identity ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> FailT SomeError Identity ()
forall (m :: * -> *) a.
Applicative m =>
String -> Int -> Int -> FailT SomeError m a
unpackFailNotFullyConsumed (forall a. MemPack a => String
typeName @a) Int
consumedBytes Int
len
  a -> Fail SomeError a
forall a. a -> FailT SomeError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINEABLE unpackFail #-}

unpackFailNotFullyConsumed :: Applicative m => String -> Int -> Int -> FailT SomeError m a
unpackFailNotFullyConsumed :: forall (m :: * -> *) a.
Applicative m =>
String -> Int -> Int -> FailT SomeError m a
unpackFailNotFullyConsumed String
name Int
consumedBytes Int
len =
  SomeError -> FailT SomeError m a
forall (m :: * -> *) e a. Applicative m => e -> FailT e m a
failT (SomeError -> FailT SomeError m a)
-> SomeError -> FailT SomeError m a
forall a b. (a -> b) -> a -> b
$
    NotFullyConsumedError -> SomeError
forall e. Error e => e -> SomeError
toSomeError (NotFullyConsumedError -> SomeError)
-> NotFullyConsumedError -> SomeError
forall a b. (a -> b) -> a -> b
$
      NotFullyConsumedError
        { notFullyConsumedRead :: Int
notFullyConsumedRead = Int
consumedBytes
        , notFullyConsumedAvailable :: Int
notFullyConsumedAvailable = Int
len
        , notFullyConsumedTypeName :: String
notFullyConsumedTypeName = String
name
        }
{-# NOINLINE unpackFailNotFullyConsumed #-}

-- | Same as `unpackFail` except fails in any `MonadFail`, instead of `Fail`.
unpackMonadFail :: forall a b m. (MemPack a, Buffer b, F.MonadFail m) => b -> m a
unpackMonadFail :: forall a b (m :: * -> *).
(MemPack a, Buffer b, MonadFail m) =>
b -> m a
unpackMonadFail = (SomeError -> m a) -> (a -> m a) -> Either SomeError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> m a) -> (SomeError -> String) -> SomeError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeError -> String
forall a. Show a => a -> String
show) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeError a -> m a)
-> (b -> Either SomeError a) -> b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either SomeError a
forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Either SomeError a
unpack
{-# INLINEABLE unpackMonadFail #-}

-- | Same as `unpack` except throws a runtime exception upon a failure
unpackError :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError :: forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError = Fail SomeError a -> a
forall e a. (Show e, HasCallStack) => Fail e a -> a
errorFail (Fail SomeError a -> a) -> (b -> Fail SomeError a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Fail SomeError a
forall a b.
(MemPack a, Buffer b, HasCallStack) =>
b -> Fail SomeError a
unpackFail
{-# INLINEABLE unpackError #-}

-- | Variable length encoding for bounded types. This type of encoding will use less
-- memory for small values, but for larger values it will consume more memory and will be
-- slower during packing/unpacking.
newtype VarLen a = VarLen {forall a. VarLen a -> a
unVarLen :: a}
  deriving (VarLen a -> VarLen a -> Bool
(VarLen a -> VarLen a -> Bool)
-> (VarLen a -> VarLen a -> Bool) -> Eq (VarLen a)
forall a. Eq a => VarLen a -> VarLen a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => VarLen a -> VarLen a -> Bool
== :: VarLen a -> VarLen a -> Bool
$c/= :: forall a. Eq a => VarLen a -> VarLen a -> Bool
/= :: VarLen a -> VarLen a -> Bool
Eq, Eq (VarLen a)
Eq (VarLen a) =>
(VarLen a -> VarLen a -> Ordering)
-> (VarLen a -> VarLen a -> Bool)
-> (VarLen a -> VarLen a -> Bool)
-> (VarLen a -> VarLen a -> Bool)
-> (VarLen a -> VarLen a -> Bool)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> Ord (VarLen a)
VarLen a -> VarLen a -> Bool
VarLen a -> VarLen a -> Ordering
VarLen a -> VarLen a -> VarLen a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (VarLen a)
forall a. Ord a => VarLen a -> VarLen a -> Bool
forall a. Ord a => VarLen a -> VarLen a -> Ordering
forall a. Ord a => VarLen a -> VarLen a -> VarLen a
$ccompare :: forall a. Ord a => VarLen a -> VarLen a -> Ordering
compare :: VarLen a -> VarLen a -> Ordering
$c< :: forall a. Ord a => VarLen a -> VarLen a -> Bool
< :: VarLen a -> VarLen a -> Bool
$c<= :: forall a. Ord a => VarLen a -> VarLen a -> Bool
<= :: VarLen a -> VarLen a -> Bool
$c> :: forall a. Ord a => VarLen a -> VarLen a -> Bool
> :: VarLen a -> VarLen a -> Bool
$c>= :: forall a. Ord a => VarLen a -> VarLen a -> Bool
>= :: VarLen a -> VarLen a -> Bool
$cmax :: forall a. Ord a => VarLen a -> VarLen a -> VarLen a
max :: VarLen a -> VarLen a -> VarLen a
$cmin :: forall a. Ord a => VarLen a -> VarLen a -> VarLen a
min :: VarLen a -> VarLen a -> VarLen a
Ord, Int -> VarLen a -> String -> String
[VarLen a] -> String -> String
VarLen a -> String
(Int -> VarLen a -> String -> String)
-> (VarLen a -> String)
-> ([VarLen a] -> String -> String)
-> Show (VarLen a)
forall a. Show a => Int -> VarLen a -> String -> String
forall a. Show a => [VarLen a] -> String -> String
forall a. Show a => VarLen a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> VarLen a -> String -> String
showsPrec :: Int -> VarLen a -> String -> String
$cshow :: forall a. Show a => VarLen a -> String
show :: VarLen a -> String
$cshowList :: forall a. Show a => [VarLen a] -> String -> String
showList :: [VarLen a] -> String -> String
Show, VarLen a
VarLen a -> VarLen a -> Bounded (VarLen a)
forall a. a -> a -> Bounded a
forall a. Bounded a => VarLen a
$cminBound :: forall a. Bounded a => VarLen a
minBound :: VarLen a
$cmaxBound :: forall a. Bounded a => VarLen a
maxBound :: VarLen a
Bounded, Int -> VarLen a
VarLen a -> Int
VarLen a -> [VarLen a]
VarLen a -> VarLen a
VarLen a -> VarLen a -> [VarLen a]
VarLen a -> VarLen a -> VarLen a -> [VarLen a]
(VarLen a -> VarLen a)
-> (VarLen a -> VarLen a)
-> (Int -> VarLen a)
-> (VarLen a -> Int)
-> (VarLen a -> [VarLen a])
-> (VarLen a -> VarLen a -> [VarLen a])
-> (VarLen a -> VarLen a -> [VarLen a])
-> (VarLen a -> VarLen a -> VarLen a -> [VarLen a])
-> Enum (VarLen a)
forall a. Enum a => Int -> VarLen a
forall a. Enum a => VarLen a -> Int
forall a. Enum a => VarLen a -> [VarLen a]
forall a. Enum a => VarLen a -> VarLen a
forall a. Enum a => VarLen a -> VarLen a -> [VarLen a]
forall a. Enum a => VarLen a -> VarLen a -> VarLen a -> [VarLen a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: forall a. Enum a => VarLen a -> VarLen a
succ :: VarLen a -> VarLen a
$cpred :: forall a. Enum a => VarLen a -> VarLen a
pred :: VarLen a -> VarLen a
$ctoEnum :: forall a. Enum a => Int -> VarLen a
toEnum :: Int -> VarLen a
$cfromEnum :: forall a. Enum a => VarLen a -> Int
fromEnum :: VarLen a -> Int
$cenumFrom :: forall a. Enum a => VarLen a -> [VarLen a]
enumFrom :: VarLen a -> [VarLen a]
$cenumFromThen :: forall a. Enum a => VarLen a -> VarLen a -> [VarLen a]
enumFromThen :: VarLen a -> VarLen a -> [VarLen a]
$cenumFromTo :: forall a. Enum a => VarLen a -> VarLen a -> [VarLen a]
enumFromTo :: VarLen a -> VarLen a -> [VarLen a]
$cenumFromThenTo :: forall a. Enum a => VarLen a -> VarLen a -> VarLen a -> [VarLen a]
enumFromThenTo :: VarLen a -> VarLen a -> VarLen a -> [VarLen a]
Enum, Integer -> VarLen a
VarLen a -> VarLen a
VarLen a -> VarLen a -> VarLen a
(VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a)
-> (VarLen a -> VarLen a)
-> (VarLen a -> VarLen a)
-> (Integer -> VarLen a)
-> Num (VarLen a)
forall a. Num a => Integer -> VarLen a
forall a. Num a => VarLen a -> VarLen a
forall a. Num a => VarLen a -> VarLen a -> VarLen a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall a. Num a => VarLen a -> VarLen a -> VarLen a
+ :: VarLen a -> VarLen a -> VarLen a
$c- :: forall a. Num a => VarLen a -> VarLen a -> VarLen a
- :: VarLen a -> VarLen a -> VarLen a
$c* :: forall a. Num a => VarLen a -> VarLen a -> VarLen a
* :: VarLen a -> VarLen a -> VarLen a
$cnegate :: forall a. Num a => VarLen a -> VarLen a
negate :: VarLen a -> VarLen a
$cabs :: forall a. Num a => VarLen a -> VarLen a
abs :: VarLen a -> VarLen a
$csignum :: forall a. Num a => VarLen a -> VarLen a
signum :: VarLen a -> VarLen a
$cfromInteger :: forall a. Num a => Integer -> VarLen a
fromInteger :: Integer -> VarLen a
Num, Num (VarLen a)
Ord (VarLen a)
(Num (VarLen a), Ord (VarLen a)) =>
(VarLen a -> Rational) -> Real (VarLen a)
VarLen a -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
forall a. Real a => Num (VarLen a)
forall a. Real a => Ord (VarLen a)
forall a. Real a => VarLen a -> Rational
$ctoRational :: forall a. Real a => VarLen a -> Rational
toRational :: VarLen a -> Rational
Real, Enum (VarLen a)
Real (VarLen a)
(Real (VarLen a), Enum (VarLen a)) =>
(VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> (VarLen a, VarLen a))
-> (VarLen a -> VarLen a -> (VarLen a, VarLen a))
-> (VarLen a -> Integer)
-> Integral (VarLen a)
VarLen a -> Integer
VarLen a -> VarLen a -> (VarLen a, VarLen a)
VarLen a -> VarLen a -> VarLen a
forall a. Integral a => Enum (VarLen a)
forall a. Integral a => Real (VarLen a)
forall a. Integral a => VarLen a -> Integer
forall a.
Integral a =>
VarLen a -> VarLen a -> (VarLen a, VarLen a)
forall a. Integral a => VarLen a -> VarLen a -> VarLen a
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: forall a. Integral a => VarLen a -> VarLen a -> VarLen a
quot :: VarLen a -> VarLen a -> VarLen a
$crem :: forall a. Integral a => VarLen a -> VarLen a -> VarLen a
rem :: VarLen a -> VarLen a -> VarLen a
$cdiv :: forall a. Integral a => VarLen a -> VarLen a -> VarLen a
div :: VarLen a -> VarLen a -> VarLen a
$cmod :: forall a. Integral a => VarLen a -> VarLen a -> VarLen a
mod :: VarLen a -> VarLen a -> VarLen a
$cquotRem :: forall a.
Integral a =>
VarLen a -> VarLen a -> (VarLen a, VarLen a)
quotRem :: VarLen a -> VarLen a -> (VarLen a, VarLen a)
$cdivMod :: forall a.
Integral a =>
VarLen a -> VarLen a -> (VarLen a, VarLen a)
divMod :: VarLen a -> VarLen a -> (VarLen a, VarLen a)
$ctoInteger :: forall a. Integral a => VarLen a -> Integer
toInteger :: VarLen a -> Integer
Integral, Eq (VarLen a)
VarLen a
Eq (VarLen a) =>
(VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a -> VarLen a)
-> (VarLen a -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> VarLen a
-> (Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> Bool)
-> (VarLen a -> Maybe Int)
-> (VarLen a -> Int)
-> (VarLen a -> Bool)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int -> VarLen a)
-> (VarLen a -> Int)
-> Bits (VarLen a)
Int -> VarLen a
VarLen a -> Bool
VarLen a -> Int
VarLen a -> Maybe Int
VarLen a -> VarLen a
VarLen a -> Int -> Bool
VarLen a -> Int -> VarLen a
VarLen a -> VarLen a -> VarLen a
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a. Bits a => Eq (VarLen a)
forall a. Bits a => VarLen a
forall a. Bits a => Int -> VarLen a
forall a. Bits a => VarLen a -> Bool
forall a. Bits a => VarLen a -> Int
forall a. Bits a => VarLen a -> Maybe Int
forall a. Bits a => VarLen a -> VarLen a
forall a. Bits a => VarLen a -> Int -> Bool
forall a. Bits a => VarLen a -> Int -> VarLen a
forall a. Bits a => VarLen a -> VarLen a -> VarLen a
$c.&. :: forall a. Bits a => VarLen a -> VarLen a -> VarLen a
.&. :: VarLen a -> VarLen a -> VarLen a
$c.|. :: forall a. Bits a => VarLen a -> VarLen a -> VarLen a
.|. :: VarLen a -> VarLen a -> VarLen a
$cxor :: forall a. Bits a => VarLen a -> VarLen a -> VarLen a
xor :: VarLen a -> VarLen a -> VarLen a
$ccomplement :: forall a. Bits a => VarLen a -> VarLen a
complement :: VarLen a -> VarLen a
$cshift :: forall a. Bits a => VarLen a -> Int -> VarLen a
shift :: VarLen a -> Int -> VarLen a
$crotate :: forall a. Bits a => VarLen a -> Int -> VarLen a
rotate :: VarLen a -> Int -> VarLen a
$czeroBits :: forall a. Bits a => VarLen a
zeroBits :: VarLen a
$cbit :: forall a. Bits a => Int -> VarLen a
bit :: Int -> VarLen a
$csetBit :: forall a. Bits a => VarLen a -> Int -> VarLen a
setBit :: VarLen a -> Int -> VarLen a
$cclearBit :: forall a. Bits a => VarLen a -> Int -> VarLen a
clearBit :: VarLen a -> Int -> VarLen a
$ccomplementBit :: forall a. Bits a => VarLen a -> Int -> VarLen a
complementBit :: VarLen a -> Int -> VarLen a
$ctestBit :: forall a. Bits a => VarLen a -> Int -> Bool
testBit :: VarLen a -> Int -> Bool
$cbitSizeMaybe :: forall a. Bits a => VarLen a -> Maybe Int
bitSizeMaybe :: VarLen a -> Maybe Int
$cbitSize :: forall a. Bits a => VarLen a -> Int
bitSize :: VarLen a -> Int
$cisSigned :: forall a. Bits a => VarLen a -> Bool
isSigned :: VarLen a -> Bool
$cshiftL :: forall a. Bits a => VarLen a -> Int -> VarLen a
shiftL :: VarLen a -> Int -> VarLen a
$cunsafeShiftL :: forall a. Bits a => VarLen a -> Int -> VarLen a
unsafeShiftL :: VarLen a -> Int -> VarLen a
$cshiftR :: forall a. Bits a => VarLen a -> Int -> VarLen a
shiftR :: VarLen a -> Int -> VarLen a
$cunsafeShiftR :: forall a. Bits a => VarLen a -> Int -> VarLen a
unsafeShiftR :: VarLen a -> Int -> VarLen a
$crotateL :: forall a. Bits a => VarLen a -> Int -> VarLen a
rotateL :: VarLen a -> Int -> VarLen a
$crotateR :: forall a. Bits a => VarLen a -> Int -> VarLen a
rotateR :: VarLen a -> Int -> VarLen a
$cpopCount :: forall a. Bits a => VarLen a -> Int
popCount :: VarLen a -> Int
Bits, Bits (VarLen a)
Bits (VarLen a) =>
(VarLen a -> Int)
-> (VarLen a -> Int) -> (VarLen a -> Int) -> FiniteBits (VarLen a)
VarLen a -> Int
forall a. FiniteBits a => Bits (VarLen a)
forall a. FiniteBits a => VarLen a -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: forall a. FiniteBits a => VarLen a -> Int
finiteBitSize :: VarLen a -> Int
$ccountLeadingZeros :: forall a. FiniteBits a => VarLen a -> Int
countLeadingZeros :: VarLen a -> Int
$ccountTrailingZeros :: forall a. FiniteBits a => VarLen a -> Int
countTrailingZeros :: VarLen a -> Int
FiniteBits)

instance MemPack (VarLen Word16) where
  packedByteCount :: VarLen Word16 -> Int
packedByteCount = VarLen Word16 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount
  {-# INLINE packedByteCount #-}
  packM :: forall s. VarLen Word16 -> Pack s ()
packM v :: VarLen Word16
v@(VarLen Word16
x) = (Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 (String -> Int -> Pack s ()
forall a. HasCallStack => String -> a
errorTooManyBits String
"Word16"))) (Int
numBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
    where
      p7 :: (Int -> Pack s ()) -> Int -> Pack s ()
p7 = Word16 -> (Int -> Pack s ()) -> Int -> Pack s ()
forall t s.
(Bits t, Integral t) =>
t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 Word16
x
      {-# INLINE p7 #-}
      numBits :: Int
numBits = VarLen Word16 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount VarLen Word16
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (VarLen Word16)
unpackM = do
    let d7 :: (Word8 -> Word16 -> Unpack b Word16)
-> Word8 -> Word16 -> Unpack b Word16
d7 = (Word8 -> Word16 -> Unpack b Word16)
-> Word8 -> Word16 -> Unpack b Word16
forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen
        {-# INLINE d7 #-}
    Word16 -> VarLen Word16
forall a. a -> VarLen a
VarLen (Word16 -> VarLen Word16)
-> Unpack b Word16 -> Unpack b (VarLen Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word16 -> Unpack b Word16)
-> Word8 -> Word16 -> Unpack b Word16
d7 ((Word8 -> Word16 -> Unpack b Word16)
-> Word8 -> Word16 -> Unpack b Word16
d7 (Word8 -> Word8 -> Word16 -> Unpack b Word16
forall t b.
(Num t, Bits t, MemPack t, Buffer b) =>
Word8 -> Word8 -> t -> Unpack b t
unpack7BitVarLenLast Word8
0b_1111_1100)) Word8
0 Word16
0
  {-# INLINE unpackM #-}

instance MemPack (VarLen Word32) where
  packedByteCount :: VarLen Word32 -> Int
packedByteCount = VarLen Word32 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount
  {-# INLINE packedByteCount #-}
  packM :: forall s. VarLen Word32 -> Pack s ()
packM v :: VarLen Word32
v@(VarLen Word32
x) = (Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 (String -> Int -> Pack s ()
forall a. HasCallStack => String -> a
errorTooManyBits String
"Word32"))))) (Int
numBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
    where
      p7 :: (Int -> Pack s ()) -> Int -> Pack s ()
p7 = Word32 -> (Int -> Pack s ()) -> Int -> Pack s ()
forall t s.
(Bits t, Integral t) =>
t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 Word32
x
      {-# INLINE p7 #-}
      numBits :: Int
numBits = VarLen Word32 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount VarLen Word32
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (VarLen Word32)
unpackM = do
    let d7 :: (Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
d7 = (Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen
        {-# INLINE d7 #-}
    Word32 -> VarLen Word32
forall a. a -> VarLen a
VarLen (Word32 -> VarLen Word32)
-> Unpack b Word32 -> Unpack b (VarLen Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
d7 ((Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
d7 ((Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
d7 ((Word8 -> Word32 -> Unpack b Word32)
-> Word8 -> Word32 -> Unpack b Word32
d7 (Word8 -> Word8 -> Word32 -> Unpack b Word32
forall t b.
(Num t, Bits t, MemPack t, Buffer b) =>
Word8 -> Word8 -> t -> Unpack b t
unpack7BitVarLenLast Word8
0b_1111_0000)))) Word8
0 Word32
0
  {-# INLINE unpackM #-}

instance MemPack (VarLen Word64) where
  packedByteCount :: VarLen Word64 -> Int
packedByteCount = VarLen Word64 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount
  {-# INLINE packedByteCount #-}
  packM :: forall s. VarLen Word64 -> Pack s ()
packM v :: VarLen Word64
v@(VarLen Word64
x) =
    (Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 (String -> Int -> Pack s ()
forall a. HasCallStack => String -> a
errorTooManyBits String
"Word64")))))))))) (Int
numBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
    where
      p7 :: (Int -> Pack s ()) -> Int -> Pack s ()
p7 = Word64 -> (Int -> Pack s ()) -> Int -> Pack s ()
forall t s.
(Bits t, Integral t) =>
t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 Word64
x
      {-# INLINE p7 #-}
      numBits :: Int
numBits = VarLen Word64 -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount VarLen Word64
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (VarLen Word64)
unpackM = do
    let d7 :: (Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 = (Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen
        {-# INLINE d7 #-}
    Word64 -> VarLen Word64
forall a. a -> VarLen a
VarLen (Word64 -> VarLen Word64)
-> Unpack b Word64 -> Unpack b (VarLen Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 ((Word8 -> Word64 -> Unpack b Word64)
-> Word8 -> Word64 -> Unpack b Word64
d7 (Word8 -> Word8 -> Word64 -> Unpack b Word64
forall t b.
(Num t, Bits t, MemPack t, Buffer b) =>
Word8 -> Word8 -> t -> Unpack b t
unpack7BitVarLenLast Word8
0b_1111_1110))))))))) Word8
0 Word64
0
  {-# INLINE unpackM #-}

instance MemPack (VarLen Word) where
  packedByteCount :: VarLen Word -> Int
packedByteCount = VarLen Word -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount
  {-# INLINE packedByteCount #-}
#if WORD_SIZE_IN_BITS == 32
  packM mba v@(VarLen x) = p7 (p7 (p7 (p7 (p7 (errorTooManyBits "Word"))))) (numBits - 7)
    where
      p7 = packIntoCont7 mba x
      {-# INLINE p7 #-}
      numBits = packedVarLenByteCount v * 7
  {-# INLINE packM #-}
  unpackM buf = do
    let d7 = unpack7BitVarLen buf
        {-# INLINE d7 #-}
    VarLen <$> d7 (d7 (d7 (d7 (unpack7BitVarLenLast buf 0b_1111_0000)))) 0 0
  {-# INLINE unpackM #-}
#elif WORD_SIZE_IN_BITS == 64
  packM :: forall s. VarLen Word -> Pack s ()
packM v :: VarLen Word
v@(VarLen Word
x) =
    (Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 ((Int -> Pack s ()) -> Int -> Pack s ()
forall {s}. (Int -> Pack s ()) -> Int -> Pack s ()
p7 (String -> Int -> Pack s ()
forall a. HasCallStack => String -> a
errorTooManyBits String
"Word")))))))))) (Int
numBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
    where
      p7 :: (Int -> Pack s ()) -> Int -> Pack s ()
p7 = Word -> (Int -> Pack s ()) -> Int -> Pack s ()
forall t s.
(Bits t, Integral t) =>
t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 Word
x
      {-# INLINE p7 #-}
      numBits :: Int
numBits = VarLen Word -> Int
forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount VarLen Word
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (VarLen Word)
unpackM = do
    let d7 :: (Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 = (Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen
        {-# INLINE d7 #-}
    Word -> VarLen Word
forall a. a -> VarLen a
VarLen (Word -> VarLen Word) -> Unpack b Word -> Unpack b (VarLen Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 ((Word8 -> Word -> Unpack b Word) -> Word8 -> Word -> Unpack b Word
d7 (Word8 -> Word8 -> Word -> Unpack b Word
forall t b.
(Num t, Bits t, MemPack t, Buffer b) =>
Word8 -> Word8 -> t -> Unpack b t
unpack7BitVarLenLast Word8
0b_1111_1110))))))))) Word8
0 Word
0
  {-# INLINE unpackM #-}
#else
#error "Only 32bit and 64bit systems are supported"
#endif

packedVarLenByteCount :: FiniteBits b => VarLen b -> Int
packedVarLenByteCount :: forall a. FiniteBits a => VarLen a -> Int
packedVarLenByteCount (VarLen b
x) =
  case (b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- b -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros b
x) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
7 of
    (Int
0, Int
0) -> Int
1
    (Int
q, Int
0) -> Int
q
    (Int
q, Int
_) -> Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
{-# INLINE packedVarLenByteCount #-}

errorTooManyBits :: HasCallStack => String -> a
errorTooManyBits :: forall a. HasCallStack => String -> a
errorTooManyBits String
name =
  String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Bug detected. Trying to pack more bits for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" than it should be posssible"
{-# NOINLINE errorTooManyBits #-}

packIntoCont7 ::
  (Bits t, Integral t) => t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 :: forall t s.
(Bits t, Integral t) =>
t -> (Int -> Pack s ()) -> Int -> Pack s ()
packIntoCont7 t
x Int -> Pack s ()
cont Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Word8 -> Pack s ()
forall s. Word8 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word8 t
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8 -> Word8
forall a. Bits a => a -> a
complement Word8
topBit8)
  | Bool
otherwise = do
      Word8 -> Pack s ()
forall s. Word8 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Word8 (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
n) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
topBit8)
      Int -> Pack s ()
cont (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7)
  where
    topBit8 :: Word8
    !topBit8 :: Word8
topBit8 = Word8
0b_1000_0000
{-# INLINE packIntoCont7 #-}

-- | Decode a variable length integral value that is encoded with 7 bits of data
-- and the most significant bit (MSB), the 8th bit is set whenever there are
-- more bits following. Continuation style allows us to avoid
-- recursion. Removing loops is good for performance.
unpack7BitVarLen ::
  (Num a, Bits a, Buffer b) =>
  -- | Continuation that will be invoked if MSB is set
  (Word8 -> a -> Unpack b a) ->
  -- | Will be set either to 0 initially or to the very first unmodified byte, which is
  -- guaranteed to have the first bit set.
  Word8 ->
  -- | Accumulator
  a ->
  Unpack b a
unpack7BitVarLen :: forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen Word8 -> a -> Unpack b a
cont Word8
firstByte !a
acc = do
  Word8
b8 :: Word8 <- Unpack b Word8
forall b. Buffer b => Unpack b Word8
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
  if Word8
b8 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
    then
      Word8 -> a -> Unpack b a
cont (if Word8
firstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then Word8
b8 else Word8
firstByte) (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b8 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7))
    else a -> Unpack b a
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
7 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b8)
{-# INLINE unpack7BitVarLen #-}

unpack7BitVarLenLast ::
  forall t b.
  (Num t, Bits t, MemPack t, Buffer b) =>
  Word8 ->
  Word8 ->
  t ->
  Unpack b t
unpack7BitVarLenLast :: forall t b.
(Num t, Bits t, MemPack t, Buffer b) =>
Word8 -> Word8 -> t -> Unpack b t
unpack7BitVarLenLast Word8
mask Word8
firstByte t
acc = do
  t
res <- (Word8 -> t -> Unpack b t) -> Word8 -> t -> Unpack b t
forall a b.
(Num a, Bits a, Buffer b) =>
(Word8 -> a -> Unpack b a) -> Word8 -> a -> Unpack b a
unpack7BitVarLen (\Word8
_ t
_ -> String -> Unpack b t
forall a. String -> Unpack b a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
"Too many bytes.") Word8
firstByte t
acc
  -- Only while decoding the last 7bits we check if there was too many
  -- bits supplied at the beginning.
  Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
firstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0b_1000_0000) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Unpack b ()
forall (m :: * -> *) a. MonadFail m => String -> Word8 -> m a
unpack7BitVarLenLastFail (forall a. MemPack a => String
typeName @t) Word8
firstByte
  t -> Unpack b t
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
res
{-# INLINE unpack7BitVarLenLast #-}

unpack7BitVarLenLastFail :: F.MonadFail m => String -> Word8 -> m a
unpack7BitVarLenLastFail :: forall (m :: * -> *) a. MonadFail m => String -> Word8 -> m a
unpack7BitVarLenLastFail String
name Word8
firstByte =
  String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
    String
"Unexpected bits for "
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" were set in the first byte of 'VarLen': 0x" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word8
firstByte String
""
{-# NOINLINE unpack7BitVarLenLastFail #-}

-- | This is a helper type useful for serializing number of elements in data
-- structures. It uses `VarLen` underneath, since sizes of common data structures aren't
-- too big. It also prevents negative values from being serialized and deserialized.
newtype Length = Length {Length -> Int
unLength :: Int}
  deriving (Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
/= :: Length -> Length -> Bool
Eq, Int -> Length -> String -> String
[Length] -> String -> String
Length -> String
(Int -> Length -> String -> String)
-> (Length -> String)
-> ([Length] -> String -> String)
-> Show Length
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Length -> String -> String
showsPrec :: Int -> Length -> String -> String
$cshow :: Length -> String
show :: Length -> String
$cshowList :: [Length] -> String -> String
showList :: [Length] -> String -> String
Show, Integer -> Length
Length -> Length
Length -> Length -> Length
(Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Integer -> Length)
-> Num Length
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Length -> Length -> Length
+ :: Length -> Length -> Length
$c- :: Length -> Length -> Length
- :: Length -> Length -> Length
$c* :: Length -> Length -> Length
* :: Length -> Length -> Length
$cnegate :: Length -> Length
negate :: Length -> Length
$cabs :: Length -> Length
abs :: Length -> Length
$csignum :: Length -> Length
signum :: Length -> Length
$cfromInteger :: Integer -> Length
fromInteger :: Integer -> Length
Num)

instance Bounded Length where
  minBound :: Length
minBound = Length
0
  maxBound :: Length
maxBound = Int -> Length
Length Int
forall a. Bounded a => a
maxBound

instance Enum Length where
  toEnum :: Int -> Length
toEnum Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Length
forall a. HasCallStack => String -> a
error (String -> Length) -> String -> Length
forall a b. (a -> b) -> a -> b
$ String
"toEnum: Length cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    | Bool
otherwise = Int -> Length
Length Int
n
  fromEnum :: Length -> Int
fromEnum = Length -> Int
unLength

instance MemPack Length where
  packedByteCount :: Length -> Int
packedByteCount = VarLen Word -> Int
forall a. MemPack a => a -> Int
packedByteCount (VarLen Word -> Int) -> (Length -> VarLen Word) -> Length -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> VarLen Word
forall a. a -> VarLen a
VarLen (Word -> VarLen Word) -> (Length -> Word) -> Length -> VarLen Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word (Int -> Word) -> (Length -> Int) -> Length -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> Int
unLength
  packM :: forall s. Length -> Pack s ()
packM (Length Int
n)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Pack s ()
forall a. Int -> a
packLengthError Int
n
    | Bool
otherwise = VarLen Word -> Pack s ()
forall s. VarLen Word -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Word -> VarLen Word
forall a. a -> VarLen a
VarLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
n))
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b Length
unpackM = do
    VarLen (Word
w :: Word) <- Unpack b (VarLen Word)
forall b. Buffer b => Unpack b (VarLen Word)
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
    Bool -> Unpack b () -> Unpack b ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word
w (Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Word
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Unpack b () -> Unpack b ()) -> Unpack b () -> Unpack b ()
forall a b. (a -> b) -> a -> b
$ Word -> Unpack b ()
forall (m :: * -> *) a. MonadFail m => Word -> m a
upackLengthFail Word
w
    Length -> Unpack b Length
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Length -> Unpack b Length) -> Length -> Unpack b Length
forall a b. (a -> b) -> a -> b
$ Int -> Length
Length (Int -> Length) -> Int -> Length
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Int Word
w
  {-# INLINE unpackM #-}

packLengthError :: Int -> a
packLengthError :: forall a. Int -> a
packLengthError Int
n = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Length cannot be negative. Supplied: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
{-# NOINLINE packLengthError #-}

upackLengthFail :: F.MonadFail m => Word -> m a
upackLengthFail :: forall (m :: * -> *) a. MonadFail m => Word -> m a
upackLengthFail Word
w =
  String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Attempt to unpack negative length was detected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Int Word
w)
{-# NOINLINE upackLengthFail #-}

-- | This is a helper type that is useful for creating `MemPack` instances for sum types.
newtype Tag = Tag {Tag -> Word8
unTag :: Word8}
  deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag =>
(Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tag -> Tag -> Ordering
compare :: Tag -> Tag -> Ordering
$c< :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
>= :: Tag -> Tag -> Bool
$cmax :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
min :: Tag -> Tag -> Tag
Ord, Int -> Tag -> String -> String
[Tag] -> String -> String
Tag -> String
(Int -> Tag -> String -> String)
-> (Tag -> String) -> ([Tag] -> String -> String) -> Show Tag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Tag -> String -> String
showsPrec :: Int -> Tag -> String -> String
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> String -> String
showList :: [Tag] -> String -> String
Show, Integer -> Tag
Tag -> Tag
Tag -> Tag -> Tag
(Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag)
-> (Tag -> Tag)
-> (Tag -> Tag)
-> (Integer -> Tag)
-> Num Tag
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Tag -> Tag -> Tag
+ :: Tag -> Tag -> Tag
$c- :: Tag -> Tag -> Tag
- :: Tag -> Tag -> Tag
$c* :: Tag -> Tag -> Tag
* :: Tag -> Tag -> Tag
$cnegate :: Tag -> Tag
negate :: Tag -> Tag
$cabs :: Tag -> Tag
abs :: Tag -> Tag
$csignum :: Tag -> Tag
signum :: Tag -> Tag
$cfromInteger :: Integer -> Tag
fromInteger :: Integer -> Tag
Num, Int -> Tag
Tag -> Int
Tag -> [Tag]
Tag -> Tag
Tag -> Tag -> [Tag]
Tag -> Tag -> Tag -> [Tag]
(Tag -> Tag)
-> (Tag -> Tag)
-> (Int -> Tag)
-> (Tag -> Int)
-> (Tag -> [Tag])
-> (Tag -> Tag -> [Tag])
-> (Tag -> Tag -> [Tag])
-> (Tag -> Tag -> Tag -> [Tag])
-> Enum Tag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Tag -> Tag
succ :: Tag -> Tag
$cpred :: Tag -> Tag
pred :: Tag -> Tag
$ctoEnum :: Int -> Tag
toEnum :: Int -> Tag
$cfromEnum :: Tag -> Int
fromEnum :: Tag -> Int
$cenumFrom :: Tag -> [Tag]
enumFrom :: Tag -> [Tag]
$cenumFromThen :: Tag -> Tag -> [Tag]
enumFromThen :: Tag -> Tag -> [Tag]
$cenumFromTo :: Tag -> Tag -> [Tag]
enumFromTo :: Tag -> Tag -> [Tag]
$cenumFromThenTo :: Tag -> Tag -> Tag -> [Tag]
enumFromThenTo :: Tag -> Tag -> Tag -> [Tag]
Enum, Tag
Tag -> Tag -> Bounded Tag
forall a. a -> a -> Bounded a
$cminBound :: Tag
minBound :: Tag
$cmaxBound :: Tag
maxBound :: Tag
Bounded)

-- Manually defined instance, since ghc-8.6 has issues with deriving MemPack
instance MemPack Tag where
  packedByteCount :: Tag -> Int
packedByteCount Tag
_ = Int
packedTagByteCount
  {-# INLINE packedByteCount #-}
  unpackM :: forall b. Buffer b => Unpack b Tag
unpackM = Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM
  {-# INLINE unpackM #-}
  packM :: forall s. Tag -> Pack s ()
packM = Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM
  {-# INLINE packM #-}

packedTagByteCount :: Int
packedTagByteCount :: Int
packedTagByteCount = SIZEOF_WORD8
{-# INLINE packedTagByteCount #-}

unpackTagM :: Buffer b => Unpack b Tag
unpackTagM :: forall b. Buffer b => Unpack b Tag
unpackTagM = Word8 -> Tag
Tag (Word8 -> Tag) -> Unpack b Word8 -> Unpack b Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b Word8
forall b. Buffer b => Unpack b Word8
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM
{-# INLINE unpackTagM #-}

packTagM :: Tag -> Pack s ()
packTagM :: forall s. Tag -> Pack s ()
packTagM = Word8 -> Pack s ()
forall s. Word8 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (Word8 -> Pack s ()) -> (Tag -> Word8) -> Tag -> Pack s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Word8
unTag
{-# INLINE packTagM #-}

unknownTagM :: forall a m b. (MemPack a, F.MonadFail m) => Tag -> m b
unknownTagM :: forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM (Tag Word8
t) = String -> m b
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized Tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" while decoding " String -> String -> String
forall a. [a] -> [a] -> [a]
++ forall a. MemPack a => String
typeName @a

lift_# :: (State# s -> State# s) -> Pack s ()
lift_# :: forall s. (State# s -> State# s) -> Pack s ()
lift_# State# s -> State# s
f = (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall s a. (MutableByteArray s -> StateT Int (ST s) a) -> Pack s a
Pack ((MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ())
-> (MutableByteArray s -> StateT Int (ST s) ()) -> Pack s ()
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
_ -> ST s () -> StateT Int (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> StateT Int (ST s) ())
-> ST s () -> StateT Int (ST s) ()
forall a b. (a -> b) -> a -> b
$ (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
st_ State# s -> State# s
f
{-# INLINE lift_# #-}

st_ :: (State# s -> State# s) -> ST s ()
st_ :: forall s. (State# s -> State# s) -> ST s ()
st_ State# s -> State# s
f = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s# -> (# State# s -> State# s
f State# s
s#, () #)
{-# INLINE st_ #-}