{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Capnp.Gen.Capnp.Rpc where
import qualified Capnp.Repr as R
import qualified Capnp.Repr.Parsed as RP
import qualified Capnp.Basics as Basics
import qualified GHC.OverloadedLabels as OL
import qualified Capnp.GenHelpers as GH
import qualified Capnp.Classes as C
import qualified GHC.Generics as Generics
import qualified Prelude as Std_
import qualified Data.Word as Std_
import qualified Data.Int as Std_
import Prelude ((<$>), (<*>), (>>=))
data Message 
type instance (R.ReprFor Message) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Message) where
    typeId :: Word64
typeId  = Word64
10500036013887172658
instance (C.TypedStruct Message) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Message) where
    type AllocHint Message = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Message -> Message ('Mut s) -> m (Raw Message ('Mut s))
new AllocHint Message
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Message (C.Parsed Message))
instance (C.AllocateList Message) where
    type ListAllocHint Message = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Message
-> Message ('Mut s) -> m (Raw (List Message) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc Message (C.Parsed Message))
data instance C.Parsed Message
    = Message 
        {Parsed Message -> Parsed (Which Message)
union' :: (C.Parsed (GH.Which Message))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Message 'Const -> m (Parsed Message)
parse Raw Message 'Const
raw_ = (Parsed (Which Message) -> Parsed Message
Message forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Message 'Const
raw_)))
instance (C.Marshal Message (C.Parsed Message)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Message ('Mut s) -> Parsed Message -> m ()
marshalInto Raw Message ('Mut s)
raw_ Message{Parsed (Which Message)
union' :: Parsed (Which Message)
$sel:union':Message :: Parsed Message -> Parsed (Which Message)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Message ('Mut s)
raw_) Parsed (Which Message)
union')
        )
instance (GH.HasUnion Message) where
    unionField :: Field 'Slot Message Word16
unionField  = (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 Message mut_
        = RW_Message'unimplemented (R.Raw Message mut_)
        | RW_Message'abort (R.Raw Exception mut_)
        | RW_Message'call (R.Raw Call mut_)
        | RW_Message'return (R.Raw Return mut_)
        | RW_Message'finish (R.Raw Finish mut_)
        | RW_Message'resolve (R.Raw Resolve mut_)
        | RW_Message'release (R.Raw Release mut_)
        | RW_Message'obsoleteSave (R.Raw (Std_.Maybe Basics.AnyPointer) mut_)
        | RW_Message'bootstrap (R.Raw Bootstrap mut_)
        | RW_Message'obsoleteDelete (R.Raw (Std_.Maybe Basics.AnyPointer) mut_)
        | RW_Message'provide (R.Raw Provide mut_)
        | RW_Message'accept (R.Raw Accept mut_)
        | RW_Message'join (R.Raw Join mut_)
        | RW_Message'disembargo (R.Raw Disembargo mut_)
        | RW_Message'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw Message mut -> m (RawWhich Message mut)
internalWhich Word16
tag_ Raw Message mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw Message mut_ -> RawWhich Message mut_
RW_Message'unimplemented forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "unimplemented" a => a
#unimplemented Raw Message mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Exception mut_ -> RawWhich Message mut_
RW_Message'abort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "abort" a => a
#abort Raw Message mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability). Raw Call mut_ -> RawWhich Message mut_
RW_Message'call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "call" a => a
#call Raw Message mut
struct_))
        Word16
3 ->
            (forall (mut_ :: Mutability).
Raw Return mut_ -> RawWhich Message mut_
RW_Message'return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "return" a => a
#return Raw Message mut
struct_))
        Word16
4 ->
            (forall (mut_ :: Mutability).
Raw Finish mut_ -> RawWhich Message mut_
RW_Message'finish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "finish" a => a
#finish Raw Message mut
struct_))
        Word16
5 ->
            (forall (mut_ :: Mutability).
Raw Resolve mut_ -> RawWhich Message mut_
RW_Message'resolve forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "resolve" a => a
#resolve Raw Message mut
struct_))
        Word16
6 ->
            (forall (mut_ :: Mutability).
Raw Release mut_ -> RawWhich Message mut_
RW_Message'release forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "release" a => a
#release Raw Message mut
struct_))
        Word16
7 ->
            (forall (mut_ :: Mutability).
Raw (Maybe AnyPointer) mut_ -> RawWhich Message mut_
RW_Message'obsoleteSave forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "obsoleteSave" a => a
#obsoleteSave Raw Message mut
struct_))
        Word16
8 ->
            (forall (mut_ :: Mutability).
Raw Bootstrap mut_ -> RawWhich Message mut_
RW_Message'bootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "bootstrap" a => a
#bootstrap Raw Message mut
struct_))
        Word16
9 ->
            (forall (mut_ :: Mutability).
Raw (Maybe AnyPointer) mut_ -> RawWhich Message mut_
RW_Message'obsoleteDelete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "obsoleteDelete" a => a
#obsoleteDelete Raw Message mut
struct_))
        Word16
10 ->
            (forall (mut_ :: Mutability).
Raw Provide mut_ -> RawWhich Message mut_
RW_Message'provide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "provide" a => a
#provide Raw Message mut
struct_))
        Word16
11 ->
            (forall (mut_ :: Mutability).
Raw Accept mut_ -> RawWhich Message mut_
RW_Message'accept forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "accept" a => a
#accept Raw Message mut
struct_))
        Word16
12 ->
            (forall (mut_ :: Mutability). Raw Join mut_ -> RawWhich Message mut_
RW_Message'join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "join" a => a
#join Raw Message mut
struct_))
        Word16
13 ->
            (forall (mut_ :: Mutability).
Raw Disembargo mut_ -> RawWhich Message mut_
RW_Message'disembargo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "disembargo" a => a
#disembargo Raw Message mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich Message mut_
RW_Message'unknown' Word16
tag_))
    data Which Message
instance (GH.HasVariant "unimplemented" GH.Slot Message Message) where
    variantByLabel :: Variant 'Slot Message Message
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
6)
instance (GH.HasVariant "obsoleteSave" GH.Slot Message (Std_.Maybe Basics.AnyPointer)) where
    variantByLabel :: Variant 'Slot Message (Maybe AnyPointer)
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
8)
instance (GH.HasVariant "obsoleteDelete" GH.Slot Message (Std_.Maybe Basics.AnyPointer)) where
    variantByLabel :: Variant 'Slot Message (Maybe AnyPointer)
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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 (Std_.Maybe Basics.AnyPointer))
    | Message'bootstrap (RP.Parsed Bootstrap)
    | Message'obsoleteDelete (RP.Parsed (Std_.Maybe 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Message) 'Const -> m (Parsed (Which Message))
parse Raw (Which Message) 'Const
raw_ = (do
        RawWhich Message 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Message) 'Const
raw_)
        case RawWhich Message 'Const
rawWhich_ of
            (RW_Message'unimplemented Raw Message 'Const
rawArg_) ->
                (Parsed Message -> Parsed (Which Message)
Message'unimplemented forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Message 'Const
rawArg_))
            (RW_Message'abort Raw Exception 'Const
rawArg_) ->
                (Parsed Exception -> Parsed (Which Message)
Message'abort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Exception 'Const
rawArg_))
            (RW_Message'call Raw Call 'Const
rawArg_) ->
                (Parsed Call -> Parsed (Which Message)
Message'call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Call 'Const
rawArg_))
            (RW_Message'return Raw Return 'Const
rawArg_) ->
                (Parsed Return -> Parsed (Which Message)
Message'return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Return 'Const
rawArg_))
            (RW_Message'finish Raw Finish 'Const
rawArg_) ->
                (Parsed Finish -> Parsed (Which Message)
Message'finish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Finish 'Const
rawArg_))
            (RW_Message'resolve Raw Resolve 'Const
rawArg_) ->
                (Parsed Resolve -> Parsed (Which Message)
Message'resolve forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Resolve 'Const
rawArg_))
            (RW_Message'release Raw Release 'Const
rawArg_) ->
                (Parsed Release -> Parsed (Which Message)
Message'release forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Release 'Const
rawArg_))
            (RW_Message'obsoleteSave Raw (Maybe AnyPointer) 'Const
rawArg_) ->
                (Parsed (Maybe AnyPointer) -> Parsed (Which Message)
Message'obsoleteSave forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (Maybe AnyPointer) 'Const
rawArg_))
            (RW_Message'bootstrap Raw Bootstrap 'Const
rawArg_) ->
                (Parsed Bootstrap -> Parsed (Which Message)
Message'bootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Bootstrap 'Const
rawArg_))
            (RW_Message'obsoleteDelete Raw (Maybe AnyPointer) 'Const
rawArg_) ->
                (Parsed (Maybe AnyPointer) -> Parsed (Which Message)
Message'obsoleteDelete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (Maybe AnyPointer) 'Const
rawArg_))
            (RW_Message'provide Raw Provide 'Const
rawArg_) ->
                (Parsed Provide -> Parsed (Which Message)
Message'provide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Provide 'Const
rawArg_))
            (RW_Message'accept Raw Accept 'Const
rawArg_) ->
                (Parsed Accept -> Parsed (Which Message)
Message'accept forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Accept 'Const
rawArg_))
            (RW_Message'join Raw Join 'Const
rawArg_) ->
                (Parsed Join -> Parsed (Which Message)
Message'join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Join 'Const
rawArg_))
            (RW_Message'disembargo Raw Disembargo 'Const
rawArg_) ->
                (Parsed Disembargo -> Parsed (Which Message)
Message'disembargo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Disembargo 'Const
rawArg_))
            (RW_Message'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Message) ('Mut s) -> Parsed (Which Message) -> m ()
marshalInto Raw (Which Message) ('Mut s)
raw_ Parsed (Which Message)
parsed_ = case Parsed (Which Message)
parsed_ of
        (Message'unimplemented Parsed Message
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "unimplemented" a => a
#unimplemented Parsed Message
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'abort Parsed Exception
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "abort" a => a
#abort Parsed Exception
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'call Parsed Call
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "call" a => a
#call Parsed Call
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'return Parsed Return
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "return" a => a
#return Parsed Return
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'finish Parsed Finish
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "finish" a => a
#finish Parsed Finish
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'resolve Parsed Resolve
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "resolve" a => a
#resolve Parsed Resolve
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'release Parsed Release
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "release" a => a
#release Parsed Release
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'obsoleteSave Parsed (Maybe AnyPointer)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "obsoleteSave" a => a
#obsoleteSave Parsed (Maybe AnyPointer)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'bootstrap Parsed Bootstrap
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "bootstrap" a => a
#bootstrap Parsed Bootstrap
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'obsoleteDelete Parsed (Maybe AnyPointer)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "obsoleteDelete" a => a
#obsoleteDelete Parsed (Maybe AnyPointer)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'provide Parsed Provide
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "provide" a => a
#provide Parsed Provide
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'accept Parsed Accept
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "accept" a => a
#accept Parsed Accept
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'join Parsed Join
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "join" a => a
#join Parsed Join
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'disembargo Parsed Disembargo
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "disembargo" a => a
#disembargo Parsed Disembargo
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
        (Message'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Message) ('Mut s)
raw_))
data Bootstrap 
type instance (R.ReprFor Bootstrap) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Bootstrap) where
    typeId :: Word64
typeId  = Word64
16811039658553601732
instance (C.TypedStruct Bootstrap) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Bootstrap) where
    type AllocHint Bootstrap = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Bootstrap
-> Message ('Mut s) -> m (Raw Bootstrap ('Mut s))
new AllocHint Bootstrap
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Bootstrap (C.Parsed Bootstrap))
instance (C.AllocateList Bootstrap) where
    type ListAllocHint Bootstrap = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Bootstrap
-> Message ('Mut s) -> m (Raw (List Bootstrap) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc Bootstrap (C.Parsed Bootstrap))
data instance C.Parsed Bootstrap
    = Bootstrap 
        {Parsed Bootstrap -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Bootstrap -> Parsed (Maybe AnyPointer)
deprecatedObjectId :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Bootstrap 'Const -> m (Parsed Bootstrap)
parse Raw Bootstrap 'Const
raw_ = (Parsed Word32 -> Parsed (Maybe AnyPointer) -> Parsed Bootstrap
Bootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Bootstrap 'Const
raw_)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "deprecatedObjectId" a => a
#deprecatedObjectId Raw Bootstrap 'Const
raw_))
instance (C.Marshal Bootstrap (C.Parsed Bootstrap)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Bootstrap ('Mut s) -> Parsed Bootstrap -> m ()
marshalInto Raw Bootstrap ('Mut s)
raw_ Bootstrap{Parsed (Maybe AnyPointer)
Parsed Word32
deprecatedObjectId :: Parsed (Maybe AnyPointer)
questionId :: Parsed Word32
$sel:deprecatedObjectId:Bootstrap :: Parsed Bootstrap -> Parsed (Maybe AnyPointer)
$sel:questionId:Bootstrap :: Parsed Bootstrap -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Bootstrap ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "deprecatedObjectId" a => a
#deprecatedObjectId Parsed (Maybe AnyPointer)
deprecatedObjectId Raw Bootstrap ('Mut s)
raw_)
        (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  = (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 (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot Bootstrap (Maybe AnyPointer)
fieldByLabel  = (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.HasTypeId Call) where
    typeId :: Word64
typeId  = Word64
9469473312751832276
instance (C.TypedStruct Call) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
3
instance (C.Allocate Call) where
    type AllocHint Call = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Call -> Message ('Mut s) -> m (Raw Call ('Mut s))
new AllocHint Call
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Call (C.Parsed Call))
instance (C.AllocateList Call) where
    type ListAllocHint Call = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Call
-> Message ('Mut s) -> m (Raw (List Call) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Call 'Const -> m (Parsed Call)
parse Raw Call 'Const
raw_ = (Parsed Word32
-> Parsed MessageTarget
-> Parsed Word64
-> Parsed Word16
-> Parsed Payload
-> Parsed Call'sendResultsTo
-> Parsed Bool
-> Parsed Call
Call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "target" a => a
#target Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "interfaceId" a => a
#interfaceId Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "methodId" a => a
#methodId Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "params" a => a
#params Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "sendResultsTo" a => a
#sendResultsTo Raw Call 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "allowThirdPartyTailCall" a => a
#allowThirdPartyTailCall Raw Call 'Const
raw_))
instance (C.Marshal Call (C.Parsed Call)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Call ('Mut s) -> Parsed Call -> m ()
marshalInto Raw Call ('Mut s)
raw_ Call{Parsed Bool
Parsed Word16
Parsed Word32
Parsed Word64
Parsed Payload
Parsed MessageTarget
Parsed Call'sendResultsTo
allowThirdPartyTailCall :: Parsed Bool
sendResultsTo :: Parsed Call'sendResultsTo
params :: Parsed Payload
methodId :: Parsed Word16
interfaceId :: Parsed Word64
target :: Parsed MessageTarget
questionId :: Parsed Word32
$sel:allowThirdPartyTailCall:Call :: Parsed Call -> Parsed Bool
$sel:sendResultsTo:Call :: Parsed Call -> Parsed Call'sendResultsTo
$sel:params:Call :: Parsed Call -> Parsed Payload
$sel:methodId:Call :: Parsed Call -> Parsed Word16
$sel:interfaceId:Call :: Parsed Call -> Parsed Word64
$sel:target:Call :: Parsed Call -> Parsed MessageTarget
$sel:questionId:Call :: Parsed Call -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Call ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "target" a => a
#target Parsed MessageTarget
target Raw Call ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "interfaceId" a => a
#interfaceId Parsed Word64
interfaceId Raw Call ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "methodId" a => a
#methodId Parsed Word16
methodId Raw Call ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "params" a => a
#params Parsed Payload
params Raw Call ('Mut s)
raw_)
        (do
            Raw Call'sendResultsTo ('Mut s)
group_ <- (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw a mut -> m (Raw b mut)
GH.readField forall a. IsLabel "sendResultsTo" a => a
#sendResultsTo Raw Call ('Mut s)
raw_)
            (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto Raw Call'sendResultsTo ('Mut s)
group_ Parsed Call'sendResultsTo
sendResultsTo)
            )
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "allowThirdPartyTailCall" a => a
#allowThirdPartyTailCall Parsed Bool
allowThirdPartyTailCall Raw Call ('Mut s)
raw_)
        (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  = (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  = (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  = (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  = (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  = (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  = 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  = (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.HasTypeId Call'sendResultsTo) where
    typeId :: Word64
typeId  = Word64
15774052265921044377
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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Call'sendResultsTo
-> Message ('Mut s) -> m (Raw Call'sendResultsTo ('Mut s))
new AllocHint Call'sendResultsTo
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Call'sendResultsTo (C.Parsed Call'sendResultsTo))
instance (C.AllocateList Call'sendResultsTo) where
    type ListAllocHint Call'sendResultsTo = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Call'sendResultsTo
-> Message ('Mut s) -> m (Raw (List Call'sendResultsTo) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Call'sendResultsTo 'Const -> m (Parsed Call'sendResultsTo)
parse Raw Call'sendResultsTo 'Const
raw_ = (Parsed (Which Call'sendResultsTo) -> Parsed Call'sendResultsTo
Call'sendResultsTo' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Call'sendResultsTo 'Const
raw_)))
instance (C.Marshal Call'sendResultsTo (C.Parsed Call'sendResultsTo)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Call'sendResultsTo ('Mut s)
-> Parsed Call'sendResultsTo -> m ()
marshalInto Raw Call'sendResultsTo ('Mut s)
raw_ Call'sendResultsTo'{Parsed (Which Call'sendResultsTo)
union' :: Parsed (Which Call'sendResultsTo)
$sel:union':Call'sendResultsTo' :: Parsed Call'sendResultsTo -> Parsed (Which Call'sendResultsTo)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Call'sendResultsTo ('Mut s)
raw_) Parsed (Which Call'sendResultsTo)
union')
        )
instance (GH.HasUnion Call'sendResultsTo) where
    unionField :: Field 'Slot Call'sendResultsTo Word16
unionField  = (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 Call'sendResultsTo mut_
        = RW_Call'sendResultsTo'caller (R.Raw () mut_)
        | RW_Call'sendResultsTo'yourself (R.Raw () mut_)
        | RW_Call'sendResultsTo'thirdParty (R.Raw (Std_.Maybe Basics.AnyPointer) mut_)
        | RW_Call'sendResultsTo'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16
-> Raw Call'sendResultsTo mut
-> m (RawWhich Call'sendResultsTo mut)
internalWhich Word16
tag_ Raw Call'sendResultsTo mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw () mut_ -> RawWhich Call'sendResultsTo mut_
RW_Call'sendResultsTo'caller forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "caller" a => a
#caller Raw Call'sendResultsTo mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw () mut_ -> RawWhich Call'sendResultsTo mut_
RW_Call'sendResultsTo'yourself forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "yourself" a => a
#yourself Raw Call'sendResultsTo mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability).
Raw (Maybe AnyPointer) mut_ -> RawWhich Call'sendResultsTo mut_
RW_Call'sendResultsTo'thirdParty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "thirdParty" a => a
#thirdParty Raw Call'sendResultsTo mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability).
Word16 -> RawWhich Call'sendResultsTo mut_
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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
1)
instance (GH.HasVariant "thirdParty" GH.Slot Call'sendResultsTo (Std_.Maybe Basics.AnyPointer)) where
    variantByLabel :: Variant 'Slot Call'sendResultsTo (Maybe AnyPointer)
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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 (Std_.Maybe Basics.AnyPointer))
    | Call'sendResultsTo'unknown' Std_.Word16
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Call'sendResultsTo) 'Const
-> m (Parsed (Which Call'sendResultsTo))
parse Raw (Which Call'sendResultsTo) 'Const
raw_ = (do
        RawWhich Call'sendResultsTo 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Call'sendResultsTo) 'Const
raw_)
        case RawWhich Call'sendResultsTo 'Const
rawWhich_ of
            (RW_Call'sendResultsTo'caller Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'caller)
            (RW_Call'sendResultsTo'yourself Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'yourself)
            (RW_Call'sendResultsTo'thirdParty Raw (Maybe AnyPointer) 'Const
rawArg_) ->
                (Parsed (Maybe AnyPointer) -> Parsed (Which Call'sendResultsTo)
Call'sendResultsTo'thirdParty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (Maybe AnyPointer) 'Const
rawArg_))
            (RW_Call'sendResultsTo'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Call'sendResultsTo) ('Mut s)
-> Parsed (Which Call'sendResultsTo) -> m ()
marshalInto Raw (Which Call'sendResultsTo) ('Mut s)
raw_ Parsed (Which Call'sendResultsTo)
parsed_ = case Parsed (Which Call'sendResultsTo)
parsed_ of
        (Parsed (Which Call'sendResultsTo)
R:ParsedWhich
Call'sendResultsTo'caller) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "caller" a => a
#caller () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Call'sendResultsTo) ('Mut s)
raw_))
        (Parsed (Which Call'sendResultsTo)
R:ParsedWhich
Call'sendResultsTo'yourself) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "yourself" a => a
#yourself () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Call'sendResultsTo) ('Mut s)
raw_))
        (Call'sendResultsTo'thirdParty Parsed (Maybe AnyPointer)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "thirdParty" a => a
#thirdParty Parsed (Maybe AnyPointer)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Call'sendResultsTo) ('Mut s)
raw_))
        (Call'sendResultsTo'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Call'sendResultsTo) ('Mut s)
raw_))
data Return 
type instance (R.ReprFor Return) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Return) where
    typeId :: Word64
typeId  = Word64
11392333052105676602
instance (C.TypedStruct Return) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Return) where
    type AllocHint Return = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Return -> Message ('Mut s) -> m (Raw Return ('Mut s))
new AllocHint Return
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Return (C.Parsed Return))
instance (C.AllocateList Return) where
    type ListAllocHint Return = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Return
-> Message ('Mut s) -> m (Raw (List Return) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Return 'Const -> m (Parsed Return)
parse Raw Return 'Const
raw_ = (Parsed Word32
-> Parsed Bool -> Parsed (Which Return) -> Parsed Return
Return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "answerId" a => a
#answerId Raw Return 'Const
raw_)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "releaseParamCaps" a => a
#releaseParamCaps Raw Return 'Const
raw_)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Return 'Const
raw_)))
instance (C.Marshal Return (C.Parsed Return)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Return ('Mut s) -> Parsed Return -> m ()
marshalInto Raw Return ('Mut s)
raw_ Return{Parsed (Which Return)
Parsed Bool
Parsed Word32
union' :: Parsed (Which Return)
releaseParamCaps :: Parsed Bool
answerId :: Parsed Word32
$sel:union':Return :: Parsed Return -> Parsed (Which Return)
$sel:releaseParamCaps:Return :: Parsed Return -> Parsed Bool
$sel:answerId:Return :: Parsed Return -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "answerId" a => a
#answerId Parsed Word32
answerId Raw Return ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "releaseParamCaps" a => a
#releaseParamCaps Parsed Bool
releaseParamCaps Raw Return ('Mut s)
raw_)
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Return ('Mut s)
raw_) Parsed (Which Return)
union')
        )
instance (GH.HasUnion Return) where
    unionField :: Field 'Slot Return Word16
unionField  = (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 Return mut_
        = RW_Return'results (R.Raw Payload mut_)
        | RW_Return'exception (R.Raw Exception mut_)
        | RW_Return'canceled (R.Raw () mut_)
        | RW_Return'resultsSentElsewhere (R.Raw () mut_)
        | RW_Return'takeFromOtherQuestion (R.Raw Std_.Word32 mut_)
        | RW_Return'acceptFromThirdParty (R.Raw (Std_.Maybe Basics.AnyPointer) mut_)
        | RW_Return'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw Return mut -> m (RawWhich Return mut)
internalWhich Word16
tag_ Raw Return mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw Payload mut_ -> RawWhich Return mut_
RW_Return'results forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "results" a => a
#results Raw Return mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Exception mut_ -> RawWhich Return mut_
RW_Return'exception forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "exception" a => a
#exception Raw Return mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability). Raw () mut_ -> RawWhich Return mut_
RW_Return'canceled forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "canceled" a => a
#canceled Raw Return mut
struct_))
        Word16
3 ->
            (forall (mut_ :: Mutability). Raw () mut_ -> RawWhich Return mut_
RW_Return'resultsSentElsewhere forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "resultsSentElsewhere" a => a
#resultsSentElsewhere Raw Return mut
struct_))
        Word16
4 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich Return mut_
RW_Return'takeFromOtherQuestion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "takeFromOtherQuestion" a => a
#takeFromOtherQuestion Raw Return mut
struct_))
        Word16
5 ->
            (forall (mut_ :: Mutability).
Raw (Maybe AnyPointer) mut_ -> RawWhich Return mut_
RW_Return'acceptFromThirdParty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "acceptFromThirdParty" a => a
#acceptFromThirdParty Raw Return mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich Return mut_
RW_Return'unknown' Word16
tag_))
    data Which Return
instance (GH.HasVariant "results" GH.Slot Return Payload) where
    variantByLabel :: Variant 'Slot Return Payload
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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 (Std_.Maybe Basics.AnyPointer)) where
    variantByLabel :: Variant 'Slot Return (Maybe AnyPointer)
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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 (Std_.Maybe Basics.AnyPointer))
    | Return'unknown' Std_.Word16
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Return) 'Const -> m (Parsed (Which Return))
parse Raw (Which Return) 'Const
raw_ = (do
        RawWhich Return 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Return) 'Const
raw_)
        case RawWhich Return 'Const
rawWhich_ of
            (RW_Return'results Raw Payload 'Const
rawArg_) ->
                (Parsed Payload -> Parsed (Which Return)
Return'results forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Payload 'Const
rawArg_))
            (RW_Return'exception Raw Exception 'Const
rawArg_) ->
                (Parsed Exception -> Parsed (Which Return)
Return'exception forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Exception 'Const
rawArg_))
            (RW_Return'canceled Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Return)
Return'canceled)
            (RW_Return'resultsSentElsewhere Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Return)
Return'resultsSentElsewhere)
            (RW_Return'takeFromOtherQuestion Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which Return)
Return'takeFromOtherQuestion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_Return'acceptFromThirdParty Raw (Maybe AnyPointer) 'Const
rawArg_) ->
                (Parsed (Maybe AnyPointer) -> Parsed (Which Return)
Return'acceptFromThirdParty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw (Maybe AnyPointer) 'Const
rawArg_))
            (RW_Return'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Return) ('Mut s) -> Parsed (Which Return) -> m ()
marshalInto Raw (Which Return) ('Mut s)
raw_ Parsed (Which Return)
parsed_ = case Parsed (Which Return)
parsed_ of
        (Return'results Parsed Payload
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "results" a => a
#results Parsed Payload
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Return'exception Parsed Exception
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "exception" a => a
#exception Parsed Exception
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Parsed (Which Return)
R:ParsedWhich11
Return'canceled) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "canceled" a => a
#canceled () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Parsed (Which Return)
R:ParsedWhich11
Return'resultsSentElsewhere) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "resultsSentElsewhere" a => a
#resultsSentElsewhere () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Return'takeFromOtherQuestion Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "takeFromOtherQuestion" a => a
#takeFromOtherQuestion Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Return'acceptFromThirdParty Parsed (Maybe AnyPointer)
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "acceptFromThirdParty" a => a
#acceptFromThirdParty Parsed (Maybe AnyPointer)
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
        (Return'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Return) ('Mut s)
raw_))
instance (GH.HasField "answerId" GH.Slot Return Std_.Word32) where
    fieldByLabel :: Field 'Slot Return Word32
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
32 Word64
0)
instance (GH.HasField "releaseParamCaps" GH.Slot Return Std_.Bool) where
    fieldByLabel :: Field 'Slot Return Bool
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
32 Word16
0 BitCount
1 Word64
1)
data Finish 
type instance (R.ReprFor Finish) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Finish) where
    typeId :: Word64
typeId  = Word64
15239388059401719395
instance (C.TypedStruct Finish) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate Finish) where
    type AllocHint Finish = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Finish -> Message ('Mut s) -> m (Raw Finish ('Mut s))
new AllocHint Finish
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Finish (C.Parsed Finish))
instance (C.AllocateList Finish) where
    type ListAllocHint Finish = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Finish
-> Message ('Mut s) -> m (Raw (List Finish) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Finish 'Const -> m (Parsed Finish)
parse Raw Finish 'Const
raw_ = (Parsed Word32 -> Parsed Bool -> Parsed Finish
Finish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Finish 'Const
raw_)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "releaseResultCaps" a => a
#releaseResultCaps Raw Finish 'Const
raw_))
instance (C.Marshal Finish (C.Parsed Finish)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Finish ('Mut s) -> Parsed Finish -> m ()
marshalInto Raw Finish ('Mut s)
raw_ Finish{Parsed Bool
Parsed Word32
releaseResultCaps :: Parsed Bool
questionId :: Parsed Word32
$sel:releaseResultCaps:Finish :: Parsed Finish -> Parsed Bool
$sel:questionId:Finish :: Parsed Finish -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Finish ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "releaseResultCaps" a => a
#releaseResultCaps Parsed Bool
releaseResultCaps Raw Finish ('Mut s)
raw_)
        (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  = (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  = (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.HasTypeId Resolve) where
    typeId :: Word64
typeId  = Word64
13529541526594062446
instance (C.TypedStruct Resolve) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Resolve) where
    type AllocHint Resolve = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Resolve -> Message ('Mut s) -> m (Raw Resolve ('Mut s))
new AllocHint Resolve
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Resolve (C.Parsed Resolve))
instance (C.AllocateList Resolve) where
    type ListAllocHint Resolve = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Resolve
-> Message ('Mut s) -> m (Raw (List Resolve) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Resolve 'Const -> m (Parsed Resolve)
parse Raw Resolve 'Const
raw_ = (Parsed Word32 -> Parsed (Which Resolve) -> Parsed Resolve
Resolve forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "promiseId" a => a
#promiseId Raw Resolve 'Const
raw_)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Resolve 'Const
raw_)))
instance (C.Marshal Resolve (C.Parsed Resolve)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Resolve ('Mut s) -> Parsed Resolve -> m ()
marshalInto Raw Resolve ('Mut s)
raw_ Resolve{Parsed (Which Resolve)
Parsed Word32
union' :: Parsed (Which Resolve)
promiseId :: Parsed Word32
$sel:union':Resolve :: Parsed Resolve -> Parsed (Which Resolve)
$sel:promiseId:Resolve :: Parsed Resolve -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "promiseId" a => a
#promiseId Parsed Word32
promiseId Raw Resolve ('Mut s)
raw_)
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Resolve ('Mut s)
raw_) Parsed (Which Resolve)
union')
        )
instance (GH.HasUnion Resolve) where
    unionField :: Field 'Slot Resolve Word16
unionField  = (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 Resolve mut_
        = RW_Resolve'cap (R.Raw CapDescriptor mut_)
        | RW_Resolve'exception (R.Raw Exception mut_)
        | RW_Resolve'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw Resolve mut -> m (RawWhich Resolve mut)
internalWhich Word16
tag_ Raw Resolve mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw CapDescriptor mut_ -> RawWhich Resolve mut_
RW_Resolve'cap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "cap" a => a
#cap Raw Resolve mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Exception mut_ -> RawWhich Resolve mut_
RW_Resolve'exception forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "exception" a => a
#exception Raw Resolve mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich Resolve mut_
RW_Resolve'unknown' Word16
tag_))
    data Which Resolve
instance (GH.HasVariant "cap" GH.Slot Resolve CapDescriptor) where
    variantByLabel :: Variant 'Slot Resolve CapDescriptor
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Resolve) 'Const -> m (Parsed (Which Resolve))
parse Raw (Which Resolve) 'Const
raw_ = (do
        RawWhich Resolve 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Resolve) 'Const
raw_)
        case RawWhich Resolve 'Const
rawWhich_ of
            (RW_Resolve'cap Raw CapDescriptor 'Const
rawArg_) ->
                (Parsed CapDescriptor -> Parsed (Which Resolve)
Resolve'cap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw CapDescriptor 'Const
rawArg_))
            (RW_Resolve'exception Raw Exception 'Const
rawArg_) ->
                (Parsed Exception -> Parsed (Which Resolve)
Resolve'exception forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Exception 'Const
rawArg_))
            (RW_Resolve'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Resolve) ('Mut s) -> Parsed (Which Resolve) -> m ()
marshalInto Raw (Which Resolve) ('Mut s)
raw_ Parsed (Which Resolve)
parsed_ = case Parsed (Which Resolve)
parsed_ of
        (Resolve'cap Parsed CapDescriptor
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "cap" a => a
#cap Parsed CapDescriptor
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Resolve) ('Mut s)
raw_))
        (Resolve'exception Parsed Exception
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "exception" a => a
#exception Parsed Exception
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Resolve) ('Mut s)
raw_))
        (Resolve'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Resolve) ('Mut s)
raw_))
instance (GH.HasField "promiseId" GH.Slot Resolve Std_.Word32) where
    fieldByLabel :: Field 'Slot Resolve Word32
fieldByLabel  = (forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
32 Word64
0)
data Release 
type instance (R.ReprFor Release) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Release) where
    typeId :: Word64
typeId  = Word64
12473400923157197975
instance (C.TypedStruct Release) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate Release) where
    type AllocHint Release = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Release -> Message ('Mut s) -> m (Raw Release ('Mut s))
new AllocHint Release
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Release (C.Parsed Release))
instance (C.AllocateList Release) where
    type ListAllocHint Release = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Release
-> Message ('Mut s) -> m (Raw (List Release) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Release 'Const -> m (Parsed Release)
parse Raw Release 'Const
raw_ = (Parsed Word32 -> Parsed Word32 -> Parsed Release
Release forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "id" a => a
#id Raw Release 'Const
raw_)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "referenceCount" a => a
#referenceCount Raw Release 'Const
raw_))
instance (C.Marshal Release (C.Parsed Release)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Release ('Mut s) -> Parsed Release -> m ()
marshalInto Raw Release ('Mut s)
raw_ Release{Parsed Word32
referenceCount :: Parsed Word32
id :: Parsed Word32
$sel:referenceCount:Release :: Parsed Release -> Parsed Word32
$sel:id:Release :: Parsed Release -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "id" a => a
#id Parsed Word32
id Raw Release ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "referenceCount" a => a
#referenceCount Parsed Word32
referenceCount Raw Release ('Mut s)
raw_)
        (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  = (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  = (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.HasTypeId Disembargo) where
    typeId :: Word64
typeId  = Word64
17970548384007534353
instance (C.TypedStruct Disembargo) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Disembargo) where
    type AllocHint Disembargo = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Disembargo
-> Message ('Mut s) -> m (Raw Disembargo ('Mut s))
new AllocHint Disembargo
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Disembargo (C.Parsed Disembargo))
instance (C.AllocateList Disembargo) where
    type ListAllocHint Disembargo = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Disembargo
-> Message ('Mut s) -> m (Raw (List Disembargo) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Disembargo 'Const -> m (Parsed Disembargo)
parse Raw Disembargo 'Const
raw_ = (Parsed MessageTarget
-> Parsed Disembargo'context -> Parsed Disembargo
Disembargo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "target" a => a
#target Raw Disembargo 'Const
raw_)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "context" a => a
#context Raw Disembargo 'Const
raw_))
instance (C.Marshal Disembargo (C.Parsed Disembargo)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Disembargo ('Mut s) -> Parsed Disembargo -> m ()
marshalInto Raw Disembargo ('Mut s)
raw_ Disembargo{Parsed MessageTarget
Parsed Disembargo'context
context :: Parsed Disembargo'context
target :: Parsed MessageTarget
$sel:context:Disembargo :: Parsed Disembargo -> Parsed Disembargo'context
$sel:target:Disembargo :: Parsed Disembargo -> Parsed MessageTarget
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "target" a => a
#target Parsed MessageTarget
target Raw Disembargo ('Mut s)
raw_)
        (do
            Raw Disembargo'context ('Mut s)
group_ <- (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw a mut -> m (Raw b mut)
GH.readField forall a. IsLabel "context" a => a
#context Raw Disembargo ('Mut s)
raw_)
            (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto Raw Disembargo'context ('Mut s)
group_ Parsed Disembargo'context
context)
            )
        (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  = (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  = 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.HasTypeId Disembargo'context) where
    typeId :: Word64
typeId  = Word64
15376050949367520589
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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Disembargo'context
-> Message ('Mut s) -> m (Raw Disembargo'context ('Mut s))
new AllocHint Disembargo'context
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Disembargo'context (C.Parsed Disembargo'context))
instance (C.AllocateList Disembargo'context) where
    type ListAllocHint Disembargo'context = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Disembargo'context
-> Message ('Mut s) -> m (Raw (List Disembargo'context) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Disembargo'context 'Const -> m (Parsed Disembargo'context)
parse Raw Disembargo'context 'Const
raw_ = (Parsed (Which Disembargo'context) -> Parsed Disembargo'context
Disembargo'context' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Disembargo'context 'Const
raw_)))
instance (C.Marshal Disembargo'context (C.Parsed Disembargo'context)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Disembargo'context ('Mut s)
-> Parsed Disembargo'context -> m ()
marshalInto Raw Disembargo'context ('Mut s)
raw_ Disembargo'context'{Parsed (Which Disembargo'context)
union' :: Parsed (Which Disembargo'context)
$sel:union':Disembargo'context' :: Parsed Disembargo'context -> Parsed (Which Disembargo'context)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw Disembargo'context ('Mut s)
raw_) Parsed (Which Disembargo'context)
union')
        )
instance (GH.HasUnion Disembargo'context) where
    unionField :: Field 'Slot Disembargo'context Word16
unionField  = (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 Disembargo'context mut_
        = RW_Disembargo'context'senderLoopback (R.Raw Std_.Word32 mut_)
        | RW_Disembargo'context'receiverLoopback (R.Raw Std_.Word32 mut_)
        | RW_Disembargo'context'accept (R.Raw () mut_)
        | RW_Disembargo'context'provide (R.Raw Std_.Word32 mut_)
        | RW_Disembargo'context'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16
-> Raw Disembargo'context mut
-> m (RawWhich Disembargo'context mut)
internalWhich Word16
tag_ Raw Disembargo'context mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich Disembargo'context mut_
RW_Disembargo'context'senderLoopback forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "senderLoopback" a => a
#senderLoopback Raw Disembargo'context mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich Disembargo'context mut_
RW_Disembargo'context'receiverLoopback forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "receiverLoopback" a => a
#receiverLoopback Raw Disembargo'context mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability).
Raw () mut_ -> RawWhich Disembargo'context mut_
RW_Disembargo'context'accept forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "accept" a => a
#accept Raw Disembargo'context mut
struct_))
        Word16
3 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich Disembargo'context mut_
RW_Disembargo'context'provide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "provide" a => a
#provide Raw Disembargo'context mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability).
Word16 -> RawWhich Disembargo'context mut_
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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which Disembargo'context) 'Const
-> m (Parsed (Which Disembargo'context))
parse Raw (Which Disembargo'context) 'Const
raw_ = (do
        RawWhich Disembargo'context 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which Disembargo'context) 'Const
raw_)
        case RawWhich Disembargo'context 'Const
rawWhich_ of
            (RW_Disembargo'context'senderLoopback Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'senderLoopback forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_Disembargo'context'receiverLoopback Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'receiverLoopback forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_Disembargo'context'accept Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Disembargo'context)
Disembargo'context'accept)
            (RW_Disembargo'context'provide Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which Disembargo'context)
Disembargo'context'provide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_Disembargo'context'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which Disembargo'context) ('Mut s)
-> Parsed (Which Disembargo'context) -> m ()
marshalInto Raw (Which Disembargo'context) ('Mut s)
raw_ Parsed (Which Disembargo'context)
parsed_ = case Parsed (Which Disembargo'context)
parsed_ of
        (Disembargo'context'senderLoopback Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "senderLoopback" a => a
#senderLoopback Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Disembargo'context) ('Mut s)
raw_))
        (Disembargo'context'receiverLoopback Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "receiverLoopback" a => a
#receiverLoopback Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Disembargo'context) ('Mut s)
raw_))
        (Parsed (Which Disembargo'context)
R:ParsedWhich1
Disembargo'context'accept) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "accept" a => a
#accept () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Disembargo'context) ('Mut s)
raw_))
        (Disembargo'context'provide Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "provide" a => a
#provide Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Disembargo'context) ('Mut s)
raw_))
        (Disembargo'context'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which Disembargo'context) ('Mut s)
raw_))
data Provide 
type instance (R.ReprFor Provide) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Provide) where
    typeId :: Word64
typeId  = Word64
11270825879279873114
instance (C.TypedStruct Provide) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Provide) where
    type AllocHint Provide = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Provide -> Message ('Mut s) -> m (Raw Provide ('Mut s))
new AllocHint Provide
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Provide (C.Parsed Provide))
instance (C.AllocateList Provide) where
    type ListAllocHint Provide = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Provide
-> Message ('Mut s) -> m (Raw (List Provide) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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 (Maybe AnyPointer)
recipient :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Provide 'Const -> m (Parsed Provide)
parse Raw Provide 'Const
raw_ = (Parsed Word32
-> Parsed MessageTarget
-> Parsed (Maybe AnyPointer)
-> Parsed Provide
Provide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Provide 'Const
raw_)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "target" a => a
#target Raw Provide 'Const
raw_)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "recipient" a => a
#recipient Raw Provide 'Const
raw_))
instance (C.Marshal Provide (C.Parsed Provide)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Provide ('Mut s) -> Parsed Provide -> m ()
marshalInto Raw Provide ('Mut s)
raw_ Provide{Parsed (Maybe AnyPointer)
Parsed Word32
Parsed MessageTarget
recipient :: Parsed (Maybe AnyPointer)
target :: Parsed MessageTarget
questionId :: Parsed Word32
$sel:recipient:Provide :: Parsed Provide -> Parsed (Maybe AnyPointer)
$sel:target:Provide :: Parsed Provide -> Parsed MessageTarget
$sel:questionId:Provide :: Parsed Provide -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Provide ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "target" a => a
#target Parsed MessageTarget
target Raw Provide ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "recipient" a => a
#recipient Parsed (Maybe AnyPointer)
recipient Raw Provide ('Mut s)
raw_)
        (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  = (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  = (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "recipient" GH.Slot Provide (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot Provide (Maybe AnyPointer)
fieldByLabel  = (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.HasTypeId Accept) where
    typeId :: Word64
typeId  = Word64
15332985841292492822
instance (C.TypedStruct Accept) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Accept) where
    type AllocHint Accept = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Accept -> Message ('Mut s) -> m (Raw Accept ('Mut s))
new AllocHint Accept
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Accept (C.Parsed Accept))
instance (C.AllocateList Accept) where
    type ListAllocHint Accept = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Accept
-> Message ('Mut s) -> m (Raw (List Accept) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc Accept (C.Parsed Accept))
data instance C.Parsed Accept
    = Accept 
        {Parsed Accept -> Parsed Word32
questionId :: (RP.Parsed Std_.Word32)
        ,Parsed Accept -> Parsed (Maybe AnyPointer)
provision :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))
        ,Parsed Accept -> Parsed Bool
embargo :: (RP.Parsed Std_.Bool)}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Accept 'Const -> m (Parsed Accept)
parse Raw Accept 'Const
raw_ = (Parsed Word32
-> Parsed (Maybe AnyPointer) -> Parsed Bool -> Parsed Accept
Accept forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Accept 'Const
raw_)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "provision" a => a
#provision Raw Accept 'Const
raw_)
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "embargo" a => a
#embargo Raw Accept 'Const
raw_))
instance (C.Marshal Accept (C.Parsed Accept)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Accept ('Mut s) -> Parsed Accept -> m ()
marshalInto Raw Accept ('Mut s)
raw_ Accept{Parsed Bool
Parsed (Maybe AnyPointer)
Parsed Word32
embargo :: Parsed Bool
provision :: Parsed (Maybe AnyPointer)
questionId :: Parsed Word32
$sel:embargo:Accept :: Parsed Accept -> Parsed Bool
$sel:provision:Accept :: Parsed Accept -> Parsed (Maybe AnyPointer)
$sel:questionId:Accept :: Parsed Accept -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Accept ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "provision" a => a
#provision Parsed (Maybe AnyPointer)
provision Raw Accept ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "embargo" a => a
#embargo Parsed Bool
embargo Raw Accept ('Mut s)
raw_)
        (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  = (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 (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot Accept (Maybe AnyPointer)
fieldByLabel  = (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  = (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.HasTypeId Join) where
    typeId :: Word64
typeId  = Word64
18149955118657700271
instance (C.TypedStruct Join) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Join) where
    type AllocHint Join = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Join -> Message ('Mut s) -> m (Raw Join ('Mut s))
new AllocHint Join
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Join (C.Parsed Join))
instance (C.AllocateList Join) where
    type ListAllocHint Join = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Join
-> Message ('Mut s) -> m (Raw (List Join) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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 (Maybe AnyPointer)
keyPart :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Join 'Const -> m (Parsed Join)
parse Raw Join 'Const
raw_ = (Parsed Word32
-> Parsed MessageTarget -> Parsed (Maybe AnyPointer) -> Parsed Join
Join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw Join 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "target" a => a
#target Raw Join 'Const
raw_)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "keyPart" a => a
#keyPart Raw Join 'Const
raw_))
instance (C.Marshal Join (C.Parsed Join)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Join ('Mut s) -> Parsed Join -> m ()
marshalInto Raw Join ('Mut s)
raw_ Join{Parsed (Maybe AnyPointer)
Parsed Word32
Parsed MessageTarget
keyPart :: Parsed (Maybe AnyPointer)
target :: Parsed MessageTarget
questionId :: Parsed Word32
$sel:keyPart:Join :: Parsed Join -> Parsed (Maybe AnyPointer)
$sel:target:Join :: Parsed Join -> Parsed MessageTarget
$sel:questionId:Join :: Parsed Join -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw Join ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "target" a => a
#target Parsed MessageTarget
target Raw Join ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "keyPart" a => a
#keyPart Parsed (Maybe AnyPointer)
keyPart Raw Join ('Mut s)
raw_)
        (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  = (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  = (forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "keyPart" GH.Slot Join (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot Join (Maybe AnyPointer)
fieldByLabel  = (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.HasTypeId MessageTarget) where
    typeId :: Word64
typeId  = Word64
10789521159760378817
instance (C.TypedStruct MessageTarget) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate MessageTarget) where
    type AllocHint MessageTarget = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint MessageTarget
-> Message ('Mut s) -> m (Raw MessageTarget ('Mut s))
new AllocHint MessageTarget
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc MessageTarget (C.Parsed MessageTarget))
instance (C.AllocateList MessageTarget) where
    type ListAllocHint MessageTarget = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint MessageTarget
-> Message ('Mut s) -> m (Raw (List MessageTarget) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc MessageTarget (C.Parsed MessageTarget))
data instance C.Parsed MessageTarget
    = MessageTarget 
        {Parsed MessageTarget -> Parsed (Which MessageTarget)
union' :: (C.Parsed (GH.Which MessageTarget))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw MessageTarget 'Const -> m (Parsed MessageTarget)
parse Raw MessageTarget 'Const
raw_ = (Parsed (Which MessageTarget) -> Parsed MessageTarget
MessageTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw MessageTarget 'Const
raw_)))
instance (C.Marshal MessageTarget (C.Parsed MessageTarget)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw MessageTarget ('Mut s) -> Parsed MessageTarget -> m ()
marshalInto Raw MessageTarget ('Mut s)
raw_ MessageTarget{Parsed (Which MessageTarget)
union' :: Parsed (Which MessageTarget)
$sel:union':MessageTarget :: Parsed MessageTarget -> Parsed (Which MessageTarget)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw MessageTarget ('Mut s)
raw_) Parsed (Which MessageTarget)
union')
        )
instance (GH.HasUnion MessageTarget) where
    unionField :: Field 'Slot MessageTarget Word16
unionField  = (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 MessageTarget mut_
        = RW_MessageTarget'importedCap (R.Raw Std_.Word32 mut_)
        | RW_MessageTarget'promisedAnswer (R.Raw PromisedAnswer mut_)
        | RW_MessageTarget'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw MessageTarget mut -> m (RawWhich MessageTarget mut)
internalWhich Word16
tag_ Raw MessageTarget mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich MessageTarget mut_
RW_MessageTarget'importedCap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "importedCap" a => a
#importedCap Raw MessageTarget mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw PromisedAnswer mut_ -> RawWhich MessageTarget mut_
RW_MessageTarget'promisedAnswer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "promisedAnswer" a => a
#promisedAnswer Raw MessageTarget mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich MessageTarget mut_
RW_MessageTarget'unknown' Word16
tag_))
    data Which MessageTarget
instance (GH.HasVariant "importedCap" GH.Slot MessageTarget Std_.Word32) where
    variantByLabel :: Variant 'Slot MessageTarget Word32
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which MessageTarget) 'Const
-> m (Parsed (Which MessageTarget))
parse Raw (Which MessageTarget) 'Const
raw_ = (do
        RawWhich MessageTarget 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which MessageTarget) 'Const
raw_)
        case RawWhich MessageTarget 'Const
rawWhich_ of
            (RW_MessageTarget'importedCap Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which MessageTarget)
MessageTarget'importedCap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_MessageTarget'promisedAnswer Raw PromisedAnswer 'Const
rawArg_) ->
                (Parsed PromisedAnswer -> Parsed (Which MessageTarget)
MessageTarget'promisedAnswer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw PromisedAnswer 'Const
rawArg_))
            (RW_MessageTarget'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which MessageTarget) ('Mut s)
-> Parsed (Which MessageTarget) -> m ()
marshalInto Raw (Which MessageTarget) ('Mut s)
raw_ Parsed (Which MessageTarget)
parsed_ = case Parsed (Which MessageTarget)
parsed_ of
        (MessageTarget'importedCap Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "importedCap" a => a
#importedCap Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which MessageTarget) ('Mut s)
raw_))
        (MessageTarget'promisedAnswer Parsed PromisedAnswer
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "promisedAnswer" a => a
#promisedAnswer Parsed PromisedAnswer
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which MessageTarget) ('Mut s)
raw_))
        (MessageTarget'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which MessageTarget) ('Mut s)
raw_))
data Payload 
type instance (R.ReprFor Payload) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId Payload) where
    typeId :: Word64
typeId  = Word64
11100916931204903995
instance (C.TypedStruct Payload) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Payload) where
    type AllocHint Payload = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Payload -> Message ('Mut s) -> m (Raw Payload ('Mut s))
new AllocHint Payload
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Payload (C.Parsed Payload))
instance (C.AllocateList Payload) where
    type ListAllocHint Payload = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Payload
-> Message ('Mut s) -> m (Raw (List Payload) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc Payload (C.Parsed Payload))
data instance C.Parsed Payload
    = Payload 
        {Parsed Payload -> Parsed (Maybe AnyPointer)
content :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))
        ,Parsed Payload -> Parsed (List CapDescriptor)
capTable :: (RP.Parsed (R.List CapDescriptor))}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Payload 'Const -> m (Parsed Payload)
parse Raw Payload 'Const
raw_ = (Parsed (Maybe AnyPointer)
-> Parsed (List CapDescriptor) -> Parsed Payload
Payload forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "content" a => a
#content Raw Payload 'Const
raw_)
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "capTable" a => a
#capTable Raw Payload 'Const
raw_))
instance (C.Marshal Payload (C.Parsed Payload)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Payload ('Mut s) -> Parsed Payload -> m ()
marshalInto Raw Payload ('Mut s)
raw_ Payload{Parsed (Maybe AnyPointer)
Parsed (List CapDescriptor)
capTable :: Parsed (List CapDescriptor)
content :: Parsed (Maybe AnyPointer)
$sel:capTable:Payload :: Parsed Payload -> Parsed (List CapDescriptor)
$sel:content:Payload :: Parsed Payload -> Parsed (Maybe AnyPointer)
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "content" a => a
#content Parsed (Maybe AnyPointer)
content Raw Payload ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "capTable" a => a
#capTable Parsed (List CapDescriptor)
capTable Raw Payload ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "content" GH.Slot Payload (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot Payload (Maybe AnyPointer)
fieldByLabel  = (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  = (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.HasTypeId CapDescriptor) where
    typeId :: Word64
typeId  = Word64
9593755465305995440
instance (C.TypedStruct CapDescriptor) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate CapDescriptor) where
    type AllocHint CapDescriptor = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint CapDescriptor
-> Message ('Mut s) -> m (Raw CapDescriptor ('Mut s))
new AllocHint CapDescriptor
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc CapDescriptor (C.Parsed CapDescriptor))
instance (C.AllocateList CapDescriptor) where
    type ListAllocHint CapDescriptor = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint CapDescriptor
-> Message ('Mut s) -> m (Raw (List CapDescriptor) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw CapDescriptor 'Const -> m (Parsed CapDescriptor)
parse Raw CapDescriptor 'Const
raw_ = (Parsed Word8
-> Parsed (Which CapDescriptor) -> Parsed CapDescriptor
CapDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "attachedFd" a => a
#attachedFd Raw CapDescriptor 'Const
raw_)
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw CapDescriptor 'Const
raw_)))
instance (C.Marshal CapDescriptor (C.Parsed CapDescriptor)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw CapDescriptor ('Mut s) -> Parsed CapDescriptor -> m ()
marshalInto Raw CapDescriptor ('Mut s)
raw_ CapDescriptor{Parsed (Which CapDescriptor)
Parsed Word8
union' :: Parsed (Which CapDescriptor)
attachedFd :: Parsed Word8
$sel:union':CapDescriptor :: Parsed CapDescriptor -> Parsed (Which CapDescriptor)
$sel:attachedFd:CapDescriptor :: Parsed CapDescriptor -> Parsed Word8
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "attachedFd" a => a
#attachedFd Parsed Word8
attachedFd Raw CapDescriptor ('Mut s)
raw_)
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw CapDescriptor ('Mut s)
raw_) Parsed (Which CapDescriptor)
union')
        )
instance (GH.HasUnion CapDescriptor) where
    unionField :: Field 'Slot CapDescriptor Word16
unionField  = (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 CapDescriptor mut_
        = RW_CapDescriptor'none (R.Raw () mut_)
        | RW_CapDescriptor'senderHosted (R.Raw Std_.Word32 mut_)
        | RW_CapDescriptor'senderPromise (R.Raw Std_.Word32 mut_)
        | RW_CapDescriptor'receiverHosted (R.Raw Std_.Word32 mut_)
        | RW_CapDescriptor'receiverAnswer (R.Raw PromisedAnswer mut_)
        | RW_CapDescriptor'thirdPartyHosted (R.Raw ThirdPartyCapDescriptor mut_)
        | RW_CapDescriptor'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16 -> Raw CapDescriptor mut -> m (RawWhich CapDescriptor mut)
internalWhich Word16
tag_ Raw CapDescriptor mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw () mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'none forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "none" a => a
#none Raw CapDescriptor mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'senderHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "senderHosted" a => a
#senderHosted Raw CapDescriptor mut
struct_))
        Word16
2 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'senderPromise forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "senderPromise" a => a
#senderPromise Raw CapDescriptor mut
struct_))
        Word16
3 ->
            (forall (mut_ :: Mutability).
Raw Word32 mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'receiverHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "receiverHosted" a => a
#receiverHosted Raw CapDescriptor mut
struct_))
        Word16
4 ->
            (forall (mut_ :: Mutability).
Raw PromisedAnswer mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'receiverAnswer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "receiverAnswer" a => a
#receiverAnswer Raw CapDescriptor mut
struct_))
        Word16
5 ->
            (forall (mut_ :: Mutability).
Raw ThirdPartyCapDescriptor mut_ -> RawWhich CapDescriptor mut_
RW_CapDescriptor'thirdPartyHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "thirdPartyHosted" a => a
#thirdPartyHosted Raw CapDescriptor mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability). Word16 -> RawWhich CapDescriptor mut_
RW_CapDescriptor'unknown' Word16
tag_))
    data Which CapDescriptor
instance (GH.HasVariant "none" GH.Slot CapDescriptor ()) where
    variantByLabel :: Variant 'Slot CapDescriptor ()
variantByLabel  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which CapDescriptor) 'Const
-> m (Parsed (Which CapDescriptor))
parse Raw (Which CapDescriptor) 'Const
raw_ = (do
        RawWhich CapDescriptor 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which CapDescriptor) 'Const
raw_)
        case RawWhich CapDescriptor 'Const
rawWhich_ of
            (RW_CapDescriptor'none Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which CapDescriptor)
CapDescriptor'none)
            (RW_CapDescriptor'senderHosted Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'senderHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_CapDescriptor'senderPromise Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'senderPromise forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_CapDescriptor'receiverHosted Raw Word32 'Const
rawArg_) ->
                (Parsed Word32 -> Parsed (Which CapDescriptor)
CapDescriptor'receiverHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word32 'Const
rawArg_))
            (RW_CapDescriptor'receiverAnswer Raw PromisedAnswer 'Const
rawArg_) ->
                (Parsed PromisedAnswer -> Parsed (Which CapDescriptor)
CapDescriptor'receiverAnswer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw PromisedAnswer 'Const
rawArg_))
            (RW_CapDescriptor'thirdPartyHosted Raw ThirdPartyCapDescriptor 'Const
rawArg_) ->
                (Parsed ThirdPartyCapDescriptor -> Parsed (Which CapDescriptor)
CapDescriptor'thirdPartyHosted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw ThirdPartyCapDescriptor 'Const
rawArg_))
            (RW_CapDescriptor'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which CapDescriptor) ('Mut s)
-> Parsed (Which CapDescriptor) -> m ()
marshalInto Raw (Which CapDescriptor) ('Mut s)
raw_ Parsed (Which CapDescriptor)
parsed_ = case Parsed (Which CapDescriptor)
parsed_ of
        (Parsed (Which CapDescriptor)
R:ParsedWhich7
CapDescriptor'none) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "none" a => a
#none () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'senderHosted Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "senderHosted" a => a
#senderHosted Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'senderPromise Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "senderPromise" a => a
#senderPromise Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'receiverHosted Parsed Word32
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "receiverHosted" a => a
#receiverHosted Parsed Word32
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'receiverAnswer Parsed PromisedAnswer
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "receiverAnswer" a => a
#receiverAnswer Parsed PromisedAnswer
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'thirdPartyHosted Parsed ThirdPartyCapDescriptor
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "thirdPartyHosted" a => a
#thirdPartyHosted Parsed ThirdPartyCapDescriptor
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
        (CapDescriptor'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which CapDescriptor) ('Mut s)
raw_))
instance (GH.HasField "attachedFd" GH.Slot CapDescriptor Std_.Word8) where
    fieldByLabel :: Field 'Slot CapDescriptor Word8
fieldByLabel  = (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.HasTypeId PromisedAnswer) where
    typeId :: Word64
typeId  = Word64
15564635848320162976
instance (C.TypedStruct PromisedAnswer) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate PromisedAnswer) where
    type AllocHint PromisedAnswer = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint PromisedAnswer
-> Message ('Mut s) -> m (Raw PromisedAnswer ('Mut s))
new AllocHint PromisedAnswer
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc PromisedAnswer (C.Parsed PromisedAnswer))
instance (C.AllocateList PromisedAnswer) where
    type ListAllocHint PromisedAnswer = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint PromisedAnswer
-> Message ('Mut s) -> m (Raw (List PromisedAnswer) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw PromisedAnswer 'Const -> m (Parsed PromisedAnswer)
parse Raw PromisedAnswer 'Const
raw_ = (Parsed Word32
-> Parsed (List PromisedAnswer'Op) -> Parsed PromisedAnswer
PromisedAnswer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "questionId" a => a
#questionId Raw PromisedAnswer 'Const
raw_)
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "transform" a => a
#transform Raw PromisedAnswer 'Const
raw_))
instance (C.Marshal PromisedAnswer (C.Parsed PromisedAnswer)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw PromisedAnswer ('Mut s) -> Parsed PromisedAnswer -> m ()
marshalInto Raw PromisedAnswer ('Mut s)
raw_ PromisedAnswer{Parsed Word32
Parsed (List PromisedAnswer'Op)
transform :: Parsed (List PromisedAnswer'Op)
questionId :: Parsed Word32
$sel:transform:PromisedAnswer :: Parsed PromisedAnswer -> Parsed (List PromisedAnswer'Op)
$sel:questionId:PromisedAnswer :: Parsed PromisedAnswer -> Parsed Word32
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "questionId" a => a
#questionId Parsed Word32
questionId Raw PromisedAnswer ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "transform" a => a
#transform Parsed (List PromisedAnswer'Op)
transform Raw PromisedAnswer ('Mut s)
raw_)
        (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  = (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  = (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.HasTypeId PromisedAnswer'Op) where
    typeId :: Word64
typeId  = Word64
17516350820840804481
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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint PromisedAnswer'Op
-> Message ('Mut s) -> m (Raw PromisedAnswer'Op ('Mut s))
new AllocHint PromisedAnswer'Op
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc PromisedAnswer'Op (C.Parsed PromisedAnswer'Op))
instance (C.AllocateList PromisedAnswer'Op) where
    type ListAllocHint PromisedAnswer'Op = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint PromisedAnswer'Op
-> Message ('Mut s) -> m (Raw (List PromisedAnswer'Op) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw PromisedAnswer'Op 'Const -> m (Parsed PromisedAnswer'Op)
parse Raw PromisedAnswer'Op 'Const
raw_ = (Parsed (Which PromisedAnswer'Op) -> Parsed PromisedAnswer'Op
PromisedAnswer'Op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw PromisedAnswer'Op 'Const
raw_)))
instance (C.Marshal PromisedAnswer'Op (C.Parsed PromisedAnswer'Op)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw PromisedAnswer'Op ('Mut s) -> Parsed PromisedAnswer'Op -> m ()
marshalInto Raw PromisedAnswer'Op ('Mut s)
raw_ PromisedAnswer'Op{Parsed (Which PromisedAnswer'Op)
union' :: Parsed (Which PromisedAnswer'Op)
$sel:union':PromisedAnswer'Op :: Parsed PromisedAnswer'Op -> Parsed (Which PromisedAnswer'Op)
..} = (do
        (forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto (forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
GH.structUnion Raw PromisedAnswer'Op ('Mut s)
raw_) Parsed (Which PromisedAnswer'Op)
union')
        )
instance (GH.HasUnion PromisedAnswer'Op) where
    unionField :: Field 'Slot PromisedAnswer'Op Word16
unionField  = (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 PromisedAnswer'Op mut_
        = RW_PromisedAnswer'Op'noop (R.Raw () mut_)
        | RW_PromisedAnswer'Op'getPointerField (R.Raw Std_.Word16 mut_)
        | RW_PromisedAnswer'Op'unknown' Std_.Word16
    internalWhich :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Word16
-> Raw PromisedAnswer'Op mut -> m (RawWhich PromisedAnswer'Op mut)
internalWhich Word16
tag_ Raw PromisedAnswer'Op mut
struct_ = case Word16
tag_ of
        Word16
0 ->
            (forall (mut_ :: Mutability).
Raw () mut_ -> RawWhich PromisedAnswer'Op mut_
RW_PromisedAnswer'Op'noop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "noop" a => a
#noop Raw PromisedAnswer'Op mut
struct_))
        Word16
1 ->
            (forall (mut_ :: Mutability).
Raw Word16 mut_ -> RawWhich PromisedAnswer'Op mut_
RW_PromisedAnswer'Op'getPointerField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw a mut -> m (Raw b mut)
GH.readVariant forall a. IsLabel "getPointerField" a => a
#getPointerField Raw PromisedAnswer'Op mut
struct_))
        Word16
_ ->
            (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (forall (mut_ :: Mutability).
Word16 -> RawWhich PromisedAnswer'Op mut_
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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant 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  = (forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (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.
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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw (Which PromisedAnswer'Op) 'Const
-> m (Parsed (Which PromisedAnswer'Op))
parse Raw (Which PromisedAnswer'Op) 'Const
raw_ = (do
        RawWhich PromisedAnswer'Op 'Const
rawWhich_ <- (forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
GH.unionWhich Raw (Which PromisedAnswer'Op) 'Const
raw_)
        case RawWhich PromisedAnswer'Op 'Const
rawWhich_ of
            (RW_PromisedAnswer'Op'noop Raw () 'Const
_) ->
                (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'noop)
            (RW_PromisedAnswer'Op'getPointerField Raw Word16 'Const
rawArg_) ->
                (Parsed Word16 -> Parsed (Which PromisedAnswer'Op)
PromisedAnswer'Op'getPointerField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse Raw Word16 'Const
rawArg_))
            (RW_PromisedAnswer'Op'unknown' Word16
tag_) ->
                (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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw (Which PromisedAnswer'Op) ('Mut s)
-> Parsed (Which PromisedAnswer'Op) -> m ()
marshalInto Raw (Which PromisedAnswer'Op) ('Mut s)
raw_ Parsed (Which PromisedAnswer'Op)
parsed_ = case Parsed (Which PromisedAnswer'Op)
parsed_ of
        (Parsed (Which PromisedAnswer'Op)
R:ParsedWhich5
PromisedAnswer'Op'noop) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "noop" a => a
#noop () (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which PromisedAnswer'Op) ('Mut s)
raw_))
        (PromisedAnswer'Op'getPointerField Parsed Word16
arg_) ->
            (forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeVariant forall a. IsLabel "getPointerField" a => a
#getPointerField Parsed Word16
arg_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which PromisedAnswer'Op) ('Mut s)
raw_))
        (PromisedAnswer'Op'unknown' Word16
tag_) ->
            (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
GH.unionStruct Raw (Which PromisedAnswer'Op) ('Mut s)
raw_))
data ThirdPartyCapDescriptor 
type instance (R.ReprFor ThirdPartyCapDescriptor) = (R.Ptr (Std_.Just R.Struct))
instance (C.HasTypeId ThirdPartyCapDescriptor) where
    typeId :: Word64
typeId  = Word64
15235686326393111165
instance (C.TypedStruct ThirdPartyCapDescriptor) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate ThirdPartyCapDescriptor) where
    type AllocHint ThirdPartyCapDescriptor = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint ThirdPartyCapDescriptor
-> Message ('Mut s) -> m (Raw ThirdPartyCapDescriptor ('Mut s))
new AllocHint ThirdPartyCapDescriptor
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor))
instance (C.AllocateList ThirdPartyCapDescriptor) where
    type ListAllocHint ThirdPartyCapDescriptor = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint ThirdPartyCapDescriptor
-> Message ('Mut s)
-> m (Raw (List ThirdPartyCapDescriptor) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor))
data instance C.Parsed ThirdPartyCapDescriptor
    = ThirdPartyCapDescriptor 
        {Parsed ThirdPartyCapDescriptor -> Parsed (Maybe AnyPointer)
id :: (RP.Parsed (Std_.Maybe Basics.AnyPointer))
        ,Parsed ThirdPartyCapDescriptor -> Parsed Word32
vineId :: (RP.Parsed Std_.Word32)}
    deriving(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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw ThirdPartyCapDescriptor 'Const
-> m (Parsed ThirdPartyCapDescriptor)
parse Raw ThirdPartyCapDescriptor 'Const
raw_ = (Parsed (Maybe AnyPointer)
-> Parsed Word32 -> Parsed ThirdPartyCapDescriptor
ThirdPartyCapDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "id" a => a
#id Raw ThirdPartyCapDescriptor 'Const
raw_)
                                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "vineId" a => a
#vineId Raw ThirdPartyCapDescriptor 'Const
raw_))
instance (C.Marshal ThirdPartyCapDescriptor (C.Parsed ThirdPartyCapDescriptor)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw ThirdPartyCapDescriptor ('Mut s)
-> Parsed ThirdPartyCapDescriptor -> m ()
marshalInto Raw ThirdPartyCapDescriptor ('Mut s)
raw_ ThirdPartyCapDescriptor{Parsed (Maybe AnyPointer)
Parsed Word32
vineId :: Parsed Word32
id :: Parsed (Maybe AnyPointer)
$sel:vineId:ThirdPartyCapDescriptor :: Parsed ThirdPartyCapDescriptor -> Parsed Word32
$sel:id:ThirdPartyCapDescriptor :: Parsed ThirdPartyCapDescriptor -> Parsed (Maybe AnyPointer)
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "id" a => a
#id Parsed (Maybe AnyPointer)
id Raw ThirdPartyCapDescriptor ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "vineId" a => a
#vineId Parsed Word32
vineId Raw ThirdPartyCapDescriptor ('Mut s)
raw_)
        (forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot ThirdPartyCapDescriptor (Std_.Maybe Basics.AnyPointer)) where
    fieldByLabel :: Field 'Slot ThirdPartyCapDescriptor (Maybe AnyPointer)
fieldByLabel  = (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  = (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.HasTypeId Exception) where
    typeId :: Word64
typeId  = Word64
15430940935639230746
instance (C.TypedStruct Exception) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Exception) where
    type AllocHint Exception = ()
    new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Exception
-> Message ('Mut s) -> m (Raw Exception ('Mut s))
new AllocHint Exception
_ = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw a ('Mut s))
C.newTypedStruct
instance (C.EstimateAlloc Exception (C.Parsed Exception))
instance (C.AllocateList Exception) where
    type ListAllocHint Exception = Std_.Int
    newList :: forall (m :: * -> *) s.
RWCtx m s =>
ListAllocHint Exception
-> Message ('Mut s) -> m (Raw (List Exception) ('Mut s))
newList  = forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw (List a) ('Mut s))
C.newTypedStructList
instance (C.EstimateListAlloc 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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Exception 'Const -> m (Parsed Exception)
parse Raw Exception 'Const
raw_ = (Parsed Text
-> Parsed Bool
-> Parsed Word16
-> Parsed Exception'Type
-> Parsed Exception
Exception forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "reason" a => a
#reason Raw Exception 'Const
raw_)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "obsoleteIsCallersFault" a => a
#obsoleteIsCallersFault Raw Exception 'Const
raw_)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "obsoleteDurability" a => a
#obsoleteDurability Raw Exception 'Const
raw_)
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
GH.parseField forall a. IsLabel "type_" a => a
#type_ Raw Exception 'Const
raw_))
instance (C.Marshal Exception (C.Parsed Exception)) where
    marshalInto :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Exception ('Mut s) -> Parsed Exception -> m ()
marshalInto Raw Exception ('Mut s)
raw_ Exception{Parsed Bool
Parsed Word16
Parsed Text
Parsed Exception'Type
type_ :: Parsed Exception'Type
obsoleteDurability :: Parsed Word16
obsoleteIsCallersFault :: Parsed Bool
reason :: Parsed Text
$sel:type_:Exception :: Parsed Exception -> Parsed Exception'Type
$sel:obsoleteDurability:Exception :: Parsed Exception -> Parsed Word16
$sel:obsoleteIsCallersFault:Exception :: Parsed Exception -> Parsed Bool
$sel:reason:Exception :: Parsed Exception -> Parsed Text
..} = (do
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "reason" a => a
#reason Parsed Text
reason Raw Exception ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "obsoleteIsCallersFault" a => a
#obsoleteIsCallersFault Parsed Bool
obsoleteIsCallersFault Raw Exception ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "obsoleteDurability" a => a
#obsoleteDurability Parsed Word16
obsoleteDurability Raw Exception ('Mut s)
raw_)
        (forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
GH.encodeField forall a. IsLabel "type_" a => a
#type_ Parsed Exception'Type
type_ Raw Exception ('Mut s)
raw_)
        (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  = (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  = (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  = (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  = (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
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
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
            ,forall x. Rep Exception'Type x -> Exception'Type
forall x. Exception'Type -> Rep Exception'Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Exception'Type x -> Exception'Type
$cfrom :: forall x. Exception'Type -> Rep Exception'Type x
Generics.Generic)
type instance (R.ReprFor Exception'Type) = (R.Data R.Sz16)
instance (C.HasTypeId Exception'Type) where
    typeId :: Word64
typeId  = Word64
12865824133959433560
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' (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_) ->
            (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_ = (forall a. Enum a => Int -> a
Std_.toEnum (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
w_))
    toWord :: Exception'Type -> Word64
toWord Exception'Type
v_ = (forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (forall a. Enum a => a -> Int
Std_.fromEnum Exception'Type
v_))
instance (C.Parse Exception'Type Exception'Type) where
    parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Exception'Type 'Const -> m Exception'Type
parse  = forall a (m :: * -> *).
(ReprFor a ~ 'Data 'Sz16, Enum a, Applicative m) =>
Raw a 'Const -> m a
GH.parseEnum
    encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s)
-> Exception'Type -> m (Raw Exception'Type ('Mut s))
encode  = forall a (m :: * -> *) s.
(ReprFor a ~ 'Data 'Sz16, Enum a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Raw a ('Mut s))
GH.encodeEnum
instance (C.AllocateList Exception'Type) where
    type ListAllocHint Exception'Type = Std_.Int
instance (C.EstimateListAlloc Exception'Type Exception'Type)