{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{- |
Module: Capnp.Capnp.Schema.Pure
Description: High-level generated module for capnp/schema.capnp
This module is the generated code for capnp/schema.capnp,
for the high-level api.
-}
module Capnp.Capnp.Schema.Pure (Annotation(..), Brand(..), CapnpVersion(..), CodeGeneratorRequest(..), Capnp.ById.Xa93fc509624c72d9.ElementSize(..), Enumerant(..), Field(..), Method(..), Node(..), Superclass(..), Type(..), Value(..), Brand'Binding(..), Brand'Scope(..), Brand'Scope'(..), CodeGeneratorRequest'RequestedFile(..), CodeGeneratorRequest'RequestedFile'Import(..), Field'(..), Capnp.ById.Xa93fc509624c72d9.field'noDiscriminant, Field'ordinal(..), Node'(..), Node'NestedNode(..), Node'Parameter(..), Type'anyPointer(..), Type'anyPointer'unconstrained(..)
) where
-- Code generated by capnpc-haskell. DO NOT EDIT.
-- Generated from schema file: capnp/schema.capnp
import Data.Int
import Data.Word
import Data.Default (Default(def))
import GHC.Generics (Generic)
import Data.Capnp.Basics.Pure (Data, Text)
import Control.Monad.Catch (MonadThrow)
import Data.Capnp.TraversalLimit (MonadLimit)
import Control.Monad (forM_)
import qualified Data.Capnp.Message as M'
import qualified Data.Capnp.Untyped as U'
import qualified Data.Capnp.Untyped.Pure as PU'
import qualified Data.Capnp.GenHelpers.Pure as PH'
import qualified Data.Capnp.Classes as C'
import qualified Data.Vector as V
import qualified Data.ByteString as BS
import qualified Capnp.ById.Xa93fc509624c72d9
import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure
import qualified Capnp.ById.Xbdf87d7bb8304e81
data Annotation
    = Annotation
        {id :: Word64,
        value :: Value,
        brand :: Brand}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Annotation where
    type Cerial msg Annotation = Capnp.ById.Xa93fc509624c72d9.Annotation msg
    decerialize raw = do
        Annotation <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Annotation'id raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Annotation'value raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Annotation'brand raw >>= C'.decerialize)
instance C'.Marshal Annotation where
    marshalInto raw value = do
        case value of
            Annotation{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_Annotation'id raw id
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Annotation'value raw
                C'.marshalInto field_ value
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Annotation'brand raw
                C'.marshalInto field_ brand
instance C'.Cerialize s Annotation
instance C'.FromStruct M'.ConstMsg Annotation where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Annotation M'.ConstMsg)
instance Default Annotation where
    def = PH'.defaultStruct
data Brand
    = Brand
        {scopes :: PU'.ListOf (Brand'Scope)}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Brand where
    type Cerial msg Brand = Capnp.ById.Xa93fc509624c72d9.Brand msg
    decerialize raw = do
        Brand <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Brand'scopes raw >>= C'.decerialize)
instance C'.Marshal Brand where
    marshalInto raw value = do
        case value of
            Brand{..} -> do
                let len_ = V.length scopes
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'scopes len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (scopes V.! i)
instance C'.Cerialize s Brand
instance C'.FromStruct M'.ConstMsg Brand where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand M'.ConstMsg)
instance Default Brand where
    def = PH'.defaultStruct
data CapnpVersion
    = CapnpVersion
        {major :: Word16,
        minor :: Word8,
        micro :: Word8}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize CapnpVersion where
    type Cerial msg CapnpVersion = Capnp.ById.Xa93fc509624c72d9.CapnpVersion msg
    decerialize raw = do
        CapnpVersion <$>
            (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'major raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'minor raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'micro raw)
instance C'.Marshal CapnpVersion where
    marshalInto raw value = do
        case value of
            CapnpVersion{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'major raw major
                Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'minor raw minor
                Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'micro raw micro
instance C'.Cerialize s CapnpVersion
instance C'.FromStruct M'.ConstMsg CapnpVersion where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CapnpVersion M'.ConstMsg)
instance Default CapnpVersion where
    def = PH'.defaultStruct
data CodeGeneratorRequest
    = CodeGeneratorRequest
        {nodes :: PU'.ListOf (Node),
        requestedFiles :: PU'.ListOf (CodeGeneratorRequest'RequestedFile),
        capnpVersion :: CapnpVersion}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize CodeGeneratorRequest where
    type Cerial msg CodeGeneratorRequest = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg
    decerialize raw = do
        CodeGeneratorRequest <$>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'nodes raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'requestedFiles raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'capnpVersion raw >>= C'.decerialize)
instance C'.Marshal CodeGeneratorRequest where
    marshalInto raw value = do
        case value of
            CodeGeneratorRequest{..} -> do
                let len_ = V.length nodes
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'nodes len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (nodes V.! i)
                let len_ = V.length requestedFiles
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'requestedFiles len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (requestedFiles V.! i)
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'capnpVersion raw
                C'.marshalInto field_ capnpVersion
instance C'.Cerialize s CodeGeneratorRequest
instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest M'.ConstMsg)
instance Default CodeGeneratorRequest where
    def = PH'.defaultStruct
data Enumerant
    = Enumerant
        {name :: Text,
        codeOrder :: Word16,
        annotations :: PU'.ListOf (Annotation)}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Enumerant where
    type Cerial msg Enumerant = Capnp.ById.Xa93fc509624c72d9.Enumerant msg
    decerialize raw = do
        Enumerant <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'name raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'codeOrder raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'annotations raw >>= C'.decerialize)
instance C'.Marshal Enumerant where
    marshalInto raw value = do
        case value of
            Enumerant{..} -> do
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_Enumerant'name raw field_
                Capnp.ById.Xa93fc509624c72d9.set_Enumerant'codeOrder raw codeOrder
                let len_ = V.length annotations
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Enumerant'annotations len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (annotations V.! i)
instance C'.Cerialize s Enumerant
instance C'.FromStruct M'.ConstMsg Enumerant where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Enumerant M'.ConstMsg)
instance Default Enumerant where
    def = PH'.defaultStruct
data Field
    = Field
        {name :: Text,
        codeOrder :: Word16,
        annotations :: PU'.ListOf (Annotation),
        discriminantValue :: Word16,
        ordinal :: Field'ordinal,
        union' :: Field'}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Field where
    type Cerial msg Field = Capnp.ById.Xa93fc509624c72d9.Field msg
    decerialize raw = do
        Field <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'name raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'codeOrder raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'annotations raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'discriminantValue raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Field'union' raw >>= C'.decerialize)
instance C'.Marshal Field where
    marshalInto raw value = do
        case value of
            Field{..} -> do
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_Field'name raw field_
                Capnp.ById.Xa93fc509624c72d9.set_Field'codeOrder raw codeOrder
                let len_ = V.length annotations
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'annotations len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (annotations V.! i)
                Capnp.ById.Xa93fc509624c72d9.set_Field'discriminantValue raw discriminantValue
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal raw
                C'.marshalInto field_ ordinal
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Field'union' raw
                C'.marshalInto field_ union'
instance C'.Cerialize s Field
instance C'.FromStruct M'.ConstMsg Field where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field M'.ConstMsg)
instance Default Field where
    def = PH'.defaultStruct
data Method
    = Method
        {name :: Text,
        codeOrder :: Word16,
        paramStructType :: Word64,
        resultStructType :: Word64,
        annotations :: PU'.ListOf (Annotation),
        paramBrand :: Brand,
        resultBrand :: Brand,
        implicitParameters :: PU'.ListOf (Node'Parameter)}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Method where
    type Cerial msg Method = Capnp.ById.Xa93fc509624c72d9.Method msg
    decerialize raw = do
        Method <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'name raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'codeOrder raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'paramStructType raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'resultStructType raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'annotations raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'paramBrand raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'resultBrand raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Method'implicitParameters raw >>= C'.decerialize)
instance C'.Marshal Method where
    marshalInto raw value = do
        case value of
            Method{..} -> do
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_Method'name raw field_
                Capnp.ById.Xa93fc509624c72d9.set_Method'codeOrder raw codeOrder
                Capnp.ById.Xa93fc509624c72d9.set_Method'paramStructType raw paramStructType
                Capnp.ById.Xa93fc509624c72d9.set_Method'resultStructType raw resultStructType
                let len_ = V.length annotations
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'annotations len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (annotations V.! i)
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'paramBrand raw
                C'.marshalInto field_ paramBrand
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'resultBrand raw
                C'.marshalInto field_ resultBrand
                let len_ = V.length implicitParameters
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'implicitParameters len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (implicitParameters V.! i)
instance C'.Cerialize s Method
instance C'.FromStruct M'.ConstMsg Method where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Method M'.ConstMsg)
instance Default Method where
    def = PH'.defaultStruct
data Node
    = Node
        {id :: Word64,
        displayName :: Text,
        displayNamePrefixLength :: Word32,
        scopeId :: Word64,
        nestedNodes :: PU'.ListOf (Node'NestedNode),
        annotations :: PU'.ListOf (Annotation),
        parameters :: PU'.ListOf (Node'Parameter),
        isGeneric :: Bool,
        union' :: Node'}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Node where
    type Cerial msg Node = Capnp.ById.Xa93fc509624c72d9.Node msg
    decerialize raw = do
        Node <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'id raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'displayName raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'displayNamePrefixLength raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'scopeId raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'nestedNodes raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'annotations raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'parameters raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'isGeneric raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'union' raw >>= C'.decerialize)
instance C'.Marshal Node where
    marshalInto raw value = do
        case value of
            Node{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_Node'id raw id
                field_ <- C'.cerialize (U'.message raw) displayName
                Capnp.ById.Xa93fc509624c72d9.set_Node'displayName raw field_
                Capnp.ById.Xa93fc509624c72d9.set_Node'displayNamePrefixLength raw displayNamePrefixLength
                Capnp.ById.Xa93fc509624c72d9.set_Node'scopeId raw scopeId
                let len_ = V.length nestedNodes
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'nestedNodes len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (nestedNodes V.! i)
                let len_ = V.length annotations
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'annotations len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (annotations V.! i)
                let len_ = V.length parameters
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'parameters len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (parameters V.! i)
                Capnp.ById.Xa93fc509624c72d9.set_Node'isGeneric raw isGeneric
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Node'union' raw
                C'.marshalInto field_ union'
instance C'.Cerialize s Node
instance C'.FromStruct M'.ConstMsg Node where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node M'.ConstMsg)
instance Default Node where
    def = PH'.defaultStruct
data Superclass
    = Superclass
        {id :: Word64,
        brand :: Brand}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Superclass where
    type Cerial msg Superclass = Capnp.ById.Xa93fc509624c72d9.Superclass msg
    decerialize raw = do
        Superclass <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Superclass'id raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Superclass'brand raw >>= C'.decerialize)
instance C'.Marshal Superclass where
    marshalInto raw value = do
        case value of
            Superclass{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_Superclass'id raw id
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Superclass'brand raw
                C'.marshalInto field_ brand
instance C'.Cerialize s Superclass
instance C'.FromStruct M'.ConstMsg Superclass where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Superclass M'.ConstMsg)
instance Default Superclass where
    def = PH'.defaultStruct
data Type
    = Type'void
    | Type'bool
    | Type'int8
    | Type'int16
    | Type'int32
    | Type'int64
    | Type'uint8
    | Type'uint16
    | Type'uint32
    | Type'uint64
    | Type'float32
    | Type'float64
    | Type'text
    | Type'data_
    | Type'list
        {elementType :: Type}
    | Type'enum
        {typeId :: Word64,
        brand :: Brand}
    | Type'struct
        {typeId :: Word64,
        brand :: Brand}
    | Type'interface
        {typeId :: Word64,
        brand :: Brand}
    | Type'anyPointer
        {union' :: Type'anyPointer}
    | Type'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Type where
    type Cerial msg Type = Capnp.ById.Xa93fc509624c72d9.Type msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Type' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Type'void -> pure Type'void
            Capnp.ById.Xa93fc509624c72d9.Type'bool -> pure Type'bool
            Capnp.ById.Xa93fc509624c72d9.Type'int8 -> pure Type'int8
            Capnp.ById.Xa93fc509624c72d9.Type'int16 -> pure Type'int16
            Capnp.ById.Xa93fc509624c72d9.Type'int32 -> pure Type'int32
            Capnp.ById.Xa93fc509624c72d9.Type'int64 -> pure Type'int64
            Capnp.ById.Xa93fc509624c72d9.Type'uint8 -> pure Type'uint8
            Capnp.ById.Xa93fc509624c72d9.Type'uint16 -> pure Type'uint16
            Capnp.ById.Xa93fc509624c72d9.Type'uint32 -> pure Type'uint32
            Capnp.ById.Xa93fc509624c72d9.Type'uint64 -> pure Type'uint64
            Capnp.ById.Xa93fc509624c72d9.Type'float32 -> pure Type'float32
            Capnp.ById.Xa93fc509624c72d9.Type'float64 -> pure Type'float64
            Capnp.ById.Xa93fc509624c72d9.Type'text -> pure Type'text
            Capnp.ById.Xa93fc509624c72d9.Type'data_ -> pure Type'data_
            Capnp.ById.Xa93fc509624c72d9.Type'list raw -> Type'list <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'list'elementType raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'enum raw -> Type'enum <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'enum'typeId raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'enum'brand raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'struct raw -> Type'struct <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'struct'typeId raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'struct'brand raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'interface raw -> Type'interface <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'interface'typeId raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'interface'brand raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer raw -> Type'anyPointer <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'union' raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'unknown' val -> pure $ Type'unknown' val
instance C'.Marshal Type where
    marshalInto raw value = do
        case value of
            Type'void -> Capnp.ById.Xa93fc509624c72d9.set_Type'void raw
            Type'bool -> Capnp.ById.Xa93fc509624c72d9.set_Type'bool raw
            Type'int8 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int8 raw
            Type'int16 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int16 raw
            Type'int32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int32 raw
            Type'int64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int64 raw
            Type'uint8 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint8 raw
            Type'uint16 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint16 raw
            Type'uint32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint32 raw
            Type'uint64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint64 raw
            Type'float32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'float32 raw
            Type'float64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'float64 raw
            Type'text -> Capnp.ById.Xa93fc509624c72d9.set_Type'text raw
            Type'data_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'data_ raw
            Type'list{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'list raw
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'list'elementType raw
                C'.marshalInto field_ elementType
            Type'enum{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'enum raw
                Capnp.ById.Xa93fc509624c72d9.set_Type'enum'typeId raw typeId
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'enum'brand raw
                C'.marshalInto field_ brand
            Type'struct{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'struct raw
                Capnp.ById.Xa93fc509624c72d9.set_Type'struct'typeId raw typeId
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'struct'brand raw
                C'.marshalInto field_ brand
            Type'interface{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'interface raw
                Capnp.ById.Xa93fc509624c72d9.set_Type'interface'typeId raw typeId
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'interface'brand raw
                C'.marshalInto field_ brand
            Type'anyPointer{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer raw
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'union' raw
                C'.marshalInto field_ union'
            Type'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'unknown' raw arg_
instance C'.Cerialize s Type
instance C'.FromStruct M'.ConstMsg Type where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type M'.ConstMsg)
instance Default Type where
    def = PH'.defaultStruct
data Value
    = 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 (Text)
    | Value'data_ (Data)
    | Value'list (Maybe (PU'.PtrType))
    | Value'enum (Word16)
    | Value'struct (Maybe (PU'.PtrType))
    | Value'interface
    | Value'anyPointer (Maybe (PU'.PtrType))
    | Value'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Value where
    type Cerial msg Value = Capnp.ById.Xa93fc509624c72d9.Value msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Value' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Value'void -> pure Value'void
            Capnp.ById.Xa93fc509624c72d9.Value'bool val -> pure (Value'bool val)
            Capnp.ById.Xa93fc509624c72d9.Value'int8 val -> pure (Value'int8 val)
            Capnp.ById.Xa93fc509624c72d9.Value'int16 val -> pure (Value'int16 val)
            Capnp.ById.Xa93fc509624c72d9.Value'int32 val -> pure (Value'int32 val)
            Capnp.ById.Xa93fc509624c72d9.Value'int64 val -> pure (Value'int64 val)
            Capnp.ById.Xa93fc509624c72d9.Value'uint8 val -> pure (Value'uint8 val)
            Capnp.ById.Xa93fc509624c72d9.Value'uint16 val -> pure (Value'uint16 val)
            Capnp.ById.Xa93fc509624c72d9.Value'uint32 val -> pure (Value'uint32 val)
            Capnp.ById.Xa93fc509624c72d9.Value'uint64 val -> pure (Value'uint64 val)
            Capnp.ById.Xa93fc509624c72d9.Value'float32 val -> pure (Value'float32 val)
            Capnp.ById.Xa93fc509624c72d9.Value'float64 val -> pure (Value'float64 val)
            Capnp.ById.Xa93fc509624c72d9.Value'text val -> Value'text <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Value'data_ val -> Value'data_ <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Value'list val -> Value'list <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Value'enum val -> pure (Value'enum val)
            Capnp.ById.Xa93fc509624c72d9.Value'struct val -> Value'struct <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Value'interface -> pure Value'interface
            Capnp.ById.Xa93fc509624c72d9.Value'anyPointer val -> Value'anyPointer <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Value'unknown' val -> pure $ Value'unknown' val
instance C'.Marshal Value where
    marshalInto raw value = do
        case value of
            Value'void -> Capnp.ById.Xa93fc509624c72d9.set_Value'void raw
            Value'bool arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'bool raw arg_
            Value'int8 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int8 raw arg_
            Value'int16 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int16 raw arg_
            Value'int32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int32 raw arg_
            Value'int64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int64 raw arg_
            Value'uint8 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint8 raw arg_
            Value'uint16 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint16 raw arg_
            Value'uint32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint32 raw arg_
            Value'uint64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint64 raw arg_
            Value'float32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'float32 raw arg_
            Value'float64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'float64 raw arg_
            Value'text arg_ -> do
                field_ <- C'.cerialize (U'.message raw) arg_
                Capnp.ById.Xa93fc509624c72d9.set_Value'text raw field_
            Value'data_ arg_ -> do
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Value'data_ (BS.length arg_) raw
                C'.marshalInto field_ arg_
            Value'list arg_ -> do
                field_ <- C'.cerialize (U'.message raw) arg_
                Capnp.ById.Xa93fc509624c72d9.set_Value'list raw field_
            Value'enum arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'enum raw arg_
            Value'struct arg_ -> do
                field_ <- C'.cerialize (U'.message raw) arg_
                Capnp.ById.Xa93fc509624c72d9.set_Value'struct raw field_
            Value'interface -> Capnp.ById.Xa93fc509624c72d9.set_Value'interface raw
            Value'anyPointer arg_ -> do
                field_ <- C'.cerialize (U'.message raw) arg_
                Capnp.ById.Xa93fc509624c72d9.set_Value'anyPointer raw field_
            Value'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'unknown' raw arg_
instance C'.Cerialize s Value
instance C'.FromStruct M'.ConstMsg Value where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Value M'.ConstMsg)
instance Default Value where
    def = PH'.defaultStruct
data Brand'Binding
    = Brand'Binding'unbound
    | Brand'Binding'type_ (Type)
    | Brand'Binding'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Brand'Binding where
    type Cerial msg Brand'Binding = Capnp.ById.Xa93fc509624c72d9.Brand'Binding msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Binding' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Brand'Binding'unbound -> pure Brand'Binding'unbound
            Capnp.ById.Xa93fc509624c72d9.Brand'Binding'type_ val -> Brand'Binding'type_ <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Brand'Binding'unknown' val -> pure $ Brand'Binding'unknown' val
instance C'.Marshal Brand'Binding where
    marshalInto raw value = do
        case value of
            Brand'Binding'unbound -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Binding'unbound raw
            Brand'Binding'type_ arg_ -> do
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'Binding'type_ raw
                C'.marshalInto field_ arg_
            Brand'Binding'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' raw arg_
instance C'.Cerialize s Brand'Binding
instance C'.FromStruct M'.ConstMsg Brand'Binding where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Binding M'.ConstMsg)
instance Default Brand'Binding where
    def = PH'.defaultStruct
data Brand'Scope
    = Brand'Scope
        {scopeId :: Word64,
        union' :: Brand'Scope'}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Brand'Scope where
    type Cerial msg Brand'Scope = Capnp.ById.Xa93fc509624c72d9.Brand'Scope msg
    decerialize raw = do
        Brand'Scope <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'scopeId raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'union' raw >>= C'.decerialize)
instance C'.Marshal Brand'Scope where
    marshalInto raw value = do
        case value of
            Brand'Scope{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope'scopeId raw scopeId
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'union' raw
                C'.marshalInto field_ union'
instance C'.Cerialize s Brand'Scope
instance C'.FromStruct M'.ConstMsg Brand'Scope where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope M'.ConstMsg)
instance Default Brand'Scope where
    def = PH'.defaultStruct
data Brand'Scope'
    = Brand'Scope'bind (PU'.ListOf (Brand'Binding))
    | Brand'Scope'inherit
    | Brand'Scope'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Brand'Scope' where
    type Cerial msg Brand'Scope' = Capnp.ById.Xa93fc509624c72d9.Brand'Scope' msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Brand'Scope'bind val -> Brand'Scope'bind <$> C'.decerialize val
            Capnp.ById.Xa93fc509624c72d9.Brand'Scope'inherit -> pure Brand'Scope'inherit
            Capnp.ById.Xa93fc509624c72d9.Brand'Scope''unknown' val -> pure $ Brand'Scope'unknown' val
instance C'.Marshal Brand'Scope' where
    marshalInto raw value = do
        case value of
            Brand'Scope'bind arg_ -> do
                let len_ = V.length arg_
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'Scope'bind len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (arg_ V.! i)
            Brand'Scope'inherit -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope'inherit raw
            Brand'Scope'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope''unknown' raw arg_
instance C'.Cerialize s Brand'Scope'
instance C'.FromStruct M'.ConstMsg Brand'Scope' where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope' M'.ConstMsg)
instance Default Brand'Scope' where
    def = PH'.defaultStruct
data CodeGeneratorRequest'RequestedFile
    = CodeGeneratorRequest'RequestedFile
        {id :: Word64,
        filename :: Text,
        imports :: PU'.ListOf (CodeGeneratorRequest'RequestedFile'Import)}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize CodeGeneratorRequest'RequestedFile where
    type Cerial msg CodeGeneratorRequest'RequestedFile = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile msg
    decerialize raw = do
        CodeGeneratorRequest'RequestedFile <$>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'id raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'filename raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'imports raw >>= C'.decerialize)
instance C'.Marshal CodeGeneratorRequest'RequestedFile where
    marshalInto raw value = do
        case value of
            CodeGeneratorRequest'RequestedFile{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'id raw id
                field_ <- C'.cerialize (U'.message raw) filename
                Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'filename raw field_
                let len_ = V.length imports
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'RequestedFile'imports len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (imports V.! i)
instance C'.Cerialize s CodeGeneratorRequest'RequestedFile
instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile M'.ConstMsg)
instance Default CodeGeneratorRequest'RequestedFile where
    def = PH'.defaultStruct
data CodeGeneratorRequest'RequestedFile'Import
    = CodeGeneratorRequest'RequestedFile'Import
        {id :: Word64,
        name :: Text}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize CodeGeneratorRequest'RequestedFile'Import where
    type Cerial msg CodeGeneratorRequest'RequestedFile'Import = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import msg
    decerialize raw = do
        CodeGeneratorRequest'RequestedFile'Import <$>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'id raw) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'name raw >>= C'.decerialize)
instance C'.Marshal CodeGeneratorRequest'RequestedFile'Import where
    marshalInto raw value = do
        case value of
            CodeGeneratorRequest'RequestedFile'Import{..} -> do
                Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'id raw id
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'name raw field_
instance C'.Cerialize s CodeGeneratorRequest'RequestedFile'Import
instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile'Import where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import M'.ConstMsg)
instance Default CodeGeneratorRequest'RequestedFile'Import where
    def = PH'.defaultStruct
data Field'
    = Field'slot
        {offset :: Word32,
        type_ :: Type,
        defaultValue :: Value,
        hadExplicitDefault :: Bool}
    | Field'group
        {typeId :: Word64}
    | Field'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Field' where
    type Cerial msg Field' = Capnp.ById.Xa93fc509624c72d9.Field' msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Field'' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Field'slot raw -> Field'slot <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'offset raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'type_ raw >>= C'.decerialize) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'defaultValue raw >>= C'.decerialize) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'hadExplicitDefault raw)
            Capnp.ById.Xa93fc509624c72d9.Field'group raw -> Field'group <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Field'group'typeId raw)
            Capnp.ById.Xa93fc509624c72d9.Field''unknown' val -> pure $ Field'unknown' val
instance C'.Marshal Field' where
    marshalInto raw value = do
        case value of
            Field'slot{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Field'slot raw
                Capnp.ById.Xa93fc509624c72d9.set_Field'slot'offset raw offset
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'slot'type_ raw
                C'.marshalInto field_ type_
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'slot'defaultValue raw
                C'.marshalInto field_ defaultValue
                Capnp.ById.Xa93fc509624c72d9.set_Field'slot'hadExplicitDefault raw hadExplicitDefault
            Field'group{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Field'group raw
                Capnp.ById.Xa93fc509624c72d9.set_Field'group'typeId raw typeId
            Field'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field''unknown' raw arg_
instance C'.Cerialize s Field'
instance C'.FromStruct M'.ConstMsg Field' where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field' M'.ConstMsg)
instance Default Field' where
    def = PH'.defaultStruct
data Field'ordinal
    = Field'ordinal'implicit
    | Field'ordinal'explicit (Word16)
    | Field'ordinal'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Field'ordinal where
    type Cerial msg Field'ordinal = Capnp.ById.Xa93fc509624c72d9.Field'ordinal msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Field'ordinal'implicit -> pure Field'ordinal'implicit
            Capnp.ById.Xa93fc509624c72d9.Field'ordinal'explicit val -> pure (Field'ordinal'explicit val)
            Capnp.ById.Xa93fc509624c72d9.Field'ordinal'unknown' val -> pure $ Field'ordinal'unknown' val
instance C'.Marshal Field'ordinal where
    marshalInto raw value = do
        case value of
            Field'ordinal'implicit -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'implicit raw
            Field'ordinal'explicit arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'explicit raw arg_
            Field'ordinal'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'unknown' raw arg_
instance C'.FromStruct M'.ConstMsg Field'ordinal where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field'ordinal M'.ConstMsg)
instance Default Field'ordinal where
    def = PH'.defaultStruct
data Node'
    = Node'file
    | Node'struct
        {dataWordCount :: Word16,
        pointerCount :: Word16,
        preferredListEncoding :: Capnp.ById.Xa93fc509624c72d9.ElementSize,
        isGroup :: Bool,
        discriminantCount :: Word16,
        discriminantOffset :: Word32,
        fields :: PU'.ListOf (Field)}
    | Node'enum
        {enumerants :: PU'.ListOf (Enumerant)}
    | Node'interface
        {methods :: PU'.ListOf (Method),
        superclasses :: PU'.ListOf (Superclass)}
    | Node'const
        {type_ :: Type,
        value :: Value}
    | Node'annotation
        {type_ :: Type,
        targetsFile :: Bool,
        targetsConst :: Bool,
        targetsEnum :: Bool,
        targetsEnumerant :: Bool,
        targetsStruct :: Bool,
        targetsField :: Bool,
        targetsUnion :: Bool,
        targetsGroup :: Bool,
        targetsInterface :: Bool,
        targetsMethod :: Bool,
        targetsParam :: Bool,
        targetsAnnotation :: Bool}
    | Node'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Node' where
    type Cerial msg Node' = Capnp.ById.Xa93fc509624c72d9.Node' msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Node'' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Node'file -> pure Node'file
            Capnp.ById.Xa93fc509624c72d9.Node'struct raw -> Node'struct <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'dataWordCount raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'pointerCount raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'preferredListEncoding raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'isGroup raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'discriminantCount raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'discriminantOffset raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'fields raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Node'enum raw -> Node'enum <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'enum'enumerants raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Node'interface raw -> Node'interface <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'interface'methods raw >>= C'.decerialize) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'interface'superclasses raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Node'const raw -> Node'const <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'const'type_ raw >>= C'.decerialize) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'const'value raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Node'annotation raw -> Node'annotation <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'type_ raw >>= C'.decerialize) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsFile raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsConst raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnum raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnumerant raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsStruct raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsField raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsUnion raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsGroup raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsInterface raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsMethod raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsParam raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsAnnotation raw)
            Capnp.ById.Xa93fc509624c72d9.Node''unknown' val -> pure $ Node'unknown' val
instance C'.Marshal Node' where
    marshalInto raw value = do
        case value of
            Node'file -> Capnp.ById.Xa93fc509624c72d9.set_Node'file raw
            Node'struct{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'struct raw
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'dataWordCount raw dataWordCount
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'pointerCount raw pointerCount
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'preferredListEncoding raw preferredListEncoding
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'isGroup raw isGroup
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'discriminantCount raw discriminantCount
                Capnp.ById.Xa93fc509624c72d9.set_Node'struct'discriminantOffset raw discriminantOffset
                let len_ = V.length fields
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'struct'fields len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (fields V.! i)
            Node'enum{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'enum raw
                let len_ = V.length enumerants
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'enum'enumerants len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (enumerants V.! i)
            Node'interface{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'interface raw
                let len_ = V.length methods
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'interface'methods len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (methods V.! i)
                let len_ = V.length superclasses
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'interface'superclasses len_ raw
                forM_ [0..len_ - 1] $ \i -> do
                    elt <- C'.index i field_
                    C'.marshalInto elt (superclasses V.! i)
            Node'const{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'const raw
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'const'type_ raw
                C'.marshalInto field_ type_
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'const'value raw
                C'.marshalInto field_ value
            Node'annotation{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'annotation raw
                field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'annotation'type_ raw
                C'.marshalInto field_ type_
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsFile raw targetsFile
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsConst raw targetsConst
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnum raw targetsEnum
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnumerant raw targetsEnumerant
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsStruct raw targetsStruct
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsField raw targetsField
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsUnion raw targetsUnion
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsGroup raw targetsGroup
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsInterface raw targetsInterface
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsMethod raw targetsMethod
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsParam raw targetsParam
                Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsAnnotation raw targetsAnnotation
            Node'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Node''unknown' raw arg_
instance C'.Cerialize s Node'
instance C'.FromStruct M'.ConstMsg Node' where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node' M'.ConstMsg)
instance Default Node' where
    def = PH'.defaultStruct
data Node'NestedNode
    = Node'NestedNode
        {name :: Text,
        id :: Word64}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Node'NestedNode where
    type Cerial msg Node'NestedNode = Capnp.ById.Xa93fc509624c72d9.Node'NestedNode msg
    decerialize raw = do
        Node'NestedNode <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'NestedNode'name raw >>= C'.decerialize) <*>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'NestedNode'id raw)
instance C'.Marshal Node'NestedNode where
    marshalInto raw value = do
        case value of
            Node'NestedNode{..} -> do
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_Node'NestedNode'name raw field_
                Capnp.ById.Xa93fc509624c72d9.set_Node'NestedNode'id raw id
instance C'.Cerialize s Node'NestedNode
instance C'.FromStruct M'.ConstMsg Node'NestedNode where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'NestedNode M'.ConstMsg)
instance Default Node'NestedNode where
    def = PH'.defaultStruct
data Node'Parameter
    = Node'Parameter
        {name :: Text}
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Node'Parameter where
    type Cerial msg Node'Parameter = Capnp.ById.Xa93fc509624c72d9.Node'Parameter msg
    decerialize raw = do
        Node'Parameter <$>
            (Capnp.ById.Xa93fc509624c72d9.get_Node'Parameter'name raw >>= C'.decerialize)
instance C'.Marshal Node'Parameter where
    marshalInto raw value = do
        case value of
            Node'Parameter{..} -> do
                field_ <- C'.cerialize (U'.message raw) name
                Capnp.ById.Xa93fc509624c72d9.set_Node'Parameter'name raw field_
instance C'.Cerialize s Node'Parameter
instance C'.FromStruct M'.ConstMsg Node'Parameter where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'Parameter M'.ConstMsg)
instance Default Node'Parameter where
    def = PH'.defaultStruct
data Type'anyPointer
    = Type'anyPointer'unconstrained
        {union' :: Type'anyPointer'unconstrained}
    | Type'anyPointer'parameter
        {scopeId :: Word64,
        parameterIndex :: Word16}
    | Type'anyPointer'implicitMethodParameter
        {parameterIndex :: Word16}
    | Type'anyPointer'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Type'anyPointer where
    type Cerial msg Type'anyPointer = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained raw -> Type'anyPointer'unconstrained <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained'union' raw >>= C'.decerialize)
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'parameter raw -> Type'anyPointer'parameter <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'scopeId raw) <*>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'parameterIndex raw)
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter raw -> Type'anyPointer'implicitMethodParameter <$>
                (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'implicitMethodParameter'parameterIndex raw)
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unknown' val -> pure $ Type'anyPointer'unknown' val
instance C'.Marshal Type'anyPointer where
    marshalInto raw value = do
        case value of
            Type'anyPointer'unconstrained{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained raw
                field_ <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained'union' raw
                C'.marshalInto field_ union'
            Type'anyPointer'parameter{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter raw
                Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'scopeId raw scopeId
                Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'parameterIndex raw parameterIndex
            Type'anyPointer'implicitMethodParameter{..} -> do
                raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter raw
                Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter'parameterIndex raw parameterIndex
            Type'anyPointer'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unknown' raw arg_
instance C'.FromStruct M'.ConstMsg Type'anyPointer where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer M'.ConstMsg)
instance Default Type'anyPointer where
    def = PH'.defaultStruct
data Type'anyPointer'unconstrained
    = Type'anyPointer'unconstrained'anyKind
    | Type'anyPointer'unconstrained'struct
    | Type'anyPointer'unconstrained'list
    | Type'anyPointer'unconstrained'capability
    | Type'anyPointer'unconstrained'unknown' Word16
    deriving(Show,Read,Eq,Generic)
instance C'.Decerialize Type'anyPointer'unconstrained where
    type Cerial msg Type'anyPointer'unconstrained = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained msg
    decerialize raw = do
        raw <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained' raw
        case raw of
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'anyKind -> pure Type'anyPointer'unconstrained'anyKind
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'struct -> pure Type'anyPointer'unconstrained'struct
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'list -> pure Type'anyPointer'unconstrained'list
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'capability -> pure Type'anyPointer'unconstrained'capability
            Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'unknown' val -> pure $ Type'anyPointer'unconstrained'unknown' val
instance C'.Marshal Type'anyPointer'unconstrained where
    marshalInto raw value = do
        case value of
            Type'anyPointer'unconstrained'anyKind -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'anyKind raw
            Type'anyPointer'unconstrained'struct -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'struct raw
            Type'anyPointer'unconstrained'list -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'list raw
            Type'anyPointer'unconstrained'capability -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'capability raw
            Type'anyPointer'unconstrained'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'unknown' raw arg_
instance C'.FromStruct M'.ConstMsg Type'anyPointer'unconstrained where
    fromStruct struct = do
        raw <- C'.fromStruct struct
        C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained M'.ConstMsg)
instance Default Type'anyPointer'unconstrained where
    def = PH'.defaultStruct