{-# LANGUAGE ConstraintKinds        #-}
{-# 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.ReinterpretCast
import Data.Word

import Control.Monad.Catch (MonadThrow(throwM))
import Data.Foldable       (for_)

import Capnp.Bits    (Word1 (..))
import Capnp.Errors  (Error(SchemaViolationError))
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 M.ConstMsg (Cerial M.ConstMsg 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 (M.MutMsg s) a)
    , FromPtr (M.MutMsg s) (Cerial (M.MutMsg 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 msg e where
    -- | The type of lists of @e@ stored in messages of type @msg@
    data List msg 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 msg => msg -> Maybe (U.Ptr msg) -> m (List msg e)

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

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

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

-- | Types which may be stored as an element of a *mutable* capnproto list.
class (ListElem (M.MutMsg 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 (M.MutMsg s) e -> m ()

    -- | @'newList' msg size@ allocates and returns a new list of length
    -- @size@ inside @msg@.
    newList :: M.WriteCtx m s => M.MutMsg s -> Int -> m (List (M.MutMsg 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.MutMsg 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 msg a

    -- | Extract the value from the message.
    decerialize :: U.ReadCtx m M.ConstMsg => Cerial M.ConstMsg 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 (M.MutMsg 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.MutMsg s -> a -> m (Cerial (M.MutMsg s) a)

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

-- | Types that can be converted from an untyped pointer.
--
-- Note that decoding do not have to succeed, if the pointer is
-- the wrong type.
class FromPtr msg a where
    -- | Convert an untyped pointer to an @a@.
    fromPtr :: ReadCtx m msg => msg -> Maybe (Ptr msg) -> 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.MutMsg s -> a -> m (Maybe (Ptr (M.MutMsg s)))

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

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

------- 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
wordToFloat (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
floatToWord
instance IsWord Double where
    fromWord :: Word64 -> Double
fromWord = Word64 -> Double
wordToDouble
    toWord :: Double -> Word64
toWord = Double -> Word64
doubleToWord

-- 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 msg (ListOf msg ()) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (ListOf msg ())
fromPtr msg
msg Maybe (Ptr msg)
Nothing                         = ListOf msg () -> m (ListOf msg ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf msg () -> m (ListOf msg ()))
-> ListOf msg () -> m (ListOf msg ())
forall a b. (a -> b) -> a -> b
$ InMessage (ListOf msg ()) -> ListOf msg ()
forall a. MessageDefault a => InMessage a -> a
messageDefault msg
InMessage (ListOf msg ())
msg
    fromPtr msg
_ (Just (PtrList (U.List0 ListOf msg ()
list))) = ListOf msg () -> m (ListOf msg ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf msg ()
list
    fromPtr msg
_ Maybe (Ptr msg)
_ = String -> m (ListOf msg ())
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list with element size 0"
instance ToPtr s (ListOf (M.MutMsg s) ()) where
    toPtr :: MutMsg s -> ListOf (MutMsg s) () -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
_ = Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s))))
-> (ListOf (MutMsg s) () -> Maybe (Ptr (MutMsg s)))
-> ListOf (MutMsg s) ()
-> m (Maybe (Ptr (MutMsg s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (ListOf (MutMsg s) () -> Ptr (MutMsg s))
-> ListOf (MutMsg s) ()
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (MutMsg s) -> Ptr (MutMsg s)
forall msg. List msg -> Ptr msg
PtrList (List (MutMsg s) -> Ptr (MutMsg s))
-> (ListOf (MutMsg s) () -> List (MutMsg s))
-> ListOf (MutMsg s) ()
-> Ptr (MutMsg s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf (MutMsg s) () -> List (MutMsg s)
forall msg. ListOf msg () -> List msg
U.List0

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

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

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

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

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

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

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

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

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

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

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

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

instance FromPtr msg (Struct msg) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Struct msg)
fromPtr msg
msg Maybe (Ptr msg)
Nothing              = Struct msg -> m (Struct msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
fromStruct (msg -> Struct msg
forall msg. msg -> Struct msg
go msg
msg) where
        -- the type checker needs a bit of help inferring the type here.
        go :: msg -> Struct msg
        go :: msg -> Struct msg
go = msg -> Struct msg
forall a. MessageDefault a => InMessage a -> a
messageDefault
    fromPtr msg
_ (Just (PtrStruct Struct msg
s)) = Struct msg -> m (Struct msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
fromStruct Struct msg
s
    fromPtr msg
_ Maybe (Ptr msg)
_                      = String -> m (Struct msg)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to struct"
instance ToPtr s (Struct (M.MutMsg s)) where
    toPtr :: MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
_ = Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s))))
-> (Struct (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> Struct (MutMsg s)
-> m (Maybe (Ptr (MutMsg s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Struct (MutMsg s) -> Ptr (MutMsg s))
-> Struct (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (MutMsg s) -> Ptr (MutMsg s)
forall msg. Struct msg -> Ptr msg
PtrStruct

instance FromPtr msg (Maybe (Cap msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Maybe (Cap msg))
fromPtr msg
_ Maybe (Ptr msg)
Nothing             = Maybe (Cap msg) -> m (Maybe (Cap msg))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Cap msg)
forall a. Maybe a
Nothing
    fromPtr msg
_ (Just (PtrCap Cap msg
cap)) = Maybe (Cap msg) -> m (Maybe (Cap msg))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cap msg -> Maybe (Cap msg)
forall a. a -> Maybe a
Just Cap msg
cap)
    fromPtr msg
_ Maybe (Ptr msg)
_                   = String -> m (Maybe (Cap msg))
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
instance ToPtr s (Maybe (Cap (M.MutMsg s))) where
    toPtr :: MutMsg s -> Maybe (Cap (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
_ = Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s))))
-> (Maybe (Cap (MutMsg s)) -> Maybe (Ptr (MutMsg s)))
-> Maybe (Cap (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cap (MutMsg s) -> Ptr (MutMsg s))
-> Maybe (Cap (MutMsg s)) -> Maybe (Ptr (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cap (MutMsg s) -> Ptr (MutMsg s)
forall msg. Cap msg -> Ptr msg
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 (M.MutMsg s) a)
    , Cerialize s a
    )
    => M.MutMsg s
    -> V.Vector a
    -> m (List (M.MutMsg s) (Cerial (M.MutMsg s) a))
cerializeBasicVec :: MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec MutMsg s
msg Vector a
vec = do
    List (MutMsg s) (Cerial (MutMsg s) a)
list <- MutMsg s -> Int -> m (List (MutMsg s) (Cerial (MutMsg s) a))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
newList MutMsg 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 (MutMsg s) a
e <- MutMsg s -> a -> m (Cerial (MutMsg s) a)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
cerialize MutMsg s
msg (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i)
        Cerial (MutMsg s) a
-> Int -> List (MutMsg s) (Cerial (MutMsg s) a) -> m ()
forall s e (m :: * -> *).
(MutListElem s e, RWCtx m s) =>
e -> Int -> List (MutMsg s) e -> m ()
setIndex Cerial (MutMsg s) a
e Int
i List (MutMsg s) (Cerial (MutMsg s) a)
list
    List (MutMsg s) (Cerial (MutMsg s) a)
-> m (List (MutMsg s) (Cerial (MutMsg s) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure List (MutMsg s) (Cerial (MutMsg 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 (M.MutMsg s) a)
    , Marshal s a
    )
    => M.MutMsg s
    -> V.Vector a
    -> m (List (M.MutMsg s) (Cerial (M.MutMsg s) a))
cerializeCompositeVec :: MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeCompositeVec MutMsg s
msg Vector a
vec = do
    List (MutMsg s) (Cerial (MutMsg s) a)
list <- MutMsg s -> Int -> m (List (MutMsg s) (Cerial (MutMsg s) a))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
newList MutMsg 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 (MutMsg s) a
targ <- Int
-> List (MutMsg s) (Cerial (MutMsg s) a) -> m (Cerial (MutMsg s) a)
forall msg e (m :: * -> *).
(ListElem msg e, ReadCtx m msg) =>
Int -> List msg e -> m e
index Int
i List (MutMsg s) (Cerial (MutMsg s) a)
list
        Cerial (MutMsg s) a -> a -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
marshalInto Cerial (MutMsg s) a
targ (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i)
    List (MutMsg s) (Cerial (MutMsg s) a)
-> m (List (MutMsg s) (Cerial (MutMsg s) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure List (MutMsg s) (Cerial (MutMsg s) a)
list

-- Generic decerialize instances for lists, given that the element type has an instance.
instance
    ( ListElem M.ConstMsg (Cerial M.ConstMsg a)
    , Decerialize a
    ) => Decerialize (V.Vector a)
  where
    type Cerial msg (V.Vector a) = List msg (Cerial msg a)
    decerialize :: Cerial ConstMsg (Vector a) -> m (Vector a)
decerialize Cerial ConstMsg (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 ConstMsg (Cerial ConstMsg a) -> Int
forall msg e. ListElem msg e => List msg e -> Int
length Cerial ConstMsg (Vector a)
List ConstMsg (Cerial ConstMsg a)
raw) (\Int
i -> Int -> List ConstMsg (Cerial ConstMsg a) -> m (Cerial ConstMsg a)
forall msg e (m :: * -> *).
(ListElem msg e, ReadCtx m msg) =>
Int -> List msg e -> m e
index Int
i Cerial ConstMsg (Vector a)
List ConstMsg (Cerial ConstMsg a)
raw m (Cerial ConstMsg a) -> (Cerial ConstMsg a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial ConstMsg a -> m a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
decerialize)