{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Capnp.Gen.Capnp.Schema.Pure(Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize(..)
                                  ,Node(..)
                                  ,Node'(..)
                                  ,Node'struct(..)
                                  ,Node'enum(..)
                                  ,Node'interface(..)
                                  ,Node'const(..)
                                  ,Node'annotation(..)
                                  ,Node'Parameter(..)
                                  ,Node'NestedNode(..)
                                  ,Node'SourceInfo(..)
                                  ,Node'SourceInfo'Member(..)
                                  ,Field(..)
                                  ,Field'(..)
                                  ,Field'slot(..)
                                  ,Field'group(..)
                                  ,Field'ordinal(..)
                                  ,Capnp.Gen.ById.Xa93fc509624c72d9.field'noDiscriminant
                                  ,Enumerant(..)
                                  ,Superclass(..)
                                  ,Method(..)
                                  ,Type(..)
                                  ,Type'list(..)
                                  ,Type'enum(..)
                                  ,Type'struct(..)
                                  ,Type'interface(..)
                                  ,Type'anyPointer(..)
                                  ,Type'anyPointer'unconstrained(..)
                                  ,Type'anyPointer'parameter(..)
                                  ,Type'anyPointer'implicitMethodParameter(..)
                                  ,Brand(..)
                                  ,Brand'Scope(..)
                                  ,Brand'Scope'(..)
                                  ,Brand'Binding(..)
                                  ,Value(..)
                                  ,Annotation(..)
                                  ,CapnpVersion(..)
                                  ,CodeGeneratorRequest(..)
                                  ,CodeGeneratorRequest'RequestedFile(..)
                                  ,CodeGeneratorRequest'RequestedFile'Import(..)) where
import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
import qualified Capnp.GenHelpers.ReExports.Data.Text as T
import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
import qualified GHC.Generics as Generics
import qualified Control.Monad.IO.Class as MonadIO
import qualified Capnp.Untyped.Pure as UntypedPure
import qualified Capnp.Untyped as Untyped
import qualified Capnp.Message as Message
import qualified Capnp.Classes as Classes
import qualified Capnp.Basics.Pure as BasicsPure
import qualified Capnp.GenHelpers.Pure as GenHelpersPure
import qualified Capnp.Gen.ById.Xa93fc509624c72d9
import qualified Prelude as Std_
import qualified Data.Word as Std_
import qualified Data.Int as Std_
import Prelude ((<$>), (<*>), (>>=))
data Node 
    = Node 
        {Node -> Word64
id :: Std_.Word64
        ,Node -> Text
displayName :: T.Text
        ,Node -> Word32
displayNamePrefixLength :: Std_.Word32
        ,Node -> Word64
scopeId :: Std_.Word64
        ,Node -> Vector Node'NestedNode
nestedNodes :: (V.Vector Node'NestedNode)
        ,Node -> Vector Annotation
annotations :: (V.Vector Annotation)
        ,Node -> Vector Node'Parameter
parameters :: (V.Vector Node'Parameter)
        ,Node -> Bool
isGeneric :: Std_.Bool
        ,Node -> Node'
union' :: Node'}
    deriving(Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Std_.Show
            ,Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Std_.Eq
            ,(forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generics.Generic)
instance (Default.Default Node) where
    def :: Node
def  = Node
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node) where
    fromStruct :: Struct 'Const -> m Node
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node 'Const) -> (Node 'Const -> m Node) -> m Node
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node 'Const -> m Node
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node) where
    type Cerial msg Node = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
    decerialize :: Cerial 'Const Node -> m Node
decerialize Cerial 'Const Node
raw = (Word64
-> Text
-> Word32
-> Word64
-> Vector Node'NestedNode
-> Vector Annotation
-> Vector Node'Parameter
-> Bool
-> Node'
-> Node
Node (Word64
 -> Text
 -> Word32
 -> Word64
 -> Vector Node'NestedNode
 -> Vector Annotation
 -> Vector Node'Parameter
 -> Bool
 -> Node'
 -> Node)
-> m Word64
-> m (Text
      -> Word32
      -> Word64
      -> Vector Node'NestedNode
      -> Vector Annotation
      -> Vector Node'Parameter
      -> Bool
      -> Node'
      -> Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'id Cerial 'Const Node
Node 'Const
raw)
                            m (Text
   -> Word32
   -> Word64
   -> Vector Node'NestedNode
   -> Vector Annotation
   -> Vector Node'Parameter
   -> Bool
   -> Node'
   -> Node)
-> m Text
-> m (Word32
      -> Word64
      -> Vector Node'NestedNode
      -> Vector Annotation
      -> Vector Node'Parameter
      -> Bool
      -> Node'
      -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayName Cerial 'Const Node
Node 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                            m (Word32
   -> Word64
   -> Vector Node'NestedNode
   -> Vector Annotation
   -> Vector Node'Parameter
   -> Bool
   -> Node'
   -> Node)
-> m Word32
-> m (Word64
      -> Vector Node'NestedNode
      -> Vector Annotation
      -> Vector Node'Parameter
      -> Bool
      -> Node'
      -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node 'Const -> m Word32
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayNamePrefixLength Cerial 'Const Node
Node 'Const
raw)
                            m (Word64
   -> Vector Node'NestedNode
   -> Vector Annotation
   -> Vector Node'Parameter
   -> Bool
   -> Node'
   -> Node)
-> m Word64
-> m (Vector Node'NestedNode
      -> Vector Annotation
      -> Vector Node'Parameter
      -> Bool
      -> Node'
      -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'scopeId Cerial 'Const Node
Node 'Const
raw)
                            m (Vector Node'NestedNode
   -> Vector Annotation
   -> Vector Node'Parameter
   -> Bool
   -> Node'
   -> Node)
-> m (Vector Node'NestedNode)
-> m (Vector Annotation
      -> Vector Node'Parameter -> Bool -> Node' -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node 'Const -> m (List 'Const (Node'NestedNode 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Node'NestedNode msg))) =>
Node msg -> m (List msg (Node'NestedNode msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'nestedNodes Cerial 'Const Node
Node 'Const
raw) m (List 'Const (Node'NestedNode 'Const))
-> (List 'Const (Node'NestedNode 'Const)
    -> m (Vector Node'NestedNode))
-> m (Vector Node'NestedNode)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node'NestedNode 'Const) -> m (Vector Node'NestedNode)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                            m (Vector Annotation
   -> Vector Node'Parameter -> Bool -> Node' -> Node)
-> m (Vector Annotation)
-> m (Vector Node'Parameter -> Bool -> Node' -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node 'Const -> m (List 'Const (Annotation 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Node msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotations Cerial 'Const Node
Node 'Const
raw) m (List 'Const (Annotation 'Const))
-> (List 'Const (Annotation 'Const) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Annotation 'Const) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                            m (Vector Node'Parameter -> Bool -> Node' -> Node)
-> m (Vector Node'Parameter) -> m (Bool -> Node' -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node 'Const -> m (List 'Const (Node'Parameter 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Node'Parameter msg))) =>
Node msg -> m (List msg (Node'Parameter msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'parameters Cerial 'Const Node
Node 'Const
raw) m (List 'Const (Node'Parameter 'Const))
-> (List 'Const (Node'Parameter 'Const)
    -> m (Vector Node'Parameter))
-> m (Vector Node'Parameter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node'Parameter 'Const) -> m (Vector Node'Parameter)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                            m (Bool -> Node' -> Node) -> m Bool -> m (Node' -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'isGeneric Cerial 'Const Node
Node 'Const
raw)
                            m (Node' -> Node) -> m Node' -> m Node
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cerial 'Const Node' -> m Node'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'
Cerial 'Const Node
raw))
instance (Classes.Marshal s Node) where
    marshalInto :: Cerial ('Mut s) Node -> Node -> m ()
marshalInto Cerial ('Mut s) Node
raw_ Node
value_ = case Node
value_ of
        Node{Bool
Word32
Word64
Text
Vector Annotation
Vector Node'NestedNode
Vector Node'Parameter
Node'
union' :: Node'
isGeneric :: Bool
parameters :: Vector Node'Parameter
annotations :: Vector Annotation
nestedNodes :: Vector Node'NestedNode
scopeId :: Word64
displayNamePrefixLength :: Word32
displayName :: Text
id :: Word64
$sel:union':Node :: Node -> Node'
$sel:isGeneric:Node :: Node -> Bool
$sel:parameters:Node :: Node -> Vector Node'Parameter
$sel:annotations:Node :: Node -> Vector Annotation
$sel:nestedNodes:Node :: Node -> Vector Node'NestedNode
$sel:scopeId:Node :: Node -> Word64
$sel:displayNamePrefixLength:Node :: Node -> Word32
$sel:displayName:Node :: Node -> Text
$sel:id:Node :: Node -> Word64
..} ->
            (do
                (Node ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'id Cerial ('Mut s) Node
Node ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node
Node ('Mut s)
raw_) Text
displayName) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Node ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayName Cerial ('Mut s) Node
Node ('Mut s)
raw_))
                (Node ('Mut s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node ('Mut s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayNamePrefixLength Cerial ('Mut s) Node
Node ('Mut s)
raw_ Word32
displayNamePrefixLength)
                (Node ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'scopeId Cerial ('Mut s) Node
Node ('Mut s)
raw_ Word64
scopeId)
                ((Message ('Mut s)
-> Vector Node'NestedNode
-> m (Cerial ('Mut s) (Vector Node'NestedNode))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node
Node ('Mut s)
raw_) Vector Node'NestedNode
nestedNodes) m (List ('Mut s) (Node'NestedNode ('Mut s)))
-> (List ('Mut s) (Node'NestedNode ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node ('Mut s) -> List ('Mut s) (Node'NestedNode ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Node'NestedNode ('Mut s)))) =>
Node ('Mut s) -> List ('Mut s) (Node'NestedNode ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'nestedNodes Cerial ('Mut s) Node
Node ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node
Node ('Mut s)
raw_) Vector Annotation
annotations) m (List ('Mut s) (Annotation ('Mut s)))
-> (List ('Mut s) (Annotation ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Annotation ('Mut s)))) =>
Node ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotations Cerial ('Mut s) Node
Node ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Node'Parameter
-> m (Cerial ('Mut s) (Vector Node'Parameter))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node
Node ('Mut s)
raw_) Vector Node'Parameter
parameters) m (List ('Mut s) (Node'Parameter ('Mut s)))
-> (List ('Mut s) (Node'Parameter ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node ('Mut s) -> List ('Mut s) (Node'Parameter ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Node'Parameter ('Mut s)))) =>
Node ('Mut s) -> List ('Mut s) (Node'Parameter ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'parameters Cerial ('Mut s) Node
Node ('Mut s)
raw_))
                (Node ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s. RWCtx m s => Node ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'isGeneric Cerial ('Mut s) Node
Node ('Mut s)
raw_ Bool
isGeneric)
                (do
                    (Cerial ('Mut s) Node' -> Node' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'
Cerial ('Mut s) Node
raw_ Node'
union')
                    )
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Node)
instance (Classes.Cerialize s (V.Vector Node)) where
    cerialize :: Message ('Mut s)
-> Vector Node -> m (Cerial ('Mut s) (Vector Node))
cerialize  = Message ('Mut s)
-> Vector Node -> m (Cerial ('Mut s) (Vector Node))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Node))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Node)
-> m (Cerial ('Mut s) (Vector (Vector Node)))
cerialize  = Message ('Mut s)
-> Vector (Vector Node)
-> m (Cerial ('Mut s) (Vector (Vector Node)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Node)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Node))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Node))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Node))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Node)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Node)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Node)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Node)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Node))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Node))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Node)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Node)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Node)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Node)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Node))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Node))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Node))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Node))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Node' 
    = Node'file 
    | Node'struct Node'struct
    | Node'enum Node'enum
    | Node'interface Node'interface
    | Node'const Node'const
    | Node'annotation Node'annotation
    | Node'unknown' Std_.Word16
    deriving(Int -> Node' -> ShowS
[Node'] -> ShowS
Node' -> String
(Int -> Node' -> ShowS)
-> (Node' -> String) -> ([Node'] -> ShowS) -> Show Node'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'] -> ShowS
$cshowList :: [Node'] -> ShowS
show :: Node' -> String
$cshow :: Node' -> String
showsPrec :: Int -> Node' -> ShowS
$cshowsPrec :: Int -> Node' -> ShowS
Std_.Show
            ,Node' -> Node' -> Bool
(Node' -> Node' -> Bool) -> (Node' -> Node' -> Bool) -> Eq Node'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node' -> Node' -> Bool
$c/= :: Node' -> Node' -> Bool
== :: Node' -> Node' -> Bool
$c== :: Node' -> Node' -> Bool
Std_.Eq
            ,(forall x. Node' -> Rep Node' x)
-> (forall x. Rep Node' x -> Node') -> Generic Node'
forall x. Rep Node' x -> Node'
forall x. Node' -> Rep Node' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node' x -> Node'
$cfrom :: forall x. Node' -> Rep Node' x
Generics.Generic)
instance (Default.Default Node') where
    def :: Node'
def  = Node'
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node') where
    fromStruct :: Struct 'Const -> m Node'
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node 'Const) -> (Node 'Const -> m Node') -> m Node'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node 'Const -> m Node'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node') where
    type Cerial msg Node' = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
    decerialize :: Cerial 'Const Node' -> m Node'
decerialize Cerial 'Const Node'
raw = (do
        Node' 'Const
raw <- (Node 'Const -> m (Node' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Node' msg)) =>
Node msg -> m (Node' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node' Cerial 'Const Node'
Node 'Const
raw)
        case Node' 'Const
raw of
            (Node' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Node'file) ->
                (Node' -> m Node'
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Node'
Node'file)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'struct Node'struct 'Const
raw) ->
                (Node'struct -> Node'
Node'struct (Node'struct -> Node') -> m Node'struct -> m Node'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Node'struct -> m Node'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'struct
Node'struct 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'enum Node'enum 'Const
raw) ->
                (Node'enum -> Node'
Node'enum (Node'enum -> Node') -> m Node'enum -> m Node'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Node'enum -> m Node'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'enum
Node'enum 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'interface Node'interface 'Const
raw) ->
                (Node'interface -> Node'
Node'interface (Node'interface -> Node') -> m Node'interface -> m Node'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Node'interface -> m Node'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'interface
Node'interface 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'const Node'const 'Const
raw) ->
                (Node'const -> Node'
Node'const (Node'const -> Node') -> m Node'const -> m Node'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Node'const -> m Node'const
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'const
Node'const 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'annotation Node'annotation 'Const
raw) ->
                (Node'annotation -> Node'
Node'annotation (Node'annotation -> Node') -> m Node'annotation -> m Node'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Node'annotation -> m Node'annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Node'annotation
Node'annotation 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'unknown' Word16
tag) ->
                (Node' -> m Node'
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Node'
Node'unknown' Word16
tag))
        )
instance (Classes.Marshal s Node') where
    marshalInto :: Cerial ('Mut s) Node' -> Node' -> m ()
marshalInto Cerial ('Mut s) Node'
raw_ Node'
value_ = case Node'
value_ of
        (Node'
Node'file) ->
            (Node ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Node ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'file Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
        (Node'struct Node'struct
arg_) ->
            (do
                Node'struct ('Mut s)
raw_ <- (Node ('Mut s) -> m (Node'struct ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Node'struct ('Mut s))) =>
Node ('Mut s) -> m (Node'struct ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
                (Cerial ('Mut s) Node'struct -> Node'struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Node'struct
arg_)
                )
        (Node'enum Node'enum
arg_) ->
            (do
                Node'enum ('Mut s)
raw_ <- (Node ('Mut s) -> m (Node'enum ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Node'enum ('Mut s))) =>
Node ('Mut s) -> m (Node'enum ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
                (Cerial ('Mut s) Node'enum -> Node'enum -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'enum
Node'enum ('Mut s)
raw_ Node'enum
arg_)
                )
        (Node'interface Node'interface
arg_) ->
            (do
                Node'interface ('Mut s)
raw_ <- (Node ('Mut s) -> m (Node'interface ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Node'interface ('Mut s))) =>
Node ('Mut s) -> m (Node'interface ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
                (Cerial ('Mut s) Node'interface -> Node'interface -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'interface
Node'interface ('Mut s)
raw_ Node'interface
arg_)
                )
        (Node'const Node'const
arg_) ->
            (do
                Node'const ('Mut s)
raw_ <- (Node ('Mut s) -> m (Node'const ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Node'const ('Mut s))) =>
Node ('Mut s) -> m (Node'const ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
                (Cerial ('Mut s) Node'const -> Node'const -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'const
Node'const ('Mut s)
raw_ Node'const
arg_)
                )
        (Node'annotation Node'annotation
arg_) ->
            (do
                Node'annotation ('Mut s)
raw_ <- (Node ('Mut s) -> m (Node'annotation ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Node'annotation ('Mut s))) =>
Node ('Mut s) -> m (Node'annotation ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation Cerial ('Mut s) Node'
Node ('Mut s)
raw_)
                (Cerial ('Mut s) Node'annotation -> Node'annotation -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Node'annotation
arg_)
                )
        (Node'unknown' Word16
tag) ->
            (Node ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'unknown' Cerial ('Mut s) Node'
Node ('Mut s)
raw_ Word16
tag)
data Node'struct 
    = Node'struct' 
        {Node'struct -> Word16
dataWordCount :: Std_.Word16
        ,Node'struct -> Word16
pointerCount :: Std_.Word16
        ,Node'struct -> ElementSize
preferredListEncoding :: Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize
        ,Node'struct -> Bool
isGroup :: Std_.Bool
        ,Node'struct -> Word16
discriminantCount :: Std_.Word16
        ,Node'struct -> Word32
discriminantOffset :: Std_.Word32
        ,Node'struct -> Vector Field
fields :: (V.Vector Field)}
    deriving(Int -> Node'struct -> ShowS
[Node'struct] -> ShowS
Node'struct -> String
(Int -> Node'struct -> ShowS)
-> (Node'struct -> String)
-> ([Node'struct] -> ShowS)
-> Show Node'struct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'struct] -> ShowS
$cshowList :: [Node'struct] -> ShowS
show :: Node'struct -> String
$cshow :: Node'struct -> String
showsPrec :: Int -> Node'struct -> ShowS
$cshowsPrec :: Int -> Node'struct -> ShowS
Std_.Show
            ,Node'struct -> Node'struct -> Bool
(Node'struct -> Node'struct -> Bool)
-> (Node'struct -> Node'struct -> Bool) -> Eq Node'struct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'struct -> Node'struct -> Bool
$c/= :: Node'struct -> Node'struct -> Bool
== :: Node'struct -> Node'struct -> Bool
$c== :: Node'struct -> Node'struct -> Bool
Std_.Eq
            ,(forall x. Node'struct -> Rep Node'struct x)
-> (forall x. Rep Node'struct x -> Node'struct)
-> Generic Node'struct
forall x. Rep Node'struct x -> Node'struct
forall x. Node'struct -> Rep Node'struct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'struct x -> Node'struct
$cfrom :: forall x. Node'struct -> Rep Node'struct x
Generics.Generic)
instance (Default.Default Node'struct) where
    def :: Node'struct
def  = Node'struct
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'struct) where
    fromStruct :: Struct 'Const -> m Node'struct
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'struct 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'struct 'Const)
-> (Node'struct 'Const -> m Node'struct) -> m Node'struct
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'struct 'Const -> m Node'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'struct) where
    type Cerial msg Node'struct = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'struct msg)
    decerialize :: Cerial 'Const Node'struct -> m Node'struct
decerialize Cerial 'Const Node'struct
raw = (Word16
-> Word16
-> ElementSize
-> Bool
-> Word16
-> Word32
-> Vector Field
-> Node'struct
Node'struct' (Word16
 -> Word16
 -> ElementSize
 -> Bool
 -> Word16
 -> Word32
 -> Vector Field
 -> Node'struct)
-> m Word16
-> m (Word16
      -> ElementSize
      -> Bool
      -> Word16
      -> Word32
      -> Vector Field
      -> Node'struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node'struct 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'dataWordCount Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (Word16
   -> ElementSize
   -> Bool
   -> Word16
   -> Word32
   -> Vector Field
   -> Node'struct)
-> m Word16
-> m (ElementSize
      -> Bool -> Word16 -> Word32 -> Vector Field -> Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'struct 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'pointerCount Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (ElementSize
   -> Bool -> Word16 -> Word32 -> Vector Field -> Node'struct)
-> m ElementSize
-> m (Bool -> Word16 -> Word32 -> Vector Field -> Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'struct 'Const -> m ElementSize
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m ElementSize
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'preferredListEncoding Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (Bool -> Word16 -> Word32 -> Vector Field -> Node'struct)
-> m Bool -> m (Word16 -> Word32 -> Vector Field -> Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'struct 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'isGroup Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (Word16 -> Word32 -> Vector Field -> Node'struct)
-> m Word16 -> m (Word32 -> Vector Field -> Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'struct 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantCount Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (Word32 -> Vector Field -> Node'struct)
-> m Word32 -> m (Vector Field -> Node'struct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'struct 'Const -> m Word32
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'struct msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantOffset Cerial 'Const Node'struct
Node'struct 'Const
raw)
                                    m (Vector Field -> Node'struct)
-> m (Vector Field) -> m Node'struct
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node'struct 'Const -> m (List 'Const (Field 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Field msg))) =>
Node'struct msg -> m (List msg (Field msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'fields Cerial 'Const Node'struct
Node'struct 'Const
raw) m (List 'Const (Field 'Const))
-> (List 'Const (Field 'Const) -> m (Vector Field))
-> m (Vector Field)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Field 'Const) -> m (Vector Field)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'struct) where
    marshalInto :: Cerial ('Mut s) Node'struct -> Node'struct -> m ()
marshalInto Cerial ('Mut s) Node'struct
raw_ Node'struct
value_ = case Node'struct
value_ of
        Node'struct'{Bool
Word16
Word32
Vector Field
ElementSize
fields :: Vector Field
discriminantOffset :: Word32
discriminantCount :: Word16
isGroup :: Bool
preferredListEncoding :: ElementSize
pointerCount :: Word16
dataWordCount :: Word16
$sel:fields:Node'struct' :: Node'struct -> Vector Field
$sel:discriminantOffset:Node'struct' :: Node'struct -> Word32
$sel:discriminantCount:Node'struct' :: Node'struct -> Word16
$sel:isGroup:Node'struct' :: Node'struct -> Bool
$sel:preferredListEncoding:Node'struct' :: Node'struct -> ElementSize
$sel:pointerCount:Node'struct' :: Node'struct -> Word16
$sel:dataWordCount:Node'struct' :: Node'struct -> Word16
..} ->
            (do
                (Node'struct ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'dataWordCount Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Word16
dataWordCount)
                (Node'struct ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'pointerCount Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Word16
pointerCount)
                (Node'struct ('Mut s) -> ElementSize -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> ElementSize -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'preferredListEncoding Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ ElementSize
preferredListEncoding)
                (Node'struct ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'isGroup Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Bool
isGroup)
                (Node'struct ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantCount Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Word16
discriminantCount)
                (Node'struct ('Mut s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct ('Mut s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantOffset Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_ Word32
discriminantOffset)
                ((Message ('Mut s)
-> Vector Field -> m (Cerial ('Mut s) (Vector Field))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_) Vector Field
fields) m (List ('Mut s) (Field ('Mut s)))
-> (List ('Mut s) (Field ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'struct ('Mut s) -> List ('Mut s) (Field ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Field ('Mut s)))) =>
Node'struct ('Mut s) -> List ('Mut s) (Field ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'fields Cerial ('Mut s) Node'struct
Node'struct ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Node'enum 
    = Node'enum' 
        {Node'enum -> Vector Enumerant
enumerants :: (V.Vector Enumerant)}
    deriving(Int -> Node'enum -> ShowS
[Node'enum] -> ShowS
Node'enum -> String
(Int -> Node'enum -> ShowS)
-> (Node'enum -> String)
-> ([Node'enum] -> ShowS)
-> Show Node'enum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'enum] -> ShowS
$cshowList :: [Node'enum] -> ShowS
show :: Node'enum -> String
$cshow :: Node'enum -> String
showsPrec :: Int -> Node'enum -> ShowS
$cshowsPrec :: Int -> Node'enum -> ShowS
Std_.Show
            ,Node'enum -> Node'enum -> Bool
(Node'enum -> Node'enum -> Bool)
-> (Node'enum -> Node'enum -> Bool) -> Eq Node'enum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'enum -> Node'enum -> Bool
$c/= :: Node'enum -> Node'enum -> Bool
== :: Node'enum -> Node'enum -> Bool
$c== :: Node'enum -> Node'enum -> Bool
Std_.Eq
            ,(forall x. Node'enum -> Rep Node'enum x)
-> (forall x. Rep Node'enum x -> Node'enum) -> Generic Node'enum
forall x. Rep Node'enum x -> Node'enum
forall x. Node'enum -> Rep Node'enum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'enum x -> Node'enum
$cfrom :: forall x. Node'enum -> Rep Node'enum x
Generics.Generic)
instance (Default.Default Node'enum) where
    def :: Node'enum
def  = Node'enum
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'enum) where
    fromStruct :: Struct 'Const -> m Node'enum
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'enum 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'enum 'Const)
-> (Node'enum 'Const -> m Node'enum) -> m Node'enum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'enum 'Const -> m Node'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'enum) where
    type Cerial msg Node'enum = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'enum msg)
    decerialize :: Cerial 'Const Node'enum -> m Node'enum
decerialize Cerial 'Const Node'enum
raw = (Vector Enumerant -> Node'enum
Node'enum' (Vector Enumerant -> Node'enum)
-> m (Vector Enumerant) -> m Node'enum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'enum 'Const -> m (List 'Const (Enumerant 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Enumerant msg))) =>
Node'enum msg -> m (List msg (Enumerant msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'enum'enumerants Cerial 'Const Node'enum
Node'enum 'Const
raw) m (List 'Const (Enumerant 'Const))
-> (List 'Const (Enumerant 'Const) -> m (Vector Enumerant))
-> m (Vector Enumerant)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Enumerant 'Const) -> m (Vector Enumerant)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'enum) where
    marshalInto :: Cerial ('Mut s) Node'enum -> Node'enum -> m ()
marshalInto Cerial ('Mut s) Node'enum
raw_ Node'enum
value_ = case Node'enum
value_ of
        Node'enum'{Vector Enumerant
enumerants :: Vector Enumerant
$sel:enumerants:Node'enum' :: Node'enum -> Vector Enumerant
..} ->
            (do
                ((Message ('Mut s)
-> Vector Enumerant -> m (Cerial ('Mut s) (Vector Enumerant))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'enum ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'enum
Node'enum ('Mut s)
raw_) Vector Enumerant
enumerants) m (List ('Mut s) (Enumerant ('Mut s)))
-> (List ('Mut s) (Enumerant ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'enum ('Mut s) -> List ('Mut s) (Enumerant ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Enumerant ('Mut s)))) =>
Node'enum ('Mut s) -> List ('Mut s) (Enumerant ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum'enumerants Cerial ('Mut s) Node'enum
Node'enum ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Node'interface 
    = Node'interface' 
        {Node'interface -> Vector Method
methods :: (V.Vector Method)
        ,Node'interface -> Vector Superclass
superclasses :: (V.Vector Superclass)}
    deriving(Int -> Node'interface -> ShowS
[Node'interface] -> ShowS
Node'interface -> String
(Int -> Node'interface -> ShowS)
-> (Node'interface -> String)
-> ([Node'interface] -> ShowS)
-> Show Node'interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'interface] -> ShowS
$cshowList :: [Node'interface] -> ShowS
show :: Node'interface -> String
$cshow :: Node'interface -> String
showsPrec :: Int -> Node'interface -> ShowS
$cshowsPrec :: Int -> Node'interface -> ShowS
Std_.Show
            ,Node'interface -> Node'interface -> Bool
(Node'interface -> Node'interface -> Bool)
-> (Node'interface -> Node'interface -> Bool) -> Eq Node'interface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'interface -> Node'interface -> Bool
$c/= :: Node'interface -> Node'interface -> Bool
== :: Node'interface -> Node'interface -> Bool
$c== :: Node'interface -> Node'interface -> Bool
Std_.Eq
            ,(forall x. Node'interface -> Rep Node'interface x)
-> (forall x. Rep Node'interface x -> Node'interface)
-> Generic Node'interface
forall x. Rep Node'interface x -> Node'interface
forall x. Node'interface -> Rep Node'interface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'interface x -> Node'interface
$cfrom :: forall x. Node'interface -> Rep Node'interface x
Generics.Generic)
instance (Default.Default Node'interface) where
    def :: Node'interface
def  = Node'interface
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'interface) where
    fromStruct :: Struct 'Const -> m Node'interface
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'interface 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'interface 'Const)
-> (Node'interface 'Const -> m Node'interface) -> m Node'interface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'interface 'Const -> m Node'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'interface) where
    type Cerial msg Node'interface = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'interface msg)
    decerialize :: Cerial 'Const Node'interface -> m Node'interface
decerialize Cerial 'Const Node'interface
raw = (Vector Method -> Vector Superclass -> Node'interface
Node'interface' (Vector Method -> Vector Superclass -> Node'interface)
-> m (Vector Method) -> m (Vector Superclass -> Node'interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'interface 'Const -> m (List 'Const (Method 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Method msg))) =>
Node'interface msg -> m (List msg (Method msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'interface'methods Cerial 'Const Node'interface
Node'interface 'Const
raw) m (List 'Const (Method 'Const))
-> (List 'Const (Method 'Const) -> m (Vector Method))
-> m (Vector Method)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Method 'Const) -> m (Vector Method)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                       m (Vector Superclass -> Node'interface)
-> m (Vector Superclass) -> m Node'interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node'interface 'Const -> m (List 'Const (Superclass 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Superclass msg))) =>
Node'interface msg -> m (List msg (Superclass msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'interface'superclasses Cerial 'Const Node'interface
Node'interface 'Const
raw) m (List 'Const (Superclass 'Const))
-> (List 'Const (Superclass 'Const) -> m (Vector Superclass))
-> m (Vector Superclass)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Superclass 'Const) -> m (Vector Superclass)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'interface) where
    marshalInto :: Cerial ('Mut s) Node'interface -> Node'interface -> m ()
marshalInto Cerial ('Mut s) Node'interface
raw_ Node'interface
value_ = case Node'interface
value_ of
        Node'interface'{Vector Method
Vector Superclass
superclasses :: Vector Superclass
methods :: Vector Method
$sel:superclasses:Node'interface' :: Node'interface -> Vector Superclass
$sel:methods:Node'interface' :: Node'interface -> Vector Method
..} ->
            (do
                ((Message ('Mut s)
-> Vector Method -> m (Cerial ('Mut s) (Vector Method))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'interface ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'interface
Node'interface ('Mut s)
raw_) Vector Method
methods) m (List ('Mut s) (Method ('Mut s)))
-> (List ('Mut s) (Method ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'interface ('Mut s) -> List ('Mut s) (Method ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Method ('Mut s)))) =>
Node'interface ('Mut s) -> List ('Mut s) (Method ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'methods Cerial ('Mut s) Node'interface
Node'interface ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Superclass -> m (Cerial ('Mut s) (Vector Superclass))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'interface ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'interface
Node'interface ('Mut s)
raw_) Vector Superclass
superclasses) m (List ('Mut s) (Superclass ('Mut s)))
-> (List ('Mut s) (Superclass ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'interface ('Mut s)
-> List ('Mut s) (Superclass ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Superclass ('Mut s)))) =>
Node'interface ('Mut s)
-> List ('Mut s) (Superclass ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'superclasses Cerial ('Mut s) Node'interface
Node'interface ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Node'const 
    = Node'const' 
        {Node'const -> Type
type_ :: Type
        ,Node'const -> Value
value :: Value}
    deriving(Int -> Node'const -> ShowS
[Node'const] -> ShowS
Node'const -> String
(Int -> Node'const -> ShowS)
-> (Node'const -> String)
-> ([Node'const] -> ShowS)
-> Show Node'const
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'const] -> ShowS
$cshowList :: [Node'const] -> ShowS
show :: Node'const -> String
$cshow :: Node'const -> String
showsPrec :: Int -> Node'const -> ShowS
$cshowsPrec :: Int -> Node'const -> ShowS
Std_.Show
            ,Node'const -> Node'const -> Bool
(Node'const -> Node'const -> Bool)
-> (Node'const -> Node'const -> Bool) -> Eq Node'const
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'const -> Node'const -> Bool
$c/= :: Node'const -> Node'const -> Bool
== :: Node'const -> Node'const -> Bool
$c== :: Node'const -> Node'const -> Bool
Std_.Eq
            ,(forall x. Node'const -> Rep Node'const x)
-> (forall x. Rep Node'const x -> Node'const) -> Generic Node'const
forall x. Rep Node'const x -> Node'const
forall x. Node'const -> Rep Node'const x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'const x -> Node'const
$cfrom :: forall x. Node'const -> Rep Node'const x
Generics.Generic)
instance (Default.Default Node'const) where
    def :: Node'const
def  = Node'const
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'const) where
    fromStruct :: Struct 'Const -> m Node'const
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'const 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'const 'Const)
-> (Node'const 'Const -> m Node'const) -> m Node'const
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'const 'Const -> m Node'const
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'const) where
    type Cerial msg Node'const = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'const msg)
    decerialize :: Cerial 'Const Node'const -> m Node'const
decerialize Cerial 'Const Node'const
raw = (Type -> Value -> Node'const
Node'const' (Type -> Value -> Node'const) -> m Type -> m (Value -> Node'const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'const 'Const -> m (Type 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Node'const msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'type_ Cerial 'Const Node'const
Node'const 'Const
raw) m (Type 'Const) -> (Type 'Const -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type 'Const -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                   m (Value -> Node'const) -> m Value -> m Node'const
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node'const 'Const -> m (Value 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Node'const msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'value Cerial 'Const Node'const
Node'const 'Const
raw) m (Value 'Const) -> (Value 'Const -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value 'Const -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'const) where
    marshalInto :: Cerial ('Mut s) Node'const -> Node'const -> m ()
marshalInto Cerial ('Mut s) Node'const
raw_ Node'const
value_ = case Node'const
value_ of
        Node'const'{Value
Type
value :: Value
type_ :: Type
$sel:value:Node'const' :: Node'const -> Value
$sel:type_:Node'const' :: Node'const -> Type
..} ->
            (do
                ((Message ('Mut s) -> Type -> m (Cerial ('Mut s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'const ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'const
Node'const ('Mut s)
raw_) Type
type_) m (Type ('Mut s)) -> (Type ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'const ('Mut s) -> Type ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type ('Mut s))) =>
Node'const ('Mut s) -> Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'type_ Cerial ('Mut s) Node'const
Node'const ('Mut s)
raw_))
                ((Message ('Mut s) -> Value -> m (Cerial ('Mut s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'const ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'const
Node'const ('Mut s)
raw_) Value
value) m (Value ('Mut s)) -> (Value ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'const ('Mut s) -> Value ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value ('Mut s))) =>
Node'const ('Mut s) -> Value ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'value Cerial ('Mut s) Node'const
Node'const ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Node'annotation 
    = Node'annotation' 
        {Node'annotation -> Type
type_ :: Type
        ,Node'annotation -> Bool
targetsFile :: Std_.Bool
        ,Node'annotation -> Bool
targetsConst :: Std_.Bool
        ,Node'annotation -> Bool
targetsEnum :: Std_.Bool
        ,Node'annotation -> Bool
targetsEnumerant :: Std_.Bool
        ,Node'annotation -> Bool
targetsStruct :: Std_.Bool
        ,Node'annotation -> Bool
targetsField :: Std_.Bool
        ,Node'annotation -> Bool
targetsUnion :: Std_.Bool
        ,Node'annotation -> Bool
targetsGroup :: Std_.Bool
        ,Node'annotation -> Bool
targetsInterface :: Std_.Bool
        ,Node'annotation -> Bool
targetsMethod :: Std_.Bool
        ,Node'annotation -> Bool
targetsParam :: Std_.Bool
        ,Node'annotation -> Bool
targetsAnnotation :: Std_.Bool}
    deriving(Int -> Node'annotation -> ShowS
[Node'annotation] -> ShowS
Node'annotation -> String
(Int -> Node'annotation -> ShowS)
-> (Node'annotation -> String)
-> ([Node'annotation] -> ShowS)
-> Show Node'annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'annotation] -> ShowS
$cshowList :: [Node'annotation] -> ShowS
show :: Node'annotation -> String
$cshow :: Node'annotation -> String
showsPrec :: Int -> Node'annotation -> ShowS
$cshowsPrec :: Int -> Node'annotation -> ShowS
Std_.Show
            ,Node'annotation -> Node'annotation -> Bool
(Node'annotation -> Node'annotation -> Bool)
-> (Node'annotation -> Node'annotation -> Bool)
-> Eq Node'annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'annotation -> Node'annotation -> Bool
$c/= :: Node'annotation -> Node'annotation -> Bool
== :: Node'annotation -> Node'annotation -> Bool
$c== :: Node'annotation -> Node'annotation -> Bool
Std_.Eq
            ,(forall x. Node'annotation -> Rep Node'annotation x)
-> (forall x. Rep Node'annotation x -> Node'annotation)
-> Generic Node'annotation
forall x. Rep Node'annotation x -> Node'annotation
forall x. Node'annotation -> Rep Node'annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'annotation x -> Node'annotation
$cfrom :: forall x. Node'annotation -> Rep Node'annotation x
Generics.Generic)
instance (Default.Default Node'annotation) where
    def :: Node'annotation
def  = Node'annotation
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'annotation) where
    fromStruct :: Struct 'Const -> m Node'annotation
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'annotation 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'annotation 'Const)
-> (Node'annotation 'Const -> m Node'annotation)
-> m Node'annotation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'annotation 'Const -> m Node'annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'annotation) where
    type Cerial msg Node'annotation = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'annotation msg)
    decerialize :: Cerial 'Const Node'annotation -> m Node'annotation
decerialize Cerial 'Const Node'annotation
raw = (Type
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Node'annotation
Node'annotation' (Type
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Node'annotation)
-> m Type
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Node'annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'annotation 'Const -> m (Type 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Node'annotation msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'type_ Cerial 'Const Node'annotation
Node'annotation 'Const
raw) m (Type 'Const) -> (Type 'Const -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type 'Const -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                        m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsFile Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsConst Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnum Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnumerant Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsStruct Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool
   -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
-> m Bool
-> m (Bool
      -> Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsField Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
-> m Bool
-> m (Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsUnion Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Bool -> Bool -> Bool -> Bool -> Node'annotation)
-> m Bool -> m (Bool -> Bool -> Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsGroup Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Bool -> Bool -> Bool -> Node'annotation)
-> m Bool -> m (Bool -> Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsInterface Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Bool -> Bool -> Node'annotation)
-> m Bool -> m (Bool -> Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsMethod Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Bool -> Node'annotation)
-> m Bool -> m (Bool -> Node'annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsParam Cerial 'Const Node'annotation
Node'annotation 'Const
raw)
                                        m (Bool -> Node'annotation) -> m Bool -> m Node'annotation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'annotation 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsAnnotation Cerial 'Const Node'annotation
Node'annotation 'Const
raw))
instance (Classes.Marshal s Node'annotation) where
    marshalInto :: Cerial ('Mut s) Node'annotation -> Node'annotation -> m ()
marshalInto Cerial ('Mut s) Node'annotation
raw_ Node'annotation
value_ = case Node'annotation
value_ of
        Node'annotation'{Bool
Type
targetsAnnotation :: Bool
targetsParam :: Bool
targetsMethod :: Bool
targetsInterface :: Bool
targetsGroup :: Bool
targetsUnion :: Bool
targetsField :: Bool
targetsStruct :: Bool
targetsEnumerant :: Bool
targetsEnum :: Bool
targetsConst :: Bool
targetsFile :: Bool
type_ :: Type
$sel:targetsAnnotation:Node'annotation' :: Node'annotation -> Bool
$sel:targetsParam:Node'annotation' :: Node'annotation -> Bool
$sel:targetsMethod:Node'annotation' :: Node'annotation -> Bool
$sel:targetsInterface:Node'annotation' :: Node'annotation -> Bool
$sel:targetsGroup:Node'annotation' :: Node'annotation -> Bool
$sel:targetsUnion:Node'annotation' :: Node'annotation -> Bool
$sel:targetsField:Node'annotation' :: Node'annotation -> Bool
$sel:targetsStruct:Node'annotation' :: Node'annotation -> Bool
$sel:targetsEnumerant:Node'annotation' :: Node'annotation -> Bool
$sel:targetsEnum:Node'annotation' :: Node'annotation -> Bool
$sel:targetsConst:Node'annotation' :: Node'annotation -> Bool
$sel:targetsFile:Node'annotation' :: Node'annotation -> Bool
$sel:type_:Node'annotation' :: Node'annotation -> Type
..} ->
            (do
                ((Message ('Mut s) -> Type -> m (Cerial ('Mut s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'annotation ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_) Type
type_) m (Type ('Mut s)) -> (Type ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'annotation ('Mut s) -> Type ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type ('Mut s))) =>
Node'annotation ('Mut s) -> Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'type_ Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_))
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsFile Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsFile)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsConst Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsConst)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnum Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsEnum)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnumerant Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsEnumerant)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsStruct Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsStruct)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsField Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsField)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsUnion Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsUnion)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsGroup Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsGroup)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsInterface Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsInterface)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsMethod Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsMethod)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsParam Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsParam)
                (Node'annotation ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsAnnotation Cerial ('Mut s) Node'annotation
Node'annotation ('Mut s)
raw_ Bool
targetsAnnotation)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Node'Parameter 
    = Node'Parameter 
        {Node'Parameter -> Text
name :: T.Text}
    deriving(Int -> Node'Parameter -> ShowS
[Node'Parameter] -> ShowS
Node'Parameter -> String
(Int -> Node'Parameter -> ShowS)
-> (Node'Parameter -> String)
-> ([Node'Parameter] -> ShowS)
-> Show Node'Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'Parameter] -> ShowS
$cshowList :: [Node'Parameter] -> ShowS
show :: Node'Parameter -> String
$cshow :: Node'Parameter -> String
showsPrec :: Int -> Node'Parameter -> ShowS
$cshowsPrec :: Int -> Node'Parameter -> ShowS
Std_.Show
            ,Node'Parameter -> Node'Parameter -> Bool
(Node'Parameter -> Node'Parameter -> Bool)
-> (Node'Parameter -> Node'Parameter -> Bool) -> Eq Node'Parameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'Parameter -> Node'Parameter -> Bool
$c/= :: Node'Parameter -> Node'Parameter -> Bool
== :: Node'Parameter -> Node'Parameter -> Bool
$c== :: Node'Parameter -> Node'Parameter -> Bool
Std_.Eq
            ,(forall x. Node'Parameter -> Rep Node'Parameter x)
-> (forall x. Rep Node'Parameter x -> Node'Parameter)
-> Generic Node'Parameter
forall x. Rep Node'Parameter x -> Node'Parameter
forall x. Node'Parameter -> Rep Node'Parameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'Parameter x -> Node'Parameter
$cfrom :: forall x. Node'Parameter -> Rep Node'Parameter x
Generics.Generic)
instance (Default.Default Node'Parameter) where
    def :: Node'Parameter
def  = Node'Parameter
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'Parameter) where
    fromStruct :: Struct 'Const -> m Node'Parameter
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'Parameter 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'Parameter 'Const)
-> (Node'Parameter 'Const -> m Node'Parameter) -> m Node'Parameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'Parameter 'Const -> m Node'Parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'Parameter) where
    type Cerial msg Node'Parameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'Parameter msg)
    decerialize :: Cerial 'Const Node'Parameter -> m Node'Parameter
decerialize Cerial 'Const Node'Parameter
raw = (Text -> Node'Parameter
Node'Parameter (Text -> Node'Parameter) -> m Text -> m Node'Parameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'Parameter 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'Parameter msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'Parameter'name Cerial 'Const Node'Parameter
Node'Parameter 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'Parameter) where
    marshalInto :: Cerial ('Mut s) Node'Parameter -> Node'Parameter -> m ()
marshalInto Cerial ('Mut s) Node'Parameter
raw_ Node'Parameter
value_ = case Node'Parameter
value_ of
        Node'Parameter{Text
name :: Text
$sel:name:Node'Parameter :: Node'Parameter -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'Parameter ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'Parameter
Node'Parameter ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'Parameter ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Node'Parameter ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'Parameter'name Cerial ('Mut s) Node'Parameter
Node'Parameter ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Node'Parameter)
instance (Classes.Cerialize s (V.Vector Node'Parameter)) where
    cerialize :: Message ('Mut s)
-> Vector Node'Parameter
-> m (Cerial ('Mut s) (Vector Node'Parameter))
cerialize  = Message ('Mut s)
-> Vector Node'Parameter
-> m (Cerial ('Mut s) (Vector Node'Parameter))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Node'Parameter))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Node'Parameter)
-> m (Cerial ('Mut s) (Vector (Vector Node'Parameter)))
cerialize  = Message ('Mut s)
-> Vector (Vector Node'Parameter)
-> m (Cerial ('Mut s) (Vector (Vector Node'Parameter)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Node'Parameter)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Node'Parameter))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'Parameter))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Node'Parameter))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'Parameter))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'Parameter)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'Parameter)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'Parameter)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'Parameter)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'Parameter))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'Parameter))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Node'NestedNode 
    = Node'NestedNode 
        {Node'NestedNode -> Text
name :: T.Text
        ,Node'NestedNode -> Word64
id :: Std_.Word64}
    deriving(Int -> Node'NestedNode -> ShowS
[Node'NestedNode] -> ShowS
Node'NestedNode -> String
(Int -> Node'NestedNode -> ShowS)
-> (Node'NestedNode -> String)
-> ([Node'NestedNode] -> ShowS)
-> Show Node'NestedNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'NestedNode] -> ShowS
$cshowList :: [Node'NestedNode] -> ShowS
show :: Node'NestedNode -> String
$cshow :: Node'NestedNode -> String
showsPrec :: Int -> Node'NestedNode -> ShowS
$cshowsPrec :: Int -> Node'NestedNode -> ShowS
Std_.Show
            ,Node'NestedNode -> Node'NestedNode -> Bool
(Node'NestedNode -> Node'NestedNode -> Bool)
-> (Node'NestedNode -> Node'NestedNode -> Bool)
-> Eq Node'NestedNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'NestedNode -> Node'NestedNode -> Bool
$c/= :: Node'NestedNode -> Node'NestedNode -> Bool
== :: Node'NestedNode -> Node'NestedNode -> Bool
$c== :: Node'NestedNode -> Node'NestedNode -> Bool
Std_.Eq
            ,(forall x. Node'NestedNode -> Rep Node'NestedNode x)
-> (forall x. Rep Node'NestedNode x -> Node'NestedNode)
-> Generic Node'NestedNode
forall x. Rep Node'NestedNode x -> Node'NestedNode
forall x. Node'NestedNode -> Rep Node'NestedNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'NestedNode x -> Node'NestedNode
$cfrom :: forall x. Node'NestedNode -> Rep Node'NestedNode x
Generics.Generic)
instance (Default.Default Node'NestedNode) where
    def :: Node'NestedNode
def  = Node'NestedNode
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'NestedNode) where
    fromStruct :: Struct 'Const -> m Node'NestedNode
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'NestedNode 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'NestedNode 'Const)
-> (Node'NestedNode 'Const -> m Node'NestedNode)
-> m Node'NestedNode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'NestedNode 'Const -> m Node'NestedNode
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'NestedNode) where
    type Cerial msg Node'NestedNode = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'NestedNode msg)
    decerialize :: Cerial 'Const Node'NestedNode -> m Node'NestedNode
decerialize Cerial 'Const Node'NestedNode
raw = (Text -> Word64 -> Node'NestedNode
Node'NestedNode (Text -> Word64 -> Node'NestedNode)
-> m Text -> m (Word64 -> Node'NestedNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'NestedNode 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'NestedNode msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'name Cerial 'Const Node'NestedNode
Node'NestedNode 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                       m (Word64 -> Node'NestedNode) -> m Word64 -> m Node'NestedNode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node'NestedNode 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'NestedNode msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'id Cerial 'Const Node'NestedNode
Node'NestedNode 'Const
raw))
instance (Classes.Marshal s Node'NestedNode) where
    marshalInto :: Cerial ('Mut s) Node'NestedNode -> Node'NestedNode -> m ()
marshalInto Cerial ('Mut s) Node'NestedNode
raw_ Node'NestedNode
value_ = case Node'NestedNode
value_ of
        Node'NestedNode{Word64
Text
id :: Word64
name :: Text
$sel:id:Node'NestedNode :: Node'NestedNode -> Word64
$sel:name:Node'NestedNode :: Node'NestedNode -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'NestedNode ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'NestedNode
Node'NestedNode ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'NestedNode ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Node'NestedNode ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'name Cerial ('Mut s) Node'NestedNode
Node'NestedNode ('Mut s)
raw_))
                (Node'NestedNode ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'NestedNode ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'id Cerial ('Mut s) Node'NestedNode
Node'NestedNode ('Mut s)
raw_ Word64
id)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Node'NestedNode)
instance (Classes.Cerialize s (V.Vector Node'NestedNode)) where
    cerialize :: Message ('Mut s)
-> Vector Node'NestedNode
-> m (Cerial ('Mut s) (Vector Node'NestedNode))
cerialize  = Message ('Mut s)
-> Vector Node'NestedNode
-> m (Cerial ('Mut s) (Vector Node'NestedNode))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Node'NestedNode))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Node'NestedNode)
-> m (Cerial ('Mut s) (Vector (Vector Node'NestedNode)))
cerialize  = Message ('Mut s)
-> Vector (Vector Node'NestedNode)
-> m (Cerial ('Mut s) (Vector (Vector Node'NestedNode)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Node'NestedNode)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Node'NestedNode))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'NestedNode))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Node'NestedNode))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'NestedNode))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'NestedNode)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'NestedNode)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'NestedNode)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'NestedNode)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'NestedNode))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'NestedNode))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Node'SourceInfo 
    = Node'SourceInfo 
        {Node'SourceInfo -> Word64
id :: Std_.Word64
        ,Node'SourceInfo -> Text
docComment :: T.Text
        ,Node'SourceInfo -> Vector Node'SourceInfo'Member
members :: (V.Vector Node'SourceInfo'Member)}
    deriving(Int -> Node'SourceInfo -> ShowS
[Node'SourceInfo] -> ShowS
Node'SourceInfo -> String
(Int -> Node'SourceInfo -> ShowS)
-> (Node'SourceInfo -> String)
-> ([Node'SourceInfo] -> ShowS)
-> Show Node'SourceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'SourceInfo] -> ShowS
$cshowList :: [Node'SourceInfo] -> ShowS
show :: Node'SourceInfo -> String
$cshow :: Node'SourceInfo -> String
showsPrec :: Int -> Node'SourceInfo -> ShowS
$cshowsPrec :: Int -> Node'SourceInfo -> ShowS
Std_.Show
            ,Node'SourceInfo -> Node'SourceInfo -> Bool
(Node'SourceInfo -> Node'SourceInfo -> Bool)
-> (Node'SourceInfo -> Node'SourceInfo -> Bool)
-> Eq Node'SourceInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'SourceInfo -> Node'SourceInfo -> Bool
$c/= :: Node'SourceInfo -> Node'SourceInfo -> Bool
== :: Node'SourceInfo -> Node'SourceInfo -> Bool
$c== :: Node'SourceInfo -> Node'SourceInfo -> Bool
Std_.Eq
            ,(forall x. Node'SourceInfo -> Rep Node'SourceInfo x)
-> (forall x. Rep Node'SourceInfo x -> Node'SourceInfo)
-> Generic Node'SourceInfo
forall x. Rep Node'SourceInfo x -> Node'SourceInfo
forall x. Node'SourceInfo -> Rep Node'SourceInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'SourceInfo x -> Node'SourceInfo
$cfrom :: forall x. Node'SourceInfo -> Rep Node'SourceInfo x
Generics.Generic)
instance (Default.Default Node'SourceInfo) where
    def :: Node'SourceInfo
def  = Node'SourceInfo
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'SourceInfo) where
    fromStruct :: Struct 'Const -> m Node'SourceInfo
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'SourceInfo 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'SourceInfo 'Const)
-> (Node'SourceInfo 'Const -> m Node'SourceInfo)
-> m Node'SourceInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'SourceInfo 'Const -> m Node'SourceInfo
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'SourceInfo) where
    type Cerial msg Node'SourceInfo = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'SourceInfo msg)
    decerialize :: Cerial 'Const Node'SourceInfo -> m Node'SourceInfo
decerialize Cerial 'Const Node'SourceInfo
raw = (Word64 -> Text -> Vector Node'SourceInfo'Member -> Node'SourceInfo
Node'SourceInfo (Word64
 -> Text -> Vector Node'SourceInfo'Member -> Node'SourceInfo)
-> m Word64
-> m (Text -> Vector Node'SourceInfo'Member -> Node'SourceInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node'SourceInfo 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Node'SourceInfo msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'id Cerial 'Const Node'SourceInfo
Node'SourceInfo 'Const
raw)
                                       m (Text -> Vector Node'SourceInfo'Member -> Node'SourceInfo)
-> m Text -> m (Vector Node'SourceInfo'Member -> Node'SourceInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node'SourceInfo 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'SourceInfo msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'docComment Cerial 'Const Node'SourceInfo
Node'SourceInfo 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                       m (Vector Node'SourceInfo'Member -> Node'SourceInfo)
-> m (Vector Node'SourceInfo'Member) -> m Node'SourceInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Node'SourceInfo 'Const
-> m (List 'Const (Node'SourceInfo'Member 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg,
 FromPtr msg (List msg (Node'SourceInfo'Member msg))) =>
Node'SourceInfo msg -> m (List msg (Node'SourceInfo'Member msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'members Cerial 'Const Node'SourceInfo
Node'SourceInfo 'Const
raw) m (List 'Const (Node'SourceInfo'Member 'Const))
-> (List 'Const (Node'SourceInfo'Member 'Const)
    -> m (Vector Node'SourceInfo'Member))
-> m (Vector Node'SourceInfo'Member)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node'SourceInfo'Member 'Const)
-> m (Vector Node'SourceInfo'Member)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'SourceInfo) where
    marshalInto :: Cerial ('Mut s) Node'SourceInfo -> Node'SourceInfo -> m ()
marshalInto Cerial ('Mut s) Node'SourceInfo
raw_ Node'SourceInfo
value_ = case Node'SourceInfo
value_ of
        Node'SourceInfo{Word64
Text
Vector Node'SourceInfo'Member
members :: Vector Node'SourceInfo'Member
docComment :: Text
id :: Word64
$sel:members:Node'SourceInfo :: Node'SourceInfo -> Vector Node'SourceInfo'Member
$sel:docComment:Node'SourceInfo :: Node'SourceInfo -> Text
$sel:id:Node'SourceInfo :: Node'SourceInfo -> Word64
..} ->
            (do
                (Node'SourceInfo ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'SourceInfo ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'id Cerial ('Mut s) Node'SourceInfo
Node'SourceInfo ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'SourceInfo ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'SourceInfo
Node'SourceInfo ('Mut s)
raw_) Text
docComment) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Node'SourceInfo ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'docComment Cerial ('Mut s) Node'SourceInfo
Node'SourceInfo ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Node'SourceInfo'Member
-> m (Cerial ('Mut s) (Vector Node'SourceInfo'Member))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'SourceInfo ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'SourceInfo
Node'SourceInfo ('Mut s)
raw_) Vector Node'SourceInfo'Member
members) m (List ('Mut s) (Node'SourceInfo'Member ('Mut s)))
-> (List ('Mut s) (Node'SourceInfo'Member ('Mut s)) -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo ('Mut s)
-> List ('Mut s) (Node'SourceInfo'Member ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List ('Mut s) (Node'SourceInfo'Member ('Mut s)))) =>
Node'SourceInfo ('Mut s)
-> List ('Mut s) (Node'SourceInfo'Member ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'members Cerial ('Mut s) Node'SourceInfo
Node'SourceInfo ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Node'SourceInfo)
instance (Classes.Cerialize s (V.Vector Node'SourceInfo)) where
    cerialize :: Message ('Mut s)
-> Vector Node'SourceInfo
-> m (Cerial ('Mut s) (Vector Node'SourceInfo))
cerialize  = Message ('Mut s)
-> Vector Node'SourceInfo
-> m (Cerial ('Mut s) (Vector Node'SourceInfo))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Node'SourceInfo))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Node'SourceInfo)
-> m (Cerial ('Mut s) (Vector (Vector Node'SourceInfo)))
cerialize  = Message ('Mut s)
-> Vector (Vector Node'SourceInfo)
-> m (Cerial ('Mut s) (Vector (Vector Node'SourceInfo)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Node'SourceInfo)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Node'SourceInfo))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'SourceInfo))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Node'SourceInfo))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Node'SourceInfo))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'SourceInfo)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'SourceInfo)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'SourceInfo)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Node'SourceInfo)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Node'SourceInfo'Member 
    = Node'SourceInfo'Member 
        {Node'SourceInfo'Member -> Text
docComment :: T.Text}
    deriving(Int -> Node'SourceInfo'Member -> ShowS
[Node'SourceInfo'Member] -> ShowS
Node'SourceInfo'Member -> String
(Int -> Node'SourceInfo'Member -> ShowS)
-> (Node'SourceInfo'Member -> String)
-> ([Node'SourceInfo'Member] -> ShowS)
-> Show Node'SourceInfo'Member
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node'SourceInfo'Member] -> ShowS
$cshowList :: [Node'SourceInfo'Member] -> ShowS
show :: Node'SourceInfo'Member -> String
$cshow :: Node'SourceInfo'Member -> String
showsPrec :: Int -> Node'SourceInfo'Member -> ShowS
$cshowsPrec :: Int -> Node'SourceInfo'Member -> ShowS
Std_.Show
            ,Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool
(Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool)
-> (Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool)
-> Eq Node'SourceInfo'Member
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool
$c/= :: Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool
== :: Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool
$c== :: Node'SourceInfo'Member -> Node'SourceInfo'Member -> Bool
Std_.Eq
            ,(forall x. Node'SourceInfo'Member -> Rep Node'SourceInfo'Member x)
-> (forall x.
    Rep Node'SourceInfo'Member x -> Node'SourceInfo'Member)
-> Generic Node'SourceInfo'Member
forall x. Rep Node'SourceInfo'Member x -> Node'SourceInfo'Member
forall x. Node'SourceInfo'Member -> Rep Node'SourceInfo'Member x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node'SourceInfo'Member x -> Node'SourceInfo'Member
$cfrom :: forall x. Node'SourceInfo'Member -> Rep Node'SourceInfo'Member x
Generics.Generic)
instance (Default.Default Node'SourceInfo'Member) where
    def :: Node'SourceInfo'Member
def  = Node'SourceInfo'Member
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Node'SourceInfo'Member) where
    fromStruct :: Struct 'Const -> m Node'SourceInfo'Member
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Node'SourceInfo'Member 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Node'SourceInfo'Member 'Const)
-> (Node'SourceInfo'Member 'Const -> m Node'SourceInfo'Member)
-> m Node'SourceInfo'Member
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'SourceInfo'Member 'Const -> m Node'SourceInfo'Member
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Node'SourceInfo'Member) where
    type Cerial msg Node'SourceInfo'Member = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'SourceInfo'Member msg)
    decerialize :: Cerial 'Const Node'SourceInfo'Member -> m Node'SourceInfo'Member
decerialize Cerial 'Const Node'SourceInfo'Member
raw = (Text -> Node'SourceInfo'Member
Node'SourceInfo'Member (Text -> Node'SourceInfo'Member)
-> m Text -> m Node'SourceInfo'Member
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node'SourceInfo'Member 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'SourceInfo'Member msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'Member'docComment Cerial 'Const Node'SourceInfo'Member
Node'SourceInfo'Member 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Node'SourceInfo'Member) where
    marshalInto :: Cerial ('Mut s) Node'SourceInfo'Member
-> Node'SourceInfo'Member -> m ()
marshalInto Cerial ('Mut s) Node'SourceInfo'Member
raw_ Node'SourceInfo'Member
value_ = case Node'SourceInfo'Member
value_ of
        Node'SourceInfo'Member{Text
docComment :: Text
$sel:docComment:Node'SourceInfo'Member :: Node'SourceInfo'Member -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Node'SourceInfo'Member ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Node'SourceInfo'Member
Node'SourceInfo'Member ('Mut s)
raw_) Text
docComment) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo'Member ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Node'SourceInfo'Member ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'Member'docComment Cerial ('Mut s) Node'SourceInfo'Member
Node'SourceInfo'Member ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Node'SourceInfo'Member)
instance (Classes.Cerialize s (V.Vector Node'SourceInfo'Member)) where
    cerialize :: Message ('Mut s)
-> Vector Node'SourceInfo'Member
-> m (Cerial ('Mut s) (Vector Node'SourceInfo'Member))
cerialize  = Message ('Mut s)
-> Vector Node'SourceInfo'Member
-> m (Cerial ('Mut s) (Vector Node'SourceInfo'Member))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Node'SourceInfo'Member))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Node'SourceInfo'Member)
-> m (Cerial ('Mut s) (Vector (Vector Node'SourceInfo'Member)))
cerialize  = Message ('Mut s)
-> Vector (Vector Node'SourceInfo'Member)
-> m (Cerial ('Mut s) (Vector (Vector Node'SourceInfo'Member)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Node'SourceInfo'Member))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector Node'SourceInfo'Member))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Node'SourceInfo'Member))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector Node'SourceInfo'Member))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'SourceInfo'Member)))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Node'SourceInfo'Member)))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Field 
    = Field 
        {Field -> Text
name :: T.Text
        ,Field -> Word16
codeOrder :: Std_.Word16
        ,Field -> Vector Annotation
annotations :: (V.Vector Annotation)
        ,Field -> Word16
discriminantValue :: Std_.Word16
        ,Field -> Field'ordinal
ordinal :: Field'ordinal
        ,Field -> Field'
union' :: Field'}
    deriving(Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Std_.Show
            ,Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Std_.Eq
            ,(forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generics.Generic)
instance (Default.Default Field) where
    def :: Field
def  = Field
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Field) where
    fromStruct :: Struct 'Const -> m Field
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Field 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Field 'Const) -> (Field 'Const -> m Field) -> m Field
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field 'Const -> m Field
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Field) where
    type Cerial msg Field = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
    decerialize :: Cerial 'Const Field -> m Field
decerialize Cerial 'Const Field
raw = (Text
-> Word16
-> Vector Annotation
-> Word16
-> Field'ordinal
-> Field'
-> Field
Field (Text
 -> Word16
 -> Vector Annotation
 -> Word16
 -> Field'ordinal
 -> Field'
 -> Field)
-> m Text
-> m (Word16
      -> Vector Annotation -> Word16 -> Field'ordinal -> Field' -> Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Field 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Field msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'name Cerial 'Const Field
Field 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                             m (Word16
   -> Vector Annotation -> Word16 -> Field'ordinal -> Field' -> Field)
-> m Word16
-> m (Vector Annotation
      -> Word16 -> Field'ordinal -> Field' -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Field msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'codeOrder Cerial 'Const Field
Field 'Const
raw)
                             m (Vector Annotation -> Word16 -> Field'ordinal -> Field' -> Field)
-> m (Vector Annotation)
-> m (Word16 -> Field'ordinal -> Field' -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Field 'Const -> m (List 'Const (Annotation 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Field msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'annotations Cerial 'Const Field
Field 'Const
raw) m (List 'Const (Annotation 'Const))
-> (List 'Const (Annotation 'Const) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Annotation 'Const) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                             m (Word16 -> Field'ordinal -> Field' -> Field)
-> m Word16 -> m (Field'ordinal -> Field' -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Field msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'discriminantValue Cerial 'Const Field
Field 'Const
raw)
                             m (Field'ordinal -> Field' -> Field)
-> m Field'ordinal -> m (Field' -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Field 'Const -> m (Field'ordinal 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Field'ordinal msg)) =>
Field msg -> m (Field'ordinal msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal Cerial 'Const Field
Field 'Const
raw) m (Field'ordinal 'Const)
-> (Field'ordinal 'Const -> m Field'ordinal) -> m Field'ordinal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'ordinal 'Const -> m Field'ordinal
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                             m (Field' -> Field) -> m Field' -> m Field
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cerial 'Const Field' -> m Field'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Field'
Cerial 'Const Field
raw))
instance (Classes.Marshal s Field) where
    marshalInto :: Cerial ('Mut s) Field -> Field -> m ()
marshalInto Cerial ('Mut s) Field
raw_ Field
value_ = case Field
value_ of
        Field{Word16
Text
Vector Annotation
Field'ordinal
Field'
union' :: Field'
ordinal :: Field'ordinal
discriminantValue :: Word16
annotations :: Vector Annotation
codeOrder :: Word16
name :: Text
$sel:union':Field :: Field -> Field'
$sel:ordinal:Field :: Field -> Field'ordinal
$sel:discriminantValue:Field :: Field -> Word16
$sel:annotations:Field :: Field -> Vector Annotation
$sel:codeOrder:Field :: Field -> Word16
$sel:name:Field :: Field -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Field ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Field
Field ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Field ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'name Cerial ('Mut s) Field
Field ('Mut s)
raw_))
                (Field ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'codeOrder Cerial ('Mut s) Field
Field ('Mut s)
raw_ Word16
codeOrder)
                ((Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Field ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Field
Field ('Mut s)
raw_) Vector Annotation
annotations) m (List ('Mut s) (Annotation ('Mut s)))
-> (List ('Mut s) (Annotation ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Annotation ('Mut s)))) =>
Field ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'annotations Cerial ('Mut s) Field
Field ('Mut s)
raw_))
                (Field ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'discriminantValue Cerial ('Mut s) Field
Field ('Mut s)
raw_ Word16
discriminantValue)
                (do
                    Field'ordinal ('Mut s)
raw_ <- (Field ('Mut s) -> m (Field'ordinal ('Mut s))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Field'ordinal msg)) =>
Field msg -> m (Field'ordinal msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal Cerial ('Mut s) Field
Field ('Mut s)
raw_)
                    (Cerial ('Mut s) Field'ordinal -> Field'ordinal -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Field'ordinal
Field'ordinal ('Mut s)
raw_ Field'ordinal
ordinal)
                    )
                (do
                    (Cerial ('Mut s) Field' -> Field' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Field'
Cerial ('Mut s) Field
raw_ Field'
union')
                    )
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Field)
instance (Classes.Cerialize s (V.Vector Field)) where
    cerialize :: Message ('Mut s)
-> Vector Field -> m (Cerial ('Mut s) (Vector Field))
cerialize  = Message ('Mut s)
-> Vector Field -> m (Cerial ('Mut s) (Vector Field))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Field))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Field)
-> m (Cerial ('Mut s) (Vector (Vector Field)))
cerialize  = Message ('Mut s)
-> Vector (Vector Field)
-> m (Cerial ('Mut s) (Vector (Vector Field)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Field)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Field))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Field))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Field))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Field))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Field))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Field)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Field)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Field)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Field)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Field))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Field))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Field))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Field))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Field)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Field)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Field)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Field)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Field))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Field))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Field))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Field))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Field' 
    = Field'slot Field'slot
    | Field'group Field'group
    | Field'unknown' Std_.Word16
    deriving(Int -> Field' -> ShowS
[Field'] -> ShowS
Field' -> String
(Int -> Field' -> ShowS)
-> (Field' -> String) -> ([Field'] -> ShowS) -> Show Field'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field'] -> ShowS
$cshowList :: [Field'] -> ShowS
show :: Field' -> String
$cshow :: Field' -> String
showsPrec :: Int -> Field' -> ShowS
$cshowsPrec :: Int -> Field' -> ShowS
Std_.Show
            ,Field' -> Field' -> Bool
(Field' -> Field' -> Bool)
-> (Field' -> Field' -> Bool) -> Eq Field'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field' -> Field' -> Bool
$c/= :: Field' -> Field' -> Bool
== :: Field' -> Field' -> Bool
$c== :: Field' -> Field' -> Bool
Std_.Eq
            ,(forall x. Field' -> Rep Field' x)
-> (forall x. Rep Field' x -> Field') -> Generic Field'
forall x. Rep Field' x -> Field'
forall x. Field' -> Rep Field' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field' x -> Field'
$cfrom :: forall x. Field' -> Rep Field' x
Generics.Generic)
instance (Default.Default Field') where
    def :: Field'
def  = Field'
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Field') where
    fromStruct :: Struct 'Const -> m Field'
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Field 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Field 'Const) -> (Field 'Const -> m Field') -> m Field'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field 'Const -> m Field'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Field') where
    type Cerial msg Field' = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
    decerialize :: Cerial 'Const Field' -> m Field'
decerialize Cerial 'Const Field'
raw = (do
        Field' 'Const
raw <- (Field 'Const -> m (Field' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Field' msg)) =>
Field msg -> m (Field' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field' Cerial 'Const Field'
Field 'Const
raw)
        case Field' 'Const
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'slot Field'slot 'Const
raw) ->
                (Field'slot -> Field'
Field'slot (Field'slot -> Field') -> m Field'slot -> m Field'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Field'slot -> m Field'slot
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Field'slot
Field'slot 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'group Field'group 'Const
raw) ->
                (Field'group -> Field'
Field'group (Field'group -> Field') -> m Field'group -> m Field'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Field'group -> m Field'group
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Field'group
Field'group 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'unknown' Word16
tag) ->
                (Field' -> m Field'
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Field'
Field'unknown' Word16
tag))
        )
instance (Classes.Marshal s Field') where
    marshalInto :: Cerial ('Mut s) Field' -> Field' -> m ()
marshalInto Cerial ('Mut s) Field'
raw_ Field'
value_ = case Field'
value_ of
        (Field'slot Field'slot
arg_) ->
            (do
                Field'slot ('Mut s)
raw_ <- (Field ('Mut s) -> m (Field'slot ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Field'slot ('Mut s))) =>
Field ('Mut s) -> m (Field'slot ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot Cerial ('Mut s) Field'
Field ('Mut s)
raw_)
                (Cerial ('Mut s) Field'slot -> Field'slot -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_ Field'slot
arg_)
                )
        (Field'group Field'group
arg_) ->
            (do
                Field'group ('Mut s)
raw_ <- (Field ('Mut s) -> m (Field'group ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Field'group ('Mut s))) =>
Field ('Mut s) -> m (Field'group ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group Cerial ('Mut s) Field'
Field ('Mut s)
raw_)
                (Cerial ('Mut s) Field'group -> Field'group -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Field'group
Field'group ('Mut s)
raw_ Field'group
arg_)
                )
        (Field'unknown' Word16
tag) ->
            (Field ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'unknown' Cerial ('Mut s) Field'
Field ('Mut s)
raw_ Word16
tag)
data Field'slot 
    = Field'slot' 
        {Field'slot -> Word32
offset :: Std_.Word32
        ,Field'slot -> Type
type_ :: Type
        ,Field'slot -> Value
defaultValue :: Value
        ,Field'slot -> Bool
hadExplicitDefault :: Std_.Bool}
    deriving(Int -> Field'slot -> ShowS
[Field'slot] -> ShowS
Field'slot -> String
(Int -> Field'slot -> ShowS)
-> (Field'slot -> String)
-> ([Field'slot] -> ShowS)
-> Show Field'slot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field'slot] -> ShowS
$cshowList :: [Field'slot] -> ShowS
show :: Field'slot -> String
$cshow :: Field'slot -> String
showsPrec :: Int -> Field'slot -> ShowS
$cshowsPrec :: Int -> Field'slot -> ShowS
Std_.Show
            ,Field'slot -> Field'slot -> Bool
(Field'slot -> Field'slot -> Bool)
-> (Field'slot -> Field'slot -> Bool) -> Eq Field'slot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field'slot -> Field'slot -> Bool
$c/= :: Field'slot -> Field'slot -> Bool
== :: Field'slot -> Field'slot -> Bool
$c== :: Field'slot -> Field'slot -> Bool
Std_.Eq
            ,(forall x. Field'slot -> Rep Field'slot x)
-> (forall x. Rep Field'slot x -> Field'slot) -> Generic Field'slot
forall x. Rep Field'slot x -> Field'slot
forall x. Field'slot -> Rep Field'slot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field'slot x -> Field'slot
$cfrom :: forall x. Field'slot -> Rep Field'slot x
Generics.Generic)
instance (Default.Default Field'slot) where
    def :: Field'slot
def  = Field'slot
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Field'slot) where
    fromStruct :: Struct 'Const -> m Field'slot
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Field'slot 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Field'slot 'Const)
-> (Field'slot 'Const -> m Field'slot) -> m Field'slot
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'slot 'Const -> m Field'slot
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Field'slot) where
    type Cerial msg Field'slot = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'slot msg)
    decerialize :: Cerial 'Const Field'slot -> m Field'slot
decerialize Cerial 'Const Field'slot
raw = (Word32 -> Type -> Value -> Bool -> Field'slot
Field'slot' (Word32 -> Type -> Value -> Bool -> Field'slot)
-> m Word32 -> m (Type -> Value -> Bool -> Field'slot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field'slot 'Const -> m Word32
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Field'slot msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'offset Cerial 'Const Field'slot
Field'slot 'Const
raw)
                                   m (Type -> Value -> Bool -> Field'slot)
-> m Type -> m (Value -> Bool -> Field'slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Field'slot 'Const -> m (Type 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Field'slot msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'type_ Cerial 'Const Field'slot
Field'slot 'Const
raw) m (Type 'Const) -> (Type 'Const -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type 'Const -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                   m (Value -> Bool -> Field'slot)
-> m Value -> m (Bool -> Field'slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Field'slot 'Const -> m (Value 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Field'slot msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'defaultValue Cerial 'Const Field'slot
Field'slot 'Const
raw) m (Value 'Const) -> (Value 'Const -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value 'Const -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                   m (Bool -> Field'slot) -> m Bool -> m Field'slot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field'slot 'Const -> m Bool
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Field'slot msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'hadExplicitDefault Cerial 'Const Field'slot
Field'slot 'Const
raw))
instance (Classes.Marshal s Field'slot) where
    marshalInto :: Cerial ('Mut s) Field'slot -> Field'slot -> m ()
marshalInto Cerial ('Mut s) Field'slot
raw_ Field'slot
value_ = case Field'slot
value_ of
        Field'slot'{Bool
Word32
Value
Type
hadExplicitDefault :: Bool
defaultValue :: Value
type_ :: Type
offset :: Word32
$sel:hadExplicitDefault:Field'slot' :: Field'slot -> Bool
$sel:defaultValue:Field'slot' :: Field'slot -> Value
$sel:type_:Field'slot' :: Field'slot -> Type
$sel:offset:Field'slot' :: Field'slot -> Word32
..} ->
            (do
                (Field'slot ('Mut s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'slot ('Mut s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'offset Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_ Word32
offset)
                ((Message ('Mut s) -> Type -> m (Cerial ('Mut s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Field'slot ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_) Type
type_) m (Type ('Mut s)) -> (Type ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field'slot ('Mut s) -> Type ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type ('Mut s))) =>
Field'slot ('Mut s) -> Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'type_ Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_))
                ((Message ('Mut s) -> Value -> m (Cerial ('Mut s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Field'slot ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_) Value
defaultValue) m (Value ('Mut s)) -> (Value ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field'slot ('Mut s) -> Value ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value ('Mut s))) =>
Field'slot ('Mut s) -> Value ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'defaultValue Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_))
                (Field'slot ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'slot ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'hadExplicitDefault Cerial ('Mut s) Field'slot
Field'slot ('Mut s)
raw_ Bool
hadExplicitDefault)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Field'group 
    = Field'group' 
        {Field'group -> Word64
typeId :: Std_.Word64}
    deriving(Int -> Field'group -> ShowS
[Field'group] -> ShowS
Field'group -> String
(Int -> Field'group -> ShowS)
-> (Field'group -> String)
-> ([Field'group] -> ShowS)
-> Show Field'group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field'group] -> ShowS
$cshowList :: [Field'group] -> ShowS
show :: Field'group -> String
$cshow :: Field'group -> String
showsPrec :: Int -> Field'group -> ShowS
$cshowsPrec :: Int -> Field'group -> ShowS
Std_.Show
            ,Field'group -> Field'group -> Bool
(Field'group -> Field'group -> Bool)
-> (Field'group -> Field'group -> Bool) -> Eq Field'group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field'group -> Field'group -> Bool
$c/= :: Field'group -> Field'group -> Bool
== :: Field'group -> Field'group -> Bool
$c== :: Field'group -> Field'group -> Bool
Std_.Eq
            ,(forall x. Field'group -> Rep Field'group x)
-> (forall x. Rep Field'group x -> Field'group)
-> Generic Field'group
forall x. Rep Field'group x -> Field'group
forall x. Field'group -> Rep Field'group x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field'group x -> Field'group
$cfrom :: forall x. Field'group -> Rep Field'group x
Generics.Generic)
instance (Default.Default Field'group) where
    def :: Field'group
def  = Field'group
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Field'group) where
    fromStruct :: Struct 'Const -> m Field'group
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Field'group 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Field'group 'Const)
-> (Field'group 'Const -> m Field'group) -> m Field'group
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'group 'Const -> m Field'group
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Field'group) where
    type Cerial msg Field'group = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'group msg)
    decerialize :: Cerial 'Const Field'group -> m Field'group
decerialize Cerial 'Const Field'group
raw = (Word64 -> Field'group
Field'group' (Word64 -> Field'group) -> m Word64 -> m Field'group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field'group 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Field'group msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'group'typeId Cerial 'Const Field'group
Field'group 'Const
raw))
instance (Classes.Marshal s Field'group) where
    marshalInto :: Cerial ('Mut s) Field'group -> Field'group -> m ()
marshalInto Cerial ('Mut s) Field'group
raw_ Field'group
value_ = case Field'group
value_ of
        Field'group'{Word64
typeId :: Word64
$sel:typeId:Field'group' :: Field'group -> Word64
..} ->
            (do
                (Field'group ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'group ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group'typeId Cerial ('Mut s) Field'group
Field'group ('Mut s)
raw_ Word64
typeId)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Field'ordinal 
    = Field'ordinal'implicit 
    | Field'ordinal'explicit Std_.Word16
    | Field'ordinal'unknown' Std_.Word16
    deriving(Int -> Field'ordinal -> ShowS
[Field'ordinal] -> ShowS
Field'ordinal -> String
(Int -> Field'ordinal -> ShowS)
-> (Field'ordinal -> String)
-> ([Field'ordinal] -> ShowS)
-> Show Field'ordinal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field'ordinal] -> ShowS
$cshowList :: [Field'ordinal] -> ShowS
show :: Field'ordinal -> String
$cshow :: Field'ordinal -> String
showsPrec :: Int -> Field'ordinal -> ShowS
$cshowsPrec :: Int -> Field'ordinal -> ShowS
Std_.Show
            ,Field'ordinal -> Field'ordinal -> Bool
(Field'ordinal -> Field'ordinal -> Bool)
-> (Field'ordinal -> Field'ordinal -> Bool) -> Eq Field'ordinal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field'ordinal -> Field'ordinal -> Bool
$c/= :: Field'ordinal -> Field'ordinal -> Bool
== :: Field'ordinal -> Field'ordinal -> Bool
$c== :: Field'ordinal -> Field'ordinal -> Bool
Std_.Eq
            ,(forall x. Field'ordinal -> Rep Field'ordinal x)
-> (forall x. Rep Field'ordinal x -> Field'ordinal)
-> Generic Field'ordinal
forall x. Rep Field'ordinal x -> Field'ordinal
forall x. Field'ordinal -> Rep Field'ordinal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field'ordinal x -> Field'ordinal
$cfrom :: forall x. Field'ordinal -> Rep Field'ordinal x
Generics.Generic)
instance (Default.Default Field'ordinal) where
    def :: Field'ordinal
def  = Field'ordinal
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Field'ordinal) where
    fromStruct :: Struct 'Const -> m Field'ordinal
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Field'ordinal 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Field'ordinal 'Const)
-> (Field'ordinal 'Const -> m Field'ordinal) -> m Field'ordinal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'ordinal 'Const -> m Field'ordinal
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Field'ordinal) where
    type Cerial msg Field'ordinal = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal msg)
    decerialize :: Cerial 'Const Field'ordinal -> m Field'ordinal
decerialize Cerial 'Const Field'ordinal
raw = (do
        Field'ordinal' 'Const
raw <- (Field'ordinal 'Const -> m (Field'ordinal' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Field'ordinal' msg)) =>
Field'ordinal msg -> m (Field'ordinal' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal' Cerial 'Const Field'ordinal
Field'ordinal 'Const
raw)
        case Field'ordinal' 'Const
raw of
            (Field'ordinal' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'implicit) ->
                (Field'ordinal -> m Field'ordinal
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Field'ordinal
Field'ordinal'implicit)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'explicit Word16
raw) ->
                (Field'ordinal -> m Field'ordinal
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Field'ordinal
Field'ordinal'explicit Word16
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'unknown' Word16
tag) ->
                (Field'ordinal -> m Field'ordinal
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Field'ordinal
Field'ordinal'unknown' Word16
tag))
        )
instance (Classes.Marshal s Field'ordinal) where
    marshalInto :: Cerial ('Mut s) Field'ordinal -> Field'ordinal -> m ()
marshalInto Cerial ('Mut s) Field'ordinal
raw_ Field'ordinal
value_ = case Field'ordinal
value_ of
        (Field'ordinal
Field'ordinal'implicit) ->
            (Field'ordinal ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Field'ordinal ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'implicit Cerial ('Mut s) Field'ordinal
Field'ordinal ('Mut s)
raw_)
        (Field'ordinal'explicit Word16
arg_) ->
            (Field'ordinal ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'ordinal ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'explicit Cerial ('Mut s) Field'ordinal
Field'ordinal ('Mut s)
raw_ Word16
arg_)
        (Field'ordinal'unknown' Word16
tag) ->
            (Field'ordinal ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'ordinal ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'unknown' Cerial ('Mut s) Field'ordinal
Field'ordinal ('Mut s)
raw_ Word16
tag)
data Enumerant 
    = Enumerant 
        {Enumerant -> Text
name :: T.Text
        ,Enumerant -> Word16
codeOrder :: Std_.Word16
        ,Enumerant -> Vector Annotation
annotations :: (V.Vector Annotation)}
    deriving(Int -> Enumerant -> ShowS
[Enumerant] -> ShowS
Enumerant -> String
(Int -> Enumerant -> ShowS)
-> (Enumerant -> String)
-> ([Enumerant] -> ShowS)
-> Show Enumerant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Enumerant] -> ShowS
$cshowList :: [Enumerant] -> ShowS
show :: Enumerant -> String
$cshow :: Enumerant -> String
showsPrec :: Int -> Enumerant -> ShowS
$cshowsPrec :: Int -> Enumerant -> ShowS
Std_.Show
            ,Enumerant -> Enumerant -> Bool
(Enumerant -> Enumerant -> Bool)
-> (Enumerant -> Enumerant -> Bool) -> Eq Enumerant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Enumerant -> Enumerant -> Bool
$c/= :: Enumerant -> Enumerant -> Bool
== :: Enumerant -> Enumerant -> Bool
$c== :: Enumerant -> Enumerant -> Bool
Std_.Eq
            ,(forall x. Enumerant -> Rep Enumerant x)
-> (forall x. Rep Enumerant x -> Enumerant) -> Generic Enumerant
forall x. Rep Enumerant x -> Enumerant
forall x. Enumerant -> Rep Enumerant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Enumerant x -> Enumerant
$cfrom :: forall x. Enumerant -> Rep Enumerant x
Generics.Generic)
instance (Default.Default Enumerant) where
    def :: Enumerant
def  = Enumerant
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Enumerant) where
    fromStruct :: Struct 'Const -> m Enumerant
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Enumerant 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Enumerant 'Const)
-> (Enumerant 'Const -> m Enumerant) -> m Enumerant
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Enumerant 'Const -> m Enumerant
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Enumerant) where
    type Cerial msg Enumerant = (Capnp.Gen.ById.Xa93fc509624c72d9.Enumerant msg)
    decerialize :: Cerial 'Const Enumerant -> m Enumerant
decerialize Cerial 'Const Enumerant
raw = (Text -> Word16 -> Vector Annotation -> Enumerant
Enumerant (Text -> Word16 -> Vector Annotation -> Enumerant)
-> m Text -> m (Word16 -> Vector Annotation -> Enumerant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Enumerant 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Enumerant msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'name Cerial 'Const Enumerant
Enumerant 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                 m (Word16 -> Vector Annotation -> Enumerant)
-> m Word16 -> m (Vector Annotation -> Enumerant)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Enumerant 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Enumerant msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'codeOrder Cerial 'Const Enumerant
Enumerant 'Const
raw)
                                 m (Vector Annotation -> Enumerant)
-> m (Vector Annotation) -> m Enumerant
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Enumerant 'Const -> m (List 'Const (Annotation 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Enumerant msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'annotations Cerial 'Const Enumerant
Enumerant 'Const
raw) m (List 'Const (Annotation 'Const))
-> (List 'Const (Annotation 'Const) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Annotation 'Const) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Enumerant) where
    marshalInto :: Cerial ('Mut s) Enumerant -> Enumerant -> m ()
marshalInto Cerial ('Mut s) Enumerant
raw_ Enumerant
value_ = case Enumerant
value_ of
        Enumerant{Word16
Text
Vector Annotation
annotations :: Vector Annotation
codeOrder :: Word16
name :: Text
$sel:annotations:Enumerant :: Enumerant -> Vector Annotation
$sel:codeOrder:Enumerant :: Enumerant -> Word16
$sel:name:Enumerant :: Enumerant -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Enumerant ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Enumerant
Enumerant ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Enumerant ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Enumerant ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'name Cerial ('Mut s) Enumerant
Enumerant ('Mut s)
raw_))
                (Enumerant ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Enumerant ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'codeOrder Cerial ('Mut s) Enumerant
Enumerant ('Mut s)
raw_ Word16
codeOrder)
                ((Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Enumerant ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Enumerant
Enumerant ('Mut s)
raw_) Vector Annotation
annotations) m (List ('Mut s) (Annotation ('Mut s)))
-> (List ('Mut s) (Annotation ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Enumerant ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Annotation ('Mut s)))) =>
Enumerant ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'annotations Cerial ('Mut s) Enumerant
Enumerant ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Enumerant)
instance (Classes.Cerialize s (V.Vector Enumerant)) where
    cerialize :: Message ('Mut s)
-> Vector Enumerant -> m (Cerial ('Mut s) (Vector Enumerant))
cerialize  = Message ('Mut s)
-> Vector Enumerant -> m (Cerial ('Mut s) (Vector Enumerant))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Enumerant))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Enumerant)
-> m (Cerial ('Mut s) (Vector (Vector Enumerant)))
cerialize  = Message ('Mut s)
-> Vector (Vector Enumerant)
-> m (Cerial ('Mut s) (Vector (Vector Enumerant)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Enumerant)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Enumerant))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Enumerant))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Enumerant))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Enumerant))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Enumerant))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Enumerant)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Enumerant)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Enumerant)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Enumerant)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Enumerant))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Enumerant))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Enumerant))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Enumerant))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Superclass 
    = Superclass 
        {Superclass -> Word64
id :: Std_.Word64
        ,Superclass -> Brand
brand :: Brand}
    deriving(Int -> Superclass -> ShowS
[Superclass] -> ShowS
Superclass -> String
(Int -> Superclass -> ShowS)
-> (Superclass -> String)
-> ([Superclass] -> ShowS)
-> Show Superclass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Superclass] -> ShowS
$cshowList :: [Superclass] -> ShowS
show :: Superclass -> String
$cshow :: Superclass -> String
showsPrec :: Int -> Superclass -> ShowS
$cshowsPrec :: Int -> Superclass -> ShowS
Std_.Show
            ,Superclass -> Superclass -> Bool
(Superclass -> Superclass -> Bool)
-> (Superclass -> Superclass -> Bool) -> Eq Superclass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Superclass -> Superclass -> Bool
$c/= :: Superclass -> Superclass -> Bool
== :: Superclass -> Superclass -> Bool
$c== :: Superclass -> Superclass -> Bool
Std_.Eq
            ,(forall x. Superclass -> Rep Superclass x)
-> (forall x. Rep Superclass x -> Superclass) -> Generic Superclass
forall x. Rep Superclass x -> Superclass
forall x. Superclass -> Rep Superclass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Superclass x -> Superclass
$cfrom :: forall x. Superclass -> Rep Superclass x
Generics.Generic)
instance (Default.Default Superclass) where
    def :: Superclass
def  = Superclass
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Superclass) where
    fromStruct :: Struct 'Const -> m Superclass
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Superclass 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Superclass 'Const)
-> (Superclass 'Const -> m Superclass) -> m Superclass
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Superclass 'Const -> m Superclass
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Superclass) where
    type Cerial msg Superclass = (Capnp.Gen.ById.Xa93fc509624c72d9.Superclass msg)
    decerialize :: Cerial 'Const Superclass -> m Superclass
decerialize Cerial 'Const Superclass
raw = (Word64 -> Brand -> Superclass
Superclass (Word64 -> Brand -> Superclass)
-> m Word64 -> m (Brand -> Superclass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Superclass 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Superclass msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'id Cerial 'Const Superclass
Superclass 'Const
raw)
                                  m (Brand -> Superclass) -> m Brand -> m Superclass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Superclass 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Superclass msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'brand Cerial 'Const Superclass
Superclass 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Superclass) where
    marshalInto :: Cerial ('Mut s) Superclass -> Superclass -> m ()
marshalInto Cerial ('Mut s) Superclass
raw_ Superclass
value_ = case Superclass
value_ of
        Superclass{Word64
Brand
brand :: Brand
id :: Word64
$sel:brand:Superclass :: Superclass -> Brand
$sel:id:Superclass :: Superclass -> Word64
..} ->
            (do
                (Superclass ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Superclass ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'id Cerial ('Mut s) Superclass
Superclass ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Superclass ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Superclass
Superclass ('Mut s)
raw_) Brand
brand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Superclass ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Superclass ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'brand Cerial ('Mut s) Superclass
Superclass ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Superclass)
instance (Classes.Cerialize s (V.Vector Superclass)) where
    cerialize :: Message ('Mut s)
-> Vector Superclass -> m (Cerial ('Mut s) (Vector Superclass))
cerialize  = Message ('Mut s)
-> Vector Superclass -> m (Cerial ('Mut s) (Vector Superclass))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Superclass))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Superclass)
-> m (Cerial ('Mut s) (Vector (Vector Superclass)))
cerialize  = Message ('Mut s)
-> Vector (Vector Superclass)
-> m (Cerial ('Mut s) (Vector (Vector Superclass)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Superclass)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Superclass))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Superclass))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Superclass))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Superclass))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Superclass))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Superclass)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Superclass)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Superclass)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Superclass)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Superclass))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Superclass))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Superclass))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Superclass))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Method 
    = Method 
        {Method -> Text
name :: T.Text
        ,Method -> Word16
codeOrder :: Std_.Word16
        ,Method -> Word64
paramStructType :: Std_.Word64
        ,Method -> Word64
resultStructType :: Std_.Word64
        ,Method -> Vector Annotation
annotations :: (V.Vector Annotation)
        ,Method -> Brand
paramBrand :: Brand
        ,Method -> Brand
resultBrand :: Brand
        ,Method -> Vector Node'Parameter
implicitParameters :: (V.Vector Node'Parameter)}
    deriving(Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Std_.Show
            ,Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Std_.Eq
            ,(forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Method x -> Method
$cfrom :: forall x. Method -> Rep Method x
Generics.Generic)
instance (Default.Default Method) where
    def :: Method
def  = Method
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Method) where
    fromStruct :: Struct 'Const -> m Method
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Method 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Method 'Const) -> (Method 'Const -> m Method) -> m Method
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Method 'Const -> m Method
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Method) where
    type Cerial msg Method = (Capnp.Gen.ById.Xa93fc509624c72d9.Method msg)
    decerialize :: Cerial 'Const Method -> m Method
decerialize Cerial 'Const Method
raw = (Text
-> Word16
-> Word64
-> Word64
-> Vector Annotation
-> Brand
-> Brand
-> Vector Node'Parameter
-> Method
Method (Text
 -> Word16
 -> Word64
 -> Word64
 -> Vector Annotation
 -> Brand
 -> Brand
 -> Vector Node'Parameter
 -> Method)
-> m Text
-> m (Word16
      -> Word64
      -> Word64
      -> Vector Annotation
      -> Brand
      -> Brand
      -> Vector Node'Parameter
      -> Method)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Method 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Method msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'name Cerial 'Const Method
Method 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                              m (Word16
   -> Word64
   -> Word64
   -> Vector Annotation
   -> Brand
   -> Brand
   -> Vector Node'Parameter
   -> Method)
-> m Word16
-> m (Word64
      -> Word64
      -> Vector Annotation
      -> Brand
      -> Brand
      -> Vector Node'Parameter
      -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Method 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Method msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'codeOrder Cerial 'Const Method
Method 'Const
raw)
                              m (Word64
   -> Word64
   -> Vector Annotation
   -> Brand
   -> Brand
   -> Vector Node'Parameter
   -> Method)
-> m Word64
-> m (Word64
      -> Vector Annotation
      -> Brand
      -> Brand
      -> Vector Node'Parameter
      -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Method 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Method msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramStructType Cerial 'Const Method
Method 'Const
raw)
                              m (Word64
   -> Vector Annotation
   -> Brand
   -> Brand
   -> Vector Node'Parameter
   -> Method)
-> m Word64
-> m (Vector Annotation
      -> Brand -> Brand -> Vector Node'Parameter -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Method 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Method msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultStructType Cerial 'Const Method
Method 'Const
raw)
                              m (Vector Annotation
   -> Brand -> Brand -> Vector Node'Parameter -> Method)
-> m (Vector Annotation)
-> m (Brand -> Brand -> Vector Node'Parameter -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Method 'Const -> m (List 'Const (Annotation 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Method msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'annotations Cerial 'Const Method
Method 'Const
raw) m (List 'Const (Annotation 'Const))
-> (List 'Const (Annotation 'Const) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Annotation 'Const) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                              m (Brand -> Brand -> Vector Node'Parameter -> Method)
-> m Brand -> m (Brand -> Vector Node'Parameter -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Method 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Method msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramBrand Cerial 'Const Method
Method 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                              m (Brand -> Vector Node'Parameter -> Method)
-> m Brand -> m (Vector Node'Parameter -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Method 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Method msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultBrand Cerial 'Const Method
Method 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                              m (Vector Node'Parameter -> Method)
-> m (Vector Node'Parameter) -> m Method
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Method 'Const -> m (List 'Const (Node'Parameter 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Node'Parameter msg))) =>
Method msg -> m (List msg (Node'Parameter msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'implicitParameters Cerial 'Const Method
Method 'Const
raw) m (List 'Const (Node'Parameter 'Const))
-> (List 'Const (Node'Parameter 'Const)
    -> m (Vector Node'Parameter))
-> m (Vector Node'Parameter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node'Parameter 'Const) -> m (Vector Node'Parameter)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Method) where
    marshalInto :: Cerial ('Mut s) Method -> Method -> m ()
marshalInto Cerial ('Mut s) Method
raw_ Method
value_ = case Method
value_ of
        Method{Word16
Word64
Text
Vector Annotation
Vector Node'Parameter
Brand
implicitParameters :: Vector Node'Parameter
resultBrand :: Brand
paramBrand :: Brand
annotations :: Vector Annotation
resultStructType :: Word64
paramStructType :: Word64
codeOrder :: Word16
name :: Text
$sel:implicitParameters:Method :: Method -> Vector Node'Parameter
$sel:resultBrand:Method :: Method -> Brand
$sel:paramBrand:Method :: Method -> Brand
$sel:annotations:Method :: Method -> Vector Annotation
$sel:resultStructType:Method :: Method -> Word64
$sel:paramStructType:Method :: Method -> Word64
$sel:codeOrder:Method :: Method -> Word16
$sel:name:Method :: Method -> Text
..} ->
            (do
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Method ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Method
Method ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Method ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'name Cerial ('Mut s) Method
Method ('Mut s)
raw_))
                (Method ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'codeOrder Cerial ('Mut s) Method
Method ('Mut s)
raw_ Word16
codeOrder)
                (Method ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramStructType Cerial ('Mut s) Method
Method ('Mut s)
raw_ Word64
paramStructType)
                (Method ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultStructType Cerial ('Mut s) Method
Method ('Mut s)
raw_ Word64
resultStructType)
                ((Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Method ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Method
Method ('Mut s)
raw_) Vector Annotation
annotations) m (List ('Mut s) (Annotation ('Mut s)))
-> (List ('Mut s) (Annotation ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Annotation ('Mut s)))) =>
Method ('Mut s) -> List ('Mut s) (Annotation ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'annotations Cerial ('Mut s) Method
Method ('Mut s)
raw_))
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Method ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Method
Method ('Mut s)
raw_) Brand
paramBrand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Method ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramBrand Cerial ('Mut s) Method
Method ('Mut s)
raw_))
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Method ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Method
Method ('Mut s)
raw_) Brand
resultBrand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Method ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultBrand Cerial ('Mut s) Method
Method ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Node'Parameter
-> m (Cerial ('Mut s) (Vector Node'Parameter))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Method ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Method
Method ('Mut s)
raw_) Vector Node'Parameter
implicitParameters) m (List ('Mut s) (Node'Parameter ('Mut s)))
-> (List ('Mut s) (Node'Parameter ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method ('Mut s) -> List ('Mut s) (Node'Parameter ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Node'Parameter ('Mut s)))) =>
Method ('Mut s) -> List ('Mut s) (Node'Parameter ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'implicitParameters Cerial ('Mut s) Method
Method ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Method)
instance (Classes.Cerialize s (V.Vector Method)) where
    cerialize :: Message ('Mut s)
-> Vector Method -> m (Cerial ('Mut s) (Vector Method))
cerialize  = Message ('Mut s)
-> Vector Method -> m (Cerial ('Mut s) (Vector Method))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Method))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Method)
-> m (Cerial ('Mut s) (Vector (Vector Method)))
cerialize  = Message ('Mut s)
-> Vector (Vector Method)
-> m (Cerial ('Mut s) (Vector (Vector Method)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Method)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Method))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Method))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Method))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Method))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Method))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Method)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Method)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Method)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Method)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Method))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Method))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Method))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Method))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Method)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Method)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Method)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Method)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Method))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Method))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Method))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Method))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
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 Type'list
    | Type'enum Type'enum
    | Type'struct Type'struct
    | Type'interface Type'interface
    | Type'anyPointer Type'anyPointer
    | Type'unknown' Std_.Word16
    deriving(Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Std_.Show
            ,Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Std_.Eq
            ,(forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generics.Generic)
instance (Default.Default Type) where
    def :: Type
def  = Type
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type) where
    fromStruct :: Struct 'Const -> m Type
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type 'Const) -> (Type 'Const -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type 'Const -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type) where
    type Cerial msg Type = (Capnp.Gen.ById.Xa93fc509624c72d9.Type msg)
    decerialize :: Cerial 'Const Type -> m Type
decerialize Cerial 'Const Type
raw = (do
        Type' 'Const
raw <- (Type 'Const -> m (Type' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Type' msg)) =>
Type msg -> m (Type' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type' Cerial 'Const Type
Type 'Const
raw)
        case Type' 'Const
raw of
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'void) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'void)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'bool) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'bool)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int8) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int8)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int16) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int16)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int32)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int64)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint8) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint8)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint16) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint16)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint32)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint64)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'float32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'float32)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'float64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'float64)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'text) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'text)
            (Type' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'data_) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'data_)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'list Type'list 'Const
raw) ->
                (Type'list -> Type
Type'list (Type'list -> Type) -> m Type'list -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'list -> m Type'list
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'list
Type'list 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'enum Type'enum 'Const
raw) ->
                (Type'enum -> Type
Type'enum (Type'enum -> Type) -> m Type'enum -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'enum -> m Type'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'enum
Type'enum 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'struct Type'struct 'Const
raw) ->
                (Type'struct -> Type
Type'struct (Type'struct -> Type) -> m Type'struct -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'struct -> m Type'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'struct
Type'struct 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'interface Type'interface 'Const
raw) ->
                (Type'interface -> Type
Type'interface (Type'interface -> Type) -> m Type'interface -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'interface -> m Type'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'interface
Type'interface 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer Type'anyPointer 'Const
raw) ->
                (Type'anyPointer -> Type
Type'anyPointer (Type'anyPointer -> Type) -> m Type'anyPointer -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'anyPointer -> m Type'anyPointer
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'anyPointer
Type'anyPointer 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'unknown' Word16
tag) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type
Type'unknown' Word16
tag))
        )
instance (Classes.Marshal s Type) where
    marshalInto :: Cerial ('Mut s) Type -> Type -> m ()
marshalInto Cerial ('Mut s) Type
raw_ Type
value_ = case Type
value_ of
        (Type
Type'void) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'void Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'bool) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'bool Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'int8) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int8 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'int16) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int16 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'int32) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int32 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'int64) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int64 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'uint8) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint8 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'uint16) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint16 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'uint32) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint32 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'uint64) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint64 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'float32) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float32 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'float64) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float64 Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'text) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'text Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type
Type'data_) ->
            (Type ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'data_ Cerial ('Mut s) Type
Type ('Mut s)
raw_)
        (Type'list Type'list
arg_) ->
            (do
                Type'list ('Mut s)
raw_ <- (Type ('Mut s) -> m (Type'list ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Type'list ('Mut s))) =>
Type ('Mut s) -> m (Type'list ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list Cerial ('Mut s) Type
Type ('Mut s)
raw_)
                (Cerial ('Mut s) Type'list -> Type'list -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'list
Type'list ('Mut s)
raw_ Type'list
arg_)
                )
        (Type'enum Type'enum
arg_) ->
            (do
                Type'enum ('Mut s)
raw_ <- (Type ('Mut s) -> m (Type'enum ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Type'enum ('Mut s))) =>
Type ('Mut s) -> m (Type'enum ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum Cerial ('Mut s) Type
Type ('Mut s)
raw_)
                (Cerial ('Mut s) Type'enum -> Type'enum -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'enum
Type'enum ('Mut s)
raw_ Type'enum
arg_)
                )
        (Type'struct Type'struct
arg_) ->
            (do
                Type'struct ('Mut s)
raw_ <- (Type ('Mut s) -> m (Type'struct ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Type'struct ('Mut s))) =>
Type ('Mut s) -> m (Type'struct ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct Cerial ('Mut s) Type
Type ('Mut s)
raw_)
                (Cerial ('Mut s) Type'struct -> Type'struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'struct
Type'struct ('Mut s)
raw_ Type'struct
arg_)
                )
        (Type'interface Type'interface
arg_) ->
            (do
                Type'interface ('Mut s)
raw_ <- (Type ('Mut s) -> m (Type'interface ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Type'interface ('Mut s))) =>
Type ('Mut s) -> m (Type'interface ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface Cerial ('Mut s) Type
Type ('Mut s)
raw_)
                (Cerial ('Mut s) Type'interface -> Type'interface -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'interface
Type'interface ('Mut s)
raw_ Type'interface
arg_)
                )
        (Type'anyPointer Type'anyPointer
arg_) ->
            (do
                Type'anyPointer ('Mut s)
raw_ <- (Type ('Mut s) -> m (Type'anyPointer ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct ('Mut s) (Type'anyPointer ('Mut s))) =>
Type ('Mut s) -> m (Type'anyPointer ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer Cerial ('Mut s) Type
Type ('Mut s)
raw_)
                (Cerial ('Mut s) Type'anyPointer -> Type'anyPointer -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'anyPointer
Type'anyPointer ('Mut s)
raw_ Type'anyPointer
arg_)
                )
        (Type'unknown' Word16
tag) ->
            (Type ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'unknown' Cerial ('Mut s) Type
Type ('Mut s)
raw_ Word16
tag)
instance (Classes.Cerialize s Type)
instance (Classes.Cerialize s (V.Vector Type)) where
    cerialize :: Message ('Mut s)
-> Vector Type -> m (Cerial ('Mut s) (Vector Type))
cerialize  = Message ('Mut s)
-> Vector Type -> m (Cerial ('Mut s) (Vector Type))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Type))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Type)
-> m (Cerial ('Mut s) (Vector (Vector Type)))
cerialize  = Message ('Mut s)
-> Vector (Vector Type)
-> m (Cerial ('Mut s) (Vector (Vector Type)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Type)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Type))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Type))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Type))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Type))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Type))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Type)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Type)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Type)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Type)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Type))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Type))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Type))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Type))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Type)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Type)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Type)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Type)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Type))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Type))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Type))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Type))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Type'list 
    = Type'list' 
        {Type'list -> Type
elementType :: Type}
    deriving(Int -> Type'list -> ShowS
[Type'list] -> ShowS
Type'list -> String
(Int -> Type'list -> ShowS)
-> (Type'list -> String)
-> ([Type'list] -> ShowS)
-> Show Type'list
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'list] -> ShowS
$cshowList :: [Type'list] -> ShowS
show :: Type'list -> String
$cshow :: Type'list -> String
showsPrec :: Int -> Type'list -> ShowS
$cshowsPrec :: Int -> Type'list -> ShowS
Std_.Show
            ,Type'list -> Type'list -> Bool
(Type'list -> Type'list -> Bool)
-> (Type'list -> Type'list -> Bool) -> Eq Type'list
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'list -> Type'list -> Bool
$c/= :: Type'list -> Type'list -> Bool
== :: Type'list -> Type'list -> Bool
$c== :: Type'list -> Type'list -> Bool
Std_.Eq
            ,(forall x. Type'list -> Rep Type'list x)
-> (forall x. Rep Type'list x -> Type'list) -> Generic Type'list
forall x. Rep Type'list x -> Type'list
forall x. Type'list -> Rep Type'list x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type'list x -> Type'list
$cfrom :: forall x. Type'list -> Rep Type'list x
Generics.Generic)
instance (Default.Default Type'list) where
    def :: Type'list
def  = Type'list
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'list) where
    fromStruct :: Struct 'Const -> m Type'list
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'list 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'list 'Const)
-> (Type'list 'Const -> m Type'list) -> m Type'list
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'list 'Const -> m Type'list
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'list) where
    type Cerial msg Type'list = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'list msg)
    decerialize :: Cerial 'Const Type'list -> m Type'list
decerialize Cerial 'Const Type'list
raw = (Type -> Type'list
Type'list' (Type -> Type'list) -> m Type -> m Type'list
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Type'list 'Const -> m (Type 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Type'list msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'list'elementType Cerial 'Const Type'list
Type'list 'Const
raw) m (Type 'Const) -> (Type 'Const -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type 'Const -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Type'list) where
    marshalInto :: Cerial ('Mut s) Type'list -> Type'list -> m ()
marshalInto Cerial ('Mut s) Type'list
raw_ Type'list
value_ = case Type'list
value_ of
        Type'list'{Type
elementType :: Type
$sel:elementType:Type'list' :: Type'list -> Type
..} ->
            (do
                ((Message ('Mut s) -> Type -> m (Cerial ('Mut s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Type'list ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Type'list
Type'list ('Mut s)
raw_) Type
elementType) m (Type ('Mut s)) -> (Type ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'list ('Mut s) -> Type ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type ('Mut s))) =>
Type'list ('Mut s) -> Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list'elementType Cerial ('Mut s) Type'list
Type'list ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Type'enum 
    = Type'enum' 
        {Type'enum -> Word64
typeId :: Std_.Word64
        ,Type'enum -> Brand
brand :: Brand}
    deriving(Int -> Type'enum -> ShowS
[Type'enum] -> ShowS
Type'enum -> String
(Int -> Type'enum -> ShowS)
-> (Type'enum -> String)
-> ([Type'enum] -> ShowS)
-> Show Type'enum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'enum] -> ShowS
$cshowList :: [Type'enum] -> ShowS
show :: Type'enum -> String
$cshow :: Type'enum -> String
showsPrec :: Int -> Type'enum -> ShowS
$cshowsPrec :: Int -> Type'enum -> ShowS
Std_.Show
            ,Type'enum -> Type'enum -> Bool
(Type'enum -> Type'enum -> Bool)
-> (Type'enum -> Type'enum -> Bool) -> Eq Type'enum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'enum -> Type'enum -> Bool
$c/= :: Type'enum -> Type'enum -> Bool
== :: Type'enum -> Type'enum -> Bool
$c== :: Type'enum -> Type'enum -> Bool
Std_.Eq
            ,(forall x. Type'enum -> Rep Type'enum x)
-> (forall x. Rep Type'enum x -> Type'enum) -> Generic Type'enum
forall x. Rep Type'enum x -> Type'enum
forall x. Type'enum -> Rep Type'enum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type'enum x -> Type'enum
$cfrom :: forall x. Type'enum -> Rep Type'enum x
Generics.Generic)
instance (Default.Default Type'enum) where
    def :: Type'enum
def  = Type'enum
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'enum) where
    fromStruct :: Struct 'Const -> m Type'enum
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'enum 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'enum 'Const)
-> (Type'enum 'Const -> m Type'enum) -> m Type'enum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'enum 'Const -> m Type'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'enum) where
    type Cerial msg Type'enum = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'enum msg)
    decerialize :: Cerial 'Const Type'enum -> m Type'enum
decerialize Cerial 'Const Type'enum
raw = (Word64 -> Brand -> Type'enum
Type'enum' (Word64 -> Brand -> Type'enum)
-> m Word64 -> m (Brand -> Type'enum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type'enum 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'enum msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'typeId Cerial 'Const Type'enum
Type'enum 'Const
raw)
                                  m (Brand -> Type'enum) -> m Brand -> m Type'enum
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Type'enum 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'enum msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'brand Cerial 'Const Type'enum
Type'enum 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Type'enum) where
    marshalInto :: Cerial ('Mut s) Type'enum -> Type'enum -> m ()
marshalInto Cerial ('Mut s) Type'enum
raw_ Type'enum
value_ = case Type'enum
value_ of
        Type'enum'{Word64
Brand
brand :: Brand
typeId :: Word64
$sel:brand:Type'enum' :: Type'enum -> Brand
$sel:typeId:Type'enum' :: Type'enum -> Word64
..} ->
            (do
                (Type'enum ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'enum ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'typeId Cerial ('Mut s) Type'enum
Type'enum ('Mut s)
raw_ Word64
typeId)
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Type'enum ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Type'enum
Type'enum ('Mut s)
raw_) Brand
brand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'enum ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Type'enum ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'brand Cerial ('Mut s) Type'enum
Type'enum ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Type'struct 
    = Type'struct' 
        {Type'struct -> Word64
typeId :: Std_.Word64
        ,Type'struct -> Brand
brand :: Brand}
    deriving(Int -> Type'struct -> ShowS
[Type'struct] -> ShowS
Type'struct -> String
(Int -> Type'struct -> ShowS)
-> (Type'struct -> String)
-> ([Type'struct] -> ShowS)
-> Show Type'struct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'struct] -> ShowS
$cshowList :: [Type'struct] -> ShowS
show :: Type'struct -> String
$cshow :: Type'struct -> String
showsPrec :: Int -> Type'struct -> ShowS
$cshowsPrec :: Int -> Type'struct -> ShowS
Std_.Show
            ,Type'struct -> Type'struct -> Bool
(Type'struct -> Type'struct -> Bool)
-> (Type'struct -> Type'struct -> Bool) -> Eq Type'struct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'struct -> Type'struct -> Bool
$c/= :: Type'struct -> Type'struct -> Bool
== :: Type'struct -> Type'struct -> Bool
$c== :: Type'struct -> Type'struct -> Bool
Std_.Eq
            ,(forall x. Type'struct -> Rep Type'struct x)
-> (forall x. Rep Type'struct x -> Type'struct)
-> Generic Type'struct
forall x. Rep Type'struct x -> Type'struct
forall x. Type'struct -> Rep Type'struct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type'struct x -> Type'struct
$cfrom :: forall x. Type'struct -> Rep Type'struct x
Generics.Generic)
instance (Default.Default Type'struct) where
    def :: Type'struct
def  = Type'struct
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'struct) where
    fromStruct :: Struct 'Const -> m Type'struct
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'struct 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'struct 'Const)
-> (Type'struct 'Const -> m Type'struct) -> m Type'struct
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'struct 'Const -> m Type'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'struct) where
    type Cerial msg Type'struct = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'struct msg)
    decerialize :: Cerial 'Const Type'struct -> m Type'struct
decerialize Cerial 'Const Type'struct
raw = (Word64 -> Brand -> Type'struct
Type'struct' (Word64 -> Brand -> Type'struct)
-> m Word64 -> m (Brand -> Type'struct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type'struct 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'struct msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'typeId Cerial 'Const Type'struct
Type'struct 'Const
raw)
                                    m (Brand -> Type'struct) -> m Brand -> m Type'struct
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Type'struct 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'struct msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'brand Cerial 'Const Type'struct
Type'struct 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Type'struct) where
    marshalInto :: Cerial ('Mut s) Type'struct -> Type'struct -> m ()
marshalInto Cerial ('Mut s) Type'struct
raw_ Type'struct
value_ = case Type'struct
value_ of
        Type'struct'{Word64
Brand
brand :: Brand
typeId :: Word64
$sel:brand:Type'struct' :: Type'struct -> Brand
$sel:typeId:Type'struct' :: Type'struct -> Word64
..} ->
            (do
                (Type'struct ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'struct ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'typeId Cerial ('Mut s) Type'struct
Type'struct ('Mut s)
raw_ Word64
typeId)
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Type'struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Type'struct
Type'struct ('Mut s)
raw_) Brand
brand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'struct ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Type'struct ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'brand Cerial ('Mut s) Type'struct
Type'struct ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Type'interface 
    = Type'interface' 
        {Type'interface -> Word64
typeId :: Std_.Word64
        ,Type'interface -> Brand
brand :: Brand}
    deriving(Int -> Type'interface -> ShowS
[Type'interface] -> ShowS
Type'interface -> String
(Int -> Type'interface -> ShowS)
-> (Type'interface -> String)
-> ([Type'interface] -> ShowS)
-> Show Type'interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'interface] -> ShowS
$cshowList :: [Type'interface] -> ShowS
show :: Type'interface -> String
$cshow :: Type'interface -> String
showsPrec :: Int -> Type'interface -> ShowS
$cshowsPrec :: Int -> Type'interface -> ShowS
Std_.Show
            ,Type'interface -> Type'interface -> Bool
(Type'interface -> Type'interface -> Bool)
-> (Type'interface -> Type'interface -> Bool) -> Eq Type'interface
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'interface -> Type'interface -> Bool
$c/= :: Type'interface -> Type'interface -> Bool
== :: Type'interface -> Type'interface -> Bool
$c== :: Type'interface -> Type'interface -> Bool
Std_.Eq
            ,(forall x. Type'interface -> Rep Type'interface x)
-> (forall x. Rep Type'interface x -> Type'interface)
-> Generic Type'interface
forall x. Rep Type'interface x -> Type'interface
forall x. Type'interface -> Rep Type'interface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type'interface x -> Type'interface
$cfrom :: forall x. Type'interface -> Rep Type'interface x
Generics.Generic)
instance (Default.Default Type'interface) where
    def :: Type'interface
def  = Type'interface
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'interface) where
    fromStruct :: Struct 'Const -> m Type'interface
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'interface 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'interface 'Const)
-> (Type'interface 'Const -> m Type'interface) -> m Type'interface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'interface 'Const -> m Type'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'interface) where
    type Cerial msg Type'interface = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'interface msg)
    decerialize :: Cerial 'Const Type'interface -> m Type'interface
decerialize Cerial 'Const Type'interface
raw = (Word64 -> Brand -> Type'interface
Type'interface' (Word64 -> Brand -> Type'interface)
-> m Word64 -> m (Brand -> Type'interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type'interface 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'interface msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'typeId Cerial 'Const Type'interface
Type'interface 'Const
raw)
                                       m (Brand -> Type'interface) -> m Brand -> m Type'interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Type'interface 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'interface msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'brand Cerial 'Const Type'interface
Type'interface 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Type'interface) where
    marshalInto :: Cerial ('Mut s) Type'interface -> Type'interface -> m ()
marshalInto Cerial ('Mut s) Type'interface
raw_ Type'interface
value_ = case Type'interface
value_ of
        Type'interface'{Word64
Brand
brand :: Brand
typeId :: Word64
$sel:brand:Type'interface' :: Type'interface -> Brand
$sel:typeId:Type'interface' :: Type'interface -> Word64
..} ->
            (do
                (Type'interface ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'interface ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'typeId Cerial ('Mut s) Type'interface
Type'interface ('Mut s)
raw_ Word64
typeId)
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Type'interface ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Type'interface
Type'interface ('Mut s)
raw_) Brand
brand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'interface ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Type'interface ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'brand Cerial ('Mut s) Type'interface
Type'interface ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Type'anyPointer 
    = Type'anyPointer'unconstrained Type'anyPointer'unconstrained
    | Type'anyPointer'parameter Type'anyPointer'parameter
    | Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter
    | Type'anyPointer'unknown' Std_.Word16
    deriving(Int -> Type'anyPointer -> ShowS
[Type'anyPointer] -> ShowS
Type'anyPointer -> String
(Int -> Type'anyPointer -> ShowS)
-> (Type'anyPointer -> String)
-> ([Type'anyPointer] -> ShowS)
-> Show Type'anyPointer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'anyPointer] -> ShowS
$cshowList :: [Type'anyPointer] -> ShowS
show :: Type'anyPointer -> String
$cshow :: Type'anyPointer -> String
showsPrec :: Int -> Type'anyPointer -> ShowS
$cshowsPrec :: Int -> Type'anyPointer -> ShowS
Std_.Show
            ,Type'anyPointer -> Type'anyPointer -> Bool
(Type'anyPointer -> Type'anyPointer -> Bool)
-> (Type'anyPointer -> Type'anyPointer -> Bool)
-> Eq Type'anyPointer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'anyPointer -> Type'anyPointer -> Bool
$c/= :: Type'anyPointer -> Type'anyPointer -> Bool
== :: Type'anyPointer -> Type'anyPointer -> Bool
$c== :: Type'anyPointer -> Type'anyPointer -> Bool
Std_.Eq
            ,(forall x. Type'anyPointer -> Rep Type'anyPointer x)
-> (forall x. Rep Type'anyPointer x -> Type'anyPointer)
-> Generic Type'anyPointer
forall x. Rep Type'anyPointer x -> Type'anyPointer
forall x. Type'anyPointer -> Rep Type'anyPointer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type'anyPointer x -> Type'anyPointer
$cfrom :: forall x. Type'anyPointer -> Rep Type'anyPointer x
Generics.Generic)
instance (Default.Default Type'anyPointer) where
    def :: Type'anyPointer
def  = Type'anyPointer
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'anyPointer) where
    fromStruct :: Struct 'Const -> m Type'anyPointer
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'anyPointer 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'anyPointer 'Const)
-> (Type'anyPointer 'Const -> m Type'anyPointer)
-> m Type'anyPointer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer 'Const -> m Type'anyPointer
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'anyPointer) where
    type Cerial msg Type'anyPointer = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer msg)
    decerialize :: Cerial 'Const Type'anyPointer -> m Type'anyPointer
decerialize Cerial 'Const Type'anyPointer
raw = (do
        Type'anyPointer' 'Const
raw <- (Type'anyPointer 'Const -> m (Type'anyPointer' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Type'anyPointer' msg)) =>
Type'anyPointer msg -> m (Type'anyPointer' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer' Cerial 'Const Type'anyPointer
Type'anyPointer 'Const
raw)
        case Type'anyPointer' 'Const
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained Type'anyPointer'unconstrained 'Const
raw) ->
                (Type'anyPointer'unconstrained -> Type'anyPointer
Type'anyPointer'unconstrained (Type'anyPointer'unconstrained -> Type'anyPointer)
-> m Type'anyPointer'unconstrained -> m Type'anyPointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'anyPointer'unconstrained
-> m Type'anyPointer'unconstrained
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'anyPointer'unconstrained
Type'anyPointer'unconstrained 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'parameter Type'anyPointer'parameter 'Const
raw) ->
                (Type'anyPointer'parameter -> Type'anyPointer
Type'anyPointer'parameter (Type'anyPointer'parameter -> Type'anyPointer)
-> m Type'anyPointer'parameter -> m Type'anyPointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'anyPointer'parameter
-> m Type'anyPointer'parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'anyPointer'parameter
Type'anyPointer'parameter 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter 'Const
raw) ->
                (Type'anyPointer'implicitMethodParameter -> Type'anyPointer
Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter -> Type'anyPointer)
-> m Type'anyPointer'implicitMethodParameter -> m Type'anyPointer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type'anyPointer'implicitMethodParameter
-> m Type'anyPointer'implicitMethodParameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unknown' Word16
tag) ->
                (Type'anyPointer -> m Type'anyPointer
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type'anyPointer
Type'anyPointer'unknown' Word16
tag))
        )
instance (Classes.Marshal s Type'anyPointer) where
    marshalInto :: Cerial ('Mut s) Type'anyPointer -> Type'anyPointer -> m ()
marshalInto Cerial ('Mut s) Type'anyPointer
raw_ Type'anyPointer
value_ = case Type'anyPointer
value_ of
        (Type'anyPointer'unconstrained Type'anyPointer'unconstrained
arg_) ->
            (do
                Type'anyPointer'unconstrained ('Mut s)
raw_ <- (Type'anyPointer ('Mut s)
-> m (Type'anyPointer'unconstrained ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct ('Mut s) (Type'anyPointer'unconstrained ('Mut s))) =>
Type'anyPointer ('Mut s)
-> m (Type'anyPointer'unconstrained ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained Cerial ('Mut s) Type'anyPointer
Type'anyPointer ('Mut s)
raw_)
                (Cerial ('Mut s) Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_ Type'anyPointer'unconstrained
arg_)
                )
        (Type'anyPointer'parameter Type'anyPointer'parameter
arg_) ->
            (do
                Type'anyPointer'parameter ('Mut s)
raw_ <- (Type'anyPointer ('Mut s) -> m (Type'anyPointer'parameter ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct ('Mut s) (Type'anyPointer'parameter ('Mut s))) =>
Type'anyPointer ('Mut s) -> m (Type'anyPointer'parameter ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter Cerial ('Mut s) Type'anyPointer
Type'anyPointer ('Mut s)
raw_)
                (Cerial ('Mut s) Type'anyPointer'parameter
-> Type'anyPointer'parameter -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'anyPointer'parameter
Type'anyPointer'parameter ('Mut s)
raw_ Type'anyPointer'parameter
arg_)
                )
        (Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter
arg_) ->
            (do
                Type'anyPointer'implicitMethodParameter ('Mut s)
raw_ <- (Type'anyPointer ('Mut s)
-> m (Type'anyPointer'implicitMethodParameter ('Mut s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct
   ('Mut s) (Type'anyPointer'implicitMethodParameter ('Mut s))) =>
Type'anyPointer ('Mut s)
-> m (Type'anyPointer'implicitMethodParameter ('Mut s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter Cerial ('Mut s) Type'anyPointer
Type'anyPointer ('Mut s)
raw_)
                (Cerial ('Mut s) Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter ('Mut s)
raw_ Type'anyPointer'implicitMethodParameter
arg_)
                )
        (Type'anyPointer'unknown' Word16
tag) ->
            (Type'anyPointer ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unknown' Cerial ('Mut s) Type'anyPointer
Type'anyPointer ('Mut s)
raw_ Word16
tag)
data Type'anyPointer'unconstrained 
    = Type'anyPointer'unconstrained'anyKind 
    | Type'anyPointer'unconstrained'struct 
    | Type'anyPointer'unconstrained'list 
    | Type'anyPointer'unconstrained'capability 
    | Type'anyPointer'unconstrained'unknown' Std_.Word16
    deriving(Int -> Type'anyPointer'unconstrained -> ShowS
[Type'anyPointer'unconstrained] -> ShowS
Type'anyPointer'unconstrained -> String
(Int -> Type'anyPointer'unconstrained -> ShowS)
-> (Type'anyPointer'unconstrained -> String)
-> ([Type'anyPointer'unconstrained] -> ShowS)
-> Show Type'anyPointer'unconstrained
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'anyPointer'unconstrained] -> ShowS
$cshowList :: [Type'anyPointer'unconstrained] -> ShowS
show :: Type'anyPointer'unconstrained -> String
$cshow :: Type'anyPointer'unconstrained -> String
showsPrec :: Int -> Type'anyPointer'unconstrained -> ShowS
$cshowsPrec :: Int -> Type'anyPointer'unconstrained -> ShowS
Std_.Show
            ,Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> Bool
(Type'anyPointer'unconstrained
 -> Type'anyPointer'unconstrained -> Bool)
-> (Type'anyPointer'unconstrained
    -> Type'anyPointer'unconstrained -> Bool)
-> Eq Type'anyPointer'unconstrained
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> Bool
$c/= :: Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> Bool
== :: Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> Bool
$c== :: Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> Bool
Std_.Eq
            ,(forall x.
 Type'anyPointer'unconstrained
 -> Rep Type'anyPointer'unconstrained x)
-> (forall x.
    Rep Type'anyPointer'unconstrained x
    -> Type'anyPointer'unconstrained)
-> Generic Type'anyPointer'unconstrained
forall x.
Rep Type'anyPointer'unconstrained x
-> Type'anyPointer'unconstrained
forall x.
Type'anyPointer'unconstrained
-> Rep Type'anyPointer'unconstrained x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep Type'anyPointer'unconstrained x
-> Type'anyPointer'unconstrained
$cfrom :: forall x.
Type'anyPointer'unconstrained
-> Rep Type'anyPointer'unconstrained x
Generics.Generic)
instance (Default.Default Type'anyPointer'unconstrained) where
    def :: Type'anyPointer'unconstrained
def  = Type'anyPointer'unconstrained
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'anyPointer'unconstrained) where
    fromStruct :: Struct 'Const -> m Type'anyPointer'unconstrained
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'anyPointer'unconstrained 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'anyPointer'unconstrained 'Const)
-> (Type'anyPointer'unconstrained 'Const
    -> m Type'anyPointer'unconstrained)
-> m Type'anyPointer'unconstrained
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'unconstrained 'Const
-> m Type'anyPointer'unconstrained
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'anyPointer'unconstrained) where
    type Cerial msg Type'anyPointer'unconstrained = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained msg)
    decerialize :: Cerial 'Const Type'anyPointer'unconstrained
-> m Type'anyPointer'unconstrained
decerialize Cerial 'Const Type'anyPointer'unconstrained
raw = (do
        Type'anyPointer'unconstrained' 'Const
raw <- (Type'anyPointer'unconstrained 'Const
-> m (Type'anyPointer'unconstrained' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg,
 FromStruct msg (Type'anyPointer'unconstrained' msg)) =>
Type'anyPointer'unconstrained msg
-> m (Type'anyPointer'unconstrained' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained' Cerial 'Const Type'anyPointer'unconstrained
Type'anyPointer'unconstrained 'Const
raw)
        case Type'anyPointer'unconstrained' 'Const
raw of
            (Type'anyPointer'unconstrained' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'anyKind) ->
                (Type'anyPointer'unconstrained -> m Type'anyPointer'unconstrained
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'anyKind)
            (Type'anyPointer'unconstrained' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'struct) ->
                (Type'anyPointer'unconstrained -> m Type'anyPointer'unconstrained
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'struct)
            (Type'anyPointer'unconstrained' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'list) ->
                (Type'anyPointer'unconstrained -> m Type'anyPointer'unconstrained
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'list)
            (Type'anyPointer'unconstrained' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'capability) ->
                (Type'anyPointer'unconstrained -> m Type'anyPointer'unconstrained
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'capability)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'unknown' Word16
tag) ->
                (Type'anyPointer'unconstrained -> m Type'anyPointer'unconstrained
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'unknown' Word16
tag))
        )
instance (Classes.Marshal s Type'anyPointer'unconstrained) where
    marshalInto :: Cerial ('Mut s) Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> m ()
marshalInto Cerial ('Mut s) Type'anyPointer'unconstrained
raw_ Type'anyPointer'unconstrained
value_ = case Type'anyPointer'unconstrained
value_ of
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'anyKind) ->
            (Type'anyPointer'unconstrained ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'anyKind Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'struct) ->
            (Type'anyPointer'unconstrained ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'struct Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'list) ->
            (Type'anyPointer'unconstrained ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'list Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'capability) ->
            (Type'anyPointer'unconstrained ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'capability Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_)
        (Type'anyPointer'unconstrained'unknown' Word16
tag) ->
            (Type'anyPointer'unconstrained ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'unknown' Cerial ('Mut s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ('Mut s)
raw_ Word16
tag)
data Type'anyPointer'parameter 
    = Type'anyPointer'parameter' 
        {Type'anyPointer'parameter -> Word64
scopeId :: Std_.Word64
        ,Type'anyPointer'parameter -> Word16
parameterIndex :: Std_.Word16}
    deriving(Int -> Type'anyPointer'parameter -> ShowS
[Type'anyPointer'parameter] -> ShowS
Type'anyPointer'parameter -> String
(Int -> Type'anyPointer'parameter -> ShowS)
-> (Type'anyPointer'parameter -> String)
-> ([Type'anyPointer'parameter] -> ShowS)
-> Show Type'anyPointer'parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'anyPointer'parameter] -> ShowS
$cshowList :: [Type'anyPointer'parameter] -> ShowS
show :: Type'anyPointer'parameter -> String
$cshow :: Type'anyPointer'parameter -> String
showsPrec :: Int -> Type'anyPointer'parameter -> ShowS
$cshowsPrec :: Int -> Type'anyPointer'parameter -> ShowS
Std_.Show
            ,Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool
(Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool)
-> (Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool)
-> Eq Type'anyPointer'parameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool
$c/= :: Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool
== :: Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool
$c== :: Type'anyPointer'parameter -> Type'anyPointer'parameter -> Bool
Std_.Eq
            ,(forall x.
 Type'anyPointer'parameter -> Rep Type'anyPointer'parameter x)
-> (forall x.
    Rep Type'anyPointer'parameter x -> Type'anyPointer'parameter)
-> Generic Type'anyPointer'parameter
forall x.
Rep Type'anyPointer'parameter x -> Type'anyPointer'parameter
forall x.
Type'anyPointer'parameter -> Rep Type'anyPointer'parameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep Type'anyPointer'parameter x -> Type'anyPointer'parameter
$cfrom :: forall x.
Type'anyPointer'parameter -> Rep Type'anyPointer'parameter x
Generics.Generic)
instance (Default.Default Type'anyPointer'parameter) where
    def :: Type'anyPointer'parameter
def  = Type'anyPointer'parameter
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'anyPointer'parameter) where
    fromStruct :: Struct 'Const -> m Type'anyPointer'parameter
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'anyPointer'parameter 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'anyPointer'parameter 'Const)
-> (Type'anyPointer'parameter 'Const
    -> m Type'anyPointer'parameter)
-> m Type'anyPointer'parameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'parameter 'Const -> m Type'anyPointer'parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'anyPointer'parameter) where
    type Cerial msg Type'anyPointer'parameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'parameter msg)
    decerialize :: Cerial 'Const Type'anyPointer'parameter
-> m Type'anyPointer'parameter
decerialize Cerial 'Const Type'anyPointer'parameter
raw = (Word64 -> Word16 -> Type'anyPointer'parameter
Type'anyPointer'parameter' (Word64 -> Word16 -> Type'anyPointer'parameter)
-> m Word64 -> m (Word16 -> Type'anyPointer'parameter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type'anyPointer'parameter 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'anyPointer'parameter msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'scopeId Cerial 'Const Type'anyPointer'parameter
Type'anyPointer'parameter 'Const
raw)
                                                  m (Word16 -> Type'anyPointer'parameter)
-> m Word16 -> m Type'anyPointer'parameter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type'anyPointer'parameter 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'anyPointer'parameter msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'parameterIndex Cerial 'Const Type'anyPointer'parameter
Type'anyPointer'parameter 'Const
raw))
instance (Classes.Marshal s Type'anyPointer'parameter) where
    marshalInto :: Cerial ('Mut s) Type'anyPointer'parameter
-> Type'anyPointer'parameter -> m ()
marshalInto Cerial ('Mut s) Type'anyPointer'parameter
raw_ Type'anyPointer'parameter
value_ = case Type'anyPointer'parameter
value_ of
        Type'anyPointer'parameter'{Word16
Word64
parameterIndex :: Word16
scopeId :: Word64
$sel:parameterIndex:Type'anyPointer'parameter' :: Type'anyPointer'parameter -> Word16
$sel:scopeId:Type'anyPointer'parameter' :: Type'anyPointer'parameter -> Word64
..} ->
            (do
                (Type'anyPointer'parameter ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'parameter ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'scopeId Cerial ('Mut s) Type'anyPointer'parameter
Type'anyPointer'parameter ('Mut s)
raw_ Word64
scopeId)
                (Type'anyPointer'parameter ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'parameter ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'parameterIndex Cerial ('Mut s) Type'anyPointer'parameter
Type'anyPointer'parameter ('Mut s)
raw_ Word16
parameterIndex)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Type'anyPointer'implicitMethodParameter 
    = Type'anyPointer'implicitMethodParameter' 
        {Type'anyPointer'implicitMethodParameter -> Word16
parameterIndex :: Std_.Word16}
    deriving(Int -> Type'anyPointer'implicitMethodParameter -> ShowS
[Type'anyPointer'implicitMethodParameter] -> ShowS
Type'anyPointer'implicitMethodParameter -> String
(Int -> Type'anyPointer'implicitMethodParameter -> ShowS)
-> (Type'anyPointer'implicitMethodParameter -> String)
-> ([Type'anyPointer'implicitMethodParameter] -> ShowS)
-> Show Type'anyPointer'implicitMethodParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type'anyPointer'implicitMethodParameter] -> ShowS
$cshowList :: [Type'anyPointer'implicitMethodParameter] -> ShowS
show :: Type'anyPointer'implicitMethodParameter -> String
$cshow :: Type'anyPointer'implicitMethodParameter -> String
showsPrec :: Int -> Type'anyPointer'implicitMethodParameter -> ShowS
$cshowsPrec :: Int -> Type'anyPointer'implicitMethodParameter -> ShowS
Std_.Show
            ,Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> Bool
(Type'anyPointer'implicitMethodParameter
 -> Type'anyPointer'implicitMethodParameter -> Bool)
-> (Type'anyPointer'implicitMethodParameter
    -> Type'anyPointer'implicitMethodParameter -> Bool)
-> Eq Type'anyPointer'implicitMethodParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> Bool
$c/= :: Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> Bool
== :: Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> Bool
$c== :: Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> Bool
Std_.Eq
            ,(forall x.
 Type'anyPointer'implicitMethodParameter
 -> Rep Type'anyPointer'implicitMethodParameter x)
-> (forall x.
    Rep Type'anyPointer'implicitMethodParameter x
    -> Type'anyPointer'implicitMethodParameter)
-> Generic Type'anyPointer'implicitMethodParameter
forall x.
Rep Type'anyPointer'implicitMethodParameter x
-> Type'anyPointer'implicitMethodParameter
forall x.
Type'anyPointer'implicitMethodParameter
-> Rep Type'anyPointer'implicitMethodParameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep Type'anyPointer'implicitMethodParameter x
-> Type'anyPointer'implicitMethodParameter
$cfrom :: forall x.
Type'anyPointer'implicitMethodParameter
-> Rep Type'anyPointer'implicitMethodParameter x
Generics.Generic)
instance (Default.Default Type'anyPointer'implicitMethodParameter) where
    def :: Type'anyPointer'implicitMethodParameter
def  = Type'anyPointer'implicitMethodParameter
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Type'anyPointer'implicitMethodParameter) where
    fromStruct :: Struct 'Const -> m Type'anyPointer'implicitMethodParameter
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Type'anyPointer'implicitMethodParameter 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Type'anyPointer'implicitMethodParameter 'Const)
-> (Type'anyPointer'implicitMethodParameter 'Const
    -> m Type'anyPointer'implicitMethodParameter)
-> m Type'anyPointer'implicitMethodParameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'implicitMethodParameter 'Const
-> m Type'anyPointer'implicitMethodParameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Type'anyPointer'implicitMethodParameter) where
    type Cerial msg Type'anyPointer'implicitMethodParameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter msg)
    decerialize :: Cerial 'Const Type'anyPointer'implicitMethodParameter
-> m Type'anyPointer'implicitMethodParameter
decerialize Cerial 'Const Type'anyPointer'implicitMethodParameter
raw = (Word16 -> Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter' (Word16 -> Type'anyPointer'implicitMethodParameter)
-> m Word16 -> m Type'anyPointer'implicitMethodParameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type'anyPointer'implicitMethodParameter 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Type'anyPointer'implicitMethodParameter msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'implicitMethodParameter'parameterIndex Cerial 'Const Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter 'Const
raw))
instance (Classes.Marshal s Type'anyPointer'implicitMethodParameter) where
    marshalInto :: Cerial ('Mut s) Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> m ()
marshalInto Cerial ('Mut s) Type'anyPointer'implicitMethodParameter
raw_ Type'anyPointer'implicitMethodParameter
value_ = case Type'anyPointer'implicitMethodParameter
value_ of
        Type'anyPointer'implicitMethodParameter'{Word16
parameterIndex :: Word16
$sel:parameterIndex:Type'anyPointer'implicitMethodParameter' :: Type'anyPointer'implicitMethodParameter -> Word16
..} ->
            (do
                (Type'anyPointer'implicitMethodParameter ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'implicitMethodParameter ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter'parameterIndex Cerial ('Mut s) Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter ('Mut s)
raw_ Word16
parameterIndex)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
data Brand 
    = Brand 
        {Brand -> Vector Brand'Scope
scopes :: (V.Vector Brand'Scope)}
    deriving(Int -> Brand -> ShowS
[Brand] -> ShowS
Brand -> String
(Int -> Brand -> ShowS)
-> (Brand -> String) -> ([Brand] -> ShowS) -> Show Brand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Brand] -> ShowS
$cshowList :: [Brand] -> ShowS
show :: Brand -> String
$cshow :: Brand -> String
showsPrec :: Int -> Brand -> ShowS
$cshowsPrec :: Int -> Brand -> ShowS
Std_.Show
            ,Brand -> Brand -> Bool
(Brand -> Brand -> Bool) -> (Brand -> Brand -> Bool) -> Eq Brand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brand -> Brand -> Bool
$c/= :: Brand -> Brand -> Bool
== :: Brand -> Brand -> Bool
$c== :: Brand -> Brand -> Bool
Std_.Eq
            ,(forall x. Brand -> Rep Brand x)
-> (forall x. Rep Brand x -> Brand) -> Generic Brand
forall x. Rep Brand x -> Brand
forall x. Brand -> Rep Brand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Brand x -> Brand
$cfrom :: forall x. Brand -> Rep Brand x
Generics.Generic)
instance (Default.Default Brand) where
    def :: Brand
def  = Brand
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Brand) where
    fromStruct :: Struct 'Const -> m Brand
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Brand 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Brand) where
    type Cerial msg Brand = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand msg)
    decerialize :: Cerial 'Const Brand -> m Brand
decerialize Cerial 'Const Brand
raw = (Vector Brand'Scope -> Brand
Brand (Vector Brand'Scope -> Brand) -> m (Vector Brand'Scope) -> m Brand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Brand 'Const -> m (List 'Const (Brand'Scope 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Brand'Scope msg))) =>
Brand msg -> m (List msg (Brand'Scope msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'scopes Cerial 'Const Brand
Brand 'Const
raw) m (List 'Const (Brand'Scope 'Const))
-> (List 'Const (Brand'Scope 'Const) -> m (Vector Brand'Scope))
-> m (Vector Brand'Scope)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Brand'Scope 'Const) -> m (Vector Brand'Scope)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Brand) where
    marshalInto :: Cerial ('Mut s) Brand -> Brand -> m ()
marshalInto Cerial ('Mut s) Brand
raw_ Brand
value_ = case Brand
value_ of
        Brand{Vector Brand'Scope
scopes :: Vector Brand'Scope
$sel:scopes:Brand :: Brand -> Vector Brand'Scope
..} ->
            (do
                ((Message ('Mut s)
-> Vector Brand'Scope -> m (Cerial ('Mut s) (Vector Brand'Scope))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Brand ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Brand
Brand ('Mut s)
raw_) Vector Brand'Scope
scopes) m (List ('Mut s) (Brand'Scope ('Mut s)))
-> (List ('Mut s) (Brand'Scope ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand ('Mut s) -> List ('Mut s) (Brand'Scope ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Brand'Scope ('Mut s)))) =>
Brand ('Mut s) -> List ('Mut s) (Brand'Scope ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'scopes Cerial ('Mut s) Brand
Brand ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Brand)
instance (Classes.Cerialize s (V.Vector Brand)) where
    cerialize :: Message ('Mut s)
-> Vector Brand -> m (Cerial ('Mut s) (Vector Brand))
cerialize  = Message ('Mut s)
-> Vector Brand -> m (Cerial ('Mut s) (Vector Brand))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Brand))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Brand)
-> m (Cerial ('Mut s) (Vector (Vector Brand)))
cerialize  = Message ('Mut s)
-> Vector (Vector Brand)
-> m (Cerial ('Mut s) (Vector (Vector Brand)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Brand)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Brand))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Brand))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Brand))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Brand)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Brand)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Brand))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Brand))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Brand)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Brand)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Brand'Scope 
    = Brand'Scope 
        {Brand'Scope -> Word64
scopeId :: Std_.Word64
        ,Brand'Scope -> Brand'Scope'
union' :: Brand'Scope'}
    deriving(Int -> Brand'Scope -> ShowS
[Brand'Scope] -> ShowS
Brand'Scope -> String
(Int -> Brand'Scope -> ShowS)
-> (Brand'Scope -> String)
-> ([Brand'Scope] -> ShowS)
-> Show Brand'Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Brand'Scope] -> ShowS
$cshowList :: [Brand'Scope] -> ShowS
show :: Brand'Scope -> String
$cshow :: Brand'Scope -> String
showsPrec :: Int -> Brand'Scope -> ShowS
$cshowsPrec :: Int -> Brand'Scope -> ShowS
Std_.Show
            ,Brand'Scope -> Brand'Scope -> Bool
(Brand'Scope -> Brand'Scope -> Bool)
-> (Brand'Scope -> Brand'Scope -> Bool) -> Eq Brand'Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brand'Scope -> Brand'Scope -> Bool
$c/= :: Brand'Scope -> Brand'Scope -> Bool
== :: Brand'Scope -> Brand'Scope -> Bool
$c== :: Brand'Scope -> Brand'Scope -> Bool
Std_.Eq
            ,(forall x. Brand'Scope -> Rep Brand'Scope x)
-> (forall x. Rep Brand'Scope x -> Brand'Scope)
-> Generic Brand'Scope
forall x. Rep Brand'Scope x -> Brand'Scope
forall x. Brand'Scope -> Rep Brand'Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Brand'Scope x -> Brand'Scope
$cfrom :: forall x. Brand'Scope -> Rep Brand'Scope x
Generics.Generic)
instance (Default.Default Brand'Scope) where
    def :: Brand'Scope
def  = Brand'Scope
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Brand'Scope) where
    fromStruct :: Struct 'Const -> m Brand'Scope
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Brand'Scope 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Brand'Scope 'Const)
-> (Brand'Scope 'Const -> m Brand'Scope) -> m Brand'Scope
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Scope 'Const -> m Brand'Scope
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Brand'Scope) where
    type Cerial msg Brand'Scope = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope msg)
    decerialize :: Cerial 'Const Brand'Scope -> m Brand'Scope
decerialize Cerial 'Const Brand'Scope
raw = (Word64 -> Brand'Scope' -> Brand'Scope
Brand'Scope (Word64 -> Brand'Scope' -> Brand'Scope)
-> m Word64 -> m (Brand'Scope' -> Brand'Scope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Brand'Scope 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Brand'Scope msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope'scopeId Cerial 'Const Brand'Scope
Brand'Scope 'Const
raw)
                                   m (Brand'Scope' -> Brand'Scope) -> m Brand'Scope' -> m Brand'Scope
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cerial 'Const Brand'Scope' -> m Brand'Scope'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Brand'Scope'
Cerial 'Const Brand'Scope
raw))
instance (Classes.Marshal s Brand'Scope) where
    marshalInto :: Cerial ('Mut s) Brand'Scope -> Brand'Scope -> m ()
marshalInto Cerial ('Mut s) Brand'Scope
raw_ Brand'Scope
value_ = case Brand'Scope
value_ of
        Brand'Scope{Word64
Brand'Scope'
union' :: Brand'Scope'
scopeId :: Word64
$sel:union':Brand'Scope :: Brand'Scope -> Brand'Scope'
$sel:scopeId:Brand'Scope :: Brand'Scope -> Word64
..} ->
            (do
                (Brand'Scope ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Scope ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'scopeId Cerial ('Mut s) Brand'Scope
Brand'Scope ('Mut s)
raw_ Word64
scopeId)
                (do
                    (Cerial ('Mut s) Brand'Scope' -> Brand'Scope' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
Classes.marshalInto Cerial ('Mut s) Brand'Scope'
Cerial ('Mut s) Brand'Scope
raw_ Brand'Scope'
union')
                    )
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Brand'Scope)
instance (Classes.Cerialize s (V.Vector Brand'Scope)) where
    cerialize :: Message ('Mut s)
-> Vector Brand'Scope -> m (Cerial ('Mut s) (Vector Brand'Scope))
cerialize  = Message ('Mut s)
-> Vector Brand'Scope -> m (Cerial ('Mut s) (Vector Brand'Scope))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Brand'Scope))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Brand'Scope)
-> m (Cerial ('Mut s) (Vector (Vector Brand'Scope)))
cerialize  = Message ('Mut s)
-> Vector (Vector Brand'Scope)
-> m (Cerial ('Mut s) (Vector (Vector Brand'Scope)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Brand'Scope)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Brand'Scope))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand'Scope))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Brand'Scope))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand'Scope))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand'Scope)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Brand'Scope)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand'Scope)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Brand'Scope)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand'Scope))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand'Scope))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Brand'Scope' 
    = Brand'Scope'bind (V.Vector Brand'Binding)
    | Brand'Scope'inherit 
    | Brand'Scope'unknown' Std_.Word16
    deriving(Int -> Brand'Scope' -> ShowS
[Brand'Scope'] -> ShowS
Brand'Scope' -> String
(Int -> Brand'Scope' -> ShowS)
-> (Brand'Scope' -> String)
-> ([Brand'Scope'] -> ShowS)
-> Show Brand'Scope'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Brand'Scope'] -> ShowS
$cshowList :: [Brand'Scope'] -> ShowS
show :: Brand'Scope' -> String
$cshow :: Brand'Scope' -> String
showsPrec :: Int -> Brand'Scope' -> ShowS
$cshowsPrec :: Int -> Brand'Scope' -> ShowS
Std_.Show
            ,Brand'Scope' -> Brand'Scope' -> Bool
(Brand'Scope' -> Brand'Scope' -> Bool)
-> (Brand'Scope' -> Brand'Scope' -> Bool) -> Eq Brand'Scope'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brand'Scope' -> Brand'Scope' -> Bool
$c/= :: Brand'Scope' -> Brand'Scope' -> Bool
== :: Brand'Scope' -> Brand'Scope' -> Bool
$c== :: Brand'Scope' -> Brand'Scope' -> Bool
Std_.Eq
            ,(forall x. Brand'Scope' -> Rep Brand'Scope' x)
-> (forall x. Rep Brand'Scope' x -> Brand'Scope')
-> Generic Brand'Scope'
forall x. Rep Brand'Scope' x -> Brand'Scope'
forall x. Brand'Scope' -> Rep Brand'Scope' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Brand'Scope' x -> Brand'Scope'
$cfrom :: forall x. Brand'Scope' -> Rep Brand'Scope' x
Generics.Generic)
instance (Default.Default Brand'Scope') where
    def :: Brand'Scope'
def  = Brand'Scope'
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Brand'Scope') where
    fromStruct :: Struct 'Const -> m Brand'Scope'
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Brand'Scope 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Brand'Scope 'Const)
-> (Brand'Scope 'Const -> m Brand'Scope') -> m Brand'Scope'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Scope 'Const -> m Brand'Scope'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Brand'Scope') where
    type Cerial msg Brand'Scope' = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope msg)
    decerialize :: Cerial 'Const Brand'Scope' -> m Brand'Scope'
decerialize Cerial 'Const Brand'Scope'
raw = (do
        Brand'Scope' 'Const
raw <- (Brand'Scope 'Const -> m (Brand'Scope' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Brand'Scope' msg)) =>
Brand'Scope msg -> m (Brand'Scope' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope' Cerial 'Const Brand'Scope'
Brand'Scope 'Const
raw)
        case Brand'Scope' 'Const
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'bind List 'Const (Brand'Binding 'Const)
raw) ->
                (Vector Brand'Binding -> Brand'Scope'
Brand'Scope'bind (Vector Brand'Binding -> Brand'Scope')
-> m (Vector Brand'Binding) -> m Brand'Scope'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const (Vector Brand'Binding) -> m (Vector Brand'Binding)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const (Vector Brand'Binding)
List 'Const (Brand'Binding 'Const)
raw))
            (Brand'Scope' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'inherit) ->
                (Brand'Scope' -> m Brand'Scope'
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand'Scope'
Brand'Scope'inherit)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'unknown' Word16
tag) ->
                (Brand'Scope' -> m Brand'Scope'
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Brand'Scope'
Brand'Scope'unknown' Word16
tag))
        )
instance (Classes.Marshal s Brand'Scope') where
    marshalInto :: Cerial ('Mut s) Brand'Scope' -> Brand'Scope' -> m ()
marshalInto Cerial ('Mut s) Brand'Scope'
raw_ Brand'Scope'
value_ = case Brand'Scope'
value_ of
        (Brand'Scope'bind Vector Brand'Binding
arg_) ->
            ((Message ('Mut s)
-> Vector Brand'Binding
-> m (Cerial ('Mut s) (Vector Brand'Binding))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Brand'Scope ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Brand'Scope'
Brand'Scope ('Mut s)
raw_) Vector Brand'Binding
arg_) m (List ('Mut s) (Brand'Binding ('Mut s)))
-> (List ('Mut s) (Brand'Binding ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand'Scope ('Mut s)
-> List ('Mut s) (Brand'Binding ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Brand'Binding ('Mut s)))) =>
Brand'Scope ('Mut s)
-> List ('Mut s) (Brand'Binding ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'bind Cerial ('Mut s) Brand'Scope'
Brand'Scope ('Mut s)
raw_))
        (Brand'Scope'
Brand'Scope'inherit) ->
            (Brand'Scope ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Brand'Scope ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'inherit Cerial ('Mut s) Brand'Scope'
Brand'Scope ('Mut s)
raw_)
        (Brand'Scope'unknown' Word16
tag) ->
            (Brand'Scope ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Scope ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'unknown' Cerial ('Mut s) Brand'Scope'
Brand'Scope ('Mut s)
raw_ Word16
tag)
data Brand'Binding 
    = Brand'Binding'unbound 
    | Brand'Binding'type_ Type
    | Brand'Binding'unknown' Std_.Word16
    deriving(Int -> Brand'Binding -> ShowS
[Brand'Binding] -> ShowS
Brand'Binding -> String
(Int -> Brand'Binding -> ShowS)
-> (Brand'Binding -> String)
-> ([Brand'Binding] -> ShowS)
-> Show Brand'Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Brand'Binding] -> ShowS
$cshowList :: [Brand'Binding] -> ShowS
show :: Brand'Binding -> String
$cshow :: Brand'Binding -> String
showsPrec :: Int -> Brand'Binding -> ShowS
$cshowsPrec :: Int -> Brand'Binding -> ShowS
Std_.Show
            ,Brand'Binding -> Brand'Binding -> Bool
(Brand'Binding -> Brand'Binding -> Bool)
-> (Brand'Binding -> Brand'Binding -> Bool) -> Eq Brand'Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brand'Binding -> Brand'Binding -> Bool
$c/= :: Brand'Binding -> Brand'Binding -> Bool
== :: Brand'Binding -> Brand'Binding -> Bool
$c== :: Brand'Binding -> Brand'Binding -> Bool
Std_.Eq
            ,(forall x. Brand'Binding -> Rep Brand'Binding x)
-> (forall x. Rep Brand'Binding x -> Brand'Binding)
-> Generic Brand'Binding
forall x. Rep Brand'Binding x -> Brand'Binding
forall x. Brand'Binding -> Rep Brand'Binding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Brand'Binding x -> Brand'Binding
$cfrom :: forall x. Brand'Binding -> Rep Brand'Binding x
Generics.Generic)
instance (Default.Default Brand'Binding) where
    def :: Brand'Binding
def  = Brand'Binding
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Brand'Binding) where
    fromStruct :: Struct 'Const -> m Brand'Binding
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Brand'Binding 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Brand'Binding 'Const)
-> (Brand'Binding 'Const -> m Brand'Binding) -> m Brand'Binding
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Binding 'Const -> m Brand'Binding
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Brand'Binding) where
    type Cerial msg Brand'Binding = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding msg)
    decerialize :: Cerial 'Const Brand'Binding -> m Brand'Binding
decerialize Cerial 'Const Brand'Binding
raw = (do
        Brand'Binding' 'Const
raw <- (Brand'Binding 'Const -> m (Brand'Binding' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Brand'Binding' msg)) =>
Brand'Binding msg -> m (Brand'Binding' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Binding' Cerial 'Const Brand'Binding
Brand'Binding 'Const
raw)
        case Brand'Binding' 'Const
raw of
            (Brand'Binding' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'unbound) ->
                (Brand'Binding -> m Brand'Binding
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand'Binding
Brand'Binding'unbound)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'type_ Type 'Const
raw) ->
                (Type -> Brand'Binding
Brand'Binding'type_ (Type -> Brand'Binding) -> m Type -> m Brand'Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Type -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Type
Type 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'unknown' Word16
tag) ->
                (Brand'Binding -> m Brand'Binding
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Brand'Binding
Brand'Binding'unknown' Word16
tag))
        )
instance (Classes.Marshal s Brand'Binding) where
    marshalInto :: Cerial ('Mut s) Brand'Binding -> Brand'Binding -> m ()
marshalInto Cerial ('Mut s) Brand'Binding
raw_ Brand'Binding
value_ = case Brand'Binding
value_ of
        (Brand'Binding
Brand'Binding'unbound) ->
            (Brand'Binding ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Brand'Binding ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unbound Cerial ('Mut s) Brand'Binding
Brand'Binding ('Mut s)
raw_)
        (Brand'Binding'type_ Type
arg_) ->
            ((Message ('Mut s) -> Type -> m (Cerial ('Mut s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Brand'Binding ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Brand'Binding
Brand'Binding ('Mut s)
raw_) Type
arg_) m (Type ('Mut s)) -> (Type ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand'Binding ('Mut s) -> Type ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type ('Mut s))) =>
Brand'Binding ('Mut s) -> Type ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'type_ Cerial ('Mut s) Brand'Binding
Brand'Binding ('Mut s)
raw_))
        (Brand'Binding'unknown' Word16
tag) ->
            (Brand'Binding ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Binding ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' Cerial ('Mut s) Brand'Binding
Brand'Binding ('Mut s)
raw_ Word16
tag)
instance (Classes.Cerialize s Brand'Binding)
instance (Classes.Cerialize s (V.Vector Brand'Binding)) where
    cerialize :: Message ('Mut s)
-> Vector Brand'Binding
-> m (Cerial ('Mut s) (Vector Brand'Binding))
cerialize  = Message ('Mut s)
-> Vector Brand'Binding
-> m (Cerial ('Mut s) (Vector Brand'Binding))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Brand'Binding))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Brand'Binding)
-> m (Cerial ('Mut s) (Vector (Vector Brand'Binding)))
cerialize  = Message ('Mut s)
-> Vector (Vector Brand'Binding)
-> m (Cerial ('Mut s) (Vector (Vector Brand'Binding)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Brand'Binding)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Brand'Binding))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand'Binding))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Brand'Binding))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Brand'Binding))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand'Binding)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Brand'Binding)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Brand'Binding)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Brand'Binding)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand'Binding))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Brand'Binding))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Value 
    = Value'void 
    | Value'bool Std_.Bool
    | Value'int8 Std_.Int8
    | Value'int16 Std_.Int16
    | Value'int32 Std_.Int32
    | Value'int64 Std_.Int64
    | Value'uint8 Std_.Word8
    | Value'uint16 Std_.Word16
    | Value'uint32 Std_.Word32
    | Value'uint64 Std_.Word64
    | Value'float32 Std_.Float
    | Value'float64 Std_.Double
    | Value'text T.Text
    | Value'data_ BS.ByteString
    | Value'list (Std_.Maybe UntypedPure.Ptr)
    | Value'enum Std_.Word16
    | Value'struct (Std_.Maybe UntypedPure.Ptr)
    | Value'interface 
    | Value'anyPointer (Std_.Maybe UntypedPure.Ptr)
    | Value'unknown' Std_.Word16
    deriving(Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Std_.Show
            ,Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Std_.Eq
            ,(forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generics.Generic)
instance (Default.Default Value) where
    def :: Value
def  = Value
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Value) where
    fromStruct :: Struct 'Const -> m Value
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Value 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Value 'Const) -> (Value 'Const -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value 'Const -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Value) where
    type Cerial msg Value = (Capnp.Gen.ById.Xa93fc509624c72d9.Value msg)
    decerialize :: Cerial 'Const Value -> m Value
decerialize Cerial 'Const Value
raw = (do
        Value' 'Const
raw <- (Value 'Const -> m (Value' 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromStruct msg (Value' msg)) =>
Value msg -> m (Value' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Value' Cerial 'Const Value
Value 'Const
raw)
        case Value' 'Const
raw of
            (Value' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Value'void) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value
Value'void)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'bool Bool
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Bool -> Value
Value'bool Bool
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int8 Int8
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Int8 -> Value
Value'int8 Int8
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int16 Int16
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Int16 -> Value
Value'int16 Int16
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int32 Int32
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Int32 -> Value
Value'int32 Int32
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int64 Int64
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Int64 -> Value
Value'int64 Int64
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint8 Word8
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word8 -> Value
Value'uint8 Word8
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint16 Word16
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Value
Value'uint16 Word16
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint32 Word32
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word32 -> Value
Value'uint32 Word32
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint64 Word64
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word64 -> Value
Value'uint64 Word64
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'float32 Float
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Float -> Value
Value'float32 Float
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'float64 Double
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Double -> Value
Value'float64 Double
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'text Text 'Const
raw) ->
                (Text -> Value
Value'text (Text -> Value) -> m Text -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const Text -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const Text
Text 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'data_ Data 'Const
raw) ->
                (ByteString -> Value
Value'data_ (ByteString -> Value) -> m ByteString -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const ByteString -> m ByteString
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Cerial 'Const ByteString
Data 'Const
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'list Maybe (Ptr 'Const)
raw) ->
                (Maybe Ptr -> Value
Value'list (Maybe Ptr -> Value) -> m (Maybe Ptr) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Maybe (Ptr 'Const)
Cerial 'Const (Maybe Ptr)
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'enum Word16
raw) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Value
Value'enum Word16
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'struct Maybe (Ptr 'Const)
raw) ->
                (Maybe Ptr -> Value
Value'struct (Maybe Ptr -> Value) -> m (Maybe Ptr) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Maybe (Ptr 'Const)
Cerial 'Const (Maybe Ptr)
raw))
            (Value' 'Const
Capnp.Gen.ById.Xa93fc509624c72d9.Value'interface) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value
Value'interface)
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'anyPointer Maybe (Ptr 'Const)
raw) ->
                (Maybe Ptr -> Value
Value'anyPointer (Maybe Ptr -> Value) -> m (Maybe Ptr) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial 'Const (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize Maybe (Ptr 'Const)
Cerial 'Const (Maybe Ptr)
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'unknown' Word16
tag) ->
                (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Value
Value'unknown' Word16
tag))
        )
instance (Classes.Marshal s Value) where
    marshalInto :: Cerial ('Mut s) Value -> Value -> m ()
marshalInto Cerial ('Mut s) Value
raw_ Value
value_ = case Value
value_ of
        (Value
Value'void) ->
            (Value ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Value ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'void Cerial ('Mut s) Value
Value ('Mut s)
raw_)
        (Value'bool Bool
arg_) ->
            (Value ('Mut s) -> Bool -> m ()
forall (m :: * -> *) s. RWCtx m s => Value ('Mut s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'bool Cerial ('Mut s) Value
Value ('Mut s)
raw_ Bool
arg_)
        (Value'int8 Int8
arg_) ->
            (Value ('Mut s) -> Int8 -> m ()
forall (m :: * -> *) s. RWCtx m s => Value ('Mut s) -> Int8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int8 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Int8
arg_)
        (Value'int16 Int16
arg_) ->
            (Value ('Mut s) -> Int16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Int16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int16 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Int16
arg_)
        (Value'int32 Int32
arg_) ->
            (Value ('Mut s) -> Int32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Int32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int32 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Int32
arg_)
        (Value'int64 Int64
arg_) ->
            (Value ('Mut s) -> Int64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Int64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int64 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Int64
arg_)
        (Value'uint8 Word8
arg_) ->
            (Value ('Mut s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint8 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word8
arg_)
        (Value'uint16 Word16
arg_) ->
            (Value ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint16 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word16
arg_)
        (Value'uint32 Word32
arg_) ->
            (Value ('Mut s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint32 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word32
arg_)
        (Value'uint64 Word64
arg_) ->
            (Value ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint64 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word64
arg_)
        (Value'float32 Float
arg_) ->
            (Value ('Mut s) -> Float -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Float -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float32 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Float
arg_)
        (Value'float64 Double
arg_) ->
            (Value ('Mut s) -> Double -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Double -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float64 Cerial ('Mut s) Value
Value ('Mut s)
raw_ Double
arg_)
        (Value'text Text
arg_) ->
            ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Value ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Value
Value ('Mut s)
raw_) Text
arg_) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ('Mut s) -> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
Value ('Mut s) -> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'text Cerial ('Mut s) Value
Value ('Mut s)
raw_))
        (Value'data_ ByteString
arg_) ->
            ((Message ('Mut s) -> ByteString -> m (Cerial ('Mut s) ByteString)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Value ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Value
Value ('Mut s)
raw_) ByteString
arg_) m (Data ('Mut s)) -> (Data ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ('Mut s) -> Data ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Data ('Mut s))) =>
Value ('Mut s) -> Data ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'data_ Cerial ('Mut s) Value
Value ('Mut s)
raw_))
        (Value'list Maybe Ptr
arg_) ->
            ((Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Value ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Value
Value ('Mut s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr ('Mut s))) -> (Maybe (Ptr ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr ('Mut s)))) =>
Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'list Cerial ('Mut s) Value
Value ('Mut s)
raw_))
        (Value'enum Word16
arg_) ->
            (Value ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'enum Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word16
arg_)
        (Value'struct Maybe Ptr
arg_) ->
            ((Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Value ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Value
Value ('Mut s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr ('Mut s))) -> (Maybe (Ptr ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr ('Mut s)))) =>
Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'struct Cerial ('Mut s) Value
Value ('Mut s)
raw_))
        (Value
Value'interface) ->
            (Value ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Value ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'interface Cerial ('Mut s) Value
Value ('Mut s)
raw_)
        (Value'anyPointer Maybe Ptr
arg_) ->
            ((Message ('Mut s) -> Maybe Ptr -> m (Cerial ('Mut s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Value ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Value
Value ('Mut s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr ('Mut s))) -> (Maybe (Ptr ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr ('Mut s)))) =>
Value ('Mut s) -> Maybe (Ptr ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'anyPointer Cerial ('Mut s) Value
Value ('Mut s)
raw_))
        (Value'unknown' Word16
tag) ->
            (Value ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'unknown' Cerial ('Mut s) Value
Value ('Mut s)
raw_ Word16
tag)
instance (Classes.Cerialize s Value)
instance (Classes.Cerialize s (V.Vector Value)) where
    cerialize :: Message ('Mut s)
-> Vector Value -> m (Cerial ('Mut s) (Vector Value))
cerialize  = Message ('Mut s)
-> Vector Value -> m (Cerial ('Mut s) (Vector Value))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Value))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Value)
-> m (Cerial ('Mut s) (Vector (Vector Value)))
cerialize  = Message ('Mut s)
-> Vector (Vector Value)
-> m (Cerial ('Mut s) (Vector (Vector Value)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Value)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Value))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Value))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Value))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Value))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Value))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Value)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Value)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Value)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Value)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Value))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Value))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Value))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Value))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Value)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Value)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Value)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Value)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Value))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Value))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Value))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Value))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data Annotation 
    = Annotation 
        {Annotation -> Word64
id :: Std_.Word64
        ,Annotation -> Value
value :: Value
        ,Annotation -> Brand
brand :: Brand}
    deriving(Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Std_.Show
            ,Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Std_.Eq
            ,(forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
Generics.Generic)
instance (Default.Default Annotation) where
    def :: Annotation
def  = Annotation
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const Annotation) where
    fromStruct :: Struct 'Const -> m Annotation
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (Annotation 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (Annotation 'Const)
-> (Annotation 'Const -> m Annotation) -> m Annotation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Annotation 'Const -> m Annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize Annotation) where
    type Cerial msg Annotation = (Capnp.Gen.ById.Xa93fc509624c72d9.Annotation msg)
    decerialize :: Cerial 'Const Annotation -> m Annotation
decerialize Cerial 'Const Annotation
raw = (Word64 -> Value -> Brand -> Annotation
Annotation (Word64 -> Value -> Brand -> Annotation)
-> m Word64 -> m (Value -> Brand -> Annotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Annotation 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Annotation msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'id Cerial 'Const Annotation
Annotation 'Const
raw)
                                  m (Value -> Brand -> Annotation)
-> m Value -> m (Brand -> Annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Annotation 'Const -> m (Value 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Annotation msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'value Cerial 'Const Annotation
Annotation 'Const
raw) m (Value 'Const) -> (Value 'Const -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value 'Const -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                  m (Brand -> Annotation) -> m Brand -> m Annotation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Annotation 'Const -> m (Brand 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Annotation msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'brand Cerial 'Const Annotation
Annotation 'Const
raw) m (Brand 'Const) -> (Brand 'Const -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand 'Const -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s Annotation) where
    marshalInto :: Cerial ('Mut s) Annotation -> Annotation -> m ()
marshalInto Cerial ('Mut s) Annotation
raw_ Annotation
value_ = case Annotation
value_ of
        Annotation{Word64
Value
Brand
brand :: Brand
value :: Value
id :: Word64
$sel:brand:Annotation :: Annotation -> Brand
$sel:value:Annotation :: Annotation -> Value
$sel:id:Annotation :: Annotation -> Word64
..} ->
            (do
                (Annotation ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Annotation ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'id Cerial ('Mut s) Annotation
Annotation ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Value -> m (Cerial ('Mut s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Annotation ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Annotation
Annotation ('Mut s)
raw_) Value
value) m (Value ('Mut s)) -> (Value ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Annotation ('Mut s) -> Value ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value ('Mut s))) =>
Annotation ('Mut s) -> Value ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'value Cerial ('Mut s) Annotation
Annotation ('Mut s)
raw_))
                ((Message ('Mut s) -> Brand -> m (Cerial ('Mut s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (Annotation ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) Annotation
Annotation ('Mut s)
raw_) Brand
brand) m (Brand ('Mut s)) -> (Brand ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Annotation ('Mut s) -> Brand ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand ('Mut s))) =>
Annotation ('Mut s) -> Brand ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'brand Cerial ('Mut s) Annotation
Annotation ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s Annotation)
instance (Classes.Cerialize s (V.Vector Annotation)) where
    cerialize :: Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
cerialize  = Message ('Mut s)
-> Vector Annotation -> m (Cerial ('Mut s) (Vector Annotation))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector Annotation))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector Annotation)
-> m (Cerial ('Mut s) (Vector (Vector Annotation)))
cerialize  = Message ('Mut s)
-> Vector (Vector Annotation)
-> m (Cerial ('Mut s) (Vector (Vector Annotation)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Annotation)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Annotation))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Annotation))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector Annotation))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Annotation))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Annotation))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Annotation)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Annotation)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector Annotation)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector Annotation)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Annotation))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Annotation))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Annotation))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Annotation))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data CapnpVersion 
    = CapnpVersion 
        {CapnpVersion -> Word16
major :: Std_.Word16
        ,CapnpVersion -> Word8
minor :: Std_.Word8
        ,CapnpVersion -> Word8
micro :: Std_.Word8}
    deriving(Int -> CapnpVersion -> ShowS
[CapnpVersion] -> ShowS
CapnpVersion -> String
(Int -> CapnpVersion -> ShowS)
-> (CapnpVersion -> String)
-> ([CapnpVersion] -> ShowS)
-> Show CapnpVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapnpVersion] -> ShowS
$cshowList :: [CapnpVersion] -> ShowS
show :: CapnpVersion -> String
$cshow :: CapnpVersion -> String
showsPrec :: Int -> CapnpVersion -> ShowS
$cshowsPrec :: Int -> CapnpVersion -> ShowS
Std_.Show
            ,CapnpVersion -> CapnpVersion -> Bool
(CapnpVersion -> CapnpVersion -> Bool)
-> (CapnpVersion -> CapnpVersion -> Bool) -> Eq CapnpVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapnpVersion -> CapnpVersion -> Bool
$c/= :: CapnpVersion -> CapnpVersion -> Bool
== :: CapnpVersion -> CapnpVersion -> Bool
$c== :: CapnpVersion -> CapnpVersion -> Bool
Std_.Eq
            ,(forall x. CapnpVersion -> Rep CapnpVersion x)
-> (forall x. Rep CapnpVersion x -> CapnpVersion)
-> Generic CapnpVersion
forall x. Rep CapnpVersion x -> CapnpVersion
forall x. CapnpVersion -> Rep CapnpVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CapnpVersion x -> CapnpVersion
$cfrom :: forall x. CapnpVersion -> Rep CapnpVersion x
Generics.Generic)
instance (Default.Default CapnpVersion) where
    def :: CapnpVersion
def  = CapnpVersion
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const CapnpVersion) where
    fromStruct :: Struct 'Const -> m CapnpVersion
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (CapnpVersion 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (CapnpVersion 'Const)
-> (CapnpVersion 'Const -> m CapnpVersion) -> m CapnpVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CapnpVersion 'Const -> m CapnpVersion
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize CapnpVersion) where
    type Cerial msg CapnpVersion = (Capnp.Gen.ById.Xa93fc509624c72d9.CapnpVersion msg)
    decerialize :: Cerial 'Const CapnpVersion -> m CapnpVersion
decerialize Cerial 'Const CapnpVersion
raw = (Word16 -> Word8 -> Word8 -> CapnpVersion
CapnpVersion (Word16 -> Word8 -> Word8 -> CapnpVersion)
-> m Word16 -> m (Word8 -> Word8 -> CapnpVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CapnpVersion 'Const -> m Word16
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
CapnpVersion msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'major Cerial 'Const CapnpVersion
CapnpVersion 'Const
raw)
                                    m (Word8 -> Word8 -> CapnpVersion)
-> m Word8 -> m (Word8 -> CapnpVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CapnpVersion 'Const -> m Word8
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
CapnpVersion msg -> m Word8
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'minor Cerial 'Const CapnpVersion
CapnpVersion 'Const
raw)
                                    m (Word8 -> CapnpVersion) -> m Word8 -> m CapnpVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CapnpVersion 'Const -> m Word8
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
CapnpVersion msg -> m Word8
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'micro Cerial 'Const CapnpVersion
CapnpVersion 'Const
raw))
instance (Classes.Marshal s CapnpVersion) where
    marshalInto :: Cerial ('Mut s) CapnpVersion -> CapnpVersion -> m ()
marshalInto Cerial ('Mut s) CapnpVersion
raw_ CapnpVersion
value_ = case CapnpVersion
value_ of
        CapnpVersion{Word8
Word16
micro :: Word8
minor :: Word8
major :: Word16
$sel:micro:CapnpVersion :: CapnpVersion -> Word8
$sel:minor:CapnpVersion :: CapnpVersion -> Word8
$sel:major:CapnpVersion :: CapnpVersion -> Word16
..} ->
            (do
                (CapnpVersion ('Mut s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion ('Mut s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'major Cerial ('Mut s) CapnpVersion
CapnpVersion ('Mut s)
raw_ Word16
major)
                (CapnpVersion ('Mut s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion ('Mut s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'minor Cerial ('Mut s) CapnpVersion
CapnpVersion ('Mut s)
raw_ Word8
minor)
                (CapnpVersion ('Mut s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion ('Mut s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'micro Cerial ('Mut s) CapnpVersion
CapnpVersion ('Mut s)
raw_ Word8
micro)
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s CapnpVersion)
instance (Classes.Cerialize s (V.Vector CapnpVersion)) where
    cerialize :: Message ('Mut s)
-> Vector CapnpVersion -> m (Cerial ('Mut s) (Vector CapnpVersion))
cerialize  = Message ('Mut s)
-> Vector CapnpVersion -> m (Cerial ('Mut s) (Vector CapnpVersion))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector CapnpVersion))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector CapnpVersion)
-> m (Cerial ('Mut s) (Vector (Vector CapnpVersion)))
cerialize  = Message ('Mut s)
-> Vector (Vector CapnpVersion)
-> m (Cerial ('Mut s) (Vector (Vector CapnpVersion)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector CapnpVersion)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector CapnpVersion))
-> m (Cerial ('Mut s) (Vector (Vector (Vector CapnpVersion))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector CapnpVersion))
-> m (Cerial ('Mut s) (Vector (Vector (Vector CapnpVersion))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector CapnpVersion)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector CapnpVersion)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector CapnpVersion)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector CapnpVersion)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector CapnpVersion))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector CapnpVersion))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data CodeGeneratorRequest 
    = CodeGeneratorRequest 
        {CodeGeneratorRequest -> Vector Node
nodes :: (V.Vector Node)
        ,CodeGeneratorRequest -> Vector CodeGeneratorRequest'RequestedFile
requestedFiles :: (V.Vector CodeGeneratorRequest'RequestedFile)
        ,CodeGeneratorRequest -> CapnpVersion
capnpVersion :: CapnpVersion
        ,CodeGeneratorRequest -> Vector Node'SourceInfo
sourceInfo :: (V.Vector Node'SourceInfo)}
    deriving(Int -> CodeGeneratorRequest -> ShowS
[CodeGeneratorRequest] -> ShowS
CodeGeneratorRequest -> String
(Int -> CodeGeneratorRequest -> ShowS)
-> (CodeGeneratorRequest -> String)
-> ([CodeGeneratorRequest] -> ShowS)
-> Show CodeGeneratorRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeGeneratorRequest] -> ShowS
$cshowList :: [CodeGeneratorRequest] -> ShowS
show :: CodeGeneratorRequest -> String
$cshow :: CodeGeneratorRequest -> String
showsPrec :: Int -> CodeGeneratorRequest -> ShowS
$cshowsPrec :: Int -> CodeGeneratorRequest -> ShowS
Std_.Show
            ,CodeGeneratorRequest -> CodeGeneratorRequest -> Bool
(CodeGeneratorRequest -> CodeGeneratorRequest -> Bool)
-> (CodeGeneratorRequest -> CodeGeneratorRequest -> Bool)
-> Eq CodeGeneratorRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeGeneratorRequest -> CodeGeneratorRequest -> Bool
$c/= :: CodeGeneratorRequest -> CodeGeneratorRequest -> Bool
== :: CodeGeneratorRequest -> CodeGeneratorRequest -> Bool
$c== :: CodeGeneratorRequest -> CodeGeneratorRequest -> Bool
Std_.Eq
            ,(forall x. CodeGeneratorRequest -> Rep CodeGeneratorRequest x)
-> (forall x. Rep CodeGeneratorRequest x -> CodeGeneratorRequest)
-> Generic CodeGeneratorRequest
forall x. Rep CodeGeneratorRequest x -> CodeGeneratorRequest
forall x. CodeGeneratorRequest -> Rep CodeGeneratorRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CodeGeneratorRequest x -> CodeGeneratorRequest
$cfrom :: forall x. CodeGeneratorRequest -> Rep CodeGeneratorRequest x
Generics.Generic)
instance (Default.Default CodeGeneratorRequest) where
    def :: CodeGeneratorRequest
def  = CodeGeneratorRequest
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const CodeGeneratorRequest) where
    fromStruct :: Struct 'Const -> m CodeGeneratorRequest
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (CodeGeneratorRequest 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (CodeGeneratorRequest 'Const)
-> (CodeGeneratorRequest 'Const -> m CodeGeneratorRequest)
-> m CodeGeneratorRequest
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest 'Const -> m CodeGeneratorRequest
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize CodeGeneratorRequest) where
    type Cerial msg CodeGeneratorRequest = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg)
    decerialize :: Cerial 'Const CodeGeneratorRequest -> m CodeGeneratorRequest
decerialize Cerial 'Const CodeGeneratorRequest
raw = (Vector Node
-> Vector CodeGeneratorRequest'RequestedFile
-> CapnpVersion
-> Vector Node'SourceInfo
-> CodeGeneratorRequest
CodeGeneratorRequest (Vector Node
 -> Vector CodeGeneratorRequest'RequestedFile
 -> CapnpVersion
 -> Vector Node'SourceInfo
 -> CodeGeneratorRequest)
-> m (Vector Node)
-> m (Vector CodeGeneratorRequest'RequestedFile
      -> CapnpVersion -> Vector Node'SourceInfo -> CodeGeneratorRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((CodeGeneratorRequest 'Const -> m (List 'Const (Node 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Node msg))) =>
CodeGeneratorRequest msg -> m (List msg (Node msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'nodes Cerial 'Const CodeGeneratorRequest
CodeGeneratorRequest 'Const
raw) m (List 'Const (Node 'Const))
-> (List 'Const (Node 'Const) -> m (Vector Node))
-> m (Vector Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node 'Const) -> m (Vector Node)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                            m (Vector CodeGeneratorRequest'RequestedFile
   -> CapnpVersion -> Vector Node'SourceInfo -> CodeGeneratorRequest)
-> m (Vector CodeGeneratorRequest'RequestedFile)
-> m (CapnpVersion
      -> Vector Node'SourceInfo -> CodeGeneratorRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest 'Const
-> m (List 'Const (CodeGeneratorRequest'RequestedFile 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg,
 FromPtr msg (List msg (CodeGeneratorRequest'RequestedFile msg))) =>
CodeGeneratorRequest msg
-> m (List msg (CodeGeneratorRequest'RequestedFile msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'requestedFiles Cerial 'Const CodeGeneratorRequest
CodeGeneratorRequest 'Const
raw) m (List 'Const (CodeGeneratorRequest'RequestedFile 'Const))
-> (List 'Const (CodeGeneratorRequest'RequestedFile 'Const)
    -> m (Vector CodeGeneratorRequest'RequestedFile))
-> m (Vector CodeGeneratorRequest'RequestedFile)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (CodeGeneratorRequest'RequestedFile 'Const)
-> m (Vector CodeGeneratorRequest'RequestedFile)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                            m (CapnpVersion -> Vector Node'SourceInfo -> CodeGeneratorRequest)
-> m CapnpVersion
-> m (Vector Node'SourceInfo -> CodeGeneratorRequest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest 'Const -> m (CapnpVersion 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (CapnpVersion msg)) =>
CodeGeneratorRequest msg -> m (CapnpVersion msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'capnpVersion Cerial 'Const CodeGeneratorRequest
CodeGeneratorRequest 'Const
raw) m (CapnpVersion 'Const)
-> (CapnpVersion 'Const -> m CapnpVersion) -> m CapnpVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CapnpVersion 'Const -> m CapnpVersion
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                            m (Vector Node'SourceInfo -> CodeGeneratorRequest)
-> m (Vector Node'SourceInfo) -> m CodeGeneratorRequest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest 'Const
-> m (List 'Const (Node'SourceInfo 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (List msg (Node'SourceInfo msg))) =>
CodeGeneratorRequest msg -> m (List msg (Node'SourceInfo msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'sourceInfo Cerial 'Const CodeGeneratorRequest
CodeGeneratorRequest 'Const
raw) m (List 'Const (Node'SourceInfo 'Const))
-> (List 'Const (Node'SourceInfo 'Const)
    -> m (Vector Node'SourceInfo))
-> m (Vector Node'SourceInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (Node'SourceInfo 'Const) -> m (Vector Node'SourceInfo)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s CodeGeneratorRequest) where
    marshalInto :: Cerial ('Mut s) CodeGeneratorRequest
-> CodeGeneratorRequest -> m ()
marshalInto Cerial ('Mut s) CodeGeneratorRequest
raw_ CodeGeneratorRequest
value_ = case CodeGeneratorRequest
value_ of
        CodeGeneratorRequest{Vector CodeGeneratorRequest'RequestedFile
Vector Node'SourceInfo
Vector Node
CapnpVersion
sourceInfo :: Vector Node'SourceInfo
capnpVersion :: CapnpVersion
requestedFiles :: Vector CodeGeneratorRequest'RequestedFile
nodes :: Vector Node
$sel:sourceInfo:CodeGeneratorRequest :: CodeGeneratorRequest -> Vector Node'SourceInfo
$sel:capnpVersion:CodeGeneratorRequest :: CodeGeneratorRequest -> CapnpVersion
$sel:requestedFiles:CodeGeneratorRequest :: CodeGeneratorRequest -> Vector CodeGeneratorRequest'RequestedFile
$sel:nodes:CodeGeneratorRequest :: CodeGeneratorRequest -> Vector Node
..} ->
            (do
                ((Message ('Mut s)
-> Vector Node -> m (Cerial ('Mut s) (Vector Node))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_) Vector Node
nodes) m (List ('Mut s) (Node ('Mut s)))
-> (List ('Mut s) (Node ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (Node ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Node ('Mut s)))) =>
CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (Node ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'nodes Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial ('Mut s) (Vector CodeGeneratorRequest'RequestedFile))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_) Vector CodeGeneratorRequest'RequestedFile
requestedFiles) m (List ('Mut s) (CodeGeneratorRequest'RequestedFile ('Mut s)))
-> (List ('Mut s) (CodeGeneratorRequest'RequestedFile ('Mut s))
    -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (CodeGeneratorRequest'RequestedFile ('Mut s))
-> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr
   s (List ('Mut s) (CodeGeneratorRequest'RequestedFile ('Mut s)))) =>
CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (CodeGeneratorRequest'RequestedFile ('Mut s))
-> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'requestedFiles Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_))
                ((Message ('Mut s)
-> CapnpVersion -> m (Cerial ('Mut s) CapnpVersion)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_) CapnpVersion
capnpVersion) m (CapnpVersion ('Mut s))
-> (CapnpVersion ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest ('Mut s) -> CapnpVersion ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (CapnpVersion ('Mut s))) =>
CodeGeneratorRequest ('Mut s) -> CapnpVersion ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'capnpVersion Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector Node'SourceInfo
-> m (Cerial ('Mut s) (Vector Node'SourceInfo))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_) Vector Node'SourceInfo
sourceInfo) m (List ('Mut s) (Node'SourceInfo ('Mut s)))
-> (List ('Mut s) (Node'SourceInfo ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (Node'SourceInfo ('Mut s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List ('Mut s) (Node'SourceInfo ('Mut s)))) =>
CodeGeneratorRequest ('Mut s)
-> List ('Mut s) (Node'SourceInfo ('Mut s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'sourceInfo Cerial ('Mut s) CodeGeneratorRequest
CodeGeneratorRequest ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s CodeGeneratorRequest)
instance (Classes.Cerialize s (V.Vector CodeGeneratorRequest)) where
    cerialize :: Message ('Mut s)
-> Vector CodeGeneratorRequest
-> m (Cerial ('Mut s) (Vector CodeGeneratorRequest))
cerialize  = Message ('Mut s)
-> Vector CodeGeneratorRequest
-> m (Cerial ('Mut s) (Vector CodeGeneratorRequest))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector CodeGeneratorRequest))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest)
-> m (Cerial ('Mut s) (Vector (Vector CodeGeneratorRequest)))
cerialize  = Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest)
-> m (Cerial ('Mut s) (Vector (Vector CodeGeneratorRequest)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector CodeGeneratorRequest))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector CodeGeneratorRequest))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector CodeGeneratorRequest))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector CodeGeneratorRequest))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector CodeGeneratorRequest)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector CodeGeneratorRequest)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data CodeGeneratorRequest'RequestedFile 
    = CodeGeneratorRequest'RequestedFile 
        {CodeGeneratorRequest'RequestedFile -> Word64
id :: Std_.Word64
        ,CodeGeneratorRequest'RequestedFile -> Text
filename :: T.Text
        ,CodeGeneratorRequest'RequestedFile
-> Vector CodeGeneratorRequest'RequestedFile'Import
imports :: (V.Vector CodeGeneratorRequest'RequestedFile'Import)}
    deriving(Int -> CodeGeneratorRequest'RequestedFile -> ShowS
[CodeGeneratorRequest'RequestedFile] -> ShowS
CodeGeneratorRequest'RequestedFile -> String
(Int -> CodeGeneratorRequest'RequestedFile -> ShowS)
-> (CodeGeneratorRequest'RequestedFile -> String)
-> ([CodeGeneratorRequest'RequestedFile] -> ShowS)
-> Show CodeGeneratorRequest'RequestedFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeGeneratorRequest'RequestedFile] -> ShowS
$cshowList :: [CodeGeneratorRequest'RequestedFile] -> ShowS
show :: CodeGeneratorRequest'RequestedFile -> String
$cshow :: CodeGeneratorRequest'RequestedFile -> String
showsPrec :: Int -> CodeGeneratorRequest'RequestedFile -> ShowS
$cshowsPrec :: Int -> CodeGeneratorRequest'RequestedFile -> ShowS
Std_.Show
            ,CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> Bool
(CodeGeneratorRequest'RequestedFile
 -> CodeGeneratorRequest'RequestedFile -> Bool)
-> (CodeGeneratorRequest'RequestedFile
    -> CodeGeneratorRequest'RequestedFile -> Bool)
-> Eq CodeGeneratorRequest'RequestedFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> Bool
$c/= :: CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> Bool
== :: CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> Bool
$c== :: CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> Bool
Std_.Eq
            ,(forall x.
 CodeGeneratorRequest'RequestedFile
 -> Rep CodeGeneratorRequest'RequestedFile x)
-> (forall x.
    Rep CodeGeneratorRequest'RequestedFile x
    -> CodeGeneratorRequest'RequestedFile)
-> Generic CodeGeneratorRequest'RequestedFile
forall x.
Rep CodeGeneratorRequest'RequestedFile x
-> CodeGeneratorRequest'RequestedFile
forall x.
CodeGeneratorRequest'RequestedFile
-> Rep CodeGeneratorRequest'RequestedFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CodeGeneratorRequest'RequestedFile x
-> CodeGeneratorRequest'RequestedFile
$cfrom :: forall x.
CodeGeneratorRequest'RequestedFile
-> Rep CodeGeneratorRequest'RequestedFile x
Generics.Generic)
instance (Default.Default CodeGeneratorRequest'RequestedFile) where
    def :: CodeGeneratorRequest'RequestedFile
def  = CodeGeneratorRequest'RequestedFile
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const CodeGeneratorRequest'RequestedFile) where
    fromStruct :: Struct 'Const -> m CodeGeneratorRequest'RequestedFile
fromStruct Struct 'Const
struct = ((Struct 'Const -> m (CodeGeneratorRequest'RequestedFile 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (CodeGeneratorRequest'RequestedFile 'Const)
-> (CodeGeneratorRequest'RequestedFile 'Const
    -> m CodeGeneratorRequest'RequestedFile)
-> m CodeGeneratorRequest'RequestedFile
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest'RequestedFile 'Const
-> m CodeGeneratorRequest'RequestedFile
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize CodeGeneratorRequest'RequestedFile) where
    type Cerial msg CodeGeneratorRequest'RequestedFile = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile msg)
    decerialize :: Cerial 'Const CodeGeneratorRequest'RequestedFile
-> m CodeGeneratorRequest'RequestedFile
decerialize Cerial 'Const CodeGeneratorRequest'RequestedFile
raw = (Word64
-> Text
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (Word64
 -> Text
 -> Vector CodeGeneratorRequest'RequestedFile'Import
 -> CodeGeneratorRequest'RequestedFile)
-> m Word64
-> m (Text
      -> Vector CodeGeneratorRequest'RequestedFile'Import
      -> CodeGeneratorRequest'RequestedFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeGeneratorRequest'RequestedFile 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
CodeGeneratorRequest'RequestedFile msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'id Cerial 'Const CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile 'Const
raw)
                                                          m (Text
   -> Vector CodeGeneratorRequest'RequestedFile'Import
   -> CodeGeneratorRequest'RequestedFile)
-> m Text
-> m (Vector CodeGeneratorRequest'RequestedFile'Import
      -> CodeGeneratorRequest'RequestedFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest'RequestedFile 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
CodeGeneratorRequest'RequestedFile msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'filename Cerial 'Const CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
                                                          m (Vector CodeGeneratorRequest'RequestedFile'Import
   -> CodeGeneratorRequest'RequestedFile)
-> m (Vector CodeGeneratorRequest'RequestedFile'Import)
-> m CodeGeneratorRequest'RequestedFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest'RequestedFile 'Const
-> m (List
        'Const (CodeGeneratorRequest'RequestedFile'Import 'Const))
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg,
 FromPtr
   msg (List msg (CodeGeneratorRequest'RequestedFile'Import msg))) =>
CodeGeneratorRequest'RequestedFile msg
-> m (List msg (CodeGeneratorRequest'RequestedFile'Import msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'imports Cerial 'Const CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile 'Const
raw) m (List 'Const (CodeGeneratorRequest'RequestedFile'Import 'Const))
-> (List 'Const (CodeGeneratorRequest'RequestedFile'Import 'Const)
    -> m (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Vector CodeGeneratorRequest'RequestedFile'Import)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List 'Const (CodeGeneratorRequest'RequestedFile'Import 'Const)
-> m (Vector CodeGeneratorRequest'RequestedFile'Import)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s CodeGeneratorRequest'RequestedFile) where
    marshalInto :: Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> m ()
marshalInto Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
raw_ CodeGeneratorRequest'RequestedFile
value_ = case CodeGeneratorRequest'RequestedFile
value_ of
        CodeGeneratorRequest'RequestedFile{Word64
Text
Vector CodeGeneratorRequest'RequestedFile'Import
imports :: Vector CodeGeneratorRequest'RequestedFile'Import
filename :: Text
id :: Word64
$sel:imports:CodeGeneratorRequest'RequestedFile :: CodeGeneratorRequest'RequestedFile
-> Vector CodeGeneratorRequest'RequestedFile'Import
$sel:filename:CodeGeneratorRequest'RequestedFile :: CodeGeneratorRequest'RequestedFile -> Text
$sel:id:CodeGeneratorRequest'RequestedFile :: CodeGeneratorRequest'RequestedFile -> Word64
..} ->
            (do
                (CodeGeneratorRequest'RequestedFile ('Mut s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CodeGeneratorRequest'RequestedFile ('Mut s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'id Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ('Mut s)
raw_) Text
filename) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile ('Mut s)
-> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
CodeGeneratorRequest'RequestedFile ('Mut s)
-> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'filename Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ('Mut s)
raw_))
                ((Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        ('Mut s) (Vector CodeGeneratorRequest'RequestedFile'Import))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ('Mut s)
raw_) Vector CodeGeneratorRequest'RequestedFile'Import
imports) m (List
     ('Mut s) (CodeGeneratorRequest'RequestedFile'Import ('Mut s)))
-> (List
      ('Mut s) (CodeGeneratorRequest'RequestedFile'Import ('Mut s))
    -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile ('Mut s)
-> List
     ('Mut s) (CodeGeneratorRequest'RequestedFile'Import ('Mut s))
-> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr
   s
   (List
      ('Mut s) (CodeGeneratorRequest'RequestedFile'Import ('Mut s)))) =>
CodeGeneratorRequest'RequestedFile ('Mut s)
-> List
     ('Mut s) (CodeGeneratorRequest'RequestedFile'Import ('Mut s))
-> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'imports Cerial ('Mut s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s CodeGeneratorRequest'RequestedFile)
instance (Classes.Cerialize s (V.Vector CodeGeneratorRequest'RequestedFile)) where
    cerialize :: Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial ('Mut s) (Vector CodeGeneratorRequest'RequestedFile))
cerialize  = Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial ('Mut s) (Vector CodeGeneratorRequest'RequestedFile))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest'RequestedFile)
-> m (Cerial
        ('Mut s) (Vector (Vector CodeGeneratorRequest'RequestedFile)))
cerialize  = Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest'RequestedFile)
-> m (Cerial
        ('Mut s) (Vector (Vector CodeGeneratorRequest'RequestedFile)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
data CodeGeneratorRequest'RequestedFile'Import 
    = CodeGeneratorRequest'RequestedFile'Import 
        {CodeGeneratorRequest'RequestedFile'Import -> Word64
id :: Std_.Word64
        ,CodeGeneratorRequest'RequestedFile'Import -> Text
name :: T.Text}
    deriving(Int -> CodeGeneratorRequest'RequestedFile'Import -> ShowS
[CodeGeneratorRequest'RequestedFile'Import] -> ShowS
CodeGeneratorRequest'RequestedFile'Import -> String
(Int -> CodeGeneratorRequest'RequestedFile'Import -> ShowS)
-> (CodeGeneratorRequest'RequestedFile'Import -> String)
-> ([CodeGeneratorRequest'RequestedFile'Import] -> ShowS)
-> Show CodeGeneratorRequest'RequestedFile'Import
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeGeneratorRequest'RequestedFile'Import] -> ShowS
$cshowList :: [CodeGeneratorRequest'RequestedFile'Import] -> ShowS
show :: CodeGeneratorRequest'RequestedFile'Import -> String
$cshow :: CodeGeneratorRequest'RequestedFile'Import -> String
showsPrec :: Int -> CodeGeneratorRequest'RequestedFile'Import -> ShowS
$cshowsPrec :: Int -> CodeGeneratorRequest'RequestedFile'Import -> ShowS
Std_.Show
            ,CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> Bool
(CodeGeneratorRequest'RequestedFile'Import
 -> CodeGeneratorRequest'RequestedFile'Import -> Bool)
-> (CodeGeneratorRequest'RequestedFile'Import
    -> CodeGeneratorRequest'RequestedFile'Import -> Bool)
-> Eq CodeGeneratorRequest'RequestedFile'Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> Bool
$c/= :: CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> Bool
== :: CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> Bool
$c== :: CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> Bool
Std_.Eq
            ,(forall x.
 CodeGeneratorRequest'RequestedFile'Import
 -> Rep CodeGeneratorRequest'RequestedFile'Import x)
-> (forall x.
    Rep CodeGeneratorRequest'RequestedFile'Import x
    -> CodeGeneratorRequest'RequestedFile'Import)
-> Generic CodeGeneratorRequest'RequestedFile'Import
forall x.
Rep CodeGeneratorRequest'RequestedFile'Import x
-> CodeGeneratorRequest'RequestedFile'Import
forall x.
CodeGeneratorRequest'RequestedFile'Import
-> Rep CodeGeneratorRequest'RequestedFile'Import x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CodeGeneratorRequest'RequestedFile'Import x
-> CodeGeneratorRequest'RequestedFile'Import
$cfrom :: forall x.
CodeGeneratorRequest'RequestedFile'Import
-> Rep CodeGeneratorRequest'RequestedFile'Import x
Generics.Generic)
instance (Default.Default CodeGeneratorRequest'RequestedFile'Import) where
    def :: CodeGeneratorRequest'RequestedFile'Import
def  = CodeGeneratorRequest'RequestedFile'Import
forall a. (Decerialize a, FromStruct 'Const (Cerial 'Const a)) => a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.Const CodeGeneratorRequest'RequestedFile'Import) where
    fromStruct :: Struct 'Const -> m CodeGeneratorRequest'RequestedFile'Import
fromStruct Struct 'Const
struct = ((Struct 'Const
-> m (CodeGeneratorRequest'RequestedFile'Import 'Const)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
Classes.fromStruct Struct 'Const
struct) m (CodeGeneratorRequest'RequestedFile'Import 'Const)
-> (CodeGeneratorRequest'RequestedFile'Import 'Const
    -> m CodeGeneratorRequest'RequestedFile'Import)
-> m CodeGeneratorRequest'RequestedFile'Import
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest'RequestedFile'Import 'Const
-> m CodeGeneratorRequest'RequestedFile'Import
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize)
instance (Classes.Decerialize CodeGeneratorRequest'RequestedFile'Import) where
    type Cerial msg CodeGeneratorRequest'RequestedFile'Import = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import msg)
    decerialize :: Cerial 'Const CodeGeneratorRequest'RequestedFile'Import
-> m CodeGeneratorRequest'RequestedFile'Import
decerialize Cerial 'Const CodeGeneratorRequest'RequestedFile'Import
raw = (Word64 -> Text -> CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import (Word64 -> Text -> CodeGeneratorRequest'RequestedFile'Import)
-> m Word64
-> m (Text -> CodeGeneratorRequest'RequestedFile'Import)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeGeneratorRequest'RequestedFile'Import 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
CodeGeneratorRequest'RequestedFile'Import msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'id Cerial 'Const CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import 'Const
raw)
                                                                 m (Text -> CodeGeneratorRequest'RequestedFile'Import)
-> m Text -> m CodeGeneratorRequest'RequestedFile'Import
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((CodeGeneratorRequest'RequestedFile'Import 'Const -> m (Text 'Const)
forall (m :: * -> *) (msg :: Mutability).
(ReadCtx m msg, FromPtr msg (Text msg)) =>
CodeGeneratorRequest'RequestedFile'Import msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'name Cerial 'Const CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import 'Const
raw) m (Text 'Const) -> (Text 'Const -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text 'Const -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
Classes.decerialize))
instance (Classes.Marshal s CodeGeneratorRequest'RequestedFile'Import) where
    marshalInto :: Cerial ('Mut s) CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> m ()
marshalInto Cerial ('Mut s) CodeGeneratorRequest'RequestedFile'Import
raw_ CodeGeneratorRequest'RequestedFile'Import
value_ = case CodeGeneratorRequest'RequestedFile'Import
value_ of
        CodeGeneratorRequest'RequestedFile'Import{Word64
Text
name :: Text
id :: Word64
$sel:name:CodeGeneratorRequest'RequestedFile'Import :: CodeGeneratorRequest'RequestedFile'Import -> Text
$sel:id:CodeGeneratorRequest'RequestedFile'Import :: CodeGeneratorRequest'RequestedFile'Import -> Word64
..} ->
            (do
                (CodeGeneratorRequest'RequestedFile'Import ('Mut s)
-> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CodeGeneratorRequest'RequestedFile'Import ('Mut s)
-> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'id Cerial ('Mut s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import ('Mut s)
raw_ Word64
id)
                ((Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
Message ('Mut s) -> a -> m (Cerial ('Mut s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile'Import ('Mut s)
-> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
Untyped.message Cerial ('Mut s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import ('Mut s)
raw_) Text
name) m (Text ('Mut s)) -> (Text ('Mut s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile'Import ('Mut s)
-> Text ('Mut s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text ('Mut s))) =>
CodeGeneratorRequest'RequestedFile'Import ('Mut s)
-> Text ('Mut s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'name Cerial ('Mut s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import ('Mut s)
raw_))
                (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
                )
instance (Classes.Cerialize s CodeGeneratorRequest'RequestedFile'Import)
instance (Classes.Cerialize s (V.Vector CodeGeneratorRequest'RequestedFile'Import)) where
    cerialize :: Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        ('Mut s) (Vector CodeGeneratorRequest'RequestedFile'Import))
cerialize  = Message ('Mut s)
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        ('Mut s) (Vector CodeGeneratorRequest'RequestedFile'Import))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Marshal s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest'RequestedFile'Import)
-> m (Cerial
        ('Mut s)
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
cerialize  = Message ('Mut s)
-> Vector (Vector CodeGeneratorRequest'RequestedFile'Import)
-> m (Cerial
        ('Mut s)
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))))))) where
    cerialize :: Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector
                       (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))))
cerialize  = Message ('Mut s)
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
-> m (Cerial
        ('Mut s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector
                       (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Decerialize Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize) where
    type Cerial msg Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize = Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize
    decerialize :: Cerial 'Const ElementSize -> m ElementSize
decerialize  = Cerial 'Const ElementSize -> m ElementSize
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure
instance (Classes.Cerialize s Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize) where
    cerialize :: Message ('Mut s) -> ElementSize -> m (Cerial ('Mut s) ElementSize)
cerialize Message ('Mut s)
_ = ElementSize -> m (Cerial ('Mut s) ElementSize)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure
instance (Classes.Cerialize s (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)) where
    cerialize :: Message ('Mut s)
-> Vector ElementSize -> m (Cerial ('Mut s) (Vector ElementSize))
cerialize  = Message ('Mut s)
-> Vector ElementSize -> m (Cerial ('Mut s) (Vector ElementSize))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector ElementSize)
-> m (Cerial ('Mut s) (Vector (Vector ElementSize)))
cerialize  = Message ('Mut s)
-> Vector (Vector ElementSize)
-> m (Cerial ('Mut s) (Vector (Vector ElementSize)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector ElementSize))
-> m (Cerial ('Mut s) (Vector (Vector (Vector ElementSize))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector ElementSize))
-> m (Cerial ('Mut s) (Vector (Vector (Vector ElementSize))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector ElementSize)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector ElementSize)))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector ElementSize)))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector ElementSize)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector ElementSize))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector ElementSize))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector ElementSize))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector ElementSize))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))))))) where
    cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))))
cerialize  = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))
-> m (Cerial
        ('Mut s)
        (Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
Classes.cerializeBasicVec