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