{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Internal.Gen.Instances where
-- This module is auto-generated by gen-builtintypes-lists.hs; DO NOT EDIT.

import Data.Int
import Data.ReinterpretCast
import Data.Word

import Capnp.Classes
    ( ListElem(..)
    , MutListElem(..)
    , FromPtr(..)
    , Decerialize(..)
    , Cerialize(..)
    , cerializeBasicVec
    )

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

instance ListElem msg Int8 where
    newtype List msg Int8 = ListInt8 (U.ListOf msg Word8)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Int8)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word8 -> List msg Int8
forall msg. ListOf msg Word8 -> List msg Int8
ListInt8 (ListOf msg Word8 -> List msg Int8)
-> m (ListOf msg Word8) -> m (List msg Int8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word8)
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 Int8 -> List msg
toUntypedList (ListInt8 l) = ListOf msg Word8 -> List msg
forall msg. ListOf msg Word8 -> List msg
U.List8 ListOf msg Word8
l
    length :: List msg Int8 -> Int
length (ListInt8 l) = ListOf msg Word8 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word8
l
    index :: Int -> List msg Int8 -> m Int8
index Int
i (ListInt8 l) = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> m Word8 -> m Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word8 -> m Word8
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word8
l
instance MutListElem s Int8 where
    setIndex :: Int8 -> Int -> List (MutMsg s) Int8 -> m ()
setIndex Int8
elt Int
i (ListInt8 l) = Word8 -> Int -> ListOf (MutMsg s) Word8 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
elt) Int
i ListOf (MutMsg s) Word8
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Int8)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word8 -> List (MutMsg s) Int8
forall msg. ListOf msg Word8 -> List msg Int8
ListInt8 (ListOf (MutMsg s) Word8 -> List (MutMsg s) Int8)
-> m (ListOf (MutMsg s) Word8) -> m (List (MutMsg s) Int8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Int8 where
    type Cerial msg Int8 = Int8
    decerialize :: Cerial ConstMsg Int8 -> m Int8
decerialize Cerial ConstMsg Int8
val = Int8 -> m Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8
Cerial ConstMsg Int8
val
instance Cerialize s Int8 where
    cerialize :: MutMsg s -> Int8 -> m (Cerial (MutMsg s) Int8)
cerialize MutMsg s
_ Int8
val = Int8 -> m Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8
val
instance Cerialize s (V.Vector Int8) where
    cerialize :: MutMsg s -> Vector Int8 -> m (Cerial (MutMsg s) (Vector Int8))
cerialize = MutMsg s -> Vector Int8 -> m (Cerial (MutMsg s) (Vector Int8))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Int8)) where
    cerialize :: MutMsg s
-> Vector (Vector Int8)
-> m (Cerial (MutMsg s) (Vector (Vector Int8)))
cerialize = MutMsg s
-> Vector (Vector Int8)
-> m (Cerial (MutMsg s) (Vector (Vector Int8)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Int8))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Int8))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int8))))
cerialize = MutMsg s
-> Vector (Vector (Vector Int8))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int8))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Int8)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Int8)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int8)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Int8)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int8)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int8))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int8))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int8))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int8))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int8))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int8)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int8)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int8)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int8)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int8)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Int16 where
    newtype List msg Int16 = ListInt16 (U.ListOf msg Word16)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Int16)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word16 -> List msg Int16
forall msg. ListOf msg Word16 -> List msg Int16
ListInt16 (ListOf msg Word16 -> List msg Int16)
-> m (ListOf msg Word16) -> m (List msg Int16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word16)
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 Int16 -> List msg
toUntypedList (ListInt16 l) = ListOf msg Word16 -> List msg
forall msg. ListOf msg Word16 -> List msg
U.List16 ListOf msg Word16
l
    length :: List msg Int16 -> Int
length (ListInt16 l) = ListOf msg Word16 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word16
l
    index :: Int -> List msg Int16 -> m Int16
index Int
i (ListInt16 l) = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> m Word16 -> m Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word16 -> m Word16
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word16
l
instance MutListElem s Int16 where
    setIndex :: Int16 -> Int -> List (MutMsg s) Int16 -> m ()
setIndex Int16
elt Int
i (ListInt16 l) = Word16 -> Int -> ListOf (MutMsg s) Word16 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
elt) Int
i ListOf (MutMsg s) Word16
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Int16)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word16 -> List (MutMsg s) Int16
forall msg. ListOf msg Word16 -> List msg Int16
ListInt16 (ListOf (MutMsg s) Word16 -> List (MutMsg s) Int16)
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s) Int16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Int16 where
    type Cerial msg Int16 = Int16
    decerialize :: Cerial ConstMsg Int16 -> m Int16
decerialize Cerial ConstMsg Int16
val = Int16 -> m Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int16
Cerial ConstMsg Int16
val
instance Cerialize s Int16 where
    cerialize :: MutMsg s -> Int16 -> m (Cerial (MutMsg s) Int16)
cerialize MutMsg s
_ Int16
val = Int16 -> m Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int16
val
instance Cerialize s (V.Vector Int16) where
    cerialize :: MutMsg s -> Vector Int16 -> m (Cerial (MutMsg s) (Vector Int16))
cerialize = MutMsg s -> Vector Int16 -> m (Cerial (MutMsg s) (Vector Int16))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Int16)) where
    cerialize :: MutMsg s
-> Vector (Vector Int16)
-> m (Cerial (MutMsg s) (Vector (Vector Int16)))
cerialize = MutMsg s
-> Vector (Vector Int16)
-> m (Cerial (MutMsg s) (Vector (Vector Int16)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Int16))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Int16))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int16))))
cerialize = MutMsg s
-> Vector (Vector (Vector Int16))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int16))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Int16)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Int16)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int16)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Int16)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int16)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int16))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int16))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int16))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int16))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int16))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int16)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int16)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int16)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int16)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int16)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Int32 where
    newtype List msg Int32 = ListInt32 (U.ListOf msg Word32)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Int32)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word32 -> List msg Int32
forall msg. ListOf msg Word32 -> List msg Int32
ListInt32 (ListOf msg Word32 -> List msg Int32)
-> m (ListOf msg Word32) -> m (List msg Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word32)
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 Int32 -> List msg
toUntypedList (ListInt32 l) = ListOf msg Word32 -> List msg
forall msg. ListOf msg Word32 -> List msg
U.List32 ListOf msg Word32
l
    length :: List msg Int32 -> Int
length (ListInt32 l) = ListOf msg Word32 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word32
l
    index :: Int -> List msg Int32 -> m Int32
index Int
i (ListInt32 l) = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> m Word32 -> m Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word32 -> m Word32
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word32
l
instance MutListElem s Int32 where
    setIndex :: Int32 -> Int -> List (MutMsg s) Int32 -> m ()
setIndex Int32
elt Int
i (ListInt32 l) = Word32 -> Int -> ListOf (MutMsg s) Word32 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
elt) Int
i ListOf (MutMsg s) Word32
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Int32)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word32 -> List (MutMsg s) Int32
forall msg. ListOf msg Word32 -> List msg Int32
ListInt32 (ListOf (MutMsg s) Word32 -> List (MutMsg s) Int32)
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s) Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Int32 where
    type Cerial msg Int32 = Int32
    decerialize :: Cerial ConstMsg Int32 -> m Int32
decerialize Cerial ConstMsg Int32
val = Int32 -> m Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
Cerial ConstMsg Int32
val
instance Cerialize s Int32 where
    cerialize :: MutMsg s -> Int32 -> m (Cerial (MutMsg s) Int32)
cerialize MutMsg s
_ Int32
val = Int32 -> m Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
val
instance Cerialize s (V.Vector Int32) where
    cerialize :: MutMsg s -> Vector Int32 -> m (Cerial (MutMsg s) (Vector Int32))
cerialize = MutMsg s -> Vector Int32 -> m (Cerial (MutMsg s) (Vector Int32))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Int32)) where
    cerialize :: MutMsg s
-> Vector (Vector Int32)
-> m (Cerial (MutMsg s) (Vector (Vector Int32)))
cerialize = MutMsg s
-> Vector (Vector Int32)
-> m (Cerial (MutMsg s) (Vector (Vector Int32)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Int32))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Int32))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int32))))
cerialize = MutMsg s
-> Vector (Vector (Vector Int32))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int32))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Int32)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Int32)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int32)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Int32)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int32)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int32))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int32))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int32))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int32))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int32))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int32)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int32)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int32)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int32)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int32)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Int64 where
    newtype List msg Int64 = ListInt64 (U.ListOf msg Word64)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Int64)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word64 -> List msg Int64
forall msg. ListOf msg Word64 -> List msg Int64
ListInt64 (ListOf msg Word64 -> List msg Int64)
-> m (ListOf msg Word64) -> m (List msg Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word64)
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 Int64 -> List msg
toUntypedList (ListInt64 l) = ListOf msg Word64 -> List msg
forall msg. ListOf msg Word64 -> List msg
U.List64 ListOf msg Word64
l
    length :: List msg Int64 -> Int
length (ListInt64 l) = ListOf msg Word64 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word64
l
    index :: Int -> List msg Int64 -> m Int64
index Int
i (ListInt64 l) = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> m Word64 -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word64 -> m Word64
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word64
l
instance MutListElem s Int64 where
    setIndex :: Int64 -> Int -> List (MutMsg s) Int64 -> m ()
setIndex Int64
elt Int
i (ListInt64 l) = Word64 -> Int -> ListOf (MutMsg s) Word64 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
elt) Int
i ListOf (MutMsg s) Word64
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Int64)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word64 -> List (MutMsg s) Int64
forall msg. ListOf msg Word64 -> List msg Int64
ListInt64 (ListOf (MutMsg s) Word64 -> List (MutMsg s) Int64)
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s) Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Int64 where
    type Cerial msg Int64 = Int64
    decerialize :: Cerial ConstMsg Int64 -> m Int64
decerialize Cerial ConstMsg Int64
val = Int64 -> m Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
Cerial ConstMsg Int64
val
instance Cerialize s Int64 where
    cerialize :: MutMsg s -> Int64 -> m (Cerial (MutMsg s) Int64)
cerialize MutMsg s
_ Int64
val = Int64 -> m Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
val
instance Cerialize s (V.Vector Int64) where
    cerialize :: MutMsg s -> Vector Int64 -> m (Cerial (MutMsg s) (Vector Int64))
cerialize = MutMsg s -> Vector Int64 -> m (Cerial (MutMsg s) (Vector Int64))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Int64)) where
    cerialize :: MutMsg s
-> Vector (Vector Int64)
-> m (Cerial (MutMsg s) (Vector (Vector Int64)))
cerialize = MutMsg s
-> Vector (Vector Int64)
-> m (Cerial (MutMsg s) (Vector (Vector Int64)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Int64))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Int64))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int64))))
cerialize = MutMsg s
-> Vector (Vector (Vector Int64))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Int64))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Int64)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Int64)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int64)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Int64)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Int64)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int64))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int64))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int64))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Int64))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Int64))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int64)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int64)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int64)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Int64)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Int64)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Word8 where
    newtype List msg Word8 = ListWord8 (U.ListOf msg Word8)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Word8)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word8 -> List msg Word8
forall msg. ListOf msg Word8 -> List msg Word8
ListWord8 (ListOf msg Word8 -> List msg Word8)
-> m (ListOf msg Word8) -> m (List msg Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word8)
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 Word8 -> List msg
toUntypedList (ListWord8 l) = ListOf msg Word8 -> List msg
forall msg. ListOf msg Word8 -> List msg
U.List8 ListOf msg Word8
l
    length :: List msg Word8 -> Int
length (ListWord8 l) = ListOf msg Word8 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word8
l
    index :: Int -> List msg Word8 -> m Word8
index Int
i (ListWord8 l) = Word8 -> Word8
forall a. a -> a
id (Word8 -> Word8) -> m Word8 -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word8 -> m Word8
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word8
l
instance MutListElem s Word8 where
    setIndex :: Word8 -> Int -> List (MutMsg s) Word8 -> m ()
setIndex Word8
elt Int
i (ListWord8 l) = Word8 -> Int -> ListOf (MutMsg s) Word8 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Word8 -> Word8
forall a. a -> a
id Word8
elt) Int
i ListOf (MutMsg s) Word8
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Word8)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word8 -> List (MutMsg s) Word8
forall msg. ListOf msg Word8 -> List msg Word8
ListWord8 (ListOf (MutMsg s) Word8 -> List (MutMsg s) Word8)
-> m (ListOf (MutMsg s) Word8) -> m (List (MutMsg s) Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Word8 where
    type Cerial msg Word8 = Word8
    decerialize :: Cerial ConstMsg Word8 -> m Word8
decerialize Cerial ConstMsg Word8
val = Word8 -> m Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
Cerial ConstMsg Word8
val
instance Cerialize s Word8 where
    cerialize :: MutMsg s -> Word8 -> m (Cerial (MutMsg s) Word8)
cerialize MutMsg s
_ Word8
val = Word8 -> m Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
val
instance Cerialize s (V.Vector Word8) where
    cerialize :: MutMsg s -> Vector Word8 -> m (Cerial (MutMsg s) (Vector Word8))
cerialize = MutMsg s -> Vector Word8 -> m (Cerial (MutMsg s) (Vector Word8))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Word8)) where
    cerialize :: MutMsg s
-> Vector (Vector Word8)
-> m (Cerial (MutMsg s) (Vector (Vector Word8)))
cerialize = MutMsg s
-> Vector (Vector Word8)
-> m (Cerial (MutMsg s) (Vector (Vector Word8)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Word8))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Word8))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word8))))
cerialize = MutMsg s
-> Vector (Vector (Vector Word8))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word8))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Word8)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Word8)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word8)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Word8)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word8)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word8))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word8))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word8))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word8))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word8))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word8)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word8)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word8)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word8)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word8)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Word16 where
    newtype List msg Word16 = ListWord16 (U.ListOf msg Word16)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Word16)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word16 -> List msg Word16
forall msg. ListOf msg Word16 -> List msg Word16
ListWord16 (ListOf msg Word16 -> List msg Word16)
-> m (ListOf msg Word16) -> m (List msg Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word16)
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 Word16 -> List msg
toUntypedList (ListWord16 l) = ListOf msg Word16 -> List msg
forall msg. ListOf msg Word16 -> List msg
U.List16 ListOf msg Word16
l
    length :: List msg Word16 -> Int
length (ListWord16 l) = ListOf msg Word16 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word16
l
    index :: Int -> List msg Word16 -> m Word16
index Int
i (ListWord16 l) = Word16 -> Word16
forall a. a -> a
id (Word16 -> Word16) -> m Word16 -> m Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word16 -> m Word16
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word16
l
instance MutListElem s Word16 where
    setIndex :: Word16 -> Int -> List (MutMsg s) Word16 -> m ()
setIndex Word16
elt Int
i (ListWord16 l) = Word16 -> Int -> ListOf (MutMsg s) Word16 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Word16 -> Word16
forall a. a -> a
id Word16
elt) Int
i ListOf (MutMsg s) Word16
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Word16)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word16 -> List (MutMsg s) Word16
forall msg. ListOf msg Word16 -> List msg Word16
ListWord16 (ListOf (MutMsg s) Word16 -> List (MutMsg s) Word16)
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s) Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Word16 where
    type Cerial msg Word16 = Word16
    decerialize :: Cerial ConstMsg Word16 -> m Word16
decerialize Cerial ConstMsg Word16
val = Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
Cerial ConstMsg Word16
val
instance Cerialize s Word16 where
    cerialize :: MutMsg s -> Word16 -> m (Cerial (MutMsg s) Word16)
cerialize MutMsg s
_ Word16
val = Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
val
instance Cerialize s (V.Vector Word16) where
    cerialize :: MutMsg s -> Vector Word16 -> m (Cerial (MutMsg s) (Vector Word16))
cerialize = MutMsg s -> Vector Word16 -> m (Cerial (MutMsg s) (Vector Word16))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Word16)) where
    cerialize :: MutMsg s
-> Vector (Vector Word16)
-> m (Cerial (MutMsg s) (Vector (Vector Word16)))
cerialize = MutMsg s
-> Vector (Vector Word16)
-> m (Cerial (MutMsg s) (Vector (Vector Word16)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Word16))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Word16))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word16))))
cerialize = MutMsg s
-> Vector (Vector (Vector Word16))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word16))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Word16)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Word16)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word16)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Word16)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word16)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word16))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word16))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word16))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word16))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word16))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word16)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word16)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word16)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word16)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word16)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Word32 where
    newtype List msg Word32 = ListWord32 (U.ListOf msg Word32)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Word32)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word32 -> List msg Word32
forall msg. ListOf msg Word32 -> List msg Word32
ListWord32 (ListOf msg Word32 -> List msg Word32)
-> m (ListOf msg Word32) -> m (List msg Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word32)
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 Word32 -> List msg
toUntypedList (ListWord32 l) = ListOf msg Word32 -> List msg
forall msg. ListOf msg Word32 -> List msg
U.List32 ListOf msg Word32
l
    length :: List msg Word32 -> Int
length (ListWord32 l) = ListOf msg Word32 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word32
l
    index :: Int -> List msg Word32 -> m Word32
index Int
i (ListWord32 l) = Word32 -> Word32
forall a. a -> a
id (Word32 -> Word32) -> m Word32 -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word32 -> m Word32
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word32
l
instance MutListElem s Word32 where
    setIndex :: Word32 -> Int -> List (MutMsg s) Word32 -> m ()
setIndex Word32
elt Int
i (ListWord32 l) = Word32 -> Int -> ListOf (MutMsg s) Word32 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Word32 -> Word32
forall a. a -> a
id Word32
elt) Int
i ListOf (MutMsg s) Word32
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Word32)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word32 -> List (MutMsg s) Word32
forall msg. ListOf msg Word32 -> List msg Word32
ListWord32 (ListOf (MutMsg s) Word32 -> List (MutMsg s) Word32)
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s) Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Word32 where
    type Cerial msg Word32 = Word32
    decerialize :: Cerial ConstMsg Word32 -> m Word32
decerialize Cerial ConstMsg Word32
val = Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
Cerial ConstMsg Word32
val
instance Cerialize s Word32 where
    cerialize :: MutMsg s -> Word32 -> m (Cerial (MutMsg s) Word32)
cerialize MutMsg s
_ Word32
val = Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
val
instance Cerialize s (V.Vector Word32) where
    cerialize :: MutMsg s -> Vector Word32 -> m (Cerial (MutMsg s) (Vector Word32))
cerialize = MutMsg s -> Vector Word32 -> m (Cerial (MutMsg s) (Vector Word32))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Word32)) where
    cerialize :: MutMsg s
-> Vector (Vector Word32)
-> m (Cerial (MutMsg s) (Vector (Vector Word32)))
cerialize = MutMsg s
-> Vector (Vector Word32)
-> m (Cerial (MutMsg s) (Vector (Vector Word32)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Word32))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Word32))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word32))))
cerialize = MutMsg s
-> Vector (Vector (Vector Word32))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word32))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Word32)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Word32)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word32)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Word32)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word32)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word32))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word32))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word32))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word32))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word32))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word32)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word32)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word32)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word32)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word32)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Word64 where
    newtype List msg Word64 = ListWord64 (U.ListOf msg Word64)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Word64)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word64 -> List msg Word64
forall msg. ListOf msg Word64 -> List msg Word64
ListWord64 (ListOf msg Word64 -> List msg Word64)
-> m (ListOf msg Word64) -> m (List msg Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word64)
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 Word64 -> List msg
toUntypedList (ListWord64 l) = ListOf msg Word64 -> List msg
forall msg. ListOf msg Word64 -> List msg
U.List64 ListOf msg Word64
l
    length :: List msg Word64 -> Int
length (ListWord64 l) = ListOf msg Word64 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word64
l
    index :: Int -> List msg Word64 -> m Word64
index Int
i (ListWord64 l) = Word64 -> Word64
forall a. a -> a
id (Word64 -> Word64) -> m Word64 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word64 -> m Word64
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word64
l
instance MutListElem s Word64 where
    setIndex :: Word64 -> Int -> List (MutMsg s) Word64 -> m ()
setIndex Word64
elt Int
i (ListWord64 l) = Word64 -> Int -> ListOf (MutMsg s) Word64 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Word64 -> Word64
forall a. a -> a
id Word64
elt) Int
i ListOf (MutMsg s) Word64
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Word64)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word64 -> List (MutMsg s) Word64
forall msg. ListOf msg Word64 -> List msg Word64
ListWord64 (ListOf (MutMsg s) Word64 -> List (MutMsg s) Word64)
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Word64 where
    type Cerial msg Word64 = Word64
    decerialize :: Cerial ConstMsg Word64 -> m Word64
decerialize Cerial ConstMsg Word64
val = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
Cerial ConstMsg Word64
val
instance Cerialize s Word64 where
    cerialize :: MutMsg s -> Word64 -> m (Cerial (MutMsg s) Word64)
cerialize MutMsg s
_ Word64
val = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
val
instance Cerialize s (V.Vector Word64) where
    cerialize :: MutMsg s -> Vector Word64 -> m (Cerial (MutMsg s) (Vector Word64))
cerialize = MutMsg s -> Vector Word64 -> m (Cerial (MutMsg s) (Vector Word64))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Word64)) where
    cerialize :: MutMsg s
-> Vector (Vector Word64)
-> m (Cerial (MutMsg s) (Vector (Vector Word64)))
cerialize = MutMsg s
-> Vector (Vector Word64)
-> m (Cerial (MutMsg s) (Vector (Vector Word64)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Word64))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Word64))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word64))))
cerialize = MutMsg s
-> Vector (Vector (Vector Word64))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Word64))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Word64)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Word64)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word64)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Word64)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Word64)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word64))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word64))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word64))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Word64))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Word64))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word64)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word64)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word64)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Word64)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Word64)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Float where
    newtype List msg Float = ListFloat (U.ListOf msg Word32)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Float)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word32 -> List msg Float
forall msg. ListOf msg Word32 -> List msg Float
ListFloat (ListOf msg Word32 -> List msg Float)
-> m (ListOf msg Word32) -> m (List msg Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word32)
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 Float -> List msg
toUntypedList (ListFloat l) = ListOf msg Word32 -> List msg
forall msg. ListOf msg Word32 -> List msg
U.List32 ListOf msg Word32
l
    length :: List msg Float -> Int
length (ListFloat l) = ListOf msg Word32 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word32
l
    index :: Int -> List msg Float -> m Float
index Int
i (ListFloat l) = Word32 -> Float
wordToFloat (Word32 -> Float) -> m Word32 -> m Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word32 -> m Word32
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word32
l
instance MutListElem s Float where
    setIndex :: Float -> Int -> List (MutMsg s) Float -> m ()
setIndex Float
elt Int
i (ListFloat l) = Word32 -> Int -> ListOf (MutMsg s) Word32 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Float -> Word32
floatToWord Float
elt) Int
i ListOf (MutMsg s) Word32
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Float)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word32 -> List (MutMsg s) Float
forall msg. ListOf msg Word32 -> List msg Float
ListFloat (ListOf (MutMsg s) Word32 -> List (MutMsg s) Float)
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s) Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Float where
    type Cerial msg Float = Float
    decerialize :: Cerial ConstMsg Float -> m Float
decerialize Cerial ConstMsg Float
val = Float -> m Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
Cerial ConstMsg Float
val
instance Cerialize s Float where
    cerialize :: MutMsg s -> Float -> m (Cerial (MutMsg s) Float)
cerialize MutMsg s
_ Float
val = Float -> m Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
val
instance Cerialize s (V.Vector Float) where
    cerialize :: MutMsg s -> Vector Float -> m (Cerial (MutMsg s) (Vector Float))
cerialize = MutMsg s -> Vector Float -> m (Cerial (MutMsg s) (Vector Float))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Float)) where
    cerialize :: MutMsg s
-> Vector (Vector Float)
-> m (Cerial (MutMsg s) (Vector (Vector Float)))
cerialize = MutMsg s
-> Vector (Vector Float)
-> m (Cerial (MutMsg s) (Vector (Vector Float)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Float))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Float))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Float))))
cerialize = MutMsg s
-> Vector (Vector (Vector Float))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Float))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Float)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Float)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Float)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Float)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Float)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Float))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Float))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Float))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Float))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Float))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Float)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Float)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Float)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Float)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Float)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Double where
    newtype List msg Double = ListDouble (U.ListOf msg Word64)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Double)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Word64 -> List msg Double
forall msg. ListOf msg Word64 -> List msg Double
ListDouble (ListOf msg Word64 -> List msg Double)
-> m (ListOf msg Word64) -> m (List msg Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Word64)
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 Double -> List msg
toUntypedList (ListDouble l) = ListOf msg Word64 -> List msg
forall msg. ListOf msg Word64 -> List msg
U.List64 ListOf msg Word64
l
    length :: List msg Double -> Int
length (ListDouble l) = ListOf msg Word64 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word64
l
    index :: Int -> List msg Double -> m Double
index Int
i (ListDouble l) = Word64 -> Double
wordToDouble (Word64 -> Double) -> m Word64 -> m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Word64 -> m Word64
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Word64
l
instance MutListElem s Double where
    setIndex :: Double -> Int -> List (MutMsg s) Double -> m ()
setIndex Double
elt Int
i (ListDouble l) = Word64 -> Int -> ListOf (MutMsg s) Word64 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Double -> Word64
doubleToWord Double
elt) Int
i ListOf (MutMsg s) Word64
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Double)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Word64 -> List (MutMsg s) Double
forall msg. ListOf msg Word64 -> List msg Double
ListDouble (ListOf (MutMsg s) Word64 -> List (MutMsg s) Double)
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s) Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Double where
    type Cerial msg Double = Double
    decerialize :: Cerial ConstMsg Double -> m Double
decerialize Cerial ConstMsg Double
val = Double -> m Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
Cerial ConstMsg Double
val
instance Cerialize s Double where
    cerialize :: MutMsg s -> Double -> m (Cerial (MutMsg s) Double)
cerialize MutMsg s
_ Double
val = Double -> m Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
val
instance Cerialize s (V.Vector Double) where
    cerialize :: MutMsg s -> Vector Double -> m (Cerial (MutMsg s) (Vector Double))
cerialize = MutMsg s -> Vector Double -> m (Cerial (MutMsg s) (Vector Double))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Double)) where
    cerialize :: MutMsg s
-> Vector (Vector Double)
-> m (Cerial (MutMsg s) (Vector (Vector Double)))
cerialize = MutMsg s
-> Vector (Vector Double)
-> m (Cerial (MutMsg s) (Vector (Vector Double)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Double))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Double))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Double))))
cerialize = MutMsg s
-> Vector (Vector (Vector Double))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Double))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Double)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Double)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Double)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Double)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Double)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Double))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Double))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Double))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Double))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Double))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Double)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Double)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Double)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Double)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Double)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance ListElem msg Bool where
    newtype List msg Bool = ListBool (U.ListOf msg Bool)
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Bool)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg Bool -> List msg Bool
forall msg. ListOf msg Bool -> List msg Bool
ListBool (ListOf msg Bool -> List msg Bool)
-> m (ListOf msg Bool) -> m (List msg Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg Bool)
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 Bool -> List msg
toUntypedList (ListBool l) = ListOf msg Bool -> List msg
forall msg. ListOf msg Bool -> List msg
U.List1 ListOf msg Bool
l
    length :: List msg Bool -> Int
length (ListBool l) = ListOf msg Bool -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Bool
l
    index :: Int -> List msg Bool -> m Bool
index Int
i (ListBool l) = Bool -> Bool
forall a. a -> a
id (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf msg Bool -> m Bool
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg Bool
l
instance MutListElem s Bool where
    setIndex :: Bool -> Int -> List (MutMsg s) Bool -> m ()
setIndex Bool
elt Int
i (ListBool l) = Bool -> Int -> ListOf (MutMsg s) Bool -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Bool -> Bool
forall a. a -> a
id Bool
elt) Int
i ListOf (MutMsg s) Bool
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Bool)
newList MutMsg s
msg Int
size = ListOf (MutMsg s) Bool -> List (MutMsg s) Bool
forall msg. ListOf msg Bool -> List msg Bool
ListBool (ListOf (MutMsg s) Bool -> List (MutMsg s) Bool)
-> m (ListOf (MutMsg s) Bool) -> m (List (MutMsg s) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Int
size
instance Decerialize Bool where
    type Cerial msg Bool = Bool
    decerialize :: Cerial ConstMsg Bool -> m Bool
decerialize Cerial ConstMsg Bool
val = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
Cerial ConstMsg Bool
val
instance Cerialize s Bool where
    cerialize :: MutMsg s -> Bool -> m (Cerial (MutMsg s) Bool)
cerialize MutMsg s
_ Bool
val = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
val
instance Cerialize s (V.Vector Bool) where
    cerialize :: MutMsg s -> Vector Bool -> m (Cerial (MutMsg s) (Vector Bool))
cerialize = MutMsg s -> Vector Bool -> m (Cerial (MutMsg s) (Vector Bool))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Bool)) where
    cerialize :: MutMsg s
-> Vector (Vector Bool)
-> m (Cerial (MutMsg s) (Vector (Vector Bool)))
cerialize = MutMsg s
-> Vector (Vector Bool)
-> m (Cerial (MutMsg s) (Vector (Vector Bool)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Bool))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Bool))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Bool))))
cerialize = MutMsg s
-> Vector (Vector (Vector Bool))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Bool))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Bool)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Bool)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Bool)))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector Bool)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Bool)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bool))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Bool))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Bool))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Bool))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Bool))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bool)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Bool)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Bool)))))))
cerialize = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Bool)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Bool)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
cerializeBasicVec