{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-|
Module: Capnp.Untyped.Pure
Description: high-level API for working with untyped Cap'N Proto values.

This module provides an idiomatic Haskell interface for untyped capnp
data, based on algebraic datatypes. It forgoes some of the benefits of
the capnp wire format in favor of a more convienient API.

In addition to the algebraic data types themselves, this module also
provides support for converting from the lower-level types in
"Capnp.Untyped".
-}
module Capnp.Untyped.Pure
    ( Slice(..)
    , Ptr(..)
    , Struct(..)
    , List(..)
    , ListOf
    , length
    , sliceIndex
    )
  where

import Prelude hiding (length)

import Data.Word

import Control.Monad                 (forM_)
import Data.Default                  (Default(def))
import Data.Default.Instances.Vector ()
import GHC.Exts                      (IsList (..))
import GHC.Generics                  (Generic)

import Capnp.Classes
    ( Cerialize (..)
    , Decerialize (..)
    , FromStruct (..)
    , Marshal (..)
    , ToPtr (..)
    )
import Internal.Gen.Instances ()

import qualified Capnp.Message as M
import qualified Capnp.Untyped as U
import qualified Data.Vector   as V

-- | A one of a struct's sections (data or pointer).
--
-- This is just a newtype wrapper around 'ListOf' (which is itself just
-- 'V.Vector'), but critically the notion of equality is different. Two
-- slices are considered equal if all of their elements are equal, but
-- If the slices are different lengths, missing elements are treated as
-- having default values. Accordingly, equality is only defined if the
-- element type is an instance of 'Default'.
newtype Slice a = Slice (ListOf a)
    deriving((forall x. Slice a -> Rep (Slice a) x)
-> (forall x. Rep (Slice a) x -> Slice a) -> Generic (Slice a)
forall x. Rep (Slice a) x -> Slice a
forall x. Slice a -> Rep (Slice a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Slice a) x -> Slice a
forall a x. Slice a -> Rep (Slice a) x
$cto :: forall a x. Rep (Slice a) x -> Slice a
$cfrom :: forall a x. Slice a -> Rep (Slice a) x
Generic, Int -> Slice a -> ShowS
[Slice a] -> ShowS
Slice a -> String
(Int -> Slice a -> ShowS)
-> (Slice a -> String) -> ([Slice a] -> ShowS) -> Show (Slice a)
forall a. Show a => Int -> Slice a -> ShowS
forall a. Show a => [Slice a] -> ShowS
forall a. Show a => Slice a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slice a] -> ShowS
$cshowList :: forall a. Show a => [Slice a] -> ShowS
show :: Slice a -> String
$cshow :: forall a. Show a => Slice a -> String
showsPrec :: Int -> Slice a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Slice a -> ShowS
Show, Eq (Slice a)
Eq (Slice a)
-> (Slice a -> Slice a -> Ordering)
-> (Slice a -> Slice a -> Bool)
-> (Slice a -> Slice a -> Bool)
-> (Slice a -> Slice a -> Bool)
-> (Slice a -> Slice a -> Bool)
-> (Slice a -> Slice a -> Slice a)
-> (Slice a -> Slice a -> Slice a)
-> Ord (Slice a)
Slice a -> Slice a -> Bool
Slice a -> Slice a -> Ordering
Slice a -> Slice a -> Slice 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. (Default a, Ord a) => Eq (Slice a)
forall a. (Default a, Ord a) => Slice a -> Slice a -> Bool
forall a. (Default a, Ord a) => Slice a -> Slice a -> Ordering
forall a. (Default a, Ord a) => Slice a -> Slice a -> Slice a
min :: Slice a -> Slice a -> Slice a
$cmin :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Slice a
max :: Slice a -> Slice a -> Slice a
$cmax :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Slice a
>= :: Slice a -> Slice a -> Bool
$c>= :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Bool
> :: Slice a -> Slice a -> Bool
$c> :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Bool
<= :: Slice a -> Slice a -> Bool
$c<= :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Bool
< :: Slice a -> Slice a -> Bool
$c< :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Bool
compare :: Slice a -> Slice a -> Ordering
$ccompare :: forall a. (Default a, Ord a) => Slice a -> Slice a -> Ordering
$cp1Ord :: forall a. (Default a, Ord a) => Eq (Slice a)
Ord, a -> Slice b -> Slice a
(a -> b) -> Slice a -> Slice b
(forall a b. (a -> b) -> Slice a -> Slice b)
-> (forall a b. a -> Slice b -> Slice a) -> Functor Slice
forall a b. a -> Slice b -> Slice a
forall a b. (a -> b) -> Slice a -> Slice b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Slice b -> Slice a
$c<$ :: forall a b. a -> Slice b -> Slice a
fmap :: (a -> b) -> Slice a -> Slice b
$cfmap :: forall a b. (a -> b) -> Slice a -> Slice b
Functor, Slice a
Slice a -> Default (Slice a)
forall a. Slice a
forall a. a -> Default a
def :: Slice a
$cdef :: forall a. Slice a
Default, Int -> [Item (Slice a)] -> Slice a
[Item (Slice a)] -> Slice a
Slice a -> [Item (Slice a)]
([Item (Slice a)] -> Slice a)
-> (Int -> [Item (Slice a)] -> Slice a)
-> (Slice a -> [Item (Slice a)])
-> IsList (Slice a)
forall a. Int -> [Item (Slice a)] -> Slice a
forall a. [Item (Slice a)] -> Slice a
forall a. Slice a -> [Item (Slice a)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
toList :: Slice a -> [Item (Slice a)]
$ctoList :: forall a. Slice a -> [Item (Slice a)]
fromListN :: Int -> [Item (Slice a)] -> Slice a
$cfromListN :: forall a. Int -> [Item (Slice a)] -> Slice a
fromList :: [Item (Slice a)] -> Slice a
$cfromList :: forall a. [Item (Slice a)] -> Slice a
IsList)

-- | A capnproto pointer type.
data Ptr
    = PtrStruct !Struct
    | PtrList   !List
    | PtrCap    !M.Client
    deriving((forall x. Ptr -> Rep Ptr x)
-> (forall x. Rep Ptr x -> Ptr) -> Generic Ptr
forall x. Rep Ptr x -> Ptr
forall x. Ptr -> Rep Ptr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ptr x -> Ptr
$cfrom :: forall x. Ptr -> Rep Ptr x
Generic, Int -> Ptr -> ShowS
[Ptr] -> ShowS
Ptr -> String
(Int -> Ptr -> ShowS)
-> (Ptr -> String) -> ([Ptr] -> ShowS) -> Show Ptr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ptr] -> ShowS
$cshowList :: [Ptr] -> ShowS
show :: Ptr -> String
$cshow :: Ptr -> String
showsPrec :: Int -> Ptr -> ShowS
$cshowsPrec :: Int -> Ptr -> ShowS
Show, Ptr -> Ptr -> Bool
(Ptr -> Ptr -> Bool) -> (Ptr -> Ptr -> Bool) -> Eq Ptr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ptr -> Ptr -> Bool
$c/= :: Ptr -> Ptr -> Bool
== :: Ptr -> Ptr -> Bool
$c== :: Ptr -> Ptr -> Bool
Eq)

-- | A capnproto struct.
data Struct = Struct
    { Struct -> Slice Word64
structData :: Slice Word64
    -- ^ The struct's data section
    , Struct -> Slice (Maybe Ptr)
structPtrs :: Slice (Maybe Ptr)
    -- ^ The struct's pointer section
    }
    deriving((forall x. Struct -> Rep Struct x)
-> (forall x. Rep Struct x -> Struct) -> Generic Struct
forall x. Rep Struct x -> Struct
forall x. Struct -> Rep Struct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Struct x -> Struct
$cfrom :: forall x. Struct -> Rep Struct x
Generic, Int -> Struct -> ShowS
[Struct] -> ShowS
Struct -> String
(Int -> Struct -> ShowS)
-> (Struct -> String) -> ([Struct] -> ShowS) -> Show Struct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Struct] -> ShowS
$cshowList :: [Struct] -> ShowS
show :: Struct -> String
$cshow :: Struct -> String
showsPrec :: Int -> Struct -> ShowS
$cshowsPrec :: Int -> Struct -> ShowS
Show, Struct -> Struct -> Bool
(Struct -> Struct -> Bool)
-> (Struct -> Struct -> Bool) -> Eq Struct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Struct -> Struct -> Bool
$c/= :: Struct -> Struct -> Bool
== :: Struct -> Struct -> Bool
$c== :: Struct -> Struct -> Bool
Eq)
instance Default Struct

-- | An untyped list.
data List
    = List0  (ListOf ())
    | List1  (ListOf Bool)
    | List8  (ListOf Word8)
    | List16 (ListOf Word16)
    | List32 (ListOf Word32)
    | List64 (ListOf Word64)
    | ListPtr (ListOf (Maybe Ptr))
    | ListStruct (ListOf Struct)
    deriving((forall x. List -> Rep List x)
-> (forall x. Rep List x -> List) -> Generic List
forall x. Rep List x -> List
forall x. List -> Rep List x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep List x -> List
$cfrom :: forall x. List -> Rep List x
Generic, Int -> List -> ShowS
[List] -> ShowS
List -> String
(Int -> List -> ShowS)
-> (List -> String) -> ([List] -> ShowS) -> Show List
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List] -> ShowS
$cshowList :: [List] -> ShowS
show :: List -> String
$cshow :: List -> String
showsPrec :: Int -> List -> ShowS
$cshowsPrec :: Int -> List -> ShowS
Show, List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List -> List -> Bool
$c/= :: List -> List -> Bool
== :: List -> List -> Bool
$c== :: List -> List -> Bool
Eq)

-- | Alias for 'V.Vector'. Using this alias may make upgrading to future
-- versions of the library easier, as we will likely switch to a more
-- efficient representation at some point.
type ListOf a = V.Vector a

-- | Alias for vector's 'V.length'.
length :: ListOf a -> Int
length :: ListOf a -> Int
length = ListOf a -> Int
forall a. Vector a -> Int
V.length

-- | Index into a slice, returning a default value if the the index is past
-- the end of the array.
sliceIndex :: Default a => Int -> Slice a -> a
sliceIndex :: Int -> Slice a -> a
sliceIndex Int
i (Slice ListOf a
vec)
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ListOf a -> Int
forall a. Vector a -> Int
V.length ListOf a
vec = ListOf a
vec ListOf a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i
    | Bool
otherwise = a
forall a. Default a => a
def

instance (Default a, Eq a) => Eq (Slice a) where
    -- We define equality specially (rather than just deriving), such that
    -- slices are padded out with the default values of their elements.
    l :: Slice a
l@(Slice ListOf a
vl) == :: Slice a -> Slice a -> Bool
== r :: Slice a
r@(Slice ListOf a
vr) = Int -> Bool
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (ListOf a -> Int
forall a. Vector a -> Int
length ListOf a
vl) (ListOf a -> Int
forall a. Vector a -> Int
length ListOf a
vr) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      where
        go :: Int -> Bool
go (-1) = Bool
True -- can happen if both slices are empty.
        go Int
0    = Bool
True
        go Int
i    = Int -> Slice a -> a
forall a. Default a => Int -> Slice a -> a
sliceIndex Int
i Slice a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Slice a -> a
forall a. Default a => Int -> Slice a -> a
sliceIndex Int
i Slice a
r Bool -> Bool -> Bool
&& Int -> Bool
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

instance Decerialize Struct where
    type Cerial msg Struct = U.Struct msg

    decerialize :: Cerial ConstMsg Struct -> m Struct
decerialize Cerial ConstMsg Struct
struct = Slice Word64 -> Slice (Maybe Ptr) -> Struct
Struct
        (Slice Word64 -> Slice (Maybe Ptr) -> Struct)
-> m (Slice Word64) -> m (Slice (Maybe Ptr) -> Struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListOf Word64 -> Slice Word64
forall a. ListOf a -> Slice a
Slice (ListOf Word64 -> Slice Word64)
-> m (ListOf Word64) -> m (Slice Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ListOf Word64)
decerializeWords)
        m (Slice (Maybe Ptr) -> Struct)
-> m (Slice (Maybe Ptr)) -> m Struct
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ListOf (Maybe Ptr) -> Slice (Maybe Ptr)
forall a. ListOf a -> Slice a
Slice (ListOf (Maybe Ptr) -> Slice (Maybe Ptr))
-> m (ListOf (Maybe Ptr)) -> m (Slice (Maybe Ptr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ListOf (Maybe Ptr))
decerializePtrs)
      where
        decerializeWords :: m (ListOf Word64)
decerializeWords =
            let nwords :: Int
nwords = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct ConstMsg -> WordCount
forall msg. Struct msg -> WordCount
U.structWordCount Struct ConstMsg
Cerial ConstMsg Struct
struct in
            Int -> (Int -> m Word64) -> m (ListOf Word64)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM Int
nwords (Int -> Struct ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Struct ConstMsg
Cerial ConstMsg Struct
struct)
        decerializePtrs :: m (ListOf (Maybe Ptr))
decerializePtrs =
            let nptrs :: Int
nptrs = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct ConstMsg -> Word16
forall msg. Struct msg -> Word16
U.structPtrCount Struct ConstMsg
Cerial ConstMsg Struct
struct in
            Int -> (Int -> m (Maybe Ptr)) -> m (ListOf (Maybe Ptr))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM Int
nptrs (\Int
i -> Int -> Struct ConstMsg -> m (Maybe (Ptr ConstMsg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct ConstMsg
Cerial ConstMsg Struct
struct m (Maybe (Ptr ConstMsg))
-> (Maybe (Ptr ConstMsg) -> m (Maybe Ptr)) -> m (Maybe Ptr)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Ptr ConstMsg) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
decerialize)

instance FromStruct M.ConstMsg Struct where
    fromStruct :: Struct ConstMsg -> m Struct
fromStruct = Struct ConstMsg -> m Struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
decerialize

instance Marshal s Struct where
    marshalInto :: Cerial (MutMsg s) Struct -> Struct -> m ()
marshalInto Cerial (MutMsg s) Struct
raw (Struct (Slice ListOf Word64
dataSec) (Slice ListOf (Maybe Ptr)
ptrSec)) = do
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf Word64 -> Int
forall a. Vector a -> Int
V.length ListOf Word64
dataSec 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 ->
            Word64 -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Word64 -> Int -> Struct (MutMsg s) -> m ()
U.setData (ListOf Word64
dataSec ListOf Word64 -> Int -> Word64
forall a. Vector a -> Int -> a
V.! Int
i) Int
i Struct (MutMsg s)
Cerial (MutMsg s) Struct
raw
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf (Maybe Ptr) -> Int
forall a. Vector a -> Int
V.length ListOf (Maybe Ptr)
ptrSec 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
            Maybe (Ptr (MutMsg s))
ptr <- MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
cerialize (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
U.message Struct (MutMsg s)
Cerial (MutMsg s) Struct
raw) (ListOf (Maybe Ptr)
ptrSec ListOf (Maybe Ptr) -> Int -> Maybe Ptr
forall a. Vector a -> Int -> a
V.! Int
i)
            Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
U.setPtr Maybe (Ptr (MutMsg s))
ptr Int
i Struct (MutMsg s)
Cerial (MutMsg s) Struct
raw

instance Cerialize s Struct where
    cerialize :: MutMsg s -> Struct -> m (Cerial (MutMsg s) Struct)
cerialize MutMsg s
msg struct :: Struct
struct@(Struct (Slice ListOf Word64
dataSec) (Slice ListOf (Maybe Ptr)
ptrSec)) = do
        Struct (MutMsg s)
raw <- MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
U.allocStruct
            MutMsg s
msg
            (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf Word64 -> Int
forall a. Vector a -> Int
V.length ListOf Word64
dataSec)
            (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf (Maybe Ptr) -> Int
forall a. Vector a -> Int
V.length ListOf (Maybe Ptr)
ptrSec)
        Cerial (MutMsg s) Struct -> Struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
marshalInto Struct (MutMsg s)
Cerial (MutMsg s) Struct
raw Struct
struct
        Struct (MutMsg s) -> m (Struct (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct (MutMsg s)
raw

instance Decerialize (Maybe Ptr) where
    type Cerial msg (Maybe Ptr) = Maybe (U.Ptr msg)

    decerialize :: Cerial ConstMsg (Maybe Ptr) -> m (Maybe Ptr)
decerialize Cerial ConstMsg (Maybe Ptr)
Nothing = Maybe Ptr -> m (Maybe Ptr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Ptr
forall a. Maybe a
Nothing
    decerialize (Just ptr) = Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> m Ptr -> m (Maybe Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Ptr ConstMsg
ptr of
        U.PtrCap Cap ConstMsg
cap       -> Client -> Ptr
PtrCap (Client -> Ptr) -> m Client -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cap ConstMsg -> m Client
forall (m :: * -> *) msg. ReadCtx m msg => Cap msg -> m Client
U.getClient Cap ConstMsg
cap
        U.PtrStruct Struct ConstMsg
struct -> Struct -> Ptr
PtrStruct (Struct -> Ptr) -> m Struct -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cerial ConstMsg Struct -> m Struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
decerialize Struct ConstMsg
Cerial ConstMsg Struct
struct
        U.PtrList List ConstMsg
list     -> List -> Ptr
PtrList (List -> Ptr) -> m List -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cerial ConstMsg List -> m List
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
decerialize List ConstMsg
Cerial ConstMsg List
list

instance Cerialize s (Maybe Ptr) where
    cerialize :: MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
cerialize MutMsg s
_ Maybe Ptr
Nothing                     = Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr (MutMsg s))
forall a. Maybe a
Nothing
    cerialize MutMsg s
msg (Just (PtrStruct Struct
struct)) = MutMsg s -> Struct -> m (Cerial (MutMsg s) Struct)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
cerialize MutMsg s
msg Struct
struct m (Struct (MutMsg s))
-> (Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s))))
-> m (Maybe (Ptr (MutMsg s)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg
    cerialize MutMsg s
msg (Just (PtrList     List
list)) = Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (List (MutMsg s) -> Ptr (MutMsg s))
-> List (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
U.PtrList (List (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (List (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> List -> m (Cerial (MutMsg s) List)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
cerialize MutMsg s
msg List
list
    cerialize MutMsg s
msg (Just (PtrCap       Client
cap)) = Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Cap (MutMsg s) -> Ptr (MutMsg s))
-> Cap (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap (MutMsg s) -> Ptr (MutMsg s)
forall msg. Cap msg -> Ptr msg
U.PtrCap (Cap (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Cap (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Client -> m (Cap (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Client -> m (Cap (MutMsg s))
U.appendCap MutMsg s
msg Client
cap

-- | Decerialize an untyped list, whose elements are instances of Decerialize. This isn't
-- an instance, since it would have to be an instance of (List a), which conflicts with
-- the above.
decerializeListOf :: (U.ReadCtx m M.ConstMsg, Decerialize a)
    => U.ListOf M.ConstMsg (Cerial M.ConstMsg a) -> m (ListOf a)
decerializeListOf :: ListOf ConstMsg (Cerial ConstMsg a) -> m (ListOf a)
decerializeListOf ListOf ConstMsg (Cerial ConstMsg a)
raw = Int -> (Int -> m a) -> m (ListOf a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (ListOf ConstMsg (Cerial ConstMsg a) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf ConstMsg (Cerial ConstMsg a)
raw) (\Int
i -> Int -> ListOf ConstMsg (Cerial ConstMsg a) -> m (Cerial ConstMsg a)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf 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)

-- | Decerialize an untyped list, leaving the elements of the list as-is. The is most
-- interesting for types that go in the data section of a struct, hence the name.
decerializeListOfWord :: (U.ReadCtx m M.ConstMsg)
    => U.ListOf M.ConstMsg a -> m (ListOf a)
decerializeListOfWord :: ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg a
raw = Int -> (Int -> m a) -> m (ListOf a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (ListOf ConstMsg a -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf ConstMsg a
raw) (Int -> ListOf ConstMsg a -> m a
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
`U.index` ListOf ConstMsg a
raw)

instance Decerialize List where
    type Cerial msg List = U.List msg

    decerialize :: Cerial ConstMsg List -> m List
decerialize (U.List0 l)      = ListOf () -> List
List0 (ListOf () -> List) -> m (ListOf ()) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg () -> m (ListOf ())
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg ()
l
    decerialize (U.List1 l)      = ListOf Bool -> List
List1 (ListOf Bool -> List) -> m (ListOf Bool) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg Bool -> m (ListOf Bool)
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg Bool
l
    decerialize (U.List8 l)      = ListOf Word8 -> List
List8 (ListOf Word8 -> List) -> m (ListOf Word8) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg Word8 -> m (ListOf Word8)
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg Word8
l
    decerialize (U.List16 l)     = ListOf Word16 -> List
List16 (ListOf Word16 -> List) -> m (ListOf Word16) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg Word16 -> m (ListOf Word16)
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg Word16
l
    decerialize (U.List32 l)     = ListOf Word32 -> List
List32 (ListOf Word32 -> List) -> m (ListOf Word32) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg Word32 -> m (ListOf Word32)
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg Word32
l
    decerialize (U.List64 l)     = ListOf Word64 -> List
List64 (ListOf Word64 -> List) -> m (ListOf Word64) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg Word64 -> m (ListOf Word64)
forall (m :: * -> *) a.
ReadCtx m ConstMsg =>
ListOf ConstMsg a -> m (ListOf a)
decerializeListOfWord ListOf ConstMsg Word64
l
    decerialize (U.ListPtr l)    = ListOf (Maybe Ptr) -> List
ListPtr (ListOf (Maybe Ptr) -> List) -> m (ListOf (Maybe Ptr)) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg (Cerial ConstMsg (Maybe Ptr))
-> m (ListOf (Maybe Ptr))
forall (m :: * -> *) a.
(ReadCtx m ConstMsg, Decerialize a) =>
ListOf ConstMsg (Cerial ConstMsg a) -> m (ListOf a)
decerializeListOf ListOf ConstMsg (Maybe (Ptr ConstMsg))
ListOf ConstMsg (Cerial ConstMsg (Maybe Ptr))
l
    decerialize (U.ListStruct l) = ListOf Struct -> List
ListStruct (ListOf Struct -> List) -> m (ListOf Struct) -> m List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf ConstMsg (Cerial ConstMsg Struct) -> m (ListOf Struct)
forall (m :: * -> *) a.
(ReadCtx m ConstMsg, Decerialize a) =>
ListOf ConstMsg (Cerial ConstMsg a) -> m (ListOf a)
decerializeListOf ListOf ConstMsg (Struct ConstMsg)
ListOf ConstMsg (Cerial ConstMsg Struct)
l

instance Cerialize s List where
    cerialize :: MutMsg s -> List -> m (Cerial (MutMsg s) List)
cerialize MutMsg s
msg (List0   ListOf ()
l) = ListOf (MutMsg s) () -> List (MutMsg s)
forall msg. ListOf msg () -> List msg
U.List0  (ListOf (MutMsg s) () -> List (MutMsg s))
-> m (ListOf (MutMsg s) ()) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) ())
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) ())
U.allocList0 MutMsg s
msg (ListOf () -> Int
forall a. Vector a -> Int
length ListOf ()
l)
    cerialize MutMsg s
msg (List1   ListOf Bool
l) = ListOf (MutMsg s) Bool -> List (MutMsg s)
forall msg. ListOf msg Bool -> List msg
U.List1  (ListOf (MutMsg s) Bool -> List (MutMsg s))
-> m (ListOf (MutMsg s) Bool) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf (MutMsg s) Bool))
-> ListOf Bool -> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord (MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
U.allocList1  MutMsg s
msg) ListOf Bool
l
    cerialize MutMsg s
msg (List8   ListOf Word8
l) = ListOf (MutMsg s) Word8 -> List (MutMsg s)
forall msg. ListOf msg Word8 -> List msg
U.List8  (ListOf (MutMsg s) Word8 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word8) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf (MutMsg s) Word8))
-> ListOf Word8 -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord (MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
U.allocList8  MutMsg s
msg) ListOf Word8
l
    cerialize MutMsg s
msg (List16  ListOf Word16
l) = ListOf (MutMsg s) Word16 -> List (MutMsg s)
forall msg. ListOf msg Word16 -> List msg
U.List16 (ListOf (MutMsg s) Word16 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf (MutMsg s) Word16))
-> ListOf Word16 -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord (MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
U.allocList16 MutMsg s
msg) ListOf Word16
l
    cerialize MutMsg s
msg (List32  ListOf Word32
l) = ListOf (MutMsg s) Word32 -> List (MutMsg s)
forall msg. ListOf msg Word32 -> List msg
U.List32 (ListOf (MutMsg s) Word32 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf (MutMsg s) Word32))
-> ListOf Word32 -> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord (MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
U.allocList32 MutMsg s
msg) ListOf Word32
l
    cerialize MutMsg s
msg (List64  ListOf Word64
l) = ListOf (MutMsg s) Word64 -> List (MutMsg s)
forall msg. ListOf msg Word64 -> List msg
U.List64 (ListOf (MutMsg s) Word64 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf (MutMsg s) Word64))
-> ListOf Word64 -> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord (MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
U.allocList64 MutMsg s
msg) ListOf Word64
l
    cerialize MutMsg s
msg (ListPtr ListOf (Maybe Ptr)
l) = do
        ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
raw <- 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 (ListOf (Maybe Ptr) -> Int
forall a. Vector a -> Int
length ListOf (Maybe Ptr)
l)
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf (Maybe Ptr) -> Int
forall a. Vector a -> Int
length ListOf (Maybe Ptr)
l 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
            Maybe (Ptr (MutMsg s))
ptr <- MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
cerialize MutMsg s
msg (ListOf (Maybe Ptr)
l ListOf (Maybe Ptr) -> Int -> Maybe Ptr
forall a. Vector a -> Int -> a
V.! Int
i)
            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 Maybe (Ptr (MutMsg s))
ptr Int
i ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
raw
        List (MutMsg s) -> m (List (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (MutMsg s) -> m (List (MutMsg s)))
-> List (MutMsg s) -> m (List (MutMsg s))
forall a b. (a -> b) -> a -> b
$ ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> List (MutMsg s)
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
U.ListPtr ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
raw
    cerialize MutMsg s
msg (ListStruct ListOf Struct
l) = do
        let (Word16
maxData, Word16
maxPtrs) = ListOf Struct -> (Word16, Word16)
measureStructSizes ListOf Struct
l
        ListOf (MutMsg s) (Struct (MutMsg s))
raw <- MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
U.allocCompositeList MutMsg s
msg Word16
maxData Word16
maxPtrs (ListOf Struct -> Int
forall a. Vector a -> Int
length ListOf Struct
l)
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf Struct -> Int
forall a. Vector a -> Int
length ListOf Struct
l 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
            Struct (MutMsg s)
elt <- Int
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m (Struct (MutMsg s))
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf (MutMsg s) (Struct (MutMsg s))
raw
            Cerial (MutMsg s) Struct -> Struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
marshalInto Struct (MutMsg s)
Cerial (MutMsg s) Struct
elt (ListOf Struct
l ListOf Struct -> Int -> Struct
forall a. Vector a -> Int -> a
V.! Int
i)
        List (MutMsg s) -> m (List (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List (MutMsg s) -> m (List (MutMsg s)))
-> List (MutMsg s) -> m (List (MutMsg s))
forall a b. (a -> b) -> a -> b
$ ListOf (MutMsg s) (Struct (MutMsg s)) -> List (MutMsg s)
forall msg. ListOf msg (Struct msg) -> List msg
U.ListStruct ListOf (MutMsg s) (Struct (MutMsg s))
raw
      where
        -- Find the maximum sizes of each section of any of the structs
        -- in the list. This is the size we need to set in the tag word.
        measureStructSizes :: ListOf Struct -> (Word16, Word16)
        measureStructSizes :: ListOf Struct -> (Word16, Word16)
measureStructSizes = ((Word16, Word16) -> Struct -> (Word16, Word16))
-> (Word16, Word16) -> ListOf Struct -> (Word16, Word16)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
            (\(!Word16
dataSz, !Word16
ptrSz) (Struct (Slice ListOf Word64
dataSec) (Slice ListOf (Maybe Ptr)
ptrSec)) ->
                ( Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
dataSz (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf Word64 -> Int
forall a. Vector a -> Int
length ListOf Word64
dataSec)
                , Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
ptrSz  (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf (Maybe Ptr) -> Int
forall a. Vector a -> Int
length ListOf (Maybe Ptr)
ptrSec)
                )
            )
            (Word16
0, Word16
0)


cerializeListOfWord :: U.RWCtx m s => (Int -> m (U.ListOf (M.MutMsg s) a)) -> ListOf a -> m (U.ListOf (M.MutMsg s) a)
cerializeListOfWord :: (Int -> m (ListOf (MutMsg s) a))
-> ListOf a -> m (ListOf (MutMsg s) a)
cerializeListOfWord Int -> m (ListOf (MutMsg s) a)
alloc ListOf a
list = do
    ListOf (MutMsg s) a
ret <- Int -> m (ListOf (MutMsg s) a)
alloc (ListOf a -> Int
forall a. Vector a -> Int
length ListOf a
list)
    ListOf (MutMsg s) a -> ListOf a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
ListOf (MutMsg s) a -> ListOf a -> m ()
marshalListOfWord ListOf (MutMsg s) a
ret ListOf a
list
    ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf (MutMsg s) a
ret

marshalListOfWord :: U.RWCtx m s => U.ListOf (M.MutMsg s) a -> ListOf a -> m ()
marshalListOfWord :: ListOf (MutMsg s) a -> ListOf a -> m ()
marshalListOfWord ListOf (MutMsg s) a
raw ListOf a
l =
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf a -> Int
forall a. Vector a -> Int
length ListOf a
l 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 ->
        a -> Int -> ListOf (MutMsg s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (ListOf a
l ListOf a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i) Int
i ListOf (MutMsg s) a
raw