{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DefaultSignatures      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE UndecidableInstances   #-}
{- |
Module: Capnp.Classes
Description: Misc. type classes

This module defines several type classes concerning encoding and decoding
values in the capnproto wire format (as well as instances for some basic
types).

Note that much of this is unlikely to be used directly by developers.
Typically these are either used internally by generated code, or
transitively via higher level functions in the API. It is recommended
to look elsewhere in the library for what you need, and refer to this
module only when trying to understand what the class constraints on a
function mean.
-}
module Capnp.Classes
    ( IsWord(..)
    , ListElem(..)
    , MutListElem(..)
    , FromPtr(..)
    , ToPtr(..)
    , FromStruct(..)
    , ToStruct(..)
    , Allocate(..)
    , Marshal(..)
    , Cerialize(..)
    , Decerialize(..)
    , cerializeBasicVec
    , cerializeCompositeVec
    , ReadParam
    , WriteParam
    ) where

import Prelude hiding (length)

import Data.Bits
import Data.Int
import Data.Word

import Control.Monad.Catch (MonadThrow(throwM))
import Data.Foldable       (for_)
import GHC.Float
    ( castDoubleToWord64
    , castFloatToWord32
    , castWord32ToFloat
    , castWord64ToDouble
    )

import Capnp.Bits    (Word1(..))
import Capnp.Errors  (Error(SchemaViolationError))
import Capnp.Message (Mutability(..))
import Capnp.Untyped (Cap, ListOf, Ptr(..), ReadCtx, Struct, messageDefault)

import qualified Capnp.Message as M
import qualified Capnp.Untyped as U

import qualified Data.Vector as V

-- | Type alias for the constraints needed for 'a' to be used as a capnp
-- type parameter for pure modules, when reading.
type ReadParam a =
    ( Decerialize a
    , FromPtr 'Const  (Cerial 'Const a)
    )
-- | Type alias for the constraints needed for 'a' to be used as a capnp
-- type parameter for pure modules, when writing with state token 's'.
type WriteParam s a =
    ( Cerialize s a
    , ToPtr s (Cerial ('Mut s) a)
    , FromPtr ('Mut s) (Cerial ('Mut s) a)
    )

-- | Types that can be converted to and from a 64-bit word.
--
-- Anything that goes in the data section of a struct will have
-- an instance of this.
class IsWord a where
    -- | Convert from a 64-bit words Truncates the word if the
    -- type has less than 64 bits.
    fromWord :: Word64 -> a

    -- | Convert to a 64-bit word.
    toWord :: a -> Word64

-- | Types which may be stored as an element of a capnproto list.
class ListElem mut e where
    -- | The type of lists of @e@ stored in messages of type @msg@
    data List mut e

    -- | Convert an untyped list to a list of this type. May fail
    -- with a 'SchemaViolationError' if the list does not have the
    -- correct representation.
    --
    -- TODO: this is basically just fromPtr; refactor so this is less
    -- redundant.
    listFromPtr :: U.ReadCtx m mut => M.Message mut -> Maybe (U.Ptr mut) -> m (List mut e)

    toUntypedList :: List mut e -> U.List mut

    -- | Get the length of a list.
    length :: List mut e -> Int

    -- | @'index' i list@ gets the @i@th element of a list.
    index :: U.ReadCtx m mut => Int -> List mut e -> m e

-- | Types which may be stored as an element of a *mutable* capnproto list.
class (ListElem ('Mut s) e) => MutListElem s e where
    -- | @'setIndex' value i list@ sets the @i@th index in @list@ to @value@
    setIndex :: U.RWCtx m s => e -> Int -> List ('Mut s) e -> m ()

    -- | @'newList' msg size@ allocates and returns a new list of length
    -- @size@ inside @msg@.
    newList :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (List ('Mut s) e)

-- | Types which may be stored in a capnproto message, and have a fixed size.
--
-- This applies to typed structs, but not e.g. lists, because the length
-- must be known to allocate a list.
class Allocate s e | e -> s where
    -- @'new' msg@ allocates a new value of type @e@ inside @msg@.
    new :: M.WriteCtx m s => M.Message ('Mut s) -> m e

-- | Types which may be extracted from a message.
--
-- typically, instances of 'Decerialize' will be the algebraic data types
-- defined in generated code for the high-level API.
class Decerialize a where
    -- | A variation on @a@ which is encoded in the message.
    --
    -- For the case of instances in generated high-level API code, this will
    -- be the low-level API analouge of the type.
    type Cerial (mut :: Mutability) a

    -- | Extract the value from the message.
    decerialize :: U.ReadCtx m 'Const => Cerial 'Const a -> m a

-- | Types which may be marshaled into a pre-allocated object in a message.
class Decerialize a => Marshal s a where

    -- | Marshal a value into the pre-allocated object inside the message.
    --
    -- Note that caller must arrange for the object to be of the correct size.
    -- This is is not necessarily guaranteed; for example, list types must
    -- coordinate the length of the list.
    marshalInto :: U.RWCtx m s => Cerial ('Mut s) a -> a -> m ()

-- | Types which may be inserted into a message.
class Decerialize a => Cerialize s a where

    -- | Cerialize a value into the supplied message, returning the result.
    cerialize :: U.RWCtx m s => M.Message ('Mut s) -> a -> m (Cerial ('Mut s) a)

    default cerialize :: (U.RWCtx m s, Marshal s a, Allocate s (Cerial ('Mut s) a))
        => M.Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
    cerialize Message ('Mut s)
msg a
value = do
        Cerial ('Mut s) a
raw <- Message ('Mut s) -> m (Cerial ('Mut s) a)
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
Message ('Mut s) -> m e
new Message ('Mut s)
msg
        Cerial ('Mut s) a -> a -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto Cerial ('Mut s) a
raw a
value
        Cerial ('Mut s) a -> m (Cerial ('Mut s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cerial ('Mut s) a
raw

-- | Types that can be converted from an untyped pointer.
--
-- Note that decoding does not have to succeed, if the pointer is
-- the wrong type.
class FromPtr mut a where
    -- | Convert an untyped pointer to an @a@.
    fromPtr :: ReadCtx m mut => M.Message mut -> Maybe (Ptr mut) -> m a

-- | Types that can be converted to an untyped pointer.
class ToPtr s a where
    -- | Convert an @a@ to an untyped pointer.
    toPtr :: M.WriteCtx m s => M.Message ('Mut s) -> a -> m (Maybe (Ptr ('Mut s)))

-- | Types that can be extracted from a struct.
class FromStruct mut a | a -> mut where
    -- | Extract a value from a struct.
    fromStruct :: ReadCtx m mut => Struct mut -> m a

-- | Types that can be converted to a struct.
class ToStruct mut a | a -> mut where
    -- | Convert a value to a struct.
    toStruct :: a -> Struct mut

------- instances -------

instance IsWord Bool where
    fromWord :: Word64 -> Bool
fromWord Word64
n = (Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1
    toWord :: Bool -> Word64
toWord Bool
True  = Word64
1
    toWord Bool
False = Word64
0

instance IsWord Word1 where
    fromWord :: Word64 -> Word1
fromWord = Bool -> Word1
Word1 (Bool -> Word1) -> (Word64 -> Bool) -> Word64 -> Word1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bool
forall a. IsWord a => Word64 -> a
fromWord
    toWord :: Word1 -> Word64
toWord = Bool -> Word64
forall a. IsWord a => a -> Word64
toWord (Bool -> Word64) -> (Word1 -> Bool) -> Word1 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word1 -> Bool
word1ToBool

-- IsWord instances for integral types; they're all the same.
instance IsWord Int8 where
    fromWord :: Word64 -> Int8
fromWord = Word64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Int8 -> Word64
toWord = Int8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Int16 where
    fromWord :: Word64 -> Int16
fromWord = Word64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Int16 -> Word64
toWord = Int16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Int32 where
    fromWord :: Word64 -> Int32
fromWord = Word64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Int32 -> Word64
toWord = Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Int64 where
    fromWord :: Word64 -> Int64
fromWord = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Int64 -> Word64
toWord = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Word8 where
    fromWord :: Word64 -> Word8
fromWord = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Word8 -> Word64
toWord = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Word16 where
    fromWord :: Word64 -> Word16
fromWord = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Word16 -> Word64
toWord = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Word32 where
    fromWord :: Word64 -> Word32
fromWord = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Word32 -> Word64
toWord = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsWord Word64 where
    fromWord :: Word64 -> Word64
fromWord = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Word64 -> Word64
toWord = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsWord Float where
    fromWord :: Word64 -> Float
fromWord = Word32 -> Float
castWord32ToFloat (Word32 -> Float) -> (Word64 -> Word32) -> Word64 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toWord :: Float -> Word64
toWord = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> (Float -> Word32) -> Float -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
castFloatToWord32
instance IsWord Double where
    fromWord :: Word64 -> Double
fromWord = Word64 -> Double
castWord64ToDouble
    toWord :: Double -> Word64
toWord = Double -> Word64
castDoubleToWord64

-- helper function for throwing SchemaViolationError "expected ..."
expected :: MonadThrow m => String -> m a
expected :: String -> m a
expected String
msg = Error -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m a) -> Error -> m a
forall a b. (a -> b) -> a -> b
$ String -> Error
SchemaViolationError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

-- To/FromPtr instance for lists of Void/().
instance FromPtr mut (ListOf mut ()) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut ())
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                       = Message mut -> m (ListOf mut ())
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List0 ListOf mut ()
list))) = ListOf mut () -> m (ListOf mut ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut ()
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut ())
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 0"
instance ToPtr s (ListOf ('Mut s) ()) where
    toPtr :: Message ('Mut s) -> ListOf ('Mut s) () -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) () -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) ()
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) () -> Ptr ('Mut s))
-> ListOf ('Mut s) ()
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) () -> List ('Mut s))
-> ListOf ('Mut s) ()
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) () -> List ('Mut s)
forall (mut :: Mutability). ListOf mut () -> List mut
U.List0

-- To/FromPtr instances for lists of unsigned integers.
instance FromPtr mut (ListOf mut Word8) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut Word8)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                       = Message mut -> m (ListOf mut Word8)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List8 ListOf mut Word8
list))) = ListOf mut Word8 -> m (ListOf mut Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut Word8
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut Word8)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 8"
instance ToPtr s (ListOf ('Mut s) Word8) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) Word8 -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) Word8 -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) Word8
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) Word8 -> Ptr ('Mut s))
-> ListOf ('Mut s) Word8
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) Word8 -> List ('Mut s))
-> ListOf ('Mut s) Word8
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) Word8 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word8 -> List mut
U.List8
instance FromPtr mut (ListOf mut Word16) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut Word16)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                       = Message mut -> m (ListOf mut Word16)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List16 ListOf mut Word16
list))) = ListOf mut Word16 -> m (ListOf mut Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut Word16
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut Word16)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 16"
instance ToPtr s (ListOf ('Mut s) Word16) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) Word16 -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) Word16 -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) Word16
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) Word16 -> Ptr ('Mut s))
-> ListOf ('Mut s) Word16
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) Word16 -> List ('Mut s))
-> ListOf ('Mut s) Word16
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) Word16 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word16 -> List mut
U.List16
instance FromPtr mut (ListOf mut Word32) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut Word32)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                       = Message mut -> m (ListOf mut Word32)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List32 ListOf mut Word32
list))) = ListOf mut Word32 -> m (ListOf mut Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut Word32
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut Word32)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 32"
instance ToPtr s (ListOf ('Mut s) Word32) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) Word32 -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) Word32 -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) Word32
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) Word32 -> Ptr ('Mut s))
-> ListOf ('Mut s) Word32
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) Word32 -> List ('Mut s))
-> ListOf ('Mut s) Word32
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) Word32 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word32 -> List mut
U.List32
instance FromPtr mut (ListOf mut Word64) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut Word64)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                        = Message mut -> m (ListOf mut Word64)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List64 ListOf mut Word64
list))) = ListOf mut Word64 -> m (ListOf mut Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut Word64
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut Word64)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 64"
instance ToPtr s (ListOf ('Mut s) Word64) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) Word64 -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) Word64 -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) Word64
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) Word64 -> Ptr ('Mut s))
-> ListOf ('Mut s) Word64
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) Word64 -> List ('Mut s))
-> ListOf ('Mut s) Word64
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) Word64 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word64 -> List mut
U.List64

instance FromPtr mut (ListOf mut Bool) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut Bool)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing = Message mut -> m (ListOf mut Bool)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.List1 ListOf mut Bool
list))) = ListOf mut Bool -> m (ListOf mut Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut Bool
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut Bool)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 1."
instance ToPtr s (ListOf ('Mut s) Bool) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) Bool -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) Bool -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) Bool
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) Bool -> Ptr ('Mut s))
-> ListOf ('Mut s) Bool
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) Bool -> List ('Mut s))
-> ListOf ('Mut s) Bool
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) Bool -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Bool -> List mut
U.List1

-- To/FromPtr instance for pointers -- this is just the identity.
instance FromPtr mut (Maybe (Ptr mut)) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
fromPtr Message mut
_ = Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance ToPtr s (Maybe (Ptr ('Mut s))) where
    toPtr :: Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- To/FromPtr instance for composite lists.
instance FromPtr mut (ListOf mut (Struct mut)) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut (Struct mut))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                            = Message mut -> m (ListOf mut (Struct mut))
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.ListStruct ListOf mut (Struct mut)
list))) = ListOf mut (Struct mut) -> m (ListOf mut (Struct mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut (Struct mut)
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut (Struct mut))
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list of structs"
instance ToPtr s (ListOf ('Mut s) (Struct ('Mut s))) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) (Struct ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) (Struct ('Mut s)) -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) (Struct ('Mut s))
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) (Struct ('Mut s)) -> Ptr ('Mut s))
-> ListOf ('Mut s) (Struct ('Mut s))
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s))
-> ListOf ('Mut s) (Struct ('Mut s))
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s)
forall (mut :: Mutability). ListOf mut (Struct mut) -> List mut
U.ListStruct

-- To/FromPtr instance for lists of pointers.
instance FromPtr mut (ListOf mut (Maybe (Ptr mut))) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (ListOf mut (Maybe (Ptr mut)))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing                         = Message mut -> m (ListOf mut (Maybe (Ptr mut)))
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg
    fromPtr Message mut
_ (Just (PtrList (U.ListPtr ListOf mut (Maybe (Ptr mut))
list))) = ListOf mut (Maybe (Ptr mut)) -> m (ListOf mut (Maybe (Ptr mut)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf mut (Maybe (Ptr mut))
list
    fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (ListOf mut (Maybe (Ptr mut)))
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list of pointers"
instance ToPtr s (ListOf ('Mut s) (Maybe (Ptr ('Mut s)))) where
    toPtr :: Message ('Mut s)
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> Maybe (Ptr ('Mut s)))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> Ptr ('Mut s))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s)
forall (mut :: Mutability).
ListOf mut (Maybe (Ptr mut)) -> List mut
U.ListPtr

-- To/FromPtr instance for *typed* lists.
instance ListElem mut e => FromPtr mut (List mut e) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (List mut e)
fromPtr = Message mut -> Maybe (Ptr mut) -> m (List mut e)
forall (mut :: Mutability) e (m :: * -> *).
(ListElem mut e, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m (List mut e)
listFromPtr
instance ListElem ('Mut s) e => ToPtr s (List ('Mut s) e) where
    toPtr :: Message ('Mut s) -> List ('Mut s) e -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (List ('Mut s) e -> Maybe (Ptr ('Mut s)))
-> List ('Mut s) e
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (List ('Mut s) e -> Ptr ('Mut s))
-> List ('Mut s) e
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (List ('Mut s) e -> List ('Mut s))
-> List ('Mut s) e
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) e -> List ('Mut s)
forall (mut :: Mutability) e.
ListElem mut e =>
List mut e -> List mut
toUntypedList

-- ListElem instance for (typed) nested lists.
instance ListElem mut e => ListElem mut (List mut e) where
    newtype List mut (List mut e) = NestedList (U.ListOf mut (Maybe (U.Ptr mut)))

    listFromPtr :: Message mut -> Maybe (Ptr mut) -> m (List mut (List mut e))
listFromPtr Message mut
msg Maybe (Ptr mut)
ptr = ListOf mut (Maybe (Ptr mut)) -> List mut (List mut e)
forall (mut :: Mutability) e.
ListOf mut (Maybe (Ptr mut)) -> List mut (List mut e)
NestedList (ListOf mut (Maybe (Ptr mut)) -> List mut (List mut e))
-> m (ListOf mut (Maybe (Ptr mut))) -> m (List mut (List mut e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> Maybe (Ptr mut) -> m (ListOf mut (Maybe (Ptr mut)))
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
fromPtr Message mut
msg Maybe (Ptr mut)
ptr
    toUntypedList :: List mut (List mut e) -> List mut
toUntypedList (NestedList l) = ListOf mut (Maybe (Ptr mut)) -> List mut
forall (mut :: Mutability).
ListOf mut (Maybe (Ptr mut)) -> List mut
U.ListPtr ListOf mut (Maybe (Ptr mut))
l

    length :: List mut (List mut e) -> Int
length (NestedList l) = ListOf mut (Maybe (Ptr mut)) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mut (Maybe (Ptr mut))
l
    index :: Int -> List mut (List mut e) -> m (List mut e)
index Int
i (NestedList l) = do
        Maybe (Ptr mut)
ptr <- Int -> ListOf mut (Maybe (Ptr mut)) -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mut (Maybe (Ptr mut))
l
        Message mut -> Maybe (Ptr mut) -> m (List mut e)
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
fromPtr (ListOf mut (Maybe (Ptr mut)) -> Message mut
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message ListOf mut (Maybe (Ptr mut))
l) Maybe (Ptr mut)
ptr

instance MutListElem s e => MutListElem s (List ('Mut s) e) where
    setIndex :: List ('Mut s) e -> Int -> List ('Mut s) (List ('Mut s) e) -> m ()
setIndex List ('Mut s) e
e Int
i (NestedList l) = Maybe (Ptr ('Mut s))
-> Int -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex (Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
U.PtrList (List ('Mut s) e -> List ('Mut s)
forall (mut :: Mutability) e.
ListElem mut e =>
List mut e -> List mut
toUntypedList List ('Mut s) e
e))) Int
i ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
l
    newList :: Message ('Mut s) -> Int -> m (List ('Mut s) (List ('Mut s) e))
newList Message ('Mut s)
msg Int
len = ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> List ('Mut s) (List ('Mut s) e)
forall (mut :: Mutability) e.
ListOf mut (Maybe (Ptr mut)) -> List mut (List mut e)
NestedList (ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
 -> List ('Mut s) (List ('Mut s) e))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
-> m (List ('Mut s) (List ('Mut s) e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> Int -> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Int -> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
U.allocListPtr Message ('Mut s)
msg Int
len

-- FromStruct instance for Struct; just the identity.
instance FromStruct mut (Struct mut) where
    fromStruct :: Struct mut -> m (Struct mut)
fromStruct = Struct mut -> m (Struct mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ToStruct mut (Struct mut) where
    toStruct :: Struct mut -> Struct mut
toStruct = Struct mut -> Struct mut
forall a. a -> a
id

instance FromPtr mut (Struct mut) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (Struct mut)
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing            = Message mut -> m (Struct mut)
forall a (mut :: Mutability) (m :: * -> *).
(MessageDefault a mut, ReadCtx m mut) =>
Message mut -> m a
messageDefault Message mut
msg m (Struct mut) -> (Struct mut -> m (Struct mut)) -> m (Struct mut)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct mut -> m (Struct mut)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
fromStruct
    fromPtr Message mut
_ (Just (PtrStruct Struct mut
s)) = Struct mut -> m (Struct mut)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
fromStruct Struct mut
s
    fromPtr Message mut
_ Maybe (Ptr mut)
_                    = String -> m (Struct mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to struct"
instance ToPtr s (Struct ('Mut s)) where
    toPtr :: Message ('Mut s) -> Struct ('Mut s) -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (Struct ('Mut s) -> Maybe (Ptr ('Mut s)))
-> Struct ('Mut s)
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Struct ('Mut s) -> Ptr ('Mut s))
-> Struct ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct

instance FromPtr mut (Maybe (Cap mut)) where
    fromPtr :: Message mut -> Maybe (Ptr mut) -> m (Maybe (Cap mut))
fromPtr Message mut
_ Maybe (Ptr mut)
Nothing             = Maybe (Cap mut) -> m (Maybe (Cap mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Cap mut)
forall a. Maybe a
Nothing
    fromPtr Message mut
_ (Just (PtrCap Cap mut
cap)) = Maybe (Cap mut) -> m (Maybe (Cap mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cap mut -> Maybe (Cap mut)
forall a. a -> Maybe a
Just Cap mut
cap)
    fromPtr Message mut
_ Maybe (Ptr mut)
_                   = String -> m (Maybe (Cap mut))
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
instance ToPtr s (Maybe (Cap ('Mut s))) where
    toPtr :: Message ('Mut s)
-> Maybe (Cap ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
_ = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s))))
-> (Maybe (Cap ('Mut s)) -> Maybe (Ptr ('Mut s)))
-> Maybe (Cap ('Mut s))
-> m (Maybe (Ptr ('Mut s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cap ('Mut s) -> Ptr ('Mut s))
-> Maybe (Cap ('Mut s)) -> Maybe (Ptr ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap

-- | A valid implementation of 'cerialize', which just cerializes the
-- elements of a list individually and puts them in the list.
--
-- Note that while this is *correct* for composite lists, it is inefficient,
-- since it will separately allocate the elements and then copy them into
-- the list, doing extra work and leaking space. See 'cerializeCompositeVec'.
cerializeBasicVec ::
    ( U.RWCtx m s
    , MutListElem s (Cerial ('Mut s) a)
    , Cerialize s a
    )
    => M.Message ('Mut s)
    -> V.Vector a
    -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec :: Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec Message ('Mut s)
msg Vector a
vec = do
    List ('Mut s) (Cerial ('Mut s) a)
list <- Message ('Mut s) -> Int -> m (List ('Mut s) (Cerial ('Mut s) a))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
Message ('Mut s) -> Int -> m (List ('Mut s) e)
newList Message ('Mut s)
msg (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec)
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Cerial ('Mut s) a
e <- Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
cerialize Message ('Mut s)
msg (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i)
        Cerial ('Mut s) a
-> Int -> List ('Mut s) (Cerial ('Mut s) a) -> m ()
forall s e (m :: * -> *).
(MutListElem s e, RWCtx m s) =>
e -> Int -> List ('Mut s) e -> m ()
setIndex Cerial ('Mut s) a
e Int
i List ('Mut s) (Cerial ('Mut s) a)
list
    List ('Mut s) (Cerial ('Mut s) a)
-> m (List ('Mut s) (Cerial ('Mut s) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure List ('Mut s) (Cerial ('Mut s) a)
list

-- | A valid implementation of 'cerialize', which allocates a list of the
-- correct size and then marshals the elements of a vector into the elements
-- of the list. This is more efficient for composite types than
-- 'cerializeBasicVec', hence the name.
cerializeCompositeVec ::
    ( U.RWCtx m s
    , MutListElem s (Cerial ('Mut s) a)
    , Marshal s a
    )
    => M.Message ('Mut s)
    -> V.Vector a
    -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeCompositeVec :: Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeCompositeVec Message ('Mut s)
msg Vector a
vec = do
    List ('Mut s) (Cerial ('Mut s) a)
list <- Message ('Mut s) -> Int -> m (List ('Mut s) (Cerial ('Mut s) a))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
Message ('Mut s) -> Int -> m (List ('Mut s) e)
newList Message ('Mut s)
msg (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec)
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Cerial ('Mut s) a
targ <- Int -> List ('Mut s) (Cerial ('Mut s) a) -> m (Cerial ('Mut s) a)
forall (mut :: Mutability) e (m :: * -> *).
(ListElem mut e, ReadCtx m mut) =>
Int -> List mut e -> m e
index Int
i List ('Mut s) (Cerial ('Mut s) a)
list
        Cerial ('Mut s) a -> a -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto Cerial ('Mut s) a
targ (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i)
    List ('Mut s) (Cerial ('Mut s) a)
-> m (List ('Mut s) (Cerial ('Mut s) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure List ('Mut s) (Cerial ('Mut s) a)
list

-- Generic decerialize instances for lists, given that the element type has an instance.
instance
    ( ListElem 'Const (Cerial 'Const a)
    , Decerialize a
    ) => Decerialize (V.Vector a)
  where
    type Cerial mut (V.Vector a) = List mut (Cerial mut a)
    decerialize :: Cerial 'Const (Vector a) -> m (Vector a)
decerialize Cerial 'Const (Vector a)
raw = Int -> (Int -> m a) -> m (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (List 'Const (Cerial 'Const a) -> Int
forall (mut :: Mutability) e. ListElem mut e => List mut e -> Int
length Cerial 'Const (Vector a)
List 'Const (Cerial 'Const a)
raw) (\Int
i -> Int -> List 'Const (Cerial 'Const a) -> m (Cerial 'Const a)
forall (mut :: Mutability) e (m :: * -> *).
(ListElem mut e, ReadCtx m mut) =>
Int -> List mut e -> m e
index Int
i Cerial 'Const (Vector a)
List 'Const (Cerial 'Const a)
raw m (Cerial 'Const a) -> (Cerial 'Const a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial 'Const a -> m a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
decerialize)