{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DataKinds                  #-}
{-# 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 Capnp.Message          (Mutability (..))
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 'Const Struct -> m Struct
decerialize Cerial 'Const 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 'Const -> WordCount
forall (msg :: Mutability). Struct msg -> WordCount
U.structWordCount Struct 'Const
Cerial 'Const 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 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Struct 'Const
Cerial 'Const 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 'Const -> Word16
forall (msg :: Mutability). Struct msg -> Word16
U.structPtrCount Struct 'Const
Cerial 'Const 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 'Const -> m (Maybe (Ptr 'Const))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct 'Const
Cerial 'Const Struct
struct m (Maybe (Ptr 'Const))
-> (Maybe (Ptr 'Const) -> m (Maybe Ptr)) -> m (Maybe Ptr)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Ptr 'Const) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
decerialize)

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

instance Marshal s Struct where
    marshalInto :: Cerial ('Mut s) Struct -> Struct -> m ()
marshalInto Cerial ('Mut 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 ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Word64 -> Int -> Struct ('Mut s) -> m ()
U.setData (ListOf Word64
dataSec ListOf Word64 -> Int -> Word64
forall a. Vector a -> Int -> a
V.! Int
i) Int
i Struct ('Mut s)
Cerial ('Mut 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 ('Mut s))
ptr <- Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
cerialize (Struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message Struct ('Mut s)
Cerial ('Mut s) Struct
raw) (ListOf (Maybe Ptr)
ptrSec ListOf (Maybe Ptr) -> Int -> Maybe Ptr
forall a. Vector a -> Int -> a
V.! Int
i)
            Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
U.setPtr Maybe (Ptr ('Mut s))
ptr Int
i Struct ('Mut s)
Cerial ('Mut s) Struct
raw

instance Cerialize s Struct where
    cerialize :: Message ('Mut s) -> Struct -> m (Cerial ('Mut s) Struct)
cerialize Message ('Mut s)
msg struct :: Struct
struct@(Struct (Slice ListOf Word64
dataSec) (Slice ListOf (Maybe Ptr)
ptrSec)) = do
        Struct ('Mut s)
raw <- Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
U.allocStruct
            Message ('Mut 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 ('Mut s) Struct -> Struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto Struct ('Mut s)
Cerial ('Mut s) Struct
raw Struct
struct
        Struct ('Mut s) -> m (Struct ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct ('Mut s)
raw

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

    decerialize :: Cerial 'Const (Maybe Ptr) -> m (Maybe Ptr)
decerialize Cerial 'Const (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 'Const
ptr of
        U.PtrCap Cap 'Const
cap       -> Client -> Ptr
PtrCap (Client -> Ptr) -> m Client -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cap 'Const -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Cap 'Const
cap
        U.PtrStruct Struct 'Const
struct -> Struct -> Ptr
PtrStruct (Struct -> Ptr) -> m Struct -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cerial 'Const Struct -> m Struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
decerialize Struct 'Const
Cerial 'Const Struct
struct
        U.PtrList List 'Const
list     -> List -> Ptr
PtrList (List -> Ptr) -> m List -> m Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cerial 'Const List -> m List
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
decerialize List 'Const
Cerial 'Const List
list

instance Cerialize s (Maybe Ptr) where
    cerialize :: Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
cerialize Message ('Mut s)
_ Maybe Ptr
Nothing                     = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
forall a. Maybe a
Nothing
    cerialize Message ('Mut s)
msg (Just (PtrStruct Struct
struct)) = Message ('Mut s) -> Struct -> m (Cerial ('Mut s) Struct)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
cerialize Message ('Mut s)
msg Struct
struct m (Struct ('Mut s))
-> (Struct ('Mut s) -> m (Maybe (Ptr ('Mut s))))
-> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message ('Mut s) -> Struct ('Mut s) -> m (Maybe (Ptr ('Mut s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
Message ('Mut s) -> a -> m (Maybe (Ptr ('Mut s)))
toPtr Message ('Mut s)
msg
    cerialize Message ('Mut s)
msg (Just (PtrList     List
list)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (List ('Mut s) -> Ptr ('Mut s))
-> List ('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
U.PtrList (List ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (List ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> List -> m (Cerial ('Mut s) List)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
cerialize Message ('Mut s)
msg List
list
    cerialize Message ('Mut s)
msg (Just (PtrCap       Client
cap)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Cap ('Mut s) -> Ptr ('Mut s))
-> Cap ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
U.PtrCap (Cap ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Cap ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
U.appendCap Message ('Mut 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 'Const, Decerialize a)
    => U.ListOf 'Const (Cerial 'Const a) -> m (ListOf a)
decerializeListOf :: ListOf 'Const (Cerial 'Const a) -> m (ListOf a)
decerializeListOf ListOf 'Const (Cerial 'Const a)
raw = Int -> (Int -> m a) -> m (ListOf a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (ListOf 'Const (Cerial 'Const a) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf 'Const (Cerial 'Const a)
raw) (\Int
i -> Int -> ListOf 'Const (Cerial 'Const a) -> m (Cerial 'Const a)
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf '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)

-- | 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 'Const)
    => U.ListOf 'Const a -> m (ListOf a)
decerializeListOfWord :: ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const a
raw = Int -> (Int -> m a) -> m (ListOf a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (ListOf 'Const a -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf 'Const a
raw) (Int -> ListOf 'Const a -> m a
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
`U.index` ListOf 'Const a
raw)

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

    decerialize :: Cerial 'Const 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 'Const () -> m (ListOf ())
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const ()
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 'Const Bool -> m (ListOf Bool)
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const 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 'Const Word8 -> m (ListOf Word8)
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const 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 'Const Word16 -> m (ListOf Word16)
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const 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 'Const Word32 -> m (ListOf Word32)
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const 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 'Const Word64 -> m (ListOf Word64)
forall (m :: * -> *) a.
ReadCtx m 'Const =>
ListOf 'Const a -> m (ListOf a)
decerializeListOfWord ListOf 'Const 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 'Const (Cerial 'Const (Maybe Ptr)) -> m (ListOf (Maybe Ptr))
forall (m :: * -> *) a.
(ReadCtx m 'Const, Decerialize a) =>
ListOf 'Const (Cerial 'Const a) -> m (ListOf a)
decerializeListOf ListOf 'Const (Maybe (Ptr 'Const))
ListOf 'Const (Cerial 'Const (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 'Const (Cerial 'Const Struct) -> m (ListOf Struct)
forall (m :: * -> *) a.
(ReadCtx m 'Const, Decerialize a) =>
ListOf 'Const (Cerial 'Const a) -> m (ListOf a)
decerializeListOf ListOf 'Const (Struct 'Const)
ListOf 'Const (Cerial 'Const Struct)
l

instance Cerialize s List where
    cerialize :: Message ('Mut s) -> List -> m (Cerial ('Mut s) List)
cerialize Message ('Mut s)
msg (List0   ListOf ()
l) = ListOf ('Mut s) () -> List ('Mut s)
forall (mut :: Mutability). ListOf mut () -> List mut
U.List0  (ListOf ('Mut s) () -> List ('Mut s))
-> m (ListOf ('Mut s) ()) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Mut s) ())
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) ())
U.allocList0 Message ('Mut s)
msg (ListOf () -> Int
forall a. Vector a -> Int
length ListOf ()
l)
    cerialize Message ('Mut s)
msg (List1   ListOf Bool
l) = ListOf ('Mut s) Bool -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Bool -> List mut
U.List1  (ListOf ('Mut s) Bool -> List ('Mut s))
-> m (ListOf ('Mut s) Bool) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf ('Mut s) Bool))
-> ListOf Bool -> m (ListOf ('Mut s) Bool)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Bool)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Bool)
U.allocList1  Message ('Mut s)
msg) ListOf Bool
l
    cerialize Message ('Mut s)
msg (List8   ListOf Word8
l) = ListOf ('Mut s) Word8 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word8 -> List mut
U.List8  (ListOf ('Mut s) Word8 -> List ('Mut s))
-> m (ListOf ('Mut s) Word8) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf ('Mut s) Word8))
-> ListOf Word8 -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
U.allocList8  Message ('Mut s)
msg) ListOf Word8
l
    cerialize Message ('Mut s)
msg (List16  ListOf Word16
l) = ListOf ('Mut s) Word16 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word16 -> List mut
U.List16 (ListOf ('Mut s) Word16 -> List ('Mut s))
-> m (ListOf ('Mut s) Word16) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf ('Mut s) Word16))
-> ListOf Word16 -> m (ListOf ('Mut s) Word16)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word16)
U.allocList16 Message ('Mut s)
msg) ListOf Word16
l
    cerialize Message ('Mut s)
msg (List32  ListOf Word32
l) = ListOf ('Mut s) Word32 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word32 -> List mut
U.List32 (ListOf ('Mut s) Word32 -> List ('Mut s))
-> m (ListOf ('Mut s) Word32) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf ('Mut s) Word32))
-> ListOf Word32 -> m (ListOf ('Mut s) Word32)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word32)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word32)
U.allocList32 Message ('Mut s)
msg) ListOf Word32
l
    cerialize Message ('Mut s)
msg (List64  ListOf Word64
l) = ListOf ('Mut s) Word64 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word64 -> List mut
U.List64 (ListOf ('Mut s) Word64 -> List ('Mut s))
-> m (ListOf ('Mut s) Word64) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m (ListOf ('Mut s) Word64))
-> ListOf Word64 -> m (ListOf ('Mut s) Word64)
forall (m :: * -> *) s a.
RWCtx m s =>
(Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word64)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word64)
U.allocList64 Message ('Mut s)
msg) ListOf Word64
l
    cerialize Message ('Mut s)
msg (ListPtr ListOf (Maybe Ptr)
l) = do
        ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
raw <- 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 (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 ('Mut s))
ptr <- Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
cerialize Message ('Mut s)
msg (ListOf (Maybe Ptr)
l ListOf (Maybe Ptr) -> Int -> Maybe Ptr
forall a. Vector a -> Int -> a
V.! Int
i)
            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 Maybe (Ptr ('Mut s))
ptr Int
i ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
raw
        List ('Mut s) -> m (List ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List ('Mut s) -> m (List ('Mut s)))
-> List ('Mut s) -> m (List ('Mut s))
forall a b. (a -> b) -> a -> b
$ ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s)
forall (mut :: Mutability).
ListOf mut (Maybe (Ptr mut)) -> List mut
U.ListPtr ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
raw
    cerialize Message ('Mut s)
msg (ListStruct ListOf Struct
l) = do
        let (Word16
maxData, Word16
maxPtrs) = ListOf Struct -> (Word16, Word16)
measureStructSizes ListOf Struct
l
        ListOf ('Mut s) (Struct ('Mut s))
raw <- Message ('Mut s)
-> Word16 -> Word16 -> Int -> m (ListOf ('Mut s) (Struct ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16 -> Word16 -> Int -> m (ListOf ('Mut s) (Struct ('Mut s)))
U.allocCompositeList Message ('Mut 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 ('Mut s)
elt <- Int -> ListOf ('Mut s) (Struct ('Mut s)) -> m (Struct ('Mut s))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf ('Mut s) (Struct ('Mut s))
raw
            Cerial ('Mut s) Struct -> Struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto Struct ('Mut s)
Cerial ('Mut s) Struct
elt (ListOf Struct
l ListOf Struct -> Int -> Struct
forall a. Vector a -> Int -> a
V.! Int
i)
        List ('Mut s) -> m (List ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List ('Mut s) -> m (List ('Mut s)))
-> List ('Mut s) -> m (List ('Mut s))
forall a b. (a -> b) -> a -> b
$ ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s)
forall (mut :: Mutability). ListOf mut (Struct mut) -> List mut
U.ListStruct ListOf ('Mut s) (Struct ('Mut 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 ('Mut s) a)) -> ListOf a -> m (U.ListOf ('Mut s) a)
cerializeListOfWord :: (Int -> m (ListOf ('Mut s) a)) -> ListOf a -> m (ListOf ('Mut s) a)
cerializeListOfWord Int -> m (ListOf ('Mut s) a)
alloc ListOf a
list = do
    ListOf ('Mut s) a
ret <- Int -> m (ListOf ('Mut s) a)
alloc (ListOf a -> Int
forall a. Vector a -> Int
length ListOf a
list)
    ListOf ('Mut s) a -> ListOf a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
ListOf ('Mut s) a -> ListOf a -> m ()
marshalListOfWord ListOf ('Mut s) a
ret ListOf a
list
    ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) a
ret

marshalListOfWord :: U.RWCtx m s => U.ListOf ('Mut s) a -> ListOf a -> m ()
marshalListOfWord :: ListOf ('Mut s) a -> ListOf a -> m ()
marshalListOfWord ListOf ('Mut 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 ('Mut s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex (ListOf a
l ListOf a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i) Int
i ListOf ('Mut s) a
raw