{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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.Rpc.New where
import qualified Capnp.Repr as R
import qualified Capnp.Repr.Parsed as RP
import qualified Capnp.New.Basics as Basics
import qualified GHC.OverloadedLabels as OL
import qualified Capnp.GenHelpers.New as GH
import qualified Capnp.New.Classes as C
import qualified GHC.Generics as Generics
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 Message 
type instance (R.ReprFor Message) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Message) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Message) where
    type AllocHint Message = ()
    new :: AllocHint Message -> Message ('Mut s) -> m (Raw ('Mut s) Message)
new AllocHint Message
_ = Message ('Mut s) -> m (Raw ('Mut s) Message)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Message (C.Parsed Message))
instance (C.AllocateList Message) where
    type ListAllocHint Message = Std_.Int
    newList :: ListAllocHint Message
-> Message ('Mut s) -> m (Raw ('Mut s) (List Message))
newList  = ListAllocHint Message
-> Message ('Mut s) -> m (Raw ('Mut s) (List Message))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Message (C.Parsed Message))
data instance C.Parsed Message
    = Message 
        {Parsed Message -> Parsed (Which Message)
union' :: (C.Parsed (GH.Which Message))}
    deriving((forall x. Parsed Message -> Rep (Parsed Message) x)
-> (forall x. Rep (Parsed Message) x -> Parsed Message)
-> Generic (Parsed Message)
forall x. Rep (Parsed Message) x -> Parsed Message
forall x. Parsed Message -> Rep (Parsed Message) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Message) x -> Parsed Message
$cfrom :: forall x. Parsed Message -> Rep (Parsed Message) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Message))
deriving instance (Std_.Eq (C.Parsed Message))
instance (C.Parse Message (C.Parsed Message)) where
    parse :: Raw 'Const Message -> m (Parsed Message)
parse Raw 'Const Message
raw_ = (Parsed (Which Message) -> Parsed Message
Message (Parsed (Which Message) -> Parsed Message)
-> m (Parsed (Which Message)) -> m (Parsed Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Message) -> m (Parsed (Which Message))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Message -> Raw 'Const (Which Message)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Message
raw_)))
instance (C.Marshal Message (C.Parsed Message)) where
    marshalInto :: Raw ('Mut s) Message -> Parsed Message -> m ()
marshalInto Raw ('Mut s) Message
raw_ Message{..} = (do
        (Raw ('Mut s) (Which Message) -> Parsed (Which Message) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Message -> Raw ('Mut s) (Which Message)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Message
raw_) Parsed (Which Message)
union')
        )
instance (GH.HasUnion Message) where
    unionField :: Field 'Slot Message Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Message Word16
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 RawWhich mut_ Message
        = RW_Message'unimplemented (R.Raw mut_ Message)
        | RW_Message'abort (R.Raw mut_ Exception)
        | RW_Message'call (R.Raw mut_ Call)
        | RW_Message'return (R.Raw mut_ Return)
        | RW_Message'finish (R.Raw mut_ Finish)
        | RW_Message'resolve (R.Raw mut_ Resolve)
        | RW_Message'release (R.Raw mut_ Release)
        | RW_Message'obsoleteSave (R.Raw mut_ Basics.AnyPointer)
        | RW_Message'bootstrap (R.Raw mut_ Bootstrap)
        | RW_Message'obsoleteDelete (R.Raw mut_ Basics.AnyPointer)
        | RW_Message'provide (R.Raw mut_ Provide)
        | RW_Message'accept (R.Raw mut_ Accept)
        | RW_Message'join (R.Raw mut_ Join)
        | RW_Message'disembargo (R.Raw mut_ Disembargo)
        | RW_Message'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Message -> m (RawWhich mut Message)
internalWhich Word16
tag_ Raw mut Message
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Message -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Message -> RawWhich mut_ Message
RW_Message'unimplemented (Raw mut Message -> RawWhich mut Message)
-> m (Raw mut Message) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Message
-> Raw mut Message -> m (Raw mut Message)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "unimplemented" (Variant 'Slot Message Message)
Variant 'Slot Message Message
#unimplemented Raw mut Message
struct_))
        Word16
1 ->
            (Raw mut Exception -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Exception -> RawWhich mut_ Message
RW_Message'abort (Raw mut Exception -> RawWhich mut Message)
-> m (Raw mut Exception) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Exception
-> Raw mut Message -> m (Raw mut Exception)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "abort" (Variant 'Slot Message Exception)
Variant 'Slot Message Exception
#abort Raw mut Message
struct_))
        Word16
2 ->
            (Raw mut Call -> RawWhich mut Message
forall (mut_ :: Mutability). Raw mut_ Call -> RawWhich mut_ Message
RW_Message'call (Raw mut Call -> RawWhich mut Message)
-> m (Raw mut Call) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Call -> Raw mut Message -> m (Raw mut Call)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "call" (Variant 'Slot Message Call)
Variant 'Slot Message Call
#call Raw mut Message
struct_))
        Word16
3 ->
            (Raw mut Return -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Return -> RawWhich mut_ Message
RW_Message'return (Raw mut Return -> RawWhich mut Message)
-> m (Raw mut Return) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Return
-> Raw mut Message -> m (Raw mut Return)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "return" (Variant 'Slot Message Return)
Variant 'Slot Message Return
#return Raw mut Message
struct_))
        Word16
4 ->
            (Raw mut Finish -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Finish -> RawWhich mut_ Message
RW_Message'finish (Raw mut Finish -> RawWhich mut Message)
-> m (Raw mut Finish) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Finish
-> Raw mut Message -> m (Raw mut Finish)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "finish" (Variant 'Slot Message Finish)
Variant 'Slot Message Finish
#finish Raw mut Message
struct_))
        Word16
5 ->
            (Raw mut Resolve -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Resolve -> RawWhich mut_ Message
RW_Message'resolve (Raw mut Resolve -> RawWhich mut Message)
-> m (Raw mut Resolve) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Resolve
-> Raw mut Message -> m (Raw mut Resolve)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "resolve" (Variant 'Slot Message Resolve)
Variant 'Slot Message Resolve
#resolve Raw mut Message
struct_))
        Word16
6 ->
            (Raw mut Release -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Release -> RawWhich mut_ Message
RW_Message'release (Raw mut Release -> RawWhich mut Message)
-> m (Raw mut Release) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Release
-> Raw mut Message -> m (Raw mut Release)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "release" (Variant 'Slot Message Release)
Variant 'Slot Message Release
#release Raw mut Message
struct_))
        Word16
7 ->
            (Raw mut AnyPointer -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Message
RW_Message'obsoleteSave (Raw mut AnyPointer -> RawWhich mut Message)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message AnyPointer
-> Raw mut Message -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "obsoleteSave" (Variant 'Slot Message AnyPointer)
Variant 'Slot Message AnyPointer
#obsoleteSave Raw mut Message
struct_))
        Word16
8 ->
            (Raw mut Bootstrap -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Bootstrap -> RawWhich mut_ Message
RW_Message'bootstrap (Raw mut Bootstrap -> RawWhich mut Message)
-> m (Raw mut Bootstrap) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Bootstrap
-> Raw mut Message -> m (Raw mut Bootstrap)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "bootstrap" (Variant 'Slot Message Bootstrap)
Variant 'Slot Message Bootstrap
#bootstrap Raw mut Message
struct_))
        Word16
9 ->
            (Raw mut AnyPointer -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Message
RW_Message'obsoleteDelete (Raw mut AnyPointer -> RawWhich mut Message)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message AnyPointer
-> Raw mut Message -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "obsoleteDelete" (Variant 'Slot Message AnyPointer)
Variant 'Slot Message AnyPointer
#obsoleteDelete Raw mut Message
struct_))
        Word16
10 ->
            (Raw mut Provide -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Provide -> RawWhich mut_ Message
RW_Message'provide (Raw mut Provide -> RawWhich mut Message)
-> m (Raw mut Provide) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Provide
-> Raw mut Message -> m (Raw mut Provide)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "provide" (Variant 'Slot Message Provide)
Variant 'Slot Message Provide
#provide Raw mut Message
struct_))
        Word16
11 ->
            (Raw mut Accept -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Accept -> RawWhich mut_ Message
RW_Message'accept (Raw mut Accept -> RawWhich mut Message)
-> m (Raw mut Accept) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Accept
-> Raw mut Message -> m (Raw mut Accept)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "accept" (Variant 'Slot Message Accept)
Variant 'Slot Message Accept
#accept Raw mut Message
struct_))
        Word16
12 ->
            (Raw mut Join -> RawWhich mut Message
forall (mut_ :: Mutability). Raw mut_ Join -> RawWhich mut_ Message
RW_Message'join (Raw mut Join -> RawWhich mut Message)
-> m (Raw mut Join) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Join -> Raw mut Message -> m (Raw mut Join)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "join" (Variant 'Slot Message Join)
Variant 'Slot Message Join
#join Raw mut Message
struct_))
        Word16
13 ->
            (Raw mut Disembargo -> RawWhich mut Message
forall (mut_ :: Mutability).
Raw mut_ Disembargo -> RawWhich mut_ Message
RW_Message'disembargo (Raw mut Disembargo -> RawWhich mut Message)
-> m (Raw mut Disembargo) -> m (RawWhich mut Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Message Disembargo
-> Raw mut Message -> m (Raw mut Disembargo)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "disembargo" (Variant 'Slot Message Disembargo)
Variant 'Slot Message Disembargo
#disembargo Raw mut Message
struct_))
        Word16
_ ->
            (RawWhich mut Message -> m (RawWhich mut Message)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Message
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Message
RW_Message'unknown' Word16
tag_))
    data Which Message
instance (GH.HasVariant "unimplemented" GH.Slot Message Message) where
    variantByLabel :: Variant 'Slot Message Message
variantByLabel  = (Field 'Slot Message Message
-> Word16 -> Variant 'Slot Message Message
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Message
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
0)
instance (GH.HasVariant "abort" GH.Slot Message Exception) where
    variantByLabel :: Variant 'Slot Message Exception
variantByLabel  = (Field 'Slot Message Exception
-> Word16 -> Variant 'Slot Message Exception
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Exception
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
1)
instance (GH.HasVariant "call" GH.Slot Message Call) where
    variantByLabel :: Variant 'Slot Message Call
variantByLabel  = (Field 'Slot Message Call -> Word16 -> Variant 'Slot Message Call
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Call
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
2)
instance (GH.HasVariant "return" GH.Slot Message Return) where
    variantByLabel :: Variant 'Slot Message Return
variantByLabel  = (Field 'Slot Message Return
-> Word16 -> Variant 'Slot Message Return
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Return
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
3)
instance (GH.HasVariant "finish" GH.Slot Message Finish) where
    variantByLabel :: Variant 'Slot Message Finish
variantByLabel  = (Field 'Slot Message Finish
-> Word16 -> Variant 'Slot Message Finish
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Finish
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
4)
instance (GH.HasVariant "resolve" GH.Slot Message Resolve) where
    variantByLabel :: Variant 'Slot Message Resolve
variantByLabel  = (Field 'Slot Message Resolve
-> Word16 -> Variant 'Slot Message Resolve
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Resolve
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
5)
instance (GH.HasVariant "release" GH.Slot Message Release) where
    variantByLabel :: Variant 'Slot Message Release
variantByLabel  = (Field 'Slot Message Release
-> Word16 -> Variant 'Slot Message Release
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Release
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
6)
instance (GH.HasVariant "obsoleteSave" GH.Slot Message Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Message AnyPointer
variantByLabel  = (Field 'Slot Message AnyPointer
-> Word16 -> Variant 'Slot Message AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
7)
instance (GH.HasVariant "bootstrap" GH.Slot Message Bootstrap) where
    variantByLabel :: Variant 'Slot Message Bootstrap
variantByLabel  = (Field 'Slot Message Bootstrap
-> Word16 -> Variant 'Slot Message Bootstrap
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Bootstrap
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
8)
instance (GH.HasVariant "obsoleteDelete" GH.Slot Message Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Message AnyPointer
variantByLabel  = (Field 'Slot Message AnyPointer
-> Word16 -> Variant 'Slot Message AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
9)
instance (GH.HasVariant "provide" GH.Slot Message Provide) where
    variantByLabel :: Variant 'Slot Message Provide
variantByLabel  = (Field 'Slot Message Provide
-> Word16 -> Variant 'Slot Message Provide
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Provide
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
10)
instance (GH.HasVariant "accept" GH.Slot Message Accept) where
    variantByLabel :: Variant 'Slot Message Accept
variantByLabel  = (Field 'Slot Message Accept
-> Word16 -> Variant 'Slot Message Accept
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Accept
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
11)
instance (GH.HasVariant "join" GH.Slot Message Join) where
    variantByLabel :: Variant 'Slot Message Join
variantByLabel  = (Field 'Slot Message Join -> Word16 -> Variant 'Slot Message Join
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Join
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
12)
instance (GH.HasVariant "disembargo" GH.Slot Message Disembargo) where
    variantByLabel :: Variant 'Slot Message Disembargo
variantByLabel  = (Field 'Slot Message Disembargo
-> Word16 -> Variant 'Slot Message Disembargo
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Message Disembargo
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
13)
data instance C.Parsed (GH.Which Message)
    = Message'unimplemented (RP.Parsed Message)
    | Message'abort (RP.Parsed Exception)
    | Message'call (RP.Parsed Call)
    | Message'return (RP.Parsed Return)
    | Message'finish (RP.Parsed Finish)
    | Message'resolve (RP.Parsed Resolve)
    | Message'release (RP.Parsed Release)
    | Message'obsoleteSave (RP.Parsed Basics.AnyPointer)
    | Message'bootstrap (RP.Parsed Bootstrap)
    | Message'obsoleteDelete (RP.Parsed Basics.AnyPointer)
    | Message'provide (RP.Parsed Provide)
    | Message'accept (RP.Parsed Accept)
    | Message'join (RP.Parsed Join)
    | Message'disembargo (RP.Parsed Disembargo)
    | Message'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Message) -> Rep (Parsed (Which Message)) x)
-> (forall x.
    Rep (Parsed (Which Message)) x -> Parsed (Which Message))
-> Generic (Parsed (Which Message))
forall x. Rep (Parsed (Which Message)) x -> Parsed (Which Message)
forall x. Parsed (Which Message) -> Rep (Parsed (Which Message)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Message)) x -> Parsed (Which Message)
$cfrom :: forall x. Parsed (Which Message) -> Rep (Parsed (Which Message)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Message)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Message)))
instance (C.Parse (GH.Which Message) (C.Parsed (GH.Which Message))) where
    parse :: Raw 'Const (Which Message) -> m (Parsed (Which Message))
parse Raw 'Const (Which Message)
raw_ = (do
        RawWhich 'Const Message
rawWhich_ <- (Raw 'Const (Which Message) -> m (RawWhich 'Const Message)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Message)
raw_)
        case RawWhich 'Const Message
rawWhich_ of
            (RW_Message'unimplemented rawArg_) ->
                (Parsed Message -> Parsed (Which Message)
Parsed Message -> Parsed (Which Message)
Message'unimplemented (Parsed Message -> Parsed (Which Message))
-> m (Parsed Message) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Message -> m (Parsed Message)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Message
rawArg_))
            (RW_Message'abort rawArg_) ->
                (Parsed Exception -> Parsed (Which Message)
Parsed Exception -> Parsed (Which Message)
Message'abort (Parsed Exception -> Parsed (Which Message))
-> m (Parsed Exception) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Exception -> m (Parsed Exception)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Exception
rawArg_))
            (RW_Message'call rawArg_) ->
                (Parsed Call -> Parsed (Which Message)
Parsed Call -> Parsed (Which Message)
Message'call (Parsed Call -> Parsed (Which Message))
-> m (Parsed Call) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Call -> m (Parsed Call)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Call
rawArg_))
            (RW_Message'return rawArg_) ->
                (Parsed Return -> Parsed (Which Message)
Parsed Return -> Parsed (Which Message)
Message'return (Parsed Return -> Parsed (Which Message))
-> m (Parsed Return) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Return -> m (Parsed Return)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Return
rawArg_))
            (RW_Message'finish rawArg_) ->
                (Parsed Finish -> Parsed (Which Message)
Parsed Finish -> Parsed (Which Message)
Message'finish (Parsed Finish -> Parsed (Which Message))
-> m (Parsed Finish) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Finish -> m (Parsed Finish)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Finish
rawArg_))
            (RW_Message'resolve rawArg_) ->
                (Parsed Resolve -> Parsed (Which Message)
Parsed Resolve -> Parsed (Which Message)
Message'resolve (Parsed Resolve -> Parsed (Which Message))
-> m (Parsed Resolve) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Resolve -> m (Parsed Resolve)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Resolve
rawArg_))
            (RW_Message'release rawArg_) ->
                (Parsed Release -> Parsed (Which Message)
Parsed Release -> Parsed (Which Message)
Message'release (Parsed Release -> Parsed (Which Message))
-> m (Parsed Release) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Release -> m (Parsed Release)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Release
rawArg_))
            (RW_Message'obsoleteSave rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Message)
Parsed AnyPointer -> Parsed (Which Message)
Message'obsoleteSave (Parsed AnyPointer -> Parsed (Which Message))
-> m (Parsed AnyPointer) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Message'bootstrap rawArg_) ->
                (Parsed Bootstrap -> Parsed (Which Message)
Parsed Bootstrap -> Parsed (Which Message)
Message'bootstrap (Parsed Bootstrap -> Parsed (Which Message))
-> m (Parsed Bootstrap) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Bootstrap -> m (Parsed Bootstrap)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Bootstrap
rawArg_))
            (RW_Message'obsoleteDelete rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Message)
Parsed AnyPointer -> Parsed (Which Message)
Message'obsoleteDelete (Parsed AnyPointer -> Parsed (Which Message))
-> m (Parsed AnyPointer) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Message'provide rawArg_) ->
                (Parsed Provide -> Parsed (Which Message)
Parsed Provide -> Parsed (Which Message)
Message'provide (Parsed Provide -> Parsed (Which Message))
-> m (Parsed Provide) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Provide -> m (Parsed Provide)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Provide
rawArg_))
            (RW_Message'accept rawArg_) ->
                (Parsed Accept -> Parsed (Which Message)
Parsed Accept -> Parsed (Which Message)
Message'accept (Parsed Accept -> Parsed (Which Message))
-> m (Parsed Accept) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Accept -> m (Parsed Accept)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Accept
rawArg_))
            (RW_Message'join rawArg_) ->
                (Parsed Join -> Parsed (Which Message)
Parsed Join -> Parsed (Which Message)
Message'join (Parsed Join -> Parsed (Which Message))
-> m (Parsed Join) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Join -> m (Parsed Join)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Join
rawArg_))
            (RW_Message'disembargo rawArg_) ->
                (Parsed Disembargo -> Parsed (Which Message)
Parsed Disembargo -> Parsed (Which Message)
Message'disembargo (Parsed Disembargo -> Parsed (Which Message))
-> m (Parsed Disembargo) -> m (Parsed (Which Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Disembargo -> m (Parsed Disembargo)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Disembargo
rawArg_))
            (RW_Message'unknown' tag_) ->
                (Parsed (Which Message) -> m (Parsed (Which Message))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Message)
Message'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Message) (C.Parsed (GH.Which Message))) where
    marshalInto :: Raw ('Mut s) (Which Message) -> Parsed (Which Message) -> m ()
marshalInto Raw ('Mut s) (Which Message)
raw_ Parsed (Which Message)
parsed_ = case Parsed (Which Message)
parsed_ of
        (Message'unimplemented arg_) ->
            (Variant 'Slot Message Message
-> Parsed Message -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "unimplemented" (Variant 'Slot Message Message)
Variant 'Slot Message Message
#unimplemented Parsed Message
Parsed Message
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'abort arg_) ->
            (Variant 'Slot Message Exception
-> Parsed Exception -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "abort" (Variant 'Slot Message Exception)
Variant 'Slot Message Exception
#abort Parsed Exception
Parsed Exception
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'call arg_) ->
            (Variant 'Slot Message Call
-> Parsed Call -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "call" (Variant 'Slot Message Call)
Variant 'Slot Message Call
#call Parsed Call
Parsed Call
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'return arg_) ->
            (Variant 'Slot Message Return
-> Parsed Return -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "return" (Variant 'Slot Message Return)
Variant 'Slot Message Return
#return Parsed Return
Parsed Return
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'finish arg_) ->
            (Variant 'Slot Message Finish
-> Parsed Finish -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "finish" (Variant 'Slot Message Finish)
Variant 'Slot Message Finish
#finish Parsed Finish
Parsed Finish
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'resolve arg_) ->
            (Variant 'Slot Message Resolve
-> Parsed Resolve -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "resolve" (Variant 'Slot Message Resolve)
Variant 'Slot Message Resolve
#resolve Parsed Resolve
Parsed Resolve
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'release arg_) ->
            (Variant 'Slot Message Release
-> Parsed Release -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "release" (Variant 'Slot Message Release)
Variant 'Slot Message Release
#release Parsed Release
Parsed Release
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'obsoleteSave arg_) ->
            (Variant 'Slot Message AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "obsoleteSave" (Variant 'Slot Message AnyPointer)
Variant 'Slot Message AnyPointer
#obsoleteSave Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'bootstrap arg_) ->
            (Variant 'Slot Message Bootstrap
-> Parsed Bootstrap -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "bootstrap" (Variant 'Slot Message Bootstrap)
Variant 'Slot Message Bootstrap
#bootstrap Parsed Bootstrap
Parsed Bootstrap
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'obsoleteDelete arg_) ->
            (Variant 'Slot Message AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "obsoleteDelete" (Variant 'Slot Message AnyPointer)
Variant 'Slot Message AnyPointer
#obsoleteDelete Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'provide arg_) ->
            (Variant 'Slot Message Provide
-> Parsed Provide -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "provide" (Variant 'Slot Message Provide)
Variant 'Slot Message Provide
#provide Parsed Provide
Parsed Provide
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'accept arg_) ->
            (Variant 'Slot Message Accept
-> Parsed Accept -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "accept" (Variant 'Slot Message Accept)
Variant 'Slot Message Accept
#accept Parsed Accept
Parsed Accept
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'join arg_) ->
            (Variant 'Slot Message Join
-> Parsed Join -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "join" (Variant 'Slot Message Join)
Variant 'Slot Message Join
#join Parsed Join
Parsed Join
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'disembargo arg_) ->
            (Variant 'Slot Message Disembargo
-> Parsed Disembargo -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "disembargo" (Variant 'Slot Message Disembargo)
Variant 'Slot Message Disembargo
#disembargo Parsed Disembargo
Parsed Disembargo
arg_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
        (Message'unknown' tag_) ->
            (Field 'Slot Message Word16
-> Word16 -> Raw ('Mut s) Message -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Message Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Message) -> Raw ('Mut s) Message
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Message)
raw_))
data Bootstrap 
type instance (R.ReprFor Bootstrap) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Bootstrap) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Bootstrap) where
    type AllocHint Bootstrap = ()
    new :: AllocHint Bootstrap
-> Message ('Mut s) -> m (Raw ('Mut s) Bootstrap)
new AllocHint Bootstrap
_ = Message ('Mut s) -> m (Raw ('Mut s) Bootstrap)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Bootstrap (C.Parsed Bootstrap))
instance (C.AllocateList Bootstrap) where
    type ListAllocHint Bootstrap = Std_.Int
    newList :: ListAllocHint Bootstrap
-> Message ('Mut s) -> m (Raw ('Mut s) (List Bootstrap))
newList  = ListAllocHint Bootstrap
-> Message ('Mut s) -> m (Raw ('Mut s) (List Bootstrap))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Bootstrap (C.Parsed Bootstrap))
data instance C.Parsed Bootstrap
    = Bootstrap 
        {Parsed Bootstrap -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Bootstrap -> Parsed AnyPointer
deprecatedObjectId :: (RP.Parsed Basics.AnyPointer)}
    deriving((forall x. Parsed Bootstrap -> Rep (Parsed Bootstrap) x)
-> (forall x. Rep (Parsed Bootstrap) x -> Parsed Bootstrap)
-> Generic (Parsed Bootstrap)
forall x. Rep (Parsed Bootstrap) x -> Parsed Bootstrap
forall x. Parsed Bootstrap -> Rep (Parsed Bootstrap) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Bootstrap) x -> Parsed Bootstrap
$cfrom :: forall x. Parsed Bootstrap -> Rep (Parsed Bootstrap) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Bootstrap))
deriving instance (Std_.Eq (C.Parsed Bootstrap))
instance (C.Parse Bootstrap (C.Parsed Bootstrap)) where
    parse :: Raw 'Const Bootstrap -> m (Parsed Bootstrap)
parse Raw 'Const Bootstrap
raw_ = (Word32 -> Parsed AnyPointer -> Parsed Bootstrap
Parsed Word32 -> Parsed AnyPointer -> Parsed Bootstrap
Bootstrap (Word32 -> Parsed AnyPointer -> Parsed Bootstrap)
-> m Word32 -> m (Parsed AnyPointer -> Parsed Bootstrap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Bootstrap Word32 -> Raw 'Const Bootstrap -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Bootstrap Word32)
Field 'Slot Bootstrap Word32
#questionId Raw 'Const Bootstrap
raw_)
                            m (Parsed AnyPointer -> Parsed Bootstrap)
-> m (Parsed AnyPointer) -> m (Parsed Bootstrap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Bootstrap AnyPointer
-> Raw 'Const Bootstrap -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "deprecatedObjectId" (Field 'Slot Bootstrap AnyPointer)
Field 'Slot Bootstrap AnyPointer
#deprecatedObjectId Raw 'Const Bootstrap
raw_))
instance (C.Marshal Bootstrap (C.Parsed Bootstrap)) where
    marshalInto :: Raw ('Mut s) Bootstrap -> Parsed Bootstrap -> m ()
marshalInto Raw ('Mut s) Bootstrap
raw_ Bootstrap{..} = (do
        (Field 'Slot Bootstrap Word32
-> Word32 -> Raw ('Mut s) Bootstrap -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Bootstrap Word32)
Field 'Slot Bootstrap Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Bootstrap
raw_)
        (Field 'Slot Bootstrap AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Bootstrap -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "deprecatedObjectId" (Field 'Slot Bootstrap AnyPointer)
Field 'Slot Bootstrap AnyPointer
#deprecatedObjectId Parsed AnyPointer
Parsed AnyPointer
deprecatedObjectId Raw ('Mut s) Bootstrap
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Bootstrap Std_.Word32) where
    fieldByLabel :: Field 'Slot Bootstrap Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Bootstrap Word32
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 "deprecatedObjectId" GH.Slot Bootstrap Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot Bootstrap AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot Bootstrap AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Call 
type instance (R.ReprFor Call) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Call) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
3
instance (C.Allocate Call) where
    type AllocHint Call = ()
    new :: AllocHint Call -> Message ('Mut s) -> m (Raw ('Mut s) Call)
new AllocHint Call
_ = Message ('Mut s) -> m (Raw ('Mut s) Call)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Call (C.Parsed Call))
instance (C.AllocateList Call) where
    type ListAllocHint Call = Std_.Int
    newList :: ListAllocHint Call
-> Message ('Mut s) -> m (Raw ('Mut s) (List Call))
newList  = ListAllocHint Call
-> Message ('Mut s) -> m (Raw ('Mut s) (List Call))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Call (C.Parsed Call))
data instance C.Parsed Call
    = Call 
        {Parsed Call -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Call -> Parsed MessageTarget
target :: (RP.Parsed MessageTarget)
        ,Parsed Call -> Parsed Word64
interfaceId :: (RP.Parsed Std_.Word64)
        ,Parsed Call -> Parsed Word16
methodId :: (RP.Parsed Std_.Word16)
        ,Parsed Call -> Parsed Payload
params :: (RP.Parsed Payload)
        ,Parsed Call -> Parsed Call'sendResultsTo
sendResultsTo :: (RP.Parsed Call'sendResultsTo)
        ,Parsed Call -> Parsed Bool
allowThirdPartyTailCall :: (RP.Parsed Std_.Bool)}
    deriving((forall x. Parsed Call -> Rep (Parsed Call) x)
-> (forall x. Rep (Parsed Call) x -> Parsed Call)
-> Generic (Parsed Call)
forall x. Rep (Parsed Call) x -> Parsed Call
forall x. Parsed Call -> Rep (Parsed Call) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Call) x -> Parsed Call
$cfrom :: forall x. Parsed Call -> Rep (Parsed Call) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Call))
deriving instance (Std_.Eq (C.Parsed Call))
instance (C.Parse Call (C.Parsed Call)) where
    parse :: Raw 'Const Call -> m (Parsed Call)
parse Raw 'Const Call
raw_ = (Word32
-> Parsed MessageTarget
-> Word64
-> Word16
-> Parsed Payload
-> Parsed Call'sendResultsTo
-> Bool
-> Parsed Call
Parsed Word32
-> Parsed MessageTarget
-> Parsed Word64
-> Parsed Word16
-> Parsed Payload
-> Parsed Call'sendResultsTo
-> Parsed Bool
-> Parsed Call
Call (Word32
 -> Parsed MessageTarget
 -> Word64
 -> Word16
 -> Parsed Payload
 -> Parsed Call'sendResultsTo
 -> Bool
 -> Parsed Call)
-> m Word32
-> m (Parsed MessageTarget
      -> Word64
      -> Word16
      -> Parsed Payload
      -> Parsed Call'sendResultsTo
      -> Bool
      -> Parsed Call)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Call Word32 -> Raw 'Const Call -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Call Word32)
Field 'Slot Call Word32
#questionId Raw 'Const Call
raw_)
                       m (Parsed MessageTarget
   -> Word64
   -> Word16
   -> Parsed Payload
   -> Parsed Call'sendResultsTo
   -> Bool
   -> Parsed Call)
-> m (Parsed MessageTarget)
-> m (Word64
      -> Word16
      -> Parsed Payload
      -> Parsed Call'sendResultsTo
      -> Bool
      -> Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Call MessageTarget
-> Raw 'Const Call -> m (Parsed MessageTarget)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "target" (Field 'Slot Call MessageTarget)
Field 'Slot Call MessageTarget
#target Raw 'Const Call
raw_)
                       m (Word64
   -> Word16
   -> Parsed Payload
   -> Parsed Call'sendResultsTo
   -> Bool
   -> Parsed Call)
-> m Word64
-> m (Word16
      -> Parsed Payload
      -> Parsed Call'sendResultsTo
      -> Bool
      -> Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Call Word64 -> Raw 'Const Call -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "interfaceId" (Field 'Slot Call Word64)
Field 'Slot Call Word64
#interfaceId Raw 'Const Call
raw_)
                       m (Word16
   -> Parsed Payload
   -> Parsed Call'sendResultsTo
   -> Bool
   -> Parsed Call)
-> m Word16
-> m (Parsed Payload
      -> Parsed Call'sendResultsTo -> Bool -> Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Call Word16 -> Raw 'Const Call -> m Word16
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "methodId" (Field 'Slot Call Word16)
Field 'Slot Call Word16
#methodId Raw 'Const Call
raw_)
                       m (Parsed Payload
   -> Parsed Call'sendResultsTo -> Bool -> Parsed Call)
-> m (Parsed Payload)
-> m (Parsed Call'sendResultsTo -> Bool -> Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Call Payload -> Raw 'Const Call -> m (Parsed Payload)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "params" (Field 'Slot Call Payload)
Field 'Slot Call Payload
#params Raw 'Const Call
raw_)
                       m (Parsed Call'sendResultsTo -> Bool -> Parsed Call)
-> m (Parsed Call'sendResultsTo) -> m (Bool -> Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Group Call Call'sendResultsTo
-> Raw 'Const Call -> m (Parsed Call'sendResultsTo)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "sendResultsTo" (Field 'Group Call Call'sendResultsTo)
Field 'Group Call Call'sendResultsTo
#sendResultsTo Raw 'Const Call
raw_)
                       m (Bool -> Parsed Call) -> m Bool -> m (Parsed Call)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Call Bool -> Raw 'Const Call -> m Bool
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "allowThirdPartyTailCall" (Field 'Slot Call Bool)
Field 'Slot Call Bool
#allowThirdPartyTailCall Raw 'Const Call
raw_))
instance (C.Marshal Call (C.Parsed Call)) where
    marshalInto :: Raw ('Mut s) Call -> Parsed Call -> m ()
marshalInto Raw ('Mut s) Call
raw_ Call{..} = (do
        (Field 'Slot Call Word32 -> Word32 -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Call Word32)
Field 'Slot Call Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Call
raw_)
        (Field 'Slot Call MessageTarget
-> Parsed MessageTarget -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "target" (Field 'Slot Call MessageTarget)
Field 'Slot Call MessageTarget
#target Parsed MessageTarget
Parsed MessageTarget
target Raw ('Mut s) Call
raw_)
        (Field 'Slot Call Word64 -> Word64 -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "interfaceId" (Field 'Slot Call Word64)
Field 'Slot Call Word64
#interfaceId Word64
Parsed Word64
interfaceId Raw ('Mut s) Call
raw_)
        (Field 'Slot Call Word16 -> Word16 -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "methodId" (Field 'Slot Call Word16)
Field 'Slot Call Word16
#methodId Word16
Parsed Word16
methodId Raw ('Mut s) Call
raw_)
        (Field 'Slot Call Payload
-> Parsed Payload -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "params" (Field 'Slot Call Payload)
Field 'Slot Call Payload
#params Parsed Payload
Parsed Payload
params Raw ('Mut s) Call
raw_)
        (do
            Raw ('Mut s) Call'sendResultsTo
group_ <- (Field 'Group Call Call'sendResultsTo
-> Raw ('Mut s) Call -> m (Raw ('Mut s) Call'sendResultsTo)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw mut a -> m (Raw mut b)
GH.readField IsLabel "sendResultsTo" (Field 'Group Call Call'sendResultsTo)
Field 'Group Call Call'sendResultsTo
#sendResultsTo Raw ('Mut s) Call
raw_)
            (Raw ('Mut s) Call'sendResultsTo
-> Parsed Call'sendResultsTo -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Call'sendResultsTo
group_ Parsed Call'sendResultsTo
Parsed Call'sendResultsTo
sendResultsTo)
            )
        (Field 'Slot Call Bool -> Bool -> Raw ('Mut s) Call -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "allowThirdPartyTailCall" (Field 'Slot Call Bool)
Field 'Slot Call Bool
#allowThirdPartyTailCall Bool
Parsed Bool
allowThirdPartyTailCall Raw ('Mut s) Call
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Call Std_.Word32) where
    fieldByLabel :: Field 'Slot Call Word32
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Call Word32
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 "target" GH.Slot Call MessageTarget) where
    fieldByLabel :: Field 'Slot Call MessageTarget
fieldByLabel  = (Word16 -> Field 'Slot Call MessageTarget
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "interfaceId" GH.Slot Call Std_.Word64) where
    fieldByLabel :: Field 'Slot Call Word64
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Call Word64
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
1 BitCount
64 Word64
0)
instance (GH.HasField "methodId" GH.Slot Call Std_.Word16) where
    fieldByLabel :: Field 'Slot Call Word16
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Call Word16
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 "params" GH.Slot Call Payload) where
    fieldByLabel :: Field 'Slot Call Payload
fieldByLabel  = (Word16 -> Field 'Slot Call Payload
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
instance (GH.HasField "sendResultsTo" GH.Group Call Call'sendResultsTo) where
    fieldByLabel :: Field 'Group Call Call'sendResultsTo
fieldByLabel  = Field 'Group Call Call'sendResultsTo
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField
instance (GH.HasField "allowThirdPartyTailCall" GH.Slot Call Std_.Bool) where
    fieldByLabel :: Field 'Slot Call Bool
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Call Bool
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
2 BitCount
1 Word64
0)
data Call'sendResultsTo 
type instance (R.ReprFor Call'sendResultsTo) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Call'sendResultsTo) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
3
instance (C.Allocate Call'sendResultsTo) where
    type AllocHint Call'sendResultsTo = ()
    new :: AllocHint Call'sendResultsTo
-> Message ('Mut s) -> m (Raw ('Mut s) Call'sendResultsTo)
new AllocHint Call'sendResultsTo
_ = Message ('Mut s) -> m (Raw ('Mut s) Call'sendResultsTo)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Call'sendResultsTo (C.Parsed Call'sendResultsTo))
instance (C.AllocateList Call'sendResultsTo) where
    type ListAllocHint Call'sendResultsTo = Std_.Int
    newList :: ListAllocHint Call'sendResultsTo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Call'sendResultsTo))
newList  = ListAllocHint Call'sendResultsTo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Call'sendResultsTo))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Call'sendResultsTo (C.Parsed Call'sendResultsTo))
data instance C.Parsed Call'sendResultsTo
    = Call'sendResultsTo' 
        {Parsed Call'sendResultsTo -> Parsed (Which Call'sendResultsTo)
union' :: (C.Parsed (GH.Which Call'sendResultsTo))}
    deriving((forall x.
 Parsed Call'sendResultsTo -> Rep (Parsed Call'sendResultsTo) x)
-> (forall x.
    Rep (Parsed Call'sendResultsTo) x -> Parsed Call'sendResultsTo)
-> Generic (Parsed Call'sendResultsTo)
forall x.
Rep (Parsed Call'sendResultsTo) x -> Parsed Call'sendResultsTo
forall x.
Parsed Call'sendResultsTo -> Rep (Parsed Call'sendResultsTo) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Call'sendResultsTo) x -> Parsed Call'sendResultsTo
$cfrom :: forall x.
Parsed Call'sendResultsTo -> Rep (Parsed Call'sendResultsTo) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Call'sendResultsTo))
deriving instance (Std_.Eq (C.Parsed Call'sendResultsTo))
instance (C.Parse Call'sendResultsTo (C.Parsed Call'sendResultsTo)) where
    parse :: Raw 'Const Call'sendResultsTo -> m (Parsed Call'sendResultsTo)
parse Raw 'Const Call'sendResultsTo
raw_ = (Parsed (Which Call'sendResultsTo) -> Parsed Call'sendResultsTo
Call'sendResultsTo' (Parsed (Which Call'sendResultsTo) -> Parsed Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
-> m (Parsed Call'sendResultsTo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Call'sendResultsTo
-> Raw 'Const (Which Call'sendResultsTo)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Call'sendResultsTo
raw_)))
instance (C.Marshal Call'sendResultsTo (C.Parsed Call'sendResultsTo)) where
    marshalInto :: Raw ('Mut s) Call'sendResultsTo
-> Parsed Call'sendResultsTo -> m ()
marshalInto Raw ('Mut s) Call'sendResultsTo
raw_ Call'sendResultsTo'{..} = (do
        (Raw ('Mut s) (Which Call'sendResultsTo)
-> Parsed (Which Call'sendResultsTo) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Call'sendResultsTo
-> Raw ('Mut s) (Which Call'sendResultsTo)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Call'sendResultsTo
raw_) Parsed (Which Call'sendResultsTo)
union')
        )
instance (GH.HasUnion Call'sendResultsTo) where
    unionField :: Field 'Slot Call'sendResultsTo Word16
unionField  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Call'sendResultsTo Word16
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 RawWhich mut_ Call'sendResultsTo
        = RW_Call'sendResultsTo'caller (R.Raw mut_ ())
        | RW_Call'sendResultsTo'yourself (R.Raw mut_ ())
        | RW_Call'sendResultsTo'thirdParty (R.Raw mut_ Basics.AnyPointer)
        | RW_Call'sendResultsTo'unknown' Std_.Word16
    internalWhich :: Word16
-> Raw mut Call'sendResultsTo
-> m (RawWhich mut Call'sendResultsTo)
internalWhich Word16
tag_ Raw mut Call'sendResultsTo
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Call'sendResultsTo
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Call'sendResultsTo
RW_Call'sendResultsTo'caller (Raw mut () -> RawWhich mut Call'sendResultsTo)
-> m (Raw mut ()) -> m (RawWhich mut Call'sendResultsTo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Call'sendResultsTo ()
-> Raw mut Call'sendResultsTo -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "caller" (Variant 'Slot Call'sendResultsTo ())
Variant 'Slot Call'sendResultsTo ()
#caller Raw mut Call'sendResultsTo
struct_))
        Word16
1 ->
            (Raw mut () -> RawWhich mut Call'sendResultsTo
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Call'sendResultsTo
RW_Call'sendResultsTo'yourself (Raw mut () -> RawWhich mut Call'sendResultsTo)
-> m (Raw mut ()) -> m (RawWhich mut Call'sendResultsTo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Call'sendResultsTo ()
-> Raw mut Call'sendResultsTo -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "yourself" (Variant 'Slot Call'sendResultsTo ())
Variant 'Slot Call'sendResultsTo ()
#yourself Raw mut Call'sendResultsTo
struct_))
        Word16
2 ->
            (Raw mut AnyPointer -> RawWhich mut Call'sendResultsTo
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Call'sendResultsTo
RW_Call'sendResultsTo'thirdParty (Raw mut AnyPointer -> RawWhich mut Call'sendResultsTo)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Call'sendResultsTo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Call'sendResultsTo AnyPointer
-> Raw mut Call'sendResultsTo -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "thirdParty" (Variant 'Slot Call'sendResultsTo AnyPointer)
Variant 'Slot Call'sendResultsTo AnyPointer
#thirdParty Raw mut Call'sendResultsTo
struct_))
        Word16
_ ->
            (RawWhich mut Call'sendResultsTo
-> m (RawWhich mut Call'sendResultsTo)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Call'sendResultsTo
forall (mut_ :: Mutability).
Word16 -> RawWhich mut_ Call'sendResultsTo
RW_Call'sendResultsTo'unknown' Word16
tag_))
    data Which Call'sendResultsTo
instance (GH.HasVariant "caller" GH.Slot Call'sendResultsTo ()) where
    variantByLabel :: Variant 'Slot Call'sendResultsTo ()
variantByLabel  = (Field 'Slot Call'sendResultsTo ()
-> Word16 -> Variant 'Slot Call'sendResultsTo ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Call'sendResultsTo ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "yourself" GH.Slot Call'sendResultsTo ()) where
    variantByLabel :: Variant 'Slot Call'sendResultsTo ()
variantByLabel  = (Field 'Slot Call'sendResultsTo ()
-> Word16 -> Variant 'Slot Call'sendResultsTo ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Call'sendResultsTo ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
1)
instance (GH.HasVariant "thirdParty" GH.Slot Call'sendResultsTo Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Call'sendResultsTo AnyPointer
variantByLabel  = (Field 'Slot Call'sendResultsTo AnyPointer
-> Word16 -> Variant 'Slot Call'sendResultsTo AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Call'sendResultsTo AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
2) Word16
2)
data instance C.Parsed (GH.Which Call'sendResultsTo)
    = Call'sendResultsTo'caller 
    | Call'sendResultsTo'yourself 
    | Call'sendResultsTo'thirdParty (RP.Parsed Basics.AnyPointer)
    | Call'sendResultsTo'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Call'sendResultsTo)
 -> Rep (Parsed (Which Call'sendResultsTo)) x)
-> (forall x.
    Rep (Parsed (Which Call'sendResultsTo)) x
    -> Parsed (Which Call'sendResultsTo))
-> Generic (Parsed (Which Call'sendResultsTo))
forall x.
Rep (Parsed (Which Call'sendResultsTo)) x
-> Parsed (Which Call'sendResultsTo)
forall x.
Parsed (Which Call'sendResultsTo)
-> Rep (Parsed (Which Call'sendResultsTo)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Call'sendResultsTo)) x
-> Parsed (Which Call'sendResultsTo)
$cfrom :: forall x.
Parsed (Which Call'sendResultsTo)
-> Rep (Parsed (Which Call'sendResultsTo)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Call'sendResultsTo)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Call'sendResultsTo)))
instance (C.Parse (GH.Which Call'sendResultsTo) (C.Parsed (GH.Which Call'sendResultsTo))) where
    parse :: Raw 'Const (Which Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
parse Raw 'Const (Which Call'sendResultsTo)
raw_ = (do
        RawWhich 'Const Call'sendResultsTo
rawWhich_ <- (Raw 'Const (Which Call'sendResultsTo)
-> m (RawWhich 'Const Call'sendResultsTo)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Call'sendResultsTo)
raw_)
        case RawWhich 'Const Call'sendResultsTo
rawWhich_ of
            (RW_Call'sendResultsTo'caller _) ->
                (Parsed (Which Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'caller)
            (RW_Call'sendResultsTo'yourself _) ->
                (Parsed (Which Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'yourself)
            (RW_Call'sendResultsTo'thirdParty rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Call'sendResultsTo)
Parsed AnyPointer -> Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'thirdParty (Parsed AnyPointer -> Parsed (Which Call'sendResultsTo))
-> m (Parsed AnyPointer) -> m (Parsed (Which Call'sendResultsTo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Call'sendResultsTo'unknown' tag_) ->
                (Parsed (Which Call'sendResultsTo)
-> m (Parsed (Which Call'sendResultsTo))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Call'sendResultsTo) (C.Parsed (GH.Which Call'sendResultsTo))) where
    marshalInto :: Raw ('Mut s) (Which Call'sendResultsTo)
-> Parsed (Which Call'sendResultsTo) -> m ()
marshalInto Raw ('Mut s) (Which Call'sendResultsTo)
raw_ Parsed (Which Call'sendResultsTo)
parsed_ = case Parsed (Which Call'sendResultsTo)
parsed_ of
        (Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'caller) ->
            (Variant 'Slot Call'sendResultsTo ()
-> () -> Raw ('Mut s) Call'sendResultsTo -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "caller" (Variant 'Slot Call'sendResultsTo ())
Variant 'Slot Call'sendResultsTo ()
#caller () (Raw ('Mut s) (Which Call'sendResultsTo)
-> Raw ('Mut s) Call'sendResultsTo
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Call'sendResultsTo)
raw_))
        (Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'yourself) ->
            (Variant 'Slot Call'sendResultsTo ()
-> () -> Raw ('Mut s) Call'sendResultsTo -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "yourself" (Variant 'Slot Call'sendResultsTo ())
Variant 'Slot Call'sendResultsTo ()
#yourself () (Raw ('Mut s) (Which Call'sendResultsTo)
-> Raw ('Mut s) Call'sendResultsTo
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Call'sendResultsTo)
raw_))
        (Call'sendResultsTo'thirdParty arg_) ->
            (Variant 'Slot Call'sendResultsTo AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Call'sendResultsTo -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "thirdParty" (Variant 'Slot Call'sendResultsTo AnyPointer)
Variant 'Slot Call'sendResultsTo AnyPointer
#thirdParty Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Call'sendResultsTo)
-> Raw ('Mut s) Call'sendResultsTo
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Call'sendResultsTo)
raw_))
        (Call'sendResultsTo'unknown' tag_) ->
            (Field 'Slot Call'sendResultsTo Word16
-> Word16 -> Raw ('Mut s) Call'sendResultsTo -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Call'sendResultsTo Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Call'sendResultsTo)
-> Raw ('Mut s) Call'sendResultsTo
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Call'sendResultsTo)
raw_))
data Return 
type instance (R.ReprFor Return) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Return) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Return) where
    type AllocHint Return = ()
    new :: AllocHint Return -> Message ('Mut s) -> m (Raw ('Mut s) Return)
new AllocHint Return
_ = Message ('Mut s) -> m (Raw ('Mut s) Return)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Return (C.Parsed Return))
instance (C.AllocateList Return) where
    type ListAllocHint Return = Std_.Int
    newList :: ListAllocHint Return
-> Message ('Mut s) -> m (Raw ('Mut s) (List Return))
newList  = ListAllocHint Return
-> Message ('Mut s) -> m (Raw ('Mut s) (List Return))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Return (C.Parsed Return))
data instance C.Parsed Return
    = Return 
        {Parsed Return -> Parsed Word32
answerId :: (RP.Parsed Std_.Word32)
        ,Parsed Return -> Parsed Bool
releaseParamCaps :: (RP.Parsed Std_.Bool)
        ,Parsed Return -> Parsed (Which Return)
union' :: (C.Parsed (GH.Which Return))}
    deriving((forall x. Parsed Return -> Rep (Parsed Return) x)
-> (forall x. Rep (Parsed Return) x -> Parsed Return)
-> Generic (Parsed Return)
forall x. Rep (Parsed Return) x -> Parsed Return
forall x. Parsed Return -> Rep (Parsed Return) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Return) x -> Parsed Return
$cfrom :: forall x. Parsed Return -> Rep (Parsed Return) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Return))
deriving instance (Std_.Eq (C.Parsed Return))
instance (C.Parse Return (C.Parsed Return)) where
    parse :: Raw 'Const Return -> m (Parsed Return)
parse Raw 'Const Return
raw_ = (Word32 -> Bool -> Parsed (Which Return) -> Parsed Return
Parsed Word32
-> Parsed Bool -> Parsed (Which Return) -> Parsed Return
Return (Word32 -> Bool -> Parsed (Which Return) -> Parsed Return)
-> m Word32 -> m (Bool -> Parsed (Which Return) -> Parsed Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Return Word32 -> Raw 'Const Return -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "answerId" (Field 'Slot Return Word32)
Field 'Slot Return Word32
#answerId Raw 'Const Return
raw_)
                         m (Bool -> Parsed (Which Return) -> Parsed Return)
-> m Bool -> m (Parsed (Which Return) -> Parsed Return)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Return Bool -> Raw 'Const Return -> m Bool
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "releaseParamCaps" (Field 'Slot Return Bool)
Field 'Slot Return Bool
#releaseParamCaps Raw 'Const Return
raw_)
                         m (Parsed (Which Return) -> Parsed Return)
-> m (Parsed (Which Return)) -> m (Parsed Return)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which Return) -> m (Parsed (Which Return))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Return -> Raw 'Const (Which Return)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Return
raw_)))
instance (C.Marshal Return (C.Parsed Return)) where
    marshalInto :: Raw ('Mut s) Return -> Parsed Return -> m ()
marshalInto Raw ('Mut s) Return
raw_ Return{..} = (do
        (Field 'Slot Return Word32 -> Word32 -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "answerId" (Field 'Slot Return Word32)
Field 'Slot Return Word32
#answerId Word32
Parsed Word32
answerId Raw ('Mut s) Return
raw_)
        (Field 'Slot Return Bool -> Bool -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "releaseParamCaps" (Field 'Slot Return Bool)
Field 'Slot Return Bool
#releaseParamCaps Bool
Parsed Bool
releaseParamCaps Raw ('Mut s) Return
raw_)
        (Raw ('Mut s) (Which Return) -> Parsed (Which Return) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Return -> Raw ('Mut s) (Which Return)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Return
raw_) Parsed (Which Return)
union')
        )
instance (GH.HasUnion Return) where
    unionField :: Field 'Slot Return Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Return Word16
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 RawWhich mut_ Return
        = RW_Return'results (R.Raw mut_ Payload)
        | RW_Return'exception (R.Raw mut_ Exception)
        | RW_Return'canceled (R.Raw mut_ ())
        | RW_Return'resultsSentElsewhere (R.Raw mut_ ())
        | RW_Return'takeFromOtherQuestion (R.Raw mut_ Std_.Word32)
        | RW_Return'acceptFromThirdParty (R.Raw mut_ Basics.AnyPointer)
        | RW_Return'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Return -> m (RawWhich mut Return)
internalWhich Word16
tag_ Raw mut Return
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Payload -> RawWhich mut Return
forall (mut_ :: Mutability).
Raw mut_ Payload -> RawWhich mut_ Return
RW_Return'results (Raw mut Payload -> RawWhich mut Return)
-> m (Raw mut Payload) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return Payload
-> Raw mut Return -> m (Raw mut Payload)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "results" (Variant 'Slot Return Payload)
Variant 'Slot Return Payload
#results Raw mut Return
struct_))
        Word16
1 ->
            (Raw mut Exception -> RawWhich mut Return
forall (mut_ :: Mutability).
Raw mut_ Exception -> RawWhich mut_ Return
RW_Return'exception (Raw mut Exception -> RawWhich mut Return)
-> m (Raw mut Exception) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return Exception
-> Raw mut Return -> m (Raw mut Exception)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "exception" (Variant 'Slot Return Exception)
Variant 'Slot Return Exception
#exception Raw mut Return
struct_))
        Word16
2 ->
            (Raw mut () -> RawWhich mut Return
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Return
RW_Return'canceled (Raw mut () -> RawWhich mut Return)
-> m (Raw mut ()) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return () -> Raw mut Return -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "canceled" (Variant 'Slot Return ())
Variant 'Slot Return ()
#canceled Raw mut Return
struct_))
        Word16
3 ->
            (Raw mut () -> RawWhich mut Return
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Return
RW_Return'resultsSentElsewhere (Raw mut () -> RawWhich mut Return)
-> m (Raw mut ()) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return () -> Raw mut Return -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "resultsSentElsewhere" (Variant 'Slot Return ())
Variant 'Slot Return ()
#resultsSentElsewhere Raw mut Return
struct_))
        Word16
4 ->
            (Raw mut Word32 -> RawWhich mut Return
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ Return
RW_Return'takeFromOtherQuestion (Raw mut Word32 -> RawWhich mut Return)
-> m (Raw mut Word32) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return Word32 -> Raw mut Return -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "takeFromOtherQuestion" (Variant 'Slot Return Word32)
Variant 'Slot Return Word32
#takeFromOtherQuestion Raw mut Return
struct_))
        Word16
5 ->
            (Raw mut AnyPointer -> RawWhich mut Return
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Return
RW_Return'acceptFromThirdParty (Raw mut AnyPointer -> RawWhich mut Return)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Return AnyPointer
-> Raw mut Return -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "acceptFromThirdParty" (Variant 'Slot Return AnyPointer)
Variant 'Slot Return AnyPointer
#acceptFromThirdParty Raw mut Return
struct_))
        Word16
_ ->
            (RawWhich mut Return -> m (RawWhich mut Return)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Return
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Return
RW_Return'unknown' Word16
tag_))
    data Which Return
instance (GH.HasVariant "results" GH.Slot Return Payload) where
    variantByLabel :: Variant 'Slot Return Payload
variantByLabel  = (Field 'Slot Return Payload
-> Word16 -> Variant 'Slot Return Payload
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Return Payload
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
0)
instance (GH.HasVariant "exception" GH.Slot Return Exception) where
    variantByLabel :: Variant 'Slot Return Exception
variantByLabel  = (Field 'Slot Return Exception
-> Word16 -> Variant 'Slot Return Exception
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Return Exception
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
1)
instance (GH.HasVariant "canceled" GH.Slot Return ()) where
    variantByLabel :: Variant 'Slot Return ()
variantByLabel  = (Field 'Slot Return () -> Word16 -> Variant 'Slot Return ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Return ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
2)
instance (GH.HasVariant "resultsSentElsewhere" GH.Slot Return ()) where
    variantByLabel :: Variant 'Slot Return ()
variantByLabel  = (Field 'Slot Return () -> Word16 -> Variant 'Slot Return ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Return ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
3)
instance (GH.HasVariant "takeFromOtherQuestion" GH.Slot Return Std_.Word32) where
    variantByLabel :: Variant 'Slot Return Word32
variantByLabel  = (Field 'Slot Return Word32 -> Word16 -> Variant 'Slot Return Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Return Word32
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
1 BitCount
32 Word64
0) Word16
4)
instance (GH.HasVariant "acceptFromThirdParty" GH.Slot Return Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Return AnyPointer
variantByLabel  = (Field 'Slot Return AnyPointer
-> Word16 -> Variant 'Slot Return AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Return AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
5)
data instance C.Parsed (GH.Which Return)
    = Return'results (RP.Parsed Payload)
    | Return'exception (RP.Parsed Exception)
    | Return'canceled 
    | Return'resultsSentElsewhere 
    | Return'takeFromOtherQuestion (RP.Parsed Std_.Word32)
    | Return'acceptFromThirdParty (RP.Parsed Basics.AnyPointer)
    | Return'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Return) -> Rep (Parsed (Which Return)) x)
-> (forall x.
    Rep (Parsed (Which Return)) x -> Parsed (Which Return))
-> Generic (Parsed (Which Return))
forall x. Rep (Parsed (Which Return)) x -> Parsed (Which Return)
forall x. Parsed (Which Return) -> Rep (Parsed (Which Return)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Return)) x -> Parsed (Which Return)
$cfrom :: forall x. Parsed (Which Return) -> Rep (Parsed (Which Return)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Return)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Return)))
instance (C.Parse (GH.Which Return) (C.Parsed (GH.Which Return))) where
    parse :: Raw 'Const (Which Return) -> m (Parsed (Which Return))
parse Raw 'Const (Which Return)
raw_ = (do
        RawWhich 'Const Return
rawWhich_ <- (Raw 'Const (Which Return) -> m (RawWhich 'Const Return)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Return)
raw_)
        case RawWhich 'Const Return
rawWhich_ of
            (RW_Return'results rawArg_) ->
                (Parsed Payload -> Parsed (Which Return)
Parsed Payload -> Parsed (Which Return)
Return'results (Parsed Payload -> Parsed (Which Return))
-> m (Parsed Payload) -> m (Parsed (Which Return))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Payload -> m (Parsed Payload)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Payload
rawArg_))
            (RW_Return'exception rawArg_) ->
                (Parsed Exception -> Parsed (Which Return)
Parsed Exception -> Parsed (Which Return)
Return'exception (Parsed Exception -> Parsed (Which Return))
-> m (Parsed Exception) -> m (Parsed (Which Return))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Exception -> m (Parsed Exception)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Exception
rawArg_))
            (RW_Return'canceled _) ->
                (Parsed (Which Return) -> m (Parsed (Which Return))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Return)
Return'canceled)
            (RW_Return'resultsSentElsewhere _) ->
                (Parsed (Which Return) -> m (Parsed (Which Return))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Return)
Return'resultsSentElsewhere)
            (RW_Return'takeFromOtherQuestion rawArg_) ->
                (Word32 -> Parsed (Which Return)
Parsed Word32 -> Parsed (Which Return)
Return'takeFromOtherQuestion (Word32 -> Parsed (Which Return))
-> m Word32 -> m (Parsed (Which Return))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_Return'acceptFromThirdParty rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Return)
Parsed AnyPointer -> Parsed (Which Return)
Return'acceptFromThirdParty (Parsed AnyPointer -> Parsed (Which Return))
-> m (Parsed AnyPointer) -> m (Parsed (Which Return))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Return'unknown' tag_) ->
                (Parsed (Which Return) -> m (Parsed (Which Return))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Return)
Return'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Return) (C.Parsed (GH.Which Return))) where
    marshalInto :: Raw ('Mut s) (Which Return) -> Parsed (Which Return) -> m ()
marshalInto Raw ('Mut s) (Which Return)
raw_ Parsed (Which Return)
parsed_ = case Parsed (Which Return)
parsed_ of
        (Return'results arg_) ->
            (Variant 'Slot Return Payload
-> Parsed Payload -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "results" (Variant 'Slot Return Payload)
Variant 'Slot Return Payload
#results Parsed Payload
Parsed Payload
arg_ (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Return'exception arg_) ->
            (Variant 'Slot Return Exception
-> Parsed Exception -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "exception" (Variant 'Slot Return Exception)
Variant 'Slot Return Exception
#exception Parsed Exception
Parsed Exception
arg_ (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Parsed (Which Return)
Return'canceled) ->
            (Variant 'Slot Return () -> () -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "canceled" (Variant 'Slot Return ())
Variant 'Slot Return ()
#canceled () (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Parsed (Which Return)
Return'resultsSentElsewhere) ->
            (Variant 'Slot Return () -> () -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "resultsSentElsewhere" (Variant 'Slot Return ())
Variant 'Slot Return ()
#resultsSentElsewhere () (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Return'takeFromOtherQuestion arg_) ->
            (Variant 'Slot Return Word32
-> Word32 -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "takeFromOtherQuestion" (Variant 'Slot Return Word32)
Variant 'Slot Return Word32
#takeFromOtherQuestion Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Return'acceptFromThirdParty arg_) ->
            (Variant 'Slot Return AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "acceptFromThirdParty" (Variant 'Slot Return AnyPointer)
Variant 'Slot Return AnyPointer
#acceptFromThirdParty Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
        (Return'unknown' tag_) ->
            (Field 'Slot Return Word16 -> Word16 -> Raw ('Mut s) Return -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Return Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Return) -> Raw ('Mut s) Return
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Return)
raw_))
instance (GH.HasField "answerId" GH.Slot Return Std_.Word32) where
    fieldByLabel :: Field 'Slot Return Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Return Word32
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 "releaseParamCaps" GH.Slot Return Std_.Bool) where
    fieldByLabel :: Field 'Slot Return Bool
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Return Bool
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
1)
data Finish 
type instance (R.ReprFor Finish) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Finish) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate Finish) where
    type AllocHint Finish = ()
    new :: AllocHint Finish -> Message ('Mut s) -> m (Raw ('Mut s) Finish)
new AllocHint Finish
_ = Message ('Mut s) -> m (Raw ('Mut s) Finish)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Finish (C.Parsed Finish))
instance (C.AllocateList Finish) where
    type ListAllocHint Finish = Std_.Int
    newList :: ListAllocHint Finish
-> Message ('Mut s) -> m (Raw ('Mut s) (List Finish))
newList  = ListAllocHint Finish
-> Message ('Mut s) -> m (Raw ('Mut s) (List Finish))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Finish (C.Parsed Finish))
data instance C.Parsed Finish
    = Finish 
        {Parsed Finish -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Finish -> Parsed Bool
releaseResultCaps :: (RP.Parsed Std_.Bool)}
    deriving((forall x. Parsed Finish -> Rep (Parsed Finish) x)
-> (forall x. Rep (Parsed Finish) x -> Parsed Finish)
-> Generic (Parsed Finish)
forall x. Rep (Parsed Finish) x -> Parsed Finish
forall x. Parsed Finish -> Rep (Parsed Finish) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Finish) x -> Parsed Finish
$cfrom :: forall x. Parsed Finish -> Rep (Parsed Finish) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Finish))
deriving instance (Std_.Eq (C.Parsed Finish))
instance (C.Parse Finish (C.Parsed Finish)) where
    parse :: Raw 'Const Finish -> m (Parsed Finish)
parse Raw 'Const Finish
raw_ = (Word32 -> Bool -> Parsed Finish
Parsed Word32 -> Parsed Bool -> Parsed Finish
Finish (Word32 -> Bool -> Parsed Finish)
-> m Word32 -> m (Bool -> Parsed Finish)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Finish Word32 -> Raw 'Const Finish -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Finish Word32)
Field 'Slot Finish Word32
#questionId Raw 'Const Finish
raw_)
                         m (Bool -> Parsed Finish) -> m Bool -> m (Parsed Finish)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Finish Bool -> Raw 'Const Finish -> m Bool
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "releaseResultCaps" (Field 'Slot Finish Bool)
Field 'Slot Finish Bool
#releaseResultCaps Raw 'Const Finish
raw_))
instance (C.Marshal Finish (C.Parsed Finish)) where
    marshalInto :: Raw ('Mut s) Finish -> Parsed Finish -> m ()
marshalInto Raw ('Mut s) Finish
raw_ Finish{..} = (do
        (Field 'Slot Finish Word32 -> Word32 -> Raw ('Mut s) Finish -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Finish Word32)
Field 'Slot Finish Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Finish
raw_)
        (Field 'Slot Finish Bool -> Bool -> Raw ('Mut s) Finish -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "releaseResultCaps" (Field 'Slot Finish Bool)
Field 'Slot Finish Bool
#releaseResultCaps Bool
Parsed Bool
releaseResultCaps Raw ('Mut s) Finish
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Finish Std_.Word32) where
    fieldByLabel :: Field 'Slot Finish Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Finish Word32
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 "releaseResultCaps" GH.Slot Finish Std_.Bool) where
    fieldByLabel :: Field 'Slot Finish Bool
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Finish Bool
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
1)
data Resolve 
type instance (R.ReprFor Resolve) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Resolve) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Resolve) where
    type AllocHint Resolve = ()
    new :: AllocHint Resolve -> Message ('Mut s) -> m (Raw ('Mut s) Resolve)
new AllocHint Resolve
_ = Message ('Mut s) -> m (Raw ('Mut s) Resolve)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Resolve (C.Parsed Resolve))
instance (C.AllocateList Resolve) where
    type ListAllocHint Resolve = Std_.Int
    newList :: ListAllocHint Resolve
-> Message ('Mut s) -> m (Raw ('Mut s) (List Resolve))
newList  = ListAllocHint Resolve
-> Message ('Mut s) -> m (Raw ('Mut s) (List Resolve))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Resolve (C.Parsed Resolve))
data instance C.Parsed Resolve
    = Resolve 
        {Parsed Resolve -> Parsed Word32
promiseId :: (RP.Parsed Std_.Word32)
        ,Parsed Resolve -> Parsed (Which Resolve)
union' :: (C.Parsed (GH.Which Resolve))}
    deriving((forall x. Parsed Resolve -> Rep (Parsed Resolve) x)
-> (forall x. Rep (Parsed Resolve) x -> Parsed Resolve)
-> Generic (Parsed Resolve)
forall x. Rep (Parsed Resolve) x -> Parsed Resolve
forall x. Parsed Resolve -> Rep (Parsed Resolve) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Resolve) x -> Parsed Resolve
$cfrom :: forall x. Parsed Resolve -> Rep (Parsed Resolve) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Resolve))
deriving instance (Std_.Eq (C.Parsed Resolve))
instance (C.Parse Resolve (C.Parsed Resolve)) where
    parse :: Raw 'Const Resolve -> m (Parsed Resolve)
parse Raw 'Const Resolve
raw_ = (Word32 -> Parsed (Which Resolve) -> Parsed Resolve
Parsed Word32 -> Parsed (Which Resolve) -> Parsed Resolve
Resolve (Word32 -> Parsed (Which Resolve) -> Parsed Resolve)
-> m Word32 -> m (Parsed (Which Resolve) -> Parsed Resolve)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Resolve Word32 -> Raw 'Const Resolve -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "promiseId" (Field 'Slot Resolve Word32)
Field 'Slot Resolve Word32
#promiseId Raw 'Const Resolve
raw_)
                          m (Parsed (Which Resolve) -> Parsed Resolve)
-> m (Parsed (Which Resolve)) -> m (Parsed Resolve)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which Resolve) -> m (Parsed (Which Resolve))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Resolve -> Raw 'Const (Which Resolve)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Resolve
raw_)))
instance (C.Marshal Resolve (C.Parsed Resolve)) where
    marshalInto :: Raw ('Mut s) Resolve -> Parsed Resolve -> m ()
marshalInto Raw ('Mut s) Resolve
raw_ Resolve{..} = (do
        (Field 'Slot Resolve Word32
-> Word32 -> Raw ('Mut s) Resolve -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "promiseId" (Field 'Slot Resolve Word32)
Field 'Slot Resolve Word32
#promiseId Word32
Parsed Word32
promiseId Raw ('Mut s) Resolve
raw_)
        (Raw ('Mut s) (Which Resolve) -> Parsed (Which Resolve) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Resolve -> Raw ('Mut s) (Which Resolve)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Resolve
raw_) Parsed (Which Resolve)
union')
        )
instance (GH.HasUnion Resolve) where
    unionField :: Field 'Slot Resolve Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Resolve Word16
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)
    data RawWhich mut_ Resolve
        = RW_Resolve'cap (R.Raw mut_ CapDescriptor)
        | RW_Resolve'exception (R.Raw mut_ Exception)
        | RW_Resolve'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Resolve -> m (RawWhich mut Resolve)
internalWhich Word16
tag_ Raw mut Resolve
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut CapDescriptor -> RawWhich mut Resolve
forall (mut_ :: Mutability).
Raw mut_ CapDescriptor -> RawWhich mut_ Resolve
RW_Resolve'cap (Raw mut CapDescriptor -> RawWhich mut Resolve)
-> m (Raw mut CapDescriptor) -> m (RawWhich mut Resolve)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Resolve CapDescriptor
-> Raw mut Resolve -> m (Raw mut CapDescriptor)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "cap" (Variant 'Slot Resolve CapDescriptor)
Variant 'Slot Resolve CapDescriptor
#cap Raw mut Resolve
struct_))
        Word16
1 ->
            (Raw mut Exception -> RawWhich mut Resolve
forall (mut_ :: Mutability).
Raw mut_ Exception -> RawWhich mut_ Resolve
RW_Resolve'exception (Raw mut Exception -> RawWhich mut Resolve)
-> m (Raw mut Exception) -> m (RawWhich mut Resolve)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Resolve Exception
-> Raw mut Resolve -> m (Raw mut Exception)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "exception" (Variant 'Slot Resolve Exception)
Variant 'Slot Resolve Exception
#exception Raw mut Resolve
struct_))
        Word16
_ ->
            (RawWhich mut Resolve -> m (RawWhich mut Resolve)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Resolve
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Resolve
RW_Resolve'unknown' Word16
tag_))
    data Which Resolve
instance (GH.HasVariant "cap" GH.Slot Resolve CapDescriptor) where
    variantByLabel :: Variant 'Slot Resolve CapDescriptor
variantByLabel  = (Field 'Slot Resolve CapDescriptor
-> Word16 -> Variant 'Slot Resolve CapDescriptor
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Resolve CapDescriptor
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
0)
instance (GH.HasVariant "exception" GH.Slot Resolve Exception) where
    variantByLabel :: Variant 'Slot Resolve Exception
variantByLabel  = (Field 'Slot Resolve Exception
-> Word16 -> Variant 'Slot Resolve Exception
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Resolve Exception
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
1)
data instance C.Parsed (GH.Which Resolve)
    = Resolve'cap (RP.Parsed CapDescriptor)
    | Resolve'exception (RP.Parsed Exception)
    | Resolve'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Resolve) -> Rep (Parsed (Which Resolve)) x)
-> (forall x.
    Rep (Parsed (Which Resolve)) x -> Parsed (Which Resolve))
-> Generic (Parsed (Which Resolve))
forall x. Rep (Parsed (Which Resolve)) x -> Parsed (Which Resolve)
forall x. Parsed (Which Resolve) -> Rep (Parsed (Which Resolve)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Resolve)) x -> Parsed (Which Resolve)
$cfrom :: forall x. Parsed (Which Resolve) -> Rep (Parsed (Which Resolve)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Resolve)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Resolve)))
instance (C.Parse (GH.Which Resolve) (C.Parsed (GH.Which Resolve))) where
    parse :: Raw 'Const (Which Resolve) -> m (Parsed (Which Resolve))
parse Raw 'Const (Which Resolve)
raw_ = (do
        RawWhich 'Const Resolve
rawWhich_ <- (Raw 'Const (Which Resolve) -> m (RawWhich 'Const Resolve)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Resolve)
raw_)
        case RawWhich 'Const Resolve
rawWhich_ of
            (RW_Resolve'cap rawArg_) ->
                (Parsed CapDescriptor -> Parsed (Which Resolve)
Parsed CapDescriptor -> Parsed (Which Resolve)
Resolve'cap (Parsed CapDescriptor -> Parsed (Which Resolve))
-> m (Parsed CapDescriptor) -> m (Parsed (Which Resolve))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const CapDescriptor -> m (Parsed CapDescriptor)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const CapDescriptor
rawArg_))
            (RW_Resolve'exception rawArg_) ->
                (Parsed Exception -> Parsed (Which Resolve)
Parsed Exception -> Parsed (Which Resolve)
Resolve'exception (Parsed Exception -> Parsed (Which Resolve))
-> m (Parsed Exception) -> m (Parsed (Which Resolve))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Exception -> m (Parsed Exception)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Exception
rawArg_))
            (RW_Resolve'unknown' tag_) ->
                (Parsed (Which Resolve) -> m (Parsed (Which Resolve))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Resolve)
Resolve'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Resolve) (C.Parsed (GH.Which Resolve))) where
    marshalInto :: Raw ('Mut s) (Which Resolve) -> Parsed (Which Resolve) -> m ()
marshalInto Raw ('Mut s) (Which Resolve)
raw_ Parsed (Which Resolve)
parsed_ = case Parsed (Which Resolve)
parsed_ of
        (Resolve'cap arg_) ->
            (Variant 'Slot Resolve CapDescriptor
-> Parsed CapDescriptor -> Raw ('Mut s) Resolve -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "cap" (Variant 'Slot Resolve CapDescriptor)
Variant 'Slot Resolve CapDescriptor
#cap Parsed CapDescriptor
Parsed CapDescriptor
arg_ (Raw ('Mut s) (Which Resolve) -> Raw ('Mut s) Resolve
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Resolve)
raw_))
        (Resolve'exception arg_) ->
            (Variant 'Slot Resolve Exception
-> Parsed Exception -> Raw ('Mut s) Resolve -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "exception" (Variant 'Slot Resolve Exception)
Variant 'Slot Resolve Exception
#exception Parsed Exception
Parsed Exception
arg_ (Raw ('Mut s) (Which Resolve) -> Raw ('Mut s) Resolve
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Resolve)
raw_))
        (Resolve'unknown' tag_) ->
            (Field 'Slot Resolve Word16
-> Word16 -> Raw ('Mut s) Resolve -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Resolve Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Resolve) -> Raw ('Mut s) Resolve
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Resolve)
raw_))
instance (GH.HasField "promiseId" GH.Slot Resolve Std_.Word32) where
    fieldByLabel :: Field 'Slot Resolve Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Resolve Word32
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 Release 
type instance (R.ReprFor Release) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Release) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate Release) where
    type AllocHint Release = ()
    new :: AllocHint Release -> Message ('Mut s) -> m (Raw ('Mut s) Release)
new AllocHint Release
_ = Message ('Mut s) -> m (Raw ('Mut s) Release)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Release (C.Parsed Release))
instance (C.AllocateList Release) where
    type ListAllocHint Release = Std_.Int
    newList :: ListAllocHint Release
-> Message ('Mut s) -> m (Raw ('Mut s) (List Release))
newList  = ListAllocHint Release
-> Message ('Mut s) -> m (Raw ('Mut s) (List Release))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Release (C.Parsed Release))
data instance C.Parsed Release
    = Release 
        {Parsed Release -> Parsed Word32
id :: (RP.Parsed Std_.Word32)
        ,Parsed Release -> Parsed Word32
referenceCount :: (RP.Parsed Std_.Word32)}
    deriving((forall x. Parsed Release -> Rep (Parsed Release) x)
-> (forall x. Rep (Parsed Release) x -> Parsed Release)
-> Generic (Parsed Release)
forall x. Rep (Parsed Release) x -> Parsed Release
forall x. Parsed Release -> Rep (Parsed Release) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Release) x -> Parsed Release
$cfrom :: forall x. Parsed Release -> Rep (Parsed Release) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Release))
deriving instance (Std_.Eq (C.Parsed Release))
instance (C.Parse Release (C.Parsed Release)) where
    parse :: Raw 'Const Release -> m (Parsed Release)
parse Raw 'Const Release
raw_ = (Word32 -> Word32 -> Parsed Release
Parsed Word32 -> Parsed Word32 -> Parsed Release
Release (Word32 -> Word32 -> Parsed Release)
-> m Word32 -> m (Word32 -> Parsed Release)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Release Word32 -> Raw 'Const Release -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Release Word32)
Field 'Slot Release Word32
#id Raw 'Const Release
raw_)
                          m (Word32 -> Parsed Release) -> m Word32 -> m (Parsed Release)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Release Word32 -> Raw 'Const Release -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "referenceCount" (Field 'Slot Release Word32)
Field 'Slot Release Word32
#referenceCount Raw 'Const Release
raw_))
instance (C.Marshal Release (C.Parsed Release)) where
    marshalInto :: Raw ('Mut s) Release -> Parsed Release -> m ()
marshalInto Raw ('Mut s) Release
raw_ Release{..} = (do
        (Field 'Slot Release Word32
-> Word32 -> Raw ('Mut s) Release -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Release Word32)
Field 'Slot Release Word32
#id Word32
Parsed Word32
id Raw ('Mut s) Release
raw_)
        (Field 'Slot Release Word32
-> Word32 -> Raw ('Mut s) Release -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "referenceCount" (Field 'Slot Release Word32)
Field 'Slot Release Word32
#referenceCount Word32
Parsed Word32
referenceCount Raw ('Mut s) Release
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot Release Std_.Word32) where
    fieldByLabel :: Field 'Slot Release Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Release Word32
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 "referenceCount" GH.Slot Release Std_.Word32) where
    fieldByLabel :: Field 'Slot Release Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Release Word32
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
32 Word64
0)
data Disembargo 
type instance (R.ReprFor Disembargo) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Disembargo) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Disembargo) where
    type AllocHint Disembargo = ()
    new :: AllocHint Disembargo
-> Message ('Mut s) -> m (Raw ('Mut s) Disembargo)
new AllocHint Disembargo
_ = Message ('Mut s) -> m (Raw ('Mut s) Disembargo)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Disembargo (C.Parsed Disembargo))
instance (C.AllocateList Disembargo) where
    type ListAllocHint Disembargo = Std_.Int
    newList :: ListAllocHint Disembargo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Disembargo))
newList  = ListAllocHint Disembargo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Disembargo))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Disembargo (C.Parsed Disembargo))
data instance C.Parsed Disembargo
    = Disembargo 
        {Parsed Disembargo -> Parsed MessageTarget
target :: (RP.Parsed MessageTarget)
        ,Parsed Disembargo -> Parsed Disembargo'context
context :: (RP.Parsed Disembargo'context)}
    deriving((forall x. Parsed Disembargo -> Rep (Parsed Disembargo) x)
-> (forall x. Rep (Parsed Disembargo) x -> Parsed Disembargo)
-> Generic (Parsed Disembargo)
forall x. Rep (Parsed Disembargo) x -> Parsed Disembargo
forall x. Parsed Disembargo -> Rep (Parsed Disembargo) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Disembargo) x -> Parsed Disembargo
$cfrom :: forall x. Parsed Disembargo -> Rep (Parsed Disembargo) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Disembargo))
deriving instance (Std_.Eq (C.Parsed Disembargo))
instance (C.Parse Disembargo (C.Parsed Disembargo)) where
    parse :: Raw 'Const Disembargo -> m (Parsed Disembargo)
parse Raw 'Const Disembargo
raw_ = (Parsed MessageTarget
-> Parsed Disembargo'context -> Parsed Disembargo
Parsed MessageTarget
-> Parsed Disembargo'context -> Parsed Disembargo
Disembargo (Parsed MessageTarget
 -> Parsed Disembargo'context -> Parsed Disembargo)
-> m (Parsed MessageTarget)
-> m (Parsed Disembargo'context -> Parsed Disembargo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Disembargo MessageTarget
-> Raw 'Const Disembargo -> m (Parsed MessageTarget)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "target" (Field 'Slot Disembargo MessageTarget)
Field 'Slot Disembargo MessageTarget
#target Raw 'Const Disembargo
raw_)
                             m (Parsed Disembargo'context -> Parsed Disembargo)
-> m (Parsed Disembargo'context) -> m (Parsed Disembargo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Group Disembargo Disembargo'context
-> Raw 'Const Disembargo -> m (Parsed Disembargo'context)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "context" (Field 'Group Disembargo Disembargo'context)
Field 'Group Disembargo Disembargo'context
#context Raw 'Const Disembargo
raw_))
instance (C.Marshal Disembargo (C.Parsed Disembargo)) where
    marshalInto :: Raw ('Mut s) Disembargo -> Parsed Disembargo -> m ()
marshalInto Raw ('Mut s) Disembargo
raw_ Disembargo{..} = (do
        (Field 'Slot Disembargo MessageTarget
-> Parsed MessageTarget -> Raw ('Mut s) Disembargo -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "target" (Field 'Slot Disembargo MessageTarget)
Field 'Slot Disembargo MessageTarget
#target Parsed MessageTarget
Parsed MessageTarget
target Raw ('Mut s) Disembargo
raw_)
        (do
            Raw ('Mut s) Disembargo'context
group_ <- (Field 'Group Disembargo Disembargo'context
-> Raw ('Mut s) Disembargo -> m (Raw ('Mut s) Disembargo'context)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw mut a -> m (Raw mut b)
GH.readField IsLabel "context" (Field 'Group Disembargo Disembargo'context)
Field 'Group Disembargo Disembargo'context
#context Raw ('Mut s) Disembargo
raw_)
            (Raw ('Mut s) Disembargo'context
-> Parsed Disembargo'context -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Disembargo'context
group_ Parsed Disembargo'context
Parsed Disembargo'context
context)
            )
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "target" GH.Slot Disembargo MessageTarget) where
    fieldByLabel :: Field 'Slot Disembargo MessageTarget
fieldByLabel  = (Word16 -> Field 'Slot Disembargo MessageTarget
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "context" GH.Group Disembargo Disembargo'context) where
    fieldByLabel :: Field 'Group Disembargo Disembargo'context
fieldByLabel  = Field 'Group Disembargo Disembargo'context
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField
data Disembargo'context 
type instance (R.ReprFor Disembargo'context) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Disembargo'context) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Disembargo'context) where
    type AllocHint Disembargo'context = ()
    new :: AllocHint Disembargo'context
-> Message ('Mut s) -> m (Raw ('Mut s) Disembargo'context)
new AllocHint Disembargo'context
_ = Message ('Mut s) -> m (Raw ('Mut s) Disembargo'context)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Disembargo'context (C.Parsed Disembargo'context))
instance (C.AllocateList Disembargo'context) where
    type ListAllocHint Disembargo'context = Std_.Int
    newList :: ListAllocHint Disembargo'context
-> Message ('Mut s) -> m (Raw ('Mut s) (List Disembargo'context))
newList  = ListAllocHint Disembargo'context
-> Message ('Mut s) -> m (Raw ('Mut s) (List Disembargo'context))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Disembargo'context (C.Parsed Disembargo'context))
data instance C.Parsed Disembargo'context
    = Disembargo'context' 
        {Parsed Disembargo'context -> Parsed (Which Disembargo'context)
union' :: (C.Parsed (GH.Which Disembargo'context))}
    deriving((forall x.
 Parsed Disembargo'context -> Rep (Parsed Disembargo'context) x)
-> (forall x.
    Rep (Parsed Disembargo'context) x -> Parsed Disembargo'context)
-> Generic (Parsed Disembargo'context)
forall x.
Rep (Parsed Disembargo'context) x -> Parsed Disembargo'context
forall x.
Parsed Disembargo'context -> Rep (Parsed Disembargo'context) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Disembargo'context) x -> Parsed Disembargo'context
$cfrom :: forall x.
Parsed Disembargo'context -> Rep (Parsed Disembargo'context) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Disembargo'context))
deriving instance (Std_.Eq (C.Parsed Disembargo'context))
instance (C.Parse Disembargo'context (C.Parsed Disembargo'context)) where
    parse :: Raw 'Const Disembargo'context -> m (Parsed Disembargo'context)
parse Raw 'Const Disembargo'context
raw_ = (Parsed (Which Disembargo'context) -> Parsed Disembargo'context
Disembargo'context' (Parsed (Which Disembargo'context) -> Parsed Disembargo'context)
-> m (Parsed (Which Disembargo'context))
-> m (Parsed Disembargo'context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Disembargo'context)
-> m (Parsed (Which Disembargo'context))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Disembargo'context
-> Raw 'Const (Which Disembargo'context)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Disembargo'context
raw_)))
instance (C.Marshal Disembargo'context (C.Parsed Disembargo'context)) where
    marshalInto :: Raw ('Mut s) Disembargo'context
-> Parsed Disembargo'context -> m ()
marshalInto Raw ('Mut s) Disembargo'context
raw_ Disembargo'context'{..} = (do
        (Raw ('Mut s) (Which Disembargo'context)
-> Parsed (Which Disembargo'context) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Disembargo'context
-> Raw ('Mut s) (Which Disembargo'context)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Disembargo'context
raw_) Parsed (Which Disembargo'context)
union')
        )
instance (GH.HasUnion Disembargo'context) where
    unionField :: Field 'Slot Disembargo'context Word16
unionField  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Disembargo'context Word16
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)
    data RawWhich mut_ Disembargo'context
        = RW_Disembargo'context'senderLoopback (R.Raw mut_ Std_.Word32)
        | RW_Disembargo'context'receiverLoopback (R.Raw mut_ Std_.Word32)
        | RW_Disembargo'context'accept (R.Raw mut_ ())
        | RW_Disembargo'context'provide (R.Raw mut_ Std_.Word32)
        | RW_Disembargo'context'unknown' Std_.Word16
    internalWhich :: Word16
-> Raw mut Disembargo'context
-> m (RawWhich mut Disembargo'context)
internalWhich Word16
tag_ Raw mut Disembargo'context
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Word32 -> RawWhich mut Disembargo'context
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ Disembargo'context
RW_Disembargo'context'senderLoopback (Raw mut Word32 -> RawWhich mut Disembargo'context)
-> m (Raw mut Word32) -> m (RawWhich mut Disembargo'context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Disembargo'context Word32
-> Raw mut Disembargo'context -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "senderLoopback" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#senderLoopback Raw mut Disembargo'context
struct_))
        Word16
1 ->
            (Raw mut Word32 -> RawWhich mut Disembargo'context
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ Disembargo'context
RW_Disembargo'context'receiverLoopback (Raw mut Word32 -> RawWhich mut Disembargo'context)
-> m (Raw mut Word32) -> m (RawWhich mut Disembargo'context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Disembargo'context Word32
-> Raw mut Disembargo'context -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "receiverLoopback" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#receiverLoopback Raw mut Disembargo'context
struct_))
        Word16
2 ->
            (Raw mut () -> RawWhich mut Disembargo'context
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Disembargo'context
RW_Disembargo'context'accept (Raw mut () -> RawWhich mut Disembargo'context)
-> m (Raw mut ()) -> m (RawWhich mut Disembargo'context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Disembargo'context ()
-> Raw mut Disembargo'context -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "accept" (Variant 'Slot Disembargo'context ())
Variant 'Slot Disembargo'context ()
#accept Raw mut Disembargo'context
struct_))
        Word16
3 ->
            (Raw mut Word32 -> RawWhich mut Disembargo'context
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ Disembargo'context
RW_Disembargo'context'provide (Raw mut Word32 -> RawWhich mut Disembargo'context)
-> m (Raw mut Word32) -> m (RawWhich mut Disembargo'context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Disembargo'context Word32
-> Raw mut Disembargo'context -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "provide" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#provide Raw mut Disembargo'context
struct_))
        Word16
_ ->
            (RawWhich mut Disembargo'context
-> m (RawWhich mut Disembargo'context)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Disembargo'context
forall (mut_ :: Mutability).
Word16 -> RawWhich mut_ Disembargo'context
RW_Disembargo'context'unknown' Word16
tag_))
    data Which Disembargo'context
instance (GH.HasVariant "senderLoopback" GH.Slot Disembargo'context Std_.Word32) where
    variantByLabel :: Variant 'Slot Disembargo'context Word32
variantByLabel  = (Field 'Slot Disembargo'context Word32
-> Word16 -> Variant 'Slot Disembargo'context Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Disembargo'context Word32
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) Word16
0)
instance (GH.HasVariant "receiverLoopback" GH.Slot Disembargo'context Std_.Word32) where
    variantByLabel :: Variant 'Slot Disembargo'context Word32
variantByLabel  = (Field 'Slot Disembargo'context Word32
-> Word16 -> Variant 'Slot Disembargo'context Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Disembargo'context Word32
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) Word16
1)
instance (GH.HasVariant "accept" GH.Slot Disembargo'context ()) where
    variantByLabel :: Variant 'Slot Disembargo'context ()
variantByLabel  = (Field 'Slot Disembargo'context ()
-> Word16 -> Variant 'Slot Disembargo'context ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Disembargo'context ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
2)
instance (GH.HasVariant "provide" GH.Slot Disembargo'context Std_.Word32) where
    variantByLabel :: Variant 'Slot Disembargo'context Word32
variantByLabel  = (Field 'Slot Disembargo'context Word32
-> Word16 -> Variant 'Slot Disembargo'context Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Disembargo'context Word32
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) Word16
3)
data instance C.Parsed (GH.Which Disembargo'context)
    = Disembargo'context'senderLoopback (RP.Parsed Std_.Word32)
    | Disembargo'context'receiverLoopback (RP.Parsed Std_.Word32)
    | Disembargo'context'accept 
    | Disembargo'context'provide (RP.Parsed Std_.Word32)
    | Disembargo'context'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Disembargo'context)
 -> Rep (Parsed (Which Disembargo'context)) x)
-> (forall x.
    Rep (Parsed (Which Disembargo'context)) x
    -> Parsed (Which Disembargo'context))
-> Generic (Parsed (Which Disembargo'context))
forall x.
Rep (Parsed (Which Disembargo'context)) x
-> Parsed (Which Disembargo'context)
forall x.
Parsed (Which Disembargo'context)
-> Rep (Parsed (Which Disembargo'context)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Disembargo'context)) x
-> Parsed (Which Disembargo'context)
$cfrom :: forall x.
Parsed (Which Disembargo'context)
-> Rep (Parsed (Which Disembargo'context)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Disembargo'context)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Disembargo'context)))
instance (C.Parse (GH.Which Disembargo'context) (C.Parsed (GH.Which Disembargo'context))) where
    parse :: Raw 'Const (Which Disembargo'context)
-> m (Parsed (Which Disembargo'context))
parse Raw 'Const (Which Disembargo'context)
raw_ = (do
        RawWhich 'Const Disembargo'context
rawWhich_ <- (Raw 'Const (Which Disembargo'context)
-> m (RawWhich 'Const Disembargo'context)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Disembargo'context)
raw_)
        case RawWhich 'Const Disembargo'context
rawWhich_ of
            (RW_Disembargo'context'senderLoopback rawArg_) ->
                (Word32 -> Parsed (Which Disembargo'context)
Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'senderLoopback (Word32 -> Parsed (Which Disembargo'context))
-> m Word32 -> m (Parsed (Which Disembargo'context))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_Disembargo'context'receiverLoopback rawArg_) ->
                (Word32 -> Parsed (Which Disembargo'context)
Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'receiverLoopback (Word32 -> Parsed (Which Disembargo'context))
-> m Word32 -> m (Parsed (Which Disembargo'context))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_Disembargo'context'accept _) ->
                (Parsed (Which Disembargo'context)
-> m (Parsed (Which Disembargo'context))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Disembargo'context)
Disembargo'context'accept)
            (RW_Disembargo'context'provide rawArg_) ->
                (Word32 -> Parsed (Which Disembargo'context)
Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'provide (Word32 -> Parsed (Which Disembargo'context))
-> m Word32 -> m (Parsed (Which Disembargo'context))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_Disembargo'context'unknown' tag_) ->
                (Parsed (Which Disembargo'context)
-> m (Parsed (Which Disembargo'context))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Disembargo'context)
Disembargo'context'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Disembargo'context) (C.Parsed (GH.Which Disembargo'context))) where
    marshalInto :: Raw ('Mut s) (Which Disembargo'context)
-> Parsed (Which Disembargo'context) -> m ()
marshalInto Raw ('Mut s) (Which Disembargo'context)
raw_ Parsed (Which Disembargo'context)
parsed_ = case Parsed (Which Disembargo'context)
parsed_ of
        (Disembargo'context'senderLoopback arg_) ->
            (Variant 'Slot Disembargo'context Word32
-> Word32 -> Raw ('Mut s) Disembargo'context -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "senderLoopback" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#senderLoopback Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which Disembargo'context)
-> Raw ('Mut s) Disembargo'context
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Disembargo'context)
raw_))
        (Disembargo'context'receiverLoopback arg_) ->
            (Variant 'Slot Disembargo'context Word32
-> Word32 -> Raw ('Mut s) Disembargo'context -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel
  "receiverLoopback" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#receiverLoopback Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which Disembargo'context)
-> Raw ('Mut s) Disembargo'context
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Disembargo'context)
raw_))
        (Parsed (Which Disembargo'context)
Disembargo'context'accept) ->
            (Variant 'Slot Disembargo'context ()
-> () -> Raw ('Mut s) Disembargo'context -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "accept" (Variant 'Slot Disembargo'context ())
Variant 'Slot Disembargo'context ()
#accept () (Raw ('Mut s) (Which Disembargo'context)
-> Raw ('Mut s) Disembargo'context
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Disembargo'context)
raw_))
        (Disembargo'context'provide arg_) ->
            (Variant 'Slot Disembargo'context Word32
-> Word32 -> Raw ('Mut s) Disembargo'context -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "provide" (Variant 'Slot Disembargo'context Word32)
Variant 'Slot Disembargo'context Word32
#provide Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which Disembargo'context)
-> Raw ('Mut s) Disembargo'context
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Disembargo'context)
raw_))
        (Disembargo'context'unknown' tag_) ->
            (Field 'Slot Disembargo'context Word16
-> Word16 -> Raw ('Mut s) Disembargo'context -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Disembargo'context Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Disembargo'context)
-> Raw ('Mut s) Disembargo'context
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Disembargo'context)
raw_))
data Provide 
type instance (R.ReprFor Provide) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Provide) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Provide) where
    type AllocHint Provide = ()
    new :: AllocHint Provide -> Message ('Mut s) -> m (Raw ('Mut s) Provide)
new AllocHint Provide
_ = Message ('Mut s) -> m (Raw ('Mut s) Provide)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Provide (C.Parsed Provide))
instance (C.AllocateList Provide) where
    type ListAllocHint Provide = Std_.Int
    newList :: ListAllocHint Provide
-> Message ('Mut s) -> m (Raw ('Mut s) (List Provide))
newList  = ListAllocHint Provide
-> Message ('Mut s) -> m (Raw ('Mut s) (List Provide))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Provide (C.Parsed Provide))
data instance C.Parsed Provide
    = Provide 
        {Parsed Provide -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Provide -> Parsed MessageTarget
target :: (RP.Parsed MessageTarget)
        ,Parsed Provide -> Parsed AnyPointer
recipient :: (RP.Parsed Basics.AnyPointer)}
    deriving((forall x. Parsed Provide -> Rep (Parsed Provide) x)
-> (forall x. Rep (Parsed Provide) x -> Parsed Provide)
-> Generic (Parsed Provide)
forall x. Rep (Parsed Provide) x -> Parsed Provide
forall x. Parsed Provide -> Rep (Parsed Provide) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Provide) x -> Parsed Provide
$cfrom :: forall x. Parsed Provide -> Rep (Parsed Provide) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Provide))
deriving instance (Std_.Eq (C.Parsed Provide))
instance (C.Parse Provide (C.Parsed Provide)) where
    parse :: Raw 'Const Provide -> m (Parsed Provide)
parse Raw 'Const Provide
raw_ = (Word32
-> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Provide
Parsed Word32
-> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Provide
Provide (Word32
 -> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Provide)
-> m Word32
-> m (Parsed MessageTarget -> Parsed AnyPointer -> Parsed Provide)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Provide Word32 -> Raw 'Const Provide -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Provide Word32)
Field 'Slot Provide Word32
#questionId Raw 'Const Provide
raw_)
                          m (Parsed MessageTarget -> Parsed AnyPointer -> Parsed Provide)
-> m (Parsed MessageTarget)
-> m (Parsed AnyPointer -> Parsed Provide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Provide MessageTarget
-> Raw 'Const Provide -> m (Parsed MessageTarget)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "target" (Field 'Slot Provide MessageTarget)
Field 'Slot Provide MessageTarget
#target Raw 'Const Provide
raw_)
                          m (Parsed AnyPointer -> Parsed Provide)
-> m (Parsed AnyPointer) -> m (Parsed Provide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Provide AnyPointer
-> Raw 'Const Provide -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "recipient" (Field 'Slot Provide AnyPointer)
Field 'Slot Provide AnyPointer
#recipient Raw 'Const Provide
raw_))
instance (C.Marshal Provide (C.Parsed Provide)) where
    marshalInto :: Raw ('Mut s) Provide -> Parsed Provide -> m ()
marshalInto Raw ('Mut s) Provide
raw_ Provide{..} = (do
        (Field 'Slot Provide Word32
-> Word32 -> Raw ('Mut s) Provide -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Provide Word32)
Field 'Slot Provide Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Provide
raw_)
        (Field 'Slot Provide MessageTarget
-> Parsed MessageTarget -> Raw ('Mut s) Provide -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "target" (Field 'Slot Provide MessageTarget)
Field 'Slot Provide MessageTarget
#target Parsed MessageTarget
Parsed MessageTarget
target Raw ('Mut s) Provide
raw_)
        (Field 'Slot Provide AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Provide -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "recipient" (Field 'Slot Provide AnyPointer)
Field 'Slot Provide AnyPointer
#recipient Parsed AnyPointer
Parsed AnyPointer
recipient Raw ('Mut s) Provide
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Provide Std_.Word32) where
    fieldByLabel :: Field 'Slot Provide Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Provide Word32
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 "target" GH.Slot Provide MessageTarget) where
    fieldByLabel :: Field 'Slot Provide MessageTarget
fieldByLabel  = (Word16 -> Field 'Slot Provide MessageTarget
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "recipient" GH.Slot Provide Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot Provide AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot Provide AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data Accept 
type instance (R.ReprFor Accept) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Accept) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Accept) where
    type AllocHint Accept = ()
    new :: AllocHint Accept -> Message ('Mut s) -> m (Raw ('Mut s) Accept)
new AllocHint Accept
_ = Message ('Mut s) -> m (Raw ('Mut s) Accept)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Accept (C.Parsed Accept))
instance (C.AllocateList Accept) where
    type ListAllocHint Accept = Std_.Int
    newList :: ListAllocHint Accept
-> Message ('Mut s) -> m (Raw ('Mut s) (List Accept))
newList  = ListAllocHint Accept
-> Message ('Mut s) -> m (Raw ('Mut s) (List Accept))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Accept (C.Parsed Accept))
data instance C.Parsed Accept
    = Accept 
        {Parsed Accept -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Accept -> Parsed AnyPointer
provision :: (RP.Parsed Basics.AnyPointer)
        ,Parsed Accept -> Parsed Bool
embargo :: (RP.Parsed Std_.Bool)}
    deriving((forall x. Parsed Accept -> Rep (Parsed Accept) x)
-> (forall x. Rep (Parsed Accept) x -> Parsed Accept)
-> Generic (Parsed Accept)
forall x. Rep (Parsed Accept) x -> Parsed Accept
forall x. Parsed Accept -> Rep (Parsed Accept) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Accept) x -> Parsed Accept
$cfrom :: forall x. Parsed Accept -> Rep (Parsed Accept) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Accept))
deriving instance (Std_.Eq (C.Parsed Accept))
instance (C.Parse Accept (C.Parsed Accept)) where
    parse :: Raw 'Const Accept -> m (Parsed Accept)
parse Raw 'Const Accept
raw_ = (Word32 -> Parsed AnyPointer -> Bool -> Parsed Accept
Parsed Word32 -> Parsed AnyPointer -> Parsed Bool -> Parsed Accept
Accept (Word32 -> Parsed AnyPointer -> Bool -> Parsed Accept)
-> m Word32 -> m (Parsed AnyPointer -> Bool -> Parsed Accept)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Accept Word32 -> Raw 'Const Accept -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Accept Word32)
Field 'Slot Accept Word32
#questionId Raw 'Const Accept
raw_)
                         m (Parsed AnyPointer -> Bool -> Parsed Accept)
-> m (Parsed AnyPointer) -> m (Bool -> Parsed Accept)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Accept AnyPointer
-> Raw 'Const Accept -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "provision" (Field 'Slot Accept AnyPointer)
Field 'Slot Accept AnyPointer
#provision Raw 'Const Accept
raw_)
                         m (Bool -> Parsed Accept) -> m Bool -> m (Parsed Accept)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Accept Bool -> Raw 'Const Accept -> m Bool
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "embargo" (Field 'Slot Accept Bool)
Field 'Slot Accept Bool
#embargo Raw 'Const Accept
raw_))
instance (C.Marshal Accept (C.Parsed Accept)) where
    marshalInto :: Raw ('Mut s) Accept -> Parsed Accept -> m ()
marshalInto Raw ('Mut s) Accept
raw_ Accept{..} = (do
        (Field 'Slot Accept Word32 -> Word32 -> Raw ('Mut s) Accept -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Accept Word32)
Field 'Slot Accept Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Accept
raw_)
        (Field 'Slot Accept AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Accept -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "provision" (Field 'Slot Accept AnyPointer)
Field 'Slot Accept AnyPointer
#provision Parsed AnyPointer
Parsed AnyPointer
provision Raw ('Mut s) Accept
raw_)
        (Field 'Slot Accept Bool -> Bool -> Raw ('Mut s) Accept -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "embargo" (Field 'Slot Accept Bool)
Field 'Slot Accept Bool
#embargo Bool
Parsed Bool
embargo Raw ('Mut s) Accept
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Accept Std_.Word32) where
    fieldByLabel :: Field 'Slot Accept Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Accept Word32
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 "provision" GH.Slot Accept Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot Accept AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot Accept AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "embargo" GH.Slot Accept Std_.Bool) where
    fieldByLabel :: Field 'Slot Accept Bool
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Accept Bool
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)
data Join 
type instance (R.ReprFor Join) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Join) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Join) where
    type AllocHint Join = ()
    new :: AllocHint Join -> Message ('Mut s) -> m (Raw ('Mut s) Join)
new AllocHint Join
_ = Message ('Mut s) -> m (Raw ('Mut s) Join)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Join (C.Parsed Join))
instance (C.AllocateList Join) where
    type ListAllocHint Join = Std_.Int
    newList :: ListAllocHint Join
-> Message ('Mut s) -> m (Raw ('Mut s) (List Join))
newList  = ListAllocHint Join
-> Message ('Mut s) -> m (Raw ('Mut s) (List Join))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Join (C.Parsed Join))
data instance C.Parsed Join
    = Join 
        {Parsed Join -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Join -> Parsed MessageTarget
target :: (RP.Parsed MessageTarget)
        ,Parsed Join -> Parsed AnyPointer
keyPart :: (RP.Parsed Basics.AnyPointer)}
    deriving((forall x. Parsed Join -> Rep (Parsed Join) x)
-> (forall x. Rep (Parsed Join) x -> Parsed Join)
-> Generic (Parsed Join)
forall x. Rep (Parsed Join) x -> Parsed Join
forall x. Parsed Join -> Rep (Parsed Join) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Join) x -> Parsed Join
$cfrom :: forall x. Parsed Join -> Rep (Parsed Join) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Join))
deriving instance (Std_.Eq (C.Parsed Join))
instance (C.Parse Join (C.Parsed Join)) where
    parse :: Raw 'Const Join -> m (Parsed Join)
parse Raw 'Const Join
raw_ = (Word32 -> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Join
Parsed Word32
-> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Join
Join (Word32
 -> Parsed MessageTarget -> Parsed AnyPointer -> Parsed Join)
-> m Word32
-> m (Parsed MessageTarget -> Parsed AnyPointer -> Parsed Join)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Join Word32 -> Raw 'Const Join -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot Join Word32)
Field 'Slot Join Word32
#questionId Raw 'Const Join
raw_)
                       m (Parsed MessageTarget -> Parsed AnyPointer -> Parsed Join)
-> m (Parsed MessageTarget) -> m (Parsed AnyPointer -> Parsed Join)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Join MessageTarget
-> Raw 'Const Join -> m (Parsed MessageTarget)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "target" (Field 'Slot Join MessageTarget)
Field 'Slot Join MessageTarget
#target Raw 'Const Join
raw_)
                       m (Parsed AnyPointer -> Parsed Join)
-> m (Parsed AnyPointer) -> m (Parsed Join)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Join AnyPointer
-> Raw 'Const Join -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "keyPart" (Field 'Slot Join AnyPointer)
Field 'Slot Join AnyPointer
#keyPart Raw 'Const Join
raw_))
instance (C.Marshal Join (C.Parsed Join)) where
    marshalInto :: Raw ('Mut s) Join -> Parsed Join -> m ()
marshalInto Raw ('Mut s) Join
raw_ Join{..} = (do
        (Field 'Slot Join Word32 -> Word32 -> Raw ('Mut s) Join -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot Join Word32)
Field 'Slot Join Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) Join
raw_)
        (Field 'Slot Join MessageTarget
-> Parsed MessageTarget -> Raw ('Mut s) Join -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "target" (Field 'Slot Join MessageTarget)
Field 'Slot Join MessageTarget
#target Parsed MessageTarget
Parsed MessageTarget
target Raw ('Mut s) Join
raw_)
        (Field 'Slot Join AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Join -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "keyPart" (Field 'Slot Join AnyPointer)
Field 'Slot Join AnyPointer
#keyPart Parsed AnyPointer
Parsed AnyPointer
keyPart Raw ('Mut s) Join
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot Join Std_.Word32) where
    fieldByLabel :: Field 'Slot Join Word32
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Join Word32
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 "target" GH.Slot Join MessageTarget) where
    fieldByLabel :: Field 'Slot Join MessageTarget
fieldByLabel  = (Word16 -> Field 'Slot Join MessageTarget
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "keyPart" GH.Slot Join Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot Join AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot Join AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data MessageTarget 
type instance (R.ReprFor MessageTarget) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct MessageTarget) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate MessageTarget) where
    type AllocHint MessageTarget = ()
    new :: AllocHint MessageTarget
-> Message ('Mut s) -> m (Raw ('Mut s) MessageTarget)
new AllocHint MessageTarget
_ = Message ('Mut s) -> m (Raw ('Mut s) MessageTarget)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc MessageTarget (C.Parsed MessageTarget))
instance (C.AllocateList MessageTarget) where
    type ListAllocHint MessageTarget = Std_.Int
    newList :: ListAllocHint MessageTarget
-> Message ('Mut s) -> m (Raw ('Mut s) (List MessageTarget))
newList  = ListAllocHint MessageTarget
-> Message ('Mut s) -> m (Raw ('Mut s) (List MessageTarget))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc MessageTarget (C.Parsed MessageTarget))
data instance C.Parsed MessageTarget
    = MessageTarget 
        {Parsed MessageTarget -> Parsed (Which MessageTarget)
union' :: (C.Parsed (GH.Which MessageTarget))}
    deriving((forall x. Parsed MessageTarget -> Rep (Parsed MessageTarget) x)
-> (forall x. Rep (Parsed MessageTarget) x -> Parsed MessageTarget)
-> Generic (Parsed MessageTarget)
forall x. Rep (Parsed MessageTarget) x -> Parsed MessageTarget
forall x. Parsed MessageTarget -> Rep (Parsed MessageTarget) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed MessageTarget) x -> Parsed MessageTarget
$cfrom :: forall x. Parsed MessageTarget -> Rep (Parsed MessageTarget) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed MessageTarget))
deriving instance (Std_.Eq (C.Parsed MessageTarget))
instance (C.Parse MessageTarget (C.Parsed MessageTarget)) where
    parse :: Raw 'Const MessageTarget -> m (Parsed MessageTarget)
parse Raw 'Const MessageTarget
raw_ = (Parsed (Which MessageTarget) -> Parsed MessageTarget
MessageTarget (Parsed (Which MessageTarget) -> Parsed MessageTarget)
-> m (Parsed (Which MessageTarget)) -> m (Parsed MessageTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which MessageTarget)
-> m (Parsed (Which MessageTarget))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const MessageTarget -> Raw 'Const (Which MessageTarget)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const MessageTarget
raw_)))
instance (C.Marshal MessageTarget (C.Parsed MessageTarget)) where
    marshalInto :: Raw ('Mut s) MessageTarget -> Parsed MessageTarget -> m ()
marshalInto Raw ('Mut s) MessageTarget
raw_ MessageTarget{..} = (do
        (Raw ('Mut s) (Which MessageTarget)
-> Parsed (Which MessageTarget) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) MessageTarget -> Raw ('Mut s) (Which MessageTarget)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) MessageTarget
raw_) Parsed (Which MessageTarget)
union')
        )
instance (GH.HasUnion MessageTarget) where
    unionField :: Field 'Slot MessageTarget Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot MessageTarget Word16
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)
    data RawWhich mut_ MessageTarget
        = RW_MessageTarget'importedCap (R.Raw mut_ Std_.Word32)
        | RW_MessageTarget'promisedAnswer (R.Raw mut_ PromisedAnswer)
        | RW_MessageTarget'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut MessageTarget -> m (RawWhich mut MessageTarget)
internalWhich Word16
tag_ Raw mut MessageTarget
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Word32 -> RawWhich mut MessageTarget
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ MessageTarget
RW_MessageTarget'importedCap (Raw mut Word32 -> RawWhich mut MessageTarget)
-> m (Raw mut Word32) -> m (RawWhich mut MessageTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot MessageTarget Word32
-> Raw mut MessageTarget -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "importedCap" (Variant 'Slot MessageTarget Word32)
Variant 'Slot MessageTarget Word32
#importedCap Raw mut MessageTarget
struct_))
        Word16
1 ->
            (Raw mut PromisedAnswer -> RawWhich mut MessageTarget
forall (mut_ :: Mutability).
Raw mut_ PromisedAnswer -> RawWhich mut_ MessageTarget
RW_MessageTarget'promisedAnswer (Raw mut PromisedAnswer -> RawWhich mut MessageTarget)
-> m (Raw mut PromisedAnswer) -> m (RawWhich mut MessageTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot MessageTarget PromisedAnswer
-> Raw mut MessageTarget -> m (Raw mut PromisedAnswer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "promisedAnswer" (Variant 'Slot MessageTarget PromisedAnswer)
Variant 'Slot MessageTarget PromisedAnswer
#promisedAnswer Raw mut MessageTarget
struct_))
        Word16
_ ->
            (RawWhich mut MessageTarget -> m (RawWhich mut MessageTarget)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut MessageTarget
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ MessageTarget
RW_MessageTarget'unknown' Word16
tag_))
    data Which MessageTarget
instance (GH.HasVariant "importedCap" GH.Slot MessageTarget Std_.Word32) where
    variantByLabel :: Variant 'Slot MessageTarget Word32
variantByLabel  = (Field 'Slot MessageTarget Word32
-> Word16 -> Variant 'Slot MessageTarget Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot MessageTarget Word32
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) Word16
0)
instance (GH.HasVariant "promisedAnswer" GH.Slot MessageTarget PromisedAnswer) where
    variantByLabel :: Variant 'Slot MessageTarget PromisedAnswer
variantByLabel  = (Field 'Slot MessageTarget PromisedAnswer
-> Word16 -> Variant 'Slot MessageTarget PromisedAnswer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot MessageTarget PromisedAnswer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
1)
data instance C.Parsed (GH.Which MessageTarget)
    = MessageTarget'importedCap (RP.Parsed Std_.Word32)
    | MessageTarget'promisedAnswer (RP.Parsed PromisedAnswer)
    | MessageTarget'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which MessageTarget)
 -> Rep (Parsed (Which MessageTarget)) x)
-> (forall x.
    Rep (Parsed (Which MessageTarget)) x
    -> Parsed (Which MessageTarget))
-> Generic (Parsed (Which MessageTarget))
forall x.
Rep (Parsed (Which MessageTarget)) x
-> Parsed (Which MessageTarget)
forall x.
Parsed (Which MessageTarget)
-> Rep (Parsed (Which MessageTarget)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which MessageTarget)) x
-> Parsed (Which MessageTarget)
$cfrom :: forall x.
Parsed (Which MessageTarget)
-> Rep (Parsed (Which MessageTarget)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which MessageTarget)))
deriving instance (Std_.Eq (C.Parsed (GH.Which MessageTarget)))
instance (C.Parse (GH.Which MessageTarget) (C.Parsed (GH.Which MessageTarget))) where
    parse :: Raw 'Const (Which MessageTarget)
-> m (Parsed (Which MessageTarget))
parse Raw 'Const (Which MessageTarget)
raw_ = (do
        RawWhich 'Const MessageTarget
rawWhich_ <- (Raw 'Const (Which MessageTarget)
-> m (RawWhich 'Const MessageTarget)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which MessageTarget)
raw_)
        case RawWhich 'Const MessageTarget
rawWhich_ of
            (RW_MessageTarget'importedCap rawArg_) ->
                (Word32 -> Parsed (Which MessageTarget)
Parsed Word32 -> Parsed (Which MessageTarget)
MessageTarget'importedCap (Word32 -> Parsed (Which MessageTarget))
-> m Word32 -> m (Parsed (Which MessageTarget))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_MessageTarget'promisedAnswer rawArg_) ->
                (Parsed PromisedAnswer -> Parsed (Which MessageTarget)
Parsed PromisedAnswer -> Parsed (Which MessageTarget)
MessageTarget'promisedAnswer (Parsed PromisedAnswer -> Parsed (Which MessageTarget))
-> m (Parsed PromisedAnswer) -> m (Parsed (Which MessageTarget))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const PromisedAnswer -> m (Parsed PromisedAnswer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const PromisedAnswer
rawArg_))
            (RW_MessageTarget'unknown' tag_) ->
                (Parsed (Which MessageTarget) -> m (Parsed (Which MessageTarget))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which MessageTarget)
MessageTarget'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which MessageTarget) (C.Parsed (GH.Which MessageTarget))) where
    marshalInto :: Raw ('Mut s) (Which MessageTarget)
-> Parsed (Which MessageTarget) -> m ()
marshalInto Raw ('Mut s) (Which MessageTarget)
raw_ Parsed (Which MessageTarget)
parsed_ = case Parsed (Which MessageTarget)
parsed_ of
        (MessageTarget'importedCap arg_) ->
            (Variant 'Slot MessageTarget Word32
-> Word32 -> Raw ('Mut s) MessageTarget -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "importedCap" (Variant 'Slot MessageTarget Word32)
Variant 'Slot MessageTarget Word32
#importedCap Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which MessageTarget) -> Raw ('Mut s) MessageTarget
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which MessageTarget)
raw_))
        (MessageTarget'promisedAnswer arg_) ->
            (Variant 'Slot MessageTarget PromisedAnswer
-> Parsed PromisedAnswer -> Raw ('Mut s) MessageTarget -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel
  "promisedAnswer" (Variant 'Slot MessageTarget PromisedAnswer)
Variant 'Slot MessageTarget PromisedAnswer
#promisedAnswer Parsed PromisedAnswer
Parsed PromisedAnswer
arg_ (Raw ('Mut s) (Which MessageTarget) -> Raw ('Mut s) MessageTarget
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which MessageTarget)
raw_))
        (MessageTarget'unknown' tag_) ->
            (Field 'Slot MessageTarget Word16
-> Word16 -> Raw ('Mut s) MessageTarget -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot MessageTarget Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which MessageTarget) -> Raw ('Mut s) MessageTarget
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which MessageTarget)
raw_))
data Payload 
type instance (R.ReprFor Payload) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Payload) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Payload) where
    type AllocHint Payload = ()
    new :: AllocHint Payload -> Message ('Mut s) -> m (Raw ('Mut s) Payload)
new AllocHint Payload
_ = Message ('Mut s) -> m (Raw ('Mut s) Payload)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Payload (C.Parsed Payload))
instance (C.AllocateList Payload) where
    type ListAllocHint Payload = Std_.Int
    newList :: ListAllocHint Payload
-> Message ('Mut s) -> m (Raw ('Mut s) (List Payload))
newList  = ListAllocHint Payload
-> Message ('Mut s) -> m (Raw ('Mut s) (List Payload))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Payload (C.Parsed Payload))
data instance C.Parsed Payload
    = Payload 
        {Parsed Payload -> Parsed AnyPointer
content :: (RP.Parsed Basics.AnyPointer)
        ,Parsed Payload -> Parsed (List CapDescriptor)
capTable :: (RP.Parsed (R.List CapDescriptor))}
    deriving((forall x. Parsed Payload -> Rep (Parsed Payload) x)
-> (forall x. Rep (Parsed Payload) x -> Parsed Payload)
-> Generic (Parsed Payload)
forall x. Rep (Parsed Payload) x -> Parsed Payload
forall x. Parsed Payload -> Rep (Parsed Payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Payload) x -> Parsed Payload
$cfrom :: forall x. Parsed Payload -> Rep (Parsed Payload) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Payload))
deriving instance (Std_.Eq (C.Parsed Payload))
instance (C.Parse Payload (C.Parsed Payload)) where
    parse :: Raw 'Const Payload -> m (Parsed Payload)
parse Raw 'Const Payload
raw_ = (Parsed AnyPointer
-> Vector (Parsed CapDescriptor) -> Parsed Payload
Parsed AnyPointer -> Parsed (List CapDescriptor) -> Parsed Payload
Payload (Parsed AnyPointer
 -> Vector (Parsed CapDescriptor) -> Parsed Payload)
-> m (Parsed AnyPointer)
-> m (Vector (Parsed CapDescriptor) -> Parsed Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Payload AnyPointer
-> Raw 'Const Payload -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "content" (Field 'Slot Payload AnyPointer)
Field 'Slot Payload AnyPointer
#content Raw 'Const Payload
raw_)
                          m (Vector (Parsed CapDescriptor) -> Parsed Payload)
-> m (Vector (Parsed CapDescriptor)) -> m (Parsed Payload)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Payload (List CapDescriptor)
-> Raw 'Const Payload -> m (Vector (Parsed CapDescriptor))
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "capTable" (Field 'Slot Payload (List CapDescriptor))
Field 'Slot Payload (List CapDescriptor)
#capTable Raw 'Const Payload
raw_))
instance (C.Marshal Payload (C.Parsed Payload)) where
    marshalInto :: Raw ('Mut s) Payload -> Parsed Payload -> m ()
marshalInto Raw ('Mut s) Payload
raw_ Payload{..} = (do
        (Field 'Slot Payload AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Payload -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "content" (Field 'Slot Payload AnyPointer)
Field 'Slot Payload AnyPointer
#content Parsed AnyPointer
Parsed AnyPointer
content Raw ('Mut s) Payload
raw_)
        (Field 'Slot Payload (List CapDescriptor)
-> Vector (Parsed CapDescriptor) -> Raw ('Mut s) Payload -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "capTable" (Field 'Slot Payload (List CapDescriptor))
Field 'Slot Payload (List CapDescriptor)
#capTable Vector (Parsed CapDescriptor)
Parsed (List CapDescriptor)
capTable Raw ('Mut s) Payload
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "content" GH.Slot Payload Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot Payload AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot Payload AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "capTable" GH.Slot Payload (R.List CapDescriptor)) where
    fieldByLabel :: Field 'Slot Payload (List CapDescriptor)
fieldByLabel  = (Word16 -> Field 'Slot Payload (List CapDescriptor)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data CapDescriptor 
type instance (R.ReprFor CapDescriptor) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct CapDescriptor) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate CapDescriptor) where
    type AllocHint CapDescriptor = ()
    new :: AllocHint CapDescriptor
-> Message ('Mut s) -> m (Raw ('Mut s) CapDescriptor)
new AllocHint CapDescriptor
_ = Message ('Mut s) -> m (Raw ('Mut s) CapDescriptor)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc CapDescriptor (C.Parsed CapDescriptor))
instance (C.AllocateList CapDescriptor) where
    type ListAllocHint CapDescriptor = Std_.Int
    newList :: ListAllocHint CapDescriptor
-> Message ('Mut s) -> m (Raw ('Mut s) (List CapDescriptor))
newList  = ListAllocHint CapDescriptor
-> Message ('Mut s) -> m (Raw ('Mut s) (List CapDescriptor))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc CapDescriptor (C.Parsed CapDescriptor))
data instance C.Parsed CapDescriptor
    = CapDescriptor 
        {Parsed CapDescriptor -> Parsed Word8
attachedFd :: (RP.Parsed Std_.Word8)
        ,Parsed CapDescriptor -> Parsed (Which CapDescriptor)
union' :: (C.Parsed (GH.Which CapDescriptor))}
    deriving((forall x. Parsed CapDescriptor -> Rep (Parsed CapDescriptor) x)
-> (forall x. Rep (Parsed CapDescriptor) x -> Parsed CapDescriptor)
-> Generic (Parsed CapDescriptor)
forall x. Rep (Parsed CapDescriptor) x -> Parsed CapDescriptor
forall x. Parsed CapDescriptor -> Rep (Parsed CapDescriptor) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed CapDescriptor) x -> Parsed CapDescriptor
$cfrom :: forall x. Parsed CapDescriptor -> Rep (Parsed CapDescriptor) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed CapDescriptor))
deriving instance (Std_.Eq (C.Parsed CapDescriptor))
instance (C.Parse CapDescriptor (C.Parsed CapDescriptor)) where
    parse :: Raw 'Const CapDescriptor -> m (Parsed CapDescriptor)
parse Raw 'Const CapDescriptor
raw_ = (Word8 -> Parsed (Which CapDescriptor) -> Parsed CapDescriptor
Parsed Word8
-> Parsed (Which CapDescriptor) -> Parsed CapDescriptor
CapDescriptor (Word8 -> Parsed (Which CapDescriptor) -> Parsed CapDescriptor)
-> m Word8
-> m (Parsed (Which CapDescriptor) -> Parsed CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot CapDescriptor Word8
-> Raw 'Const CapDescriptor -> m Word8
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "attachedFd" (Field 'Slot CapDescriptor Word8)
Field 'Slot CapDescriptor Word8
#attachedFd Raw 'Const CapDescriptor
raw_)
                                m (Parsed (Which CapDescriptor) -> Parsed CapDescriptor)
-> m (Parsed (Which CapDescriptor)) -> m (Parsed CapDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which CapDescriptor)
-> m (Parsed (Which CapDescriptor))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const CapDescriptor -> Raw 'Const (Which CapDescriptor)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const CapDescriptor
raw_)))
instance (C.Marshal CapDescriptor (C.Parsed CapDescriptor)) where
    marshalInto :: Raw ('Mut s) CapDescriptor -> Parsed CapDescriptor -> m ()
marshalInto Raw ('Mut s) CapDescriptor
raw_ CapDescriptor{..} = (do
        (Field 'Slot CapDescriptor Word8
-> Word8 -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "attachedFd" (Field 'Slot CapDescriptor Word8)
Field 'Slot CapDescriptor Word8
#attachedFd Word8
Parsed Word8
attachedFd Raw ('Mut s) CapDescriptor
raw_)
        (Raw ('Mut s) (Which CapDescriptor)
-> Parsed (Which CapDescriptor) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) CapDescriptor -> Raw ('Mut s) (Which CapDescriptor)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) CapDescriptor
raw_) Parsed (Which CapDescriptor)
union')
        )
instance (GH.HasUnion CapDescriptor) where
    unionField :: Field 'Slot CapDescriptor Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapDescriptor Word16
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 RawWhich mut_ CapDescriptor
        = RW_CapDescriptor'none (R.Raw mut_ ())
        | RW_CapDescriptor'senderHosted (R.Raw mut_ Std_.Word32)
        | RW_CapDescriptor'senderPromise (R.Raw mut_ Std_.Word32)
        | RW_CapDescriptor'receiverHosted (R.Raw mut_ Std_.Word32)
        | RW_CapDescriptor'receiverAnswer (R.Raw mut_ PromisedAnswer)
        | RW_CapDescriptor'thirdPartyHosted (R.Raw mut_ ThirdPartyCapDescriptor)
        | RW_CapDescriptor'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut CapDescriptor -> m (RawWhich mut CapDescriptor)
internalWhich Word16
tag_ Raw mut CapDescriptor
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'none (Raw mut () -> RawWhich mut CapDescriptor)
-> m (Raw mut ()) -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor ()
-> Raw mut CapDescriptor -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "none" (Variant 'Slot CapDescriptor ())
Variant 'Slot CapDescriptor ()
#none Raw mut CapDescriptor
struct_))
        Word16
1 ->
            (Raw mut Word32 -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'senderHosted (Raw mut Word32 -> RawWhich mut CapDescriptor)
-> m (Raw mut Word32) -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor Word32
-> Raw mut CapDescriptor -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "senderHosted" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#senderHosted Raw mut CapDescriptor
struct_))
        Word16
2 ->
            (Raw mut Word32 -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'senderPromise (Raw mut Word32 -> RawWhich mut CapDescriptor)
-> m (Raw mut Word32) -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor Word32
-> Raw mut CapDescriptor -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "senderPromise" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#senderPromise Raw mut CapDescriptor
struct_))
        Word16
3 ->
            (Raw mut Word32 -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ Word32 -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'receiverHosted (Raw mut Word32 -> RawWhich mut CapDescriptor)
-> m (Raw mut Word32) -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor Word32
-> Raw mut CapDescriptor -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "receiverHosted" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#receiverHosted Raw mut CapDescriptor
struct_))
        Word16
4 ->
            (Raw mut PromisedAnswer -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ PromisedAnswer -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'receiverAnswer (Raw mut PromisedAnswer -> RawWhich mut CapDescriptor)
-> m (Raw mut PromisedAnswer) -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor PromisedAnswer
-> Raw mut CapDescriptor -> m (Raw mut PromisedAnswer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "receiverAnswer" (Variant 'Slot CapDescriptor PromisedAnswer)
Variant 'Slot CapDescriptor PromisedAnswer
#receiverAnswer Raw mut CapDescriptor
struct_))
        Word16
5 ->
            (Raw mut ThirdPartyCapDescriptor -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability).
Raw mut_ ThirdPartyCapDescriptor -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'thirdPartyHosted (Raw mut ThirdPartyCapDescriptor -> RawWhich mut CapDescriptor)
-> m (Raw mut ThirdPartyCapDescriptor)
-> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
-> Raw mut CapDescriptor -> m (Raw mut ThirdPartyCapDescriptor)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "thirdPartyHosted"
  (Variant 'Slot CapDescriptor ThirdPartyCapDescriptor)
Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
#thirdPartyHosted Raw mut CapDescriptor
struct_))
        Word16
_ ->
            (RawWhich mut CapDescriptor -> m (RawWhich mut CapDescriptor)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut CapDescriptor
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ CapDescriptor
RW_CapDescriptor'unknown' Word16
tag_))
    data Which CapDescriptor
instance (GH.HasVariant "none" GH.Slot CapDescriptor ()) where
    variantByLabel :: Variant 'Slot CapDescriptor ()
variantByLabel  = (Field 'Slot CapDescriptor ()
-> Word16 -> Variant 'Slot CapDescriptor ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot CapDescriptor ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "senderHosted" GH.Slot CapDescriptor Std_.Word32) where
    variantByLabel :: Variant 'Slot CapDescriptor Word32
variantByLabel  = (Field 'Slot CapDescriptor Word32
-> Word16 -> Variant 'Slot CapDescriptor Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapDescriptor Word32
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
32 Word64
0) Word16
1)
instance (GH.HasVariant "senderPromise" GH.Slot CapDescriptor Std_.Word32) where
    variantByLabel :: Variant 'Slot CapDescriptor Word32
variantByLabel  = (Field 'Slot CapDescriptor Word32
-> Word16 -> Variant 'Slot CapDescriptor Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapDescriptor Word32
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
32 Word64
0) Word16
2)
instance (GH.HasVariant "receiverHosted" GH.Slot CapDescriptor Std_.Word32) where
    variantByLabel :: Variant 'Slot CapDescriptor Word32
variantByLabel  = (Field 'Slot CapDescriptor Word32
-> Word16 -> Variant 'Slot CapDescriptor Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapDescriptor Word32
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
32 Word64
0) Word16
3)
instance (GH.HasVariant "receiverAnswer" GH.Slot CapDescriptor PromisedAnswer) where
    variantByLabel :: Variant 'Slot CapDescriptor PromisedAnswer
variantByLabel  = (Field 'Slot CapDescriptor PromisedAnswer
-> Word16 -> Variant 'Slot CapDescriptor PromisedAnswer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot CapDescriptor PromisedAnswer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
4)
instance (GH.HasVariant "thirdPartyHosted" GH.Slot CapDescriptor ThirdPartyCapDescriptor) where
    variantByLabel :: Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
variantByLabel  = (Field 'Slot CapDescriptor ThirdPartyCapDescriptor
-> Word16 -> Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot CapDescriptor ThirdPartyCapDescriptor
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
5)
data instance C.Parsed (GH.Which CapDescriptor)
    = CapDescriptor'none 
    | CapDescriptor'senderHosted (RP.Parsed Std_.Word32)
    | CapDescriptor'senderPromise (RP.Parsed Std_.Word32)
    | CapDescriptor'receiverHosted (RP.Parsed Std_.Word32)
    | CapDescriptor'receiverAnswer (RP.Parsed PromisedAnswer)
    | CapDescriptor'thirdPartyHosted (RP.Parsed ThirdPartyCapDescriptor)
    | CapDescriptor'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which CapDescriptor)
 -> Rep (Parsed (Which CapDescriptor)) x)
-> (forall x.
    Rep (Parsed (Which CapDescriptor)) x
    -> Parsed (Which CapDescriptor))
-> Generic (Parsed (Which CapDescriptor))
forall x.
Rep (Parsed (Which CapDescriptor)) x
-> Parsed (Which CapDescriptor)
forall x.
Parsed (Which CapDescriptor)
-> Rep (Parsed (Which CapDescriptor)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which CapDescriptor)) x
-> Parsed (Which CapDescriptor)
$cfrom :: forall x.
Parsed (Which CapDescriptor)
-> Rep (Parsed (Which CapDescriptor)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which CapDescriptor)))
deriving instance (Std_.Eq (C.Parsed (GH.Which CapDescriptor)))
instance (C.Parse (GH.Which CapDescriptor) (C.Parsed (GH.Which CapDescriptor))) where
    parse :: Raw 'Const (Which CapDescriptor)
-> m (Parsed (Which CapDescriptor))
parse Raw 'Const (Which CapDescriptor)
raw_ = (do
        RawWhich 'Const CapDescriptor
rawWhich_ <- (Raw 'Const (Which CapDescriptor)
-> m (RawWhich 'Const CapDescriptor)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which CapDescriptor)
raw_)
        case RawWhich 'Const CapDescriptor
rawWhich_ of
            (RW_CapDescriptor'none _) ->
                (Parsed (Which CapDescriptor) -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which CapDescriptor)
CapDescriptor'none)
            (RW_CapDescriptor'senderHosted rawArg_) ->
                (Word32 -> Parsed (Which CapDescriptor)
Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'senderHosted (Word32 -> Parsed (Which CapDescriptor))
-> m Word32 -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_CapDescriptor'senderPromise rawArg_) ->
                (Word32 -> Parsed (Which CapDescriptor)
Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'senderPromise (Word32 -> Parsed (Which CapDescriptor))
-> m Word32 -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_CapDescriptor'receiverHosted rawArg_) ->
                (Word32 -> Parsed (Which CapDescriptor)
Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'receiverHosted (Word32 -> Parsed (Which CapDescriptor))
-> m Word32 -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_CapDescriptor'receiverAnswer rawArg_) ->
                (Parsed PromisedAnswer -> Parsed (Which CapDescriptor)
Parsed PromisedAnswer -> Parsed (Which CapDescriptor)
CapDescriptor'receiverAnswer (Parsed PromisedAnswer -> Parsed (Which CapDescriptor))
-> m (Parsed PromisedAnswer) -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const PromisedAnswer -> m (Parsed PromisedAnswer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const PromisedAnswer
rawArg_))
            (RW_CapDescriptor'thirdPartyHosted rawArg_) ->
                (Parsed ThirdPartyCapDescriptor -> Parsed (Which CapDescriptor)
Parsed ThirdPartyCapDescriptor -> Parsed (Which CapDescriptor)
CapDescriptor'thirdPartyHosted (Parsed ThirdPartyCapDescriptor -> Parsed (Which CapDescriptor))
-> m (Parsed ThirdPartyCapDescriptor)
-> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const ThirdPartyCapDescriptor
-> m (Parsed ThirdPartyCapDescriptor)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const ThirdPartyCapDescriptor
rawArg_))
            (RW_CapDescriptor'unknown' tag_) ->
                (Parsed (Which CapDescriptor) -> m (Parsed (Which CapDescriptor))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which CapDescriptor)
CapDescriptor'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which CapDescriptor) (C.Parsed (GH.Which CapDescriptor))) where
    marshalInto :: Raw ('Mut s) (Which CapDescriptor)
-> Parsed (Which CapDescriptor) -> m ()
marshalInto Raw ('Mut s) (Which CapDescriptor)
raw_ Parsed (Which CapDescriptor)
parsed_ = case Parsed (Which CapDescriptor)
parsed_ of
        (Parsed (Which CapDescriptor)
CapDescriptor'none) ->
            (Variant 'Slot CapDescriptor ()
-> () -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "none" (Variant 'Slot CapDescriptor ())
Variant 'Slot CapDescriptor ()
#none () (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'senderHosted arg_) ->
            (Variant 'Slot CapDescriptor Word32
-> Word32 -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "senderHosted" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#senderHosted Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'senderPromise arg_) ->
            (Variant 'Slot CapDescriptor Word32
-> Word32 -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "senderPromise" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#senderPromise Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'receiverHosted arg_) ->
            (Variant 'Slot CapDescriptor Word32
-> Word32 -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "receiverHosted" (Variant 'Slot CapDescriptor Word32)
Variant 'Slot CapDescriptor Word32
#receiverHosted Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'receiverAnswer arg_) ->
            (Variant 'Slot CapDescriptor PromisedAnswer
-> Parsed PromisedAnswer -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel
  "receiverAnswer" (Variant 'Slot CapDescriptor PromisedAnswer)
Variant 'Slot CapDescriptor PromisedAnswer
#receiverAnswer Parsed PromisedAnswer
Parsed PromisedAnswer
arg_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'thirdPartyHosted arg_) ->
            (Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
-> Parsed ThirdPartyCapDescriptor
-> Raw ('Mut s) CapDescriptor
-> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel
  "thirdPartyHosted"
  (Variant 'Slot CapDescriptor ThirdPartyCapDescriptor)
Variant 'Slot CapDescriptor ThirdPartyCapDescriptor
#thirdPartyHosted Parsed ThirdPartyCapDescriptor
Parsed ThirdPartyCapDescriptor
arg_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
        (CapDescriptor'unknown' tag_) ->
            (Field 'Slot CapDescriptor Word16
-> Word16 -> Raw ('Mut s) CapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot CapDescriptor Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which CapDescriptor) -> Raw ('Mut s) CapDescriptor
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which CapDescriptor)
raw_))
instance (GH.HasField "attachedFd" GH.Slot CapDescriptor Std_.Word8) where
    fieldByLabel :: Field 'Slot CapDescriptor Word8
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapDescriptor Word8
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
8 Word64
255)
data PromisedAnswer 
type instance (R.ReprFor PromisedAnswer) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct PromisedAnswer) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate PromisedAnswer) where
    type AllocHint PromisedAnswer = ()
    new :: AllocHint PromisedAnswer
-> Message ('Mut s) -> m (Raw ('Mut s) PromisedAnswer)
new AllocHint PromisedAnswer
_ = Message ('Mut s) -> m (Raw ('Mut s) PromisedAnswer)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc PromisedAnswer (C.Parsed PromisedAnswer))
instance (C.AllocateList PromisedAnswer) where
    type ListAllocHint PromisedAnswer = Std_.Int
    newList :: ListAllocHint PromisedAnswer
-> Message ('Mut s) -> m (Raw ('Mut s) (List PromisedAnswer))
newList  = ListAllocHint PromisedAnswer
-> Message ('Mut s) -> m (Raw ('Mut s) (List PromisedAnswer))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc PromisedAnswer (C.Parsed PromisedAnswer))
data instance C.Parsed PromisedAnswer
    = PromisedAnswer 
        {Parsed PromisedAnswer -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed PromisedAnswer -> Parsed (List PromisedAnswer'Op)
transform :: (RP.Parsed (R.List PromisedAnswer'Op))}
    deriving((forall x. Parsed PromisedAnswer -> Rep (Parsed PromisedAnswer) x)
-> (forall x.
    Rep (Parsed PromisedAnswer) x -> Parsed PromisedAnswer)
-> Generic (Parsed PromisedAnswer)
forall x. Rep (Parsed PromisedAnswer) x -> Parsed PromisedAnswer
forall x. Parsed PromisedAnswer -> Rep (Parsed PromisedAnswer) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed PromisedAnswer) x -> Parsed PromisedAnswer
$cfrom :: forall x. Parsed PromisedAnswer -> Rep (Parsed PromisedAnswer) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed PromisedAnswer))
deriving instance (Std_.Eq (C.Parsed PromisedAnswer))
instance (C.Parse PromisedAnswer (C.Parsed PromisedAnswer)) where
    parse :: Raw 'Const PromisedAnswer -> m (Parsed PromisedAnswer)
parse Raw 'Const PromisedAnswer
raw_ = (Word32
-> Vector (Parsed PromisedAnswer'Op) -> Parsed PromisedAnswer
Parsed Word32
-> Parsed (List PromisedAnswer'Op) -> Parsed PromisedAnswer
PromisedAnswer (Word32
 -> Vector (Parsed PromisedAnswer'Op) -> Parsed PromisedAnswer)
-> m Word32
-> m (Vector (Parsed PromisedAnswer'Op) -> Parsed PromisedAnswer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot PromisedAnswer Word32
-> Raw 'Const PromisedAnswer -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "questionId" (Field 'Slot PromisedAnswer Word32)
Field 'Slot PromisedAnswer Word32
#questionId Raw 'Const PromisedAnswer
raw_)
                                 m (Vector (Parsed PromisedAnswer'Op) -> Parsed PromisedAnswer)
-> m (Vector (Parsed PromisedAnswer'Op))
-> m (Parsed PromisedAnswer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
-> Raw 'Const PromisedAnswer
-> m (Vector (Parsed PromisedAnswer'Op))
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel
  "transform" (Field 'Slot PromisedAnswer (List PromisedAnswer'Op))
Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
#transform Raw 'Const PromisedAnswer
raw_))
instance (C.Marshal PromisedAnswer (C.Parsed PromisedAnswer)) where
    marshalInto :: Raw ('Mut s) PromisedAnswer -> Parsed PromisedAnswer -> m ()
marshalInto Raw ('Mut s) PromisedAnswer
raw_ PromisedAnswer{..} = (do
        (Field 'Slot PromisedAnswer Word32
-> Word32 -> Raw ('Mut s) PromisedAnswer -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "questionId" (Field 'Slot PromisedAnswer Word32)
Field 'Slot PromisedAnswer Word32
#questionId Word32
Parsed Word32
questionId Raw ('Mut s) PromisedAnswer
raw_)
        (Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
-> Vector (Parsed PromisedAnswer'Op)
-> Raw ('Mut s) PromisedAnswer
-> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel
  "transform" (Field 'Slot PromisedAnswer (List PromisedAnswer'Op))
Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
#transform Vector (Parsed PromisedAnswer'Op)
Parsed (List PromisedAnswer'Op)
transform Raw ('Mut s) PromisedAnswer
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "questionId" GH.Slot PromisedAnswer Std_.Word32) where
    fieldByLabel :: Field 'Slot PromisedAnswer Word32
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot PromisedAnswer Word32
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 "transform" GH.Slot PromisedAnswer (R.List PromisedAnswer'Op)) where
    fieldByLabel :: Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
fieldByLabel  = (Word16 -> Field 'Slot PromisedAnswer (List PromisedAnswer'Op)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data PromisedAnswer'Op 
type instance (R.ReprFor PromisedAnswer'Op) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct PromisedAnswer'Op) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate PromisedAnswer'Op) where
    type AllocHint PromisedAnswer'Op = ()
    new :: AllocHint PromisedAnswer'Op
-> Message ('Mut s) -> m (Raw ('Mut s) PromisedAnswer'Op)
new AllocHint PromisedAnswer'Op
_ = Message ('Mut s) -> m (Raw ('Mut s) PromisedAnswer'Op)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc PromisedAnswer'Op (C.Parsed PromisedAnswer'Op))
instance (C.AllocateList PromisedAnswer'Op) where
    type ListAllocHint PromisedAnswer'Op = Std_.Int
    newList :: ListAllocHint PromisedAnswer'Op
-> Message ('Mut s) -> m (Raw ('Mut s) (List PromisedAnswer'Op))
newList  = ListAllocHint PromisedAnswer'Op
-> Message ('Mut s) -> m (Raw ('Mut s) (List PromisedAnswer'Op))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc PromisedAnswer'Op (C.Parsed PromisedAnswer'Op))
data instance C.Parsed PromisedAnswer'Op
    = PromisedAnswer'Op 
        {Parsed PromisedAnswer'Op -> Parsed (Which PromisedAnswer'Op)
union' :: (C.Parsed (GH.Which PromisedAnswer'Op))}
    deriving((forall x.
 Parsed PromisedAnswer'Op -> Rep (Parsed PromisedAnswer'Op) x)
-> (forall x.
    Rep (Parsed PromisedAnswer'Op) x -> Parsed PromisedAnswer'Op)
-> Generic (Parsed PromisedAnswer'Op)
forall x.
Rep (Parsed PromisedAnswer'Op) x -> Parsed PromisedAnswer'Op
forall x.
Parsed PromisedAnswer'Op -> Rep (Parsed PromisedAnswer'Op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed PromisedAnswer'Op) x -> Parsed PromisedAnswer'Op
$cfrom :: forall x.
Parsed PromisedAnswer'Op -> Rep (Parsed PromisedAnswer'Op) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed PromisedAnswer'Op))
deriving instance (Std_.Eq (C.Parsed PromisedAnswer'Op))
instance (C.Parse PromisedAnswer'Op (C.Parsed PromisedAnswer'Op)) where
    parse :: Raw 'Const PromisedAnswer'Op -> m (Parsed PromisedAnswer'Op)
parse Raw 'Const PromisedAnswer'Op
raw_ = (Parsed (Which PromisedAnswer'Op) -> Parsed PromisedAnswer'Op
PromisedAnswer'Op (Parsed (Which PromisedAnswer'Op) -> Parsed PromisedAnswer'Op)
-> m (Parsed (Which PromisedAnswer'Op))
-> m (Parsed PromisedAnswer'Op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which PromisedAnswer'Op)
-> m (Parsed (Which PromisedAnswer'Op))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const PromisedAnswer'Op
-> Raw 'Const (Which PromisedAnswer'Op)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const PromisedAnswer'Op
raw_)))
instance (C.Marshal PromisedAnswer'Op (C.Parsed PromisedAnswer'Op)) where
    marshalInto :: Raw ('Mut s) PromisedAnswer'Op -> Parsed PromisedAnswer'Op -> m ()
marshalInto Raw ('Mut s) PromisedAnswer'Op
raw_ PromisedAnswer'Op{..} = (do
        (Raw ('Mut s) (Which PromisedAnswer'Op)
-> Parsed (Which PromisedAnswer'Op) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) PromisedAnswer'Op
-> Raw ('Mut s) (Which PromisedAnswer'Op)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) PromisedAnswer'Op
raw_) Parsed (Which PromisedAnswer'Op)
union')
        )
instance (GH.HasUnion PromisedAnswer'Op) where
    unionField :: Field 'Slot PromisedAnswer'Op Word16
unionField  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot PromisedAnswer'Op Word16
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 RawWhich mut_ PromisedAnswer'Op
        = RW_PromisedAnswer'Op'noop (R.Raw mut_ ())
        | RW_PromisedAnswer'Op'getPointerField (R.Raw mut_ Std_.Word16)
        | RW_PromisedAnswer'Op'unknown' Std_.Word16
    internalWhich :: Word16
-> Raw mut PromisedAnswer'Op -> m (RawWhich mut PromisedAnswer'Op)
internalWhich Word16
tag_ Raw mut PromisedAnswer'Op
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut PromisedAnswer'Op
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ PromisedAnswer'Op
RW_PromisedAnswer'Op'noop (Raw mut () -> RawWhich mut PromisedAnswer'Op)
-> m (Raw mut ()) -> m (RawWhich mut PromisedAnswer'Op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot PromisedAnswer'Op ()
-> Raw mut PromisedAnswer'Op -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "noop" (Variant 'Slot PromisedAnswer'Op ())
Variant 'Slot PromisedAnswer'Op ()
#noop Raw mut PromisedAnswer'Op
struct_))
        Word16
1 ->
            (Raw mut Word16 -> RawWhich mut PromisedAnswer'Op
forall (mut_ :: Mutability).
Raw mut_ Word16 -> RawWhich mut_ PromisedAnswer'Op
RW_PromisedAnswer'Op'getPointerField (Raw mut Word16 -> RawWhich mut PromisedAnswer'Op)
-> m (Raw mut Word16) -> m (RawWhich mut PromisedAnswer'Op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot PromisedAnswer'Op Word16
-> Raw mut PromisedAnswer'Op -> m (Raw mut Word16)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "getPointerField" (Variant 'Slot PromisedAnswer'Op Word16)
Variant 'Slot PromisedAnswer'Op Word16
#getPointerField Raw mut PromisedAnswer'Op
struct_))
        Word16
_ ->
            (RawWhich mut PromisedAnswer'Op
-> m (RawWhich mut PromisedAnswer'Op)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut PromisedAnswer'Op
forall (mut_ :: Mutability).
Word16 -> RawWhich mut_ PromisedAnswer'Op
RW_PromisedAnswer'Op'unknown' Word16
tag_))
    data Which PromisedAnswer'Op
instance (GH.HasVariant "noop" GH.Slot PromisedAnswer'Op ()) where
    variantByLabel :: Variant 'Slot PromisedAnswer'Op ()
variantByLabel  = (Field 'Slot PromisedAnswer'Op ()
-> Word16 -> Variant 'Slot PromisedAnswer'Op ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot PromisedAnswer'Op ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "getPointerField" GH.Slot PromisedAnswer'Op Std_.Word16) where
    variantByLabel :: Variant 'Slot PromisedAnswer'Op Word16
variantByLabel  = (Field 'Slot PromisedAnswer'Op Word16
-> Word16 -> Variant 'Slot PromisedAnswer'Op Word16
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot PromisedAnswer'Op Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
16 Word64
0) Word16
1)
data instance C.Parsed (GH.Which PromisedAnswer'Op)
    = PromisedAnswer'Op'noop 
    | PromisedAnswer'Op'getPointerField (RP.Parsed Std_.Word16)
    | PromisedAnswer'Op'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which PromisedAnswer'Op)
 -> Rep (Parsed (Which PromisedAnswer'Op)) x)
-> (forall x.
    Rep (Parsed (Which PromisedAnswer'Op)) x
    -> Parsed (Which PromisedAnswer'Op))
-> Generic (Parsed (Which PromisedAnswer'Op))
forall x.
Rep (Parsed (Which PromisedAnswer'Op)) x
-> Parsed (Which PromisedAnswer'Op)
forall x.
Parsed (Which PromisedAnswer'Op)
-> Rep (Parsed (Which PromisedAnswer'Op)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which PromisedAnswer'Op)) x
-> Parsed (Which PromisedAnswer'Op)
$cfrom :: forall x.
Parsed (Which PromisedAnswer'Op)
-> Rep (Parsed (Which PromisedAnswer'Op)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which PromisedAnswer'Op)))
deriving instance (Std_.Eq (C.Parsed (GH.Which PromisedAnswer'Op)))
instance (C.Parse (GH.Which PromisedAnswer'Op) (C.Parsed (GH.Which PromisedAnswer'Op))) where
    parse :: Raw 'Const (Which PromisedAnswer'Op)
-> m (Parsed (Which PromisedAnswer'Op))
parse Raw 'Const (Which PromisedAnswer'Op)
raw_ = (do
        RawWhich 'Const PromisedAnswer'Op
rawWhich_ <- (Raw 'Const (Which PromisedAnswer'Op)
-> m (RawWhich 'Const PromisedAnswer'Op)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which PromisedAnswer'Op)
raw_)
        case RawWhich 'Const PromisedAnswer'Op
rawWhich_ of
            (RW_PromisedAnswer'Op'noop _) ->
                (Parsed (Which PromisedAnswer'Op)
-> m (Parsed (Which PromisedAnswer'Op))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'noop)
            (RW_PromisedAnswer'Op'getPointerField rawArg_) ->
                (Word16 -> Parsed (Which PromisedAnswer'Op)
Parsed Word16 -> Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'getPointerField (Word16 -> Parsed (Which PromisedAnswer'Op))
-> m Word16 -> m (Parsed (Which PromisedAnswer'Op))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word16 -> m Word16
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word16
rawArg_))
            (RW_PromisedAnswer'Op'unknown' tag_) ->
                (Parsed (Which PromisedAnswer'Op)
-> m (Parsed (Which PromisedAnswer'Op))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which PromisedAnswer'Op) (C.Parsed (GH.Which PromisedAnswer'Op))) where
    marshalInto :: Raw ('Mut s) (Which PromisedAnswer'Op)
-> Parsed (Which PromisedAnswer'Op) -> m ()
marshalInto Raw ('Mut s) (Which PromisedAnswer'Op)
raw_ Parsed (Which PromisedAnswer'Op)
parsed_ = case Parsed (Which PromisedAnswer'Op)
parsed_ of
        (Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'noop) ->
            (Variant 'Slot PromisedAnswer'Op ()
-> () -> Raw ('Mut s) PromisedAnswer'Op -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "noop" (Variant 'Slot PromisedAnswer'Op ())
Variant 'Slot PromisedAnswer'Op ()
#noop () (Raw ('Mut s) (Which PromisedAnswer'Op)
-> Raw ('Mut s) PromisedAnswer'Op
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which PromisedAnswer'Op)
raw_))
        (PromisedAnswer'Op'getPointerField arg_) ->
            (Variant 'Slot PromisedAnswer'Op Word16
-> Word16 -> Raw ('Mut s) PromisedAnswer'Op -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "getPointerField" (Variant 'Slot PromisedAnswer'Op Word16)
Variant 'Slot PromisedAnswer'Op Word16
#getPointerField Word16
Parsed Word16
arg_ (Raw ('Mut s) (Which PromisedAnswer'Op)
-> Raw ('Mut s) PromisedAnswer'Op
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which PromisedAnswer'Op)
raw_))
        (PromisedAnswer'Op'unknown' tag_) ->
            (Field 'Slot PromisedAnswer'Op Word16
-> Word16 -> Raw ('Mut s) PromisedAnswer'Op -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot PromisedAnswer'Op Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which PromisedAnswer'Op)
-> Raw ('Mut s) PromisedAnswer'Op
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which PromisedAnswer'Op)
raw_))
data ThirdPartyCapDescriptor 
type instance (R.ReprFor ThirdPartyCapDescriptor) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct ThirdPartyCapDescriptor) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate ThirdPartyCapDescriptor) where
    type AllocHint ThirdPartyCapDescriptor = ()
    new :: AllocHint ThirdPartyCapDescriptor
-> Message ('Mut s) -> m (Raw ('Mut s) ThirdPartyCapDescriptor)
new AllocHint ThirdPartyCapDescriptor
_ = Message ('Mut s) -> m (Raw ('Mut s) ThirdPartyCapDescriptor)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor))
instance (C.AllocateList ThirdPartyCapDescriptor) where
    type ListAllocHint ThirdPartyCapDescriptor = Std_.Int
    newList :: ListAllocHint ThirdPartyCapDescriptor
-> Message ('Mut s)
-> m (Raw ('Mut s) (List ThirdPartyCapDescriptor))
newList  = ListAllocHint ThirdPartyCapDescriptor
-> Message ('Mut s)
-> m (Raw ('Mut s) (List ThirdPartyCapDescriptor))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor))
data instance C.Parsed ThirdPartyCapDescriptor
    = ThirdPartyCapDescriptor 
        {Parsed ThirdPartyCapDescriptor -> Parsed AnyPointer
id :: (RP.Parsed Basics.AnyPointer)
        ,Parsed ThirdPartyCapDescriptor -> Parsed Word32
vineId :: (RP.Parsed Std_.Word32)}
    deriving((forall x.
 Parsed ThirdPartyCapDescriptor
 -> Rep (Parsed ThirdPartyCapDescriptor) x)
-> (forall x.
    Rep (Parsed ThirdPartyCapDescriptor) x
    -> Parsed ThirdPartyCapDescriptor)
-> Generic (Parsed ThirdPartyCapDescriptor)
forall x.
Rep (Parsed ThirdPartyCapDescriptor) x
-> Parsed ThirdPartyCapDescriptor
forall x.
Parsed ThirdPartyCapDescriptor
-> Rep (Parsed ThirdPartyCapDescriptor) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed ThirdPartyCapDescriptor) x
-> Parsed ThirdPartyCapDescriptor
$cfrom :: forall x.
Parsed ThirdPartyCapDescriptor
-> Rep (Parsed ThirdPartyCapDescriptor) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed ThirdPartyCapDescriptor))
deriving instance (Std_.Eq (C.Parsed ThirdPartyCapDescriptor))
instance (C.Parse ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor)) where
    parse :: Raw 'Const ThirdPartyCapDescriptor
-> m (Parsed ThirdPartyCapDescriptor)
parse Raw 'Const ThirdPartyCapDescriptor
raw_ = (Parsed AnyPointer -> Word32 -> Parsed ThirdPartyCapDescriptor
Parsed AnyPointer
-> Parsed Word32 -> Parsed ThirdPartyCapDescriptor
ThirdPartyCapDescriptor (Parsed AnyPointer -> Word32 -> Parsed ThirdPartyCapDescriptor)
-> m (Parsed AnyPointer)
-> m (Word32 -> Parsed ThirdPartyCapDescriptor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot ThirdPartyCapDescriptor AnyPointer
-> Raw 'Const ThirdPartyCapDescriptor -> m (Parsed AnyPointer)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot ThirdPartyCapDescriptor AnyPointer)
Field 'Slot ThirdPartyCapDescriptor AnyPointer
#id Raw 'Const ThirdPartyCapDescriptor
raw_)
                                          m (Word32 -> Parsed ThirdPartyCapDescriptor)
-> m Word32 -> m (Parsed ThirdPartyCapDescriptor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot ThirdPartyCapDescriptor Word32
-> Raw 'Const ThirdPartyCapDescriptor -> m Word32
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "vineId" (Field 'Slot ThirdPartyCapDescriptor Word32)
Field 'Slot ThirdPartyCapDescriptor Word32
#vineId Raw 'Const ThirdPartyCapDescriptor
raw_))
instance (C.Marshal ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor)) where
    marshalInto :: Raw ('Mut s) ThirdPartyCapDescriptor
-> Parsed ThirdPartyCapDescriptor -> m ()
marshalInto Raw ('Mut s) ThirdPartyCapDescriptor
raw_ ThirdPartyCapDescriptor{..} = (do
        (Field 'Slot ThirdPartyCapDescriptor AnyPointer
-> Parsed AnyPointer
-> Raw ('Mut s) ThirdPartyCapDescriptor
-> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot ThirdPartyCapDescriptor AnyPointer)
Field 'Slot ThirdPartyCapDescriptor AnyPointer
#id Parsed AnyPointer
Parsed AnyPointer
id Raw ('Mut s) ThirdPartyCapDescriptor
raw_)
        (Field 'Slot ThirdPartyCapDescriptor Word32
-> Word32 -> Raw ('Mut s) ThirdPartyCapDescriptor -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "vineId" (Field 'Slot ThirdPartyCapDescriptor Word32)
Field 'Slot ThirdPartyCapDescriptor Word32
#vineId Word32
Parsed Word32
vineId Raw ('Mut s) ThirdPartyCapDescriptor
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot ThirdPartyCapDescriptor Basics.AnyPointer) where
    fieldByLabel :: Field 'Slot ThirdPartyCapDescriptor AnyPointer
fieldByLabel  = (Word16 -> Field 'Slot ThirdPartyCapDescriptor AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "vineId" GH.Slot ThirdPartyCapDescriptor Std_.Word32) where
    fieldByLabel :: Field 'Slot ThirdPartyCapDescriptor Word32
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot ThirdPartyCapDescriptor Word32
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 Exception 
type instance (R.ReprFor Exception) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Exception) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Exception) where
    type AllocHint Exception = ()
    new :: AllocHint Exception
-> Message ('Mut s) -> m (Raw ('Mut s) Exception)
new AllocHint Exception
_ = Message ('Mut s) -> m (Raw ('Mut s) Exception)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Exception (C.Parsed Exception))
instance (C.AllocateList Exception) where
    type ListAllocHint Exception = Std_.Int
    newList :: ListAllocHint Exception
-> Message ('Mut s) -> m (Raw ('Mut s) (List Exception))
newList  = ListAllocHint Exception
-> Message ('Mut s) -> m (Raw ('Mut s) (List Exception))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Exception (C.Parsed Exception))
data instance C.Parsed Exception
    = Exception 
        {Parsed Exception -> Parsed Text
reason :: (RP.Parsed Basics.Text)
        ,Parsed Exception -> Parsed Bool
obsoleteIsCallersFault :: (RP.Parsed Std_.Bool)
        ,Parsed Exception -> Parsed Word16
obsoleteDurability :: (RP.Parsed Std_.Word16)
        ,Parsed Exception -> Parsed Exception'Type
type_ :: (RP.Parsed Exception'Type)}
    deriving((forall x. Parsed Exception -> Rep (Parsed Exception) x)
-> (forall x. Rep (Parsed Exception) x -> Parsed Exception)
-> Generic (Parsed Exception)
forall x. Rep (Parsed Exception) x -> Parsed Exception
forall x. Parsed Exception -> Rep (Parsed Exception) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Exception) x -> Parsed Exception
$cfrom :: forall x. Parsed Exception -> Rep (Parsed Exception) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Exception))
deriving instance (Std_.Eq (C.Parsed Exception))
instance (C.Parse Exception (C.Parsed Exception)) where
    parse :: Raw 'Const Exception -> m (Parsed Exception)
parse Raw 'Const Exception
raw_ = (Text -> Bool -> Word16 -> Exception'Type -> Parsed Exception
Parsed Text
-> Parsed Bool
-> Parsed Word16
-> Parsed Exception'Type
-> Parsed Exception
Exception (Text -> Bool -> Word16 -> Exception'Type -> Parsed Exception)
-> m Text
-> m (Bool -> Word16 -> Exception'Type -> Parsed Exception)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Exception Text -> Raw 'Const Exception -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "reason" (Field 'Slot Exception Text)
Field 'Slot Exception Text
#reason Raw 'Const Exception
raw_)
                            m (Bool -> Word16 -> Exception'Type -> Parsed Exception)
-> m Bool -> m (Word16 -> Exception'Type -> Parsed Exception)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Exception Bool -> Raw 'Const Exception -> m Bool
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "obsoleteIsCallersFault" (Field 'Slot Exception Bool)
Field 'Slot Exception Bool
#obsoleteIsCallersFault Raw 'Const Exception
raw_)
                            m (Word16 -> Exception'Type -> Parsed Exception)
-> m Word16 -> m (Exception'Type -> Parsed Exception)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Exception Word16 -> Raw 'Const Exception -> m Word16
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "obsoleteDurability" (Field 'Slot Exception Word16)
Field 'Slot Exception Word16
#obsoleteDurability Raw 'Const Exception
raw_)
                            m (Exception'Type -> Parsed Exception)
-> m Exception'Type -> m (Parsed Exception)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Exception Exception'Type
-> Raw 'Const Exception -> m Exception'Type
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "type_" (Field 'Slot Exception Exception'Type)
Field 'Slot Exception Exception'Type
#type_ Raw 'Const Exception
raw_))
instance (C.Marshal Exception (C.Parsed Exception)) where
    marshalInto :: Raw ('Mut s) Exception -> Parsed Exception -> m ()
marshalInto Raw ('Mut s) Exception
raw_ Exception{..} = (do
        (Field 'Slot Exception Text
-> Text -> Raw ('Mut s) Exception -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "reason" (Field 'Slot Exception Text)
Field 'Slot Exception Text
#reason Text
Parsed Text
reason Raw ('Mut s) Exception
raw_)
        (Field 'Slot Exception Bool
-> Bool -> Raw ('Mut s) Exception -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "obsoleteIsCallersFault" (Field 'Slot Exception Bool)
Field 'Slot Exception Bool
#obsoleteIsCallersFault Bool
Parsed Bool
obsoleteIsCallersFault Raw ('Mut s) Exception
raw_)
        (Field 'Slot Exception Word16
-> Word16 -> Raw ('Mut s) Exception -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "obsoleteDurability" (Field 'Slot Exception Word16)
Field 'Slot Exception Word16
#obsoleteDurability Word16
Parsed Word16
obsoleteDurability Raw ('Mut s) Exception
raw_)
        (Field 'Slot Exception Exception'Type
-> Exception'Type -> Raw ('Mut s) Exception -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "type_" (Field 'Slot Exception Exception'Type)
Field 'Slot Exception Exception'Type
#type_ Parsed Exception'Type
Exception'Type
type_ Raw ('Mut s) Exception
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "reason" GH.Slot Exception Basics.Text) where
    fieldByLabel :: Field 'Slot Exception Text
fieldByLabel  = (Word16 -> Field 'Slot Exception Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "obsoleteIsCallersFault" GH.Slot Exception Std_.Bool) where
    fieldByLabel :: Field 'Slot Exception Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Exception Bool
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
1 Word64
0)
instance (GH.HasField "obsoleteDurability" GH.Slot Exception Std_.Word16) where
    fieldByLabel :: Field 'Slot Exception Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Exception Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "type_" GH.Slot Exception Exception'Type) where
    fieldByLabel :: Field 'Slot Exception Exception'Type
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Exception Exception'Type
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)
data Exception'Type 
    = Exception'Type'failed 
    | Exception'Type'overloaded 
    | Exception'Type'disconnected 
    | Exception'Type'unimplemented 
    | Exception'Type'unknown' Std_.Word16
    deriving(Exception'Type -> Exception'Type -> Bool
(Exception'Type -> Exception'Type -> Bool)
-> (Exception'Type -> Exception'Type -> Bool) -> Eq Exception'Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exception'Type -> Exception'Type -> Bool
$c/= :: Exception'Type -> Exception'Type -> Bool
== :: Exception'Type -> Exception'Type -> Bool
$c== :: Exception'Type -> Exception'Type -> Bool
Std_.Eq,Int -> Exception'Type -> ShowS
[Exception'Type] -> ShowS
Exception'Type -> String
(Int -> Exception'Type -> ShowS)
-> (Exception'Type -> String)
-> ([Exception'Type] -> ShowS)
-> Show Exception'Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception'Type] -> ShowS
$cshowList :: [Exception'Type] -> ShowS
show :: Exception'Type -> String
$cshow :: Exception'Type -> String
showsPrec :: Int -> Exception'Type -> ShowS
$cshowsPrec :: Int -> Exception'Type -> ShowS
Std_.Show)
type instance (R.ReprFor Exception'Type) = (R.Data R.Sz16)
instance (Std_.Enum Exception'Type) where
    toEnum :: Int -> Exception'Type
toEnum Int
n_ = case Int
n_ of
        Int
0 ->
            Exception'Type
Exception'Type'failed
        Int
1 ->
            Exception'Type
Exception'Type'overloaded
        Int
2 ->
            Exception'Type
Exception'Type'disconnected
        Int
3 ->
            Exception'Type
Exception'Type'unimplemented
        Int
tag_ ->
            (Word16 -> Exception'Type
Exception'Type'unknown' (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Int
tag_))
    fromEnum :: Exception'Type -> Int
fromEnum Exception'Type
value_ = case Exception'Type
value_ of
        (Exception'Type
Exception'Type'failed) ->
            Int
0
        (Exception'Type
Exception'Type'overloaded) ->
            Int
1
        (Exception'Type
Exception'Type'disconnected) ->
            Int
2
        (Exception'Type
Exception'Type'unimplemented) ->
            Int
3
        (Exception'Type'unknown' Word16
tag_) ->
            (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag_)
instance (C.IsWord Exception'Type) where
    fromWord :: Word64 -> Exception'Type
fromWord Word64
w_ = (Int -> Exception'Type
forall a. Enum a => Int -> a
Std_.toEnum (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
w_))
    toWord :: Exception'Type -> Word64
toWord Exception'Type
v_ = (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Exception'Type -> Int
forall a. Enum a => a -> Int
Std_.fromEnum Exception'Type
v_))
instance (C.Parse Exception'Type Exception'Type) where
    parse :: Raw 'Const Exception'Type -> m Exception'Type
parse  = Raw 'Const Exception'Type -> m Exception'Type
forall a (m :: * -> *).
(ReprFor a ~ 'Data 'Sz16, Enum a, Applicative m) =>
Raw 'Const a -> m a
GH.parseEnum
    encode :: Message ('Mut s)
-> Exception'Type -> m (Raw ('Mut s) Exception'Type)
encode  = Message ('Mut s)
-> Exception'Type -> m (Raw ('Mut s) Exception'Type)
forall a (m :: * -> *) s.
(ReprFor a ~ 'Data 'Sz16, Enum a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Raw ('Mut s) a)
GH.encodeEnum
instance (C.AllocateList Exception'Type) where
    type ListAllocHint Exception'Type = Std_.Int
instance (C.EstimateListAlloc Exception'Type Exception'Type)