{-# 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.Schema.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 Node 
type instance (R.ReprFor Node) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node) where
    type AllocHint Node = ()
    new :: AllocHint Node -> Message ('Mut s) -> m (Raw ('Mut s) Node)
new AllocHint Node
_ = Message ('Mut s) -> m (Raw ('Mut s) Node)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node (C.Parsed Node))
instance (C.AllocateList Node) where
    type ListAllocHint Node = Std_.Int
    newList :: ListAllocHint Node
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node))
newList  = ListAllocHint Node
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node (C.Parsed Node))
data instance C.Parsed Node
    = Node 
        {Parsed Node -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed Node -> Parsed Text
displayName :: (RP.Parsed Basics.Text)
        ,Parsed Node -> Parsed Word32
displayNamePrefixLength :: (RP.Parsed Std_.Word32)
        ,Parsed Node -> Parsed Word64
scopeId :: (RP.Parsed Std_.Word64)
        ,Parsed Node -> Parsed (List Node'NestedNode)
nestedNodes :: (RP.Parsed (R.List Node'NestedNode))
        ,Parsed Node -> Parsed (List Annotation)
annotations :: (RP.Parsed (R.List Annotation))
        ,Parsed Node -> Parsed (List Node'Parameter)
parameters :: (RP.Parsed (R.List Node'Parameter))
        ,Parsed Node -> Parsed Bool
isGeneric :: (RP.Parsed Std_.Bool)
        ,Parsed Node -> Parsed (Which Node)
union' :: (C.Parsed (GH.Which Node))}
    deriving((forall x. Parsed Node -> Rep (Parsed Node) x)
-> (forall x. Rep (Parsed Node) x -> Parsed Node)
-> Generic (Parsed Node)
forall x. Rep (Parsed Node) x -> Parsed Node
forall x. Parsed Node -> Rep (Parsed Node) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node) x -> Parsed Node
$cfrom :: forall x. Parsed Node -> Rep (Parsed Node) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node))
deriving instance (Std_.Eq (C.Parsed Node))
instance (C.Parse Node (C.Parsed Node)) where
    parse :: Raw 'Const Node -> m (Parsed Node)
parse Raw 'Const Node
raw_ = (Word64
-> Text
-> Word32
-> Word64
-> Vector (Parsed Node'NestedNode)
-> Vector (Parsed Annotation)
-> Vector (Parsed Node'Parameter)
-> Bool
-> Parsed (Which Node)
-> Parsed Node
Parsed Word64
-> Parsed Text
-> Parsed Word32
-> Parsed Word64
-> Parsed (List Node'NestedNode)
-> Parsed (List Annotation)
-> Parsed (List Node'Parameter)
-> Parsed Bool
-> Parsed (Which Node)
-> Parsed Node
Node (Word64
 -> Text
 -> Word32
 -> Word64
 -> Vector (Parsed Node'NestedNode)
 -> Vector (Parsed Annotation)
 -> Vector (Parsed Node'Parameter)
 -> Bool
 -> Parsed (Which Node)
 -> Parsed Node)
-> m Word64
-> m (Text
      -> Word32
      -> Word64
      -> Vector (Parsed Node'NestedNode)
      -> Vector (Parsed Annotation)
      -> Vector (Parsed Node'Parameter)
      -> Bool
      -> Parsed (Which Node)
      -> Parsed Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node Word64 -> Raw 'Const Node -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Node Word64)
Field 'Slot Node Word64
#id Raw 'Const Node
raw_)
                       m (Text
   -> Word32
   -> Word64
   -> Vector (Parsed Node'NestedNode)
   -> Vector (Parsed Annotation)
   -> Vector (Parsed Node'Parameter)
   -> Bool
   -> Parsed (Which Node)
   -> Parsed Node)
-> m Text
-> m (Word32
      -> Word64
      -> Vector (Parsed Node'NestedNode)
      -> Vector (Parsed Annotation)
      -> Vector (Parsed Node'Parameter)
      -> Bool
      -> Parsed (Which Node)
      -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node Text -> Raw 'Const Node -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "displayName" (Field 'Slot Node Text)
Field 'Slot Node Text
#displayName Raw 'Const Node
raw_)
                       m (Word32
   -> Word64
   -> Vector (Parsed Node'NestedNode)
   -> Vector (Parsed Annotation)
   -> Vector (Parsed Node'Parameter)
   -> Bool
   -> Parsed (Which Node)
   -> Parsed Node)
-> m Word32
-> m (Word64
      -> Vector (Parsed Node'NestedNode)
      -> Vector (Parsed Annotation)
      -> Vector (Parsed Node'Parameter)
      -> Bool
      -> Parsed (Which Node)
      -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node Word32 -> Raw 'Const Node -> 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 "displayNamePrefixLength" (Field 'Slot Node Word32)
Field 'Slot Node Word32
#displayNamePrefixLength Raw 'Const Node
raw_)
                       m (Word64
   -> Vector (Parsed Node'NestedNode)
   -> Vector (Parsed Annotation)
   -> Vector (Parsed Node'Parameter)
   -> Bool
   -> Parsed (Which Node)
   -> Parsed Node)
-> m Word64
-> m (Vector (Parsed Node'NestedNode)
      -> Vector (Parsed Annotation)
      -> Vector (Parsed Node'Parameter)
      -> Bool
      -> Parsed (Which Node)
      -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node Word64 -> Raw 'Const Node -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "scopeId" (Field 'Slot Node Word64)
Field 'Slot Node Word64
#scopeId Raw 'Const Node
raw_)
                       m (Vector (Parsed Node'NestedNode)
   -> Vector (Parsed Annotation)
   -> Vector (Parsed Node'Parameter)
   -> Bool
   -> Parsed (Which Node)
   -> Parsed Node)
-> m (Vector (Parsed Node'NestedNode))
-> m (Vector (Parsed Annotation)
      -> Vector (Parsed Node'Parameter)
      -> Bool
      -> Parsed (Which Node)
      -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node (List Node'NestedNode)
-> Raw 'Const Node -> m (Vector (Parsed Node'NestedNode))
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 "nestedNodes" (Field 'Slot Node (List Node'NestedNode))
Field 'Slot Node (List Node'NestedNode)
#nestedNodes Raw 'Const Node
raw_)
                       m (Vector (Parsed Annotation)
   -> Vector (Parsed Node'Parameter)
   -> Bool
   -> Parsed (Which Node)
   -> Parsed Node)
-> m (Vector (Parsed Annotation))
-> m (Vector (Parsed Node'Parameter)
      -> Bool -> Parsed (Which Node) -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node (List Annotation)
-> Raw 'Const Node -> m (Vector (Parsed Annotation))
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 "annotations" (Field 'Slot Node (List Annotation))
Field 'Slot Node (List Annotation)
#annotations Raw 'Const Node
raw_)
                       m (Vector (Parsed Node'Parameter)
   -> Bool -> Parsed (Which Node) -> Parsed Node)
-> m (Vector (Parsed Node'Parameter))
-> m (Bool -> Parsed (Which Node) -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node (List Node'Parameter)
-> Raw 'Const Node -> m (Vector (Parsed Node'Parameter))
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 "parameters" (Field 'Slot Node (List Node'Parameter))
Field 'Slot Node (List Node'Parameter)
#parameters Raw 'Const Node
raw_)
                       m (Bool -> Parsed (Which Node) -> Parsed Node)
-> m Bool -> m (Parsed (Which Node) -> Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node Bool -> Raw 'Const Node -> 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 "isGeneric" (Field 'Slot Node Bool)
Field 'Slot Node Bool
#isGeneric Raw 'Const Node
raw_)
                       m (Parsed (Which Node) -> Parsed Node)
-> m (Parsed (Which Node)) -> m (Parsed Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which Node) -> m (Parsed (Which Node))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Node -> Raw 'Const (Which Node)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Node
raw_)))
instance (C.Marshal Node (C.Parsed Node)) where
    marshalInto :: Raw ('Mut s) Node -> Parsed Node -> m ()
marshalInto Raw ('Mut s) Node
raw_ Node{..} = (do
        (Field 'Slot Node Word64 -> Word64 -> Raw ('Mut s) Node -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Node Word64)
Field 'Slot Node Word64
#id Word64
Parsed Word64
id Raw ('Mut s) Node
raw_)
        (Field 'Slot Node Text -> Text -> Raw ('Mut s) Node -> 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 "displayName" (Field 'Slot Node Text)
Field 'Slot Node Text
#displayName Text
Parsed Text
displayName Raw ('Mut s) Node
raw_)
        (Field 'Slot Node Word32 -> Word32 -> Raw ('Mut s) Node -> 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 "displayNamePrefixLength" (Field 'Slot Node Word32)
Field 'Slot Node Word32
#displayNamePrefixLength Word32
Parsed Word32
displayNamePrefixLength Raw ('Mut s) Node
raw_)
        (Field 'Slot Node Word64 -> Word64 -> Raw ('Mut s) Node -> 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 "scopeId" (Field 'Slot Node Word64)
Field 'Slot Node Word64
#scopeId Word64
Parsed Word64
scopeId Raw ('Mut s) Node
raw_)
        (Field 'Slot Node (List Node'NestedNode)
-> Vector (Parsed Node'NestedNode) -> Raw ('Mut s) Node -> 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 "nestedNodes" (Field 'Slot Node (List Node'NestedNode))
Field 'Slot Node (List Node'NestedNode)
#nestedNodes Vector (Parsed Node'NestedNode)
Parsed (List Node'NestedNode)
nestedNodes Raw ('Mut s) Node
raw_)
        (Field 'Slot Node (List Annotation)
-> Vector (Parsed Annotation) -> Raw ('Mut s) Node -> 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 "annotations" (Field 'Slot Node (List Annotation))
Field 'Slot Node (List Annotation)
#annotations Vector (Parsed Annotation)
Parsed (List Annotation)
annotations Raw ('Mut s) Node
raw_)
        (Field 'Slot Node (List Node'Parameter)
-> Vector (Parsed Node'Parameter) -> Raw ('Mut s) Node -> 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 "parameters" (Field 'Slot Node (List Node'Parameter))
Field 'Slot Node (List Node'Parameter)
#parameters Vector (Parsed Node'Parameter)
Parsed (List Node'Parameter)
parameters Raw ('Mut s) Node
raw_)
        (Field 'Slot Node Bool -> Bool -> Raw ('Mut s) Node -> 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 "isGeneric" (Field 'Slot Node Bool)
Field 'Slot Node Bool
#isGeneric Bool
Parsed Bool
isGeneric Raw ('Mut s) Node
raw_)
        (Raw ('Mut s) (Which Node) -> Parsed (Which Node) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Node -> Raw ('Mut s) (Which Node)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Node
raw_) Parsed (Which Node)
union')
        )
instance (GH.HasUnion Node) where
    unionField :: Field 'Slot Node Word16
unionField  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Node 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
1 BitCount
16 Word64
0)
    data RawWhich mut_ Node
        = RW_Node'file (R.Raw mut_ ())
        | RW_Node'struct (R.Raw mut_ Node'struct)
        | RW_Node'enum (R.Raw mut_ Node'enum)
        | RW_Node'interface (R.Raw mut_ Node'interface)
        | RW_Node'const (R.Raw mut_ Node'const)
        | RW_Node'annotation (R.Raw mut_ Node'annotation)
        | RW_Node'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Node -> m (RawWhich mut Node)
internalWhich Word16
tag_ Raw mut Node
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Node
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Node
RW_Node'file (Raw mut () -> RawWhich mut Node)
-> m (Raw mut ()) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Node () -> Raw mut Node -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "file" (Variant 'Slot Node ())
Variant 'Slot Node ()
#file Raw mut Node
struct_))
        Word16
1 ->
            (Raw mut Node'struct -> RawWhich mut Node
forall (mut_ :: Mutability).
Raw mut_ Node'struct -> RawWhich mut_ Node
RW_Node'struct (Raw mut Node'struct -> RawWhich mut Node)
-> m (Raw mut Node'struct) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Node Node'struct
-> Raw mut Node -> m (Raw mut Node'struct)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "struct" (Variant 'Group Node Node'struct)
Variant 'Group Node Node'struct
#struct Raw mut Node
struct_))
        Word16
2 ->
            (Raw mut Node'enum -> RawWhich mut Node
forall (mut_ :: Mutability).
Raw mut_ Node'enum -> RawWhich mut_ Node
RW_Node'enum (Raw mut Node'enum -> RawWhich mut Node)
-> m (Raw mut Node'enum) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Node Node'enum
-> Raw mut Node -> m (Raw mut Node'enum)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "enum" (Variant 'Group Node Node'enum)
Variant 'Group Node Node'enum
#enum Raw mut Node
struct_))
        Word16
3 ->
            (Raw mut Node'interface -> RawWhich mut Node
forall (mut_ :: Mutability).
Raw mut_ Node'interface -> RawWhich mut_ Node
RW_Node'interface (Raw mut Node'interface -> RawWhich mut Node)
-> m (Raw mut Node'interface) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Node Node'interface
-> Raw mut Node -> m (Raw mut Node'interface)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "interface" (Variant 'Group Node Node'interface)
Variant 'Group Node Node'interface
#interface Raw mut Node
struct_))
        Word16
4 ->
            (Raw mut Node'const -> RawWhich mut Node
forall (mut_ :: Mutability).
Raw mut_ Node'const -> RawWhich mut_ Node
RW_Node'const (Raw mut Node'const -> RawWhich mut Node)
-> m (Raw mut Node'const) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Node Node'const
-> Raw mut Node -> m (Raw mut Node'const)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "const" (Variant 'Group Node Node'const)
Variant 'Group Node Node'const
#const Raw mut Node
struct_))
        Word16
5 ->
            (Raw mut Node'annotation -> RawWhich mut Node
forall (mut_ :: Mutability).
Raw mut_ Node'annotation -> RawWhich mut_ Node
RW_Node'annotation (Raw mut Node'annotation -> RawWhich mut Node)
-> m (Raw mut Node'annotation) -> m (RawWhich mut Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Node Node'annotation
-> Raw mut Node -> m (Raw mut Node'annotation)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "annotation" (Variant 'Group Node Node'annotation)
Variant 'Group Node Node'annotation
#annotation Raw mut Node
struct_))
        Word16
_ ->
            (RawWhich mut Node -> m (RawWhich mut Node)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Node
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Node
RW_Node'unknown' Word16
tag_))
    data Which Node
instance (GH.HasVariant "file" GH.Slot Node ()) where
    variantByLabel :: Variant 'Slot Node ()
variantByLabel  = (Field 'Slot Node () -> Word16 -> Variant 'Slot Node ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Node ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "struct" GH.Group Node Node'struct) where
    variantByLabel :: Variant 'Group Node Node'struct
variantByLabel  = (Field 'Group Node Node'struct
-> Word16 -> Variant 'Group Node Node'struct
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Node Node'struct
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
1)
instance (GH.HasVariant "enum" GH.Group Node Node'enum) where
    variantByLabel :: Variant 'Group Node Node'enum
variantByLabel  = (Field 'Group Node Node'enum
-> Word16 -> Variant 'Group Node Node'enum
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Node Node'enum
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
2)
instance (GH.HasVariant "interface" GH.Group Node Node'interface) where
    variantByLabel :: Variant 'Group Node Node'interface
variantByLabel  = (Field 'Group Node Node'interface
-> Word16 -> Variant 'Group Node Node'interface
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Node Node'interface
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
3)
instance (GH.HasVariant "const" GH.Group Node Node'const) where
    variantByLabel :: Variant 'Group Node Node'const
variantByLabel  = (Field 'Group Node Node'const
-> Word16 -> Variant 'Group Node Node'const
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Node Node'const
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
4)
instance (GH.HasVariant "annotation" GH.Group Node Node'annotation) where
    variantByLabel :: Variant 'Group Node Node'annotation
variantByLabel  = (Field 'Group Node Node'annotation
-> Word16 -> Variant 'Group Node Node'annotation
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Node Node'annotation
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
5)
data instance C.Parsed (GH.Which Node)
    = Node'file 
    | Node'struct (RP.Parsed Node'struct)
    | Node'enum (RP.Parsed Node'enum)
    | Node'interface (RP.Parsed Node'interface)
    | Node'const (RP.Parsed Node'const)
    | Node'annotation (RP.Parsed Node'annotation)
    | Node'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Node) -> Rep (Parsed (Which Node)) x)
-> (forall x. Rep (Parsed (Which Node)) x -> Parsed (Which Node))
-> Generic (Parsed (Which Node))
forall x. Rep (Parsed (Which Node)) x -> Parsed (Which Node)
forall x. Parsed (Which Node) -> Rep (Parsed (Which Node)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Node)) x -> Parsed (Which Node)
$cfrom :: forall x. Parsed (Which Node) -> Rep (Parsed (Which Node)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Node)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Node)))
instance (C.Parse (GH.Which Node) (C.Parsed (GH.Which Node))) where
    parse :: Raw 'Const (Which Node) -> m (Parsed (Which Node))
parse Raw 'Const (Which Node)
raw_ = (do
        RawWhich 'Const Node
rawWhich_ <- (Raw 'Const (Which Node) -> m (RawWhich 'Const Node)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Node)
raw_)
        case RawWhich 'Const Node
rawWhich_ of
            (RW_Node'file _) ->
                (Parsed (Which Node) -> m (Parsed (Which Node))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Node)
Node'file)
            (RW_Node'struct rawArg_) ->
                (Parsed Node'struct -> Parsed (Which Node)
Parsed Node'struct -> Parsed (Which Node)
Node'struct (Parsed Node'struct -> Parsed (Which Node))
-> m (Parsed Node'struct) -> m (Parsed (Which Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Node'struct -> m (Parsed Node'struct)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Node'struct
rawArg_))
            (RW_Node'enum rawArg_) ->
                (Parsed Node'enum -> Parsed (Which Node)
Parsed Node'enum -> Parsed (Which Node)
Node'enum (Parsed Node'enum -> Parsed (Which Node))
-> m (Parsed Node'enum) -> m (Parsed (Which Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Node'enum -> m (Parsed Node'enum)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Node'enum
rawArg_))
            (RW_Node'interface rawArg_) ->
                (Parsed Node'interface -> Parsed (Which Node)
Parsed Node'interface -> Parsed (Which Node)
Node'interface (Parsed Node'interface -> Parsed (Which Node))
-> m (Parsed Node'interface) -> m (Parsed (Which Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Node'interface -> m (Parsed Node'interface)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Node'interface
rawArg_))
            (RW_Node'const rawArg_) ->
                (Parsed Node'const -> Parsed (Which Node)
Parsed Node'const -> Parsed (Which Node)
Node'const (Parsed Node'const -> Parsed (Which Node))
-> m (Parsed Node'const) -> m (Parsed (Which Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Node'const -> m (Parsed Node'const)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Node'const
rawArg_))
            (RW_Node'annotation rawArg_) ->
                (Parsed Node'annotation -> Parsed (Which Node)
Parsed Node'annotation -> Parsed (Which Node)
Node'annotation (Parsed Node'annotation -> Parsed (Which Node))
-> m (Parsed Node'annotation) -> m (Parsed (Which Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Node'annotation -> m (Parsed Node'annotation)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Node'annotation
rawArg_))
            (RW_Node'unknown' tag_) ->
                (Parsed (Which Node) -> m (Parsed (Which Node))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Node)
Node'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Node) (C.Parsed (GH.Which Node))) where
    marshalInto :: Raw ('Mut s) (Which Node) -> Parsed (Which Node) -> m ()
marshalInto Raw ('Mut s) (Which Node)
raw_ Parsed (Which Node)
parsed_ = case Parsed (Which Node)
parsed_ of
        (Parsed (Which Node)
Node'file) ->
            (Variant 'Slot Node () -> () -> Raw ('Mut s) Node -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "file" (Variant 'Slot Node ())
Variant 'Slot Node ()
#file () (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
        (Node'struct arg_) ->
            (do
                Raw ('Mut s) Node'struct
rawGroup_ <- (Variant 'Group Node Node'struct
-> Raw ('Mut s) Node -> m (Raw ('Mut s) Node'struct)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "struct" (Variant 'Group Node Node'struct)
Variant 'Group Node Node'struct
#struct (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
                (Raw ('Mut s) Node'struct -> Parsed Node'struct -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Node'struct
rawGroup_ Parsed Node'struct
Parsed Node'struct
arg_)
                )
        (Node'enum arg_) ->
            (do
                Raw ('Mut s) Node'enum
rawGroup_ <- (Variant 'Group Node Node'enum
-> Raw ('Mut s) Node -> m (Raw ('Mut s) Node'enum)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "enum" (Variant 'Group Node Node'enum)
Variant 'Group Node Node'enum
#enum (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
                (Raw ('Mut s) Node'enum -> Parsed Node'enum -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Node'enum
rawGroup_ Parsed Node'enum
Parsed Node'enum
arg_)
                )
        (Node'interface arg_) ->
            (do
                Raw ('Mut s) Node'interface
rawGroup_ <- (Variant 'Group Node Node'interface
-> Raw ('Mut s) Node -> m (Raw ('Mut s) Node'interface)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "interface" (Variant 'Group Node Node'interface)
Variant 'Group Node Node'interface
#interface (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
                (Raw ('Mut s) Node'interface -> Parsed Node'interface -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Node'interface
rawGroup_ Parsed Node'interface
Parsed Node'interface
arg_)
                )
        (Node'const arg_) ->
            (do
                Raw ('Mut s) Node'const
rawGroup_ <- (Variant 'Group Node Node'const
-> Raw ('Mut s) Node -> m (Raw ('Mut s) Node'const)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "const" (Variant 'Group Node Node'const)
Variant 'Group Node Node'const
#const (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
                (Raw ('Mut s) Node'const -> Parsed Node'const -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Node'const
rawGroup_ Parsed Node'const
Parsed Node'const
arg_)
                )
        (Node'annotation arg_) ->
            (do
                Raw ('Mut s) Node'annotation
rawGroup_ <- (Variant 'Group Node Node'annotation
-> Raw ('Mut s) Node -> m (Raw ('Mut s) Node'annotation)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "annotation" (Variant 'Group Node Node'annotation)
Variant 'Group Node Node'annotation
#annotation (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
                (Raw ('Mut s) Node'annotation -> Parsed Node'annotation -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Node'annotation
rawGroup_ Parsed Node'annotation
Parsed Node'annotation
arg_)
                )
        (Node'unknown' tag_) ->
            (Field 'Slot Node Word16 -> Word16 -> Raw ('Mut s) Node -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Node Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Node) -> Raw ('Mut s) Node
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Node)
raw_))
instance (GH.HasField "id" GH.Slot Node Std_.Word64) where
    fieldByLabel :: Field 'Slot Node Word64
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Node Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "displayName" GH.Slot Node Basics.Text) where
    fieldByLabel :: Field 'Slot Node Text
fieldByLabel  = (Word16 -> Field 'Slot Node Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "displayNamePrefixLength" GH.Slot Node Std_.Word32) where
    fieldByLabel :: Field 'Slot Node Word32
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Node Word32
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
32 Word64
0)
instance (GH.HasField "scopeId" GH.Slot Node Std_.Word64) where
    fieldByLabel :: Field 'Slot Node Word64
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Node Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
2 BitCount
64 Word64
0)
instance (GH.HasField "nestedNodes" GH.Slot Node (R.List Node'NestedNode)) where
    fieldByLabel :: Field 'Slot Node (List Node'NestedNode)
fieldByLabel  = (Word16 -> Field 'Slot Node (List Node'NestedNode)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
instance (GH.HasField "annotations" GH.Slot Node (R.List Annotation)) where
    fieldByLabel :: Field 'Slot Node (List Annotation)
fieldByLabel  = (Word16 -> Field 'Slot Node (List Annotation)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
2)
instance (GH.HasField "parameters" GH.Slot Node (R.List Node'Parameter)) where
    fieldByLabel :: Field 'Slot Node (List Node'Parameter)
fieldByLabel  = (Word16 -> Field 'Slot Node (List Node'Parameter)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
5)
instance (GH.HasField "isGeneric" GH.Slot Node Std_.Bool) where
    fieldByLabel :: Field 'Slot Node Bool
fieldByLabel  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Node 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
4 BitCount
1 Word64
0)
data Node'struct 
type instance (R.ReprFor Node'struct) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'struct) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node'struct) where
    type AllocHint Node'struct = ()
    new :: AllocHint Node'struct
-> Message ('Mut s) -> m (Raw ('Mut s) Node'struct)
new AllocHint Node'struct
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'struct)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'struct (C.Parsed Node'struct))
instance (C.AllocateList Node'struct) where
    type ListAllocHint Node'struct = Std_.Int
    newList :: ListAllocHint Node'struct
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'struct))
newList  = ListAllocHint Node'struct
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'struct))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'struct (C.Parsed Node'struct))
data instance C.Parsed Node'struct
    = Node'struct' 
        {Parsed Node'struct -> Parsed Word16
dataWordCount :: (RP.Parsed Std_.Word16)
        ,Parsed Node'struct -> Parsed Word16
pointerCount :: (RP.Parsed Std_.Word16)
        ,Parsed Node'struct -> Parsed ElementSize
preferredListEncoding :: (RP.Parsed ElementSize)
        ,Parsed Node'struct -> Parsed Bool
isGroup :: (RP.Parsed Std_.Bool)
        ,Parsed Node'struct -> Parsed Word16
discriminantCount :: (RP.Parsed Std_.Word16)
        ,Parsed Node'struct -> Parsed Word32
discriminantOffset :: (RP.Parsed Std_.Word32)
        ,Parsed Node'struct -> Parsed (List Field)
fields :: (RP.Parsed (R.List Field))}
    deriving((forall x. Parsed Node'struct -> Rep (Parsed Node'struct) x)
-> (forall x. Rep (Parsed Node'struct) x -> Parsed Node'struct)
-> Generic (Parsed Node'struct)
forall x. Rep (Parsed Node'struct) x -> Parsed Node'struct
forall x. Parsed Node'struct -> Rep (Parsed Node'struct) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'struct) x -> Parsed Node'struct
$cfrom :: forall x. Parsed Node'struct -> Rep (Parsed Node'struct) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'struct))
deriving instance (Std_.Eq (C.Parsed Node'struct))
instance (C.Parse Node'struct (C.Parsed Node'struct)) where
    parse :: Raw 'Const Node'struct -> m (Parsed Node'struct)
parse Raw 'Const Node'struct
raw_ = (Word16
-> Word16
-> ElementSize
-> Bool
-> Word16
-> Word32
-> Vector (Parsed Field)
-> Parsed Node'struct
Parsed Word16
-> Parsed Word16
-> Parsed ElementSize
-> Parsed Bool
-> Parsed Word16
-> Parsed Word32
-> Parsed (List Field)
-> Parsed Node'struct
Node'struct' (Word16
 -> Word16
 -> ElementSize
 -> Bool
 -> Word16
 -> Word32
 -> Vector (Parsed Field)
 -> Parsed Node'struct)
-> m Word16
-> m (Word16
      -> ElementSize
      -> Bool
      -> Word16
      -> Word32
      -> Vector (Parsed Field)
      -> Parsed Node'struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'struct Word16
-> Raw 'Const Node'struct -> 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 "dataWordCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#dataWordCount Raw 'Const Node'struct
raw_)
                               m (Word16
   -> ElementSize
   -> Bool
   -> Word16
   -> Word32
   -> Vector (Parsed Field)
   -> Parsed Node'struct)
-> m Word16
-> m (ElementSize
      -> Bool
      -> Word16
      -> Word32
      -> Vector (Parsed Field)
      -> Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct Word16
-> Raw 'Const Node'struct -> 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 "pointerCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#pointerCount Raw 'Const Node'struct
raw_)
                               m (ElementSize
   -> Bool
   -> Word16
   -> Word32
   -> Vector (Parsed Field)
   -> Parsed Node'struct)
-> m ElementSize
-> m (Bool
      -> Word16 -> Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct ElementSize
-> Raw 'Const Node'struct -> m ElementSize
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
  "preferredListEncoding" (Field 'Slot Node'struct ElementSize)
Field 'Slot Node'struct ElementSize
#preferredListEncoding Raw 'Const Node'struct
raw_)
                               m (Bool
   -> Word16 -> Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
-> m Bool
-> m (Word16
      -> Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct Bool -> Raw 'Const Node'struct -> 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 "isGroup" (Field 'Slot Node'struct Bool)
Field 'Slot Node'struct Bool
#isGroup Raw 'Const Node'struct
raw_)
                               m (Word16 -> Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
-> m Word16
-> m (Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct Word16
-> Raw 'Const Node'struct -> 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 "discriminantCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#discriminantCount Raw 'Const Node'struct
raw_)
                               m (Word32 -> Vector (Parsed Field) -> Parsed Node'struct)
-> m Word32 -> m (Vector (Parsed Field) -> Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct Word32
-> Raw 'Const Node'struct -> 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 "discriminantOffset" (Field 'Slot Node'struct Word32)
Field 'Slot Node'struct Word32
#discriminantOffset Raw 'Const Node'struct
raw_)
                               m (Vector (Parsed Field) -> Parsed Node'struct)
-> m (Vector (Parsed Field)) -> m (Parsed Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'struct (List Field)
-> Raw 'Const Node'struct -> m (Vector (Parsed Field))
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 "fields" (Field 'Slot Node'struct (List Field))
Field 'Slot Node'struct (List Field)
#fields Raw 'Const Node'struct
raw_))
instance (C.Marshal Node'struct (C.Parsed Node'struct)) where
    marshalInto :: Raw ('Mut s) Node'struct -> Parsed Node'struct -> m ()
marshalInto Raw ('Mut s) Node'struct
raw_ Node'struct'{..} = (do
        (Field 'Slot Node'struct Word16
-> Word16 -> Raw ('Mut s) Node'struct -> 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 "dataWordCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#dataWordCount Word16
Parsed Word16
dataWordCount Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct Word16
-> Word16 -> Raw ('Mut s) Node'struct -> 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 "pointerCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#pointerCount Word16
Parsed Word16
pointerCount Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct ElementSize
-> ElementSize -> Raw ('Mut s) Node'struct -> 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
  "preferredListEncoding" (Field 'Slot Node'struct ElementSize)
Field 'Slot Node'struct ElementSize
#preferredListEncoding Parsed ElementSize
ElementSize
preferredListEncoding Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct Bool
-> Bool -> Raw ('Mut s) Node'struct -> 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 "isGroup" (Field 'Slot Node'struct Bool)
Field 'Slot Node'struct Bool
#isGroup Bool
Parsed Bool
isGroup Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct Word16
-> Word16 -> Raw ('Mut s) Node'struct -> 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 "discriminantCount" (Field 'Slot Node'struct Word16)
Field 'Slot Node'struct Word16
#discriminantCount Word16
Parsed Word16
discriminantCount Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct Word32
-> Word32 -> Raw ('Mut s) Node'struct -> 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 "discriminantOffset" (Field 'Slot Node'struct Word32)
Field 'Slot Node'struct Word32
#discriminantOffset Word32
Parsed Word32
discriminantOffset Raw ('Mut s) Node'struct
raw_)
        (Field 'Slot Node'struct (List Field)
-> Vector (Parsed Field) -> Raw ('Mut s) Node'struct -> 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 "fields" (Field 'Slot Node'struct (List Field))
Field 'Slot Node'struct (List Field)
#fields Vector (Parsed Field)
Parsed (List Field)
fields Raw ('Mut s) Node'struct
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "dataWordCount" GH.Slot Node'struct Std_.Word16) where
    fieldByLabel :: Field 'Slot Node'struct Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'struct 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
1 BitCount
16 Word64
0)
instance (GH.HasField "pointerCount" GH.Slot Node'struct Std_.Word16) where
    fieldByLabel :: Field 'Slot Node'struct Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'struct Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
3 BitCount
16 Word64
0)
instance (GH.HasField "preferredListEncoding" GH.Slot Node'struct ElementSize) where
    fieldByLabel :: Field 'Slot Node'struct ElementSize
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Node'struct ElementSize
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
3 BitCount
16 Word64
0)
instance (GH.HasField "isGroup" GH.Slot Node'struct Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'struct Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'struct 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
3 BitCount
1 Word64
0)
instance (GH.HasField "discriminantCount" GH.Slot Node'struct Std_.Word16) where
    fieldByLabel :: Field 'Slot Node'struct Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'struct 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
3 BitCount
16 Word64
0)
instance (GH.HasField "discriminantOffset" GH.Slot Node'struct Std_.Word32) where
    fieldByLabel :: Field 'Slot Node'struct Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'struct 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
4 BitCount
32 Word64
0)
instance (GH.HasField "fields" GH.Slot Node'struct (R.List Field)) where
    fieldByLabel :: Field 'Slot Node'struct (List Field)
fieldByLabel  = (Word16 -> Field 'Slot Node'struct (List Field)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
data Node'enum 
type instance (R.ReprFor Node'enum) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'enum) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node'enum) where
    type AllocHint Node'enum = ()
    new :: AllocHint Node'enum
-> Message ('Mut s) -> m (Raw ('Mut s) Node'enum)
new AllocHint Node'enum
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'enum)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'enum (C.Parsed Node'enum))
instance (C.AllocateList Node'enum) where
    type ListAllocHint Node'enum = Std_.Int
    newList :: ListAllocHint Node'enum
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'enum))
newList  = ListAllocHint Node'enum
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'enum))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'enum (C.Parsed Node'enum))
data instance C.Parsed Node'enum
    = Node'enum' 
        {Parsed Node'enum -> Parsed (List Enumerant)
enumerants :: (RP.Parsed (R.List Enumerant))}
    deriving((forall x. Parsed Node'enum -> Rep (Parsed Node'enum) x)
-> (forall x. Rep (Parsed Node'enum) x -> Parsed Node'enum)
-> Generic (Parsed Node'enum)
forall x. Rep (Parsed Node'enum) x -> Parsed Node'enum
forall x. Parsed Node'enum -> Rep (Parsed Node'enum) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'enum) x -> Parsed Node'enum
$cfrom :: forall x. Parsed Node'enum -> Rep (Parsed Node'enum) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'enum))
deriving instance (Std_.Eq (C.Parsed Node'enum))
instance (C.Parse Node'enum (C.Parsed Node'enum)) where
    parse :: Raw 'Const Node'enum -> m (Parsed Node'enum)
parse Raw 'Const Node'enum
raw_ = (Vector (Parsed Enumerant) -> Parsed Node'enum
Parsed (List Enumerant) -> Parsed Node'enum
Node'enum' (Vector (Parsed Enumerant) -> Parsed Node'enum)
-> m (Vector (Parsed Enumerant)) -> m (Parsed Node'enum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'enum (List Enumerant)
-> Raw 'Const Node'enum -> m (Vector (Parsed Enumerant))
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 "enumerants" (Field 'Slot Node'enum (List Enumerant))
Field 'Slot Node'enum (List Enumerant)
#enumerants Raw 'Const Node'enum
raw_))
instance (C.Marshal Node'enum (C.Parsed Node'enum)) where
    marshalInto :: Raw ('Mut s) Node'enum -> Parsed Node'enum -> m ()
marshalInto Raw ('Mut s) Node'enum
raw_ Node'enum'{..} = (do
        (Field 'Slot Node'enum (List Enumerant)
-> Vector (Parsed Enumerant) -> Raw ('Mut s) Node'enum -> 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 "enumerants" (Field 'Slot Node'enum (List Enumerant))
Field 'Slot Node'enum (List Enumerant)
#enumerants Vector (Parsed Enumerant)
Parsed (List Enumerant)
enumerants Raw ('Mut s) Node'enum
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "enumerants" GH.Slot Node'enum (R.List Enumerant)) where
    fieldByLabel :: Field 'Slot Node'enum (List Enumerant)
fieldByLabel  = (Word16 -> Field 'Slot Node'enum (List Enumerant)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
data Node'interface 
type instance (R.ReprFor Node'interface) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'interface) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node'interface) where
    type AllocHint Node'interface = ()
    new :: AllocHint Node'interface
-> Message ('Mut s) -> m (Raw ('Mut s) Node'interface)
new AllocHint Node'interface
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'interface)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'interface (C.Parsed Node'interface))
instance (C.AllocateList Node'interface) where
    type ListAllocHint Node'interface = Std_.Int
    newList :: ListAllocHint Node'interface
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'interface))
newList  = ListAllocHint Node'interface
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'interface))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'interface (C.Parsed Node'interface))
data instance C.Parsed Node'interface
    = Node'interface' 
        {Parsed Node'interface -> Parsed (List Method)
methods :: (RP.Parsed (R.List Method))
        ,Parsed Node'interface -> Parsed (List Superclass)
superclasses :: (RP.Parsed (R.List Superclass))}
    deriving((forall x. Parsed Node'interface -> Rep (Parsed Node'interface) x)
-> (forall x.
    Rep (Parsed Node'interface) x -> Parsed Node'interface)
-> Generic (Parsed Node'interface)
forall x. Rep (Parsed Node'interface) x -> Parsed Node'interface
forall x. Parsed Node'interface -> Rep (Parsed Node'interface) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'interface) x -> Parsed Node'interface
$cfrom :: forall x. Parsed Node'interface -> Rep (Parsed Node'interface) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'interface))
deriving instance (Std_.Eq (C.Parsed Node'interface))
instance (C.Parse Node'interface (C.Parsed Node'interface)) where
    parse :: Raw 'Const Node'interface -> m (Parsed Node'interface)
parse Raw 'Const Node'interface
raw_ = (Vector (Parsed Method)
-> Vector (Parsed Superclass) -> Parsed Node'interface
Parsed (List Method)
-> Parsed (List Superclass) -> Parsed Node'interface
Node'interface' (Vector (Parsed Method)
 -> Vector (Parsed Superclass) -> Parsed Node'interface)
-> m (Vector (Parsed Method))
-> m (Vector (Parsed Superclass) -> Parsed Node'interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'interface (List Method)
-> Raw 'Const Node'interface -> m (Vector (Parsed Method))
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 "methods" (Field 'Slot Node'interface (List Method))
Field 'Slot Node'interface (List Method)
#methods Raw 'Const Node'interface
raw_)
                                  m (Vector (Parsed Superclass) -> Parsed Node'interface)
-> m (Vector (Parsed Superclass)) -> m (Parsed Node'interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'interface (List Superclass)
-> Raw 'Const Node'interface -> m (Vector (Parsed Superclass))
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
  "superclasses" (Field 'Slot Node'interface (List Superclass))
Field 'Slot Node'interface (List Superclass)
#superclasses Raw 'Const Node'interface
raw_))
instance (C.Marshal Node'interface (C.Parsed Node'interface)) where
    marshalInto :: Raw ('Mut s) Node'interface -> Parsed Node'interface -> m ()
marshalInto Raw ('Mut s) Node'interface
raw_ Node'interface'{..} = (do
        (Field 'Slot Node'interface (List Method)
-> Vector (Parsed Method) -> Raw ('Mut s) Node'interface -> 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 "methods" (Field 'Slot Node'interface (List Method))
Field 'Slot Node'interface (List Method)
#methods Vector (Parsed Method)
Parsed (List Method)
methods Raw ('Mut s) Node'interface
raw_)
        (Field 'Slot Node'interface (List Superclass)
-> Vector (Parsed Superclass)
-> Raw ('Mut s) Node'interface
-> 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
  "superclasses" (Field 'Slot Node'interface (List Superclass))
Field 'Slot Node'interface (List Superclass)
#superclasses Vector (Parsed Superclass)
Parsed (List Superclass)
superclasses Raw ('Mut s) Node'interface
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "methods" GH.Slot Node'interface (R.List Method)) where
    fieldByLabel :: Field 'Slot Node'interface (List Method)
fieldByLabel  = (Word16 -> Field 'Slot Node'interface (List Method)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
instance (GH.HasField "superclasses" GH.Slot Node'interface (R.List Superclass)) where
    fieldByLabel :: Field 'Slot Node'interface (List Superclass)
fieldByLabel  = (Word16 -> Field 'Slot Node'interface (List Superclass)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
4)
data Node'const 
type instance (R.ReprFor Node'const) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'const) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node'const) where
    type AllocHint Node'const = ()
    new :: AllocHint Node'const
-> Message ('Mut s) -> m (Raw ('Mut s) Node'const)
new AllocHint Node'const
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'const)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'const (C.Parsed Node'const))
instance (C.AllocateList Node'const) where
    type ListAllocHint Node'const = Std_.Int
    newList :: ListAllocHint Node'const
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'const))
newList  = ListAllocHint Node'const
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'const))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'const (C.Parsed Node'const))
data instance C.Parsed Node'const
    = Node'const' 
        {Parsed Node'const -> Parsed Type
type_ :: (RP.Parsed Type)
        ,Parsed Node'const -> Parsed Value
value :: (RP.Parsed Value)}
    deriving((forall x. Parsed Node'const -> Rep (Parsed Node'const) x)
-> (forall x. Rep (Parsed Node'const) x -> Parsed Node'const)
-> Generic (Parsed Node'const)
forall x. Rep (Parsed Node'const) x -> Parsed Node'const
forall x. Parsed Node'const -> Rep (Parsed Node'const) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'const) x -> Parsed Node'const
$cfrom :: forall x. Parsed Node'const -> Rep (Parsed Node'const) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'const))
deriving instance (Std_.Eq (C.Parsed Node'const))
instance (C.Parse Node'const (C.Parsed Node'const)) where
    parse :: Raw 'Const Node'const -> m (Parsed Node'const)
parse Raw 'Const Node'const
raw_ = (Parsed Type -> Parsed Value -> Parsed Node'const
Parsed Type -> Parsed Value -> Parsed Node'const
Node'const' (Parsed Type -> Parsed Value -> Parsed Node'const)
-> m (Parsed Type) -> m (Parsed Value -> Parsed Node'const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'const Type
-> Raw 'Const Node'const -> m (Parsed Type)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "type_" (Field 'Slot Node'const Type)
Field 'Slot Node'const Type
#type_ Raw 'Const Node'const
raw_)
                              m (Parsed Value -> Parsed Node'const)
-> m (Parsed Value) -> m (Parsed Node'const)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'const Value
-> Raw 'Const Node'const -> m (Parsed Value)
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 "value" (Field 'Slot Node'const Value)
Field 'Slot Node'const Value
#value Raw 'Const Node'const
raw_))
instance (C.Marshal Node'const (C.Parsed Node'const)) where
    marshalInto :: Raw ('Mut s) Node'const -> Parsed Node'const -> m ()
marshalInto Raw ('Mut s) Node'const
raw_ Node'const'{..} = (do
        (Field 'Slot Node'const Type
-> Parsed Type -> Raw ('Mut s) Node'const -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "type_" (Field 'Slot Node'const Type)
Field 'Slot Node'const Type
#type_ Parsed Type
Parsed Type
type_ Raw ('Mut s) Node'const
raw_)
        (Field 'Slot Node'const Value
-> Parsed Value -> Raw ('Mut s) Node'const -> 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 "value" (Field 'Slot Node'const Value)
Field 'Slot Node'const Value
#value Parsed Value
Parsed Value
value Raw ('Mut s) Node'const
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "type_" GH.Slot Node'const Type) where
    fieldByLabel :: Field 'Slot Node'const Type
fieldByLabel  = (Word16 -> Field 'Slot Node'const Type
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
instance (GH.HasField "value" GH.Slot Node'const Value) where
    fieldByLabel :: Field 'Slot Node'const Value
fieldByLabel  = (Word16 -> Field 'Slot Node'const Value
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
4)
data Node'annotation 
type instance (R.ReprFor Node'annotation) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'annotation) where
    numStructWords :: Word16
numStructWords  = Word16
5
    numStructPtrs :: Word16
numStructPtrs  = Word16
6
instance (C.Allocate Node'annotation) where
    type AllocHint Node'annotation = ()
    new :: AllocHint Node'annotation
-> Message ('Mut s) -> m (Raw ('Mut s) Node'annotation)
new AllocHint Node'annotation
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'annotation)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'annotation (C.Parsed Node'annotation))
instance (C.AllocateList Node'annotation) where
    type ListAllocHint Node'annotation = Std_.Int
    newList :: ListAllocHint Node'annotation
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'annotation))
newList  = ListAllocHint Node'annotation
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'annotation))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'annotation (C.Parsed Node'annotation))
data instance C.Parsed Node'annotation
    = Node'annotation' 
        {Parsed Node'annotation -> Parsed Type
type_ :: (RP.Parsed Type)
        ,Parsed Node'annotation -> Parsed Bool
targetsFile :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsConst :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsEnum :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsEnumerant :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsStruct :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsField :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsUnion :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsGroup :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsInterface :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsMethod :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsParam :: (RP.Parsed Std_.Bool)
        ,Parsed Node'annotation -> Parsed Bool
targetsAnnotation :: (RP.Parsed Std_.Bool)}
    deriving((forall x.
 Parsed Node'annotation -> Rep (Parsed Node'annotation) x)
-> (forall x.
    Rep (Parsed Node'annotation) x -> Parsed Node'annotation)
-> Generic (Parsed Node'annotation)
forall x. Rep (Parsed Node'annotation) x -> Parsed Node'annotation
forall x. Parsed Node'annotation -> Rep (Parsed Node'annotation) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'annotation) x -> Parsed Node'annotation
$cfrom :: forall x. Parsed Node'annotation -> Rep (Parsed Node'annotation) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'annotation))
deriving instance (Std_.Eq (C.Parsed Node'annotation))
instance (C.Parse Node'annotation (C.Parsed Node'annotation)) where
    parse :: Raw 'Const Node'annotation -> m (Parsed Node'annotation)
parse Raw 'Const Node'annotation
raw_ = (Parsed Type
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Parsed Node'annotation
Parsed Type
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Bool
-> Parsed Node'annotation
Node'annotation' (Parsed Type
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Parsed Node'annotation)
-> m (Parsed Type)
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'annotation Type
-> Raw 'Const Node'annotation -> m (Parsed Type)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "type_" (Field 'Slot Node'annotation Type)
Field 'Slot Node'annotation Type
#type_ Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsFile" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsFile Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsConst" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsConst Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsEnum" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsEnum Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsEnumerant" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsEnumerant Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsStruct" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsStruct Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool -> Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsField" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsField Raw 'Const Node'annotation
raw_)
                                   m (Bool
   -> Bool -> Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
-> m Bool
-> m (Bool
      -> Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsUnion" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsUnion Raw 'Const Node'annotation
raw_)
                                   m (Bool -> Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
-> m Bool
-> m (Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsGroup" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsGroup Raw 'Const Node'annotation
raw_)
                                   m (Bool -> Bool -> Bool -> Bool -> Parsed Node'annotation)
-> m Bool -> m (Bool -> Bool -> Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsInterface" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsInterface Raw 'Const Node'annotation
raw_)
                                   m (Bool -> Bool -> Bool -> Parsed Node'annotation)
-> m Bool -> m (Bool -> Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsMethod" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsMethod Raw 'Const Node'annotation
raw_)
                                   m (Bool -> Bool -> Parsed Node'annotation)
-> m Bool -> m (Bool -> Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsParam" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsParam Raw 'Const Node'annotation
raw_)
                                   m (Bool -> Parsed Node'annotation)
-> m Bool -> m (Parsed Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'annotation Bool
-> Raw 'Const Node'annotation -> 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 "targetsAnnotation" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsAnnotation Raw 'Const Node'annotation
raw_))
instance (C.Marshal Node'annotation (C.Parsed Node'annotation)) where
    marshalInto :: Raw ('Mut s) Node'annotation -> Parsed Node'annotation -> m ()
marshalInto Raw ('Mut s) Node'annotation
raw_ Node'annotation'{..} = (do
        (Field 'Slot Node'annotation Type
-> Parsed Type -> Raw ('Mut s) Node'annotation -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "type_" (Field 'Slot Node'annotation Type)
Field 'Slot Node'annotation Type
#type_ Parsed Type
Parsed Type
type_ Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsFile" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsFile Bool
Parsed Bool
targetsFile Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsConst" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsConst Bool
Parsed Bool
targetsConst Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsEnum" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsEnum Bool
Parsed Bool
targetsEnum Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsEnumerant" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsEnumerant Bool
Parsed Bool
targetsEnumerant Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsStruct" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsStruct Bool
Parsed Bool
targetsStruct Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsField" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsField Bool
Parsed Bool
targetsField Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsUnion" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsUnion Bool
Parsed Bool
targetsUnion Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsGroup" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsGroup Bool
Parsed Bool
targetsGroup Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsInterface" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsInterface Bool
Parsed Bool
targetsInterface Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsMethod" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsMethod Bool
Parsed Bool
targetsMethod Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsParam" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsParam Bool
Parsed Bool
targetsParam Raw ('Mut s) Node'annotation
raw_)
        (Field 'Slot Node'annotation Bool
-> Bool -> Raw ('Mut s) Node'annotation -> 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 "targetsAnnotation" (Field 'Slot Node'annotation Bool)
Field 'Slot Node'annotation Bool
#targetsAnnotation Bool
Parsed Bool
targetsAnnotation Raw ('Mut s) Node'annotation
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "type_" GH.Slot Node'annotation Type) where
    fieldByLabel :: Field 'Slot Node'annotation Type
fieldByLabel  = (Word16 -> Field 'Slot Node'annotation Type
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
instance (GH.HasField "targetsFile" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
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
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsConst" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
49 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsEnum" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
50 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsEnumerant" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
51 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsStruct" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
52 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsField" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
53 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsUnion" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
54 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsGroup" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
55 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsInterface" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
56 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsMethod" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
57 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsParam" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
58 Word16
1 BitCount
1 Word64
0)
instance (GH.HasField "targetsAnnotation" GH.Slot Node'annotation Std_.Bool) where
    fieldByLabel :: Field 'Slot Node'annotation Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Node'annotation Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
59 Word16
1 BitCount
1 Word64
0)
data Node'Parameter 
type instance (R.ReprFor Node'Parameter) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'Parameter) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Node'Parameter) where
    type AllocHint Node'Parameter = ()
    new :: AllocHint Node'Parameter
-> Message ('Mut s) -> m (Raw ('Mut s) Node'Parameter)
new AllocHint Node'Parameter
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'Parameter)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'Parameter (C.Parsed Node'Parameter))
instance (C.AllocateList Node'Parameter) where
    type ListAllocHint Node'Parameter = Std_.Int
    newList :: ListAllocHint Node'Parameter
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'Parameter))
newList  = ListAllocHint Node'Parameter
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'Parameter))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'Parameter (C.Parsed Node'Parameter))
data instance C.Parsed Node'Parameter
    = Node'Parameter 
        {Parsed Node'Parameter -> Parsed Text
name :: (RP.Parsed Basics.Text)}
    deriving((forall x. Parsed Node'Parameter -> Rep (Parsed Node'Parameter) x)
-> (forall x.
    Rep (Parsed Node'Parameter) x -> Parsed Node'Parameter)
-> Generic (Parsed Node'Parameter)
forall x. Rep (Parsed Node'Parameter) x -> Parsed Node'Parameter
forall x. Parsed Node'Parameter -> Rep (Parsed Node'Parameter) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'Parameter) x -> Parsed Node'Parameter
$cfrom :: forall x. Parsed Node'Parameter -> Rep (Parsed Node'Parameter) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'Parameter))
deriving instance (Std_.Eq (C.Parsed Node'Parameter))
instance (C.Parse Node'Parameter (C.Parsed Node'Parameter)) where
    parse :: Raw 'Const Node'Parameter -> m (Parsed Node'Parameter)
parse Raw 'Const Node'Parameter
raw_ = (Text -> Parsed Node'Parameter
Parsed Text -> Parsed Node'Parameter
Node'Parameter (Text -> Parsed Node'Parameter)
-> m Text -> m (Parsed Node'Parameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'Parameter Text
-> Raw 'Const Node'Parameter -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Node'Parameter Text)
Field 'Slot Node'Parameter Text
#name Raw 'Const Node'Parameter
raw_))
instance (C.Marshal Node'Parameter (C.Parsed Node'Parameter)) where
    marshalInto :: Raw ('Mut s) Node'Parameter -> Parsed Node'Parameter -> m ()
marshalInto Raw ('Mut s) Node'Parameter
raw_ Node'Parameter{..} = (do
        (Field 'Slot Node'Parameter Text
-> Text -> Raw ('Mut s) Node'Parameter -> 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 "name" (Field 'Slot Node'Parameter Text)
Field 'Slot Node'Parameter Text
#name Text
Parsed Text
name Raw ('Mut s) Node'Parameter
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot Node'Parameter Basics.Text) where
    fieldByLabel :: Field 'Slot Node'Parameter Text
fieldByLabel  = (Word16 -> Field 'Slot Node'Parameter Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Node'NestedNode 
type instance (R.ReprFor Node'NestedNode) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'NestedNode) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Node'NestedNode) where
    type AllocHint Node'NestedNode = ()
    new :: AllocHint Node'NestedNode
-> Message ('Mut s) -> m (Raw ('Mut s) Node'NestedNode)
new AllocHint Node'NestedNode
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'NestedNode)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'NestedNode (C.Parsed Node'NestedNode))
instance (C.AllocateList Node'NestedNode) where
    type ListAllocHint Node'NestedNode = Std_.Int
    newList :: ListAllocHint Node'NestedNode
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'NestedNode))
newList  = ListAllocHint Node'NestedNode
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'NestedNode))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'NestedNode (C.Parsed Node'NestedNode))
data instance C.Parsed Node'NestedNode
    = Node'NestedNode 
        {Parsed Node'NestedNode -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed Node'NestedNode -> Parsed Word64
id :: (RP.Parsed Std_.Word64)}
    deriving((forall x.
 Parsed Node'NestedNode -> Rep (Parsed Node'NestedNode) x)
-> (forall x.
    Rep (Parsed Node'NestedNode) x -> Parsed Node'NestedNode)
-> Generic (Parsed Node'NestedNode)
forall x. Rep (Parsed Node'NestedNode) x -> Parsed Node'NestedNode
forall x. Parsed Node'NestedNode -> Rep (Parsed Node'NestedNode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'NestedNode) x -> Parsed Node'NestedNode
$cfrom :: forall x. Parsed Node'NestedNode -> Rep (Parsed Node'NestedNode) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'NestedNode))
deriving instance (Std_.Eq (C.Parsed Node'NestedNode))
instance (C.Parse Node'NestedNode (C.Parsed Node'NestedNode)) where
    parse :: Raw 'Const Node'NestedNode -> m (Parsed Node'NestedNode)
parse Raw 'Const Node'NestedNode
raw_ = (Text -> Word64 -> Parsed Node'NestedNode
Parsed Text -> Parsed Word64 -> Parsed Node'NestedNode
Node'NestedNode (Text -> Word64 -> Parsed Node'NestedNode)
-> m Text -> m (Word64 -> Parsed Node'NestedNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'NestedNode Text
-> Raw 'Const Node'NestedNode -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Node'NestedNode Text)
Field 'Slot Node'NestedNode Text
#name Raw 'Const Node'NestedNode
raw_)
                                  m (Word64 -> Parsed Node'NestedNode)
-> m Word64 -> m (Parsed Node'NestedNode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'NestedNode Word64
-> Raw 'Const Node'NestedNode -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Node'NestedNode Word64)
Field 'Slot Node'NestedNode Word64
#id Raw 'Const Node'NestedNode
raw_))
instance (C.Marshal Node'NestedNode (C.Parsed Node'NestedNode)) where
    marshalInto :: Raw ('Mut s) Node'NestedNode -> Parsed Node'NestedNode -> m ()
marshalInto Raw ('Mut s) Node'NestedNode
raw_ Node'NestedNode{..} = (do
        (Field 'Slot Node'NestedNode Text
-> Text -> Raw ('Mut s) Node'NestedNode -> 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 "name" (Field 'Slot Node'NestedNode Text)
Field 'Slot Node'NestedNode Text
#name Text
Parsed Text
name Raw ('Mut s) Node'NestedNode
raw_)
        (Field 'Slot Node'NestedNode Word64
-> Word64 -> Raw ('Mut s) Node'NestedNode -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Node'NestedNode Word64)
Field 'Slot Node'NestedNode Word64
#id Word64
Parsed Word64
id Raw ('Mut s) Node'NestedNode
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot Node'NestedNode Basics.Text) where
    fieldByLabel :: Field 'Slot Node'NestedNode Text
fieldByLabel  = (Word16 -> Field 'Slot Node'NestedNode Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "id" GH.Slot Node'NestedNode Std_.Word64) where
    fieldByLabel :: Field 'Slot Node'NestedNode Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Node'NestedNode Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
data Node'SourceInfo 
type instance (R.ReprFor Node'SourceInfo) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'SourceInfo) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Node'SourceInfo) where
    type AllocHint Node'SourceInfo = ()
    new :: AllocHint Node'SourceInfo
-> Message ('Mut s) -> m (Raw ('Mut s) Node'SourceInfo)
new AllocHint Node'SourceInfo
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'SourceInfo)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'SourceInfo (C.Parsed Node'SourceInfo))
instance (C.AllocateList Node'SourceInfo) where
    type ListAllocHint Node'SourceInfo = Std_.Int
    newList :: ListAllocHint Node'SourceInfo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'SourceInfo))
newList  = ListAllocHint Node'SourceInfo
-> Message ('Mut s) -> m (Raw ('Mut s) (List Node'SourceInfo))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'SourceInfo (C.Parsed Node'SourceInfo))
data instance C.Parsed Node'SourceInfo
    = Node'SourceInfo 
        {Parsed Node'SourceInfo -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed Node'SourceInfo -> Parsed Text
docComment :: (RP.Parsed Basics.Text)
        ,Parsed Node'SourceInfo -> Parsed (List Node'SourceInfo'Member)
members :: (RP.Parsed (R.List Node'SourceInfo'Member))}
    deriving((forall x.
 Parsed Node'SourceInfo -> Rep (Parsed Node'SourceInfo) x)
-> (forall x.
    Rep (Parsed Node'SourceInfo) x -> Parsed Node'SourceInfo)
-> Generic (Parsed Node'SourceInfo)
forall x. Rep (Parsed Node'SourceInfo) x -> Parsed Node'SourceInfo
forall x. Parsed Node'SourceInfo -> Rep (Parsed Node'SourceInfo) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Node'SourceInfo) x -> Parsed Node'SourceInfo
$cfrom :: forall x. Parsed Node'SourceInfo -> Rep (Parsed Node'SourceInfo) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'SourceInfo))
deriving instance (Std_.Eq (C.Parsed Node'SourceInfo))
instance (C.Parse Node'SourceInfo (C.Parsed Node'SourceInfo)) where
    parse :: Raw 'Const Node'SourceInfo -> m (Parsed Node'SourceInfo)
parse Raw 'Const Node'SourceInfo
raw_ = (Word64
-> Text
-> Vector (Parsed Node'SourceInfo'Member)
-> Parsed Node'SourceInfo
Parsed Word64
-> Parsed Text
-> Parsed (List Node'SourceInfo'Member)
-> Parsed Node'SourceInfo
Node'SourceInfo (Word64
 -> Text
 -> Vector (Parsed Node'SourceInfo'Member)
 -> Parsed Node'SourceInfo)
-> m Word64
-> m (Text
      -> Vector (Parsed Node'SourceInfo'Member)
      -> Parsed Node'SourceInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'SourceInfo Word64
-> Raw 'Const Node'SourceInfo -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Node'SourceInfo Word64)
Field 'Slot Node'SourceInfo Word64
#id Raw 'Const Node'SourceInfo
raw_)
                                  m (Text
   -> Vector (Parsed Node'SourceInfo'Member)
   -> Parsed Node'SourceInfo)
-> m Text
-> m (Vector (Parsed Node'SourceInfo'Member)
      -> Parsed Node'SourceInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'SourceInfo Text
-> Raw 'Const Node'SourceInfo -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "docComment" (Field 'Slot Node'SourceInfo Text)
Field 'Slot Node'SourceInfo Text
#docComment Raw 'Const Node'SourceInfo
raw_)
                                  m (Vector (Parsed Node'SourceInfo'Member)
   -> Parsed Node'SourceInfo)
-> m (Vector (Parsed Node'SourceInfo'Member))
-> m (Parsed Node'SourceInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
-> Raw 'Const Node'SourceInfo
-> m (Vector (Parsed Node'SourceInfo'Member))
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
  "members"
  (Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member))
Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
#members Raw 'Const Node'SourceInfo
raw_))
instance (C.Marshal Node'SourceInfo (C.Parsed Node'SourceInfo)) where
    marshalInto :: Raw ('Mut s) Node'SourceInfo -> Parsed Node'SourceInfo -> m ()
marshalInto Raw ('Mut s) Node'SourceInfo
raw_ Node'SourceInfo{..} = (do
        (Field 'Slot Node'SourceInfo Word64
-> Word64 -> Raw ('Mut s) Node'SourceInfo -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Node'SourceInfo Word64)
Field 'Slot Node'SourceInfo Word64
#id Word64
Parsed Word64
id Raw ('Mut s) Node'SourceInfo
raw_)
        (Field 'Slot Node'SourceInfo Text
-> Text -> Raw ('Mut s) Node'SourceInfo -> 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 "docComment" (Field 'Slot Node'SourceInfo Text)
Field 'Slot Node'SourceInfo Text
#docComment Text
Parsed Text
docComment Raw ('Mut s) Node'SourceInfo
raw_)
        (Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
-> Vector (Parsed Node'SourceInfo'Member)
-> Raw ('Mut s) Node'SourceInfo
-> 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
  "members"
  (Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member))
Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
#members Vector (Parsed Node'SourceInfo'Member)
Parsed (List Node'SourceInfo'Member)
members Raw ('Mut s) Node'SourceInfo
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot Node'SourceInfo Std_.Word64) where
    fieldByLabel :: Field 'Slot Node'SourceInfo Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Node'SourceInfo Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "docComment" GH.Slot Node'SourceInfo Basics.Text) where
    fieldByLabel :: Field 'Slot Node'SourceInfo Text
fieldByLabel  = (Word16 -> Field 'Slot Node'SourceInfo Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "members" GH.Slot Node'SourceInfo (R.List Node'SourceInfo'Member)) where
    fieldByLabel :: Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
fieldByLabel  = (Word16 -> Field 'Slot Node'SourceInfo (List Node'SourceInfo'Member)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data Node'SourceInfo'Member 
type instance (R.ReprFor Node'SourceInfo'Member) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Node'SourceInfo'Member) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Node'SourceInfo'Member) where
    type AllocHint Node'SourceInfo'Member = ()
    new :: AllocHint Node'SourceInfo'Member
-> Message ('Mut s) -> m (Raw ('Mut s) Node'SourceInfo'Member)
new AllocHint Node'SourceInfo'Member
_ = Message ('Mut s) -> m (Raw ('Mut s) Node'SourceInfo'Member)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Node'SourceInfo'Member (C.Parsed Node'SourceInfo'Member))
instance (C.AllocateList Node'SourceInfo'Member) where
    type ListAllocHint Node'SourceInfo'Member = Std_.Int
    newList :: ListAllocHint Node'SourceInfo'Member
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Node'SourceInfo'Member))
newList  = ListAllocHint Node'SourceInfo'Member
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Node'SourceInfo'Member))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Node'SourceInfo'Member (C.Parsed Node'SourceInfo'Member))
data instance C.Parsed Node'SourceInfo'Member
    = Node'SourceInfo'Member 
        {Parsed Node'SourceInfo'Member -> Parsed Text
docComment :: (RP.Parsed Basics.Text)}
    deriving((forall x.
 Parsed Node'SourceInfo'Member
 -> Rep (Parsed Node'SourceInfo'Member) x)
-> (forall x.
    Rep (Parsed Node'SourceInfo'Member) x
    -> Parsed Node'SourceInfo'Member)
-> Generic (Parsed Node'SourceInfo'Member)
forall x.
Rep (Parsed Node'SourceInfo'Member) x
-> Parsed Node'SourceInfo'Member
forall x.
Parsed Node'SourceInfo'Member
-> Rep (Parsed Node'SourceInfo'Member) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Node'SourceInfo'Member) x
-> Parsed Node'SourceInfo'Member
$cfrom :: forall x.
Parsed Node'SourceInfo'Member
-> Rep (Parsed Node'SourceInfo'Member) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Node'SourceInfo'Member))
deriving instance (Std_.Eq (C.Parsed Node'SourceInfo'Member))
instance (C.Parse Node'SourceInfo'Member (C.Parsed Node'SourceInfo'Member)) where
    parse :: Raw 'Const Node'SourceInfo'Member
-> m (Parsed Node'SourceInfo'Member)
parse Raw 'Const Node'SourceInfo'Member
raw_ = (Text -> Parsed Node'SourceInfo'Member
Parsed Text -> Parsed Node'SourceInfo'Member
Node'SourceInfo'Member (Text -> Parsed Node'SourceInfo'Member)
-> m Text -> m (Parsed Node'SourceInfo'Member)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Node'SourceInfo'Member Text
-> Raw 'Const Node'SourceInfo'Member -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "docComment" (Field 'Slot Node'SourceInfo'Member Text)
Field 'Slot Node'SourceInfo'Member Text
#docComment Raw 'Const Node'SourceInfo'Member
raw_))
instance (C.Marshal Node'SourceInfo'Member (C.Parsed Node'SourceInfo'Member)) where
    marshalInto :: Raw ('Mut s) Node'SourceInfo'Member
-> Parsed Node'SourceInfo'Member -> m ()
marshalInto Raw ('Mut s) Node'SourceInfo'Member
raw_ Node'SourceInfo'Member{..} = (do
        (Field 'Slot Node'SourceInfo'Member Text
-> Text -> Raw ('Mut s) Node'SourceInfo'Member -> 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 "docComment" (Field 'Slot Node'SourceInfo'Member Text)
Field 'Slot Node'SourceInfo'Member Text
#docComment Text
Parsed Text
docComment Raw ('Mut s) Node'SourceInfo'Member
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "docComment" GH.Slot Node'SourceInfo'Member Basics.Text) where
    fieldByLabel :: Field 'Slot Node'SourceInfo'Member Text
fieldByLabel  = (Word16 -> Field 'Slot Node'SourceInfo'Member Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Field 
type instance (R.ReprFor Field) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Field) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
4
instance (C.Allocate Field) where
    type AllocHint Field = ()
    new :: AllocHint Field -> Message ('Mut s) -> m (Raw ('Mut s) Field)
new AllocHint Field
_ = Message ('Mut s) -> m (Raw ('Mut s) Field)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Field (C.Parsed Field))
instance (C.AllocateList Field) where
    type ListAllocHint Field = Std_.Int
    newList :: ListAllocHint Field
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field))
newList  = ListAllocHint Field
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Field (C.Parsed Field))
data instance C.Parsed Field
    = Field 
        {Parsed Field -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed Field -> Parsed Word16
codeOrder :: (RP.Parsed Std_.Word16)
        ,Parsed Field -> Parsed (List Annotation)
annotations :: (RP.Parsed (R.List Annotation))
        ,Parsed Field -> Parsed Word16
discriminantValue :: (RP.Parsed Std_.Word16)
        ,Parsed Field -> Parsed Field'ordinal
ordinal :: (RP.Parsed Field'ordinal)
        ,Parsed Field -> Parsed (Which Field)
union' :: (C.Parsed (GH.Which Field))}
    deriving((forall x. Parsed Field -> Rep (Parsed Field) x)
-> (forall x. Rep (Parsed Field) x -> Parsed Field)
-> Generic (Parsed Field)
forall x. Rep (Parsed Field) x -> Parsed Field
forall x. Parsed Field -> Rep (Parsed Field) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Field) x -> Parsed Field
$cfrom :: forall x. Parsed Field -> Rep (Parsed Field) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Field))
deriving instance (Std_.Eq (C.Parsed Field))
instance (C.Parse Field (C.Parsed Field)) where
    parse :: Raw 'Const Field -> m (Parsed Field)
parse Raw 'Const Field
raw_ = (Text
-> Word16
-> Vector (Parsed Annotation)
-> Word16
-> Parsed Field'ordinal
-> Parsed (Which Field)
-> Parsed Field
Parsed Text
-> Parsed Word16
-> Parsed (List Annotation)
-> Parsed Word16
-> Parsed Field'ordinal
-> Parsed (Which Field)
-> Parsed Field
Field (Text
 -> Word16
 -> Vector (Parsed Annotation)
 -> Word16
 -> Parsed Field'ordinal
 -> Parsed (Which Field)
 -> Parsed Field)
-> m Text
-> m (Word16
      -> Vector (Parsed Annotation)
      -> Word16
      -> Parsed Field'ordinal
      -> Parsed (Which Field)
      -> Parsed Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Field Text -> Raw 'Const Field -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Field Text)
Field 'Slot Field Text
#name Raw 'Const Field
raw_)
                        m (Word16
   -> Vector (Parsed Annotation)
   -> Word16
   -> Parsed Field'ordinal
   -> Parsed (Which Field)
   -> Parsed Field)
-> m Word16
-> m (Vector (Parsed Annotation)
      -> Word16
      -> Parsed Field'ordinal
      -> Parsed (Which Field)
      -> Parsed Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field Word16 -> Raw 'Const Field -> 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 "codeOrder" (Field 'Slot Field Word16)
Field 'Slot Field Word16
#codeOrder Raw 'Const Field
raw_)
                        m (Vector (Parsed Annotation)
   -> Word16
   -> Parsed Field'ordinal
   -> Parsed (Which Field)
   -> Parsed Field)
-> m (Vector (Parsed Annotation))
-> m (Word16
      -> Parsed Field'ordinal -> Parsed (Which Field) -> Parsed Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field (List Annotation)
-> Raw 'Const Field -> m (Vector (Parsed Annotation))
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 "annotations" (Field 'Slot Field (List Annotation))
Field 'Slot Field (List Annotation)
#annotations Raw 'Const Field
raw_)
                        m (Word16
   -> Parsed Field'ordinal -> Parsed (Which Field) -> Parsed Field)
-> m Word16
-> m (Parsed Field'ordinal -> Parsed (Which Field) -> Parsed Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field Word16 -> Raw 'Const Field -> 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 "discriminantValue" (Field 'Slot Field Word16)
Field 'Slot Field Word16
#discriminantValue Raw 'Const Field
raw_)
                        m (Parsed Field'ordinal -> Parsed (Which Field) -> Parsed Field)
-> m (Parsed Field'ordinal)
-> m (Parsed (Which Field) -> Parsed Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Group Field Field'ordinal
-> Raw 'Const Field -> m (Parsed Field'ordinal)
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 "ordinal" (Field 'Group Field Field'ordinal)
Field 'Group Field Field'ordinal
#ordinal Raw 'Const Field
raw_)
                        m (Parsed (Which Field) -> Parsed Field)
-> m (Parsed (Which Field)) -> m (Parsed Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which Field) -> m (Parsed (Which Field))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Field -> Raw 'Const (Which Field)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Field
raw_)))
instance (C.Marshal Field (C.Parsed Field)) where
    marshalInto :: Raw ('Mut s) Field -> Parsed Field -> m ()
marshalInto Raw ('Mut s) Field
raw_ Field{..} = (do
        (Field 'Slot Field Text -> Text -> Raw ('Mut s) Field -> 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 "name" (Field 'Slot Field Text)
Field 'Slot Field Text
#name Text
Parsed Text
name Raw ('Mut s) Field
raw_)
        (Field 'Slot Field Word16 -> Word16 -> Raw ('Mut s) Field -> 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 "codeOrder" (Field 'Slot Field Word16)
Field 'Slot Field Word16
#codeOrder Word16
Parsed Word16
codeOrder Raw ('Mut s) Field
raw_)
        (Field 'Slot Field (List Annotation)
-> Vector (Parsed Annotation) -> Raw ('Mut s) Field -> 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 "annotations" (Field 'Slot Field (List Annotation))
Field 'Slot Field (List Annotation)
#annotations Vector (Parsed Annotation)
Parsed (List Annotation)
annotations Raw ('Mut s) Field
raw_)
        (Field 'Slot Field Word16 -> Word16 -> Raw ('Mut s) Field -> 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 "discriminantValue" (Field 'Slot Field Word16)
Field 'Slot Field Word16
#discriminantValue Word16
Parsed Word16
discriminantValue Raw ('Mut s) Field
raw_)
        (do
            Raw ('Mut s) Field'ordinal
group_ <- (Field 'Group Field Field'ordinal
-> Raw ('Mut s) Field -> m (Raw ('Mut s) Field'ordinal)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw mut a -> m (Raw mut b)
GH.readField IsLabel "ordinal" (Field 'Group Field Field'ordinal)
Field 'Group Field Field'ordinal
#ordinal Raw ('Mut s) Field
raw_)
            (Raw ('Mut s) Field'ordinal -> Parsed Field'ordinal -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Field'ordinal
group_ Parsed Field'ordinal
Parsed Field'ordinal
ordinal)
            )
        (Raw ('Mut s) (Which Field) -> Parsed (Which Field) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Field -> Raw ('Mut s) (Which Field)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Field
raw_) Parsed (Which Field)
union')
        )
instance (GH.HasUnion Field) where
    unionField :: Field 'Slot Field Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
16 Word64
0)
    data RawWhich mut_ Field
        = RW_Field'slot (R.Raw mut_ Field'slot)
        | RW_Field'group (R.Raw mut_ Field'group)
        | RW_Field'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Field -> m (RawWhich mut Field)
internalWhich Word16
tag_ Raw mut Field
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Field'slot -> RawWhich mut Field
forall (mut_ :: Mutability).
Raw mut_ Field'slot -> RawWhich mut_ Field
RW_Field'slot (Raw mut Field'slot -> RawWhich mut Field)
-> m (Raw mut Field'slot) -> m (RawWhich mut Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Field Field'slot
-> Raw mut Field -> m (Raw mut Field'slot)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "slot" (Variant 'Group Field Field'slot)
Variant 'Group Field Field'slot
#slot Raw mut Field
struct_))
        Word16
1 ->
            (Raw mut Field'group -> RawWhich mut Field
forall (mut_ :: Mutability).
Raw mut_ Field'group -> RawWhich mut_ Field
RW_Field'group (Raw mut Field'group -> RawWhich mut Field)
-> m (Raw mut Field'group) -> m (RawWhich mut Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Field Field'group
-> Raw mut Field -> m (Raw mut Field'group)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "group" (Variant 'Group Field Field'group)
Variant 'Group Field Field'group
#group Raw mut Field
struct_))
        Word16
_ ->
            (RawWhich mut Field -> m (RawWhich mut Field)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Field
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Field
RW_Field'unknown' Word16
tag_))
    data Which Field
instance (GH.HasVariant "slot" GH.Group Field Field'slot) where
    variantByLabel :: Variant 'Group Field Field'slot
variantByLabel  = (Field 'Group Field Field'slot
-> Word16 -> Variant 'Group Field Field'slot
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Field Field'slot
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
0)
instance (GH.HasVariant "group" GH.Group Field Field'group) where
    variantByLabel :: Variant 'Group Field Field'group
variantByLabel  = (Field 'Group Field Field'group
-> Word16 -> Variant 'Group Field Field'group
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Field Field'group
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
1)
data instance C.Parsed (GH.Which Field)
    = Field'slot (RP.Parsed Field'slot)
    | Field'group (RP.Parsed Field'group)
    | Field'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Field) -> Rep (Parsed (Which Field)) x)
-> (forall x. Rep (Parsed (Which Field)) x -> Parsed (Which Field))
-> Generic (Parsed (Which Field))
forall x. Rep (Parsed (Which Field)) x -> Parsed (Which Field)
forall x. Parsed (Which Field) -> Rep (Parsed (Which Field)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Field)) x -> Parsed (Which Field)
$cfrom :: forall x. Parsed (Which Field) -> Rep (Parsed (Which Field)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Field)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Field)))
instance (C.Parse (GH.Which Field) (C.Parsed (GH.Which Field))) where
    parse :: Raw 'Const (Which Field) -> m (Parsed (Which Field))
parse Raw 'Const (Which Field)
raw_ = (do
        RawWhich 'Const Field
rawWhich_ <- (Raw 'Const (Which Field) -> m (RawWhich 'Const Field)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Field)
raw_)
        case RawWhich 'Const Field
rawWhich_ of
            (RW_Field'slot rawArg_) ->
                (Parsed Field'slot -> Parsed (Which Field)
Parsed Field'slot -> Parsed (Which Field)
Field'slot (Parsed Field'slot -> Parsed (Which Field))
-> m (Parsed Field'slot) -> m (Parsed (Which Field))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Field'slot -> m (Parsed Field'slot)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Field'slot
rawArg_))
            (RW_Field'group rawArg_) ->
                (Parsed Field'group -> Parsed (Which Field)
Parsed Field'group -> Parsed (Which Field)
Field'group (Parsed Field'group -> Parsed (Which Field))
-> m (Parsed Field'group) -> m (Parsed (Which Field))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Field'group -> m (Parsed Field'group)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Field'group
rawArg_))
            (RW_Field'unknown' tag_) ->
                (Parsed (Which Field) -> m (Parsed (Which Field))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Field)
Field'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Field) (C.Parsed (GH.Which Field))) where
    marshalInto :: Raw ('Mut s) (Which Field) -> Parsed (Which Field) -> m ()
marshalInto Raw ('Mut s) (Which Field)
raw_ Parsed (Which Field)
parsed_ = case Parsed (Which Field)
parsed_ of
        (Field'slot arg_) ->
            (do
                Raw ('Mut s) Field'slot
rawGroup_ <- (Variant 'Group Field Field'slot
-> Raw ('Mut s) Field -> m (Raw ('Mut s) Field'slot)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "slot" (Variant 'Group Field Field'slot)
Variant 'Group Field Field'slot
#slot (Raw ('Mut s) (Which Field) -> Raw ('Mut s) Field
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field)
raw_))
                (Raw ('Mut s) Field'slot -> Parsed Field'slot -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Field'slot
rawGroup_ Parsed Field'slot
Parsed Field'slot
arg_)
                )
        (Field'group arg_) ->
            (do
                Raw ('Mut s) Field'group
rawGroup_ <- (Variant 'Group Field Field'group
-> Raw ('Mut s) Field -> m (Raw ('Mut s) Field'group)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "group" (Variant 'Group Field Field'group)
Variant 'Group Field Field'group
#group (Raw ('Mut s) (Which Field) -> Raw ('Mut s) Field
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field)
raw_))
                (Raw ('Mut s) Field'group -> Parsed Field'group -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Field'group
rawGroup_ Parsed Field'group
Parsed Field'group
arg_)
                )
        (Field'unknown' tag_) ->
            (Field 'Slot Field Word16 -> Word16 -> Raw ('Mut s) Field -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Field Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Field) -> Raw ('Mut s) Field
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field)
raw_))
instance (GH.HasField "name" GH.Slot Field Basics.Text) where
    fieldByLabel :: Field 'Slot Field Text
fieldByLabel  = (Word16 -> Field 'Slot Field Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "codeOrder" GH.Slot Field Std_.Word16) where
    fieldByLabel :: Field 'Slot Field Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "annotations" GH.Slot Field (R.List Annotation)) where
    fieldByLabel :: Field 'Slot Field (List Annotation)
fieldByLabel  = (Word16 -> Field 'Slot Field (List Annotation)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
instance (GH.HasField "discriminantValue" GH.Slot Field Std_.Word16) where
    fieldByLabel :: Field 'Slot Field Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
16 Word64
65535)
instance (GH.HasField "ordinal" GH.Group Field Field'ordinal) where
    fieldByLabel :: Field 'Group Field Field'ordinal
fieldByLabel  = Field 'Group Field Field'ordinal
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField
data Field'slot 
type instance (R.ReprFor Field'slot) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Field'slot) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
4
instance (C.Allocate Field'slot) where
    type AllocHint Field'slot = ()
    new :: AllocHint Field'slot
-> Message ('Mut s) -> m (Raw ('Mut s) Field'slot)
new AllocHint Field'slot
_ = Message ('Mut s) -> m (Raw ('Mut s) Field'slot)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Field'slot (C.Parsed Field'slot))
instance (C.AllocateList Field'slot) where
    type ListAllocHint Field'slot = Std_.Int
    newList :: ListAllocHint Field'slot
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'slot))
newList  = ListAllocHint Field'slot
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'slot))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Field'slot (C.Parsed Field'slot))
data instance C.Parsed Field'slot
    = Field'slot' 
        {Parsed Field'slot -> Parsed Word32
offset :: (RP.Parsed Std_.Word32)
        ,Parsed Field'slot -> Parsed Type
type_ :: (RP.Parsed Type)
        ,Parsed Field'slot -> Parsed Value
defaultValue :: (RP.Parsed Value)
        ,Parsed Field'slot -> Parsed Bool
hadExplicitDefault :: (RP.Parsed Std_.Bool)}
    deriving((forall x. Parsed Field'slot -> Rep (Parsed Field'slot) x)
-> (forall x. Rep (Parsed Field'slot) x -> Parsed Field'slot)
-> Generic (Parsed Field'slot)
forall x. Rep (Parsed Field'slot) x -> Parsed Field'slot
forall x. Parsed Field'slot -> Rep (Parsed Field'slot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Field'slot) x -> Parsed Field'slot
$cfrom :: forall x. Parsed Field'slot -> Rep (Parsed Field'slot) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Field'slot))
deriving instance (Std_.Eq (C.Parsed Field'slot))
instance (C.Parse Field'slot (C.Parsed Field'slot)) where
    parse :: Raw 'Const Field'slot -> m (Parsed Field'slot)
parse Raw 'Const Field'slot
raw_ = (Word32 -> Parsed Type -> Parsed Value -> Bool -> Parsed Field'slot
Parsed Word32
-> Parsed Type -> Parsed Value -> Parsed Bool -> Parsed Field'slot
Field'slot' (Word32
 -> Parsed Type -> Parsed Value -> Bool -> Parsed Field'slot)
-> m Word32
-> m (Parsed Type -> Parsed Value -> Bool -> Parsed Field'slot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Field'slot Word32 -> Raw 'Const Field'slot -> 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 "offset" (Field 'Slot Field'slot Word32)
Field 'Slot Field'slot Word32
#offset Raw 'Const Field'slot
raw_)
                              m (Parsed Type -> Parsed Value -> Bool -> Parsed Field'slot)
-> m (Parsed Type) -> m (Parsed Value -> Bool -> Parsed Field'slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field'slot Type
-> Raw 'Const Field'slot -> m (Parsed Type)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "type_" (Field 'Slot Field'slot Type)
Field 'Slot Field'slot Type
#type_ Raw 'Const Field'slot
raw_)
                              m (Parsed Value -> Bool -> Parsed Field'slot)
-> m (Parsed Value) -> m (Bool -> Parsed Field'slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field'slot Value
-> Raw 'Const Field'slot -> m (Parsed Value)
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 "defaultValue" (Field 'Slot Field'slot Value)
Field 'Slot Field'slot Value
#defaultValue Raw 'Const Field'slot
raw_)
                              m (Bool -> Parsed Field'slot) -> m Bool -> m (Parsed Field'slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Field'slot Bool -> Raw 'Const Field'slot -> 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 "hadExplicitDefault" (Field 'Slot Field'slot Bool)
Field 'Slot Field'slot Bool
#hadExplicitDefault Raw 'Const Field'slot
raw_))
instance (C.Marshal Field'slot (C.Parsed Field'slot)) where
    marshalInto :: Raw ('Mut s) Field'slot -> Parsed Field'slot -> m ()
marshalInto Raw ('Mut s) Field'slot
raw_ Field'slot'{..} = (do
        (Field 'Slot Field'slot Word32
-> Word32 -> Raw ('Mut s) Field'slot -> 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 "offset" (Field 'Slot Field'slot Word32)
Field 'Slot Field'slot Word32
#offset Word32
Parsed Word32
offset Raw ('Mut s) Field'slot
raw_)
        (Field 'Slot Field'slot Type
-> Parsed Type -> Raw ('Mut s) Field'slot -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "type_" (Field 'Slot Field'slot Type)
Field 'Slot Field'slot Type
#type_ Parsed Type
Parsed Type
type_ Raw ('Mut s) Field'slot
raw_)
        (Field 'Slot Field'slot Value
-> Parsed Value -> Raw ('Mut s) Field'slot -> 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 "defaultValue" (Field 'Slot Field'slot Value)
Field 'Slot Field'slot Value
#defaultValue Parsed Value
Parsed Value
defaultValue Raw ('Mut s) Field'slot
raw_)
        (Field 'Slot Field'slot Bool
-> Bool -> Raw ('Mut s) Field'slot -> 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 "hadExplicitDefault" (Field 'Slot Field'slot Bool)
Field 'Slot Field'slot Bool
#hadExplicitDefault Bool
Parsed Bool
hadExplicitDefault Raw ('Mut s) Field'slot
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "offset" GH.Slot Field'slot Std_.Word32) where
    fieldByLabel :: Field 'Slot Field'slot Word32
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field'slot Word32
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
32 Word16
0 BitCount
32 Word64
0)
instance (GH.HasField "type_" GH.Slot Field'slot Type) where
    fieldByLabel :: Field 'Slot Field'slot Type
fieldByLabel  = (Word16 -> Field 'Slot Field'slot Type
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
2)
instance (GH.HasField "defaultValue" GH.Slot Field'slot Value) where
    fieldByLabel :: Field 'Slot Field'slot Value
fieldByLabel  = (Word16 -> Field 'Slot Field'slot Value
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
instance (GH.HasField "hadExplicitDefault" GH.Slot Field'slot Std_.Bool) where
    fieldByLabel :: Field 'Slot Field'slot Bool
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field'slot Bool
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
2 BitCount
1 Word64
0)
data Field'group 
type instance (R.ReprFor Field'group) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Field'group) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
4
instance (C.Allocate Field'group) where
    type AllocHint Field'group = ()
    new :: AllocHint Field'group
-> Message ('Mut s) -> m (Raw ('Mut s) Field'group)
new AllocHint Field'group
_ = Message ('Mut s) -> m (Raw ('Mut s) Field'group)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Field'group (C.Parsed Field'group))
instance (C.AllocateList Field'group) where
    type ListAllocHint Field'group = Std_.Int
    newList :: ListAllocHint Field'group
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'group))
newList  = ListAllocHint Field'group
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'group))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Field'group (C.Parsed Field'group))
data instance C.Parsed Field'group
    = Field'group' 
        {Parsed Field'group -> Parsed Word64
typeId :: (RP.Parsed Std_.Word64)}
    deriving((forall x. Parsed Field'group -> Rep (Parsed Field'group) x)
-> (forall x. Rep (Parsed Field'group) x -> Parsed Field'group)
-> Generic (Parsed Field'group)
forall x. Rep (Parsed Field'group) x -> Parsed Field'group
forall x. Parsed Field'group -> Rep (Parsed Field'group) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Field'group) x -> Parsed Field'group
$cfrom :: forall x. Parsed Field'group -> Rep (Parsed Field'group) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Field'group))
deriving instance (Std_.Eq (C.Parsed Field'group))
instance (C.Parse Field'group (C.Parsed Field'group)) where
    parse :: Raw 'Const Field'group -> m (Parsed Field'group)
parse Raw 'Const Field'group
raw_ = (Word64 -> Parsed Field'group
Parsed Word64 -> Parsed Field'group
Field'group' (Word64 -> Parsed Field'group)
-> m Word64 -> m (Parsed Field'group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Field'group Word64
-> Raw 'Const Field'group -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "typeId" (Field 'Slot Field'group Word64)
Field 'Slot Field'group Word64
#typeId Raw 'Const Field'group
raw_))
instance (C.Marshal Field'group (C.Parsed Field'group)) where
    marshalInto :: Raw ('Mut s) Field'group -> Parsed Field'group -> m ()
marshalInto Raw ('Mut s) Field'group
raw_ Field'group'{..} = (do
        (Field 'Slot Field'group Word64
-> Word64 -> Raw ('Mut s) Field'group -> 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 "typeId" (Field 'Slot Field'group Word64)
Field 'Slot Field'group Word64
#typeId Word64
Parsed Word64
typeId Raw ('Mut s) Field'group
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "typeId" GH.Slot Field'group Std_.Word64) where
    fieldByLabel :: Field 'Slot Field'group Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field'group Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
2 BitCount
64 Word64
0)
data Field'ordinal 
type instance (R.ReprFor Field'ordinal) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Field'ordinal) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
4
instance (C.Allocate Field'ordinal) where
    type AllocHint Field'ordinal = ()
    new :: AllocHint Field'ordinal
-> Message ('Mut s) -> m (Raw ('Mut s) Field'ordinal)
new AllocHint Field'ordinal
_ = Message ('Mut s) -> m (Raw ('Mut s) Field'ordinal)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Field'ordinal (C.Parsed Field'ordinal))
instance (C.AllocateList Field'ordinal) where
    type ListAllocHint Field'ordinal = Std_.Int
    newList :: ListAllocHint Field'ordinal
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'ordinal))
newList  = ListAllocHint Field'ordinal
-> Message ('Mut s) -> m (Raw ('Mut s) (List Field'ordinal))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Field'ordinal (C.Parsed Field'ordinal))
data instance C.Parsed Field'ordinal
    = Field'ordinal' 
        {Parsed Field'ordinal -> Parsed (Which Field'ordinal)
union' :: (C.Parsed (GH.Which Field'ordinal))}
    deriving((forall x. Parsed Field'ordinal -> Rep (Parsed Field'ordinal) x)
-> (forall x. Rep (Parsed Field'ordinal) x -> Parsed Field'ordinal)
-> Generic (Parsed Field'ordinal)
forall x. Rep (Parsed Field'ordinal) x -> Parsed Field'ordinal
forall x. Parsed Field'ordinal -> Rep (Parsed Field'ordinal) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Field'ordinal) x -> Parsed Field'ordinal
$cfrom :: forall x. Parsed Field'ordinal -> Rep (Parsed Field'ordinal) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Field'ordinal))
deriving instance (Std_.Eq (C.Parsed Field'ordinal))
instance (C.Parse Field'ordinal (C.Parsed Field'ordinal)) where
    parse :: Raw 'Const Field'ordinal -> m (Parsed Field'ordinal)
parse Raw 'Const Field'ordinal
raw_ = (Parsed (Which Field'ordinal) -> Parsed Field'ordinal
Field'ordinal' (Parsed (Which Field'ordinal) -> Parsed Field'ordinal)
-> m (Parsed (Which Field'ordinal)) -> m (Parsed Field'ordinal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Field'ordinal)
-> m (Parsed (Which Field'ordinal))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Field'ordinal -> Raw 'Const (Which Field'ordinal)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Field'ordinal
raw_)))
instance (C.Marshal Field'ordinal (C.Parsed Field'ordinal)) where
    marshalInto :: Raw ('Mut s) Field'ordinal -> Parsed Field'ordinal -> m ()
marshalInto Raw ('Mut s) Field'ordinal
raw_ Field'ordinal'{..} = (do
        (Raw ('Mut s) (Which Field'ordinal)
-> Parsed (Which Field'ordinal) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Field'ordinal -> Raw ('Mut s) (Which Field'ordinal)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Field'ordinal
raw_) Parsed (Which Field'ordinal)
union')
        )
instance (GH.HasUnion Field'ordinal) where
    unionField :: Field 'Slot Field'ordinal Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field'ordinal Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
1 BitCount
16 Word64
0)
    data RawWhich mut_ Field'ordinal
        = RW_Field'ordinal'implicit (R.Raw mut_ ())
        | RW_Field'ordinal'explicit (R.Raw mut_ Std_.Word16)
        | RW_Field'ordinal'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Field'ordinal -> m (RawWhich mut Field'ordinal)
internalWhich Word16
tag_ Raw mut Field'ordinal
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Field'ordinal
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Field'ordinal
RW_Field'ordinal'implicit (Raw mut () -> RawWhich mut Field'ordinal)
-> m (Raw mut ()) -> m (RawWhich mut Field'ordinal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Field'ordinal ()
-> Raw mut Field'ordinal -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "implicit" (Variant 'Slot Field'ordinal ())
Variant 'Slot Field'ordinal ()
#implicit Raw mut Field'ordinal
struct_))
        Word16
1 ->
            (Raw mut Word16 -> RawWhich mut Field'ordinal
forall (mut_ :: Mutability).
Raw mut_ Word16 -> RawWhich mut_ Field'ordinal
RW_Field'ordinal'explicit (Raw mut Word16 -> RawWhich mut Field'ordinal)
-> m (Raw mut Word16) -> m (RawWhich mut Field'ordinal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Field'ordinal Word16
-> Raw mut Field'ordinal -> m (Raw mut Word16)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "explicit" (Variant 'Slot Field'ordinal Word16)
Variant 'Slot Field'ordinal Word16
#explicit Raw mut Field'ordinal
struct_))
        Word16
_ ->
            (RawWhich mut Field'ordinal -> m (RawWhich mut Field'ordinal)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Field'ordinal
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Field'ordinal
RW_Field'ordinal'unknown' Word16
tag_))
    data Which Field'ordinal
instance (GH.HasVariant "implicit" GH.Slot Field'ordinal ()) where
    variantByLabel :: Variant 'Slot Field'ordinal ()
variantByLabel  = (Field 'Slot Field'ordinal ()
-> Word16 -> Variant 'Slot Field'ordinal ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Field'ordinal ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "explicit" GH.Slot Field'ordinal Std_.Word16) where
    variantByLabel :: Variant 'Slot Field'ordinal Word16
variantByLabel  = (Field 'Slot Field'ordinal Word16
-> Word16 -> Variant 'Slot Field'ordinal Word16
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Field'ordinal 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
1 BitCount
16 Word64
0) Word16
1)
data instance C.Parsed (GH.Which Field'ordinal)
    = Field'ordinal'implicit 
    | Field'ordinal'explicit (RP.Parsed Std_.Word16)
    | Field'ordinal'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Field'ordinal)
 -> Rep (Parsed (Which Field'ordinal)) x)
-> (forall x.
    Rep (Parsed (Which Field'ordinal)) x
    -> Parsed (Which Field'ordinal))
-> Generic (Parsed (Which Field'ordinal))
forall x.
Rep (Parsed (Which Field'ordinal)) x
-> Parsed (Which Field'ordinal)
forall x.
Parsed (Which Field'ordinal)
-> Rep (Parsed (Which Field'ordinal)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Field'ordinal)) x
-> Parsed (Which Field'ordinal)
$cfrom :: forall x.
Parsed (Which Field'ordinal)
-> Rep (Parsed (Which Field'ordinal)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Field'ordinal)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Field'ordinal)))
instance (C.Parse (GH.Which Field'ordinal) (C.Parsed (GH.Which Field'ordinal))) where
    parse :: Raw 'Const (Which Field'ordinal)
-> m (Parsed (Which Field'ordinal))
parse Raw 'Const (Which Field'ordinal)
raw_ = (do
        RawWhich 'Const Field'ordinal
rawWhich_ <- (Raw 'Const (Which Field'ordinal)
-> m (RawWhich 'Const Field'ordinal)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Field'ordinal)
raw_)
        case RawWhich 'Const Field'ordinal
rawWhich_ of
            (RW_Field'ordinal'implicit _) ->
                (Parsed (Which Field'ordinal) -> m (Parsed (Which Field'ordinal))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Field'ordinal)
Field'ordinal'implicit)
            (RW_Field'ordinal'explicit rawArg_) ->
                (Word16 -> Parsed (Which Field'ordinal)
Parsed Word16 -> Parsed (Which Field'ordinal)
Field'ordinal'explicit (Word16 -> Parsed (Which Field'ordinal))
-> m Word16 -> m (Parsed (Which Field'ordinal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word16 -> m Word16
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word16
rawArg_))
            (RW_Field'ordinal'unknown' tag_) ->
                (Parsed (Which Field'ordinal) -> m (Parsed (Which Field'ordinal))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Field'ordinal)
Field'ordinal'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Field'ordinal) (C.Parsed (GH.Which Field'ordinal))) where
    marshalInto :: Raw ('Mut s) (Which Field'ordinal)
-> Parsed (Which Field'ordinal) -> m ()
marshalInto Raw ('Mut s) (Which Field'ordinal)
raw_ Parsed (Which Field'ordinal)
parsed_ = case Parsed (Which Field'ordinal)
parsed_ of
        (Parsed (Which Field'ordinal)
Field'ordinal'implicit) ->
            (Variant 'Slot Field'ordinal ()
-> () -> Raw ('Mut s) Field'ordinal -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "implicit" (Variant 'Slot Field'ordinal ())
Variant 'Slot Field'ordinal ()
#implicit () (Raw ('Mut s) (Which Field'ordinal) -> Raw ('Mut s) Field'ordinal
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field'ordinal)
raw_))
        (Field'ordinal'explicit arg_) ->
            (Variant 'Slot Field'ordinal Word16
-> Word16 -> Raw ('Mut s) Field'ordinal -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "explicit" (Variant 'Slot Field'ordinal Word16)
Variant 'Slot Field'ordinal Word16
#explicit Word16
Parsed Word16
arg_ (Raw ('Mut s) (Which Field'ordinal) -> Raw ('Mut s) Field'ordinal
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field'ordinal)
raw_))
        (Field'ordinal'unknown' tag_) ->
            (Field 'Slot Field'ordinal Word16
-> Word16 -> Raw ('Mut s) Field'ordinal -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Field'ordinal Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Field'ordinal) -> Raw ('Mut s) Field'ordinal
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Field'ordinal)
raw_))
field'noDiscriminant :: Std_.Word16
field'noDiscriminant :: Word16
field'noDiscriminant  = (Word64 -> Word16
forall a. IsWord a => Word64 -> a
C.fromWord Word64
65535)
data Enumerant 
type instance (R.ReprFor Enumerant) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Enumerant) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Enumerant) where
    type AllocHint Enumerant = ()
    new :: AllocHint Enumerant
-> Message ('Mut s) -> m (Raw ('Mut s) Enumerant)
new AllocHint Enumerant
_ = Message ('Mut s) -> m (Raw ('Mut s) Enumerant)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Enumerant (C.Parsed Enumerant))
instance (C.AllocateList Enumerant) where
    type ListAllocHint Enumerant = Std_.Int
    newList :: ListAllocHint Enumerant
-> Message ('Mut s) -> m (Raw ('Mut s) (List Enumerant))
newList  = ListAllocHint Enumerant
-> Message ('Mut s) -> m (Raw ('Mut s) (List Enumerant))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Enumerant (C.Parsed Enumerant))
data instance C.Parsed Enumerant
    = Enumerant 
        {Parsed Enumerant -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed Enumerant -> Parsed Word16
codeOrder :: (RP.Parsed Std_.Word16)
        ,Parsed Enumerant -> Parsed (List Annotation)
annotations :: (RP.Parsed (R.List Annotation))}
    deriving((forall x. Parsed Enumerant -> Rep (Parsed Enumerant) x)
-> (forall x. Rep (Parsed Enumerant) x -> Parsed Enumerant)
-> Generic (Parsed Enumerant)
forall x. Rep (Parsed Enumerant) x -> Parsed Enumerant
forall x. Parsed Enumerant -> Rep (Parsed Enumerant) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Enumerant) x -> Parsed Enumerant
$cfrom :: forall x. Parsed Enumerant -> Rep (Parsed Enumerant) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Enumerant))
deriving instance (Std_.Eq (C.Parsed Enumerant))
instance (C.Parse Enumerant (C.Parsed Enumerant)) where
    parse :: Raw 'Const Enumerant -> m (Parsed Enumerant)
parse Raw 'Const Enumerant
raw_ = (Text -> Word16 -> Vector (Parsed Annotation) -> Parsed Enumerant
Parsed Text
-> Parsed Word16 -> Parsed (List Annotation) -> Parsed Enumerant
Enumerant (Text -> Word16 -> Vector (Parsed Annotation) -> Parsed Enumerant)
-> m Text
-> m (Word16 -> Vector (Parsed Annotation) -> Parsed Enumerant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Enumerant Text -> Raw 'Const Enumerant -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Enumerant Text)
Field 'Slot Enumerant Text
#name Raw 'Const Enumerant
raw_)
                            m (Word16 -> Vector (Parsed Annotation) -> Parsed Enumerant)
-> m Word16 -> m (Vector (Parsed Annotation) -> Parsed Enumerant)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Enumerant Word16 -> Raw 'Const Enumerant -> 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 "codeOrder" (Field 'Slot Enumerant Word16)
Field 'Slot Enumerant Word16
#codeOrder Raw 'Const Enumerant
raw_)
                            m (Vector (Parsed Annotation) -> Parsed Enumerant)
-> m (Vector (Parsed Annotation)) -> m (Parsed Enumerant)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Enumerant (List Annotation)
-> Raw 'Const Enumerant -> m (Vector (Parsed Annotation))
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 "annotations" (Field 'Slot Enumerant (List Annotation))
Field 'Slot Enumerant (List Annotation)
#annotations Raw 'Const Enumerant
raw_))
instance (C.Marshal Enumerant (C.Parsed Enumerant)) where
    marshalInto :: Raw ('Mut s) Enumerant -> Parsed Enumerant -> m ()
marshalInto Raw ('Mut s) Enumerant
raw_ Enumerant{..} = (do
        (Field 'Slot Enumerant Text
-> Text -> Raw ('Mut s) Enumerant -> 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 "name" (Field 'Slot Enumerant Text)
Field 'Slot Enumerant Text
#name Text
Parsed Text
name Raw ('Mut s) Enumerant
raw_)
        (Field 'Slot Enumerant Word16
-> Word16 -> Raw ('Mut s) Enumerant -> 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 "codeOrder" (Field 'Slot Enumerant Word16)
Field 'Slot Enumerant Word16
#codeOrder Word16
Parsed Word16
codeOrder Raw ('Mut s) Enumerant
raw_)
        (Field 'Slot Enumerant (List Annotation)
-> Vector (Parsed Annotation) -> Raw ('Mut s) Enumerant -> 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 "annotations" (Field 'Slot Enumerant (List Annotation))
Field 'Slot Enumerant (List Annotation)
#annotations Vector (Parsed Annotation)
Parsed (List Annotation)
annotations Raw ('Mut s) Enumerant
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot Enumerant Basics.Text) where
    fieldByLabel :: Field 'Slot Enumerant Text
fieldByLabel  = (Word16 -> Field 'Slot Enumerant Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "codeOrder" GH.Slot Enumerant Std_.Word16) where
    fieldByLabel :: Field 'Slot Enumerant Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Enumerant Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "annotations" GH.Slot Enumerant (R.List Annotation)) where
    fieldByLabel :: Field 'Slot Enumerant (List Annotation)
fieldByLabel  = (Word16 -> Field 'Slot Enumerant (List Annotation)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data Superclass 
type instance (R.ReprFor Superclass) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Superclass) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Superclass) where
    type AllocHint Superclass = ()
    new :: AllocHint Superclass
-> Message ('Mut s) -> m (Raw ('Mut s) Superclass)
new AllocHint Superclass
_ = Message ('Mut s) -> m (Raw ('Mut s) Superclass)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Superclass (C.Parsed Superclass))
instance (C.AllocateList Superclass) where
    type ListAllocHint Superclass = Std_.Int
    newList :: ListAllocHint Superclass
-> Message ('Mut s) -> m (Raw ('Mut s) (List Superclass))
newList  = ListAllocHint Superclass
-> Message ('Mut s) -> m (Raw ('Mut s) (List Superclass))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Superclass (C.Parsed Superclass))
data instance C.Parsed Superclass
    = Superclass 
        {Parsed Superclass -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed Superclass -> Parsed Brand
brand :: (RP.Parsed Brand)}
    deriving((forall x. Parsed Superclass -> Rep (Parsed Superclass) x)
-> (forall x. Rep (Parsed Superclass) x -> Parsed Superclass)
-> Generic (Parsed Superclass)
forall x. Rep (Parsed Superclass) x -> Parsed Superclass
forall x. Parsed Superclass -> Rep (Parsed Superclass) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Superclass) x -> Parsed Superclass
$cfrom :: forall x. Parsed Superclass -> Rep (Parsed Superclass) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Superclass))
deriving instance (Std_.Eq (C.Parsed Superclass))
instance (C.Parse Superclass (C.Parsed Superclass)) where
    parse :: Raw 'Const Superclass -> m (Parsed Superclass)
parse Raw 'Const Superclass
raw_ = (Word64 -> Parsed Brand -> Parsed Superclass
Parsed Word64 -> Parsed Brand -> Parsed Superclass
Superclass (Word64 -> Parsed Brand -> Parsed Superclass)
-> m Word64 -> m (Parsed Brand -> Parsed Superclass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Superclass Word64 -> Raw 'Const Superclass -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Superclass Word64)
Field 'Slot Superclass Word64
#id Raw 'Const Superclass
raw_)
                             m (Parsed Brand -> Parsed Superclass)
-> m (Parsed Brand) -> m (Parsed Superclass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Superclass Brand
-> Raw 'Const Superclass -> m (Parsed Brand)
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 "brand" (Field 'Slot Superclass Brand)
Field 'Slot Superclass Brand
#brand Raw 'Const Superclass
raw_))
instance (C.Marshal Superclass (C.Parsed Superclass)) where
    marshalInto :: Raw ('Mut s) Superclass -> Parsed Superclass -> m ()
marshalInto Raw ('Mut s) Superclass
raw_ Superclass{..} = (do
        (Field 'Slot Superclass Word64
-> Word64 -> Raw ('Mut s) Superclass -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Superclass Word64)
Field 'Slot Superclass Word64
#id Word64
Parsed Word64
id Raw ('Mut s) Superclass
raw_)
        (Field 'Slot Superclass Brand
-> Parsed Brand -> Raw ('Mut s) Superclass -> 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 "brand" (Field 'Slot Superclass Brand)
Field 'Slot Superclass Brand
#brand Parsed Brand
Parsed Brand
brand Raw ('Mut s) Superclass
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot Superclass Std_.Word64) where
    fieldByLabel :: Field 'Slot Superclass Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Superclass Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "brand" GH.Slot Superclass Brand) where
    fieldByLabel :: Field 'Slot Superclass Brand
fieldByLabel  = (Word16 -> Field 'Slot Superclass Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Method 
type instance (R.ReprFor Method) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Method) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
5
instance (C.Allocate Method) where
    type AllocHint Method = ()
    new :: AllocHint Method -> Message ('Mut s) -> m (Raw ('Mut s) Method)
new AllocHint Method
_ = Message ('Mut s) -> m (Raw ('Mut s) Method)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Method (C.Parsed Method))
instance (C.AllocateList Method) where
    type ListAllocHint Method = Std_.Int
    newList :: ListAllocHint Method
-> Message ('Mut s) -> m (Raw ('Mut s) (List Method))
newList  = ListAllocHint Method
-> Message ('Mut s) -> m (Raw ('Mut s) (List Method))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Method (C.Parsed Method))
data instance C.Parsed Method
    = Method 
        {Parsed Method -> Parsed Text
name :: (RP.Parsed Basics.Text)
        ,Parsed Method -> Parsed Word16
codeOrder :: (RP.Parsed Std_.Word16)
        ,Parsed Method -> Parsed Word64
paramStructType :: (RP.Parsed Std_.Word64)
        ,Parsed Method -> Parsed Word64
resultStructType :: (RP.Parsed Std_.Word64)
        ,Parsed Method -> Parsed (List Annotation)
annotations :: (RP.Parsed (R.List Annotation))
        ,Parsed Method -> Parsed Brand
paramBrand :: (RP.Parsed Brand)
        ,Parsed Method -> Parsed Brand
resultBrand :: (RP.Parsed Brand)
        ,Parsed Method -> Parsed (List Node'Parameter)
implicitParameters :: (RP.Parsed (R.List Node'Parameter))}
    deriving((forall x. Parsed Method -> Rep (Parsed Method) x)
-> (forall x. Rep (Parsed Method) x -> Parsed Method)
-> Generic (Parsed Method)
forall x. Rep (Parsed Method) x -> Parsed Method
forall x. Parsed Method -> Rep (Parsed Method) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Method) x -> Parsed Method
$cfrom :: forall x. Parsed Method -> Rep (Parsed Method) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Method))
deriving instance (Std_.Eq (C.Parsed Method))
instance (C.Parse Method (C.Parsed Method)) where
    parse :: Raw 'Const Method -> m (Parsed Method)
parse Raw 'Const Method
raw_ = (Text
-> Word16
-> Word64
-> Word64
-> Vector (Parsed Annotation)
-> Parsed Brand
-> Parsed Brand
-> Vector (Parsed Node'Parameter)
-> Parsed Method
Parsed Text
-> Parsed Word16
-> Parsed Word64
-> Parsed Word64
-> Parsed (List Annotation)
-> Parsed Brand
-> Parsed Brand
-> Parsed (List Node'Parameter)
-> Parsed Method
Method (Text
 -> Word16
 -> Word64
 -> Word64
 -> Vector (Parsed Annotation)
 -> Parsed Brand
 -> Parsed Brand
 -> Vector (Parsed Node'Parameter)
 -> Parsed Method)
-> m Text
-> m (Word16
      -> Word64
      -> Word64
      -> Vector (Parsed Annotation)
      -> Parsed Brand
      -> Parsed Brand
      -> Vector (Parsed Node'Parameter)
      -> Parsed Method)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Method Text -> Raw 'Const Method -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "name" (Field 'Slot Method Text)
Field 'Slot Method Text
#name Raw 'Const Method
raw_)
                         m (Word16
   -> Word64
   -> Word64
   -> Vector (Parsed Annotation)
   -> Parsed Brand
   -> Parsed Brand
   -> Vector (Parsed Node'Parameter)
   -> Parsed Method)
-> m Word16
-> m (Word64
      -> Word64
      -> Vector (Parsed Annotation)
      -> Parsed Brand
      -> Parsed Brand
      -> Vector (Parsed Node'Parameter)
      -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method Word16 -> Raw 'Const Method -> 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 "codeOrder" (Field 'Slot Method Word16)
Field 'Slot Method Word16
#codeOrder Raw 'Const Method
raw_)
                         m (Word64
   -> Word64
   -> Vector (Parsed Annotation)
   -> Parsed Brand
   -> Parsed Brand
   -> Vector (Parsed Node'Parameter)
   -> Parsed Method)
-> m Word64
-> m (Word64
      -> Vector (Parsed Annotation)
      -> Parsed Brand
      -> Parsed Brand
      -> Vector (Parsed Node'Parameter)
      -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method Word64 -> Raw 'Const Method -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "paramStructType" (Field 'Slot Method Word64)
Field 'Slot Method Word64
#paramStructType Raw 'Const Method
raw_)
                         m (Word64
   -> Vector (Parsed Annotation)
   -> Parsed Brand
   -> Parsed Brand
   -> Vector (Parsed Node'Parameter)
   -> Parsed Method)
-> m Word64
-> m (Vector (Parsed Annotation)
      -> Parsed Brand
      -> Parsed Brand
      -> Vector (Parsed Node'Parameter)
      -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method Word64 -> Raw 'Const Method -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "resultStructType" (Field 'Slot Method Word64)
Field 'Slot Method Word64
#resultStructType Raw 'Const Method
raw_)
                         m (Vector (Parsed Annotation)
   -> Parsed Brand
   -> Parsed Brand
   -> Vector (Parsed Node'Parameter)
   -> Parsed Method)
-> m (Vector (Parsed Annotation))
-> m (Parsed Brand
      -> Parsed Brand -> Vector (Parsed Node'Parameter) -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method (List Annotation)
-> Raw 'Const Method -> m (Vector (Parsed Annotation))
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 "annotations" (Field 'Slot Method (List Annotation))
Field 'Slot Method (List Annotation)
#annotations Raw 'Const Method
raw_)
                         m (Parsed Brand
   -> Parsed Brand -> Vector (Parsed Node'Parameter) -> Parsed Method)
-> m (Parsed Brand)
-> m (Parsed Brand
      -> Vector (Parsed Node'Parameter) -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method Brand -> Raw 'Const Method -> m (Parsed Brand)
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 "paramBrand" (Field 'Slot Method Brand)
Field 'Slot Method Brand
#paramBrand Raw 'Const Method
raw_)
                         m (Parsed Brand -> Vector (Parsed Node'Parameter) -> Parsed Method)
-> m (Parsed Brand)
-> m (Vector (Parsed Node'Parameter) -> Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method Brand -> Raw 'Const Method -> m (Parsed Brand)
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 "resultBrand" (Field 'Slot Method Brand)
Field 'Slot Method Brand
#resultBrand Raw 'Const Method
raw_)
                         m (Vector (Parsed Node'Parameter) -> Parsed Method)
-> m (Vector (Parsed Node'Parameter)) -> m (Parsed Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Method (List Node'Parameter)
-> Raw 'Const Method -> m (Vector (Parsed Node'Parameter))
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
  "implicitParameters" (Field 'Slot Method (List Node'Parameter))
Field 'Slot Method (List Node'Parameter)
#implicitParameters Raw 'Const Method
raw_))
instance (C.Marshal Method (C.Parsed Method)) where
    marshalInto :: Raw ('Mut s) Method -> Parsed Method -> m ()
marshalInto Raw ('Mut s) Method
raw_ Method{..} = (do
        (Field 'Slot Method Text -> Text -> Raw ('Mut s) Method -> 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 "name" (Field 'Slot Method Text)
Field 'Slot Method Text
#name Text
Parsed Text
name Raw ('Mut s) Method
raw_)
        (Field 'Slot Method Word16 -> Word16 -> Raw ('Mut s) Method -> 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 "codeOrder" (Field 'Slot Method Word16)
Field 'Slot Method Word16
#codeOrder Word16
Parsed Word16
codeOrder Raw ('Mut s) Method
raw_)
        (Field 'Slot Method Word64 -> Word64 -> Raw ('Mut s) Method -> 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 "paramStructType" (Field 'Slot Method Word64)
Field 'Slot Method Word64
#paramStructType Word64
Parsed Word64
paramStructType Raw ('Mut s) Method
raw_)
        (Field 'Slot Method Word64 -> Word64 -> Raw ('Mut s) Method -> 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 "resultStructType" (Field 'Slot Method Word64)
Field 'Slot Method Word64
#resultStructType Word64
Parsed Word64
resultStructType Raw ('Mut s) Method
raw_)
        (Field 'Slot Method (List Annotation)
-> Vector (Parsed Annotation) -> Raw ('Mut s) Method -> 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 "annotations" (Field 'Slot Method (List Annotation))
Field 'Slot Method (List Annotation)
#annotations Vector (Parsed Annotation)
Parsed (List Annotation)
annotations Raw ('Mut s) Method
raw_)
        (Field 'Slot Method Brand
-> Parsed Brand -> Raw ('Mut s) Method -> 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 "paramBrand" (Field 'Slot Method Brand)
Field 'Slot Method Brand
#paramBrand Parsed Brand
Parsed Brand
paramBrand Raw ('Mut s) Method
raw_)
        (Field 'Slot Method Brand
-> Parsed Brand -> Raw ('Mut s) Method -> 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 "resultBrand" (Field 'Slot Method Brand)
Field 'Slot Method Brand
#resultBrand Parsed Brand
Parsed Brand
resultBrand Raw ('Mut s) Method
raw_)
        (Field 'Slot Method (List Node'Parameter)
-> Vector (Parsed Node'Parameter) -> Raw ('Mut s) Method -> 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
  "implicitParameters" (Field 'Slot Method (List Node'Parameter))
Field 'Slot Method (List Node'Parameter)
#implicitParameters Vector (Parsed Node'Parameter)
Parsed (List Node'Parameter)
implicitParameters Raw ('Mut s) Method
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "name" GH.Slot Method Basics.Text) where
    fieldByLabel :: Field 'Slot Method Text
fieldByLabel  = (Word16 -> Field 'Slot Method Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "codeOrder" GH.Slot Method Std_.Word16) where
    fieldByLabel :: Field 'Slot Method Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Method Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "paramStructType" GH.Slot Method Std_.Word64) where
    fieldByLabel :: Field 'Slot Method Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Method Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0)
instance (GH.HasField "resultStructType" GH.Slot Method Std_.Word64) where
    fieldByLabel :: Field 'Slot Method Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Method Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
2 BitCount
64 Word64
0)
instance (GH.HasField "annotations" GH.Slot Method (R.List Annotation)) where
    fieldByLabel :: Field 'Slot Method (List Annotation)
fieldByLabel  = (Word16 -> Field 'Slot Method (List Annotation)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
instance (GH.HasField "paramBrand" GH.Slot Method Brand) where
    fieldByLabel :: Field 'Slot Method Brand
fieldByLabel  = (Word16 -> Field 'Slot Method Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
2)
instance (GH.HasField "resultBrand" GH.Slot Method Brand) where
    fieldByLabel :: Field 'Slot Method Brand
fieldByLabel  = (Word16 -> Field 'Slot Method Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
instance (GH.HasField "implicitParameters" GH.Slot Method (R.List Node'Parameter)) where
    fieldByLabel :: Field 'Slot Method (List Node'Parameter)
fieldByLabel  = (Word16 -> Field 'Slot Method (List Node'Parameter)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
4)
data Type 
type instance (R.ReprFor Type) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type) where
    type AllocHint Type = ()
    new :: AllocHint Type -> Message ('Mut s) -> m (Raw ('Mut s) Type)
new AllocHint Type
_ = Message ('Mut s) -> m (Raw ('Mut s) Type)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type (C.Parsed Type))
instance (C.AllocateList Type) where
    type ListAllocHint Type = Std_.Int
    newList :: ListAllocHint Type
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type))
newList  = ListAllocHint Type
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type (C.Parsed Type))
data instance C.Parsed Type
    = Type 
        {Parsed Type -> Parsed (Which Type)
union' :: (C.Parsed (GH.Which Type))}
    deriving((forall x. Parsed Type -> Rep (Parsed Type) x)
-> (forall x. Rep (Parsed Type) x -> Parsed Type)
-> Generic (Parsed Type)
forall x. Rep (Parsed Type) x -> Parsed Type
forall x. Parsed Type -> Rep (Parsed Type) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type) x -> Parsed Type
$cfrom :: forall x. Parsed Type -> Rep (Parsed Type) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type))
deriving instance (Std_.Eq (C.Parsed Type))
instance (C.Parse Type (C.Parsed Type)) where
    parse :: Raw 'Const Type -> m (Parsed Type)
parse Raw 'Const Type
raw_ = (Parsed (Which Type) -> Parsed Type
Type (Parsed (Which Type) -> Parsed Type)
-> m (Parsed (Which Type)) -> m (Parsed Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Type) -> m (Parsed (Which Type))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Type -> Raw 'Const (Which Type)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Type
raw_)))
instance (C.Marshal Type (C.Parsed Type)) where
    marshalInto :: Raw ('Mut s) Type -> Parsed Type -> m ()
marshalInto Raw ('Mut s) Type
raw_ Type{..} = (do
        (Raw ('Mut s) (Which Type) -> Parsed (Which Type) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Type -> Raw ('Mut s) (Which Type)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Type
raw_) Parsed (Which Type)
union')
        )
instance (GH.HasUnion Type) where
    unionField :: Field 'Slot Type Word16
unionField  = (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Type Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
    data RawWhich mut_ Type
        = RW_Type'void (R.Raw mut_ ())
        | RW_Type'bool (R.Raw mut_ ())
        | RW_Type'int8 (R.Raw mut_ ())
        | RW_Type'int16 (R.Raw mut_ ())
        | RW_Type'int32 (R.Raw mut_ ())
        | RW_Type'int64 (R.Raw mut_ ())
        | RW_Type'uint8 (R.Raw mut_ ())
        | RW_Type'uint16 (R.Raw mut_ ())
        | RW_Type'uint32 (R.Raw mut_ ())
        | RW_Type'uint64 (R.Raw mut_ ())
        | RW_Type'float32 (R.Raw mut_ ())
        | RW_Type'float64 (R.Raw mut_ ())
        | RW_Type'text (R.Raw mut_ ())
        | RW_Type'data_ (R.Raw mut_ ())
        | RW_Type'list (R.Raw mut_ Type'list)
        | RW_Type'enum (R.Raw mut_ Type'enum)
        | RW_Type'struct (R.Raw mut_ Type'struct)
        | RW_Type'interface (R.Raw mut_ Type'interface)
        | RW_Type'anyPointer (R.Raw mut_ Type'anyPointer)
        | RW_Type'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Type -> m (RawWhich mut Type)
internalWhich Word16
tag_ Raw mut Type
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'void (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "void" (Variant 'Slot Type ())
Variant 'Slot Type ()
#void Raw mut Type
struct_))
        Word16
1 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'bool (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "bool" (Variant 'Slot Type ())
Variant 'Slot Type ()
#bool Raw mut Type
struct_))
        Word16
2 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'int8 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int8" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int8 Raw mut Type
struct_))
        Word16
3 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'int16 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int16" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int16 Raw mut Type
struct_))
        Word16
4 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'int32 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int32 Raw mut Type
struct_))
        Word16
5 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'int64 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int64 Raw mut Type
struct_))
        Word16
6 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'uint8 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint8" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint8 Raw mut Type
struct_))
        Word16
7 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'uint16 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint16" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint16 Raw mut Type
struct_))
        Word16
8 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'uint32 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint32 Raw mut Type
struct_))
        Word16
9 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'uint64 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint64 Raw mut Type
struct_))
        Word16
10 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'float32 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "float32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#float32 Raw mut Type
struct_))
        Word16
11 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'float64 (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "float64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#float64 Raw mut Type
struct_))
        Word16
12 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'text (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "text" (Variant 'Slot Type ())
Variant 'Slot Type ()
#text Raw mut Type
struct_))
        Word16
13 ->
            (Raw mut () -> RawWhich mut Type
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Type
RW_Type'data_ (Raw mut () -> RawWhich mut Type)
-> m (Raw mut ()) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type () -> Raw mut Type -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "data_" (Variant 'Slot Type ())
Variant 'Slot Type ()
#data_ Raw mut Type
struct_))
        Word16
14 ->
            (Raw mut Type'list -> RawWhich mut Type
forall (mut_ :: Mutability).
Raw mut_ Type'list -> RawWhich mut_ Type
RW_Type'list (Raw mut Type'list -> RawWhich mut Type)
-> m (Raw mut Type'list) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type Type'list
-> Raw mut Type -> m (Raw mut Type'list)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "list" (Variant 'Group Type Type'list)
Variant 'Group Type Type'list
#list Raw mut Type
struct_))
        Word16
15 ->
            (Raw mut Type'enum -> RawWhich mut Type
forall (mut_ :: Mutability).
Raw mut_ Type'enum -> RawWhich mut_ Type
RW_Type'enum (Raw mut Type'enum -> RawWhich mut Type)
-> m (Raw mut Type'enum) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type Type'enum
-> Raw mut Type -> m (Raw mut Type'enum)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "enum" (Variant 'Group Type Type'enum)
Variant 'Group Type Type'enum
#enum Raw mut Type
struct_))
        Word16
16 ->
            (Raw mut Type'struct -> RawWhich mut Type
forall (mut_ :: Mutability).
Raw mut_ Type'struct -> RawWhich mut_ Type
RW_Type'struct (Raw mut Type'struct -> RawWhich mut Type)
-> m (Raw mut Type'struct) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type Type'struct
-> Raw mut Type -> m (Raw mut Type'struct)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "struct" (Variant 'Group Type Type'struct)
Variant 'Group Type Type'struct
#struct Raw mut Type
struct_))
        Word16
17 ->
            (Raw mut Type'interface -> RawWhich mut Type
forall (mut_ :: Mutability).
Raw mut_ Type'interface -> RawWhich mut_ Type
RW_Type'interface (Raw mut Type'interface -> RawWhich mut Type)
-> m (Raw mut Type'interface) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type Type'interface
-> Raw mut Type -> m (Raw mut Type'interface)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "interface" (Variant 'Group Type Type'interface)
Variant 'Group Type Type'interface
#interface Raw mut Type
struct_))
        Word16
18 ->
            (Raw mut Type'anyPointer -> RawWhich mut Type
forall (mut_ :: Mutability).
Raw mut_ Type'anyPointer -> RawWhich mut_ Type
RW_Type'anyPointer (Raw mut Type'anyPointer -> RawWhich mut Type)
-> m (Raw mut Type'anyPointer) -> m (RawWhich mut Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type Type'anyPointer
-> Raw mut Type -> m (Raw mut Type'anyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "anyPointer" (Variant 'Group Type Type'anyPointer)
Variant 'Group Type Type'anyPointer
#anyPointer Raw mut Type
struct_))
        Word16
_ ->
            (RawWhich mut Type -> m (RawWhich mut Type)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Type
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Type
RW_Type'unknown' Word16
tag_))
    data Which Type
instance (GH.HasVariant "void" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "bool" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
1)
instance (GH.HasVariant "int8" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
2)
instance (GH.HasVariant "int16" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
3)
instance (GH.HasVariant "int32" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
4)
instance (GH.HasVariant "int64" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
5)
instance (GH.HasVariant "uint8" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
6)
instance (GH.HasVariant "uint16" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
7)
instance (GH.HasVariant "uint32" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
8)
instance (GH.HasVariant "uint64" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
9)
instance (GH.HasVariant "float32" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
10)
instance (GH.HasVariant "float64" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
11)
instance (GH.HasVariant "text" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
12)
instance (GH.HasVariant "data_" GH.Slot Type ()) where
    variantByLabel :: Variant 'Slot Type ()
variantByLabel  = (Field 'Slot Type () -> Word16 -> Variant 'Slot Type ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
13)
instance (GH.HasVariant "list" GH.Group Type Type'list) where
    variantByLabel :: Variant 'Group Type Type'list
variantByLabel  = (Field 'Group Type Type'list
-> Word16 -> Variant 'Group Type Type'list
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type Type'list
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
14)
instance (GH.HasVariant "enum" GH.Group Type Type'enum) where
    variantByLabel :: Variant 'Group Type Type'enum
variantByLabel  = (Field 'Group Type Type'enum
-> Word16 -> Variant 'Group Type Type'enum
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type Type'enum
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
15)
instance (GH.HasVariant "struct" GH.Group Type Type'struct) where
    variantByLabel :: Variant 'Group Type Type'struct
variantByLabel  = (Field 'Group Type Type'struct
-> Word16 -> Variant 'Group Type Type'struct
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type Type'struct
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
16)
instance (GH.HasVariant "interface" GH.Group Type Type'interface) where
    variantByLabel :: Variant 'Group Type Type'interface
variantByLabel  = (Field 'Group Type Type'interface
-> Word16 -> Variant 'Group Type Type'interface
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type Type'interface
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
17)
instance (GH.HasVariant "anyPointer" GH.Group Type Type'anyPointer) where
    variantByLabel :: Variant 'Group Type Type'anyPointer
variantByLabel  = (Field 'Group Type Type'anyPointer
-> Word16 -> Variant 'Group Type Type'anyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type Type'anyPointer
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
18)
data instance C.Parsed (GH.Which Type)
    = Type'void 
    | Type'bool 
    | Type'int8 
    | Type'int16 
    | Type'int32 
    | Type'int64 
    | Type'uint8 
    | Type'uint16 
    | Type'uint32 
    | Type'uint64 
    | Type'float32 
    | Type'float64 
    | Type'text 
    | Type'data_ 
    | Type'list (RP.Parsed Type'list)
    | Type'enum (RP.Parsed Type'enum)
    | Type'struct (RP.Parsed Type'struct)
    | Type'interface (RP.Parsed Type'interface)
    | Type'anyPointer (RP.Parsed Type'anyPointer)
    | Type'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Type) -> Rep (Parsed (Which Type)) x)
-> (forall x. Rep (Parsed (Which Type)) x -> Parsed (Which Type))
-> Generic (Parsed (Which Type))
forall x. Rep (Parsed (Which Type)) x -> Parsed (Which Type)
forall x. Parsed (Which Type) -> Rep (Parsed (Which Type)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Type)) x -> Parsed (Which Type)
$cfrom :: forall x. Parsed (Which Type) -> Rep (Parsed (Which Type)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Type)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Type)))
instance (C.Parse (GH.Which Type) (C.Parsed (GH.Which Type))) where
    parse :: Raw 'Const (Which Type) -> m (Parsed (Which Type))
parse Raw 'Const (Which Type)
raw_ = (do
        RawWhich 'Const Type
rawWhich_ <- (Raw 'Const (Which Type) -> m (RawWhich 'Const Type)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Type)
raw_)
        case RawWhich 'Const Type
rawWhich_ of
            (RW_Type'void _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'void)
            (RW_Type'bool _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'bool)
            (RW_Type'int8 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'int8)
            (RW_Type'int16 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'int16)
            (RW_Type'int32 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'int32)
            (RW_Type'int64 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'int64)
            (RW_Type'uint8 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'uint8)
            (RW_Type'uint16 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'uint16)
            (RW_Type'uint32 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'uint32)
            (RW_Type'uint64 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'uint64)
            (RW_Type'float32 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'float32)
            (RW_Type'float64 _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'float64)
            (RW_Type'text _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'text)
            (RW_Type'data_ _) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type)
Type'data_)
            (RW_Type'list rawArg_) ->
                (Parsed Type'list -> Parsed (Which Type)
Parsed Type'list -> Parsed (Which Type)
Type'list (Parsed Type'list -> Parsed (Which Type))
-> m (Parsed Type'list) -> m (Parsed (Which Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'list -> m (Parsed Type'list)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'list
rawArg_))
            (RW_Type'enum rawArg_) ->
                (Parsed Type'enum -> Parsed (Which Type)
Parsed Type'enum -> Parsed (Which Type)
Type'enum (Parsed Type'enum -> Parsed (Which Type))
-> m (Parsed Type'enum) -> m (Parsed (Which Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'enum -> m (Parsed Type'enum)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'enum
rawArg_))
            (RW_Type'struct rawArg_) ->
                (Parsed Type'struct -> Parsed (Which Type)
Parsed Type'struct -> Parsed (Which Type)
Type'struct (Parsed Type'struct -> Parsed (Which Type))
-> m (Parsed Type'struct) -> m (Parsed (Which Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'struct -> m (Parsed Type'struct)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'struct
rawArg_))
            (RW_Type'interface rawArg_) ->
                (Parsed Type'interface -> Parsed (Which Type)
Parsed Type'interface -> Parsed (Which Type)
Type'interface (Parsed Type'interface -> Parsed (Which Type))
-> m (Parsed Type'interface) -> m (Parsed (Which Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'interface -> m (Parsed Type'interface)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'interface
rawArg_))
            (RW_Type'anyPointer rawArg_) ->
                (Parsed Type'anyPointer -> Parsed (Which Type)
Parsed Type'anyPointer -> Parsed (Which Type)
Type'anyPointer (Parsed Type'anyPointer -> Parsed (Which Type))
-> m (Parsed Type'anyPointer) -> m (Parsed (Which Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'anyPointer -> m (Parsed Type'anyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'anyPointer
rawArg_))
            (RW_Type'unknown' tag_) ->
                (Parsed (Which Type) -> m (Parsed (Which Type))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Type)
Type'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Type) (C.Parsed (GH.Which Type))) where
    marshalInto :: Raw ('Mut s) (Which Type) -> Parsed (Which Type) -> m ()
marshalInto Raw ('Mut s) (Which Type)
raw_ Parsed (Which Type)
parsed_ = case Parsed (Which Type)
parsed_ of
        (Parsed (Which Type)
Type'void) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "void" (Variant 'Slot Type ())
Variant 'Slot Type ()
#void () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'bool) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "bool" (Variant 'Slot Type ())
Variant 'Slot Type ()
#bool () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'int8) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int8" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int8 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'int16) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int16" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int16 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'int32) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int32 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'int64) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#int64 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'uint8) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint8" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint8 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'uint16) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint16" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint16 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'uint32) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint32 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'uint64) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#uint64 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'float32) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "float32" (Variant 'Slot Type ())
Variant 'Slot Type ()
#float32 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'float64) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "float64" (Variant 'Slot Type ())
Variant 'Slot Type ()
#float64 () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'text) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "text" (Variant 'Slot Type ())
Variant 'Slot Type ()
#text () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Parsed (Which Type)
Type'data_) ->
            (Variant 'Slot Type () -> () -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "data_" (Variant 'Slot Type ())
Variant 'Slot Type ()
#data_ () (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
        (Type'list arg_) ->
            (do
                Raw ('Mut s) Type'list
rawGroup_ <- (Variant 'Group Type Type'list
-> Raw ('Mut s) Type -> m (Raw ('Mut s) Type'list)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "list" (Variant 'Group Type Type'list)
Variant 'Group Type Type'list
#list (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
                (Raw ('Mut s) Type'list -> Parsed Type'list -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'list
rawGroup_ Parsed Type'list
Parsed Type'list
arg_)
                )
        (Type'enum arg_) ->
            (do
                Raw ('Mut s) Type'enum
rawGroup_ <- (Variant 'Group Type Type'enum
-> Raw ('Mut s) Type -> m (Raw ('Mut s) Type'enum)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "enum" (Variant 'Group Type Type'enum)
Variant 'Group Type Type'enum
#enum (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
                (Raw ('Mut s) Type'enum -> Parsed Type'enum -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'enum
rawGroup_ Parsed Type'enum
Parsed Type'enum
arg_)
                )
        (Type'struct arg_) ->
            (do
                Raw ('Mut s) Type'struct
rawGroup_ <- (Variant 'Group Type Type'struct
-> Raw ('Mut s) Type -> m (Raw ('Mut s) Type'struct)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "struct" (Variant 'Group Type Type'struct)
Variant 'Group Type Type'struct
#struct (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
                (Raw ('Mut s) Type'struct -> Parsed Type'struct -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'struct
rawGroup_ Parsed Type'struct
Parsed Type'struct
arg_)
                )
        (Type'interface arg_) ->
            (do
                Raw ('Mut s) Type'interface
rawGroup_ <- (Variant 'Group Type Type'interface
-> Raw ('Mut s) Type -> m (Raw ('Mut s) Type'interface)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "interface" (Variant 'Group Type Type'interface)
Variant 'Group Type Type'interface
#interface (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
                (Raw ('Mut s) Type'interface -> Parsed Type'interface -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'interface
rawGroup_ Parsed Type'interface
Parsed Type'interface
arg_)
                )
        (Type'anyPointer arg_) ->
            (do
                Raw ('Mut s) Type'anyPointer
rawGroup_ <- (Variant 'Group Type Type'anyPointer
-> Raw ('Mut s) Type -> m (Raw ('Mut s) Type'anyPointer)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel "anyPointer" (Variant 'Group Type Type'anyPointer)
Variant 'Group Type Type'anyPointer
#anyPointer (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
                (Raw ('Mut s) Type'anyPointer -> Parsed Type'anyPointer -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'anyPointer
rawGroup_ Parsed Type'anyPointer
Parsed Type'anyPointer
arg_)
                )
        (Type'unknown' tag_) ->
            (Field 'Slot Type Word16 -> Word16 -> Raw ('Mut s) Type -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Type Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Type) -> Raw ('Mut s) Type
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type)
raw_))
data Type'list 
type instance (R.ReprFor Type'list) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'list) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'list) where
    type AllocHint Type'list = ()
    new :: AllocHint Type'list
-> Message ('Mut s) -> m (Raw ('Mut s) Type'list)
new AllocHint Type'list
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'list)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'list (C.Parsed Type'list))
instance (C.AllocateList Type'list) where
    type ListAllocHint Type'list = Std_.Int
    newList :: ListAllocHint Type'list
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'list))
newList  = ListAllocHint Type'list
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'list))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'list (C.Parsed Type'list))
data instance C.Parsed Type'list
    = Type'list' 
        {Parsed Type'list -> Parsed Type
elementType :: (RP.Parsed Type)}
    deriving((forall x. Parsed Type'list -> Rep (Parsed Type'list) x)
-> (forall x. Rep (Parsed Type'list) x -> Parsed Type'list)
-> Generic (Parsed Type'list)
forall x. Rep (Parsed Type'list) x -> Parsed Type'list
forall x. Parsed Type'list -> Rep (Parsed Type'list) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type'list) x -> Parsed Type'list
$cfrom :: forall x. Parsed Type'list -> Rep (Parsed Type'list) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'list))
deriving instance (Std_.Eq (C.Parsed Type'list))
instance (C.Parse Type'list (C.Parsed Type'list)) where
    parse :: Raw 'Const Type'list -> m (Parsed Type'list)
parse Raw 'Const Type'list
raw_ = (Parsed Type -> Parsed Type'list
Parsed Type -> Parsed Type'list
Type'list' (Parsed Type -> Parsed Type'list)
-> m (Parsed Type) -> m (Parsed Type'list)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'list Type
-> Raw 'Const Type'list -> m (Parsed Type)
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "elementType" (Field 'Slot Type'list Type)
Field 'Slot Type'list Type
#elementType Raw 'Const Type'list
raw_))
instance (C.Marshal Type'list (C.Parsed Type'list)) where
    marshalInto :: Raw ('Mut s) Type'list -> Parsed Type'list -> m ()
marshalInto Raw ('Mut s) Type'list
raw_ Type'list'{..} = (do
        (Field 'Slot Type'list Type
-> Parsed Type -> Raw ('Mut s) Type'list -> 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 "elementType" (Field 'Slot Type'list Type)
Field 'Slot Type'list Type
#elementType Parsed Type
Parsed Type
elementType Raw ('Mut s) Type'list
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "elementType" GH.Slot Type'list Type) where
    fieldByLabel :: Field 'Slot Type'list Type
fieldByLabel  = (Word16 -> Field 'Slot Type'list Type
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Type'enum 
type instance (R.ReprFor Type'enum) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'enum) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'enum) where
    type AllocHint Type'enum = ()
    new :: AllocHint Type'enum
-> Message ('Mut s) -> m (Raw ('Mut s) Type'enum)
new AllocHint Type'enum
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'enum)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'enum (C.Parsed Type'enum))
instance (C.AllocateList Type'enum) where
    type ListAllocHint Type'enum = Std_.Int
    newList :: ListAllocHint Type'enum
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'enum))
newList  = ListAllocHint Type'enum
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'enum))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'enum (C.Parsed Type'enum))
data instance C.Parsed Type'enum
    = Type'enum' 
        {Parsed Type'enum -> Parsed Word64
typeId :: (RP.Parsed Std_.Word64)
        ,Parsed Type'enum -> Parsed Brand
brand :: (RP.Parsed Brand)}
    deriving((forall x. Parsed Type'enum -> Rep (Parsed Type'enum) x)
-> (forall x. Rep (Parsed Type'enum) x -> Parsed Type'enum)
-> Generic (Parsed Type'enum)
forall x. Rep (Parsed Type'enum) x -> Parsed Type'enum
forall x. Parsed Type'enum -> Rep (Parsed Type'enum) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type'enum) x -> Parsed Type'enum
$cfrom :: forall x. Parsed Type'enum -> Rep (Parsed Type'enum) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'enum))
deriving instance (Std_.Eq (C.Parsed Type'enum))
instance (C.Parse Type'enum (C.Parsed Type'enum)) where
    parse :: Raw 'Const Type'enum -> m (Parsed Type'enum)
parse Raw 'Const Type'enum
raw_ = (Word64 -> Parsed Brand -> Parsed Type'enum
Parsed Word64 -> Parsed Brand -> Parsed Type'enum
Type'enum' (Word64 -> Parsed Brand -> Parsed Type'enum)
-> m Word64 -> m (Parsed Brand -> Parsed Type'enum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'enum Word64 -> Raw 'Const Type'enum -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "typeId" (Field 'Slot Type'enum Word64)
Field 'Slot Type'enum Word64
#typeId Raw 'Const Type'enum
raw_)
                             m (Parsed Brand -> Parsed Type'enum)
-> m (Parsed Brand) -> m (Parsed Type'enum)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Type'enum Brand
-> Raw 'Const Type'enum -> m (Parsed Brand)
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 "brand" (Field 'Slot Type'enum Brand)
Field 'Slot Type'enum Brand
#brand Raw 'Const Type'enum
raw_))
instance (C.Marshal Type'enum (C.Parsed Type'enum)) where
    marshalInto :: Raw ('Mut s) Type'enum -> Parsed Type'enum -> m ()
marshalInto Raw ('Mut s) Type'enum
raw_ Type'enum'{..} = (do
        (Field 'Slot Type'enum Word64
-> Word64 -> Raw ('Mut s) Type'enum -> 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 "typeId" (Field 'Slot Type'enum Word64)
Field 'Slot Type'enum Word64
#typeId Word64
Parsed Word64
typeId Raw ('Mut s) Type'enum
raw_)
        (Field 'Slot Type'enum Brand
-> Parsed Brand -> Raw ('Mut s) Type'enum -> 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 "brand" (Field 'Slot Type'enum Brand)
Field 'Slot Type'enum Brand
#brand Parsed Brand
Parsed Brand
brand Raw ('Mut s) Type'enum
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "typeId" GH.Slot Type'enum Std_.Word64) where
    fieldByLabel :: Field 'Slot Type'enum Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Type'enum Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0)
instance (GH.HasField "brand" GH.Slot Type'enum Brand) where
    fieldByLabel :: Field 'Slot Type'enum Brand
fieldByLabel  = (Word16 -> Field 'Slot Type'enum Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Type'struct 
type instance (R.ReprFor Type'struct) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'struct) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'struct) where
    type AllocHint Type'struct = ()
    new :: AllocHint Type'struct
-> Message ('Mut s) -> m (Raw ('Mut s) Type'struct)
new AllocHint Type'struct
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'struct)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'struct (C.Parsed Type'struct))
instance (C.AllocateList Type'struct) where
    type ListAllocHint Type'struct = Std_.Int
    newList :: ListAllocHint Type'struct
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'struct))
newList  = ListAllocHint Type'struct
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'struct))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'struct (C.Parsed Type'struct))
data instance C.Parsed Type'struct
    = Type'struct' 
        {Parsed Type'struct -> Parsed Word64
typeId :: (RP.Parsed Std_.Word64)
        ,Parsed Type'struct -> Parsed Brand
brand :: (RP.Parsed Brand)}
    deriving((forall x. Parsed Type'struct -> Rep (Parsed Type'struct) x)
-> (forall x. Rep (Parsed Type'struct) x -> Parsed Type'struct)
-> Generic (Parsed Type'struct)
forall x. Rep (Parsed Type'struct) x -> Parsed Type'struct
forall x. Parsed Type'struct -> Rep (Parsed Type'struct) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type'struct) x -> Parsed Type'struct
$cfrom :: forall x. Parsed Type'struct -> Rep (Parsed Type'struct) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'struct))
deriving instance (Std_.Eq (C.Parsed Type'struct))
instance (C.Parse Type'struct (C.Parsed Type'struct)) where
    parse :: Raw 'Const Type'struct -> m (Parsed Type'struct)
parse Raw 'Const Type'struct
raw_ = (Word64 -> Parsed Brand -> Parsed Type'struct
Parsed Word64 -> Parsed Brand -> Parsed Type'struct
Type'struct' (Word64 -> Parsed Brand -> Parsed Type'struct)
-> m Word64 -> m (Parsed Brand -> Parsed Type'struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'struct Word64
-> Raw 'Const Type'struct -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "typeId" (Field 'Slot Type'struct Word64)
Field 'Slot Type'struct Word64
#typeId Raw 'Const Type'struct
raw_)
                               m (Parsed Brand -> Parsed Type'struct)
-> m (Parsed Brand) -> m (Parsed Type'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Type'struct Brand
-> Raw 'Const Type'struct -> m (Parsed Brand)
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 "brand" (Field 'Slot Type'struct Brand)
Field 'Slot Type'struct Brand
#brand Raw 'Const Type'struct
raw_))
instance (C.Marshal Type'struct (C.Parsed Type'struct)) where
    marshalInto :: Raw ('Mut s) Type'struct -> Parsed Type'struct -> m ()
marshalInto Raw ('Mut s) Type'struct
raw_ Type'struct'{..} = (do
        (Field 'Slot Type'struct Word64
-> Word64 -> Raw ('Mut s) Type'struct -> 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 "typeId" (Field 'Slot Type'struct Word64)
Field 'Slot Type'struct Word64
#typeId Word64
Parsed Word64
typeId Raw ('Mut s) Type'struct
raw_)
        (Field 'Slot Type'struct Brand
-> Parsed Brand -> Raw ('Mut s) Type'struct -> 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 "brand" (Field 'Slot Type'struct Brand)
Field 'Slot Type'struct Brand
#brand Parsed Brand
Parsed Brand
brand Raw ('Mut s) Type'struct
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "typeId" GH.Slot Type'struct Std_.Word64) where
    fieldByLabel :: Field 'Slot Type'struct Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Type'struct Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0)
instance (GH.HasField "brand" GH.Slot Type'struct Brand) where
    fieldByLabel :: Field 'Slot Type'struct Brand
fieldByLabel  = (Word16 -> Field 'Slot Type'struct Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Type'interface 
type instance (R.ReprFor Type'interface) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'interface) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'interface) where
    type AllocHint Type'interface = ()
    new :: AllocHint Type'interface
-> Message ('Mut s) -> m (Raw ('Mut s) Type'interface)
new AllocHint Type'interface
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'interface)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'interface (C.Parsed Type'interface))
instance (C.AllocateList Type'interface) where
    type ListAllocHint Type'interface = Std_.Int
    newList :: ListAllocHint Type'interface
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'interface))
newList  = ListAllocHint Type'interface
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'interface))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'interface (C.Parsed Type'interface))
data instance C.Parsed Type'interface
    = Type'interface' 
        {Parsed Type'interface -> Parsed Word64
typeId :: (RP.Parsed Std_.Word64)
        ,Parsed Type'interface -> Parsed Brand
brand :: (RP.Parsed Brand)}
    deriving((forall x. Parsed Type'interface -> Rep (Parsed Type'interface) x)
-> (forall x.
    Rep (Parsed Type'interface) x -> Parsed Type'interface)
-> Generic (Parsed Type'interface)
forall x. Rep (Parsed Type'interface) x -> Parsed Type'interface
forall x. Parsed Type'interface -> Rep (Parsed Type'interface) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type'interface) x -> Parsed Type'interface
$cfrom :: forall x. Parsed Type'interface -> Rep (Parsed Type'interface) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'interface))
deriving instance (Std_.Eq (C.Parsed Type'interface))
instance (C.Parse Type'interface (C.Parsed Type'interface)) where
    parse :: Raw 'Const Type'interface -> m (Parsed Type'interface)
parse Raw 'Const Type'interface
raw_ = (Word64 -> Parsed Brand -> Parsed Type'interface
Parsed Word64 -> Parsed Brand -> Parsed Type'interface
Type'interface' (Word64 -> Parsed Brand -> Parsed Type'interface)
-> m Word64 -> m (Parsed Brand -> Parsed Type'interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'interface Word64
-> Raw 'Const Type'interface -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "typeId" (Field 'Slot Type'interface Word64)
Field 'Slot Type'interface Word64
#typeId Raw 'Const Type'interface
raw_)
                                  m (Parsed Brand -> Parsed Type'interface)
-> m (Parsed Brand) -> m (Parsed Type'interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Type'interface Brand
-> Raw 'Const Type'interface -> m (Parsed Brand)
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 "brand" (Field 'Slot Type'interface Brand)
Field 'Slot Type'interface Brand
#brand Raw 'Const Type'interface
raw_))
instance (C.Marshal Type'interface (C.Parsed Type'interface)) where
    marshalInto :: Raw ('Mut s) Type'interface -> Parsed Type'interface -> m ()
marshalInto Raw ('Mut s) Type'interface
raw_ Type'interface'{..} = (do
        (Field 'Slot Type'interface Word64
-> Word64 -> Raw ('Mut s) Type'interface -> 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 "typeId" (Field 'Slot Type'interface Word64)
Field 'Slot Type'interface Word64
#typeId Word64
Parsed Word64
typeId Raw ('Mut s) Type'interface
raw_)
        (Field 'Slot Type'interface Brand
-> Parsed Brand -> Raw ('Mut s) Type'interface -> 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 "brand" (Field 'Slot Type'interface Brand)
Field 'Slot Type'interface Brand
#brand Parsed Brand
Parsed Brand
brand Raw ('Mut s) Type'interface
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "typeId" GH.Slot Type'interface Std_.Word64) where
    fieldByLabel :: Field 'Slot Type'interface Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'interface Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0)
instance (GH.HasField "brand" GH.Slot Type'interface Brand) where
    fieldByLabel :: Field 'Slot Type'interface Brand
fieldByLabel  = (Word16 -> Field 'Slot Type'interface Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Type'anyPointer 
type instance (R.ReprFor Type'anyPointer) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'anyPointer) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'anyPointer) where
    type AllocHint Type'anyPointer = ()
    new :: AllocHint Type'anyPointer
-> Message ('Mut s) -> m (Raw ('Mut s) Type'anyPointer)
new AllocHint Type'anyPointer
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'anyPointer)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'anyPointer (C.Parsed Type'anyPointer))
instance (C.AllocateList Type'anyPointer) where
    type ListAllocHint Type'anyPointer = Std_.Int
    newList :: ListAllocHint Type'anyPointer
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'anyPointer))
newList  = ListAllocHint Type'anyPointer
-> Message ('Mut s) -> m (Raw ('Mut s) (List Type'anyPointer))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'anyPointer (C.Parsed Type'anyPointer))
data instance C.Parsed Type'anyPointer
    = Type'anyPointer' 
        {Parsed Type'anyPointer -> Parsed (Which Type'anyPointer)
union' :: (C.Parsed (GH.Which Type'anyPointer))}
    deriving((forall x.
 Parsed Type'anyPointer -> Rep (Parsed Type'anyPointer) x)
-> (forall x.
    Rep (Parsed Type'anyPointer) x -> Parsed Type'anyPointer)
-> Generic (Parsed Type'anyPointer)
forall x. Rep (Parsed Type'anyPointer) x -> Parsed Type'anyPointer
forall x. Parsed Type'anyPointer -> Rep (Parsed Type'anyPointer) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Type'anyPointer) x -> Parsed Type'anyPointer
$cfrom :: forall x. Parsed Type'anyPointer -> Rep (Parsed Type'anyPointer) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'anyPointer))
deriving instance (Std_.Eq (C.Parsed Type'anyPointer))
instance (C.Parse Type'anyPointer (C.Parsed Type'anyPointer)) where
    parse :: Raw 'Const Type'anyPointer -> m (Parsed Type'anyPointer)
parse Raw 'Const Type'anyPointer
raw_ = (Parsed (Which Type'anyPointer) -> Parsed Type'anyPointer
Type'anyPointer' (Parsed (Which Type'anyPointer) -> Parsed Type'anyPointer)
-> m (Parsed (Which Type'anyPointer)) -> m (Parsed Type'anyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Type'anyPointer)
-> m (Parsed (Which Type'anyPointer))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Type'anyPointer -> Raw 'Const (Which Type'anyPointer)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Type'anyPointer
raw_)))
instance (C.Marshal Type'anyPointer (C.Parsed Type'anyPointer)) where
    marshalInto :: Raw ('Mut s) Type'anyPointer -> Parsed Type'anyPointer -> m ()
marshalInto Raw ('Mut s) Type'anyPointer
raw_ Type'anyPointer'{..} = (do
        (Raw ('Mut s) (Which Type'anyPointer)
-> Parsed (Which Type'anyPointer) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Type'anyPointer
-> Raw ('Mut s) (Which Type'anyPointer)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Type'anyPointer
raw_) Parsed (Which Type'anyPointer)
union')
        )
instance (GH.HasUnion Type'anyPointer) where
    unionField :: Field 'Slot Type'anyPointer Word16
unionField  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'anyPointer Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
16 Word64
0)
    data RawWhich mut_ Type'anyPointer
        = RW_Type'anyPointer'unconstrained (R.Raw mut_ Type'anyPointer'unconstrained)
        | RW_Type'anyPointer'parameter (R.Raw mut_ Type'anyPointer'parameter)
        | RW_Type'anyPointer'implicitMethodParameter (R.Raw mut_ Type'anyPointer'implicitMethodParameter)
        | RW_Type'anyPointer'unknown' Std_.Word16
    internalWhich :: Word16
-> Raw mut Type'anyPointer -> m (RawWhich mut Type'anyPointer)
internalWhich Word16
tag_ Raw mut Type'anyPointer
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut Type'anyPointer'unconstrained
-> RawWhich mut Type'anyPointer
forall (mut_ :: Mutability).
Raw mut_ Type'anyPointer'unconstrained
-> RawWhich mut_ Type'anyPointer
RW_Type'anyPointer'unconstrained (Raw mut Type'anyPointer'unconstrained
 -> RawWhich mut Type'anyPointer)
-> m (Raw mut Type'anyPointer'unconstrained)
-> m (RawWhich mut Type'anyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
-> Raw mut Type'anyPointer
-> m (Raw mut Type'anyPointer'unconstrained)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "unconstrained"
  (Variant 'Group Type'anyPointer Type'anyPointer'unconstrained)
Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
#unconstrained Raw mut Type'anyPointer
struct_))
        Word16
1 ->
            (Raw mut Type'anyPointer'parameter -> RawWhich mut Type'anyPointer
forall (mut_ :: Mutability).
Raw mut_ Type'anyPointer'parameter -> RawWhich mut_ Type'anyPointer
RW_Type'anyPointer'parameter (Raw mut Type'anyPointer'parameter -> RawWhich mut Type'anyPointer)
-> m (Raw mut Type'anyPointer'parameter)
-> m (RawWhich mut Type'anyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Group Type'anyPointer Type'anyPointer'parameter
-> Raw mut Type'anyPointer -> m (Raw mut Type'anyPointer'parameter)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "parameter"
  (Variant 'Group Type'anyPointer Type'anyPointer'parameter)
Variant 'Group Type'anyPointer Type'anyPointer'parameter
#parameter Raw mut Type'anyPointer
struct_))
        Word16
2 ->
            (Raw mut Type'anyPointer'implicitMethodParameter
-> RawWhich mut Type'anyPointer
forall (mut_ :: Mutability).
Raw mut_ Type'anyPointer'implicitMethodParameter
-> RawWhich mut_ Type'anyPointer
RW_Type'anyPointer'implicitMethodParameter (Raw mut Type'anyPointer'implicitMethodParameter
 -> RawWhich mut Type'anyPointer)
-> m (Raw mut Type'anyPointer'implicitMethodParameter)
-> m (RawWhich mut Type'anyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
-> Raw mut Type'anyPointer
-> m (Raw mut Type'anyPointer'implicitMethodParameter)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "implicitMethodParameter"
  (Variant
     'Group Type'anyPointer Type'anyPointer'implicitMethodParameter)
Variant
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
#implicitMethodParameter Raw mut Type'anyPointer
struct_))
        Word16
_ ->
            (RawWhich mut Type'anyPointer -> m (RawWhich mut Type'anyPointer)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Type'anyPointer
forall (mut_ :: Mutability).
Word16 -> RawWhich mut_ Type'anyPointer
RW_Type'anyPointer'unknown' Word16
tag_))
    data Which Type'anyPointer
instance (GH.HasVariant "unconstrained" GH.Group Type'anyPointer Type'anyPointer'unconstrained) where
    variantByLabel :: Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
variantByLabel  = (Field 'Group Type'anyPointer Type'anyPointer'unconstrained
-> Word16
-> Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type'anyPointer Type'anyPointer'unconstrained
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
0)
instance (GH.HasVariant "parameter" GH.Group Type'anyPointer Type'anyPointer'parameter) where
    variantByLabel :: Variant 'Group Type'anyPointer Type'anyPointer'parameter
variantByLabel  = (Field 'Group Type'anyPointer Type'anyPointer'parameter
-> Word16
-> Variant 'Group Type'anyPointer Type'anyPointer'parameter
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Group Type'anyPointer Type'anyPointer'parameter
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
1)
instance (GH.HasVariant "implicitMethodParameter" GH.Group Type'anyPointer Type'anyPointer'implicitMethodParameter) where
    variantByLabel :: Variant
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
variantByLabel  = (Field
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
-> Word16
-> Variant
     'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
forall b a. (ReprFor b ~ 'Ptr ('Just 'Struct)) => Field 'Group a b
GH.groupField Word16
2)
data instance C.Parsed (GH.Which Type'anyPointer)
    = Type'anyPointer'unconstrained (RP.Parsed Type'anyPointer'unconstrained)
    | Type'anyPointer'parameter (RP.Parsed Type'anyPointer'parameter)
    | Type'anyPointer'implicitMethodParameter (RP.Parsed Type'anyPointer'implicitMethodParameter)
    | Type'anyPointer'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Type'anyPointer)
 -> Rep (Parsed (Which Type'anyPointer)) x)
-> (forall x.
    Rep (Parsed (Which Type'anyPointer)) x
    -> Parsed (Which Type'anyPointer))
-> Generic (Parsed (Which Type'anyPointer))
forall x.
Rep (Parsed (Which Type'anyPointer)) x
-> Parsed (Which Type'anyPointer)
forall x.
Parsed (Which Type'anyPointer)
-> Rep (Parsed (Which Type'anyPointer)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Type'anyPointer)) x
-> Parsed (Which Type'anyPointer)
$cfrom :: forall x.
Parsed (Which Type'anyPointer)
-> Rep (Parsed (Which Type'anyPointer)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Type'anyPointer)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Type'anyPointer)))
instance (C.Parse (GH.Which Type'anyPointer) (C.Parsed (GH.Which Type'anyPointer))) where
    parse :: Raw 'Const (Which Type'anyPointer)
-> m (Parsed (Which Type'anyPointer))
parse Raw 'Const (Which Type'anyPointer)
raw_ = (do
        RawWhich 'Const Type'anyPointer
rawWhich_ <- (Raw 'Const (Which Type'anyPointer)
-> m (RawWhich 'Const Type'anyPointer)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Type'anyPointer)
raw_)
        case RawWhich 'Const Type'anyPointer
rawWhich_ of
            (RW_Type'anyPointer'unconstrained rawArg_) ->
                (Parsed Type'anyPointer'unconstrained
-> Parsed (Which Type'anyPointer)
Parsed Type'anyPointer'unconstrained
-> Parsed (Which Type'anyPointer)
Type'anyPointer'unconstrained (Parsed Type'anyPointer'unconstrained
 -> Parsed (Which Type'anyPointer))
-> m (Parsed Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'anyPointer'unconstrained
-> m (Parsed Type'anyPointer'unconstrained)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'anyPointer'unconstrained
rawArg_))
            (RW_Type'anyPointer'parameter rawArg_) ->
                (Parsed Type'anyPointer'parameter -> Parsed (Which Type'anyPointer)
Parsed Type'anyPointer'parameter -> Parsed (Which Type'anyPointer)
Type'anyPointer'parameter (Parsed Type'anyPointer'parameter
 -> Parsed (Which Type'anyPointer))
-> m (Parsed Type'anyPointer'parameter)
-> m (Parsed (Which Type'anyPointer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'anyPointer'parameter
-> m (Parsed Type'anyPointer'parameter)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'anyPointer'parameter
rawArg_))
            (RW_Type'anyPointer'implicitMethodParameter rawArg_) ->
                (Parsed Type'anyPointer'implicitMethodParameter
-> Parsed (Which Type'anyPointer)
Parsed Type'anyPointer'implicitMethodParameter
-> Parsed (Which Type'anyPointer)
Type'anyPointer'implicitMethodParameter (Parsed Type'anyPointer'implicitMethodParameter
 -> Parsed (Which Type'anyPointer))
-> m (Parsed Type'anyPointer'implicitMethodParameter)
-> m (Parsed (Which Type'anyPointer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type'anyPointer'implicitMethodParameter
-> m (Parsed Type'anyPointer'implicitMethodParameter)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type'anyPointer'implicitMethodParameter
rawArg_))
            (RW_Type'anyPointer'unknown' tag_) ->
                (Parsed (Which Type'anyPointer)
-> m (Parsed (Which Type'anyPointer))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Type'anyPointer)
Type'anyPointer'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Type'anyPointer) (C.Parsed (GH.Which Type'anyPointer))) where
    marshalInto :: Raw ('Mut s) (Which Type'anyPointer)
-> Parsed (Which Type'anyPointer) -> m ()
marshalInto Raw ('Mut s) (Which Type'anyPointer)
raw_ Parsed (Which Type'anyPointer)
parsed_ = case Parsed (Which Type'anyPointer)
parsed_ of
        (Type'anyPointer'unconstrained arg_) ->
            (do
                Raw ('Mut s) Type'anyPointer'unconstrained
rawGroup_ <- (Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
-> Raw ('Mut s) Type'anyPointer
-> m (Raw ('Mut s) Type'anyPointer'unconstrained)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel
  "unconstrained"
  (Variant 'Group Type'anyPointer Type'anyPointer'unconstrained)
Variant 'Group Type'anyPointer Type'anyPointer'unconstrained
#unconstrained (Raw ('Mut s) (Which Type'anyPointer)
-> Raw ('Mut s) Type'anyPointer
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer)
raw_))
                (Raw ('Mut s) Type'anyPointer'unconstrained
-> Parsed Type'anyPointer'unconstrained -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'anyPointer'unconstrained
rawGroup_ Parsed Type'anyPointer'unconstrained
Parsed Type'anyPointer'unconstrained
arg_)
                )
        (Type'anyPointer'parameter arg_) ->
            (do
                Raw ('Mut s) Type'anyPointer'parameter
rawGroup_ <- (Variant 'Group Type'anyPointer Type'anyPointer'parameter
-> Raw ('Mut s) Type'anyPointer
-> m (Raw ('Mut s) Type'anyPointer'parameter)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel
  "parameter"
  (Variant 'Group Type'anyPointer Type'anyPointer'parameter)
Variant 'Group Type'anyPointer Type'anyPointer'parameter
#parameter (Raw ('Mut s) (Which Type'anyPointer)
-> Raw ('Mut s) Type'anyPointer
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer)
raw_))
                (Raw ('Mut s) Type'anyPointer'parameter
-> Parsed Type'anyPointer'parameter -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'anyPointer'parameter
rawGroup_ Parsed Type'anyPointer'parameter
Parsed Type'anyPointer'parameter
arg_)
                )
        (Type'anyPointer'implicitMethodParameter arg_) ->
            (do
                Raw ('Mut s) Type'anyPointer'implicitMethodParameter
rawGroup_ <- (Variant
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
-> Raw ('Mut s) Type'anyPointer
-> m (Raw ('Mut s) Type'anyPointer'implicitMethodParameter)
forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
Variant 'Group a b -> Raw ('Mut s) a -> m (Raw ('Mut s) b)
GH.initVariant IsLabel
  "implicitMethodParameter"
  (Variant
     'Group Type'anyPointer Type'anyPointer'implicitMethodParameter)
Variant
  'Group Type'anyPointer Type'anyPointer'implicitMethodParameter
#implicitMethodParameter (Raw ('Mut s) (Which Type'anyPointer)
-> Raw ('Mut s) Type'anyPointer
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer)
raw_))
                (Raw ('Mut s) Type'anyPointer'implicitMethodParameter
-> Parsed Type'anyPointer'implicitMethodParameter -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto Raw ('Mut s) Type'anyPointer'implicitMethodParameter
rawGroup_ Parsed Type'anyPointer'implicitMethodParameter
Parsed Type'anyPointer'implicitMethodParameter
arg_)
                )
        (Type'anyPointer'unknown' tag_) ->
            (Field 'Slot Type'anyPointer Word16
-> Word16 -> Raw ('Mut s) Type'anyPointer -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Type'anyPointer Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Type'anyPointer)
-> Raw ('Mut s) Type'anyPointer
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer)
raw_))
data Type'anyPointer'unconstrained 
type instance (R.ReprFor Type'anyPointer'unconstrained) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'anyPointer'unconstrained) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'anyPointer'unconstrained) where
    type AllocHint Type'anyPointer'unconstrained = ()
    new :: AllocHint Type'anyPointer'unconstrained
-> Message ('Mut s)
-> m (Raw ('Mut s) Type'anyPointer'unconstrained)
new AllocHint Type'anyPointer'unconstrained
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'anyPointer'unconstrained)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'anyPointer'unconstrained (C.Parsed Type'anyPointer'unconstrained))
instance (C.AllocateList Type'anyPointer'unconstrained) where
    type ListAllocHint Type'anyPointer'unconstrained = Std_.Int
    newList :: ListAllocHint Type'anyPointer'unconstrained
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'unconstrained))
newList  = ListAllocHint Type'anyPointer'unconstrained
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'unconstrained))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'anyPointer'unconstrained (C.Parsed Type'anyPointer'unconstrained))
data instance C.Parsed Type'anyPointer'unconstrained
    = Type'anyPointer'unconstrained' 
        {Parsed Type'anyPointer'unconstrained
-> Parsed (Which Type'anyPointer'unconstrained)
union' :: (C.Parsed (GH.Which Type'anyPointer'unconstrained))}
    deriving((forall x.
 Parsed Type'anyPointer'unconstrained
 -> Rep (Parsed Type'anyPointer'unconstrained) x)
-> (forall x.
    Rep (Parsed Type'anyPointer'unconstrained) x
    -> Parsed Type'anyPointer'unconstrained)
-> Generic (Parsed Type'anyPointer'unconstrained)
forall x.
Rep (Parsed Type'anyPointer'unconstrained) x
-> Parsed Type'anyPointer'unconstrained
forall x.
Parsed Type'anyPointer'unconstrained
-> Rep (Parsed Type'anyPointer'unconstrained) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Type'anyPointer'unconstrained) x
-> Parsed Type'anyPointer'unconstrained
$cfrom :: forall x.
Parsed Type'anyPointer'unconstrained
-> Rep (Parsed Type'anyPointer'unconstrained) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'anyPointer'unconstrained))
deriving instance (Std_.Eq (C.Parsed Type'anyPointer'unconstrained))
instance (C.Parse Type'anyPointer'unconstrained (C.Parsed Type'anyPointer'unconstrained)) where
    parse :: Raw 'Const Type'anyPointer'unconstrained
-> m (Parsed Type'anyPointer'unconstrained)
parse Raw 'Const Type'anyPointer'unconstrained
raw_ = (Parsed (Which Type'anyPointer'unconstrained)
-> Parsed Type'anyPointer'unconstrained
Type'anyPointer'unconstrained' (Parsed (Which Type'anyPointer'unconstrained)
 -> Parsed Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
-> m (Parsed Type'anyPointer'unconstrained)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Type'anyPointer'unconstrained
-> Raw 'Const (Which Type'anyPointer'unconstrained)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Type'anyPointer'unconstrained
raw_)))
instance (C.Marshal Type'anyPointer'unconstrained (C.Parsed Type'anyPointer'unconstrained)) where
    marshalInto :: Raw ('Mut s) Type'anyPointer'unconstrained
-> Parsed Type'anyPointer'unconstrained -> m ()
marshalInto Raw ('Mut s) Type'anyPointer'unconstrained
raw_ Type'anyPointer'unconstrained'{..} = (do
        (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Parsed (Which Type'anyPointer'unconstrained) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Type'anyPointer'unconstrained
-> Raw ('Mut s) (Which Type'anyPointer'unconstrained)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Type'anyPointer'unconstrained
raw_) Parsed (Which Type'anyPointer'unconstrained)
union')
        )
instance (GH.HasUnion Type'anyPointer'unconstrained) where
    unionField :: Field 'Slot Type'anyPointer'unconstrained Word16
unionField  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'anyPointer'unconstrained Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
1 BitCount
16 Word64
0)
    data RawWhich mut_ Type'anyPointer'unconstrained
        = RW_Type'anyPointer'unconstrained'anyKind (R.Raw mut_ ())
        | RW_Type'anyPointer'unconstrained'struct (R.Raw mut_ ())
        | RW_Type'anyPointer'unconstrained'list (R.Raw mut_ ())
        | RW_Type'anyPointer'unconstrained'capability (R.Raw mut_ ())
        | RW_Type'anyPointer'unconstrained'unknown' Std_.Word16
    internalWhich :: Word16
-> Raw mut Type'anyPointer'unconstrained
-> m (RawWhich mut Type'anyPointer'unconstrained)
internalWhich Word16
tag_ Raw mut Type'anyPointer'unconstrained
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Type'anyPointer'unconstrained
RW_Type'anyPointer'unconstrained'anyKind (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained)
-> m (Raw mut ()) -> m (RawWhich mut Type'anyPointer'unconstrained)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type'anyPointer'unconstrained ()
-> Raw mut Type'anyPointer'unconstrained -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "anyKind" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#anyKind Raw mut Type'anyPointer'unconstrained
struct_))
        Word16
1 ->
            (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Type'anyPointer'unconstrained
RW_Type'anyPointer'unconstrained'struct (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained)
-> m (Raw mut ()) -> m (RawWhich mut Type'anyPointer'unconstrained)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type'anyPointer'unconstrained ()
-> Raw mut Type'anyPointer'unconstrained -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "struct" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#struct Raw mut Type'anyPointer'unconstrained
struct_))
        Word16
2 ->
            (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Type'anyPointer'unconstrained
RW_Type'anyPointer'unconstrained'list (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained)
-> m (Raw mut ()) -> m (RawWhich mut Type'anyPointer'unconstrained)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type'anyPointer'unconstrained ()
-> Raw mut Type'anyPointer'unconstrained -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "list" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#list Raw mut Type'anyPointer'unconstrained
struct_))
        Word16
3 ->
            (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Type'anyPointer'unconstrained
RW_Type'anyPointer'unconstrained'capability (Raw mut () -> RawWhich mut Type'anyPointer'unconstrained)
-> m (Raw mut ()) -> m (RawWhich mut Type'anyPointer'unconstrained)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Type'anyPointer'unconstrained ()
-> Raw mut Type'anyPointer'unconstrained -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel
  "capability" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#capability Raw mut Type'anyPointer'unconstrained
struct_))
        Word16
_ ->
            (RawWhich mut Type'anyPointer'unconstrained
-> m (RawWhich mut Type'anyPointer'unconstrained)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Type'anyPointer'unconstrained
forall (mut_ :: Mutability).
Word16 -> RawWhich mut_ Type'anyPointer'unconstrained
RW_Type'anyPointer'unconstrained'unknown' Word16
tag_))
    data Which Type'anyPointer'unconstrained
instance (GH.HasVariant "anyKind" GH.Slot Type'anyPointer'unconstrained ()) where
    variantByLabel :: Variant 'Slot Type'anyPointer'unconstrained ()
variantByLabel  = (Field 'Slot Type'anyPointer'unconstrained ()
-> Word16 -> Variant 'Slot Type'anyPointer'unconstrained ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type'anyPointer'unconstrained ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "struct" GH.Slot Type'anyPointer'unconstrained ()) where
    variantByLabel :: Variant 'Slot Type'anyPointer'unconstrained ()
variantByLabel  = (Field 'Slot Type'anyPointer'unconstrained ()
-> Word16 -> Variant 'Slot Type'anyPointer'unconstrained ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type'anyPointer'unconstrained ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
1)
instance (GH.HasVariant "list" GH.Slot Type'anyPointer'unconstrained ()) where
    variantByLabel :: Variant 'Slot Type'anyPointer'unconstrained ()
variantByLabel  = (Field 'Slot Type'anyPointer'unconstrained ()
-> Word16 -> Variant 'Slot Type'anyPointer'unconstrained ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type'anyPointer'unconstrained ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
2)
instance (GH.HasVariant "capability" GH.Slot Type'anyPointer'unconstrained ()) where
    variantByLabel :: Variant 'Slot Type'anyPointer'unconstrained ()
variantByLabel  = (Field 'Slot Type'anyPointer'unconstrained ()
-> Word16 -> Variant 'Slot Type'anyPointer'unconstrained ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Type'anyPointer'unconstrained ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
3)
data instance C.Parsed (GH.Which Type'anyPointer'unconstrained)
    = Type'anyPointer'unconstrained'anyKind 
    | Type'anyPointer'unconstrained'struct 
    | Type'anyPointer'unconstrained'list 
    | Type'anyPointer'unconstrained'capability 
    | Type'anyPointer'unconstrained'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Type'anyPointer'unconstrained)
 -> Rep (Parsed (Which Type'anyPointer'unconstrained)) x)
-> (forall x.
    Rep (Parsed (Which Type'anyPointer'unconstrained)) x
    -> Parsed (Which Type'anyPointer'unconstrained))
-> Generic (Parsed (Which Type'anyPointer'unconstrained))
forall x.
Rep (Parsed (Which Type'anyPointer'unconstrained)) x
-> Parsed (Which Type'anyPointer'unconstrained)
forall x.
Parsed (Which Type'anyPointer'unconstrained)
-> Rep (Parsed (Which Type'anyPointer'unconstrained)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Type'anyPointer'unconstrained)) x
-> Parsed (Which Type'anyPointer'unconstrained)
$cfrom :: forall x.
Parsed (Which Type'anyPointer'unconstrained)
-> Rep (Parsed (Which Type'anyPointer'unconstrained)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Type'anyPointer'unconstrained)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Type'anyPointer'unconstrained)))
instance (C.Parse (GH.Which Type'anyPointer'unconstrained) (C.Parsed (GH.Which Type'anyPointer'unconstrained))) where
    parse :: Raw 'Const (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
parse Raw 'Const (Which Type'anyPointer'unconstrained)
raw_ = (do
        RawWhich 'Const Type'anyPointer'unconstrained
rawWhich_ <- (Raw 'Const (Which Type'anyPointer'unconstrained)
-> m (RawWhich 'Const Type'anyPointer'unconstrained)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Type'anyPointer'unconstrained)
raw_)
        case RawWhich 'Const Type'anyPointer'unconstrained
rawWhich_ of
            (RW_Type'anyPointer'unconstrained'anyKind _) ->
                (Parsed (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'anyKind)
            (RW_Type'anyPointer'unconstrained'struct _) ->
                (Parsed (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'struct)
            (RW_Type'anyPointer'unconstrained'list _) ->
                (Parsed (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'list)
            (RW_Type'anyPointer'unconstrained'capability _) ->
                (Parsed (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'capability)
            (RW_Type'anyPointer'unconstrained'unknown' tag_) ->
                (Parsed (Which Type'anyPointer'unconstrained)
-> m (Parsed (Which Type'anyPointer'unconstrained))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Type'anyPointer'unconstrained) (C.Parsed (GH.Which Type'anyPointer'unconstrained))) where
    marshalInto :: Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Parsed (Which Type'anyPointer'unconstrained) -> m ()
marshalInto Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_ Parsed (Which Type'anyPointer'unconstrained)
parsed_ = case Parsed (Which Type'anyPointer'unconstrained)
parsed_ of
        (Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'anyKind) ->
            (Variant 'Slot Type'anyPointer'unconstrained ()
-> () -> Raw ('Mut s) Type'anyPointer'unconstrained -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "anyKind" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#anyKind () (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Raw ('Mut s) Type'anyPointer'unconstrained
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_))
        (Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'struct) ->
            (Variant 'Slot Type'anyPointer'unconstrained ()
-> () -> Raw ('Mut s) Type'anyPointer'unconstrained -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "struct" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#struct () (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Raw ('Mut s) Type'anyPointer'unconstrained
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_))
        (Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'list) ->
            (Variant 'Slot Type'anyPointer'unconstrained ()
-> () -> Raw ('Mut s) Type'anyPointer'unconstrained -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "list" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#list () (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Raw ('Mut s) Type'anyPointer'unconstrained
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_))
        (Parsed (Which Type'anyPointer'unconstrained)
Type'anyPointer'unconstrained'capability) ->
            (Variant 'Slot Type'anyPointer'unconstrained ()
-> () -> Raw ('Mut s) Type'anyPointer'unconstrained -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel
  "capability" (Variant 'Slot Type'anyPointer'unconstrained ())
Variant 'Slot Type'anyPointer'unconstrained ()
#capability () (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Raw ('Mut s) Type'anyPointer'unconstrained
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_))
        (Type'anyPointer'unconstrained'unknown' tag_) ->
            (Field 'Slot Type'anyPointer'unconstrained Word16
-> Word16 -> Raw ('Mut s) Type'anyPointer'unconstrained -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Type'anyPointer'unconstrained Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Type'anyPointer'unconstrained)
-> Raw ('Mut s) Type'anyPointer'unconstrained
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Type'anyPointer'unconstrained)
raw_))
data Type'anyPointer'parameter 
type instance (R.ReprFor Type'anyPointer'parameter) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'anyPointer'parameter) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'anyPointer'parameter) where
    type AllocHint Type'anyPointer'parameter = ()
    new :: AllocHint Type'anyPointer'parameter
-> Message ('Mut s) -> m (Raw ('Mut s) Type'anyPointer'parameter)
new AllocHint Type'anyPointer'parameter
_ = Message ('Mut s) -> m (Raw ('Mut s) Type'anyPointer'parameter)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'anyPointer'parameter (C.Parsed Type'anyPointer'parameter))
instance (C.AllocateList Type'anyPointer'parameter) where
    type ListAllocHint Type'anyPointer'parameter = Std_.Int
    newList :: ListAllocHint Type'anyPointer'parameter
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'parameter))
newList  = ListAllocHint Type'anyPointer'parameter
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'parameter))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'anyPointer'parameter (C.Parsed Type'anyPointer'parameter))
data instance C.Parsed Type'anyPointer'parameter
    = Type'anyPointer'parameter' 
        {Parsed Type'anyPointer'parameter -> Parsed Word64
scopeId :: (RP.Parsed Std_.Word64)
        ,Parsed Type'anyPointer'parameter -> Parsed Word16
parameterIndex :: (RP.Parsed Std_.Word16)}
    deriving((forall x.
 Parsed Type'anyPointer'parameter
 -> Rep (Parsed Type'anyPointer'parameter) x)
-> (forall x.
    Rep (Parsed Type'anyPointer'parameter) x
    -> Parsed Type'anyPointer'parameter)
-> Generic (Parsed Type'anyPointer'parameter)
forall x.
Rep (Parsed Type'anyPointer'parameter) x
-> Parsed Type'anyPointer'parameter
forall x.
Parsed Type'anyPointer'parameter
-> Rep (Parsed Type'anyPointer'parameter) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Type'anyPointer'parameter) x
-> Parsed Type'anyPointer'parameter
$cfrom :: forall x.
Parsed Type'anyPointer'parameter
-> Rep (Parsed Type'anyPointer'parameter) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'anyPointer'parameter))
deriving instance (Std_.Eq (C.Parsed Type'anyPointer'parameter))
instance (C.Parse Type'anyPointer'parameter (C.Parsed Type'anyPointer'parameter)) where
    parse :: Raw 'Const Type'anyPointer'parameter
-> m (Parsed Type'anyPointer'parameter)
parse Raw 'Const Type'anyPointer'parameter
raw_ = (Word64 -> Word16 -> Parsed Type'anyPointer'parameter
Parsed Word64 -> Parsed Word16 -> Parsed Type'anyPointer'parameter
Type'anyPointer'parameter' (Word64 -> Word16 -> Parsed Type'anyPointer'parameter)
-> m Word64 -> m (Word16 -> Parsed Type'anyPointer'parameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'anyPointer'parameter Word64
-> Raw 'Const Type'anyPointer'parameter -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "scopeId" (Field 'Slot Type'anyPointer'parameter Word64)
Field 'Slot Type'anyPointer'parameter Word64
#scopeId Raw 'Const Type'anyPointer'parameter
raw_)
                                             m (Word16 -> Parsed Type'anyPointer'parameter)
-> m Word16 -> m (Parsed Type'anyPointer'parameter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Type'anyPointer'parameter Word16
-> Raw 'Const Type'anyPointer'parameter -> 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
  "parameterIndex" (Field 'Slot Type'anyPointer'parameter Word16)
Field 'Slot Type'anyPointer'parameter Word16
#parameterIndex Raw 'Const Type'anyPointer'parameter
raw_))
instance (C.Marshal Type'anyPointer'parameter (C.Parsed Type'anyPointer'parameter)) where
    marshalInto :: Raw ('Mut s) Type'anyPointer'parameter
-> Parsed Type'anyPointer'parameter -> m ()
marshalInto Raw ('Mut s) Type'anyPointer'parameter
raw_ Type'anyPointer'parameter'{..} = (do
        (Field 'Slot Type'anyPointer'parameter Word64
-> Word64 -> Raw ('Mut s) Type'anyPointer'parameter -> 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 "scopeId" (Field 'Slot Type'anyPointer'parameter Word64)
Field 'Slot Type'anyPointer'parameter Word64
#scopeId Word64
Parsed Word64
scopeId Raw ('Mut s) Type'anyPointer'parameter
raw_)
        (Field 'Slot Type'anyPointer'parameter Word16
-> Word16 -> Raw ('Mut s) Type'anyPointer'parameter -> 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
  "parameterIndex" (Field 'Slot Type'anyPointer'parameter Word16)
Field 'Slot Type'anyPointer'parameter Word16
#parameterIndex Word16
Parsed Word16
parameterIndex Raw ('Mut s) Type'anyPointer'parameter
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "scopeId" GH.Slot Type'anyPointer'parameter Std_.Word64) where
    fieldByLabel :: Field 'Slot Type'anyPointer'parameter Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'anyPointer'parameter Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
2 BitCount
64 Word64
0)
instance (GH.HasField "parameterIndex" GH.Slot Type'anyPointer'parameter Std_.Word16) where
    fieldByLabel :: Field 'Slot Type'anyPointer'parameter Word16
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'anyPointer'parameter Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
1 BitCount
16 Word64
0)
data Type'anyPointer'implicitMethodParameter 
type instance (R.ReprFor Type'anyPointer'implicitMethodParameter) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Type'anyPointer'implicitMethodParameter) where
    numStructWords :: Word16
numStructWords  = Word16
3
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Type'anyPointer'implicitMethodParameter) where
    type AllocHint Type'anyPointer'implicitMethodParameter = ()
    new :: AllocHint Type'anyPointer'implicitMethodParameter
-> Message ('Mut s)
-> m (Raw ('Mut s) Type'anyPointer'implicitMethodParameter)
new AllocHint Type'anyPointer'implicitMethodParameter
_ = Message ('Mut s)
-> m (Raw ('Mut s) Type'anyPointer'implicitMethodParameter)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Type'anyPointer'implicitMethodParameter (C.Parsed Type'anyPointer'implicitMethodParameter))
instance (C.AllocateList Type'anyPointer'implicitMethodParameter) where
    type ListAllocHint Type'anyPointer'implicitMethodParameter = Std_.Int
    newList :: ListAllocHint Type'anyPointer'implicitMethodParameter
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'implicitMethodParameter))
newList  = ListAllocHint Type'anyPointer'implicitMethodParameter
-> Message ('Mut s)
-> m (Raw ('Mut s) (List Type'anyPointer'implicitMethodParameter))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Type'anyPointer'implicitMethodParameter (C.Parsed Type'anyPointer'implicitMethodParameter))
data instance C.Parsed Type'anyPointer'implicitMethodParameter
    = Type'anyPointer'implicitMethodParameter' 
        {Parsed Type'anyPointer'implicitMethodParameter -> Parsed Word16
parameterIndex :: (RP.Parsed Std_.Word16)}
    deriving((forall x.
 Parsed Type'anyPointer'implicitMethodParameter
 -> Rep (Parsed Type'anyPointer'implicitMethodParameter) x)
-> (forall x.
    Rep (Parsed Type'anyPointer'implicitMethodParameter) x
    -> Parsed Type'anyPointer'implicitMethodParameter)
-> Generic (Parsed Type'anyPointer'implicitMethodParameter)
forall x.
Rep (Parsed Type'anyPointer'implicitMethodParameter) x
-> Parsed Type'anyPointer'implicitMethodParameter
forall x.
Parsed Type'anyPointer'implicitMethodParameter
-> Rep (Parsed Type'anyPointer'implicitMethodParameter) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed Type'anyPointer'implicitMethodParameter) x
-> Parsed Type'anyPointer'implicitMethodParameter
$cfrom :: forall x.
Parsed Type'anyPointer'implicitMethodParameter
-> Rep (Parsed Type'anyPointer'implicitMethodParameter) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Type'anyPointer'implicitMethodParameter))
deriving instance (Std_.Eq (C.Parsed Type'anyPointer'implicitMethodParameter))
instance (C.Parse Type'anyPointer'implicitMethodParameter (C.Parsed Type'anyPointer'implicitMethodParameter)) where
    parse :: Raw 'Const Type'anyPointer'implicitMethodParameter
-> m (Parsed Type'anyPointer'implicitMethodParameter)
parse Raw 'Const Type'anyPointer'implicitMethodParameter
raw_ = (Word16 -> Parsed Type'anyPointer'implicitMethodParameter
Parsed Word16 -> Parsed Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter' (Word16 -> Parsed Type'anyPointer'implicitMethodParameter)
-> m Word16 -> m (Parsed Type'anyPointer'implicitMethodParameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Type'anyPointer'implicitMethodParameter Word16
-> Raw 'Const Type'anyPointer'implicitMethodParameter -> 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
  "parameterIndex"
  (Field 'Slot Type'anyPointer'implicitMethodParameter Word16)
Field 'Slot Type'anyPointer'implicitMethodParameter Word16
#parameterIndex Raw 'Const Type'anyPointer'implicitMethodParameter
raw_))
instance (C.Marshal Type'anyPointer'implicitMethodParameter (C.Parsed Type'anyPointer'implicitMethodParameter)) where
    marshalInto :: Raw ('Mut s) Type'anyPointer'implicitMethodParameter
-> Parsed Type'anyPointer'implicitMethodParameter -> m ()
marshalInto Raw ('Mut s) Type'anyPointer'implicitMethodParameter
raw_ Type'anyPointer'implicitMethodParameter'{..} = (do
        (Field 'Slot Type'anyPointer'implicitMethodParameter Word16
-> Word16
-> Raw ('Mut s) Type'anyPointer'implicitMethodParameter
-> 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
  "parameterIndex"
  (Field 'Slot Type'anyPointer'implicitMethodParameter Word16)
Field 'Slot Type'anyPointer'implicitMethodParameter Word16
#parameterIndex Word16
Parsed Word16
parameterIndex Raw ('Mut s) Type'anyPointer'implicitMethodParameter
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "parameterIndex" GH.Slot Type'anyPointer'implicitMethodParameter Std_.Word16) where
    fieldByLabel :: Field 'Slot Type'anyPointer'implicitMethodParameter Word16
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot Type'anyPointer'implicitMethodParameter Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
1 BitCount
16 Word64
0)
data Brand 
type instance (R.ReprFor Brand) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Brand) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Brand) where
    type AllocHint Brand = ()
    new :: AllocHint Brand -> Message ('Mut s) -> m (Raw ('Mut s) Brand)
new AllocHint Brand
_ = Message ('Mut s) -> m (Raw ('Mut s) Brand)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Brand (C.Parsed Brand))
instance (C.AllocateList Brand) where
    type ListAllocHint Brand = Std_.Int
    newList :: ListAllocHint Brand
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand))
newList  = ListAllocHint Brand
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Brand (C.Parsed Brand))
data instance C.Parsed Brand
    = Brand 
        {Parsed Brand -> Parsed (List Brand'Scope)
scopes :: (RP.Parsed (R.List Brand'Scope))}
    deriving((forall x. Parsed Brand -> Rep (Parsed Brand) x)
-> (forall x. Rep (Parsed Brand) x -> Parsed Brand)
-> Generic (Parsed Brand)
forall x. Rep (Parsed Brand) x -> Parsed Brand
forall x. Parsed Brand -> Rep (Parsed Brand) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Brand) x -> Parsed Brand
$cfrom :: forall x. Parsed Brand -> Rep (Parsed Brand) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Brand))
deriving instance (Std_.Eq (C.Parsed Brand))
instance (C.Parse Brand (C.Parsed Brand)) where
    parse :: Raw 'Const Brand -> m (Parsed Brand)
parse Raw 'Const Brand
raw_ = (Vector (Parsed Brand'Scope) -> Parsed Brand
Parsed (List Brand'Scope) -> Parsed Brand
Brand (Vector (Parsed Brand'Scope) -> Parsed Brand)
-> m (Vector (Parsed Brand'Scope)) -> m (Parsed Brand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Brand (List Brand'Scope)
-> Raw 'Const Brand -> m (Vector (Parsed Brand'Scope))
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 "scopes" (Field 'Slot Brand (List Brand'Scope))
Field 'Slot Brand (List Brand'Scope)
#scopes Raw 'Const Brand
raw_))
instance (C.Marshal Brand (C.Parsed Brand)) where
    marshalInto :: Raw ('Mut s) Brand -> Parsed Brand -> m ()
marshalInto Raw ('Mut s) Brand
raw_ Brand{..} = (do
        (Field 'Slot Brand (List Brand'Scope)
-> Vector (Parsed Brand'Scope) -> Raw ('Mut s) Brand -> 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 "scopes" (Field 'Slot Brand (List Brand'Scope))
Field 'Slot Brand (List Brand'Scope)
#scopes Vector (Parsed Brand'Scope)
Parsed (List Brand'Scope)
scopes Raw ('Mut s) Brand
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "scopes" GH.Slot Brand (R.List Brand'Scope)) where
    fieldByLabel :: Field 'Slot Brand (List Brand'Scope)
fieldByLabel  = (Word16 -> Field 'Slot Brand (List Brand'Scope)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
data Brand'Scope 
type instance (R.ReprFor Brand'Scope) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Brand'Scope) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Brand'Scope) where
    type AllocHint Brand'Scope = ()
    new :: AllocHint Brand'Scope
-> Message ('Mut s) -> m (Raw ('Mut s) Brand'Scope)
new AllocHint Brand'Scope
_ = Message ('Mut s) -> m (Raw ('Mut s) Brand'Scope)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Brand'Scope (C.Parsed Brand'Scope))
instance (C.AllocateList Brand'Scope) where
    type ListAllocHint Brand'Scope = Std_.Int
    newList :: ListAllocHint Brand'Scope
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand'Scope))
newList  = ListAllocHint Brand'Scope
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand'Scope))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Brand'Scope (C.Parsed Brand'Scope))
data instance C.Parsed Brand'Scope
    = Brand'Scope 
        {Parsed Brand'Scope -> Parsed Word64
scopeId :: (RP.Parsed Std_.Word64)
        ,Parsed Brand'Scope -> Parsed (Which Brand'Scope)
union' :: (C.Parsed (GH.Which Brand'Scope))}
    deriving((forall x. Parsed Brand'Scope -> Rep (Parsed Brand'Scope) x)
-> (forall x. Rep (Parsed Brand'Scope) x -> Parsed Brand'Scope)
-> Generic (Parsed Brand'Scope)
forall x. Rep (Parsed Brand'Scope) x -> Parsed Brand'Scope
forall x. Parsed Brand'Scope -> Rep (Parsed Brand'Scope) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Brand'Scope) x -> Parsed Brand'Scope
$cfrom :: forall x. Parsed Brand'Scope -> Rep (Parsed Brand'Scope) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Brand'Scope))
deriving instance (Std_.Eq (C.Parsed Brand'Scope))
instance (C.Parse Brand'Scope (C.Parsed Brand'Scope)) where
    parse :: Raw 'Const Brand'Scope -> m (Parsed Brand'Scope)
parse Raw 'Const Brand'Scope
raw_ = (Word64 -> Parsed (Which Brand'Scope) -> Parsed Brand'Scope
Parsed Word64 -> Parsed (Which Brand'Scope) -> Parsed Brand'Scope
Brand'Scope (Word64 -> Parsed (Which Brand'Scope) -> Parsed Brand'Scope)
-> m Word64 -> m (Parsed (Which Brand'Scope) -> Parsed Brand'Scope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Brand'Scope Word64
-> Raw 'Const Brand'Scope -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "scopeId" (Field 'Slot Brand'Scope Word64)
Field 'Slot Brand'Scope Word64
#scopeId Raw 'Const Brand'Scope
raw_)
                              m (Parsed (Which Brand'Scope) -> Parsed Brand'Scope)
-> m (Parsed (Which Brand'Scope)) -> m (Parsed Brand'Scope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Raw 'Const (Which Brand'Scope) -> m (Parsed (Which Brand'Scope))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Brand'Scope -> Raw 'Const (Which Brand'Scope)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Brand'Scope
raw_)))
instance (C.Marshal Brand'Scope (C.Parsed Brand'Scope)) where
    marshalInto :: Raw ('Mut s) Brand'Scope -> Parsed Brand'Scope -> m ()
marshalInto Raw ('Mut s) Brand'Scope
raw_ Brand'Scope{..} = (do
        (Field 'Slot Brand'Scope Word64
-> Word64 -> Raw ('Mut s) Brand'Scope -> 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 "scopeId" (Field 'Slot Brand'Scope Word64)
Field 'Slot Brand'Scope Word64
#scopeId Word64
Parsed Word64
scopeId Raw ('Mut s) Brand'Scope
raw_)
        (Raw ('Mut s) (Which Brand'Scope)
-> Parsed (Which Brand'Scope) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Brand'Scope -> Raw ('Mut s) (Which Brand'Scope)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Brand'Scope
raw_) Parsed (Which Brand'Scope)
union')
        )
instance (GH.HasUnion Brand'Scope) where
    unionField :: Field 'Slot Brand'Scope Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Brand'Scope Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
16 Word64
0)
    data RawWhich mut_ Brand'Scope
        = RW_Brand'Scope'bind (R.Raw mut_ (R.List Brand'Binding))
        | RW_Brand'Scope'inherit (R.Raw mut_ ())
        | RW_Brand'Scope'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Brand'Scope -> m (RawWhich mut Brand'Scope)
internalWhich Word16
tag_ Raw mut Brand'Scope
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut (List Brand'Binding) -> RawWhich mut Brand'Scope
forall (mut_ :: Mutability).
Raw mut_ (List Brand'Binding) -> RawWhich mut_ Brand'Scope
RW_Brand'Scope'bind (Raw mut (List Brand'Binding) -> RawWhich mut Brand'Scope)
-> m (Raw mut (List Brand'Binding)) -> m (RawWhich mut Brand'Scope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Brand'Scope (List Brand'Binding)
-> Raw mut Brand'Scope -> m (Raw mut (List Brand'Binding))
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "bind" (Variant 'Slot Brand'Scope (List Brand'Binding))
Variant 'Slot Brand'Scope (List Brand'Binding)
#bind Raw mut Brand'Scope
struct_))
        Word16
1 ->
            (Raw mut () -> RawWhich mut Brand'Scope
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Brand'Scope
RW_Brand'Scope'inherit (Raw mut () -> RawWhich mut Brand'Scope)
-> m (Raw mut ()) -> m (RawWhich mut Brand'Scope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Brand'Scope ()
-> Raw mut Brand'Scope -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "inherit" (Variant 'Slot Brand'Scope ())
Variant 'Slot Brand'Scope ()
#inherit Raw mut Brand'Scope
struct_))
        Word16
_ ->
            (RawWhich mut Brand'Scope -> m (RawWhich mut Brand'Scope)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Brand'Scope
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Brand'Scope
RW_Brand'Scope'unknown' Word16
tag_))
    data Which Brand'Scope
instance (GH.HasVariant "bind" GH.Slot Brand'Scope (R.List Brand'Binding)) where
    variantByLabel :: Variant 'Slot Brand'Scope (List Brand'Binding)
variantByLabel  = (Field 'Slot Brand'Scope (List Brand'Binding)
-> Word16 -> Variant 'Slot Brand'Scope (List Brand'Binding)
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Brand'Scope (List Brand'Binding)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
0)
instance (GH.HasVariant "inherit" GH.Slot Brand'Scope ()) where
    variantByLabel :: Variant 'Slot Brand'Scope ()
variantByLabel  = (Field 'Slot Brand'Scope ()
-> Word16 -> Variant 'Slot Brand'Scope ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Brand'Scope ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
1)
data instance C.Parsed (GH.Which Brand'Scope)
    = Brand'Scope'bind (RP.Parsed (R.List Brand'Binding))
    | Brand'Scope'inherit 
    | Brand'Scope'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Brand'Scope) -> Rep (Parsed (Which Brand'Scope)) x)
-> (forall x.
    Rep (Parsed (Which Brand'Scope)) x -> Parsed (Which Brand'Scope))
-> Generic (Parsed (Which Brand'Scope))
forall x.
Rep (Parsed (Which Brand'Scope)) x -> Parsed (Which Brand'Scope)
forall x.
Parsed (Which Brand'Scope) -> Rep (Parsed (Which Brand'Scope)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Brand'Scope)) x -> Parsed (Which Brand'Scope)
$cfrom :: forall x.
Parsed (Which Brand'Scope) -> Rep (Parsed (Which Brand'Scope)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Brand'Scope)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Brand'Scope)))
instance (C.Parse (GH.Which Brand'Scope) (C.Parsed (GH.Which Brand'Scope))) where
    parse :: Raw 'Const (Which Brand'Scope) -> m (Parsed (Which Brand'Scope))
parse Raw 'Const (Which Brand'Scope)
raw_ = (do
        RawWhich 'Const Brand'Scope
rawWhich_ <- (Raw 'Const (Which Brand'Scope) -> m (RawWhich 'Const Brand'Scope)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Brand'Scope)
raw_)
        case RawWhich 'Const Brand'Scope
rawWhich_ of
            (RW_Brand'Scope'bind rawArg_) ->
                (Vector (Parsed Brand'Binding) -> Parsed (Which Brand'Scope)
Parsed (List Brand'Binding) -> Parsed (Which Brand'Scope)
Brand'Scope'bind (Vector (Parsed Brand'Binding) -> Parsed (Which Brand'Scope))
-> m (Vector (Parsed Brand'Binding))
-> m (Parsed (Which Brand'Scope))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (List Brand'Binding)
-> m (Vector (Parsed Brand'Binding))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const (List Brand'Binding)
rawArg_))
            (RW_Brand'Scope'inherit _) ->
                (Parsed (Which Brand'Scope) -> m (Parsed (Which Brand'Scope))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Brand'Scope)
Brand'Scope'inherit)
            (RW_Brand'Scope'unknown' tag_) ->
                (Parsed (Which Brand'Scope) -> m (Parsed (Which Brand'Scope))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Brand'Scope)
Brand'Scope'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Brand'Scope) (C.Parsed (GH.Which Brand'Scope))) where
    marshalInto :: Raw ('Mut s) (Which Brand'Scope)
-> Parsed (Which Brand'Scope) -> m ()
marshalInto Raw ('Mut s) (Which Brand'Scope)
raw_ Parsed (Which Brand'Scope)
parsed_ = case Parsed (Which Brand'Scope)
parsed_ of
        (Brand'Scope'bind arg_) ->
            (Variant 'Slot Brand'Scope (List Brand'Binding)
-> Vector (Parsed Brand'Binding)
-> Raw ('Mut s) Brand'Scope
-> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "bind" (Variant 'Slot Brand'Scope (List Brand'Binding))
Variant 'Slot Brand'Scope (List Brand'Binding)
#bind Vector (Parsed Brand'Binding)
Parsed (List Brand'Binding)
arg_ (Raw ('Mut s) (Which Brand'Scope) -> Raw ('Mut s) Brand'Scope
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Scope)
raw_))
        (Parsed (Which Brand'Scope)
Brand'Scope'inherit) ->
            (Variant 'Slot Brand'Scope ()
-> () -> Raw ('Mut s) Brand'Scope -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "inherit" (Variant 'Slot Brand'Scope ())
Variant 'Slot Brand'Scope ()
#inherit () (Raw ('Mut s) (Which Brand'Scope) -> Raw ('Mut s) Brand'Scope
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Scope)
raw_))
        (Brand'Scope'unknown' tag_) ->
            (Field 'Slot Brand'Scope Word16
-> Word16 -> Raw ('Mut s) Brand'Scope -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Brand'Scope Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Brand'Scope) -> Raw ('Mut s) Brand'Scope
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Scope)
raw_))
instance (GH.HasField "scopeId" GH.Slot Brand'Scope Std_.Word64) where
    fieldByLabel :: Field 'Slot Brand'Scope Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Brand'Scope Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
data Brand'Binding 
type instance (R.ReprFor Brand'Binding) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Brand'Binding) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Brand'Binding) where
    type AllocHint Brand'Binding = ()
    new :: AllocHint Brand'Binding
-> Message ('Mut s) -> m (Raw ('Mut s) Brand'Binding)
new AllocHint Brand'Binding
_ = Message ('Mut s) -> m (Raw ('Mut s) Brand'Binding)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Brand'Binding (C.Parsed Brand'Binding))
instance (C.AllocateList Brand'Binding) where
    type ListAllocHint Brand'Binding = Std_.Int
    newList :: ListAllocHint Brand'Binding
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand'Binding))
newList  = ListAllocHint Brand'Binding
-> Message ('Mut s) -> m (Raw ('Mut s) (List Brand'Binding))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Brand'Binding (C.Parsed Brand'Binding))
data instance C.Parsed Brand'Binding
    = Brand'Binding 
        {Parsed Brand'Binding -> Parsed (Which Brand'Binding)
union' :: (C.Parsed (GH.Which Brand'Binding))}
    deriving((forall x. Parsed Brand'Binding -> Rep (Parsed Brand'Binding) x)
-> (forall x. Rep (Parsed Brand'Binding) x -> Parsed Brand'Binding)
-> Generic (Parsed Brand'Binding)
forall x. Rep (Parsed Brand'Binding) x -> Parsed Brand'Binding
forall x. Parsed Brand'Binding -> Rep (Parsed Brand'Binding) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Brand'Binding) x -> Parsed Brand'Binding
$cfrom :: forall x. Parsed Brand'Binding -> Rep (Parsed Brand'Binding) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Brand'Binding))
deriving instance (Std_.Eq (C.Parsed Brand'Binding))
instance (C.Parse Brand'Binding (C.Parsed Brand'Binding)) where
    parse :: Raw 'Const Brand'Binding -> m (Parsed Brand'Binding)
parse Raw 'Const Brand'Binding
raw_ = (Parsed (Which Brand'Binding) -> Parsed Brand'Binding
Brand'Binding (Parsed (Which Brand'Binding) -> Parsed Brand'Binding)
-> m (Parsed (Which Brand'Binding)) -> m (Parsed Brand'Binding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Brand'Binding)
-> m (Parsed (Which Brand'Binding))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Brand'Binding -> Raw 'Const (Which Brand'Binding)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Brand'Binding
raw_)))
instance (C.Marshal Brand'Binding (C.Parsed Brand'Binding)) where
    marshalInto :: Raw ('Mut s) Brand'Binding -> Parsed Brand'Binding -> m ()
marshalInto Raw ('Mut s) Brand'Binding
raw_ Brand'Binding{..} = (do
        (Raw ('Mut s) (Which Brand'Binding)
-> Parsed (Which Brand'Binding) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Brand'Binding -> Raw ('Mut s) (Which Brand'Binding)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Brand'Binding
raw_) Parsed (Which Brand'Binding)
union')
        )
instance (GH.HasUnion Brand'Binding) where
    unionField :: Field 'Slot Brand'Binding Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Brand'Binding Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
    data RawWhich mut_ Brand'Binding
        = RW_Brand'Binding'unbound (R.Raw mut_ ())
        | RW_Brand'Binding'type_ (R.Raw mut_ Type)
        | RW_Brand'Binding'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Brand'Binding -> m (RawWhich mut Brand'Binding)
internalWhich Word16
tag_ Raw mut Brand'Binding
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Brand'Binding
forall (mut_ :: Mutability).
Raw mut_ () -> RawWhich mut_ Brand'Binding
RW_Brand'Binding'unbound (Raw mut () -> RawWhich mut Brand'Binding)
-> m (Raw mut ()) -> m (RawWhich mut Brand'Binding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Brand'Binding ()
-> Raw mut Brand'Binding -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "unbound" (Variant 'Slot Brand'Binding ())
Variant 'Slot Brand'Binding ()
#unbound Raw mut Brand'Binding
struct_))
        Word16
1 ->
            (Raw mut Type -> RawWhich mut Brand'Binding
forall (mut_ :: Mutability).
Raw mut_ Type -> RawWhich mut_ Brand'Binding
RW_Brand'Binding'type_ (Raw mut Type -> RawWhich mut Brand'Binding)
-> m (Raw mut Type) -> m (RawWhich mut Brand'Binding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Brand'Binding Type
-> Raw mut Brand'Binding -> m (Raw mut Type)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "type_" (Variant 'Slot Brand'Binding Type)
Variant 'Slot Brand'Binding Type
#type_ Raw mut Brand'Binding
struct_))
        Word16
_ ->
            (RawWhich mut Brand'Binding -> m (RawWhich mut Brand'Binding)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Brand'Binding
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Brand'Binding
RW_Brand'Binding'unknown' Word16
tag_))
    data Which Brand'Binding
instance (GH.HasVariant "unbound" GH.Slot Brand'Binding ()) where
    variantByLabel :: Variant 'Slot Brand'Binding ()
variantByLabel  = (Field 'Slot Brand'Binding ()
-> Word16 -> Variant 'Slot Brand'Binding ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Brand'Binding ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "type_" GH.Slot Brand'Binding Type) where
    variantByLabel :: Variant 'Slot Brand'Binding Type
variantByLabel  = (Field 'Slot Brand'Binding Type
-> Word16 -> Variant 'Slot Brand'Binding Type
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Brand'Binding Type
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
1)
data instance C.Parsed (GH.Which Brand'Binding)
    = Brand'Binding'unbound 
    | Brand'Binding'type_ (RP.Parsed Type)
    | Brand'Binding'unknown' Std_.Word16
    deriving((forall x.
 Parsed (Which Brand'Binding)
 -> Rep (Parsed (Which Brand'Binding)) x)
-> (forall x.
    Rep (Parsed (Which Brand'Binding)) x
    -> Parsed (Which Brand'Binding))
-> Generic (Parsed (Which Brand'Binding))
forall x.
Rep (Parsed (Which Brand'Binding)) x
-> Parsed (Which Brand'Binding)
forall x.
Parsed (Which Brand'Binding)
-> Rep (Parsed (Which Brand'Binding)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed (Which Brand'Binding)) x
-> Parsed (Which Brand'Binding)
$cfrom :: forall x.
Parsed (Which Brand'Binding)
-> Rep (Parsed (Which Brand'Binding)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Brand'Binding)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Brand'Binding)))
instance (C.Parse (GH.Which Brand'Binding) (C.Parsed (GH.Which Brand'Binding))) where
    parse :: Raw 'Const (Which Brand'Binding)
-> m (Parsed (Which Brand'Binding))
parse Raw 'Const (Which Brand'Binding)
raw_ = (do
        RawWhich 'Const Brand'Binding
rawWhich_ <- (Raw 'Const (Which Brand'Binding)
-> m (RawWhich 'Const Brand'Binding)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Brand'Binding)
raw_)
        case RawWhich 'Const Brand'Binding
rawWhich_ of
            (RW_Brand'Binding'unbound _) ->
                (Parsed (Which Brand'Binding) -> m (Parsed (Which Brand'Binding))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Brand'Binding)
Brand'Binding'unbound)
            (RW_Brand'Binding'type_ rawArg_) ->
                (Parsed Type -> Parsed (Which Brand'Binding)
Parsed Type -> Parsed (Which Brand'Binding)
Brand'Binding'type_ (Parsed Type -> Parsed (Which Brand'Binding))
-> m (Parsed Type) -> m (Parsed (Which Brand'Binding))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Type -> m (Parsed Type)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Type
rawArg_))
            (RW_Brand'Binding'unknown' tag_) ->
                (Parsed (Which Brand'Binding) -> m (Parsed (Which Brand'Binding))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Brand'Binding)
Brand'Binding'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Brand'Binding) (C.Parsed (GH.Which Brand'Binding))) where
    marshalInto :: Raw ('Mut s) (Which Brand'Binding)
-> Parsed (Which Brand'Binding) -> m ()
marshalInto Raw ('Mut s) (Which Brand'Binding)
raw_ Parsed (Which Brand'Binding)
parsed_ = case Parsed (Which Brand'Binding)
parsed_ of
        (Parsed (Which Brand'Binding)
Brand'Binding'unbound) ->
            (Variant 'Slot Brand'Binding ()
-> () -> Raw ('Mut s) Brand'Binding -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "unbound" (Variant 'Slot Brand'Binding ())
Variant 'Slot Brand'Binding ()
#unbound () (Raw ('Mut s) (Which Brand'Binding) -> Raw ('Mut s) Brand'Binding
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Binding)
raw_))
        (Brand'Binding'type_ arg_) ->
            (Variant 'Slot Brand'Binding Type
-> Parsed Type -> Raw ('Mut s) Brand'Binding -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "type_" (Variant 'Slot Brand'Binding Type)
Variant 'Slot Brand'Binding Type
#type_ Parsed Type
Parsed Type
arg_ (Raw ('Mut s) (Which Brand'Binding) -> Raw ('Mut s) Brand'Binding
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Binding)
raw_))
        (Brand'Binding'unknown' tag_) ->
            (Field 'Slot Brand'Binding Word16
-> Word16 -> Raw ('Mut s) Brand'Binding -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Brand'Binding Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Brand'Binding) -> Raw ('Mut s) Brand'Binding
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Brand'Binding)
raw_))
data Value 
type instance (R.ReprFor Value) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Value) where
    numStructWords :: Word16
numStructWords  = Word16
2
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate Value) where
    type AllocHint Value = ()
    new :: AllocHint Value -> Message ('Mut s) -> m (Raw ('Mut s) Value)
new AllocHint Value
_ = Message ('Mut s) -> m (Raw ('Mut s) Value)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Value (C.Parsed Value))
instance (C.AllocateList Value) where
    type ListAllocHint Value = Std_.Int
    newList :: ListAllocHint Value
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value))
newList  = ListAllocHint Value
-> Message ('Mut s) -> m (Raw ('Mut s) (List Value))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Value (C.Parsed Value))
data instance C.Parsed Value
    = Value 
        {Parsed Value -> Parsed (Which Value)
union' :: (C.Parsed (GH.Which Value))}
    deriving((forall x. Parsed Value -> Rep (Parsed Value) x)
-> (forall x. Rep (Parsed Value) x -> Parsed Value)
-> Generic (Parsed Value)
forall x. Rep (Parsed Value) x -> Parsed Value
forall x. Parsed Value -> Rep (Parsed Value) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Value) x -> Parsed Value
$cfrom :: forall x. Parsed Value -> Rep (Parsed Value) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Value))
deriving instance (Std_.Eq (C.Parsed Value))
instance (C.Parse Value (C.Parsed Value)) where
    parse :: Raw 'Const Value -> m (Parsed Value)
parse Raw 'Const Value
raw_ = (Parsed (Which Value) -> Parsed Value
Value (Parsed (Which Value) -> Parsed Value)
-> m (Parsed (Which Value)) -> m (Parsed Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const (Which Value) -> m (Parsed (Which Value))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const Value -> Raw 'Const (Which Value)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw 'Const Value
raw_)))
instance (C.Marshal Value (C.Parsed Value)) where
    marshalInto :: Raw ('Mut s) Value -> Parsed Value -> m ()
marshalInto Raw ('Mut s) Value
raw_ Value{..} = (do
        (Raw ('Mut s) (Which Value) -> Parsed (Which Value) -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto (Raw ('Mut s) Value -> Raw ('Mut s) (Which Value)
forall a (mut :: Mutability).
HasUnion a =>
Raw mut a -> Raw mut (Which a)
GH.structUnion Raw ('Mut s) Value
raw_) Parsed (Which Value)
union')
        )
instance (GH.HasUnion Value) where
    unionField :: Field 'Slot Value Word16
unionField  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
    data RawWhich mut_ Value
        = RW_Value'void (R.Raw mut_ ())
        | RW_Value'bool (R.Raw mut_ Std_.Bool)
        | RW_Value'int8 (R.Raw mut_ Std_.Int8)
        | RW_Value'int16 (R.Raw mut_ Std_.Int16)
        | RW_Value'int32 (R.Raw mut_ Std_.Int32)
        | RW_Value'int64 (R.Raw mut_ Std_.Int64)
        | RW_Value'uint8 (R.Raw mut_ Std_.Word8)
        | RW_Value'uint16 (R.Raw mut_ Std_.Word16)
        | RW_Value'uint32 (R.Raw mut_ Std_.Word32)
        | RW_Value'uint64 (R.Raw mut_ Std_.Word64)
        | RW_Value'float32 (R.Raw mut_ Std_.Float)
        | RW_Value'float64 (R.Raw mut_ Std_.Double)
        | RW_Value'text (R.Raw mut_ Basics.Text)
        | RW_Value'data_ (R.Raw mut_ Basics.Data)
        | RW_Value'list (R.Raw mut_ Basics.AnyPointer)
        | RW_Value'enum (R.Raw mut_ Std_.Word16)
        | RW_Value'struct (R.Raw mut_ Basics.AnyPointer)
        | RW_Value'interface (R.Raw mut_ ())
        | RW_Value'anyPointer (R.Raw mut_ Basics.AnyPointer)
        | RW_Value'unknown' Std_.Word16
    internalWhich :: Word16 -> Raw mut Value -> m (RawWhich mut Value)
internalWhich Word16
tag_ Raw mut Value
struct_ = case Word16
tag_ of
        Word16
0 ->
            (Raw mut () -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Value
RW_Value'void (Raw mut () -> RawWhich mut Value)
-> m (Raw mut ()) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value () -> Raw mut Value -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "void" (Variant 'Slot Value ())
Variant 'Slot Value ()
#void Raw mut Value
struct_))
        Word16
1 ->
            (Raw mut Bool -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Bool -> RawWhich mut_ Value
RW_Value'bool (Raw mut Bool -> RawWhich mut Value)
-> m (Raw mut Bool) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Bool -> Raw mut Value -> m (Raw mut Bool)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "bool" (Variant 'Slot Value Bool)
Variant 'Slot Value Bool
#bool Raw mut Value
struct_))
        Word16
2 ->
            (Raw mut Int8 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Int8 -> RawWhich mut_ Value
RW_Value'int8 (Raw mut Int8 -> RawWhich mut Value)
-> m (Raw mut Int8) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Int8 -> Raw mut Value -> m (Raw mut Int8)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int8" (Variant 'Slot Value Int8)
Variant 'Slot Value Int8
#int8 Raw mut Value
struct_))
        Word16
3 ->
            (Raw mut Int16 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Int16 -> RawWhich mut_ Value
RW_Value'int16 (Raw mut Int16 -> RawWhich mut Value)
-> m (Raw mut Int16) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Int16 -> Raw mut Value -> m (Raw mut Int16)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int16" (Variant 'Slot Value Int16)
Variant 'Slot Value Int16
#int16 Raw mut Value
struct_))
        Word16
4 ->
            (Raw mut Int32 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Int32 -> RawWhich mut_ Value
RW_Value'int32 (Raw mut Int32 -> RawWhich mut Value)
-> m (Raw mut Int32) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Int32 -> Raw mut Value -> m (Raw mut Int32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int32" (Variant 'Slot Value Int32)
Variant 'Slot Value Int32
#int32 Raw mut Value
struct_))
        Word16
5 ->
            (Raw mut Int64 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Int64 -> RawWhich mut_ Value
RW_Value'int64 (Raw mut Int64 -> RawWhich mut Value)
-> m (Raw mut Int64) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Int64 -> Raw mut Value -> m (Raw mut Int64)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "int64" (Variant 'Slot Value Int64)
Variant 'Slot Value Int64
#int64 Raw mut Value
struct_))
        Word16
6 ->
            (Raw mut Word8 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Word8 -> RawWhich mut_ Value
RW_Value'uint8 (Raw mut Word8 -> RawWhich mut Value)
-> m (Raw mut Word8) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Word8 -> Raw mut Value -> m (Raw mut Word8)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint8" (Variant 'Slot Value Word8)
Variant 'Slot Value Word8
#uint8 Raw mut Value
struct_))
        Word16
7 ->
            (Raw mut Word16 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Word16 -> RawWhich mut_ Value
RW_Value'uint16 (Raw mut Word16 -> RawWhich mut Value)
-> m (Raw mut Word16) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Word16 -> Raw mut Value -> m (Raw mut Word16)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint16" (Variant 'Slot Value Word16)
Variant 'Slot Value Word16
#uint16 Raw mut Value
struct_))
        Word16
8 ->
            (Raw mut Word32 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Word32 -> RawWhich mut_ Value
RW_Value'uint32 (Raw mut Word32 -> RawWhich mut Value)
-> m (Raw mut Word32) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Word32 -> Raw mut Value -> m (Raw mut Word32)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint32" (Variant 'Slot Value Word32)
Variant 'Slot Value Word32
#uint32 Raw mut Value
struct_))
        Word16
9 ->
            (Raw mut Word64 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Word64 -> RawWhich mut_ Value
RW_Value'uint64 (Raw mut Word64 -> RawWhich mut Value)
-> m (Raw mut Word64) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Word64 -> Raw mut Value -> m (Raw mut Word64)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "uint64" (Variant 'Slot Value Word64)
Variant 'Slot Value Word64
#uint64 Raw mut Value
struct_))
        Word16
10 ->
            (Raw mut Float -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Float -> RawWhich mut_ Value
RW_Value'float32 (Raw mut Float -> RawWhich mut Value)
-> m (Raw mut Float) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Float -> Raw mut Value -> m (Raw mut Float)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "float32" (Variant 'Slot Value Float)
Variant 'Slot Value Float
#float32 Raw mut Value
struct_))
        Word16
11 ->
            (Raw mut Double -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Double -> RawWhich mut_ Value
RW_Value'float64 (Raw mut Double -> RawWhich mut Value)
-> m (Raw mut Double) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Double -> Raw mut Value -> m (Raw mut Double)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "float64" (Variant 'Slot Value Double)
Variant 'Slot Value Double
#float64 Raw mut Value
struct_))
        Word16
12 ->
            (Raw mut Text -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Text -> RawWhich mut_ Value
RW_Value'text (Raw mut Text -> RawWhich mut Value)
-> m (Raw mut Text) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Text -> Raw mut Value -> m (Raw mut Text)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "text" (Variant 'Slot Value Text)
Variant 'Slot Value Text
#text Raw mut Value
struct_))
        Word16
13 ->
            (Raw mut Data -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Data -> RawWhich mut_ Value
RW_Value'data_ (Raw mut Data -> RawWhich mut Value)
-> m (Raw mut Data) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Data -> Raw mut Value -> m (Raw mut Data)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "data_" (Variant 'Slot Value Data)
Variant 'Slot Value Data
#data_ Raw mut Value
struct_))
        Word16
14 ->
            (Raw mut AnyPointer -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Value
RW_Value'list (Raw mut AnyPointer -> RawWhich mut Value)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value AnyPointer
-> Raw mut Value -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "list" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#list Raw mut Value
struct_))
        Word16
15 ->
            (Raw mut Word16 -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ Word16 -> RawWhich mut_ Value
RW_Value'enum (Raw mut Word16 -> RawWhich mut Value)
-> m (Raw mut Word16) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value Word16 -> Raw mut Value -> m (Raw mut Word16)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "enum" (Variant 'Slot Value Word16)
Variant 'Slot Value Word16
#enum Raw mut Value
struct_))
        Word16
16 ->
            (Raw mut AnyPointer -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Value
RW_Value'struct (Raw mut AnyPointer -> RawWhich mut Value)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value AnyPointer
-> Raw mut Value -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "struct" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#struct Raw mut Value
struct_))
        Word16
17 ->
            (Raw mut () -> RawWhich mut Value
forall (mut_ :: Mutability). Raw mut_ () -> RawWhich mut_ Value
RW_Value'interface (Raw mut () -> RawWhich mut Value)
-> m (Raw mut ()) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value () -> Raw mut Value -> m (Raw mut ())
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "interface" (Variant 'Slot Value ())
Variant 'Slot Value ()
#interface Raw mut Value
struct_))
        Word16
18 ->
            (Raw mut AnyPointer -> RawWhich mut Value
forall (mut_ :: Mutability).
Raw mut_ AnyPointer -> RawWhich mut_ Value
RW_Value'anyPointer (Raw mut AnyPointer -> RawWhich mut Value)
-> m (Raw mut AnyPointer) -> m (RawWhich mut Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Variant 'Slot Value AnyPointer
-> Raw mut Value -> m (Raw mut AnyPointer)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Variant k a b -> Raw mut a -> m (Raw mut b)
GH.readVariant IsLabel "anyPointer" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#anyPointer Raw mut Value
struct_))
        Word16
_ ->
            (RawWhich mut Value -> m (RawWhich mut Value)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> RawWhich mut Value
forall (mut_ :: Mutability). Word16 -> RawWhich mut_ Value
RW_Value'unknown' Word16
tag_))
    data Which Value
instance (GH.HasVariant "void" GH.Slot Value ()) where
    variantByLabel :: Variant 'Slot Value ()
variantByLabel  = (Field 'Slot Value () -> Word16 -> Variant 'Slot Value ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Value ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
0)
instance (GH.HasVariant "bool" GH.Slot Value Std_.Bool) where
    variantByLabel :: Variant 'Slot Value Bool
variantByLabel  = (Field 'Slot Value Bool -> Word16 -> Variant 'Slot Value Bool
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Bool
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
1 Word64
0) Word16
1)
instance (GH.HasVariant "int8" GH.Slot Value Std_.Int8) where
    variantByLabel :: Variant 'Slot Value Int8
variantByLabel  = (Field 'Slot Value Int8 -> Word16 -> Variant 'Slot Value Int8
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Int8
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
0) Word16
2)
instance (GH.HasVariant "int16" GH.Slot Value Std_.Int16) where
    variantByLabel :: Variant 'Slot Value Int16
variantByLabel  = (Field 'Slot Value Int16 -> Word16 -> Variant 'Slot Value Int16
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Int16
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
3)
instance (GH.HasVariant "int32" GH.Slot Value Std_.Int32) where
    variantByLabel :: Variant 'Slot Value Int32
variantByLabel  = (Field 'Slot Value Int32 -> Word16 -> Variant 'Slot Value Int32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Int32
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
4)
instance (GH.HasVariant "int64" GH.Slot Value Std_.Int64) where
    variantByLabel :: Variant 'Slot Value Int64
variantByLabel  = (Field 'Slot Value Int64 -> Word16 -> Variant 'Slot Value Int64
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Int64
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) Word16
5)
instance (GH.HasVariant "uint8" GH.Slot Value Std_.Word8) where
    variantByLabel :: Variant 'Slot Value Word8
variantByLabel  = (Field 'Slot Value Word8 -> Word16 -> Variant 'Slot Value Word8
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word8
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
8 Word64
0) Word16
6)
instance (GH.HasVariant "uint16" GH.Slot Value Std_.Word16) where
    variantByLabel :: Variant 'Slot Value Word16
variantByLabel  = (Field 'Slot Value Word16 -> Word16 -> Variant 'Slot Value Word16
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
16 Word64
0) Word16
7)
instance (GH.HasVariant "uint32" GH.Slot Value Std_.Word32) where
    variantByLabel :: Variant 'Slot Value Word32
variantByLabel  = (Field 'Slot Value Word32 -> Word16 -> Variant 'Slot Value Word32
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word32
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
32 Word16
0 BitCount
32 Word64
0) Word16
8)
instance (GH.HasVariant "uint64" GH.Slot Value Std_.Word64) where
    variantByLabel :: Variant 'Slot Value Word64
variantByLabel  = (Field 'Slot Value Word64 -> Word16 -> Variant 'Slot Value Word64
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
1 BitCount
64 Word64
0) Word16
9)
instance (GH.HasVariant "float32" GH.Slot Value Std_.Float) where
    variantByLabel :: Variant 'Slot Value Float
variantByLabel  = (Field 'Slot Value Float -> Word16 -> Variant 'Slot Value Float
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot Value Float
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
10)
instance (GH.HasVariant "float64" GH.Slot Value Std_.Double) where
    variantByLabel :: Variant 'Slot Value Double
variantByLabel  = (Field 'Slot Value Double -> Word16 -> Variant 'Slot Value Double
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Double
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) Word16
11)
instance (GH.HasVariant "text" GH.Slot Value Basics.Text) where
    variantByLabel :: Variant 'Slot Value Text
variantByLabel  = (Field 'Slot Value Text -> Word16 -> Variant 'Slot Value Text
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
12)
instance (GH.HasVariant "data_" GH.Slot Value Basics.Data) where
    variantByLabel :: Variant 'Slot Value Data
variantByLabel  = (Field 'Slot Value Data -> Word16 -> Variant 'Slot Value Data
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value Data
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
13)
instance (GH.HasVariant "list" GH.Slot Value Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Value AnyPointer
variantByLabel  = (Field 'Slot Value AnyPointer
-> Word16 -> Variant 'Slot Value AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
14)
instance (GH.HasVariant "enum" GH.Slot Value Std_.Word16) where
    variantByLabel :: Variant 'Slot Value Word16
variantByLabel  = (Field 'Slot Value Word16 -> Word16 -> Variant 'Slot Value Word16
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Value Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
16 Word64
0) Word16
15)
instance (GH.HasVariant "struct" GH.Slot Value Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Value AnyPointer
variantByLabel  = (Field 'Slot Value AnyPointer
-> Word16 -> Variant 'Slot Value AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
16)
instance (GH.HasVariant "interface" GH.Slot Value ()) where
    variantByLabel :: Variant 'Slot Value ()
variantByLabel  = (Field 'Slot Value () -> Word16 -> Variant 'Slot Value ()
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant Field 'Slot Value ()
forall b a. (ReprFor b ~ 'Data 'Sz0) => Field 'Slot a b
GH.voidField Word16
17)
instance (GH.HasVariant "anyPointer" GH.Slot Value Basics.AnyPointer) where
    variantByLabel :: Variant 'Slot Value AnyPointer
variantByLabel  = (Field 'Slot Value AnyPointer
-> Word16 -> Variant 'Slot Value AnyPointer
forall (k :: FieldKind) a b. Field k a b -> Word16 -> Variant k a b
GH.Variant (Word16 -> Field 'Slot Value AnyPointer
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0) Word16
18)
data instance C.Parsed (GH.Which Value)
    = Value'void 
    | Value'bool (RP.Parsed Std_.Bool)
    | Value'int8 (RP.Parsed Std_.Int8)
    | Value'int16 (RP.Parsed Std_.Int16)
    | Value'int32 (RP.Parsed Std_.Int32)
    | Value'int64 (RP.Parsed Std_.Int64)
    | Value'uint8 (RP.Parsed Std_.Word8)
    | Value'uint16 (RP.Parsed Std_.Word16)
    | Value'uint32 (RP.Parsed Std_.Word32)
    | Value'uint64 (RP.Parsed Std_.Word64)
    | Value'float32 (RP.Parsed Std_.Float)
    | Value'float64 (RP.Parsed Std_.Double)
    | Value'text (RP.Parsed Basics.Text)
    | Value'data_ (RP.Parsed Basics.Data)
    | Value'list (RP.Parsed Basics.AnyPointer)
    | Value'enum (RP.Parsed Std_.Word16)
    | Value'struct (RP.Parsed Basics.AnyPointer)
    | Value'interface 
    | Value'anyPointer (RP.Parsed Basics.AnyPointer)
    | Value'unknown' Std_.Word16
    deriving((forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x)
-> (forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value))
-> Generic (Parsed (Which Value))
forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value)
forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed (Which Value)) x -> Parsed (Which Value)
$cfrom :: forall x. Parsed (Which Value) -> Rep (Parsed (Which Value)) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed (GH.Which Value)))
deriving instance (Std_.Eq (C.Parsed (GH.Which Value)))
instance (C.Parse (GH.Which Value) (C.Parsed (GH.Which Value))) where
    parse :: Raw 'Const (Which Value) -> m (Parsed (Which Value))
parse Raw 'Const (Which Value)
raw_ = (do
        RawWhich 'Const Value
rawWhich_ <- (Raw 'Const (Which Value) -> m (RawWhich 'Const Value)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw mut (Which a) -> m (RawWhich mut a)
GH.unionWhich Raw 'Const (Which Value)
raw_)
        case RawWhich 'Const Value
rawWhich_ of
            (RW_Value'void _) ->
                (Parsed (Which Value) -> m (Parsed (Which Value))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Value)
Value'void)
            (RW_Value'bool rawArg_) ->
                (Bool -> Parsed (Which Value)
Parsed Bool -> Parsed (Which Value)
Value'bool (Bool -> Parsed (Which Value))
-> m Bool -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Bool -> m Bool
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Bool
rawArg_))
            (RW_Value'int8 rawArg_) ->
                (Int8 -> Parsed (Which Value)
Parsed Int8 -> Parsed (Which Value)
Value'int8 (Int8 -> Parsed (Which Value))
-> m Int8 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Int8 -> m Int8
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Int8
rawArg_))
            (RW_Value'int16 rawArg_) ->
                (Int16 -> Parsed (Which Value)
Parsed Int16 -> Parsed (Which Value)
Value'int16 (Int16 -> Parsed (Which Value))
-> m Int16 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Int16 -> m Int16
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Int16
rawArg_))
            (RW_Value'int32 rawArg_) ->
                (Int32 -> Parsed (Which Value)
Parsed Int32 -> Parsed (Which Value)
Value'int32 (Int32 -> Parsed (Which Value))
-> m Int32 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Int32 -> m Int32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Int32
rawArg_))
            (RW_Value'int64 rawArg_) ->
                (Int64 -> Parsed (Which Value)
Parsed Int64 -> Parsed (Which Value)
Value'int64 (Int64 -> Parsed (Which Value))
-> m Int64 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Int64 -> m Int64
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Int64
rawArg_))
            (RW_Value'uint8 rawArg_) ->
                (Word8 -> Parsed (Which Value)
Parsed Word8 -> Parsed (Which Value)
Value'uint8 (Word8 -> Parsed (Which Value))
-> m Word8 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word8 -> m Word8
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word8
rawArg_))
            (RW_Value'uint16 rawArg_) ->
                (Word16 -> Parsed (Which Value)
Parsed Word16 -> Parsed (Which Value)
Value'uint16 (Word16 -> Parsed (Which Value))
-> m Word16 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word16 -> m Word16
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word16
rawArg_))
            (RW_Value'uint32 rawArg_) ->
                (Word32 -> Parsed (Which Value)
Parsed Word32 -> Parsed (Which Value)
Value'uint32 (Word32 -> Parsed (Which Value))
-> m Word32 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word32 -> m Word32
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word32
rawArg_))
            (RW_Value'uint64 rawArg_) ->
                (Word64 -> Parsed (Which Value)
Parsed Word64 -> Parsed (Which Value)
Value'uint64 (Word64 -> Parsed (Which Value))
-> m Word64 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word64 -> m Word64
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word64
rawArg_))
            (RW_Value'float32 rawArg_) ->
                (Float -> Parsed (Which Value)
Parsed Float -> Parsed (Which Value)
Value'float32 (Float -> Parsed (Which Value))
-> m Float -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Float -> m Float
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Float
rawArg_))
            (RW_Value'float64 rawArg_) ->
                (Double -> Parsed (Which Value)
Parsed Double -> Parsed (Which Value)
Value'float64 (Double -> Parsed (Which Value))
-> m Double -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Double -> m Double
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Double
rawArg_))
            (RW_Value'text rawArg_) ->
                (Text -> Parsed (Which Value)
Parsed Text -> Parsed (Which Value)
Value'text (Text -> Parsed (Which Value))
-> m Text -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Text -> m Text
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Text
rawArg_))
            (RW_Value'data_ rawArg_) ->
                (ByteString -> Parsed (Which Value)
Parsed Data -> Parsed (Which Value)
Value'data_ (ByteString -> Parsed (Which Value))
-> m ByteString -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Data -> m ByteString
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Data
rawArg_))
            (RW_Value'list rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Value)
Parsed AnyPointer -> Parsed (Which Value)
Value'list (Parsed AnyPointer -> Parsed (Which Value))
-> m (Parsed AnyPointer) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Value'enum rawArg_) ->
                (Word16 -> Parsed (Which Value)
Parsed Word16 -> Parsed (Which Value)
Value'enum (Word16 -> Parsed (Which Value))
-> m Word16 -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const Word16 -> m Word16
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const Word16
rawArg_))
            (RW_Value'struct rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Value)
Parsed AnyPointer -> Parsed (Which Value)
Value'struct (Parsed AnyPointer -> Parsed (Which Value))
-> m (Parsed AnyPointer) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Value'interface _) ->
                (Parsed (Which Value) -> m (Parsed (Which Value))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Parsed (Which Value)
Value'interface)
            (RW_Value'anyPointer rawArg_) ->
                (Parsed AnyPointer -> Parsed (Which Value)
Parsed AnyPointer -> Parsed (Which Value)
Value'anyPointer (Parsed AnyPointer -> Parsed (Which Value))
-> m (Parsed AnyPointer) -> m (Parsed (Which Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse Raw 'Const AnyPointer
rawArg_))
            (RW_Value'unknown' tag_) ->
                (Parsed (Which Value) -> m (Parsed (Which Value))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Parsed (Which Value)
Value'unknown' Word16
tag_))
        )
instance (C.Marshal (GH.Which Value) (C.Parsed (GH.Which Value))) where
    marshalInto :: Raw ('Mut s) (Which Value) -> Parsed (Which Value) -> m ()
marshalInto Raw ('Mut s) (Which Value)
raw_ Parsed (Which Value)
parsed_ = case Parsed (Which Value)
parsed_ of
        (Parsed (Which Value)
Value'void) ->
            (Variant 'Slot Value () -> () -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "void" (Variant 'Slot Value ())
Variant 'Slot Value ()
#void () (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'bool arg_) ->
            (Variant 'Slot Value Bool -> Bool -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "bool" (Variant 'Slot Value Bool)
Variant 'Slot Value Bool
#bool Bool
Parsed Bool
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'int8 arg_) ->
            (Variant 'Slot Value Int8 -> Int8 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int8" (Variant 'Slot Value Int8)
Variant 'Slot Value Int8
#int8 Int8
Parsed Int8
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'int16 arg_) ->
            (Variant 'Slot Value Int16 -> Int16 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int16" (Variant 'Slot Value Int16)
Variant 'Slot Value Int16
#int16 Int16
Parsed Int16
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'int32 arg_) ->
            (Variant 'Slot Value Int32 -> Int32 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int32" (Variant 'Slot Value Int32)
Variant 'Slot Value Int32
#int32 Int32
Parsed Int32
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'int64 arg_) ->
            (Variant 'Slot Value Int64 -> Int64 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "int64" (Variant 'Slot Value Int64)
Variant 'Slot Value Int64
#int64 Int64
Parsed Int64
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'uint8 arg_) ->
            (Variant 'Slot Value Word8 -> Word8 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint8" (Variant 'Slot Value Word8)
Variant 'Slot Value Word8
#uint8 Word8
Parsed Word8
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'uint16 arg_) ->
            (Variant 'Slot Value Word16 -> Word16 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint16" (Variant 'Slot Value Word16)
Variant 'Slot Value Word16
#uint16 Word16
Parsed Word16
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'uint32 arg_) ->
            (Variant 'Slot Value Word32 -> Word32 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint32" (Variant 'Slot Value Word32)
Variant 'Slot Value Word32
#uint32 Word32
Parsed Word32
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'uint64 arg_) ->
            (Variant 'Slot Value Word64 -> Word64 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "uint64" (Variant 'Slot Value Word64)
Variant 'Slot Value Word64
#uint64 Word64
Parsed Word64
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'float32 arg_) ->
            (Variant 'Slot Value Float -> Float -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "float32" (Variant 'Slot Value Float)
Variant 'Slot Value Float
#float32 Float
Parsed Float
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'float64 arg_) ->
            (Variant 'Slot Value Double -> Double -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "float64" (Variant 'Slot Value Double)
Variant 'Slot Value Double
#float64 Double
Parsed Double
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'text arg_) ->
            (Variant 'Slot Value Text -> Text -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "text" (Variant 'Slot Value Text)
Variant 'Slot Value Text
#text Text
Parsed Text
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'data_ arg_) ->
            (Variant 'Slot Value Data
-> ByteString -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "data_" (Variant 'Slot Value Data)
Variant 'Slot Value Data
#data_ ByteString
Parsed Data
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'list arg_) ->
            (Variant 'Slot Value AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "list" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#list Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'enum arg_) ->
            (Variant 'Slot Value Word16 -> Word16 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "enum" (Variant 'Slot Value Word16)
Variant 'Slot Value Word16
#enum Word16
Parsed Word16
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'struct arg_) ->
            (Variant 'Slot Value AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "struct" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#struct Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Parsed (Which Value)
Value'interface) ->
            (Variant 'Slot Value () -> () -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "interface" (Variant 'Slot Value ())
Variant 'Slot Value ()
#interface () (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'anyPointer arg_) ->
            (Variant 'Slot Value AnyPointer
-> Parsed AnyPointer -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
Variant 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeVariant IsLabel "anyPointer" (Variant 'Slot Value AnyPointer)
Variant 'Slot Value AnyPointer
#anyPointer Parsed AnyPointer
Parsed AnyPointer
arg_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
        (Value'unknown' tag_) ->
            (Field 'Slot Value Word16 -> Word16 -> Raw ('Mut s) Value -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField Field 'Slot Value Word16
forall a. HasUnion a => Field 'Slot a Word16
GH.unionField Word16
tag_ (Raw ('Mut s) (Which Value) -> Raw ('Mut s) Value
forall a (mut :: Mutability).
HasUnion a =>
Raw mut (Which a) -> Raw mut a
GH.unionStruct Raw ('Mut s) (Which Value)
raw_))
data Annotation 
type instance (R.ReprFor Annotation) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct Annotation) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate Annotation) where
    type AllocHint Annotation = ()
    new :: AllocHint Annotation
-> Message ('Mut s) -> m (Raw ('Mut s) Annotation)
new AllocHint Annotation
_ = Message ('Mut s) -> m (Raw ('Mut s) Annotation)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc Annotation (C.Parsed Annotation))
instance (C.AllocateList Annotation) where
    type ListAllocHint Annotation = Std_.Int
    newList :: ListAllocHint Annotation
-> Message ('Mut s) -> m (Raw ('Mut s) (List Annotation))
newList  = ListAllocHint Annotation
-> Message ('Mut s) -> m (Raw ('Mut s) (List Annotation))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc Annotation (C.Parsed Annotation))
data instance C.Parsed Annotation
    = Annotation 
        {Parsed Annotation -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed Annotation -> Parsed Value
value :: (RP.Parsed Value)
        ,Parsed Annotation -> Parsed Brand
brand :: (RP.Parsed Brand)}
    deriving((forall x. Parsed Annotation -> Rep (Parsed Annotation) x)
-> (forall x. Rep (Parsed Annotation) x -> Parsed Annotation)
-> Generic (Parsed Annotation)
forall x. Rep (Parsed Annotation) x -> Parsed Annotation
forall x. Parsed Annotation -> Rep (Parsed Annotation) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed Annotation) x -> Parsed Annotation
$cfrom :: forall x. Parsed Annotation -> Rep (Parsed Annotation) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed Annotation))
deriving instance (Std_.Eq (C.Parsed Annotation))
instance (C.Parse Annotation (C.Parsed Annotation)) where
    parse :: Raw 'Const Annotation -> m (Parsed Annotation)
parse Raw 'Const Annotation
raw_ = (Word64 -> Parsed Value -> Parsed Brand -> Parsed Annotation
Parsed Word64 -> Parsed Value -> Parsed Brand -> Parsed Annotation
Annotation (Word64 -> Parsed Value -> Parsed Brand -> Parsed Annotation)
-> m Word64
-> m (Parsed Value -> Parsed Brand -> Parsed Annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot Annotation Word64 -> Raw 'Const Annotation -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "id" (Field 'Slot Annotation Word64)
Field 'Slot Annotation Word64
#id Raw 'Const Annotation
raw_)
                             m (Parsed Value -> Parsed Brand -> Parsed Annotation)
-> m (Parsed Value) -> m (Parsed Brand -> Parsed Annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Annotation Value
-> Raw 'Const Annotation -> m (Parsed Value)
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 "value" (Field 'Slot Annotation Value)
Field 'Slot Annotation Value
#value Raw 'Const Annotation
raw_)
                             m (Parsed Brand -> Parsed Annotation)
-> m (Parsed Brand) -> m (Parsed Annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot Annotation Brand
-> Raw 'Const Annotation -> m (Parsed Brand)
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 "brand" (Field 'Slot Annotation Brand)
Field 'Slot Annotation Brand
#brand Raw 'Const Annotation
raw_))
instance (C.Marshal Annotation (C.Parsed Annotation)) where
    marshalInto :: Raw ('Mut s) Annotation -> Parsed Annotation -> m ()
marshalInto Raw ('Mut s) Annotation
raw_ Annotation{..} = (do
        (Field 'Slot Annotation Word64
-> Word64 -> Raw ('Mut s) Annotation -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel "id" (Field 'Slot Annotation Word64)
Field 'Slot Annotation Word64
#id Word64
Parsed Word64
id Raw ('Mut s) Annotation
raw_)
        (Field 'Slot Annotation Value
-> Parsed Value -> Raw ('Mut s) Annotation -> 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 "value" (Field 'Slot Annotation Value)
Field 'Slot Annotation Value
#value Parsed Value
Parsed Value
value Raw ('Mut s) Annotation
raw_)
        (Field 'Slot Annotation Brand
-> Parsed Brand -> Raw ('Mut s) Annotation -> 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 "brand" (Field 'Slot Annotation Brand)
Field 'Slot Annotation Brand
#brand Parsed Brand
Parsed Brand
brand Raw ('Mut s) Annotation
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot Annotation Std_.Word64) where
    fieldByLabel :: Field 'Slot Annotation Word64
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot Annotation Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "value" GH.Slot Annotation Value) where
    fieldByLabel :: Field 'Slot Annotation Value
fieldByLabel  = (Word16 -> Field 'Slot Annotation Value
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "brand" GH.Slot Annotation Brand) where
    fieldByLabel :: Field 'Slot Annotation Brand
fieldByLabel  = (Word16 -> Field 'Slot Annotation Brand
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data ElementSize 
    = ElementSize'empty 
    | ElementSize'bit 
    | ElementSize'byte 
    | ElementSize'twoBytes 
    | ElementSize'fourBytes 
    | ElementSize'eightBytes 
    | ElementSize'pointer 
    | ElementSize'inlineComposite 
    | ElementSize'unknown' Std_.Word16
    deriving(ElementSize -> ElementSize -> Bool
(ElementSize -> ElementSize -> Bool)
-> (ElementSize -> ElementSize -> Bool) -> Eq ElementSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementSize -> ElementSize -> Bool
$c/= :: ElementSize -> ElementSize -> Bool
== :: ElementSize -> ElementSize -> Bool
$c== :: ElementSize -> ElementSize -> Bool
Std_.Eq,Int -> ElementSize -> ShowS
[ElementSize] -> ShowS
ElementSize -> String
(Int -> ElementSize -> ShowS)
-> (ElementSize -> String)
-> ([ElementSize] -> ShowS)
-> Show ElementSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementSize] -> ShowS
$cshowList :: [ElementSize] -> ShowS
show :: ElementSize -> String
$cshow :: ElementSize -> String
showsPrec :: Int -> ElementSize -> ShowS
$cshowsPrec :: Int -> ElementSize -> ShowS
Std_.Show)
type instance (R.ReprFor ElementSize) = (R.Data R.Sz16)
instance (Std_.Enum ElementSize) where
    toEnum :: Int -> ElementSize
toEnum Int
n_ = case Int
n_ of
        Int
0 ->
            ElementSize
ElementSize'empty
        Int
1 ->
            ElementSize
ElementSize'bit
        Int
2 ->
            ElementSize
ElementSize'byte
        Int
3 ->
            ElementSize
ElementSize'twoBytes
        Int
4 ->
            ElementSize
ElementSize'fourBytes
        Int
5 ->
            ElementSize
ElementSize'eightBytes
        Int
6 ->
            ElementSize
ElementSize'pointer
        Int
7 ->
            ElementSize
ElementSize'inlineComposite
        Int
tag_ ->
            (Word16 -> ElementSize
ElementSize'unknown' (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Int
tag_))
    fromEnum :: ElementSize -> Int
fromEnum ElementSize
value_ = case ElementSize
value_ of
        (ElementSize
ElementSize'empty) ->
            Int
0
        (ElementSize
ElementSize'bit) ->
            Int
1
        (ElementSize
ElementSize'byte) ->
            Int
2
        (ElementSize
ElementSize'twoBytes) ->
            Int
3
        (ElementSize
ElementSize'fourBytes) ->
            Int
4
        (ElementSize
ElementSize'eightBytes) ->
            Int
5
        (ElementSize
ElementSize'pointer) ->
            Int
6
        (ElementSize
ElementSize'inlineComposite) ->
            Int
7
        (ElementSize'unknown' Word16
tag_) ->
            (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag_)
instance (C.IsWord ElementSize) where
    fromWord :: Word64 -> ElementSize
fromWord Word64
w_ = (Int -> ElementSize
forall a. Enum a => Int -> a
Std_.toEnum (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
w_))
    toWord :: ElementSize -> Word64
toWord ElementSize
v_ = (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (ElementSize -> Int
forall a. Enum a => a -> Int
Std_.fromEnum ElementSize
v_))
instance (C.Parse ElementSize ElementSize) where
    parse :: Raw 'Const ElementSize -> m ElementSize
parse  = Raw 'Const ElementSize -> m ElementSize
forall a (m :: * -> *).
(ReprFor a ~ 'Data 'Sz16, Enum a, Applicative m) =>
Raw 'Const a -> m a
GH.parseEnum
    encode :: Message ('Mut s) -> ElementSize -> m (Raw ('Mut s) ElementSize)
encode  = Message ('Mut s) -> ElementSize -> m (Raw ('Mut s) ElementSize)
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 ElementSize) where
    type ListAllocHint ElementSize = Std_.Int
instance (C.EstimateListAlloc ElementSize ElementSize)
data CapnpVersion 
type instance (R.ReprFor CapnpVersion) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct CapnpVersion) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
0
instance (C.Allocate CapnpVersion) where
    type AllocHint CapnpVersion = ()
    new :: AllocHint CapnpVersion
-> Message ('Mut s) -> m (Raw ('Mut s) CapnpVersion)
new AllocHint CapnpVersion
_ = Message ('Mut s) -> m (Raw ('Mut s) CapnpVersion)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc CapnpVersion (C.Parsed CapnpVersion))
instance (C.AllocateList CapnpVersion) where
    type ListAllocHint CapnpVersion = Std_.Int
    newList :: ListAllocHint CapnpVersion
-> Message ('Mut s) -> m (Raw ('Mut s) (List CapnpVersion))
newList  = ListAllocHint CapnpVersion
-> Message ('Mut s) -> m (Raw ('Mut s) (List CapnpVersion))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc CapnpVersion (C.Parsed CapnpVersion))
data instance C.Parsed CapnpVersion
    = CapnpVersion 
        {Parsed CapnpVersion -> Parsed Word16
major :: (RP.Parsed Std_.Word16)
        ,Parsed CapnpVersion -> Parsed Word8
minor :: (RP.Parsed Std_.Word8)
        ,Parsed CapnpVersion -> Parsed Word8
micro :: (RP.Parsed Std_.Word8)}
    deriving((forall x. Parsed CapnpVersion -> Rep (Parsed CapnpVersion) x)
-> (forall x. Rep (Parsed CapnpVersion) x -> Parsed CapnpVersion)
-> Generic (Parsed CapnpVersion)
forall x. Rep (Parsed CapnpVersion) x -> Parsed CapnpVersion
forall x. Parsed CapnpVersion -> Rep (Parsed CapnpVersion) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed CapnpVersion) x -> Parsed CapnpVersion
$cfrom :: forall x. Parsed CapnpVersion -> Rep (Parsed CapnpVersion) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed CapnpVersion))
deriving instance (Std_.Eq (C.Parsed CapnpVersion))
instance (C.Parse CapnpVersion (C.Parsed CapnpVersion)) where
    parse :: Raw 'Const CapnpVersion -> m (Parsed CapnpVersion)
parse Raw 'Const CapnpVersion
raw_ = (Word16 -> Word8 -> Word8 -> Parsed CapnpVersion
Parsed Word16
-> Parsed Word8 -> Parsed Word8 -> Parsed CapnpVersion
CapnpVersion (Word16 -> Word8 -> Word8 -> Parsed CapnpVersion)
-> m Word16 -> m (Word8 -> Word8 -> Parsed CapnpVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot CapnpVersion Word16
-> Raw 'Const CapnpVersion -> 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 "major" (Field 'Slot CapnpVersion Word16)
Field 'Slot CapnpVersion Word16
#major Raw 'Const CapnpVersion
raw_)
                               m (Word8 -> Word8 -> Parsed CapnpVersion)
-> m Word8 -> m (Word8 -> Parsed CapnpVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CapnpVersion Word8
-> Raw 'Const CapnpVersion -> m Word8
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "minor" (Field 'Slot CapnpVersion Word8)
Field 'Slot CapnpVersion Word8
#minor Raw 'Const CapnpVersion
raw_)
                               m (Word8 -> Parsed CapnpVersion)
-> m Word8 -> m (Parsed CapnpVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CapnpVersion Word8
-> Raw 'Const CapnpVersion -> m Word8
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel "micro" (Field 'Slot CapnpVersion Word8)
Field 'Slot CapnpVersion Word8
#micro Raw 'Const CapnpVersion
raw_))
instance (C.Marshal CapnpVersion (C.Parsed CapnpVersion)) where
    marshalInto :: Raw ('Mut s) CapnpVersion -> Parsed CapnpVersion -> m ()
marshalInto Raw ('Mut s) CapnpVersion
raw_ CapnpVersion{..} = (do
        (Field 'Slot CapnpVersion Word16
-> Word16 -> Raw ('Mut s) CapnpVersion -> 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 "major" (Field 'Slot CapnpVersion Word16)
Field 'Slot CapnpVersion Word16
#major Word16
Parsed Word16
major Raw ('Mut s) CapnpVersion
raw_)
        (Field 'Slot CapnpVersion Word8
-> Word8 -> Raw ('Mut s) CapnpVersion -> 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 "minor" (Field 'Slot CapnpVersion Word8)
Field 'Slot CapnpVersion Word8
#minor Word8
Parsed Word8
minor Raw ('Mut s) CapnpVersion
raw_)
        (Field 'Slot CapnpVersion Word8
-> Word8 -> Raw ('Mut s) CapnpVersion -> 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 "micro" (Field 'Slot CapnpVersion Word8)
Field 'Slot CapnpVersion Word8
#micro Word8
Parsed Word8
micro Raw ('Mut s) CapnpVersion
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "major" GH.Slot CapnpVersion Std_.Word16) where
    fieldByLabel :: Field 'Slot CapnpVersion Word16
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapnpVersion Word16
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
16 Word64
0)
instance (GH.HasField "minor" GH.Slot CapnpVersion Std_.Word8) where
    fieldByLabel :: Field 'Slot CapnpVersion Word8
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapnpVersion Word8
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
16 Word16
0 BitCount
8 Word64
0)
instance (GH.HasField "micro" GH.Slot CapnpVersion Std_.Word8) where
    fieldByLabel :: Field 'Slot CapnpVersion Word8
fieldByLabel  = (BitCount
-> Word16 -> BitCount -> Word64 -> Field 'Slot CapnpVersion Word8
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
24 Word16
0 BitCount
8 Word64
0)
data CodeGeneratorRequest 
type instance (R.ReprFor CodeGeneratorRequest) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct CodeGeneratorRequest) where
    numStructWords :: Word16
numStructWords  = Word16
0
    numStructPtrs :: Word16
numStructPtrs  = Word16
4
instance (C.Allocate CodeGeneratorRequest) where
    type AllocHint CodeGeneratorRequest = ()
    new :: AllocHint CodeGeneratorRequest
-> Message ('Mut s) -> m (Raw ('Mut s) CodeGeneratorRequest)
new AllocHint CodeGeneratorRequest
_ = Message ('Mut s) -> m (Raw ('Mut s) CodeGeneratorRequest)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc CodeGeneratorRequest (C.Parsed CodeGeneratorRequest))
instance (C.AllocateList CodeGeneratorRequest) where
    type ListAllocHint CodeGeneratorRequest = Std_.Int
    newList :: ListAllocHint CodeGeneratorRequest
-> Message ('Mut s) -> m (Raw ('Mut s) (List CodeGeneratorRequest))
newList  = ListAllocHint CodeGeneratorRequest
-> Message ('Mut s) -> m (Raw ('Mut s) (List CodeGeneratorRequest))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc CodeGeneratorRequest (C.Parsed CodeGeneratorRequest))
data instance C.Parsed CodeGeneratorRequest
    = CodeGeneratorRequest 
        {Parsed CodeGeneratorRequest -> Parsed (List Node)
nodes :: (RP.Parsed (R.List Node))
        ,Parsed CodeGeneratorRequest
-> Parsed (List CodeGeneratorRequest'RequestedFile)
requestedFiles :: (RP.Parsed (R.List CodeGeneratorRequest'RequestedFile))
        ,Parsed CodeGeneratorRequest -> Parsed CapnpVersion
capnpVersion :: (RP.Parsed CapnpVersion)
        ,Parsed CodeGeneratorRequest -> Parsed (List Node'SourceInfo)
sourceInfo :: (RP.Parsed (R.List Node'SourceInfo))}
    deriving((forall x.
 Parsed CodeGeneratorRequest -> Rep (Parsed CodeGeneratorRequest) x)
-> (forall x.
    Rep (Parsed CodeGeneratorRequest) x -> Parsed CodeGeneratorRequest)
-> Generic (Parsed CodeGeneratorRequest)
forall x.
Rep (Parsed CodeGeneratorRequest) x -> Parsed CodeGeneratorRequest
forall x.
Parsed CodeGeneratorRequest -> Rep (Parsed CodeGeneratorRequest) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed CodeGeneratorRequest) x -> Parsed CodeGeneratorRequest
$cfrom :: forall x.
Parsed CodeGeneratorRequest -> Rep (Parsed CodeGeneratorRequest) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed CodeGeneratorRequest))
deriving instance (Std_.Eq (C.Parsed CodeGeneratorRequest))
instance (C.Parse CodeGeneratorRequest (C.Parsed CodeGeneratorRequest)) where
    parse :: Raw 'Const CodeGeneratorRequest -> m (Parsed CodeGeneratorRequest)
parse Raw 'Const CodeGeneratorRequest
raw_ = (Vector (Parsed Node)
-> Vector (Parsed CodeGeneratorRequest'RequestedFile)
-> Parsed CapnpVersion
-> Vector (Parsed Node'SourceInfo)
-> Parsed CodeGeneratorRequest
Parsed (List Node)
-> Parsed (List CodeGeneratorRequest'RequestedFile)
-> Parsed CapnpVersion
-> Parsed (List Node'SourceInfo)
-> Parsed CodeGeneratorRequest
CodeGeneratorRequest (Vector (Parsed Node)
 -> Vector (Parsed CodeGeneratorRequest'RequestedFile)
 -> Parsed CapnpVersion
 -> Vector (Parsed Node'SourceInfo)
 -> Parsed CodeGeneratorRequest)
-> m (Vector (Parsed Node))
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile)
      -> Parsed CapnpVersion
      -> Vector (Parsed Node'SourceInfo)
      -> Parsed CodeGeneratorRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot CodeGeneratorRequest (List Node)
-> Raw 'Const CodeGeneratorRequest -> m (Vector (Parsed Node))
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 "nodes" (Field 'Slot CodeGeneratorRequest (List Node))
Field 'Slot CodeGeneratorRequest (List Node)
#nodes Raw 'Const CodeGeneratorRequest
raw_)
                                       m (Vector (Parsed CodeGeneratorRequest'RequestedFile)
   -> Parsed CapnpVersion
   -> Vector (Parsed Node'SourceInfo)
   -> Parsed CodeGeneratorRequest)
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile))
-> m (Parsed CapnpVersion
      -> Vector (Parsed Node'SourceInfo) -> Parsed CodeGeneratorRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field
  'Slot
  CodeGeneratorRequest
  (List CodeGeneratorRequest'RequestedFile)
-> Raw 'Const CodeGeneratorRequest
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile))
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
  "requestedFiles"
  (Field
     'Slot
     CodeGeneratorRequest
     (List CodeGeneratorRequest'RequestedFile))
Field
  'Slot
  CodeGeneratorRequest
  (List CodeGeneratorRequest'RequestedFile)
#requestedFiles Raw 'Const CodeGeneratorRequest
raw_)
                                       m (Parsed CapnpVersion
   -> Vector (Parsed Node'SourceInfo) -> Parsed CodeGeneratorRequest)
-> m (Parsed CapnpVersion)
-> m (Vector (Parsed Node'SourceInfo)
      -> Parsed CodeGeneratorRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CodeGeneratorRequest CapnpVersion
-> Raw 'Const CodeGeneratorRequest -> m (Parsed CapnpVersion)
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
  "capnpVersion" (Field 'Slot CodeGeneratorRequest CapnpVersion)
Field 'Slot CodeGeneratorRequest CapnpVersion
#capnpVersion Raw 'Const CodeGeneratorRequest
raw_)
                                       m (Vector (Parsed Node'SourceInfo) -> Parsed CodeGeneratorRequest)
-> m (Vector (Parsed Node'SourceInfo))
-> m (Parsed CodeGeneratorRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
-> Raw 'Const CodeGeneratorRequest
-> m (Vector (Parsed Node'SourceInfo))
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
  "sourceInfo"
  (Field 'Slot CodeGeneratorRequest (List Node'SourceInfo))
Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
#sourceInfo Raw 'Const CodeGeneratorRequest
raw_))
instance (C.Marshal CodeGeneratorRequest (C.Parsed CodeGeneratorRequest)) where
    marshalInto :: Raw ('Mut s) CodeGeneratorRequest
-> Parsed CodeGeneratorRequest -> m ()
marshalInto Raw ('Mut s) CodeGeneratorRequest
raw_ CodeGeneratorRequest{..} = (do
        (Field 'Slot CodeGeneratorRequest (List Node)
-> Vector (Parsed Node)
-> Raw ('Mut s) CodeGeneratorRequest
-> 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 "nodes" (Field 'Slot CodeGeneratorRequest (List Node))
Field 'Slot CodeGeneratorRequest (List Node)
#nodes Vector (Parsed Node)
Parsed (List Node)
nodes Raw ('Mut s) CodeGeneratorRequest
raw_)
        (Field
  'Slot
  CodeGeneratorRequest
  (List CodeGeneratorRequest'RequestedFile)
-> Vector (Parsed CodeGeneratorRequest'RequestedFile)
-> Raw ('Mut s) CodeGeneratorRequest
-> 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
  "requestedFiles"
  (Field
     'Slot
     CodeGeneratorRequest
     (List CodeGeneratorRequest'RequestedFile))
Field
  'Slot
  CodeGeneratorRequest
  (List CodeGeneratorRequest'RequestedFile)
#requestedFiles Vector (Parsed CodeGeneratorRequest'RequestedFile)
Parsed (List CodeGeneratorRequest'RequestedFile)
requestedFiles Raw ('Mut s) CodeGeneratorRequest
raw_)
        (Field 'Slot CodeGeneratorRequest CapnpVersion
-> Parsed CapnpVersion -> Raw ('Mut s) CodeGeneratorRequest -> 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
  "capnpVersion" (Field 'Slot CodeGeneratorRequest CapnpVersion)
Field 'Slot CodeGeneratorRequest CapnpVersion
#capnpVersion Parsed CapnpVersion
Parsed CapnpVersion
capnpVersion Raw ('Mut s) CodeGeneratorRequest
raw_)
        (Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
-> Vector (Parsed Node'SourceInfo)
-> Raw ('Mut s) CodeGeneratorRequest
-> 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
  "sourceInfo"
  (Field 'Slot CodeGeneratorRequest (List Node'SourceInfo))
Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
#sourceInfo Vector (Parsed Node'SourceInfo)
Parsed (List Node'SourceInfo)
sourceInfo Raw ('Mut s) CodeGeneratorRequest
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "nodes" GH.Slot CodeGeneratorRequest (R.List Node)) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest (List Node)
fieldByLabel  = (Word16 -> Field 'Slot CodeGeneratorRequest (List Node)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "requestedFiles" GH.Slot CodeGeneratorRequest (R.List CodeGeneratorRequest'RequestedFile)) where
    fieldByLabel :: Field
  'Slot
  CodeGeneratorRequest
  (List CodeGeneratorRequest'RequestedFile)
fieldByLabel  = (Word16
-> Field
     'Slot
     CodeGeneratorRequest
     (List CodeGeneratorRequest'RequestedFile)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
instance (GH.HasField "capnpVersion" GH.Slot CodeGeneratorRequest CapnpVersion) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest CapnpVersion
fieldByLabel  = (Word16 -> Field 'Slot CodeGeneratorRequest CapnpVersion
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
2)
instance (GH.HasField "sourceInfo" GH.Slot CodeGeneratorRequest (R.List Node'SourceInfo)) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
fieldByLabel  = (Word16 -> Field 'Slot CodeGeneratorRequest (List Node'SourceInfo)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
3)
data CodeGeneratorRequest'RequestedFile 
type instance (R.ReprFor CodeGeneratorRequest'RequestedFile) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct CodeGeneratorRequest'RequestedFile) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
2
instance (C.Allocate CodeGeneratorRequest'RequestedFile) where
    type AllocHint CodeGeneratorRequest'RequestedFile = ()
    new :: AllocHint CodeGeneratorRequest'RequestedFile
-> Message ('Mut s)
-> m (Raw ('Mut s) CodeGeneratorRequest'RequestedFile)
new AllocHint CodeGeneratorRequest'RequestedFile
_ = Message ('Mut s)
-> m (Raw ('Mut s) CodeGeneratorRequest'RequestedFile)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc CodeGeneratorRequest'RequestedFile (C.Parsed CodeGeneratorRequest'RequestedFile))
instance (C.AllocateList CodeGeneratorRequest'RequestedFile) where
    type ListAllocHint CodeGeneratorRequest'RequestedFile = Std_.Int
    newList :: ListAllocHint CodeGeneratorRequest'RequestedFile
-> Message ('Mut s)
-> m (Raw ('Mut s) (List CodeGeneratorRequest'RequestedFile))
newList  = ListAllocHint CodeGeneratorRequest'RequestedFile
-> Message ('Mut s)
-> m (Raw ('Mut s) (List CodeGeneratorRequest'RequestedFile))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc CodeGeneratorRequest'RequestedFile (C.Parsed CodeGeneratorRequest'RequestedFile))
data instance C.Parsed CodeGeneratorRequest'RequestedFile
    = CodeGeneratorRequest'RequestedFile 
        {Parsed CodeGeneratorRequest'RequestedFile -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed CodeGeneratorRequest'RequestedFile -> Parsed Text
filename :: (RP.Parsed Basics.Text)
        ,Parsed CodeGeneratorRequest'RequestedFile
-> Parsed (List CodeGeneratorRequest'RequestedFile'Import)
imports :: (RP.Parsed (R.List CodeGeneratorRequest'RequestedFile'Import))}
    deriving((forall x.
 Parsed CodeGeneratorRequest'RequestedFile
 -> Rep (Parsed CodeGeneratorRequest'RequestedFile) x)
-> (forall x.
    Rep (Parsed CodeGeneratorRequest'RequestedFile) x
    -> Parsed CodeGeneratorRequest'RequestedFile)
-> Generic (Parsed CodeGeneratorRequest'RequestedFile)
forall x.
Rep (Parsed CodeGeneratorRequest'RequestedFile) x
-> Parsed CodeGeneratorRequest'RequestedFile
forall x.
Parsed CodeGeneratorRequest'RequestedFile
-> Rep (Parsed CodeGeneratorRequest'RequestedFile) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed CodeGeneratorRequest'RequestedFile) x
-> Parsed CodeGeneratorRequest'RequestedFile
$cfrom :: forall x.
Parsed CodeGeneratorRequest'RequestedFile
-> Rep (Parsed CodeGeneratorRequest'RequestedFile) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed CodeGeneratorRequest'RequestedFile))
deriving instance (Std_.Eq (C.Parsed CodeGeneratorRequest'RequestedFile))
instance (C.Parse CodeGeneratorRequest'RequestedFile (C.Parsed CodeGeneratorRequest'RequestedFile)) where
    parse :: Raw 'Const CodeGeneratorRequest'RequestedFile
-> m (Parsed CodeGeneratorRequest'RequestedFile)
parse Raw 'Const CodeGeneratorRequest'RequestedFile
raw_ = (Word64
-> Text
-> Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
-> Parsed CodeGeneratorRequest'RequestedFile
Parsed Word64
-> Parsed Text
-> Parsed (List CodeGeneratorRequest'RequestedFile'Import)
-> Parsed CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (Word64
 -> Text
 -> Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
 -> Parsed CodeGeneratorRequest'RequestedFile)
-> m Word64
-> m (Text
      -> Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
      -> Parsed CodeGeneratorRequest'RequestedFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot CodeGeneratorRequest'RequestedFile Word64
-> Raw 'Const CodeGeneratorRequest'RequestedFile -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel
  "id" (Field 'Slot CodeGeneratorRequest'RequestedFile Word64)
Field 'Slot CodeGeneratorRequest'RequestedFile Word64
#id Raw 'Const CodeGeneratorRequest'RequestedFile
raw_)
                                                     m (Text
   -> Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
   -> Parsed CodeGeneratorRequest'RequestedFile)
-> m Text
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
      -> Parsed CodeGeneratorRequest'RequestedFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CodeGeneratorRequest'RequestedFile Text
-> Raw 'Const CodeGeneratorRequest'RequestedFile -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel
  "filename" (Field 'Slot CodeGeneratorRequest'RequestedFile Text)
Field 'Slot CodeGeneratorRequest'RequestedFile Text
#filename Raw 'Const CodeGeneratorRequest'RequestedFile
raw_)
                                                     m (Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
   -> Parsed CodeGeneratorRequest'RequestedFile)
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile'Import))
-> m (Parsed CodeGeneratorRequest'RequestedFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field
  'Slot
  CodeGeneratorRequest'RequestedFile
  (List CodeGeneratorRequest'RequestedFile'Import)
-> Raw 'Const CodeGeneratorRequest'RequestedFile
-> m (Vector (Parsed CodeGeneratorRequest'RequestedFile'Import))
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
  "imports"
  (Field
     'Slot
     CodeGeneratorRequest'RequestedFile
     (List CodeGeneratorRequest'RequestedFile'Import))
Field
  'Slot
  CodeGeneratorRequest'RequestedFile
  (List CodeGeneratorRequest'RequestedFile'Import)
#imports Raw 'Const CodeGeneratorRequest'RequestedFile
raw_))
instance (C.Marshal CodeGeneratorRequest'RequestedFile (C.Parsed CodeGeneratorRequest'RequestedFile)) where
    marshalInto :: Raw ('Mut s) CodeGeneratorRequest'RequestedFile
-> Parsed CodeGeneratorRequest'RequestedFile -> m ()
marshalInto Raw ('Mut s) CodeGeneratorRequest'RequestedFile
raw_ CodeGeneratorRequest'RequestedFile{..} = (do
        (Field 'Slot CodeGeneratorRequest'RequestedFile Word64
-> Word64
-> Raw ('Mut s) CodeGeneratorRequest'RequestedFile
-> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel
  "id" (Field 'Slot CodeGeneratorRequest'RequestedFile Word64)
Field 'Slot CodeGeneratorRequest'RequestedFile Word64
#id Word64
Parsed Word64
id Raw ('Mut s) CodeGeneratorRequest'RequestedFile
raw_)
        (Field 'Slot CodeGeneratorRequest'RequestedFile Text
-> Text -> Raw ('Mut s) CodeGeneratorRequest'RequestedFile -> 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
  "filename" (Field 'Slot CodeGeneratorRequest'RequestedFile Text)
Field 'Slot CodeGeneratorRequest'RequestedFile Text
#filename Text
Parsed Text
filename Raw ('Mut s) CodeGeneratorRequest'RequestedFile
raw_)
        (Field
  'Slot
  CodeGeneratorRequest'RequestedFile
  (List CodeGeneratorRequest'RequestedFile'Import)
-> Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
-> Raw ('Mut s) CodeGeneratorRequest'RequestedFile
-> 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
  "imports"
  (Field
     'Slot
     CodeGeneratorRequest'RequestedFile
     (List CodeGeneratorRequest'RequestedFile'Import))
Field
  'Slot
  CodeGeneratorRequest'RequestedFile
  (List CodeGeneratorRequest'RequestedFile'Import)
#imports Vector (Parsed CodeGeneratorRequest'RequestedFile'Import)
Parsed (List CodeGeneratorRequest'RequestedFile'Import)
imports Raw ('Mut s) CodeGeneratorRequest'RequestedFile
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot CodeGeneratorRequest'RequestedFile Std_.Word64) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest'RequestedFile Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot CodeGeneratorRequest'RequestedFile Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "filename" GH.Slot CodeGeneratorRequest'RequestedFile Basics.Text) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest'RequestedFile Text
fieldByLabel  = (Word16 -> Field 'Slot CodeGeneratorRequest'RequestedFile Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)
instance (GH.HasField "imports" GH.Slot CodeGeneratorRequest'RequestedFile (R.List CodeGeneratorRequest'RequestedFile'Import)) where
    fieldByLabel :: Field
  'Slot
  CodeGeneratorRequest'RequestedFile
  (List CodeGeneratorRequest'RequestedFile'Import)
fieldByLabel  = (Word16
-> Field
     'Slot
     CodeGeneratorRequest'RequestedFile
     (List CodeGeneratorRequest'RequestedFile'Import)
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
1)
data CodeGeneratorRequest'RequestedFile'Import 
type instance (R.ReprFor CodeGeneratorRequest'RequestedFile'Import) = (R.Ptr (Std_.Just R.Struct))
instance (C.TypedStruct CodeGeneratorRequest'RequestedFile'Import) where
    numStructWords :: Word16
numStructWords  = Word16
1
    numStructPtrs :: Word16
numStructPtrs  = Word16
1
instance (C.Allocate CodeGeneratorRequest'RequestedFile'Import) where
    type AllocHint CodeGeneratorRequest'RequestedFile'Import = ()
    new :: AllocHint CodeGeneratorRequest'RequestedFile'Import
-> Message ('Mut s)
-> m (Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import)
new AllocHint CodeGeneratorRequest'RequestedFile'Import
_ = Message ('Mut s)
-> m (Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import)
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Message ('Mut s) -> m (Raw ('Mut s) a)
C.newTypedStruct
instance (C.EstimateAlloc CodeGeneratorRequest'RequestedFile'Import (C.Parsed CodeGeneratorRequest'RequestedFile'Import))
instance (C.AllocateList CodeGeneratorRequest'RequestedFile'Import) where
    type ListAllocHint CodeGeneratorRequest'RequestedFile'Import = Std_.Int
    newList :: ListAllocHint CodeGeneratorRequest'RequestedFile'Import
-> Message ('Mut s)
-> m (Raw
        ('Mut s) (List CodeGeneratorRequest'RequestedFile'Import))
newList  = ListAllocHint CodeGeneratorRequest'RequestedFile'Import
-> Message ('Mut s)
-> m (Raw
        ('Mut s) (List CodeGeneratorRequest'RequestedFile'Import))
forall a (m :: * -> *) s.
(TypedStruct a, RWCtx m s) =>
Int -> Message ('Mut s) -> m (Raw ('Mut s) (List a))
C.newTypedStructList
instance (C.EstimateListAlloc CodeGeneratorRequest'RequestedFile'Import (C.Parsed CodeGeneratorRequest'RequestedFile'Import))
data instance C.Parsed CodeGeneratorRequest'RequestedFile'Import
    = CodeGeneratorRequest'RequestedFile'Import 
        {Parsed CodeGeneratorRequest'RequestedFile'Import -> Parsed Word64
id :: (RP.Parsed Std_.Word64)
        ,Parsed CodeGeneratorRequest'RequestedFile'Import -> Parsed Text
name :: (RP.Parsed Basics.Text)}
    deriving((forall x.
 Parsed CodeGeneratorRequest'RequestedFile'Import
 -> Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x)
-> (forall x.
    Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x
    -> Parsed CodeGeneratorRequest'RequestedFile'Import)
-> Generic (Parsed CodeGeneratorRequest'RequestedFile'Import)
forall x.
Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x
-> Parsed CodeGeneratorRequest'RequestedFile'Import
forall x.
Parsed CodeGeneratorRequest'RequestedFile'Import
-> Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x
-> Parsed CodeGeneratorRequest'RequestedFile'Import
$cfrom :: forall x.
Parsed CodeGeneratorRequest'RequestedFile'Import
-> Rep (Parsed CodeGeneratorRequest'RequestedFile'Import) x
Generics.Generic)
deriving instance (Std_.Show (C.Parsed CodeGeneratorRequest'RequestedFile'Import))
deriving instance (Std_.Eq (C.Parsed CodeGeneratorRequest'RequestedFile'Import))
instance (C.Parse CodeGeneratorRequest'RequestedFile'Import (C.Parsed CodeGeneratorRequest'RequestedFile'Import)) where
    parse :: Raw 'Const CodeGeneratorRequest'RequestedFile'Import
-> m (Parsed CodeGeneratorRequest'RequestedFile'Import)
parse Raw 'Const CodeGeneratorRequest'RequestedFile'Import
raw_ = (Word64 -> Text -> Parsed CodeGeneratorRequest'RequestedFile'Import
Parsed Word64
-> Parsed Text -> Parsed CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import (Word64
 -> Text -> Parsed CodeGeneratorRequest'RequestedFile'Import)
-> m Word64
-> m (Text -> Parsed CodeGeneratorRequest'RequestedFile'Import)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
-> Raw 'Const CodeGeneratorRequest'RequestedFile'Import -> m Word64
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel
  "id" (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64)
Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
#id Raw 'Const CodeGeneratorRequest'RequestedFile'Import
raw_)
                                                            m (Text -> Parsed CodeGeneratorRequest'RequestedFile'Import)
-> m Text -> m (Parsed CodeGeneratorRequest'RequestedFile'Import)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
-> Raw 'Const CodeGeneratorRequest'RequestedFile'Import -> m Text
forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw 'Const a -> m bp
GH.parseField IsLabel
  "name" (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text)
Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
#name Raw 'Const CodeGeneratorRequest'RequestedFile'Import
raw_))
instance (C.Marshal CodeGeneratorRequest'RequestedFile'Import (C.Parsed CodeGeneratorRequest'RequestedFile'Import)) where
    marshalInto :: Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
-> Parsed CodeGeneratorRequest'RequestedFile'Import -> m ()
marshalInto Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
raw_ CodeGeneratorRequest'RequestedFile'Import{..} = (do
        (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
-> Word64
-> Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
-> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw ('Mut s) a -> m ()
GH.encodeField IsLabel
  "id" (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64)
Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
#id Word64
Parsed Word64
id Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
raw_)
        (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
-> Text
-> Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
-> 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
  "name" (Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text)
Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
#name Text
Parsed Text
name Raw ('Mut s) CodeGeneratorRequest'RequestedFile'Import
raw_)
        (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
        )
instance (GH.HasField "id" GH.Slot CodeGeneratorRequest'RequestedFile'Import Std_.Word64) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
fieldByLabel  = (BitCount
-> Word16
-> BitCount
-> Word64
-> Field 'Slot CodeGeneratorRequest'RequestedFile'Import Word64
forall b a (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
GH.dataField BitCount
0 Word16
0 BitCount
64 Word64
0)
instance (GH.HasField "name" GH.Slot CodeGeneratorRequest'RequestedFile'Import Basics.Text) where
    fieldByLabel :: Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
fieldByLabel  = (Word16
-> Field 'Slot CodeGeneratorRequest'RequestedFile'Import Text
forall a b. IsPtr b => Word16 -> Field 'Slot a b
GH.ptrField Word16
0)