{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Capnp.Gen.Capnp.RpcTwoparty where
import qualified Capnp.Message as Message
import qualified Capnp.Untyped as Untyped
import qualified Capnp.Basics as Basics
import qualified Capnp.GenHelpers as GenHelpers
import qualified Capnp.Classes as Classes
import qualified GHC.Generics as Generics
import qualified Capnp.Bits as Std_
import qualified Data.Maybe as Std_
import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
import qualified Prelude as Std_
import qualified Data.Word as Std_
import qualified Data.Int as Std_
import Prelude ((<$>), (<*>), (>>=))
data Side 
    = Side'server 
    | Side'client 
    | Side'unknown' Std_.Word16
    deriving(Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
(Int -> Side -> ShowS)
-> (Side -> String) -> ([Side] -> ShowS) -> Show Side
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Std_.Show
            ,ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
(Int -> ReadS Side)
-> ReadS [Side] -> ReadPrec Side -> ReadPrec [Side] -> Read Side
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS Side
Std_.Read
            ,Side -> Side -> Bool
(Side -> Side -> Bool) -> (Side -> Side -> Bool) -> Eq Side
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: Side -> Side -> Bool
Std_.Eq
            ,(forall x. Side -> Rep Side x)
-> (forall x. Rep Side x -> Side) -> Generic Side
forall x. Rep Side x -> Side
forall x. Side -> Rep Side x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Side x -> Side
$cfrom :: forall x. Side -> Rep Side x
Generics.Generic)
instance (Classes.IsWord Side) where
    fromWord :: Word64 -> Side
fromWord Word64
n = case ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
n) :: Std_.Word16) of
        Word16
0 ->
            Side
Side'server
        Word16
1 ->
            Side
Side'client
        Word16
tag ->
            (Word16 -> Side
Side'unknown' Word16
tag)
    toWord :: Side -> Word64
toWord (Side
Side'server) = Word64
0
    toWord (Side
Side'client) = Word64
1
    toWord (Side'unknown' Word16
tag) = (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)
instance (Std_.Enum Side) where
    fromEnum :: Side -> Int
fromEnum Side
x = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Side -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Side
x))
    toEnum :: Int -> Side
toEnum Int
x = (Word64 -> Side
forall a. IsWord a => Word64 -> a
Classes.fromWord (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Int
x))
instance (Basics.ListElem msg Side) where
    newtype List msg Side
        = Side'List_ (Untyped.ListOf msg Std_.Word16)
    index :: Int -> List msg Side -> m Side
index Int
i (Side'List_ l) = (Word64 -> Side
forall a. IsWord a => Word64 -> a
Classes.fromWord (Word64 -> Side) -> m Word64 -> m Side
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64) -> m Word16 -> m Word64
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
Untyped.index Int
i ListOf msg Word16
l)))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg Side)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg Word16 -> List msg Side
forall msg. ListOf msg Word16 -> List msg Side
Side'List_ (ListOf msg Word16 -> List msg Side)
-> m (ListOf msg Word16) -> m (List msg Side)
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
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg Side -> List msg
toUntypedList (Side'List_ l) = (ListOf msg Word16 -> List msg
forall msg. ListOf msg Word16 -> List msg
Untyped.List16 ListOf msg Word16
l)
    length :: List msg Side -> Int
length (Side'List_ l) = (ListOf msg Word16 -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg Word16
l)
instance (Classes.MutListElem s Side) where
    setIndex :: Side -> Int -> List (MutMsg s) Side -> m ()
setIndex Side
elt Int
i (Side'List_ l) = (Word16 -> Int -> ListOf (MutMsg s) Word16 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Side -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Side
elt)) Int
i ListOf (MutMsg s) Word16
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) Side)
newList MutMsg s
msg Int
size = (ListOf (MutMsg s) Word16 -> List (MutMsg s) Side
forall msg. ListOf msg Word16 -> List msg Side
Side'List_ (ListOf (MutMsg s) Word16 -> List (MutMsg s) Side)
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s) Side)
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)
Untyped.allocList16 MutMsg s
msg Int
size))
newtype VatId msg
    = VatId'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (VatId msg)) where
    fromStruct :: Struct msg -> m (VatId msg)
fromStruct Struct msg
struct = (VatId msg -> m (VatId msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> VatId msg
forall msg. Struct msg -> VatId msg
VatId'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (VatId msg)) where
    toStruct :: VatId msg -> Struct msg
toStruct (VatId'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (VatId msg)) where
    type InMessage (VatId msg) = msg
    message :: VatId msg -> InMessage (VatId msg)
message (VatId'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (VatId msg)) where
    messageDefault :: InMessage (VatId msg) -> VatId msg
messageDefault InMessage (VatId msg)
msg = (Struct msg -> VatId msg
forall msg. Struct msg -> VatId msg
VatId'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (VatId msg)
msg))
instance (Classes.FromPtr msg (VatId msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (VatId msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> VatId msg
forall msg. Struct msg -> VatId msg
VatId'newtype_ (Struct msg -> VatId msg) -> m (Struct msg) -> m (VatId msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (VatId (Message.MutMsg s))) where
    toPtr :: MutMsg s -> VatId (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (VatId'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (VatId (Message.MutMsg s))) where
    new :: MutMsg s -> m (VatId (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> VatId (MutMsg s)
forall msg. Struct msg -> VatId msg
VatId'newtype_ (Struct (MutMsg s) -> VatId (MutMsg s))
-> m (Struct (MutMsg s)) -> m (VatId (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
0))
instance (Basics.ListElem msg (VatId msg)) where
    newtype List msg (VatId msg)
        = VatId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (VatId msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (VatId msg)
forall msg. ListOf msg (Struct msg) -> List msg (VatId msg)
VatId'List_ (ListOf msg (Struct msg) -> List msg (VatId msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (VatId msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (VatId msg) -> List msg
toUntypedList (VatId'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (VatId msg) -> Int
length (VatId'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (VatId msg) -> m (VatId msg)
index Int
i (VatId'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (VatId msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (VatId (Message.MutMsg s))) where
    setIndex :: VatId (MutMsg s)
-> Int -> List (MutMsg s) (VatId (MutMsg s)) -> m ()
setIndex (VatId'newtype_ Struct (MutMsg s)
elt) Int
i (VatId'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (VatId (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (VatId (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (VatId msg)
VatId'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (VatId (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (VatId (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
0 Int
len))
get_VatId'side :: ((Untyped.ReadCtx m msg)) => (VatId msg) -> (m Side)
get_VatId'side :: VatId msg -> m Side
get_VatId'side (VatId'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Side
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_VatId'side :: ((Untyped.RWCtx m s)) => (VatId (Message.MutMsg s)) -> Side -> (m ())
set_VatId'side :: VatId (MutMsg s) -> Side -> m ()
set_VatId'side (VatId'newtype_ Struct (MutMsg s)
struct) Side
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Side -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Side
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
newtype ProvisionId msg
    = ProvisionId'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (ProvisionId msg)) where
    fromStruct :: Struct msg -> m (ProvisionId msg)
fromStruct Struct msg
struct = (ProvisionId msg -> m (ProvisionId msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> ProvisionId msg
forall msg. Struct msg -> ProvisionId msg
ProvisionId'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (ProvisionId msg)) where
    toStruct :: ProvisionId msg -> Struct msg
toStruct (ProvisionId'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (ProvisionId msg)) where
    type InMessage (ProvisionId msg) = msg
    message :: ProvisionId msg -> InMessage (ProvisionId msg)
message (ProvisionId'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (ProvisionId msg)) where
    messageDefault :: InMessage (ProvisionId msg) -> ProvisionId msg
messageDefault InMessage (ProvisionId msg)
msg = (Struct msg -> ProvisionId msg
forall msg. Struct msg -> ProvisionId msg
ProvisionId'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (ProvisionId msg)
msg))
instance (Classes.FromPtr msg (ProvisionId msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (ProvisionId msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> ProvisionId msg
forall msg. Struct msg -> ProvisionId msg
ProvisionId'newtype_ (Struct msg -> ProvisionId msg)
-> m (Struct msg) -> m (ProvisionId msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (ProvisionId (Message.MutMsg s))) where
    toPtr :: MutMsg s -> ProvisionId (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (ProvisionId'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (ProvisionId (Message.MutMsg s))) where
    new :: MutMsg s -> m (ProvisionId (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> ProvisionId (MutMsg s)
forall msg. Struct msg -> ProvisionId msg
ProvisionId'newtype_ (Struct (MutMsg s) -> ProvisionId (MutMsg s))
-> m (Struct (MutMsg s)) -> m (ProvisionId (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
0))
instance (Basics.ListElem msg (ProvisionId msg)) where
    newtype List msg (ProvisionId msg)
        = ProvisionId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (ProvisionId msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (ProvisionId msg)
forall msg. ListOf msg (Struct msg) -> List msg (ProvisionId msg)
ProvisionId'List_ (ListOf msg (Struct msg) -> List msg (ProvisionId msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (ProvisionId msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (ProvisionId msg) -> List msg
toUntypedList (ProvisionId'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (ProvisionId msg) -> Int
length (ProvisionId'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (ProvisionId msg) -> m (ProvisionId msg)
index Int
i (ProvisionId'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (ProvisionId msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (ProvisionId (Message.MutMsg s))) where
    setIndex :: ProvisionId (MutMsg s)
-> Int -> List (MutMsg s) (ProvisionId (MutMsg s)) -> m ()
setIndex (ProvisionId'newtype_ Struct (MutMsg s)
elt) Int
i (ProvisionId'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (ProvisionId (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (ProvisionId (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (ProvisionId msg)
ProvisionId'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (ProvisionId (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (ProvisionId (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
0 Int
len))
get_ProvisionId'joinId :: ((Untyped.ReadCtx m msg)) => (ProvisionId msg) -> (m Std_.Word32)
get_ProvisionId'joinId :: ProvisionId msg -> m Word32
get_ProvisionId'joinId (ProvisionId'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_ProvisionId'joinId :: ((Untyped.RWCtx m s)) => (ProvisionId (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_ProvisionId'joinId :: ProvisionId (MutMsg s) -> Word32 -> m ()
set_ProvisionId'joinId (ProvisionId'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
0 Int
0 Word64
0)
newtype RecipientId msg
    = RecipientId'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (RecipientId msg)) where
    fromStruct :: Struct msg -> m (RecipientId msg)
fromStruct Struct msg
struct = (RecipientId msg -> m (RecipientId msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> RecipientId msg
forall msg. Struct msg -> RecipientId msg
RecipientId'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (RecipientId msg)) where
    toStruct :: RecipientId msg -> Struct msg
toStruct (RecipientId'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (RecipientId msg)) where
    type InMessage (RecipientId msg) = msg
    message :: RecipientId msg -> InMessage (RecipientId msg)
message (RecipientId'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (RecipientId msg)) where
    messageDefault :: InMessage (RecipientId msg) -> RecipientId msg
messageDefault InMessage (RecipientId msg)
msg = (Struct msg -> RecipientId msg
forall msg. Struct msg -> RecipientId msg
RecipientId'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (RecipientId msg)
msg))
instance (Classes.FromPtr msg (RecipientId msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (RecipientId msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> RecipientId msg
forall msg. Struct msg -> RecipientId msg
RecipientId'newtype_ (Struct msg -> RecipientId msg)
-> m (Struct msg) -> m (RecipientId msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (RecipientId (Message.MutMsg s))) where
    toPtr :: MutMsg s -> RecipientId (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (RecipientId'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (RecipientId (Message.MutMsg s))) where
    new :: MutMsg s -> m (RecipientId (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> RecipientId (MutMsg s)
forall msg. Struct msg -> RecipientId msg
RecipientId'newtype_ (Struct (MutMsg s) -> RecipientId (MutMsg s))
-> m (Struct (MutMsg s)) -> m (RecipientId (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
0))
instance (Basics.ListElem msg (RecipientId msg)) where
    newtype List msg (RecipientId msg)
        = RecipientId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (RecipientId msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (RecipientId msg)
forall msg. ListOf msg (Struct msg) -> List msg (RecipientId msg)
RecipientId'List_ (ListOf msg (Struct msg) -> List msg (RecipientId msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (RecipientId msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (RecipientId msg) -> List msg
toUntypedList (RecipientId'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (RecipientId msg) -> Int
length (RecipientId'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (RecipientId msg) -> m (RecipientId msg)
index Int
i (RecipientId'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (RecipientId msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (RecipientId (Message.MutMsg s))) where
    setIndex :: RecipientId (MutMsg s)
-> Int -> List (MutMsg s) (RecipientId (MutMsg s)) -> m ()
setIndex (RecipientId'newtype_ Struct (MutMsg s)
elt) Int
i (RecipientId'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (RecipientId (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (RecipientId (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (RecipientId msg)
RecipientId'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (RecipientId (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (RecipientId (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
0 Int
len))
newtype ThirdPartyCapId msg
    = ThirdPartyCapId'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (ThirdPartyCapId msg)) where
    fromStruct :: Struct msg -> m (ThirdPartyCapId msg)
fromStruct Struct msg
struct = (ThirdPartyCapId msg -> m (ThirdPartyCapId msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> ThirdPartyCapId msg
forall msg. Struct msg -> ThirdPartyCapId msg
ThirdPartyCapId'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (ThirdPartyCapId msg)) where
    toStruct :: ThirdPartyCapId msg -> Struct msg
toStruct (ThirdPartyCapId'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (ThirdPartyCapId msg)) where
    type InMessage (ThirdPartyCapId msg) = msg
    message :: ThirdPartyCapId msg -> InMessage (ThirdPartyCapId msg)
message (ThirdPartyCapId'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (ThirdPartyCapId msg)) where
    messageDefault :: InMessage (ThirdPartyCapId msg) -> ThirdPartyCapId msg
messageDefault InMessage (ThirdPartyCapId msg)
msg = (Struct msg -> ThirdPartyCapId msg
forall msg. Struct msg -> ThirdPartyCapId msg
ThirdPartyCapId'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (ThirdPartyCapId msg)
msg))
instance (Classes.FromPtr msg (ThirdPartyCapId msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (ThirdPartyCapId msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> ThirdPartyCapId msg
forall msg. Struct msg -> ThirdPartyCapId msg
ThirdPartyCapId'newtype_ (Struct msg -> ThirdPartyCapId msg)
-> m (Struct msg) -> m (ThirdPartyCapId msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (ThirdPartyCapId (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> ThirdPartyCapId (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (ThirdPartyCapId'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (ThirdPartyCapId (Message.MutMsg s))) where
    new :: MutMsg s -> m (ThirdPartyCapId (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> ThirdPartyCapId (MutMsg s)
forall msg. Struct msg -> ThirdPartyCapId msg
ThirdPartyCapId'newtype_ (Struct (MutMsg s) -> ThirdPartyCapId (MutMsg s))
-> m (Struct (MutMsg s)) -> m (ThirdPartyCapId (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
0))
instance (Basics.ListElem msg (ThirdPartyCapId msg)) where
    newtype List msg (ThirdPartyCapId msg)
        = ThirdPartyCapId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (ThirdPartyCapId msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (ThirdPartyCapId msg)
forall msg.
ListOf msg (Struct msg) -> List msg (ThirdPartyCapId msg)
ThirdPartyCapId'List_ (ListOf msg (Struct msg) -> List msg (ThirdPartyCapId msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (ThirdPartyCapId msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (ThirdPartyCapId msg) -> List msg
toUntypedList (ThirdPartyCapId'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (ThirdPartyCapId msg) -> Int
length (ThirdPartyCapId'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (ThirdPartyCapId msg) -> m (ThirdPartyCapId msg)
index Int
i (ThirdPartyCapId'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (ThirdPartyCapId msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (ThirdPartyCapId (Message.MutMsg s))) where
    setIndex :: ThirdPartyCapId (MutMsg s)
-> Int -> List (MutMsg s) (ThirdPartyCapId (MutMsg s)) -> m ()
setIndex (ThirdPartyCapId'newtype_ Struct (MutMsg s)
elt) Int
i (ThirdPartyCapId'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (ThirdPartyCapId (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (ThirdPartyCapId (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (ThirdPartyCapId msg)
ThirdPartyCapId'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (ThirdPartyCapId (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (ThirdPartyCapId (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
0 Int
len))
newtype JoinKeyPart msg
    = JoinKeyPart'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (JoinKeyPart msg)) where
    fromStruct :: Struct msg -> m (JoinKeyPart msg)
fromStruct Struct msg
struct = (JoinKeyPart msg -> m (JoinKeyPart msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> JoinKeyPart msg
forall msg. Struct msg -> JoinKeyPart msg
JoinKeyPart'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (JoinKeyPart msg)) where
    toStruct :: JoinKeyPart msg -> Struct msg
toStruct (JoinKeyPart'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (JoinKeyPart msg)) where
    type InMessage (JoinKeyPart msg) = msg
    message :: JoinKeyPart msg -> InMessage (JoinKeyPart msg)
message (JoinKeyPart'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (JoinKeyPart msg)) where
    messageDefault :: InMessage (JoinKeyPart msg) -> JoinKeyPart msg
messageDefault InMessage (JoinKeyPart msg)
msg = (Struct msg -> JoinKeyPart msg
forall msg. Struct msg -> JoinKeyPart msg
JoinKeyPart'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (JoinKeyPart msg)
msg))
instance (Classes.FromPtr msg (JoinKeyPart msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (JoinKeyPart msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> JoinKeyPart msg
forall msg. Struct msg -> JoinKeyPart msg
JoinKeyPart'newtype_ (Struct msg -> JoinKeyPart msg)
-> m (Struct msg) -> m (JoinKeyPart msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (JoinKeyPart (Message.MutMsg s))) where
    toPtr :: MutMsg s -> JoinKeyPart (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (JoinKeyPart'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (JoinKeyPart (Message.MutMsg s))) where
    new :: MutMsg s -> m (JoinKeyPart (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> JoinKeyPart (MutMsg s)
forall msg. Struct msg -> JoinKeyPart msg
JoinKeyPart'newtype_ (Struct (MutMsg s) -> JoinKeyPart (MutMsg s))
-> m (Struct (MutMsg s)) -> m (JoinKeyPart (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
0))
instance (Basics.ListElem msg (JoinKeyPart msg)) where
    newtype List msg (JoinKeyPart msg)
        = JoinKeyPart'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (JoinKeyPart msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (JoinKeyPart msg)
forall msg. ListOf msg (Struct msg) -> List msg (JoinKeyPart msg)
JoinKeyPart'List_ (ListOf msg (Struct msg) -> List msg (JoinKeyPart msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (JoinKeyPart msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (JoinKeyPart msg) -> List msg
toUntypedList (JoinKeyPart'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (JoinKeyPart msg) -> Int
length (JoinKeyPart'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (JoinKeyPart msg) -> m (JoinKeyPart msg)
index Int
i (JoinKeyPart'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (JoinKeyPart msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (JoinKeyPart (Message.MutMsg s))) where
    setIndex :: JoinKeyPart (MutMsg s)
-> Int -> List (MutMsg s) (JoinKeyPart (MutMsg s)) -> m ()
setIndex (JoinKeyPart'newtype_ Struct (MutMsg s)
elt) Int
i (JoinKeyPart'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (JoinKeyPart (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (JoinKeyPart (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (JoinKeyPart msg)
JoinKeyPart'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (JoinKeyPart (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (JoinKeyPart (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
0 Int
len))
get_JoinKeyPart'joinId :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word32)
get_JoinKeyPart'joinId :: JoinKeyPart msg -> m Word32
get_JoinKeyPart'joinId (JoinKeyPart'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_JoinKeyPart'joinId :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_JoinKeyPart'joinId :: JoinKeyPart (MutMsg s) -> Word32 -> m ()
set_JoinKeyPart'joinId (JoinKeyPart'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
0 Int
0 Word64
0)
get_JoinKeyPart'partCount :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word16)
get_JoinKeyPart'partCount :: JoinKeyPart msg -> m Word16
get_JoinKeyPart'partCount (JoinKeyPart'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0)
set_JoinKeyPart'partCount :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_JoinKeyPart'partCount :: JoinKeyPart (MutMsg s) -> Word16 -> m ()
set_JoinKeyPart'partCount (JoinKeyPart'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
32 Word64
0)
get_JoinKeyPart'partNum :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word16)
get_JoinKeyPart'partNum :: JoinKeyPart msg -> m Word16
get_JoinKeyPart'partNum (JoinKeyPart'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
48 Word64
0)
set_JoinKeyPart'partNum :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_JoinKeyPart'partNum :: JoinKeyPart (MutMsg s) -> Word16 -> m ()
set_JoinKeyPart'partNum (JoinKeyPart'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
48 Word64
0)
newtype JoinResult msg
    = JoinResult'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (JoinResult msg)) where
    fromStruct :: Struct msg -> m (JoinResult msg)
fromStruct Struct msg
struct = (JoinResult msg -> m (JoinResult msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> JoinResult msg
forall msg. Struct msg -> JoinResult msg
JoinResult'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (JoinResult msg)) where
    toStruct :: JoinResult msg -> Struct msg
toStruct (JoinResult'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (JoinResult msg)) where
    type InMessage (JoinResult msg) = msg
    message :: JoinResult msg -> InMessage (JoinResult msg)
message (JoinResult'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (JoinResult msg)) where
    messageDefault :: InMessage (JoinResult msg) -> JoinResult msg
messageDefault InMessage (JoinResult msg)
msg = (Struct msg -> JoinResult msg
forall msg. Struct msg -> JoinResult msg
JoinResult'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (JoinResult msg)
msg))
instance (Classes.FromPtr msg (JoinResult msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (JoinResult msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> JoinResult msg
forall msg. Struct msg -> JoinResult msg
JoinResult'newtype_ (Struct msg -> JoinResult msg)
-> m (Struct msg) -> m (JoinResult msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (JoinResult (Message.MutMsg s))) where
    toPtr :: MutMsg s -> JoinResult (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (JoinResult'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (JoinResult (Message.MutMsg s))) where
    new :: MutMsg s -> m (JoinResult (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> JoinResult (MutMsg s)
forall msg. Struct msg -> JoinResult msg
JoinResult'newtype_ (Struct (MutMsg s) -> JoinResult (MutMsg s))
-> m (Struct (MutMsg s)) -> m (JoinResult (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
1))
instance (Basics.ListElem msg (JoinResult msg)) where
    newtype List msg (JoinResult msg)
        = JoinResult'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (JoinResult msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (JoinResult msg)
forall msg. ListOf msg (Struct msg) -> List msg (JoinResult msg)
JoinResult'List_ (ListOf msg (Struct msg) -> List msg (JoinResult msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (JoinResult msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (JoinResult msg) -> List msg
toUntypedList (JoinResult'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (JoinResult msg) -> Int
length (JoinResult'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (JoinResult msg) -> m (JoinResult msg)
index Int
i (JoinResult'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (JoinResult msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (JoinResult (Message.MutMsg s))) where
    setIndex :: JoinResult (MutMsg s)
-> Int -> List (MutMsg s) (JoinResult (MutMsg s)) -> m ()
setIndex (JoinResult'newtype_ Struct (MutMsg s)
elt) Int
i (JoinResult'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (JoinResult (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (JoinResult (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (JoinResult msg)
JoinResult'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (JoinResult (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (JoinResult (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
1 Int
len))
get_JoinResult'joinId :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Word32)
get_JoinResult'joinId :: JoinResult msg -> m Word32
get_JoinResult'joinId (JoinResult'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_JoinResult'joinId :: ((Untyped.RWCtx m s)) => (JoinResult (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_JoinResult'joinId :: JoinResult (MutMsg s) -> Word32 -> m ()
set_JoinResult'joinId (JoinResult'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
0 Int
0 Word64
0)
get_JoinResult'succeeded :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Bool)
get_JoinResult'succeeded :: JoinResult msg -> m Bool
get_JoinResult'succeeded (JoinResult'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0)
set_JoinResult'succeeded :: ((Untyped.RWCtx m s)) => (JoinResult (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_JoinResult'succeeded :: JoinResult (MutMsg s) -> Bool -> m ()
set_JoinResult'succeeded (JoinResult'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
0 Int
32 Word64
0)
get_JoinResult'cap :: ((Untyped.ReadCtx m msg)
                      ,(Classes.FromPtr msg (Std_.Maybe (Untyped.Ptr msg)))) => (JoinResult msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
get_JoinResult'cap :: JoinResult msg -> m (Maybe (Ptr msg))
get_JoinResult'cap (JoinResult'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_JoinResult'cap :: ((Untyped.RWCtx m s)
                      ,(Classes.ToPtr s (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))))) => (JoinResult (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
set_JoinResult'cap :: JoinResult (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
set_JoinResult'cap (JoinResult'newtype_ Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_JoinResult'cap :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Bool)
has_JoinResult'cap :: JoinResult msg -> m Bool
has_JoinResult'cap (JoinResult'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))