{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{- |
Module: Capnp.Capnp.Schema
Description: Low-level generated module for capnp/schema.capnp
This module is the generated code for capnp/schema.capnp, for the
low-level api.
-}
module Capnp.Capnp.Schema where
-- Code generated by capnpc-haskell. DO NOT EDIT.
-- Generated from schema file: capnp/schema.capnp
import Data.Int
import Data.Word
import GHC.Generics (Generic)
import Data.Capnp.Bits (Word1)
import qualified Data.Bits
import qualified Data.Maybe
import qualified Data.Capnp.Classes as C'
import qualified Data.Capnp.Basics as B'
import qualified Data.Capnp.GenHelpers as H'
import qualified Data.Capnp.TraversalLimit as TL'
import qualified Data.Capnp.Untyped as U'
import qualified Data.Capnp.Message as M'
import qualified Capnp.ById.Xbdf87d7bb8304e81
newtype Annotation msg = Annotation_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Annotation msg) where
    fromStruct = pure . Annotation_newtype_
instance C'.ToStruct msg (Annotation msg) where
    toStruct (Annotation_newtype_ struct) = struct
instance C'.IsPtr msg (Annotation msg) where
    fromPtr msg ptr = Annotation_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Annotation_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Annotation msg) where
    newtype List msg (Annotation msg) = List_Annotation (U'.ListOf msg (U'.Struct msg))
    length (List_Annotation l) = U'.length l
    index i (List_Annotation l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Annotation msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Annotation (M'.MutMsg s)) where
    setIndex (Annotation_newtype_ elt) i (List_Annotation l) = U'.setIndex elt i l
    newList msg len = List_Annotation <$> U'.allocCompositeList msg 1 2 len
instance U'.HasMessage (Annotation msg) msg where
    message (Annotation_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Annotation msg) msg where
    messageDefault = Annotation_newtype_ . U'.messageDefault
instance C'.Allocate s (Annotation (M'.MutMsg s)) where
    new msg = Annotation_newtype_ <$> U'.allocStruct msg 1 2
instance C'.IsPtr msg (B'.List msg (Annotation msg)) where
    fromPtr msg ptr = List_Annotation <$> C'.fromPtr msg ptr
    toPtr (List_Annotation l) = C'.toPtr l
get_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Word64
get_Annotation'id (Annotation_newtype_ struct) = H'.getWordField struct 0 0 0
has_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Bool
has_Annotation'id(Annotation_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Annotation'id :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> Word64 -> m ()
set_Annotation'id (Annotation_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m (Value msg)
get_Annotation'value (Annotation_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m Bool
has_Annotation'value(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
set_Annotation'value (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
new_Annotation'value struct = do
    result <- C'.new (U'.message struct)
    set_Annotation'value struct result
    pure result
get_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m (Brand msg)
get_Annotation'brand (Annotation_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m Bool
has_Annotation'brand(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Annotation'brand (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Annotation'brand struct = do
    result <- C'.new (U'.message struct)
    set_Annotation'brand struct result
    pure result
newtype Brand msg = Brand_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Brand msg) where
    fromStruct = pure . Brand_newtype_
instance C'.ToStruct msg (Brand msg) where
    toStruct (Brand_newtype_ struct) = struct
instance C'.IsPtr msg (Brand msg) where
    fromPtr msg ptr = Brand_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Brand_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Brand msg) where
    newtype List msg (Brand msg) = List_Brand (U'.ListOf msg (U'.Struct msg))
    length (List_Brand l) = U'.length l
    index i (List_Brand l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Brand (M'.MutMsg s)) where
    setIndex (Brand_newtype_ elt) i (List_Brand l) = U'.setIndex elt i l
    newList msg len = List_Brand <$> U'.allocCompositeList msg 0 1 len
instance U'.HasMessage (Brand msg) msg where
    message (Brand_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Brand msg) msg where
    messageDefault = Brand_newtype_ . U'.messageDefault
instance C'.Allocate s (Brand (M'.MutMsg s)) where
    new msg = Brand_newtype_ <$> U'.allocStruct msg 0 1
instance C'.IsPtr msg (B'.List msg (Brand msg)) where
    fromPtr msg ptr = List_Brand <$> C'.fromPtr msg ptr
    toPtr (List_Brand l) = C'.toPtr l
get_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m (B'.List msg (Brand'Scope msg))
get_Brand'scopes (Brand_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m Bool
has_Brand'scopes(Brand_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Brand'scopes :: U'.RWCtx m s => Brand (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))) -> m ()
set_Brand'scopes (Brand_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Brand'scopes :: U'.RWCtx m s => Int -> Brand (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))))
new_Brand'scopes len struct = do
    result <- C'.newList (U'.message struct) len
    set_Brand'scopes struct result
    pure result
newtype CapnpVersion msg = CapnpVersion_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (CapnpVersion msg) where
    fromStruct = pure . CapnpVersion_newtype_
instance C'.ToStruct msg (CapnpVersion msg) where
    toStruct (CapnpVersion_newtype_ struct) = struct
instance C'.IsPtr msg (CapnpVersion msg) where
    fromPtr msg ptr = CapnpVersion_newtype_ <$> C'.fromPtr msg ptr
    toPtr (CapnpVersion_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (CapnpVersion msg) where
    newtype List msg (CapnpVersion msg) = List_CapnpVersion (U'.ListOf msg (U'.Struct msg))
    length (List_CapnpVersion l) = U'.length l
    index i (List_CapnpVersion l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapnpVersion msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (CapnpVersion (M'.MutMsg s)) where
    setIndex (CapnpVersion_newtype_ elt) i (List_CapnpVersion l) = U'.setIndex elt i l
    newList msg len = List_CapnpVersion <$> U'.allocCompositeList msg 1 0 len
instance U'.HasMessage (CapnpVersion msg) msg where
    message (CapnpVersion_newtype_ struct) = U'.message struct
instance U'.MessageDefault (CapnpVersion msg) msg where
    messageDefault = CapnpVersion_newtype_ . U'.messageDefault
instance C'.Allocate s (CapnpVersion (M'.MutMsg s)) where
    new msg = CapnpVersion_newtype_ <$> U'.allocStruct msg 1 0
instance C'.IsPtr msg (B'.List msg (CapnpVersion msg)) where
    fromPtr msg ptr = List_CapnpVersion <$> C'.fromPtr msg ptr
    toPtr (List_CapnpVersion l) = C'.toPtr l
get_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Word16
get_CapnpVersion'major (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 0 0
has_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool
has_CapnpVersion'major(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_CapnpVersion'major :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word16 -> m ()
set_CapnpVersion'major (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
get_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8
get_CapnpVersion'minor (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 16 0
has_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool
has_CapnpVersion'minor(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_CapnpVersion'minor :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m ()
set_CapnpVersion'minor (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
get_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8
get_CapnpVersion'micro (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 24 0
has_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool
has_CapnpVersion'micro(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_CapnpVersion'micro :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m ()
set_CapnpVersion'micro (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 24 0
newtype CodeGeneratorRequest msg = CodeGeneratorRequest_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (CodeGeneratorRequest msg) where
    fromStruct = pure . CodeGeneratorRequest_newtype_
instance C'.ToStruct msg (CodeGeneratorRequest msg) where
    toStruct (CodeGeneratorRequest_newtype_ struct) = struct
instance C'.IsPtr msg (CodeGeneratorRequest msg) where
    fromPtr msg ptr = CodeGeneratorRequest_newtype_ <$> C'.fromPtr msg ptr
    toPtr (CodeGeneratorRequest_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (CodeGeneratorRequest msg) where
    newtype List msg (CodeGeneratorRequest msg) = List_CodeGeneratorRequest (U'.ListOf msg (U'.Struct msg))
    length (List_CodeGeneratorRequest l) = U'.length l
    index i (List_CodeGeneratorRequest l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (CodeGeneratorRequest (M'.MutMsg s)) where
    setIndex (CodeGeneratorRequest_newtype_ elt) i (List_CodeGeneratorRequest l) = U'.setIndex elt i l
    newList msg len = List_CodeGeneratorRequest <$> U'.allocCompositeList msg 0 3 len
instance U'.HasMessage (CodeGeneratorRequest msg) msg where
    message (CodeGeneratorRequest_newtype_ struct) = U'.message struct
instance U'.MessageDefault (CodeGeneratorRequest msg) msg where
    messageDefault = CodeGeneratorRequest_newtype_ . U'.messageDefault
instance C'.Allocate s (CodeGeneratorRequest (M'.MutMsg s)) where
    new msg = CodeGeneratorRequest_newtype_ <$> U'.allocStruct msg 0 3
instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest msg)) where
    fromPtr msg ptr = List_CodeGeneratorRequest <$> C'.fromPtr msg ptr
    toPtr (List_CodeGeneratorRequest l) = C'.toPtr l
get_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (Node msg))
get_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'nodes(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_CodeGeneratorRequest'nodes :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node (M'.MutMsg s))) -> m ()
set_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_CodeGeneratorRequest'nodes :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node (M'.MutMsg s))))
new_CodeGeneratorRequest'nodes len struct = do
    result <- C'.newList (U'.message struct) len
    set_CodeGeneratorRequest'nodes struct result
    pure result
get_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile msg))
get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'requestedFiles(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))) -> m ()
set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))))
new_CodeGeneratorRequest'requestedFiles len struct = do
    result <- C'.newList (U'.message struct) len
    set_CodeGeneratorRequest'requestedFiles struct result
    pure result
get_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (CapnpVersion msg)
get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) =
    U'.getPtr 2 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'capnpVersion(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
set_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (CapnpVersion (M'.MutMsg s)) -> m ()
set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
new_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> m ((CapnpVersion (M'.MutMsg s)))
new_CodeGeneratorRequest'capnpVersion struct = do
    result <- C'.new (U'.message struct)
    set_CodeGeneratorRequest'capnpVersion struct result
    pure result
data ElementSize =
    ElementSize'empty |
    ElementSize'bit |
    ElementSize'byte |
    ElementSize'twoBytes |
    ElementSize'fourBytes |
    ElementSize'eightBytes |
    ElementSize'pointer |
    ElementSize'inlineComposite |
    ElementSize'unknown' Word16
    deriving(Show, Read, Eq, Generic)
instance Enum ElementSize where
    toEnum = C'.fromWord . fromIntegral
    fromEnum = fromIntegral . C'.toWord
instance C'.IsWord ElementSize where
    fromWord n = go (fromIntegral n :: Word16) where
        go 7 = ElementSize'inlineComposite
        go 6 = ElementSize'pointer
        go 5 = ElementSize'eightBytes
        go 4 = ElementSize'fourBytes
        go 3 = ElementSize'twoBytes
        go 2 = ElementSize'byte
        go 1 = ElementSize'bit
        go 0 = ElementSize'empty
        go tag = ElementSize'unknown' (fromIntegral tag)
    toWord ElementSize'inlineComposite = 7
    toWord ElementSize'pointer = 6
    toWord ElementSize'eightBytes = 5
    toWord ElementSize'fourBytes = 4
    toWord ElementSize'twoBytes = 3
    toWord ElementSize'byte = 2
    toWord ElementSize'bit = 1
    toWord ElementSize'empty = 0
    toWord (ElementSize'unknown' tag) = fromIntegral tag
instance B'.ListElem msg ElementSize where
    newtype List msg ElementSize = List_ElementSize (U'.ListOf msg Word16)
    length (List_ElementSize l) = U'.length l
    index i (List_ElementSize l) = (C'.fromWord . fromIntegral) <$> U'.index i l
instance B'.MutListElem s ElementSize where
    setIndex elt i (List_ElementSize l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l
    newList msg size = List_ElementSize <$> U'.allocList16 msg size
instance C'.IsPtr msg (B'.List msg ElementSize) where
    fromPtr msg ptr = List_ElementSize <$> C'.fromPtr msg ptr
    toPtr (List_ElementSize l) = C'.toPtr l
newtype Enumerant msg = Enumerant_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Enumerant msg) where
    fromStruct = pure . Enumerant_newtype_
instance C'.ToStruct msg (Enumerant msg) where
    toStruct (Enumerant_newtype_ struct) = struct
instance C'.IsPtr msg (Enumerant msg) where
    fromPtr msg ptr = Enumerant_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Enumerant_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Enumerant msg) where
    newtype List msg (Enumerant msg) = List_Enumerant (U'.ListOf msg (U'.Struct msg))
    length (List_Enumerant l) = U'.length l
    index i (List_Enumerant l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Enumerant msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Enumerant (M'.MutMsg s)) where
    setIndex (Enumerant_newtype_ elt) i (List_Enumerant l) = U'.setIndex elt i l
    newList msg len = List_Enumerant <$> U'.allocCompositeList msg 1 2 len
instance U'.HasMessage (Enumerant msg) msg where
    message (Enumerant_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Enumerant msg) msg where
    messageDefault = Enumerant_newtype_ . U'.messageDefault
instance C'.Allocate s (Enumerant (M'.MutMsg s)) where
    new msg = Enumerant_newtype_ <$> U'.allocStruct msg 1 2
instance C'.IsPtr msg (B'.List msg (Enumerant msg)) where
    fromPtr msg ptr = List_Enumerant <$> C'.fromPtr msg ptr
    toPtr (List_Enumerant l) = C'.toPtr l
get_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m (B'.Text msg)
get_Enumerant'name (Enumerant_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m Bool
has_Enumerant'name(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Enumerant'name :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Enumerant'name (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Enumerant'name :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Enumerant'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_Enumerant'name struct result
    pure result
get_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Word16
get_Enumerant'codeOrder (Enumerant_newtype_ struct) = H'.getWordField struct 0 0 0
has_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Bool
has_Enumerant'codeOrder(Enumerant_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Enumerant'codeOrder :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> Word16 -> m ()
set_Enumerant'codeOrder (Enumerant_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
get_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m (B'.List msg (Annotation msg))
get_Enumerant'annotations (Enumerant_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m Bool
has_Enumerant'annotations(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_Enumerant'annotations :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
set_Enumerant'annotations (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_Enumerant'annotations :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
new_Enumerant'annotations len struct = do
    result <- C'.newList (U'.message struct) len
    set_Enumerant'annotations struct result
    pure result
newtype Field msg = Field_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Field msg) where
    fromStruct = pure . Field_newtype_
instance C'.ToStruct msg (Field msg) where
    toStruct (Field_newtype_ struct) = struct
instance C'.IsPtr msg (Field msg) where
    fromPtr msg ptr = Field_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Field_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Field msg) where
    newtype List msg (Field msg) = List_Field (U'.ListOf msg (U'.Struct msg))
    length (List_Field l) = U'.length l
    index i (List_Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Field (M'.MutMsg s)) where
    setIndex (Field_newtype_ elt) i (List_Field l) = U'.setIndex elt i l
    newList msg len = List_Field <$> U'.allocCompositeList msg 3 4 len
instance U'.HasMessage (Field msg) msg where
    message (Field_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Field msg) msg where
    messageDefault = Field_newtype_ . U'.messageDefault
instance C'.Allocate s (Field (M'.MutMsg s)) where
    new msg = Field_newtype_ <$> U'.allocStruct msg 3 4
instance C'.IsPtr msg (B'.List msg (Field msg)) where
    fromPtr msg ptr = List_Field <$> C'.fromPtr msg ptr
    toPtr (List_Field l) = C'.toPtr l
get_Field'name :: U'.ReadCtx m msg => Field msg -> m (B'.Text msg)
get_Field'name (Field_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Field'name :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'name(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Field'name :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Field'name (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Field'name :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Field'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_Field'name struct result
    pure result
get_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Word16
get_Field'codeOrder (Field_newtype_ struct) = H'.getWordField struct 0 0 0
has_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'codeOrder(Field_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Field'codeOrder :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m ()
set_Field'codeOrder (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
get_Field'annotations :: U'.ReadCtx m msg => Field msg -> m (B'.List msg (Annotation msg))
get_Field'annotations (Field_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_Field'annotations :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'annotations(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_Field'annotations :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
set_Field'annotations (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_Field'annotations :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
new_Field'annotations len struct = do
    result <- C'.newList (U'.message struct) len
    set_Field'annotations struct result
    pure result
get_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Word16
get_Field'discriminantValue (Field_newtype_ struct) = H'.getWordField struct 0 16 65535
has_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'discriminantValue(Field_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Field'discriminantValue :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m ()
set_Field'discriminantValue (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 65535
get_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m (Field'ordinal msg)
get_Field'ordinal (Field_newtype_ struct) = C'.fromStruct struct
has_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'ordinal(Field_newtype_ struct) = pure True
get_Field'union' :: U'.ReadCtx m msg => Field msg -> m (Field' msg)
get_Field'union' (Field_newtype_ struct) = C'.fromStruct struct
has_Field'union' :: U'.ReadCtx m msg => Field msg -> m Bool
has_Field'union'(Field_newtype_ struct) = pure True
newtype Method msg = Method_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Method msg) where
    fromStruct = pure . Method_newtype_
instance C'.ToStruct msg (Method msg) where
    toStruct (Method_newtype_ struct) = struct
instance C'.IsPtr msg (Method msg) where
    fromPtr msg ptr = Method_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Method_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Method msg) where
    newtype List msg (Method msg) = List_Method (U'.ListOf msg (U'.Struct msg))
    length (List_Method l) = U'.length l
    index i (List_Method l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Method msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Method (M'.MutMsg s)) where
    setIndex (Method_newtype_ elt) i (List_Method l) = U'.setIndex elt i l
    newList msg len = List_Method <$> U'.allocCompositeList msg 3 5 len
instance U'.HasMessage (Method msg) msg where
    message (Method_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Method msg) msg where
    messageDefault = Method_newtype_ . U'.messageDefault
instance C'.Allocate s (Method (M'.MutMsg s)) where
    new msg = Method_newtype_ <$> U'.allocStruct msg 3 5
instance C'.IsPtr msg (B'.List msg (Method msg)) where
    fromPtr msg ptr = List_Method <$> C'.fromPtr msg ptr
    toPtr (List_Method l) = C'.toPtr l
get_Method'name :: U'.ReadCtx m msg => Method msg -> m (B'.Text msg)
get_Method'name (Method_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Method'name :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'name(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Method'name :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Method'name (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Method'name :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Method'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_Method'name struct result
    pure result
get_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Word16
get_Method'codeOrder (Method_newtype_ struct) = H'.getWordField struct 0 0 0
has_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'codeOrder(Method_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Method'codeOrder :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word16 -> m ()
set_Method'codeOrder (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
get_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Word64
get_Method'paramStructType (Method_newtype_ struct) = H'.getWordField struct 1 0 0
has_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'paramStructType(Method_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Method'paramStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m ()
set_Method'paramStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
get_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Word64
get_Method'resultStructType (Method_newtype_ struct) = H'.getWordField struct 2 0 0
has_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'resultStructType(Method_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct)
set_Method'resultStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m ()
set_Method'resultStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
get_Method'annotations :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Annotation msg))
get_Method'annotations (Method_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_Method'annotations :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'annotations(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_Method'annotations :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
set_Method'annotations (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_Method'annotations :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
new_Method'annotations len struct = do
    result <- C'.newList (U'.message struct) len
    set_Method'annotations struct result
    pure result
get_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg)
get_Method'paramBrand (Method_newtype_ struct) =
    U'.getPtr 2 struct
    >>= C'.fromPtr (U'.message struct)
has_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'paramBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
set_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Method'paramBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
new_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Method'paramBrand struct = do
    result <- C'.new (U'.message struct)
    set_Method'paramBrand struct result
    pure result
get_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg)
get_Method'resultBrand (Method_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'resultBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Method'resultBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Method'resultBrand struct = do
    result <- C'.new (U'.message struct)
    set_Method'resultBrand struct result
    pure result
get_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Node'Parameter msg))
get_Method'implicitParameters (Method_newtype_ struct) =
    U'.getPtr 4 struct
    >>= C'.fromPtr (U'.message struct)
has_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m Bool
has_Method'implicitParameters(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
set_Method'implicitParameters :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m ()
set_Method'implicitParameters (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
new_Method'implicitParameters :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))))
new_Method'implicitParameters len struct = do
    result <- C'.newList (U'.message struct) len
    set_Method'implicitParameters struct result
    pure result
newtype Node msg = Node_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node msg) where
    fromStruct = pure . Node_newtype_
instance C'.ToStruct msg (Node msg) where
    toStruct (Node_newtype_ struct) = struct
instance C'.IsPtr msg (Node msg) where
    fromPtr msg ptr = Node_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node msg) where
    newtype List msg (Node msg) = List_Node (U'.ListOf msg (U'.Struct msg))
    length (List_Node l) = U'.length l
    index i (List_Node l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node (M'.MutMsg s)) where
    setIndex (Node_newtype_ elt) i (List_Node l) = U'.setIndex elt i l
    newList msg len = List_Node <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node msg) msg where
    message (Node_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node msg) msg where
    messageDefault = Node_newtype_ . U'.messageDefault
instance C'.Allocate s (Node (M'.MutMsg s)) where
    new msg = Node_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node msg)) where
    fromPtr msg ptr = List_Node <$> C'.fromPtr msg ptr
    toPtr (List_Node l) = C'.toPtr l
get_Node'id :: U'.ReadCtx m msg => Node msg -> m Word64
get_Node'id (Node_newtype_ struct) = H'.getWordField struct 0 0 0
has_Node'id :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'id(Node_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Node'id :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m ()
set_Node'id (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_Node'displayName :: U'.ReadCtx m msg => Node msg -> m (B'.Text msg)
get_Node'displayName (Node_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'displayName :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'displayName(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Node'displayName :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Node'displayName (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Node'displayName :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Node'displayName len struct = do
    result <- B'.newText (U'.message struct) len
    set_Node'displayName struct result
    pure result
get_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Word32
get_Node'displayNamePrefixLength (Node_newtype_ struct) = H'.getWordField struct 1 0 0
has_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'displayNamePrefixLength(Node_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'displayNamePrefixLength :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word32 -> m ()
set_Node'displayNamePrefixLength (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 1 0 0
get_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Word64
get_Node'scopeId (Node_newtype_ struct) = H'.getWordField struct 2 0 0
has_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'scopeId(Node_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct)
set_Node'scopeId :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m ()
set_Node'scopeId (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
get_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'NestedNode msg))
get_Node'nestedNodes (Node_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'nestedNodes(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_Node'nestedNodes :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))) -> m ()
set_Node'nestedNodes (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_Node'nestedNodes :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))))
new_Node'nestedNodes len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'nestedNodes struct result
    pure result
get_Node'annotations :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Annotation msg))
get_Node'annotations (Node_newtype_ struct) =
    U'.getPtr 2 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'annotations :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'annotations(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
set_Node'annotations :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
set_Node'annotations (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
new_Node'annotations :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
new_Node'annotations len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'annotations struct result
    pure result
get_Node'parameters :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'Parameter msg))
get_Node'parameters (Node_newtype_ struct) =
    U'.getPtr 5 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'parameters :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'parameters(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 5 struct
set_Node'parameters :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m ()
set_Node'parameters (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 5 struct
new_Node'parameters :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))))
new_Node'parameters len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'parameters struct result
    pure result
get_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool
get_Node'isGeneric (Node_newtype_ struct) = H'.getWordField struct 4 32 0
has_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'isGeneric(Node_newtype_ struct) = pure $ 4 < U'.length (U'.dataSection struct)
set_Node'isGeneric :: U'.RWCtx m s => Node (M'.MutMsg s) -> Bool -> m ()
set_Node'isGeneric (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 4 32 0
get_Node'union' :: U'.ReadCtx m msg => Node msg -> m (Node' msg)
get_Node'union' (Node_newtype_ struct) = C'.fromStruct struct
has_Node'union' :: U'.ReadCtx m msg => Node msg -> m Bool
has_Node'union'(Node_newtype_ struct) = pure True
newtype Superclass msg = Superclass_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Superclass msg) where
    fromStruct = pure . Superclass_newtype_
instance C'.ToStruct msg (Superclass msg) where
    toStruct (Superclass_newtype_ struct) = struct
instance C'.IsPtr msg (Superclass msg) where
    fromPtr msg ptr = Superclass_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Superclass_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Superclass msg) where
    newtype List msg (Superclass msg) = List_Superclass (U'.ListOf msg (U'.Struct msg))
    length (List_Superclass l) = U'.length l
    index i (List_Superclass l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Superclass msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Superclass (M'.MutMsg s)) where
    setIndex (Superclass_newtype_ elt) i (List_Superclass l) = U'.setIndex elt i l
    newList msg len = List_Superclass <$> U'.allocCompositeList msg 1 1 len
instance U'.HasMessage (Superclass msg) msg where
    message (Superclass_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Superclass msg) msg where
    messageDefault = Superclass_newtype_ . U'.messageDefault
instance C'.Allocate s (Superclass (M'.MutMsg s)) where
    new msg = Superclass_newtype_ <$> U'.allocStruct msg 1 1
instance C'.IsPtr msg (B'.List msg (Superclass msg)) where
    fromPtr msg ptr = List_Superclass <$> C'.fromPtr msg ptr
    toPtr (List_Superclass l) = C'.toPtr l
get_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Word64
get_Superclass'id (Superclass_newtype_ struct) = H'.getWordField struct 0 0 0
has_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Bool
has_Superclass'id(Superclass_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Superclass'id :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> Word64 -> m ()
set_Superclass'id (Superclass_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m (Brand msg)
get_Superclass'brand (Superclass_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m Bool
has_Superclass'brand(Superclass_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Superclass'brand (Superclass_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Superclass'brand struct = do
    result <- C'.new (U'.message struct)
    set_Superclass'brand struct result
    pure result
newtype Type msg = Type_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type msg) where
    fromStruct = pure . Type_newtype_
instance C'.ToStruct msg (Type msg) where
    toStruct (Type_newtype_ struct) = struct
instance C'.IsPtr msg (Type msg) where
    fromPtr msg ptr = Type_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type msg) where
    newtype List msg (Type msg) = List_Type (U'.ListOf msg (U'.Struct msg))
    length (List_Type l) = U'.length l
    index i (List_Type l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type (M'.MutMsg s)) where
    setIndex (Type_newtype_ elt) i (List_Type l) = U'.setIndex elt i l
    newList msg len = List_Type <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type msg) msg where
    message (Type_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type msg) msg where
    messageDefault = Type_newtype_ . U'.messageDefault
instance C'.Allocate s (Type (M'.MutMsg s)) where
    new msg = Type_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type msg)) where
    fromPtr msg ptr = List_Type <$> C'.fromPtr msg ptr
    toPtr (List_Type l) = C'.toPtr l
data Type' msg =
    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 (Type'list'group' msg) |
    Type'enum (Type'enum'group' msg) |
    Type'struct (Type'struct'group' msg) |
    Type'interface (Type'interface'group' msg) |
    Type'anyPointer (Type'anyPointer'group' msg) |
    Type'unknown' Word16
get_Type' :: U'.ReadCtx m msg => Type msg -> m (Type' msg)
get_Type' (Type_newtype_ struct) = C'.fromStruct struct
has_Type' :: U'.ReadCtx m msg => Type msg -> m Bool
has_Type'(Type_newtype_ struct) = pure True
set_Type'void :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'void (Type_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
set_Type'bool :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'bool (Type_newtype_ struct) = H'.setWordField struct (1 :: Word16) 0 0 0
set_Type'int8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'int8 (Type_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 0 0
set_Type'int16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'int16 (Type_newtype_ struct) = H'.setWordField struct (3 :: Word16) 0 0 0
set_Type'int32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'int32 (Type_newtype_ struct) = H'.setWordField struct (4 :: Word16) 0 0 0
set_Type'int64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'int64 (Type_newtype_ struct) = H'.setWordField struct (5 :: Word16) 0 0 0
set_Type'uint8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'uint8 (Type_newtype_ struct) = H'.setWordField struct (6 :: Word16) 0 0 0
set_Type'uint16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'uint16 (Type_newtype_ struct) = H'.setWordField struct (7 :: Word16) 0 0 0
set_Type'uint32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'uint32 (Type_newtype_ struct) = H'.setWordField struct (8 :: Word16) 0 0 0
set_Type'uint64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'uint64 (Type_newtype_ struct) = H'.setWordField struct (9 :: Word16) 0 0 0
set_Type'float32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'float32 (Type_newtype_ struct) = H'.setWordField struct (10 :: Word16) 0 0 0
set_Type'float64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'float64 (Type_newtype_ struct) = H'.setWordField struct (11 :: Word16) 0 0 0
set_Type'text :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'text (Type_newtype_ struct) = H'.setWordField struct (12 :: Word16) 0 0 0
set_Type'data_ :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
set_Type'data_ (Type_newtype_ struct) = H'.setWordField struct (13 :: Word16) 0 0 0
set_Type'list :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'list'group' (M'.MutMsg s))
set_Type'list (Type_newtype_ struct) = do
    H'.setWordField struct (14 :: Word16) 0 0 0
    pure $ Type'list'group'_newtype_ struct
set_Type'enum :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'enum'group' (M'.MutMsg s))
set_Type'enum (Type_newtype_ struct) = do
    H'.setWordField struct (15 :: Word16) 0 0 0
    pure $ Type'enum'group'_newtype_ struct
set_Type'struct :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'struct'group' (M'.MutMsg s))
set_Type'struct (Type_newtype_ struct) = do
    H'.setWordField struct (16 :: Word16) 0 0 0
    pure $ Type'struct'group'_newtype_ struct
set_Type'interface :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'interface'group' (M'.MutMsg s))
set_Type'interface (Type_newtype_ struct) = do
    H'.setWordField struct (17 :: Word16) 0 0 0
    pure $ Type'interface'group'_newtype_ struct
set_Type'anyPointer :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'anyPointer'group' (M'.MutMsg s))
set_Type'anyPointer (Type_newtype_ struct) = do
    H'.setWordField struct (18 :: Word16) 0 0 0
    pure $ Type'anyPointer'group'_newtype_ struct
set_Type'unknown' :: U'.RWCtx m s => Type (M'.MutMsg s) -> Word16 -> m ()
set_Type'unknown'(Type_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
newtype Type'list'group' msg = Type'list'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'list'group' msg) where
    fromStruct = pure . Type'list'group'_newtype_
instance C'.ToStruct msg (Type'list'group' msg) where
    toStruct (Type'list'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'list'group' msg) where
    fromPtr msg ptr = Type'list'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'list'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'list'group' msg) where
    newtype List msg (Type'list'group' msg) = List_Type'list'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'list'group' l) = U'.length l
    index i (List_Type'list'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'list'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'list'group' (M'.MutMsg s)) where
    setIndex (Type'list'group'_newtype_ elt) i (List_Type'list'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'list'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'list'group' msg) msg where
    message (Type'list'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'list'group' msg) msg where
    messageDefault = Type'list'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'list'group' (M'.MutMsg s)) where
    new msg = Type'list'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'list'group' msg)) where
    fromPtr msg ptr = List_Type'list'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'list'group' l) = C'.toPtr l
get_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m (Type msg)
get_Type'list'elementType (Type'list'group'_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m Bool
has_Type'list'elementType(Type'list'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
set_Type'list'elementType (Type'list'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
new_Type'list'elementType struct = do
    result <- C'.new (U'.message struct)
    set_Type'list'elementType struct result
    pure result
newtype Type'enum'group' msg = Type'enum'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'enum'group' msg) where
    fromStruct = pure . Type'enum'group'_newtype_
instance C'.ToStruct msg (Type'enum'group' msg) where
    toStruct (Type'enum'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'enum'group' msg) where
    fromPtr msg ptr = Type'enum'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'enum'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'enum'group' msg) where
    newtype List msg (Type'enum'group' msg) = List_Type'enum'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'enum'group' l) = U'.length l
    index i (List_Type'enum'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'enum'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'enum'group' (M'.MutMsg s)) where
    setIndex (Type'enum'group'_newtype_ elt) i (List_Type'enum'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'enum'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'enum'group' msg) msg where
    message (Type'enum'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'enum'group' msg) msg where
    messageDefault = Type'enum'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'enum'group' (M'.MutMsg s)) where
    new msg = Type'enum'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'enum'group' msg)) where
    fromPtr msg ptr = List_Type'enum'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'enum'group' l) = C'.toPtr l
get_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Word64
get_Type'enum'typeId (Type'enum'group'_newtype_ struct) = H'.getWordField struct 1 0 0
has_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool
has_Type'enum'typeId(Type'enum'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Type'enum'typeId :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> Word64 -> m ()
set_Type'enum'typeId (Type'enum'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
get_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m (Brand msg)
get_Type'enum'brand (Type'enum'group'_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool
has_Type'enum'brand(Type'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Type'enum'brand (Type'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Type'enum'brand struct = do
    result <- C'.new (U'.message struct)
    set_Type'enum'brand struct result
    pure result
newtype Type'struct'group' msg = Type'struct'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'struct'group' msg) where
    fromStruct = pure . Type'struct'group'_newtype_
instance C'.ToStruct msg (Type'struct'group' msg) where
    toStruct (Type'struct'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'struct'group' msg) where
    fromPtr msg ptr = Type'struct'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'struct'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'struct'group' msg) where
    newtype List msg (Type'struct'group' msg) = List_Type'struct'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'struct'group' l) = U'.length l
    index i (List_Type'struct'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'struct'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'struct'group' (M'.MutMsg s)) where
    setIndex (Type'struct'group'_newtype_ elt) i (List_Type'struct'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'struct'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'struct'group' msg) msg where
    message (Type'struct'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'struct'group' msg) msg where
    messageDefault = Type'struct'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'struct'group' (M'.MutMsg s)) where
    new msg = Type'struct'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'struct'group' msg)) where
    fromPtr msg ptr = List_Type'struct'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'struct'group' l) = C'.toPtr l
get_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Word64
get_Type'struct'typeId (Type'struct'group'_newtype_ struct) = H'.getWordField struct 1 0 0
has_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool
has_Type'struct'typeId(Type'struct'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Type'struct'typeId :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> Word64 -> m ()
set_Type'struct'typeId (Type'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
get_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m (Brand msg)
get_Type'struct'brand (Type'struct'group'_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool
has_Type'struct'brand(Type'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Type'struct'brand (Type'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Type'struct'brand struct = do
    result <- C'.new (U'.message struct)
    set_Type'struct'brand struct result
    pure result
newtype Type'interface'group' msg = Type'interface'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'interface'group' msg) where
    fromStruct = pure . Type'interface'group'_newtype_
instance C'.ToStruct msg (Type'interface'group' msg) where
    toStruct (Type'interface'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'interface'group' msg) where
    fromPtr msg ptr = Type'interface'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'interface'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'interface'group' msg) where
    newtype List msg (Type'interface'group' msg) = List_Type'interface'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'interface'group' l) = U'.length l
    index i (List_Type'interface'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'interface'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'interface'group' (M'.MutMsg s)) where
    setIndex (Type'interface'group'_newtype_ elt) i (List_Type'interface'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'interface'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'interface'group' msg) msg where
    message (Type'interface'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'interface'group' msg) msg where
    messageDefault = Type'interface'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'interface'group' (M'.MutMsg s)) where
    new msg = Type'interface'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'interface'group' msg)) where
    fromPtr msg ptr = List_Type'interface'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'interface'group' l) = C'.toPtr l
get_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Word64
get_Type'interface'typeId (Type'interface'group'_newtype_ struct) = H'.getWordField struct 1 0 0
has_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool
has_Type'interface'typeId(Type'interface'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Type'interface'typeId :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> Word64 -> m ()
set_Type'interface'typeId (Type'interface'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
get_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m (Brand msg)
get_Type'interface'brand (Type'interface'group'_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool
has_Type'interface'brand(Type'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
set_Type'interface'brand (Type'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
new_Type'interface'brand struct = do
    result <- C'.new (U'.message struct)
    set_Type'interface'brand struct result
    pure result
newtype Type'anyPointer'group' msg = Type'anyPointer'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer'group' msg) where
    fromStruct = pure . Type'anyPointer'group'_newtype_
instance C'.ToStruct msg (Type'anyPointer'group' msg) where
    toStruct (Type'anyPointer'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer'group' msg) where
    fromPtr msg ptr = Type'anyPointer'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer'group' msg) where
    newtype List msg (Type'anyPointer'group' msg) = List_Type'anyPointer'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer'group' l) = U'.length l
    index i (List_Type'anyPointer'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer'group' (M'.MutMsg s)) where
    setIndex (Type'anyPointer'group'_newtype_ elt) i (List_Type'anyPointer'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer'group' msg) msg where
    message (Type'anyPointer'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer'group' msg) msg where
    messageDefault = Type'anyPointer'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer'group' (M'.MutMsg s)) where
    new msg = Type'anyPointer'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer'group' msg)) where
    fromPtr msg ptr = List_Type'anyPointer'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer'group' l) = C'.toPtr l
get_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m (Type'anyPointer msg)
get_Type'anyPointer'union' (Type'anyPointer'group'_newtype_ struct) = C'.fromStruct struct
has_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m Bool
has_Type'anyPointer'union'(Type'anyPointer'group'_newtype_ struct) = pure True
instance C'.FromStruct msg (Type' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 0 0 0
        case tag of
            18 -> Type'anyPointer <$> C'.fromStruct struct
            17 -> Type'interface <$> C'.fromStruct struct
            16 -> Type'struct <$> C'.fromStruct struct
            15 -> Type'enum <$> C'.fromStruct struct
            14 -> Type'list <$> C'.fromStruct struct
            13 -> pure Type'data_
            12 -> pure Type'text
            11 -> pure Type'float64
            10 -> pure Type'float32
            9 -> pure Type'uint64
            8 -> pure Type'uint32
            7 -> pure Type'uint16
            6 -> pure Type'uint8
            5 -> pure Type'int64
            4 -> pure Type'int32
            3 -> pure Type'int16
            2 -> pure Type'int8
            1 -> pure Type'bool
            0 -> pure Type'void
            _ -> pure $ Type'unknown' tag
newtype Value msg = Value_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Value msg) where
    fromStruct = pure . Value_newtype_
instance C'.ToStruct msg (Value msg) where
    toStruct (Value_newtype_ struct) = struct
instance C'.IsPtr msg (Value msg) where
    fromPtr msg ptr = Value_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Value_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Value msg) where
    newtype List msg (Value msg) = List_Value (U'.ListOf msg (U'.Struct msg))
    length (List_Value l) = U'.length l
    index i (List_Value l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Value msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Value (M'.MutMsg s)) where
    setIndex (Value_newtype_ elt) i (List_Value l) = U'.setIndex elt i l
    newList msg len = List_Value <$> U'.allocCompositeList msg 2 1 len
instance U'.HasMessage (Value msg) msg where
    message (Value_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Value msg) msg where
    messageDefault = Value_newtype_ . U'.messageDefault
instance C'.Allocate s (Value (M'.MutMsg s)) where
    new msg = Value_newtype_ <$> U'.allocStruct msg 2 1
instance C'.IsPtr msg (B'.List msg (Value msg)) where
    fromPtr msg ptr = List_Value <$> C'.fromPtr msg ptr
    toPtr (List_Value l) = C'.toPtr l
data Value' msg =
    Value'void |
    Value'bool Bool |
    Value'int8 Int8 |
    Value'int16 Int16 |
    Value'int32 Int32 |
    Value'int64 Int64 |
    Value'uint8 Word8 |
    Value'uint16 Word16 |
    Value'uint32 Word32 |
    Value'uint64 Word64 |
    Value'float32 Float |
    Value'float64 Double |
    Value'text (B'.Text msg) |
    Value'data_ (B'.Data msg) |
    Value'list (Maybe (U'.Ptr msg)) |
    Value'enum Word16 |
    Value'struct (Maybe (U'.Ptr msg)) |
    Value'interface |
    Value'anyPointer (Maybe (U'.Ptr msg)) |
    Value'unknown' Word16
get_Value' :: U'.ReadCtx m msg => Value msg -> m (Value' msg)
get_Value' (Value_newtype_ struct) = C'.fromStruct struct
has_Value' :: U'.ReadCtx m msg => Value msg -> m Bool
has_Value'(Value_newtype_ struct) = pure True
set_Value'void :: U'.RWCtx m s => Value (M'.MutMsg s) -> m ()
set_Value'void (Value_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
set_Value'bool :: U'.RWCtx m s => Value (M'.MutMsg s) -> Bool -> m ()
set_Value'bool (Value_newtype_ struct) value = do
    H'.setWordField struct (1 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 16 0
set_Value'int8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int8 -> m ()
set_Value'int8 (Value_newtype_ struct) value = do
    H'.setWordField struct (2 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
set_Value'int16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int16 -> m ()
set_Value'int16 (Value_newtype_ struct) value = do
    H'.setWordField struct (3 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
set_Value'int32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int32 -> m ()
set_Value'int32 (Value_newtype_ struct) value = do
    H'.setWordField struct (4 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
set_Value'int64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int64 -> m ()
set_Value'int64 (Value_newtype_ struct) value = do
    H'.setWordField struct (5 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
set_Value'uint8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word8 -> m ()
set_Value'uint8 (Value_newtype_ struct) value = do
    H'.setWordField struct (6 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
set_Value'uint16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
set_Value'uint16 (Value_newtype_ struct) value = do
    H'.setWordField struct (7 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
set_Value'uint32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word32 -> m ()
set_Value'uint32 (Value_newtype_ struct) value = do
    H'.setWordField struct (8 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
set_Value'uint64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word64 -> m ()
set_Value'uint64 (Value_newtype_ struct) value = do
    H'.setWordField struct (9 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
set_Value'float32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Float -> m ()
set_Value'float32 (Value_newtype_ struct) value = do
    H'.setWordField struct (10 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
set_Value'float64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Double -> m ()
set_Value'float64 (Value_newtype_ struct) value = do
    H'.setWordField struct (11 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
set_Value'text :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Value'text(Value_newtype_ struct) value = do
    H'.setWordField struct (12 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
new_Value'text :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Value'text len struct = do
    result <- B'.newText (U'.message struct) len
    set_Value'text struct result
    pure result
set_Value'data_ :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Data (M'.MutMsg s)) -> m ()
set_Value'data_(Value_newtype_ struct) value = do
    H'.setWordField struct (13 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
new_Value'data_ :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Data (M'.MutMsg s)))
new_Value'data_ len struct = do
    result <- B'.newData (U'.message struct) len
    set_Value'data_ struct result
    pure result
set_Value'list :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
set_Value'list(Value_newtype_ struct) value = do
    H'.setWordField struct (14 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
set_Value'enum :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
set_Value'enum (Value_newtype_ struct) value = do
    H'.setWordField struct (15 :: Word16) 0 0 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
set_Value'struct :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
set_Value'struct(Value_newtype_ struct) value = do
    H'.setWordField struct (16 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
set_Value'interface :: U'.RWCtx m s => Value (M'.MutMsg s) -> m ()
set_Value'interface (Value_newtype_ struct) = H'.setWordField struct (17 :: Word16) 0 0 0
set_Value'anyPointer :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
set_Value'anyPointer(Value_newtype_ struct) value = do
    H'.setWordField struct (18 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
set_Value'unknown' :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
set_Value'unknown'(Value_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
instance C'.FromStruct msg (Value' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 0 0 0
        case tag of
            18 -> Value'anyPointer <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            17 -> pure Value'interface
            16 -> Value'struct <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            15 -> Value'enum <$>  H'.getWordField struct 0 16 0
            14 -> Value'list <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            13 -> Value'data_ <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            12 -> Value'text <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            11 -> Value'float64 <$>  H'.getWordField struct 1 0 0
            10 -> Value'float32 <$>  H'.getWordField struct 0 32 0
            9 -> Value'uint64 <$>  H'.getWordField struct 1 0 0
            8 -> Value'uint32 <$>  H'.getWordField struct 0 32 0
            7 -> Value'uint16 <$>  H'.getWordField struct 0 16 0
            6 -> Value'uint8 <$>  H'.getWordField struct 0 16 0
            5 -> Value'int64 <$>  H'.getWordField struct 1 0 0
            4 -> Value'int32 <$>  H'.getWordField struct 0 32 0
            3 -> Value'int16 <$>  H'.getWordField struct 0 16 0
            2 -> Value'int8 <$>  H'.getWordField struct 0 16 0
            1 -> Value'bool <$>  H'.getWordField struct 0 16 0
            0 -> pure Value'void
            _ -> pure $ Value'unknown' tag
newtype Brand'Binding msg = Brand'Binding_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Brand'Binding msg) where
    fromStruct = pure . Brand'Binding_newtype_
instance C'.ToStruct msg (Brand'Binding msg) where
    toStruct (Brand'Binding_newtype_ struct) = struct
instance C'.IsPtr msg (Brand'Binding msg) where
    fromPtr msg ptr = Brand'Binding_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Brand'Binding_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Brand'Binding msg) where
    newtype List msg (Brand'Binding msg) = List_Brand'Binding (U'.ListOf msg (U'.Struct msg))
    length (List_Brand'Binding l) = U'.length l
    index i (List_Brand'Binding l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Binding msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Brand'Binding (M'.MutMsg s)) where
    setIndex (Brand'Binding_newtype_ elt) i (List_Brand'Binding l) = U'.setIndex elt i l
    newList msg len = List_Brand'Binding <$> U'.allocCompositeList msg 1 1 len
instance U'.HasMessage (Brand'Binding msg) msg where
    message (Brand'Binding_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Brand'Binding msg) msg where
    messageDefault = Brand'Binding_newtype_ . U'.messageDefault
instance C'.Allocate s (Brand'Binding (M'.MutMsg s)) where
    new msg = Brand'Binding_newtype_ <$> U'.allocStruct msg 1 1
instance C'.IsPtr msg (B'.List msg (Brand'Binding msg)) where
    fromPtr msg ptr = List_Brand'Binding <$> C'.fromPtr msg ptr
    toPtr (List_Brand'Binding l) = C'.toPtr l
data Brand'Binding' msg =
    Brand'Binding'unbound |
    Brand'Binding'type_ (Type msg) |
    Brand'Binding'unknown' Word16
get_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m (Brand'Binding' msg)
get_Brand'Binding' (Brand'Binding_newtype_ struct) = C'.fromStruct struct
has_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m Bool
has_Brand'Binding'(Brand'Binding_newtype_ struct) = pure True
set_Brand'Binding'unbound :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ()
set_Brand'Binding'unbound (Brand'Binding_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
set_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
set_Brand'Binding'type_(Brand'Binding_newtype_ struct) value = do
    H'.setWordField struct (1 :: Word16) 0 0 0
    U'.setPtr (C'.toPtr value) 0 struct
new_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
new_Brand'Binding'type_ struct = do
    result <- C'.new (U'.message struct)
    set_Brand'Binding'type_ struct result
    pure result
set_Brand'Binding'unknown' :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> Word16 -> m ()
set_Brand'Binding'unknown'(Brand'Binding_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
instance C'.FromStruct msg (Brand'Binding' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 0 0 0
        case tag of
            1 -> Brand'Binding'type_ <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            0 -> pure Brand'Binding'unbound
            _ -> pure $ Brand'Binding'unknown' tag
newtype Brand'Scope msg = Brand'Scope_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Brand'Scope msg) where
    fromStruct = pure . Brand'Scope_newtype_
instance C'.ToStruct msg (Brand'Scope msg) where
    toStruct (Brand'Scope_newtype_ struct) = struct
instance C'.IsPtr msg (Brand'Scope msg) where
    fromPtr msg ptr = Brand'Scope_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Brand'Scope_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Brand'Scope msg) where
    newtype List msg (Brand'Scope msg) = List_Brand'Scope (U'.ListOf msg (U'.Struct msg))
    length (List_Brand'Scope l) = U'.length l
    index i (List_Brand'Scope l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Brand'Scope (M'.MutMsg s)) where
    setIndex (Brand'Scope_newtype_ elt) i (List_Brand'Scope l) = U'.setIndex elt i l
    newList msg len = List_Brand'Scope <$> U'.allocCompositeList msg 2 1 len
instance U'.HasMessage (Brand'Scope msg) msg where
    message (Brand'Scope_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Brand'Scope msg) msg where
    messageDefault = Brand'Scope_newtype_ . U'.messageDefault
instance C'.Allocate s (Brand'Scope (M'.MutMsg s)) where
    new msg = Brand'Scope_newtype_ <$> U'.allocStruct msg 2 1
instance C'.IsPtr msg (B'.List msg (Brand'Scope msg)) where
    fromPtr msg ptr = List_Brand'Scope <$> C'.fromPtr msg ptr
    toPtr (List_Brand'Scope l) = C'.toPtr l
get_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Word64
get_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) = H'.getWordField struct 0 0 0
has_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Bool
has_Brand'Scope'scopeId(Brand'Scope_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Brand'Scope'scopeId :: U'.RWCtx m s => Brand'Scope (M'.MutMsg s) -> Word64 -> m ()
set_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m (Brand'Scope' msg)
get_Brand'Scope'union' (Brand'Scope_newtype_ struct) = C'.fromStruct struct
has_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m Bool
has_Brand'Scope'union'(Brand'Scope_newtype_ struct) = pure True
newtype Brand'Scope' msg = Brand'Scope'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Brand'Scope' msg) where
    fromStruct = pure . Brand'Scope'_newtype_
instance C'.ToStruct msg (Brand'Scope' msg) where
    toStruct (Brand'Scope'_newtype_ struct) = struct
instance C'.IsPtr msg (Brand'Scope' msg) where
    fromPtr msg ptr = Brand'Scope'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Brand'Scope'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Brand'Scope' msg) where
    newtype List msg (Brand'Scope' msg) = List_Brand'Scope' (U'.ListOf msg (U'.Struct msg))
    length (List_Brand'Scope' l) = U'.length l
    index i (List_Brand'Scope' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Brand'Scope' (M'.MutMsg s)) where
    setIndex (Brand'Scope'_newtype_ elt) i (List_Brand'Scope' l) = U'.setIndex elt i l
    newList msg len = List_Brand'Scope' <$> U'.allocCompositeList msg 2 1 len
instance U'.HasMessage (Brand'Scope' msg) msg where
    message (Brand'Scope'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Brand'Scope' msg) msg where
    messageDefault = Brand'Scope'_newtype_ . U'.messageDefault
instance C'.Allocate s (Brand'Scope' (M'.MutMsg s)) where
    new msg = Brand'Scope'_newtype_ <$> U'.allocStruct msg 2 1
instance C'.IsPtr msg (B'.List msg (Brand'Scope' msg)) where
    fromPtr msg ptr = List_Brand'Scope' <$> C'.fromPtr msg ptr
    toPtr (List_Brand'Scope' l) = C'.toPtr l
data Brand'Scope'' msg =
    Brand'Scope'bind (B'.List msg (Brand'Binding msg)) |
    Brand'Scope'inherit |
    Brand'Scope'unknown' Word16
get_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m (Brand'Scope'' msg)
get_Brand'Scope'' (Brand'Scope'_newtype_ struct) = C'.fromStruct struct
has_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m Bool
has_Brand'Scope''(Brand'Scope'_newtype_ struct) = pure True
set_Brand'Scope'bind :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))) -> m ()
set_Brand'Scope'bind(Brand'Scope'_newtype_ struct) value = do
    H'.setWordField struct (0 :: Word16) 1 0 0
    U'.setPtr (C'.toPtr value) 0 struct
new_Brand'Scope'bind :: U'.RWCtx m s => Int -> Brand'Scope' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))))
new_Brand'Scope'bind len struct = do
    result <- C'.newList (U'.message struct) len
    set_Brand'Scope'bind struct result
    pure result
set_Brand'Scope'inherit :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> m ()
set_Brand'Scope'inherit (Brand'Scope'_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 0 0
set_Brand'Scope'unknown' :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> Word16 -> m ()
set_Brand'Scope'unknown'(Brand'Scope'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
instance C'.FromStruct msg (Brand'Scope'' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 0 0
        case tag of
            1 -> pure Brand'Scope'inherit
            0 -> Brand'Scope'bind <$>  (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
            _ -> pure $ Brand'Scope'unknown' tag
newtype CodeGeneratorRequest'RequestedFile msg = CodeGeneratorRequest'RequestedFile_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile msg) where
    fromStruct = pure . CodeGeneratorRequest'RequestedFile_newtype_
instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile msg) where
    toStruct (CodeGeneratorRequest'RequestedFile_newtype_ struct) = struct
instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile msg) where
    fromPtr msg ptr = CodeGeneratorRequest'RequestedFile_newtype_ <$> C'.fromPtr msg ptr
    toPtr (CodeGeneratorRequest'RequestedFile_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile msg) where
    newtype List msg (CodeGeneratorRequest'RequestedFile msg) = List_CodeGeneratorRequest'RequestedFile (U'.ListOf msg (U'.Struct msg))
    length (List_CodeGeneratorRequest'RequestedFile l) = U'.length l
    index i (List_CodeGeneratorRequest'RequestedFile l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where
    setIndex (CodeGeneratorRequest'RequestedFile_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile l) = U'.setIndex elt i l
    newList msg len = List_CodeGeneratorRequest'RequestedFile <$> U'.allocCompositeList msg 1 2 len
instance U'.HasMessage (CodeGeneratorRequest'RequestedFile msg) msg where
    message (CodeGeneratorRequest'RequestedFile_newtype_ struct) = U'.message struct
instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile msg) msg where
    messageDefault = CodeGeneratorRequest'RequestedFile_newtype_ . U'.messageDefault
instance C'.Allocate s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where
    new msg = CodeGeneratorRequest'RequestedFile_newtype_ <$> U'.allocStruct msg 1 2
instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) where
    fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile <$> C'.fromPtr msg ptr
    toPtr (List_CodeGeneratorRequest'RequestedFile l) = C'.toPtr l
get_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Word64
get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) = H'.getWordField struct 0 0 0
has_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'id(CodeGeneratorRequest'RequestedFile_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_CodeGeneratorRequest'RequestedFile'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> Word64 -> m ()
set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.Text msg)
get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'filename(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_CodeGeneratorRequest'RequestedFile'filename len struct = do
    result <- B'.newText (U'.message struct) len
    set_CodeGeneratorRequest'RequestedFile'filename struct result
    pure result
get_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg))
get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) =
    U'.getPtr 1 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'imports(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
set_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))) -> m ()
set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
new_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))))
new_CodeGeneratorRequest'RequestedFile'imports len struct = do
    result <- C'.newList (U'.message struct) len
    set_CodeGeneratorRequest'RequestedFile'imports struct result
    pure result
newtype CodeGeneratorRequest'RequestedFile'Import msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where
    fromStruct = pure . CodeGeneratorRequest'RequestedFile'Import_newtype_
instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where
    toStruct (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = struct
instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile'Import msg) where
    fromPtr msg ptr = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> C'.fromPtr msg ptr
    toPtr (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg) where
    newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg) = List_CodeGeneratorRequest'RequestedFile'Import (U'.ListOf msg (U'.Struct msg))
    length (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.length l
    index i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where
    setIndex (CodeGeneratorRequest'RequestedFile'Import_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.setIndex elt i l
    newList msg len = List_CodeGeneratorRequest'RequestedFile'Import <$> U'.allocCompositeList msg 1 1 len
instance U'.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg) msg where
    message (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = U'.message struct
instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg) msg where
    messageDefault = CodeGeneratorRequest'RequestedFile'Import_newtype_ . U'.messageDefault
instance C'.Allocate s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where
    new msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> U'.allocStruct msg 1 1
instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
    fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile'Import <$> C'.fromPtr msg ptr
    toPtr (List_CodeGeneratorRequest'RequestedFile'Import l) = C'.toPtr l
get_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Word64
get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = H'.getWordField struct 0 0 0
has_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'Import'id(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_CodeGeneratorRequest'RequestedFile'Import'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> Word64 -> m ()
set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
get_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m (B'.Text msg)
get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'Import'name(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_CodeGeneratorRequest'RequestedFile'Import'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_CodeGeneratorRequest'RequestedFile'Import'name struct result
    pure result
newtype Field' msg = Field'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Field' msg) where
    fromStruct = pure . Field'_newtype_
instance C'.ToStruct msg (Field' msg) where
    toStruct (Field'_newtype_ struct) = struct
instance C'.IsPtr msg (Field' msg) where
    fromPtr msg ptr = Field'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Field'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Field' msg) where
    newtype List msg (Field' msg) = List_Field' (U'.ListOf msg (U'.Struct msg))
    length (List_Field' l) = U'.length l
    index i (List_Field' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Field' (M'.MutMsg s)) where
    setIndex (Field'_newtype_ elt) i (List_Field' l) = U'.setIndex elt i l
    newList msg len = List_Field' <$> U'.allocCompositeList msg 3 4 len
instance U'.HasMessage (Field' msg) msg where
    message (Field'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Field' msg) msg where
    messageDefault = Field'_newtype_ . U'.messageDefault
instance C'.Allocate s (Field' (M'.MutMsg s)) where
    new msg = Field'_newtype_ <$> U'.allocStruct msg 3 4
instance C'.IsPtr msg (B'.List msg (Field' msg)) where
    fromPtr msg ptr = List_Field' <$> C'.fromPtr msg ptr
    toPtr (List_Field' l) = C'.toPtr l
data Field'' msg =
    Field'slot (Field'slot'group' msg) |
    Field'group (Field'group'group' msg) |
    Field'unknown' Word16
get_Field'' :: U'.ReadCtx m msg => Field' msg -> m (Field'' msg)
get_Field'' (Field'_newtype_ struct) = C'.fromStruct struct
has_Field'' :: U'.ReadCtx m msg => Field' msg -> m Bool
has_Field''(Field'_newtype_ struct) = pure True
set_Field'slot :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'slot'group' (M'.MutMsg s))
set_Field'slot (Field'_newtype_ struct) = do
    H'.setWordField struct (0 :: Word16) 1 0 0
    pure $ Field'slot'group'_newtype_ struct
set_Field'group :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'group'group' (M'.MutMsg s))
set_Field'group (Field'_newtype_ struct) = do
    H'.setWordField struct (1 :: Word16) 1 0 0
    pure $ Field'group'group'_newtype_ struct
set_Field'unknown' :: U'.RWCtx m s => Field' (M'.MutMsg s) -> Word16 -> m ()
set_Field'unknown'(Field'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
newtype Field'slot'group' msg = Field'slot'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Field'slot'group' msg) where
    fromStruct = pure . Field'slot'group'_newtype_
instance C'.ToStruct msg (Field'slot'group' msg) where
    toStruct (Field'slot'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Field'slot'group' msg) where
    fromPtr msg ptr = Field'slot'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Field'slot'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Field'slot'group' msg) where
    newtype List msg (Field'slot'group' msg) = List_Field'slot'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Field'slot'group' l) = U'.length l
    index i (List_Field'slot'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'slot'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Field'slot'group' (M'.MutMsg s)) where
    setIndex (Field'slot'group'_newtype_ elt) i (List_Field'slot'group' l) = U'.setIndex elt i l
    newList msg len = List_Field'slot'group' <$> U'.allocCompositeList msg 3 4 len
instance U'.HasMessage (Field'slot'group' msg) msg where
    message (Field'slot'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Field'slot'group' msg) msg where
    messageDefault = Field'slot'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Field'slot'group' (M'.MutMsg s)) where
    new msg = Field'slot'group'_newtype_ <$> U'.allocStruct msg 3 4
instance C'.IsPtr msg (B'.List msg (Field'slot'group' msg)) where
    fromPtr msg ptr = List_Field'slot'group' <$> C'.fromPtr msg ptr
    toPtr (List_Field'slot'group' l) = C'.toPtr l
get_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Word32
get_Field'slot'offset (Field'slot'group'_newtype_ struct) = H'.getWordField struct 0 32 0
has_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
has_Field'slot'offset(Field'slot'group'_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Field'slot'offset :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Word32 -> m ()
set_Field'slot'offset (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
get_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Type msg)
get_Field'slot'type_ (Field'slot'group'_newtype_ struct) =
    U'.getPtr 2 struct
    >>= C'.fromPtr (U'.message struct)
has_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
has_Field'slot'type_(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
set_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
set_Field'slot'type_ (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
new_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
new_Field'slot'type_ struct = do
    result <- C'.new (U'.message struct)
    set_Field'slot'type_ struct result
    pure result
get_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Value msg)
get_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
has_Field'slot'defaultValue(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
set_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
new_Field'slot'defaultValue struct = do
    result <- C'.new (U'.message struct)
    set_Field'slot'defaultValue struct result
    pure result
get_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
get_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) = H'.getWordField struct 2 0 0
has_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
has_Field'slot'hadExplicitDefault(Field'slot'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct)
set_Field'slot'hadExplicitDefault :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Bool -> m ()
set_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 2 0 0
newtype Field'group'group' msg = Field'group'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Field'group'group' msg) where
    fromStruct = pure . Field'group'group'_newtype_
instance C'.ToStruct msg (Field'group'group' msg) where
    toStruct (Field'group'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Field'group'group' msg) where
    fromPtr msg ptr = Field'group'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Field'group'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Field'group'group' msg) where
    newtype List msg (Field'group'group' msg) = List_Field'group'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Field'group'group' l) = U'.length l
    index i (List_Field'group'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'group'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Field'group'group' (M'.MutMsg s)) where
    setIndex (Field'group'group'_newtype_ elt) i (List_Field'group'group' l) = U'.setIndex elt i l
    newList msg len = List_Field'group'group' <$> U'.allocCompositeList msg 3 4 len
instance U'.HasMessage (Field'group'group' msg) msg where
    message (Field'group'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Field'group'group' msg) msg where
    messageDefault = Field'group'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Field'group'group' (M'.MutMsg s)) where
    new msg = Field'group'group'_newtype_ <$> U'.allocStruct msg 3 4
instance C'.IsPtr msg (B'.List msg (Field'group'group' msg)) where
    fromPtr msg ptr = List_Field'group'group' <$> C'.fromPtr msg ptr
    toPtr (List_Field'group'group' l) = C'.toPtr l
get_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Word64
get_Field'group'typeId (Field'group'group'_newtype_ struct) = H'.getWordField struct 2 0 0
has_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Bool
has_Field'group'typeId(Field'group'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct)
set_Field'group'typeId :: U'.RWCtx m s => Field'group'group' (M'.MutMsg s) -> Word64 -> m ()
set_Field'group'typeId (Field'group'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
instance C'.FromStruct msg (Field'' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 0 0
        case tag of
            1 -> Field'group <$> C'.fromStruct struct
            0 -> Field'slot <$> C'.fromStruct struct
            _ -> pure $ Field'unknown' tag
field'noDiscriminant :: Word16
field'noDiscriminant = C'.fromWord 65535
newtype Field'ordinal msg = Field'ordinal_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Field'ordinal msg) where
    fromStruct = pure . Field'ordinal_newtype_
instance C'.ToStruct msg (Field'ordinal msg) where
    toStruct (Field'ordinal_newtype_ struct) = struct
instance C'.IsPtr msg (Field'ordinal msg) where
    fromPtr msg ptr = Field'ordinal_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Field'ordinal_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Field'ordinal msg) where
    newtype List msg (Field'ordinal msg) = List_Field'ordinal (U'.ListOf msg (U'.Struct msg))
    length (List_Field'ordinal l) = U'.length l
    index i (List_Field'ordinal l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'ordinal msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Field'ordinal (M'.MutMsg s)) where
    setIndex (Field'ordinal_newtype_ elt) i (List_Field'ordinal l) = U'.setIndex elt i l
    newList msg len = List_Field'ordinal <$> U'.allocCompositeList msg 3 4 len
instance U'.HasMessage (Field'ordinal msg) msg where
    message (Field'ordinal_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Field'ordinal msg) msg where
    messageDefault = Field'ordinal_newtype_ . U'.messageDefault
instance C'.Allocate s (Field'ordinal (M'.MutMsg s)) where
    new msg = Field'ordinal_newtype_ <$> U'.allocStruct msg 3 4
instance C'.IsPtr msg (B'.List msg (Field'ordinal msg)) where
    fromPtr msg ptr = List_Field'ordinal <$> C'.fromPtr msg ptr
    toPtr (List_Field'ordinal l) = C'.toPtr l
data Field'ordinal' msg =
    Field'ordinal'implicit |
    Field'ordinal'explicit Word16 |
    Field'ordinal'unknown' Word16
get_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m (Field'ordinal' msg)
get_Field'ordinal' (Field'ordinal_newtype_ struct) = C'.fromStruct struct
has_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m Bool
has_Field'ordinal'(Field'ordinal_newtype_ struct) = pure True
set_Field'ordinal'implicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> m ()
set_Field'ordinal'implicit (Field'ordinal_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0
set_Field'ordinal'explicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m ()
set_Field'ordinal'explicit (Field'ordinal_newtype_ struct) value = do
    H'.setWordField struct (1 :: Word16) 1 16 0
    H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 32 0
set_Field'ordinal'unknown' :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m ()
set_Field'ordinal'unknown'(Field'ordinal_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0
instance C'.FromStruct msg (Field'ordinal' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 16 0
        case tag of
            1 -> Field'ordinal'explicit <$>  H'.getWordField struct 1 32 0
            0 -> pure Field'ordinal'implicit
            _ -> pure $ Field'ordinal'unknown' tag
newtype Node' msg = Node'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node' msg) where
    fromStruct = pure . Node'_newtype_
instance C'.ToStruct msg (Node' msg) where
    toStruct (Node'_newtype_ struct) = struct
instance C'.IsPtr msg (Node' msg) where
    fromPtr msg ptr = Node'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node' msg) where
    newtype List msg (Node' msg) = List_Node' (U'.ListOf msg (U'.Struct msg))
    length (List_Node' l) = U'.length l
    index i (List_Node' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node' (M'.MutMsg s)) where
    setIndex (Node'_newtype_ elt) i (List_Node' l) = U'.setIndex elt i l
    newList msg len = List_Node' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node' msg) msg where
    message (Node'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node' msg) msg where
    messageDefault = Node'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node' (M'.MutMsg s)) where
    new msg = Node'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node' msg)) where
    fromPtr msg ptr = List_Node' <$> C'.fromPtr msg ptr
    toPtr (List_Node' l) = C'.toPtr l
data Node'' msg =
    Node'file |
    Node'struct (Node'struct'group' msg) |
    Node'enum (Node'enum'group' msg) |
    Node'interface (Node'interface'group' msg) |
    Node'const (Node'const'group' msg) |
    Node'annotation (Node'annotation'group' msg) |
    Node'unknown' Word16
get_Node'' :: U'.ReadCtx m msg => Node' msg -> m (Node'' msg)
get_Node'' (Node'_newtype_ struct) = C'.fromStruct struct
has_Node'' :: U'.ReadCtx m msg => Node' msg -> m Bool
has_Node''(Node'_newtype_ struct) = pure True
set_Node'file :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m ()
set_Node'file (Node'_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 32 0
set_Node'struct :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'struct'group' (M'.MutMsg s))
set_Node'struct (Node'_newtype_ struct) = do
    H'.setWordField struct (1 :: Word16) 1 32 0
    pure $ Node'struct'group'_newtype_ struct
set_Node'enum :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'enum'group' (M'.MutMsg s))
set_Node'enum (Node'_newtype_ struct) = do
    H'.setWordField struct (2 :: Word16) 1 32 0
    pure $ Node'enum'group'_newtype_ struct
set_Node'interface :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'interface'group' (M'.MutMsg s))
set_Node'interface (Node'_newtype_ struct) = do
    H'.setWordField struct (3 :: Word16) 1 32 0
    pure $ Node'interface'group'_newtype_ struct
set_Node'const :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'const'group' (M'.MutMsg s))
set_Node'const (Node'_newtype_ struct) = do
    H'.setWordField struct (4 :: Word16) 1 32 0
    pure $ Node'const'group'_newtype_ struct
set_Node'annotation :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'annotation'group' (M'.MutMsg s))
set_Node'annotation (Node'_newtype_ struct) = do
    H'.setWordField struct (5 :: Word16) 1 32 0
    pure $ Node'annotation'group'_newtype_ struct
set_Node'unknown' :: U'.RWCtx m s => Node' (M'.MutMsg s) -> Word16 -> m ()
set_Node'unknown'(Node'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 32 0
newtype Node'struct'group' msg = Node'struct'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'struct'group' msg) where
    fromStruct = pure . Node'struct'group'_newtype_
instance C'.ToStruct msg (Node'struct'group' msg) where
    toStruct (Node'struct'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Node'struct'group' msg) where
    fromPtr msg ptr = Node'struct'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'struct'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'struct'group' msg) where
    newtype List msg (Node'struct'group' msg) = List_Node'struct'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Node'struct'group' l) = U'.length l
    index i (List_Node'struct'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'struct'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'struct'group' (M'.MutMsg s)) where
    setIndex (Node'struct'group'_newtype_ elt) i (List_Node'struct'group' l) = U'.setIndex elt i l
    newList msg len = List_Node'struct'group' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node'struct'group' msg) msg where
    message (Node'struct'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'struct'group' msg) msg where
    messageDefault = Node'struct'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'struct'group' (M'.MutMsg s)) where
    new msg = Node'struct'group'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node'struct'group' msg)) where
    fromPtr msg ptr = List_Node'struct'group' <$> C'.fromPtr msg ptr
    toPtr (List_Node'struct'group' l) = C'.toPtr l
get_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
get_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 1 48 0
has_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'dataWordCount(Node'struct'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'struct'dataWordCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
set_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 48 0
get_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
get_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 0 0
has_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'pointerCount(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct)
set_Node'struct'pointerCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
set_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 0 0
get_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m ElementSize
get_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 16 0
has_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'preferredListEncoding(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct)
set_Node'struct'preferredListEncoding :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> ElementSize -> m ()
set_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 16 0
get_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
get_Node'struct'isGroup (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 32 0
has_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'isGroup(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct)
set_Node'struct'isGroup :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'struct'isGroup (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 3 32 0
get_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
get_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 48 0
has_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'discriminantCount(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct)
set_Node'struct'discriminantCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
set_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 48 0
get_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word32
get_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) = H'.getWordField struct 4 0 0
has_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'discriminantOffset(Node'struct'group'_newtype_ struct) = pure $ 4 < U'.length (U'.dataSection struct)
set_Node'struct'discriminantOffset :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word32 -> m ()
set_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 4 0 0
get_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m (B'.List msg (Field msg))
get_Node'struct'fields (Node'struct'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
has_Node'struct'fields(Node'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Node'struct'fields :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Field (M'.MutMsg s))) -> m ()
set_Node'struct'fields (Node'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Node'struct'fields :: U'.RWCtx m s => Int -> Node'struct'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Field (M'.MutMsg s))))
new_Node'struct'fields len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'struct'fields struct result
    pure result
newtype Node'enum'group' msg = Node'enum'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'enum'group' msg) where
    fromStruct = pure . Node'enum'group'_newtype_
instance C'.ToStruct msg (Node'enum'group' msg) where
    toStruct (Node'enum'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Node'enum'group' msg) where
    fromPtr msg ptr = Node'enum'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'enum'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'enum'group' msg) where
    newtype List msg (Node'enum'group' msg) = List_Node'enum'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Node'enum'group' l) = U'.length l
    index i (List_Node'enum'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'enum'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'enum'group' (M'.MutMsg s)) where
    setIndex (Node'enum'group'_newtype_ elt) i (List_Node'enum'group' l) = U'.setIndex elt i l
    newList msg len = List_Node'enum'group' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node'enum'group' msg) msg where
    message (Node'enum'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'enum'group' msg) msg where
    messageDefault = Node'enum'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'enum'group' (M'.MutMsg s)) where
    new msg = Node'enum'group'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node'enum'group' msg)) where
    fromPtr msg ptr = List_Node'enum'group' <$> C'.fromPtr msg ptr
    toPtr (List_Node'enum'group' l) = C'.toPtr l
get_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m (B'.List msg (Enumerant msg))
get_Node'enum'enumerants (Node'enum'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m Bool
has_Node'enum'enumerants(Node'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Node'enum'enumerants :: U'.RWCtx m s => Node'enum'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))) -> m ()
set_Node'enum'enumerants (Node'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Node'enum'enumerants :: U'.RWCtx m s => Int -> Node'enum'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))))
new_Node'enum'enumerants len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'enum'enumerants struct result
    pure result
newtype Node'interface'group' msg = Node'interface'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'interface'group' msg) where
    fromStruct = pure . Node'interface'group'_newtype_
instance C'.ToStruct msg (Node'interface'group' msg) where
    toStruct (Node'interface'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Node'interface'group' msg) where
    fromPtr msg ptr = Node'interface'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'interface'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'interface'group' msg) where
    newtype List msg (Node'interface'group' msg) = List_Node'interface'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Node'interface'group' l) = U'.length l
    index i (List_Node'interface'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'interface'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'interface'group' (M'.MutMsg s)) where
    setIndex (Node'interface'group'_newtype_ elt) i (List_Node'interface'group' l) = U'.setIndex elt i l
    newList msg len = List_Node'interface'group' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node'interface'group' msg) msg where
    message (Node'interface'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'interface'group' msg) msg where
    messageDefault = Node'interface'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'interface'group' (M'.MutMsg s)) where
    new msg = Node'interface'group'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node'interface'group' msg)) where
    fromPtr msg ptr = List_Node'interface'group' <$> C'.fromPtr msg ptr
    toPtr (List_Node'interface'group' l) = C'.toPtr l
get_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Method msg))
get_Node'interface'methods (Node'interface'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool
has_Node'interface'methods(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Node'interface'methods :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Method (M'.MutMsg s))) -> m ()
set_Node'interface'methods (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Node'interface'methods :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Method (M'.MutMsg s))))
new_Node'interface'methods len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'interface'methods struct result
    pure result
get_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Superclass msg))
get_Node'interface'superclasses (Node'interface'group'_newtype_ struct) =
    U'.getPtr 4 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool
has_Node'interface'superclasses(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
set_Node'interface'superclasses :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))) -> m ()
set_Node'interface'superclasses (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
new_Node'interface'superclasses :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))))
new_Node'interface'superclasses len struct = do
    result <- C'.newList (U'.message struct) len
    set_Node'interface'superclasses struct result
    pure result
newtype Node'const'group' msg = Node'const'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'const'group' msg) where
    fromStruct = pure . Node'const'group'_newtype_
instance C'.ToStruct msg (Node'const'group' msg) where
    toStruct (Node'const'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Node'const'group' msg) where
    fromPtr msg ptr = Node'const'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'const'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'const'group' msg) where
    newtype List msg (Node'const'group' msg) = List_Node'const'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Node'const'group' l) = U'.length l
    index i (List_Node'const'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'const'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'const'group' (M'.MutMsg s)) where
    setIndex (Node'const'group'_newtype_ elt) i (List_Node'const'group' l) = U'.setIndex elt i l
    newList msg len = List_Node'const'group' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node'const'group' msg) msg where
    message (Node'const'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'const'group' msg) msg where
    messageDefault = Node'const'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'const'group' (M'.MutMsg s)) where
    new msg = Node'const'group'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node'const'group' msg)) where
    fromPtr msg ptr = List_Node'const'group' <$> C'.fromPtr msg ptr
    toPtr (List_Node'const'group' l) = C'.toPtr l
get_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m (Type msg)
get_Node'const'type_ (Node'const'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool
has_Node'const'type_(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
set_Node'const'type_ (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
new_Node'const'type_ struct = do
    result <- C'.new (U'.message struct)
    set_Node'const'type_ struct result
    pure result
get_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m (Value msg)
get_Node'const'value (Node'const'group'_newtype_ struct) =
    U'.getPtr 4 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool
has_Node'const'value(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
set_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
set_Node'const'value (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
new_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
new_Node'const'value struct = do
    result <- C'.new (U'.message struct)
    set_Node'const'value struct result
    pure result
newtype Node'annotation'group' msg = Node'annotation'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'annotation'group' msg) where
    fromStruct = pure . Node'annotation'group'_newtype_
instance C'.ToStruct msg (Node'annotation'group' msg) where
    toStruct (Node'annotation'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Node'annotation'group' msg) where
    fromPtr msg ptr = Node'annotation'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'annotation'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'annotation'group' msg) where
    newtype List msg (Node'annotation'group' msg) = List_Node'annotation'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Node'annotation'group' l) = U'.length l
    index i (List_Node'annotation'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'annotation'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'annotation'group' (M'.MutMsg s)) where
    setIndex (Node'annotation'group'_newtype_ elt) i (List_Node'annotation'group' l) = U'.setIndex elt i l
    newList msg len = List_Node'annotation'group' <$> U'.allocCompositeList msg 5 6 len
instance U'.HasMessage (Node'annotation'group' msg) msg where
    message (Node'annotation'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'annotation'group' msg) msg where
    messageDefault = Node'annotation'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'annotation'group' (M'.MutMsg s)) where
    new msg = Node'annotation'group'_newtype_ <$> U'.allocStruct msg 5 6
instance C'.IsPtr msg (B'.List msg (Node'annotation'group' msg)) where
    fromPtr msg ptr = List_Node'annotation'group' <$> C'.fromPtr msg ptr
    toPtr (List_Node'annotation'group' l) = C'.toPtr l
get_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m (Type msg)
get_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) =
    U'.getPtr 3 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'type_(Node'annotation'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
set_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
set_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
new_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
new_Node'annotation'type_ struct = do
    result <- C'.new (U'.message struct)
    set_Node'annotation'type_ struct result
    pure result
get_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 48 0
has_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsFile(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsFile :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 48 0
get_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 49 0
has_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsConst(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsConst :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 49 0
get_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 50 0
has_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsEnum(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsEnum :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 50 0
get_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 51 0
has_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsEnumerant(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsEnumerant :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 51 0
get_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 52 0
has_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsStruct(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsStruct :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 52 0
get_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 53 0
has_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsField(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsField :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 53 0
get_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 54 0
has_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsUnion(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsUnion :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 54 0
get_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 55 0
has_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsGroup(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsGroup :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 55 0
get_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 56 0
has_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsInterface(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsInterface :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 56 0
get_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 57 0
has_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsMethod(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsMethod :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 57 0
get_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 58 0
has_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsParam(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsParam :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 58 0
get_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
get_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 59 0
has_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
has_Node'annotation'targetsAnnotation(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Node'annotation'targetsAnnotation :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 59 0
instance C'.FromStruct msg (Node'' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 32 0
        case tag of
            5 -> Node'annotation <$> C'.fromStruct struct
            4 -> Node'const <$> C'.fromStruct struct
            3 -> Node'interface <$> C'.fromStruct struct
            2 -> Node'enum <$> C'.fromStruct struct
            1 -> Node'struct <$> C'.fromStruct struct
            0 -> pure Node'file
            _ -> pure $ Node'unknown' tag
newtype Node'NestedNode msg = Node'NestedNode_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'NestedNode msg) where
    fromStruct = pure . Node'NestedNode_newtype_
instance C'.ToStruct msg (Node'NestedNode msg) where
    toStruct (Node'NestedNode_newtype_ struct) = struct
instance C'.IsPtr msg (Node'NestedNode msg) where
    fromPtr msg ptr = Node'NestedNode_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'NestedNode_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'NestedNode msg) where
    newtype List msg (Node'NestedNode msg) = List_Node'NestedNode (U'.ListOf msg (U'.Struct msg))
    length (List_Node'NestedNode l) = U'.length l
    index i (List_Node'NestedNode l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'NestedNode msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'NestedNode (M'.MutMsg s)) where
    setIndex (Node'NestedNode_newtype_ elt) i (List_Node'NestedNode l) = U'.setIndex elt i l
    newList msg len = List_Node'NestedNode <$> U'.allocCompositeList msg 1 1 len
instance U'.HasMessage (Node'NestedNode msg) msg where
    message (Node'NestedNode_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'NestedNode msg) msg where
    messageDefault = Node'NestedNode_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'NestedNode (M'.MutMsg s)) where
    new msg = Node'NestedNode_newtype_ <$> U'.allocStruct msg 1 1
instance C'.IsPtr msg (B'.List msg (Node'NestedNode msg)) where
    fromPtr msg ptr = List_Node'NestedNode <$> C'.fromPtr msg ptr
    toPtr (List_Node'NestedNode l) = C'.toPtr l
get_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m (B'.Text msg)
get_Node'NestedNode'name (Node'NestedNode_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool
has_Node'NestedNode'name(Node'NestedNode_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Node'NestedNode'name :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Node'NestedNode'name (Node'NestedNode_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Node'NestedNode'name :: U'.RWCtx m s => Int -> Node'NestedNode (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Node'NestedNode'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_Node'NestedNode'name struct result
    pure result
get_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Word64
get_Node'NestedNode'id (Node'NestedNode_newtype_ struct) = H'.getWordField struct 0 0 0
has_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool
has_Node'NestedNode'id(Node'NestedNode_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct)
set_Node'NestedNode'id :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> Word64 -> m ()
set_Node'NestedNode'id (Node'NestedNode_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
newtype Node'Parameter msg = Node'Parameter_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Node'Parameter msg) where
    fromStruct = pure . Node'Parameter_newtype_
instance C'.ToStruct msg (Node'Parameter msg) where
    toStruct (Node'Parameter_newtype_ struct) = struct
instance C'.IsPtr msg (Node'Parameter msg) where
    fromPtr msg ptr = Node'Parameter_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Node'Parameter_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Node'Parameter msg) where
    newtype List msg (Node'Parameter msg) = List_Node'Parameter (U'.ListOf msg (U'.Struct msg))
    length (List_Node'Parameter l) = U'.length l
    index i (List_Node'Parameter l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'Parameter msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Node'Parameter (M'.MutMsg s)) where
    setIndex (Node'Parameter_newtype_ elt) i (List_Node'Parameter l) = U'.setIndex elt i l
    newList msg len = List_Node'Parameter <$> U'.allocCompositeList msg 0 1 len
instance U'.HasMessage (Node'Parameter msg) msg where
    message (Node'Parameter_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Node'Parameter msg) msg where
    messageDefault = Node'Parameter_newtype_ . U'.messageDefault
instance C'.Allocate s (Node'Parameter (M'.MutMsg s)) where
    new msg = Node'Parameter_newtype_ <$> U'.allocStruct msg 0 1
instance C'.IsPtr msg (B'.List msg (Node'Parameter msg)) where
    fromPtr msg ptr = List_Node'Parameter <$> C'.fromPtr msg ptr
    toPtr (List_Node'Parameter l) = C'.toPtr l
get_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m (B'.Text msg)
get_Node'Parameter'name (Node'Parameter_newtype_ struct) =
    U'.getPtr 0 struct
    >>= C'.fromPtr (U'.message struct)
has_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m Bool
has_Node'Parameter'name(Node'Parameter_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
set_Node'Parameter'name :: U'.RWCtx m s => Node'Parameter (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
set_Node'Parameter'name (Node'Parameter_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
new_Node'Parameter'name :: U'.RWCtx m s => Int -> Node'Parameter (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
new_Node'Parameter'name len struct = do
    result <- B'.newText (U'.message struct) len
    set_Node'Parameter'name struct result
    pure result
newtype Type'anyPointer msg = Type'anyPointer_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer msg) where
    fromStruct = pure . Type'anyPointer_newtype_
instance C'.ToStruct msg (Type'anyPointer msg) where
    toStruct (Type'anyPointer_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer msg) where
    fromPtr msg ptr = Type'anyPointer_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer msg) where
    newtype List msg (Type'anyPointer msg) = List_Type'anyPointer (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer l) = U'.length l
    index i (List_Type'anyPointer l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer (M'.MutMsg s)) where
    setIndex (Type'anyPointer_newtype_ elt) i (List_Type'anyPointer l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer msg) msg where
    message (Type'anyPointer_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer msg) msg where
    messageDefault = Type'anyPointer_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer (M'.MutMsg s)) where
    new msg = Type'anyPointer_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer msg)) where
    fromPtr msg ptr = List_Type'anyPointer <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer l) = C'.toPtr l
data Type'anyPointer' msg =
    Type'anyPointer'unconstrained (Type'anyPointer'unconstrained'group' msg) |
    Type'anyPointer'parameter (Type'anyPointer'parameter'group' msg) |
    Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter'group' msg) |
    Type'anyPointer'unknown' Word16
get_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m (Type'anyPointer' msg)
get_Type'anyPointer' (Type'anyPointer_newtype_ struct) = C'.fromStruct struct
has_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m Bool
has_Type'anyPointer'(Type'anyPointer_newtype_ struct) = pure True
set_Type'anyPointer'unconstrained :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'unconstrained'group' (M'.MutMsg s))
set_Type'anyPointer'unconstrained (Type'anyPointer_newtype_ struct) = do
    H'.setWordField struct (0 :: Word16) 1 0 0
    pure $ Type'anyPointer'unconstrained'group'_newtype_ struct
set_Type'anyPointer'parameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'parameter'group' (M'.MutMsg s))
set_Type'anyPointer'parameter (Type'anyPointer_newtype_ struct) = do
    H'.setWordField struct (1 :: Word16) 1 0 0
    pure $ Type'anyPointer'parameter'group'_newtype_ struct
set_Type'anyPointer'implicitMethodParameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s))
set_Type'anyPointer'implicitMethodParameter (Type'anyPointer_newtype_ struct) = do
    H'.setWordField struct (2 :: Word16) 1 0 0
    pure $ Type'anyPointer'implicitMethodParameter'group'_newtype_ struct
set_Type'anyPointer'unknown' :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'unknown'(Type'anyPointer_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
newtype Type'anyPointer'unconstrained'group' msg = Type'anyPointer'unconstrained'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer'unconstrained'group' msg) where
    fromStruct = pure . Type'anyPointer'unconstrained'group'_newtype_
instance C'.ToStruct msg (Type'anyPointer'unconstrained'group' msg) where
    toStruct (Type'anyPointer'unconstrained'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer'unconstrained'group' msg) where
    fromPtr msg ptr = Type'anyPointer'unconstrained'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer'unconstrained'group' msg) where
    newtype List msg (Type'anyPointer'unconstrained'group' msg) = List_Type'anyPointer'unconstrained'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer'unconstrained'group' l) = U'.length l
    index i (List_Type'anyPointer'unconstrained'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'unconstrained'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) where
    setIndex (Type'anyPointer'unconstrained'group'_newtype_ elt) i (List_Type'anyPointer'unconstrained'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer'unconstrained'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer'unconstrained'group' msg) msg where
    message (Type'anyPointer'unconstrained'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer'unconstrained'group' msg) msg where
    messageDefault = Type'anyPointer'unconstrained'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) where
    new msg = Type'anyPointer'unconstrained'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer'unconstrained'group' msg)) where
    fromPtr msg ptr = List_Type'anyPointer'unconstrained'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer'unconstrained'group' l) = C'.toPtr l
get_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m (Type'anyPointer'unconstrained msg)
get_Type'anyPointer'unconstrained'union' (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.fromStruct struct
has_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m Bool
has_Type'anyPointer'unconstrained'union'(Type'anyPointer'unconstrained'group'_newtype_ struct) = pure True
newtype Type'anyPointer'parameter'group' msg = Type'anyPointer'parameter'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer'parameter'group' msg) where
    fromStruct = pure . Type'anyPointer'parameter'group'_newtype_
instance C'.ToStruct msg (Type'anyPointer'parameter'group' msg) where
    toStruct (Type'anyPointer'parameter'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer'parameter'group' msg) where
    fromPtr msg ptr = Type'anyPointer'parameter'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer'parameter'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer'parameter'group' msg) where
    newtype List msg (Type'anyPointer'parameter'group' msg) = List_Type'anyPointer'parameter'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer'parameter'group' l) = U'.length l
    index i (List_Type'anyPointer'parameter'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'parameter'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer'parameter'group' (M'.MutMsg s)) where
    setIndex (Type'anyPointer'parameter'group'_newtype_ elt) i (List_Type'anyPointer'parameter'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer'parameter'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer'parameter'group' msg) msg where
    message (Type'anyPointer'parameter'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer'parameter'group' msg) msg where
    messageDefault = Type'anyPointer'parameter'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer'parameter'group' (M'.MutMsg s)) where
    new msg = Type'anyPointer'parameter'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer'parameter'group' msg)) where
    fromPtr msg ptr = List_Type'anyPointer'parameter'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer'parameter'group' l) = C'.toPtr l
get_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word64
get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 2 0 0
has_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Bool
has_Type'anyPointer'parameter'scopeId(Type'anyPointer'parameter'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct)
set_Type'anyPointer'parameter'scopeId :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word64 -> m ()
set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
get_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word16
get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0
has_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Bool
has_Type'anyPointer'parameter'parameterIndex(Type'anyPointer'parameter'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Type'anyPointer'parameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0
newtype Type'anyPointer'implicitMethodParameter'group' msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where
    fromStruct = pure . Type'anyPointer'implicitMethodParameter'group'_newtype_
instance C'.ToStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where
    toStruct (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer'implicitMethodParameter'group' msg) where
    fromPtr msg ptr = Type'anyPointer'implicitMethodParameter'group'_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer'implicitMethodParameter'group' msg) where
    newtype List msg (Type'anyPointer'implicitMethodParameter'group' msg) = List_Type'anyPointer'implicitMethodParameter'group' (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.length l
    index i (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'implicitMethodParameter'group' msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) where
    setIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ elt) i (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer'implicitMethodParameter'group' <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer'implicitMethodParameter'group' msg) msg where
    message (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer'implicitMethodParameter'group' msg) msg where
    messageDefault = Type'anyPointer'implicitMethodParameter'group'_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) where
    new msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer'implicitMethodParameter'group' msg)) where
    fromPtr msg ptr = List_Type'anyPointer'implicitMethodParameter'group' <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer'implicitMethodParameter'group' l) = C'.toPtr l
get_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Word16
get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0
has_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Bool
has_Type'anyPointer'implicitMethodParameter'parameterIndex(Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct)
set_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0
instance C'.FromStruct msg (Type'anyPointer' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 0 0
        case tag of
            2 -> Type'anyPointer'implicitMethodParameter <$> C'.fromStruct struct
            1 -> Type'anyPointer'parameter <$> C'.fromStruct struct
            0 -> Type'anyPointer'unconstrained <$> C'.fromStruct struct
            _ -> pure $ Type'anyPointer'unknown' tag
newtype Type'anyPointer'unconstrained msg = Type'anyPointer'unconstrained_newtype_ (U'.Struct msg)
instance C'.FromStruct msg (Type'anyPointer'unconstrained msg) where
    fromStruct = pure . Type'anyPointer'unconstrained_newtype_
instance C'.ToStruct msg (Type'anyPointer'unconstrained msg) where
    toStruct (Type'anyPointer'unconstrained_newtype_ struct) = struct
instance C'.IsPtr msg (Type'anyPointer'unconstrained msg) where
    fromPtr msg ptr = Type'anyPointer'unconstrained_newtype_ <$> C'.fromPtr msg ptr
    toPtr (Type'anyPointer'unconstrained_newtype_ struct) = C'.toPtr struct
instance B'.ListElem msg (Type'anyPointer'unconstrained msg) where
    newtype List msg (Type'anyPointer'unconstrained msg) = List_Type'anyPointer'unconstrained (U'.ListOf msg (U'.Struct msg))
    length (List_Type'anyPointer'unconstrained l) = U'.length l
    index i (List_Type'anyPointer'unconstrained l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'unconstrained msg); go = C'.fromStruct} in go)
instance B'.MutListElem s (Type'anyPointer'unconstrained (M'.MutMsg s)) where
    setIndex (Type'anyPointer'unconstrained_newtype_ elt) i (List_Type'anyPointer'unconstrained l) = U'.setIndex elt i l
    newList msg len = List_Type'anyPointer'unconstrained <$> U'.allocCompositeList msg 3 1 len
instance U'.HasMessage (Type'anyPointer'unconstrained msg) msg where
    message (Type'anyPointer'unconstrained_newtype_ struct) = U'.message struct
instance U'.MessageDefault (Type'anyPointer'unconstrained msg) msg where
    messageDefault = Type'anyPointer'unconstrained_newtype_ . U'.messageDefault
instance C'.Allocate s (Type'anyPointer'unconstrained (M'.MutMsg s)) where
    new msg = Type'anyPointer'unconstrained_newtype_ <$> U'.allocStruct msg 3 1
instance C'.IsPtr msg (B'.List msg (Type'anyPointer'unconstrained msg)) where
    fromPtr msg ptr = List_Type'anyPointer'unconstrained <$> C'.fromPtr msg ptr
    toPtr (List_Type'anyPointer'unconstrained l) = C'.toPtr l
data Type'anyPointer'unconstrained' msg =
    Type'anyPointer'unconstrained'anyKind |
    Type'anyPointer'unconstrained'struct |
    Type'anyPointer'unconstrained'list |
    Type'anyPointer'unconstrained'capability |
    Type'anyPointer'unconstrained'unknown' Word16
get_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m (Type'anyPointer'unconstrained' msg)
get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained_newtype_ struct) = C'.fromStruct struct
has_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m Bool
has_Type'anyPointer'unconstrained'(Type'anyPointer'unconstrained_newtype_ struct) = pure True
set_Type'anyPointer'unconstrained'anyKind :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'anyKind (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0
set_Type'anyPointer'unconstrained'struct :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'struct (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 16 0
set_Type'anyPointer'unconstrained'list :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'list (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (2 :: Word16) 1 16 0
set_Type'anyPointer'unconstrained'capability :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'capability (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (3 :: Word16) 1 16 0
set_Type'anyPointer'unconstrained'unknown' :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'unconstrained'unknown'(Type'anyPointer'unconstrained_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0
instance C'.FromStruct msg (Type'anyPointer'unconstrained' msg) where
    fromStruct struct = do
        tag <-  H'.getWordField struct 1 16 0
        case tag of
            3 -> pure Type'anyPointer'unconstrained'capability
            2 -> pure Type'anyPointer'unconstrained'list
            1 -> pure Type'anyPointer'unconstrained'struct
            0 -> pure Type'anyPointer'unconstrained'anyKind
            _ -> pure $ Type'anyPointer'unconstrained'unknown' tag