{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Capnp.Gen.Capnp.RpcTwoparty where
import qualified Capnp.Repr as R
import qualified Capnp.Repr.Parsed as RP
import qualified Capnp.Basics as Basics
import qualified GHC.OverloadedLabels as OL
import qualified Capnp.GenHelpers as GH
import qualified Capnp.Classes as C
import qualified GHC.Generics as Generics
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(Side -> Side -> Bool
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
            ,Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
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
            ,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)
type instance (R.ReprFor Side) = (R.Data R.Sz16)
instance (C.HasTypeId Side) where
    typeId :: Word64
typeId  = Word64
11517567629614739868
instance (Std_.Enum Side) where
    toEnum :: Int -> Side
toEnum Int
n_ = case Int
n_ of
        Int
0 ->
            Side
Side'server
        Int
1 ->
            Side
Side'client
        Int
tag_ ->
            (Word16 -> Side
Side'unknown' (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Int
tag_))
    fromEnum :: Side -> Int
fromEnum Side
value_ = case Side
value_ of
        (Side
Side'server) ->
            Int
0
        (Side
Side'client) ->
            Int
1
        (Side'unknown' Word16
tag_) ->
            (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag_)
instance (C.IsWord Side) where
    fromWord :: Word64 -> Side
fromWord Word64
w_ = (forall a. Enum a => Int -> a
Std_.toEnum (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
w_))
    toWord :: Side -> Word64
toWord Side
v_ = (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (forall a. Enum a => a -> Int
Std_.fromEnum Side
v_))
instance (C.Parse Side Side) where
    parse :: forall (m :: * -> *). ReadCtx m 'Const => Raw Side 'Const -> m Side
parse  = forall a (m :: * -> *).
(ReprFor a ~ 'Data 'Sz16, Enum a, Applicative m) =>
Raw a 'Const -> m a
GH.parseEnum
    encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> Side -> m (Raw Side ('Mut s))
encode  = forall a (m :: * -> *) s.
(ReprFor a ~ 'Data 'Sz16, Enum a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Raw a ('Mut s))
GH.encodeEnum
instance (C.AllocateList Side) where
    type ListAllocHint Side = Std_.Int
instance (C.EstimateListAlloc Side Side)
data VatId 
type instance (R.ReprFor VatId) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId VatId) where
    typeId :: Word64
typeId  = Word64
15135349989283412622
instance (C.TypedStruct VatId) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate VatId) where
    type AllocHint VatId = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint VatId -> Message ('Mut s) -> m (Raw VatId ('Mut s))
new AllocHint VatId
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc VatId (C.Parsed VatId))
instance (C.AllocateList VatId) where
    type ListAllocHint VatId = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint VatId
-> Message ('Mut s) -> m (Raw (List VatId) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc VatId (C.Parsed VatId))
data instance C.Parsed VatId
    = VatId 
        {Parsed VatId -> Parsed Side
side :: (RP.Parsed Side)}
    deriving(forall x. Rep (Parsed VatId) x -> Parsed VatId
forall x. Parsed VatId -> Rep (Parsed VatId) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed VatId) x -> Parsed VatId
$cfrom :: forall x. Parsed VatId -> Rep (Parsed VatId) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed VatId))
deriving instance (Std_.Eq (C.Parsed VatId))
instance (C.Parse VatId (C.Parsed VatId)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw VatId 'Const -> m (Parsed VatId)
parse Raw VatId 'Const
raw_ = (Parsed Side -> Parsed VatId
VatId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "side" a => a
#side Raw VatId 'Const
raw_))
instance (C.Marshal VatId (C.Parsed VatId)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw VatId ('Mut s) -> Parsed VatId -> m ()
marshalInto Raw VatId ('Mut s)
raw_ VatId{Parsed Side
side :: Parsed Side
$sel:side:VatId :: Parsed VatId -> Parsed Side
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "side" a => a
#side Parsed Side
side Raw VatId ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "side" GH.Slot VatId Side) where
    fieldByLabel :: Field 'Slot VatId Side
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
data ProvisionId 
type instance (R.ReprFor ProvisionId) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId ProvisionId) where
    typeId :: Word64
typeId  = Word64
13298295899470141463
instance (C.TypedStruct ProvisionId) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate ProvisionId) where
    type AllocHint ProvisionId = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint ProvisionId
-> Message ('Mut s) -> m (Raw ProvisionId ('Mut s))
new AllocHint ProvisionId
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc ProvisionId (C.Parsed ProvisionId))
instance (C.AllocateList ProvisionId) where
    type ListAllocHint ProvisionId = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint ProvisionId
-> Message ('Mut s) -> m (Raw (List ProvisionId) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc ProvisionId (C.Parsed ProvisionId))
data instance C.Parsed ProvisionId
    = ProvisionId 
        {Parsed ProvisionId -> Parsed Word32
joinId :: (RP.Parsed Std_.Word32)}
    deriving(forall x. Rep (Parsed ProvisionId) x -> Parsed ProvisionId
forall x. Parsed ProvisionId -> Rep (Parsed ProvisionId) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed ProvisionId) x -> Parsed ProvisionId
$cfrom :: forall x. Parsed ProvisionId -> Rep (Parsed ProvisionId) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed ProvisionId))
deriving instance (Std_.Eq (C.Parsed ProvisionId))
instance (C.Parse ProvisionId (C.Parsed ProvisionId)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw ProvisionId 'Const -> m (Parsed ProvisionId)
parse Raw ProvisionId 'Const
raw_ = (Parsed Word32 -> Parsed ProvisionId
ProvisionId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "joinId" a => a
#joinId Raw ProvisionId 'Const
raw_))
instance (C.Marshal ProvisionId (C.Parsed ProvisionId)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw ProvisionId ('Mut s) -> Parsed ProvisionId -> m ()
marshalInto Raw ProvisionId ('Mut s)
raw_ ProvisionId{Parsed Word32
joinId :: Parsed Word32
$sel:joinId:ProvisionId :: Parsed ProvisionId -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "joinId" a => a
#joinId Parsed Word32
joinId Raw ProvisionId ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "joinId" GH.Slot ProvisionId Std_.Word32) where
    fieldByLabel :: Field 'Slot ProvisionId Word32
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
32 Word64
0)
data RecipientId 
type instance (R.ReprFor RecipientId) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId RecipientId) where
    typeId :: Word64
typeId  = Word64
9940440221562733249
instance (C.TypedStruct RecipientId) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate RecipientId) where
    type AllocHint RecipientId = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint RecipientId
-> Message ('Mut s) -> m (Raw RecipientId ('Mut s))
new AllocHint RecipientId
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc RecipientId (C.Parsed RecipientId))
instance (C.AllocateList RecipientId) where
    type ListAllocHint RecipientId = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint RecipientId
-> Message ('Mut s) -> m (Raw (List RecipientId) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc RecipientId (C.Parsed RecipientId))
data instance C.Parsed RecipientId
    = RecipientId 
        {}
    deriving(forall x. Rep (Parsed RecipientId) x -> Parsed RecipientId
forall x. Parsed RecipientId -> Rep (Parsed RecipientId) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed RecipientId) x -> Parsed RecipientId
$cfrom :: forall x. Parsed RecipientId -> Rep (Parsed RecipientId) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed RecipientId))
deriving instance (Std_.Eq (C.Parsed RecipientId))
instance (C.Parse RecipientId (C.Parsed RecipientId)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw RecipientId 'Const -> m (Parsed RecipientId)
parse Raw RecipientId 'Const
raw_ = (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed RecipientId
RecipientId)
instance (C.Marshal RecipientId (C.Parsed RecipientId)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw RecipientId ('Mut s) -> Parsed RecipientId -> m ()
marshalInto Raw RecipientId ('Mut s)
_raw (Parsed RecipientId
R:ParsedRecipientId
RecipientId) = (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
data ThirdPartyCapId 
type instance (R.ReprFor ThirdPartyCapId) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId ThirdPartyCapId) where
    typeId :: Word64
typeId  = Word64
13006195034640135581
instance (C.TypedStruct ThirdPartyCapId) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate ThirdPartyCapId) where
    type AllocHint ThirdPartyCapId = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint ThirdPartyCapId
-> Message ('Mut s) -> m (Raw ThirdPartyCapId ('Mut s))
new AllocHint ThirdPartyCapId
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc ThirdPartyCapId (C.Parsed ThirdPartyCapId))
instance (C.AllocateList ThirdPartyCapId) where
    type ListAllocHint ThirdPartyCapId = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint ThirdPartyCapId
-> Message ('Mut s) -> m (Raw (List ThirdPartyCapId) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc ThirdPartyCapId (C.Parsed ThirdPartyCapId))
data instance C.Parsed ThirdPartyCapId
    = ThirdPartyCapId 
        {}
    deriving(forall x. Rep (Parsed ThirdPartyCapId) x -> Parsed ThirdPartyCapId
forall x. Parsed ThirdPartyCapId -> Rep (Parsed ThirdPartyCapId) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed ThirdPartyCapId) x -> Parsed ThirdPartyCapId
$cfrom :: forall x. Parsed ThirdPartyCapId -> Rep (Parsed ThirdPartyCapId) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed ThirdPartyCapId))
deriving instance (Std_.Eq (C.Parsed ThirdPartyCapId))
instance (C.Parse ThirdPartyCapId (C.Parsed ThirdPartyCapId)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw ThirdPartyCapId 'Const -> m (Parsed ThirdPartyCapId)
parse Raw ThirdPartyCapId 'Const
raw_ = (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed ThirdPartyCapId
ThirdPartyCapId)
instance (C.Marshal ThirdPartyCapId (C.Parsed ThirdPartyCapId)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw ThirdPartyCapId ('Mut s) -> Parsed ThirdPartyCapId -> m ()
marshalInto Raw ThirdPartyCapId ('Mut s)
_raw (Parsed ThirdPartyCapId
R:ParsedThirdPartyCapId
ThirdPartyCapId) = (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
data JoinKeyPart 
type instance (R.ReprFor JoinKeyPart) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId JoinKeyPart) where
    typeId :: Word64
typeId  = Word64
10786842769591618179
instance (C.TypedStruct JoinKeyPart) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate JoinKeyPart) where
    type AllocHint JoinKeyPart = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint JoinKeyPart
-> Message ('Mut s) -> m (Raw JoinKeyPart ('Mut s))
new AllocHint JoinKeyPart
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc JoinKeyPart (C.Parsed JoinKeyPart))
instance (C.AllocateList JoinKeyPart) where
    type ListAllocHint JoinKeyPart = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint JoinKeyPart
-> Message ('Mut s) -> m (Raw (List JoinKeyPart) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc JoinKeyPart (C.Parsed JoinKeyPart))
data instance C.Parsed JoinKeyPart
    = JoinKeyPart 
        {Parsed JoinKeyPart -> Parsed Word32
joinId :: (RP.Parsed Std_.Word32)
        ,Parsed JoinKeyPart -> Parsed Word16
partCount :: (RP.Parsed Std_.Word16)
        ,Parsed JoinKeyPart -> Parsed Word16
partNum :: (RP.Parsed Std_.Word16)}
    deriving(forall x. Rep (Parsed JoinKeyPart) x -> Parsed JoinKeyPart
forall x. Parsed JoinKeyPart -> Rep (Parsed JoinKeyPart) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed JoinKeyPart) x -> Parsed JoinKeyPart
$cfrom :: forall x. Parsed JoinKeyPart -> Rep (Parsed JoinKeyPart) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed JoinKeyPart))
deriving instance (Std_.Eq (C.Parsed JoinKeyPart))
instance (C.Parse JoinKeyPart (C.Parsed JoinKeyPart)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw JoinKeyPart 'Const -> m (Parsed JoinKeyPart)
parse Raw JoinKeyPart 'Const
raw_ = (Parsed Word32
-> Parsed Word16 -> Parsed Word16 -> Parsed JoinKeyPart
JoinKeyPart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "joinId" a => a
#joinId Raw JoinKeyPart 'Const
raw_)
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "partCount" a => a
#partCount Raw JoinKeyPart 'Const
raw_)
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "partNum" a => a
#partNum Raw JoinKeyPart 'Const
raw_))
instance (C.Marshal JoinKeyPart (C.Parsed JoinKeyPart)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw JoinKeyPart ('Mut s) -> Parsed JoinKeyPart -> m ()
marshalInto Raw JoinKeyPart ('Mut s)
raw_ JoinKeyPart{Parsed Word16
Parsed Word32
partNum :: Parsed Word16
partCount :: Parsed Word16
joinId :: Parsed Word32
$sel:partNum:JoinKeyPart :: Parsed JoinKeyPart -> Parsed Word16
$sel:partCount:JoinKeyPart :: Parsed JoinKeyPart -> Parsed Word16
$sel:joinId:JoinKeyPart :: Parsed JoinKeyPart -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "joinId" a => a
#joinId Parsed Word32
joinId Raw JoinKeyPart ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "partCount" a => a
#partCount Parsed Word16
partCount Raw JoinKeyPart ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "partNum" a => a
#partNum Parsed Word16
partNum Raw JoinKeyPart ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "joinId" GH.Slot JoinKeyPart Std_.Word32) where
    fieldByLabel :: Field 'Slot JoinKeyPart Word32
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
32 Word64
0)
instance (GH.HasField "partCount" GH.Slot JoinKeyPart Std_.Word16) where
    fieldByLabel :: Field 'Slot JoinKeyPart Word16
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
32 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "partNum" GH.Slot JoinKeyPart Std_.Word16) where
    fieldByLabel :: Field 'Slot JoinKeyPart Word16
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
48 Word16
0 BitCount
16 Word64
0)
data JoinResult 
type instance (R.ReprFor JoinResult) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId JoinResult) where
    typeId :: Word64
typeId  = Word64
11323802317489695726
instance (C.TypedStruct JoinResult) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate JoinResult) where
    type AllocHint JoinResult = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint JoinResult
-> Message ('Mut s) -> m (Raw JoinResult ('Mut s))
new AllocHint JoinResult
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc JoinResult (C.Parsed JoinResult))
instance (C.AllocateList JoinResult) where
    type ListAllocHint JoinResult = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint JoinResult
-> Message ('Mut s) -> m (Raw (List JoinResult) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc JoinResult (C.Parsed JoinResult))
data instance C.Parsed JoinResult
    = JoinResult 
        {Parsed JoinResult -> Parsed Word32
joinId :: (RP.Parsed Std_.Word32)
        ,Parsed JoinResult -> Parsed Bool
succeeded :: (RP.Parsed Std_.Bool)
        ,Parsed JoinResult -> Parsed (Maybe AnyPointer)
cap :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))}
    deriving(forall x. Rep (Parsed JoinResult) x -> Parsed JoinResult
forall x. Parsed JoinResult -> Rep (Parsed JoinResult) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed JoinResult) x -> Parsed JoinResult
$cfrom :: forall x. Parsed JoinResult -> Rep (Parsed JoinResult) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed JoinResult))
deriving instance (Std_.Eq (C.Parsed JoinResult))
instance (C.Parse JoinResult (C.Parsed JoinResult)) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw JoinResult 'Const -> m (Parsed JoinResult)
parse Raw JoinResult 'Const
raw_ = (Parsed Word32
-> Parsed Bool -> Parsed (Maybe AnyPointer) -> Parsed JoinResult
JoinResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "joinId" a => a
#joinId Raw JoinResult 'Const
raw_)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "succeeded" a => a
#succeeded Raw JoinResult 'Const
raw_)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "cap" a => a
#cap Raw JoinResult 'Const
raw_))
instance (C.Marshal JoinResult (C.Parsed JoinResult)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw JoinResult ('Mut s) -> Parsed JoinResult -> m ()
marshalInto Raw JoinResult ('Mut s)
raw_ JoinResult{Parsed Bool
Parsed (Maybe AnyPointer)
Parsed Word32
cap :: Parsed (Maybe AnyPointer)
succeeded :: Parsed Bool
joinId :: Parsed Word32
$sel:cap:JoinResult :: Parsed JoinResult -> Parsed (Maybe AnyPointer)
$sel:succeeded:JoinResult :: Parsed JoinResult -> Parsed Bool
$sel:joinId:JoinResult :: Parsed JoinResult -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "joinId" a => a
#joinId Parsed Word32
joinId Raw JoinResult ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "succeeded" a => a
#succeeded Parsed Bool
succeeded Raw JoinResult ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "cap" a => a
#cap Parsed (Maybe AnyPointer)
cap Raw JoinResult ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "joinId" GH.Slot JoinResult Std_.Word32) where
    fieldByLabel :: Field 'Slot JoinResult Word32
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
32 Word64
0)
instance (GH.HasField "succeeded" GH.Slot JoinResult Std_.Bool) where
    fieldByLabel :: Field 'Slot JoinResult Bool
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
32 Word16
0 BitCount
1 Word64
0)
instance (GH.HasField "cap" GH.Slot JoinResult (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot JoinResult (Maybe AnyPointer)
fieldByLabel  = (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)