{-# 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 #-}
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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node)) where
    fromStruct :: Struct ConstMsg -> m Node
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node ConstMsg) -> (Node ConstMsg -> m Node) -> m Node
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node ConstMsg -> m Node
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Node)) where
    type Cerial msg (Node) = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
    decerialize :: Cerial ConstMsg Node -> m Node
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg. ReadCtx m msg => Node msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'id Cerial ConstMsg Node
Node ConstMsg
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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayName Cerial ConstMsg Node
Node ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word32
forall (m :: * -> *) msg. ReadCtx m msg => Node msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayNamePrefixLength Cerial ConstMsg Node
Node ConstMsg
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 ConstMsg -> m Word64
forall (m :: * -> *) msg. ReadCtx m msg => Node msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'scopeId Cerial ConstMsg Node
Node ConstMsg
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 ConstMsg -> m (List ConstMsg (Node'NestedNode ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node
Node ConstMsg
raw) m (List ConstMsg (Node'NestedNode ConstMsg))
-> (List ConstMsg (Node'NestedNode ConstMsg)
    -> m (Vector Node'NestedNode))
-> m (Vector Node'NestedNode)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node'NestedNode ConstMsg)
-> m (Vector Node'NestedNode)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Annotation ConstMsg))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Node msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotations Cerial ConstMsg Node
Node ConstMsg
raw) m (List ConstMsg (Annotation ConstMsg))
-> (List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Node'Parameter ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node
Node ConstMsg
raw) m (List ConstMsg (Node'Parameter ConstMsg))
-> (List ConstMsg (Node'Parameter ConstMsg)
    -> m (Vector Node'Parameter))
-> m (Vector Node'Parameter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node'Parameter ConstMsg)
-> m (Vector Node'Parameter)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Bool
forall (m :: * -> *) msg. ReadCtx m msg => Node msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'isGeneric Cerial ConstMsg Node
Node ConstMsg
raw)
                            m (Node' -> Node) -> m Node' -> m Node
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cerial ConstMsg Node' -> m Node'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'
Cerial ConstMsg Node
raw))
instance (Classes.Marshal s (Node)) where
    marshalInto :: Cerial (MutMsg s) Node -> Node -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'id Cerial (MutMsg s) Node
Node (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node
Node (MutMsg s)
raw_) Text
displayName) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Node (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayName Cerial (MutMsg s) Node
Node (MutMsg s)
raw_))
                (Node (MutMsg s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node (MutMsg s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayNamePrefixLength Cerial (MutMsg s) Node
Node (MutMsg s)
raw_ Word32
displayNamePrefixLength)
                (Node (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'scopeId Cerial (MutMsg s) Node
Node (MutMsg s)
raw_ Word64
scopeId)
                ((MutMsg s
-> Vector Node'NestedNode
-> m (Cerial (MutMsg s) (Vector Node'NestedNode))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node
Node (MutMsg s)
raw_) Vector Node'NestedNode
nestedNodes) m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
-> (List (MutMsg s) (Node'NestedNode (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node (MutMsg s)
-> List (MutMsg s) (Node'NestedNode (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Node'NestedNode (MutMsg s)))) =>
Node (MutMsg s)
-> List (MutMsg s) (Node'NestedNode (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'nestedNodes Cerial (MutMsg s) Node
Node (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node
Node (MutMsg s)
raw_) Vector Annotation
annotations) m (List (MutMsg s) (Annotation (MutMsg s)))
-> (List (MutMsg s) (Annotation (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Annotation (MutMsg s)))) =>
Node (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotations Cerial (MutMsg s) Node
Node (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Node'Parameter
-> m (Cerial (MutMsg s) (Vector Node'Parameter))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node
Node (MutMsg s)
raw_) Vector Node'Parameter
parameters) m (List (MutMsg s) (Node'Parameter (MutMsg s)))
-> (List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Node'Parameter (MutMsg s)))) =>
Node (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'parameters Cerial (MutMsg s) Node
Node (MutMsg s)
raw_))
                (Node (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'isGeneric Cerial (MutMsg s) Node
Node (MutMsg s)
raw_ Bool
isGeneric)
                (do
                    (Cerial (MutMsg s) Node' -> Node' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'
Cerial (MutMsg 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 :: MutMsg s -> Vector Node -> m (Cerial (MutMsg s) (Vector Node))
cerialize  = MutMsg s -> Vector Node -> m (Cerial (MutMsg s) (Vector Node))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Node)))) where
    cerialize :: MutMsg s
-> Vector (Vector Node)
-> m (Cerial (MutMsg s) (Vector (Vector Node)))
cerialize  = MutMsg s
-> Vector (Vector Node)
-> m (Cerial (MutMsg s) (Vector (Vector Node)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Node))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Node))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Node))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Node)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Node)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Node)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Node)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Node)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Node))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Node))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Node)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Node)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Node)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Node)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Node))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Node))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Node))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Node))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node')) where
    fromStruct :: Struct ConstMsg -> m Node'
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node ConstMsg) -> (Node ConstMsg -> m Node') -> m Node'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node ConstMsg -> m Node'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Node')) where
    type Cerial msg (Node') = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
    decerialize :: Cerial ConstMsg Node' -> m Node'
decerialize Cerial ConstMsg Node'
raw = (do
        Node' ConstMsg
raw <- (Node ConstMsg -> m (Node' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Node' msg)) =>
Node msg -> m (Node' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node' Cerial ConstMsg Node'
Node ConstMsg
raw)
        case Node' ConstMsg
raw of
            (Node' ConstMsg
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 ConstMsg
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 ConstMsg Node'struct -> m Node'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'struct
Node'struct ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'enum Node'enum ConstMsg
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 ConstMsg Node'enum -> m Node'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'enum
Node'enum ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'interface Node'interface ConstMsg
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 ConstMsg Node'interface -> m Node'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'interface
Node'interface ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'const Node'const ConstMsg
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 ConstMsg Node'const -> m Node'const
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'const
Node'const ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Node'annotation Node'annotation ConstMsg
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 ConstMsg Node'annotation -> m Node'annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 (MutMsg s) Node' -> Node' -> m ()
marshalInto Cerial (MutMsg s) Node'
raw_ Node'
value_ = case Node'
value_ of
        (Node'
Node'file) ->
            (Node (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Node (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'file Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
        (Node'struct Node'struct
arg_) ->
            (do
                Node'struct (MutMsg s)
raw_ <- (Node (MutMsg s) -> m (Node'struct (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Node'struct (MutMsg s))) =>
Node (MutMsg s) -> m (Node'struct (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
                (Cerial (MutMsg s) Node'struct -> Node'struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Node'struct
arg_)
                )
        (Node'enum Node'enum
arg_) ->
            (do
                Node'enum (MutMsg s)
raw_ <- (Node (MutMsg s) -> m (Node'enum (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Node'enum (MutMsg s))) =>
Node (MutMsg s) -> m (Node'enum (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
                (Cerial (MutMsg s) Node'enum -> Node'enum -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'enum
Node'enum (MutMsg s)
raw_ Node'enum
arg_)
                )
        (Node'interface Node'interface
arg_) ->
            (do
                Node'interface (MutMsg s)
raw_ <- (Node (MutMsg s) -> m (Node'interface (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Node'interface (MutMsg s))) =>
Node (MutMsg s) -> m (Node'interface (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
                (Cerial (MutMsg s) Node'interface -> Node'interface -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'interface
Node'interface (MutMsg s)
raw_ Node'interface
arg_)
                )
        (Node'const Node'const
arg_) ->
            (do
                Node'const (MutMsg s)
raw_ <- (Node (MutMsg s) -> m (Node'const (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Node'const (MutMsg s))) =>
Node (MutMsg s) -> m (Node'const (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
                (Cerial (MutMsg s) Node'const -> Node'const -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'const
Node'const (MutMsg s)
raw_ Node'const
arg_)
                )
        (Node'annotation Node'annotation
arg_) ->
            (do
                Node'annotation (MutMsg s)
raw_ <- (Node (MutMsg s) -> m (Node'annotation (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Node'annotation (MutMsg s))) =>
Node (MutMsg s) -> m (Node'annotation (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation Cerial (MutMsg s) Node'
Node (MutMsg s)
raw_)
                (Cerial (MutMsg s) Node'annotation -> Node'annotation -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Node'annotation
arg_)
                )
        (Node'unknown' Word16
tag) ->
            (Node (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'unknown' Cerial (MutMsg s) Node'
Node (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'struct)) where
    fromStruct :: Struct ConstMsg -> m Node'struct
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'struct ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'struct ConstMsg)
-> (Node'struct ConstMsg -> m Node'struct) -> m Node'struct
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'struct ConstMsg -> m Node'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'struct -> m Node'struct
decerialize Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'dataWordCount Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'pointerCount Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m ElementSize
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m ElementSize
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'preferredListEncoding Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'isGroup Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantCount Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m Word32
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'struct msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantOffset Cerial ConstMsg Node'struct
Node'struct ConstMsg
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 ConstMsg -> m (List ConstMsg (Field ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node'struct
Node'struct ConstMsg
raw) m (List ConstMsg (Field ConstMsg))
-> (List ConstMsg (Field ConstMsg) -> m (Vector Field))
-> m (Vector Field)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Field ConstMsg) -> m (Vector Field)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'struct)) where
    marshalInto :: Cerial (MutMsg s) Node'struct -> Node'struct -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'dataWordCount Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Word16
dataWordCount)
                (Node'struct (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'pointerCount Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Word16
pointerCount)
                (Node'struct (MutMsg s) -> ElementSize -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> ElementSize -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'preferredListEncoding Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ ElementSize
preferredListEncoding)
                (Node'struct (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'isGroup Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Bool
isGroup)
                (Node'struct (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantCount Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Word16
discriminantCount)
                (Node'struct (MutMsg s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'struct (MutMsg s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantOffset Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_ Word32
discriminantOffset)
                ((MutMsg s -> Vector Field -> m (Cerial (MutMsg s) (Vector Field))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'struct (MutMsg s) -> InMessage (Node'struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'struct
Node'struct (MutMsg s)
raw_) Vector Field
fields) m (List (MutMsg s) (Field (MutMsg s)))
-> (List (MutMsg s) (Field (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'struct (MutMsg s)
-> List (MutMsg s) (Field (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Field (MutMsg s)))) =>
Node'struct (MutMsg s)
-> List (MutMsg s) (Field (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'fields Cerial (MutMsg s) Node'struct
Node'struct (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'enum)) where
    fromStruct :: Struct ConstMsg -> m Node'enum
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'enum ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'enum ConstMsg)
-> (Node'enum ConstMsg -> m Node'enum) -> m Node'enum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'enum ConstMsg -> m Node'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'enum -> m Node'enum
decerialize Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Enumerant ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node'enum
Node'enum ConstMsg
raw) m (List ConstMsg (Enumerant ConstMsg))
-> (List ConstMsg (Enumerant ConstMsg) -> m (Vector Enumerant))
-> m (Vector Enumerant)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Enumerant ConstMsg) -> m (Vector Enumerant)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'enum)) where
    marshalInto :: Cerial (MutMsg s) Node'enum -> Node'enum -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s
-> Vector Enumerant -> m (Cerial (MutMsg s) (Vector Enumerant))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'enum (MutMsg s) -> InMessage (Node'enum (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'enum
Node'enum (MutMsg s)
raw_) Vector Enumerant
enumerants) m (List (MutMsg s) (Enumerant (MutMsg s)))
-> (List (MutMsg s) (Enumerant (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'enum (MutMsg s)
-> List (MutMsg s) (Enumerant (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Enumerant (MutMsg s)))) =>
Node'enum (MutMsg s)
-> List (MutMsg s) (Enumerant (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum'enumerants Cerial (MutMsg s) Node'enum
Node'enum (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'interface)) where
    fromStruct :: Struct ConstMsg -> m Node'interface
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'interface ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'interface ConstMsg)
-> (Node'interface ConstMsg -> m Node'interface)
-> m Node'interface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'interface ConstMsg -> m Node'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'interface -> m Node'interface
decerialize Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Method ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node'interface
Node'interface ConstMsg
raw) m (List ConstMsg (Method ConstMsg))
-> (List ConstMsg (Method ConstMsg) -> m (Vector Method))
-> m (Vector Method)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Method ConstMsg) -> m (Vector Method)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Superclass ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node'interface
Node'interface ConstMsg
raw) m (List ConstMsg (Superclass ConstMsg))
-> (List ConstMsg (Superclass ConstMsg) -> m (Vector Superclass))
-> m (Vector Superclass)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Superclass ConstMsg) -> m (Vector Superclass)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'interface)) where
    marshalInto :: Cerial (MutMsg s) Node'interface -> Node'interface -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Vector Method -> m (Cerial (MutMsg s) (Vector Method))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'interface (MutMsg s) -> InMessage (Node'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'interface
Node'interface (MutMsg s)
raw_) Vector Method
methods) m (List (MutMsg s) (Method (MutMsg s)))
-> (List (MutMsg s) (Method (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'interface (MutMsg s)
-> List (MutMsg s) (Method (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Method (MutMsg s)))) =>
Node'interface (MutMsg s)
-> List (MutMsg s) (Method (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'methods Cerial (MutMsg s) Node'interface
Node'interface (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Superclass -> m (Cerial (MutMsg s) (Vector Superclass))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'interface (MutMsg s) -> InMessage (Node'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'interface
Node'interface (MutMsg s)
raw_) Vector Superclass
superclasses) m (List (MutMsg s) (Superclass (MutMsg s)))
-> (List (MutMsg s) (Superclass (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'interface (MutMsg s)
-> List (MutMsg s) (Superclass (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Superclass (MutMsg s)))) =>
Node'interface (MutMsg s)
-> List (MutMsg s) (Superclass (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'superclasses Cerial (MutMsg s) Node'interface
Node'interface (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'const)) where
    fromStruct :: Struct ConstMsg -> m Node'const
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'const ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'const ConstMsg)
-> (Node'const ConstMsg -> m Node'const) -> m Node'const
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'const ConstMsg -> m Node'const
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'const -> m Node'const
decerialize Cerial ConstMsg 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 ConstMsg -> m (Type ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Node'const msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'type_ Cerial ConstMsg Node'const
Node'const ConstMsg
raw) m (Type ConstMsg) -> (Type ConstMsg -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type ConstMsg -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (Value ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Node'const msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'value Cerial ConstMsg Node'const
Node'const ConstMsg
raw) m (Value ConstMsg) -> (Value ConstMsg -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value ConstMsg -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'const)) where
    marshalInto :: Cerial (MutMsg s) Node'const -> Node'const -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Type -> m (Cerial (MutMsg s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'const (MutMsg s) -> InMessage (Node'const (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'const
Node'const (MutMsg s)
raw_) Type
type_) m (Type (MutMsg s)) -> (Type (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'const (MutMsg s) -> Type (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type (MutMsg s))) =>
Node'const (MutMsg s) -> Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'type_ Cerial (MutMsg s) Node'const
Node'const (MutMsg s)
raw_))
                ((MutMsg s -> Value -> m (Cerial (MutMsg s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'const (MutMsg s) -> InMessage (Node'const (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'const
Node'const (MutMsg s)
raw_) Value
value) m (Value (MutMsg s)) -> (Value (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'const (MutMsg s) -> Value (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value (MutMsg s))) =>
Node'const (MutMsg s) -> Value (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'value Cerial (MutMsg s) Node'const
Node'const (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'annotation)) where
    fromStruct :: Struct ConstMsg -> m Node'annotation
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'annotation ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'annotation ConstMsg)
-> (Node'annotation ConstMsg -> m Node'annotation)
-> m Node'annotation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'annotation ConstMsg -> m Node'annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'annotation -> m Node'annotation
decerialize Cerial ConstMsg 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 ConstMsg -> m (Type ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Node'annotation msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'type_ Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
raw) m (Type ConstMsg) -> (Type ConstMsg -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type ConstMsg -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsFile Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsConst Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnum Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnumerant Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsStruct Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsField Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsUnion Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsGroup Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsInterface Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsMethod Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsParam Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
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 ConstMsg -> m Bool
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'annotation msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsAnnotation Cerial ConstMsg Node'annotation
Node'annotation ConstMsg
raw))
instance (Classes.Marshal s (Node'annotation)) where
    marshalInto :: Cerial (MutMsg s) Node'annotation -> Node'annotation -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Type -> m (Cerial (MutMsg s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'annotation (MutMsg s)
-> InMessage (Node'annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_) Type
type_) m (Type (MutMsg s)) -> (Type (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'annotation (MutMsg s) -> Type (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type (MutMsg s))) =>
Node'annotation (MutMsg s) -> Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'type_ Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_))
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsFile Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsFile)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsConst Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsConst)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnum Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsEnum)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnumerant Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsEnumerant)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsStruct Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsStruct)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsField Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsField)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsUnion Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsUnion)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsGroup Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsGroup)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsInterface Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsInterface)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsMethod Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsMethod)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsParam Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg s)
raw_ Bool
targetsParam)
                (Node'annotation (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'annotation (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsAnnotation Cerial (MutMsg s) Node'annotation
Node'annotation (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'Parameter)) where
    fromStruct :: Struct ConstMsg -> m Node'Parameter
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'Parameter ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'Parameter ConstMsg)
-> (Node'Parameter ConstMsg -> m Node'Parameter)
-> m Node'Parameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'Parameter ConstMsg -> m Node'Parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'Parameter -> m Node'Parameter
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'Parameter msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'Parameter'name Cerial ConstMsg Node'Parameter
Node'Parameter ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'Parameter)) where
    marshalInto :: Cerial (MutMsg s) Node'Parameter -> Node'Parameter -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'Parameter (MutMsg s) -> InMessage (Node'Parameter (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'Parameter
Node'Parameter (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'Parameter (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Node'Parameter (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'Parameter'name Cerial (MutMsg s) Node'Parameter
Node'Parameter (MutMsg 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 :: MutMsg s
-> Vector Node'Parameter
-> m (Cerial (MutMsg s) (Vector Node'Parameter))
cerialize  = MutMsg s
-> Vector Node'Parameter
-> m (Cerial (MutMsg s) (Vector Node'Parameter))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Node'Parameter)))) where
    cerialize :: MutMsg s
-> Vector (Vector Node'Parameter)
-> m (Cerial (MutMsg s) (Vector (Vector Node'Parameter)))
cerialize  = MutMsg s
-> Vector (Vector Node'Parameter)
-> m (Cerial (MutMsg s) (Vector (Vector Node'Parameter)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Node'Parameter))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Node'Parameter))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'Parameter))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Node'Parameter))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'Parameter))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Node'Parameter)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Node'Parameter)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'Parameter)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Node'Parameter)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'Parameter)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'Parameter))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'Parameter))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'Parameter))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'Parameter)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'Parameter)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'Parameter))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'NestedNode)) where
    fromStruct :: Struct ConstMsg -> m Node'NestedNode
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'NestedNode ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'NestedNode ConstMsg)
-> (Node'NestedNode ConstMsg -> m Node'NestedNode)
-> m Node'NestedNode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'NestedNode ConstMsg -> m Node'NestedNode
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'NestedNode -> m Node'NestedNode
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'NestedNode msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'name Cerial ConstMsg Node'NestedNode
Node'NestedNode ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'NestedNode msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'id Cerial ConstMsg Node'NestedNode
Node'NestedNode ConstMsg
raw))
instance (Classes.Marshal s (Node'NestedNode)) where
    marshalInto :: Cerial (MutMsg s) Node'NestedNode -> Node'NestedNode -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'NestedNode (MutMsg s)
-> InMessage (Node'NestedNode (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'NestedNode
Node'NestedNode (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'NestedNode (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Node'NestedNode (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'name Cerial (MutMsg s) Node'NestedNode
Node'NestedNode (MutMsg s)
raw_))
                (Node'NestedNode (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'NestedNode (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'id Cerial (MutMsg s) Node'NestedNode
Node'NestedNode (MutMsg 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 :: MutMsg s
-> Vector Node'NestedNode
-> m (Cerial (MutMsg s) (Vector Node'NestedNode))
cerialize  = MutMsg s
-> Vector Node'NestedNode
-> m (Cerial (MutMsg s) (Vector Node'NestedNode))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Node'NestedNode)))) where
    cerialize :: MutMsg s
-> Vector (Vector Node'NestedNode)
-> m (Cerial (MutMsg s) (Vector (Vector Node'NestedNode)))
cerialize  = MutMsg s
-> Vector (Vector Node'NestedNode)
-> m (Cerial (MutMsg s) (Vector (Vector Node'NestedNode)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Node'NestedNode))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Node'NestedNode))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'NestedNode))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Node'NestedNode))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'NestedNode))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Node'NestedNode)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Node'NestedNode)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'NestedNode)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Node'NestedNode)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'NestedNode)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'NestedNode))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'NestedNode))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'NestedNode))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'NestedNode)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'NestedNode)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'NestedNode))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'SourceInfo)) where
    fromStruct :: Struct ConstMsg -> m Node'SourceInfo
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'SourceInfo ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'SourceInfo ConstMsg)
-> (Node'SourceInfo ConstMsg -> m Node'SourceInfo)
-> m Node'SourceInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'SourceInfo ConstMsg -> m Node'SourceInfo
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'SourceInfo -> m Node'SourceInfo
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Node'SourceInfo msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'id Cerial ConstMsg Node'SourceInfo
Node'SourceInfo ConstMsg
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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'SourceInfo msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'docComment Cerial ConstMsg Node'SourceInfo
Node'SourceInfo ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg
-> m (List ConstMsg (Node'SourceInfo'Member ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Node'SourceInfo
Node'SourceInfo ConstMsg
raw) m (List ConstMsg (Node'SourceInfo'Member ConstMsg))
-> (List ConstMsg (Node'SourceInfo'Member ConstMsg)
    -> m (Vector Node'SourceInfo'Member))
-> m (Vector Node'SourceInfo'Member)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node'SourceInfo'Member ConstMsg)
-> m (Vector Node'SourceInfo'Member)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'SourceInfo)) where
    marshalInto :: Cerial (MutMsg s) Node'SourceInfo -> Node'SourceInfo -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Node'SourceInfo (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'id Cerial (MutMsg s) Node'SourceInfo
Node'SourceInfo (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'SourceInfo (MutMsg s)
-> InMessage (Node'SourceInfo (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'SourceInfo
Node'SourceInfo (MutMsg s)
raw_) Text
docComment) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Node'SourceInfo (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'docComment Cerial (MutMsg s) Node'SourceInfo
Node'SourceInfo (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Node'SourceInfo'Member
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo'Member))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'SourceInfo (MutMsg s)
-> InMessage (Node'SourceInfo (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'SourceInfo
Node'SourceInfo (MutMsg s)
raw_) Vector Node'SourceInfo'Member
members) m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
-> (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)) -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))) =>
Node'SourceInfo (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'members Cerial (MutMsg s) Node'SourceInfo
Node'SourceInfo (MutMsg 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 :: MutMsg s
-> Vector Node'SourceInfo
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo))
cerialize  = MutMsg s
-> Vector Node'SourceInfo
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Node'SourceInfo)))) where
    cerialize :: MutMsg s
-> Vector (Vector Node'SourceInfo)
-> m (Cerial (MutMsg s) (Vector (Vector Node'SourceInfo)))
cerialize  = MutMsg s
-> Vector (Vector Node'SourceInfo)
-> m (Cerial (MutMsg s) (Vector (Vector Node'SourceInfo)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Node'SourceInfo))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Node'SourceInfo))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'SourceInfo))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Node'SourceInfo))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Node'SourceInfo))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Node'SourceInfo)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Node'SourceInfo)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'SourceInfo)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Node'SourceInfo)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Node'SourceInfo)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'SourceInfo))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'SourceInfo)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Node'SourceInfo)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Node'SourceInfo))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Node'SourceInfo'Member)) where
    fromStruct :: Struct ConstMsg -> m Node'SourceInfo'Member
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Node'SourceInfo'Member ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Node'SourceInfo'Member ConstMsg)
-> (Node'SourceInfo'Member ConstMsg -> m Node'SourceInfo'Member)
-> m Node'SourceInfo'Member
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node'SourceInfo'Member ConstMsg -> m Node'SourceInfo'Member
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Node'SourceInfo'Member -> m Node'SourceInfo'Member
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Node'SourceInfo'Member msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'Member'docComment Cerial ConstMsg Node'SourceInfo'Member
Node'SourceInfo'Member ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Node'SourceInfo'Member)) where
    marshalInto :: Cerial (MutMsg s) Node'SourceInfo'Member
-> Node'SourceInfo'Member -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Node'SourceInfo'Member (MutMsg s)
-> InMessage (Node'SourceInfo'Member (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Node'SourceInfo'Member
Node'SourceInfo'Member (MutMsg s)
raw_) Text
docComment) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Node'SourceInfo'Member (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Node'SourceInfo'Member (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'Member'docComment Cerial (MutMsg s) Node'SourceInfo'Member
Node'SourceInfo'Member (MutMsg 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 :: MutMsg s
-> Vector Node'SourceInfo'Member
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo'Member))
cerialize  = MutMsg s
-> Vector Node'SourceInfo'Member
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo'Member))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Node'SourceInfo'Member)))) where
    cerialize :: MutMsg s
-> Vector (Vector Node'SourceInfo'Member)
-> m (Cerial (MutMsg s) (Vector (Vector Node'SourceInfo'Member)))
cerialize  = MutMsg s
-> Vector (Vector Node'SourceInfo'Member)
-> m (Cerial (MutMsg s) (Vector (Vector Node'SourceInfo'Member)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Node'SourceInfo'Member))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Node'SourceInfo'Member))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector Node'SourceInfo'Member))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Node'SourceInfo'Member))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector Node'SourceInfo'Member))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Node'SourceInfo'Member)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Node'SourceInfo'Member)))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Node'SourceInfo'Member)))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Node'SourceInfo'Member))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector Node'SourceInfo'Member)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector Node'SourceInfo'Member))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Field)) where
    fromStruct :: Struct ConstMsg -> m Field
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Field ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Field ConstMsg) -> (Field ConstMsg -> m Field) -> m Field
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field ConstMsg -> m Field
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Field)) where
    type Cerial msg (Field) = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
    decerialize :: Cerial ConstMsg Field -> m Field
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Field msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'name Cerial ConstMsg Field
Field ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg. ReadCtx m msg => Field msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'codeOrder Cerial ConstMsg Field
Field ConstMsg
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 ConstMsg -> m (List ConstMsg (Annotation ConstMsg))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Field msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'annotations Cerial ConstMsg Field
Field ConstMsg
raw) m (List ConstMsg (Annotation ConstMsg))
-> (List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg. ReadCtx m msg => Field msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'discriminantValue Cerial ConstMsg Field
Field ConstMsg
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 ConstMsg -> m (Field'ordinal ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Field'ordinal msg)) =>
Field msg -> m (Field'ordinal msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal Cerial ConstMsg Field
Field ConstMsg
raw) m (Field'ordinal ConstMsg)
-> (Field'ordinal ConstMsg -> m Field'ordinal) -> m Field'ordinal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'ordinal ConstMsg -> m Field'ordinal
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Field' -> m Field'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Field'
Cerial ConstMsg Field
raw))
instance (Classes.Marshal s (Field)) where
    marshalInto :: Cerial (MutMsg s) Field -> Field -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Field (MutMsg s) -> InMessage (Field (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Field
Field (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Field (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'name Cerial (MutMsg s) Field
Field (MutMsg s)
raw_))
                (Field (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'codeOrder Cerial (MutMsg s) Field
Field (MutMsg s)
raw_ Word16
codeOrder)
                ((MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Field (MutMsg s) -> InMessage (Field (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Field
Field (MutMsg s)
raw_) Vector Annotation
annotations) m (List (MutMsg s) (Annotation (MutMsg s)))
-> (List (MutMsg s) (Annotation (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Annotation (MutMsg s)))) =>
Field (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'annotations Cerial (MutMsg s) Field
Field (MutMsg s)
raw_))
                (Field (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'discriminantValue Cerial (MutMsg s) Field
Field (MutMsg s)
raw_ Word16
discriminantValue)
                (do
                    Field'ordinal (MutMsg s)
raw_ <- (Field (MutMsg s) -> m (Field'ordinal (MutMsg s))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Field'ordinal msg)) =>
Field msg -> m (Field'ordinal msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal Cerial (MutMsg s) Field
Field (MutMsg s)
raw_)
                    (Cerial (MutMsg s) Field'ordinal -> Field'ordinal -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Field'ordinal
Field'ordinal (MutMsg s)
raw_ Field'ordinal
ordinal)
                    )
                (do
                    (Cerial (MutMsg s) Field' -> Field' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Field'
Cerial (MutMsg 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 :: MutMsg s -> Vector Field -> m (Cerial (MutMsg s) (Vector Field))
cerialize  = MutMsg s -> Vector Field -> m (Cerial (MutMsg s) (Vector Field))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Field)))) where
    cerialize :: MutMsg s
-> Vector (Vector Field)
-> m (Cerial (MutMsg s) (Vector (Vector Field)))
cerialize  = MutMsg s
-> Vector (Vector Field)
-> m (Cerial (MutMsg s) (Vector (Vector Field)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Field))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Field))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Field))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Field))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Field))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Field)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Field)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Field)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Field)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Field)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Field))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Field))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Field))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Field))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Field))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Field)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Field)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Field)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Field)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Field)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Field))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Field))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Field))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Field))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Field')) where
    fromStruct :: Struct ConstMsg -> m Field'
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Field ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Field ConstMsg) -> (Field ConstMsg -> m Field') -> m Field'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field ConstMsg -> m Field'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Field')) where
    type Cerial msg (Field') = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
    decerialize :: Cerial ConstMsg Field' -> m Field'
decerialize Cerial ConstMsg Field'
raw = (do
        Field' ConstMsg
raw <- (Field ConstMsg -> m (Field' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Field' msg)) =>
Field msg -> m (Field' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field' Cerial ConstMsg Field'
Field ConstMsg
raw)
        case Field' ConstMsg
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'slot Field'slot ConstMsg
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 ConstMsg Field'slot -> m Field'slot
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Field'slot
Field'slot ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Field'group Field'group ConstMsg
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 ConstMsg Field'group -> m Field'group
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Field'group
Field'group ConstMsg
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 (MutMsg s) Field' -> Field' -> m ()
marshalInto Cerial (MutMsg s) Field'
raw_ Field'
value_ = case Field'
value_ of
        (Field'slot Field'slot
arg_) ->
            (do
                Field'slot (MutMsg s)
raw_ <- (Field (MutMsg s) -> m (Field'slot (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Field'slot (MutMsg s))) =>
Field (MutMsg s) -> m (Field'slot (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot Cerial (MutMsg s) Field'
Field (MutMsg s)
raw_)
                (Cerial (MutMsg s) Field'slot -> Field'slot -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_ Field'slot
arg_)
                )
        (Field'group Field'group
arg_) ->
            (do
                Field'group (MutMsg s)
raw_ <- (Field (MutMsg s) -> m (Field'group (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Field'group (MutMsg s))) =>
Field (MutMsg s) -> m (Field'group (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group Cerial (MutMsg s) Field'
Field (MutMsg s)
raw_)
                (Cerial (MutMsg s) Field'group -> Field'group -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Field'group
Field'group (MutMsg s)
raw_ Field'group
arg_)
                )
        (Field'unknown' Word16
tag) ->
            (Field (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'unknown' Cerial (MutMsg s) Field'
Field (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Field'slot)) where
    fromStruct :: Struct ConstMsg -> m Field'slot
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Field'slot ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Field'slot ConstMsg)
-> (Field'slot ConstMsg -> m Field'slot) -> m Field'slot
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'slot ConstMsg -> m Field'slot
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Field'slot -> m Field'slot
decerialize Cerial ConstMsg 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 ConstMsg -> m Word32
forall (m :: * -> *) msg.
ReadCtx m msg =>
Field'slot msg -> m Word32
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'offset Cerial ConstMsg Field'slot
Field'slot ConstMsg
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 ConstMsg -> m (Type ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Field'slot msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'type_ Cerial ConstMsg Field'slot
Field'slot ConstMsg
raw) m (Type ConstMsg) -> (Type ConstMsg -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type ConstMsg -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (Value ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Field'slot msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'defaultValue Cerial ConstMsg Field'slot
Field'slot ConstMsg
raw) m (Value ConstMsg) -> (Value ConstMsg -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value ConstMsg -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Bool
forall (m :: * -> *) msg. ReadCtx m msg => Field'slot msg -> m Bool
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'hadExplicitDefault Cerial ConstMsg Field'slot
Field'slot ConstMsg
raw))
instance (Classes.Marshal s (Field'slot)) where
    marshalInto :: Cerial (MutMsg s) Field'slot -> Field'slot -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'slot (MutMsg s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'offset Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_ Word32
offset)
                ((MutMsg s -> Type -> m (Cerial (MutMsg s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Field'slot (MutMsg s) -> InMessage (Field'slot (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_) Type
type_) m (Type (MutMsg s)) -> (Type (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field'slot (MutMsg s) -> Type (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type (MutMsg s))) =>
Field'slot (MutMsg s) -> Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'type_ Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_))
                ((MutMsg s -> Value -> m (Cerial (MutMsg s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Field'slot (MutMsg s) -> InMessage (Field'slot (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_) Value
defaultValue) m (Value (MutMsg s)) -> (Value (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Field'slot (MutMsg s) -> Value (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value (MutMsg s))) =>
Field'slot (MutMsg s) -> Value (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'defaultValue Cerial (MutMsg s) Field'slot
Field'slot (MutMsg s)
raw_))
                (Field'slot (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'slot (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'hadExplicitDefault Cerial (MutMsg s) Field'slot
Field'slot (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Field'group)) where
    fromStruct :: Struct ConstMsg -> m Field'group
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Field'group ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Field'group ConstMsg)
-> (Field'group ConstMsg -> m Field'group) -> m Field'group
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'group ConstMsg -> m Field'group
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Field'group -> m Field'group
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Field'group msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'group'typeId Cerial ConstMsg Field'group
Field'group ConstMsg
raw))
instance (Classes.Marshal s (Field'group)) where
    marshalInto :: Cerial (MutMsg s) Field'group -> Field'group -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'group (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group'typeId Cerial (MutMsg s) Field'group
Field'group (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Field'ordinal)) where
    fromStruct :: Struct ConstMsg -> m Field'ordinal
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Field'ordinal ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Field'ordinal ConstMsg)
-> (Field'ordinal ConstMsg -> m Field'ordinal) -> m Field'ordinal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Field'ordinal ConstMsg -> m Field'ordinal
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Field'ordinal -> m Field'ordinal
decerialize Cerial ConstMsg Field'ordinal
raw = (do
        Field'ordinal' ConstMsg
raw <- (Field'ordinal ConstMsg -> m (Field'ordinal' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Field'ordinal' msg)) =>
Field'ordinal msg -> m (Field'ordinal' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal' Cerial ConstMsg Field'ordinal
Field'ordinal ConstMsg
raw)
        case Field'ordinal' ConstMsg
raw of
            (Field'ordinal' ConstMsg
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 (MutMsg s) Field'ordinal -> Field'ordinal -> m ()
marshalInto Cerial (MutMsg s) Field'ordinal
raw_ Field'ordinal
value_ = case Field'ordinal
value_ of
        (Field'ordinal
Field'ordinal'implicit) ->
            (Field'ordinal (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'ordinal (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'implicit Cerial (MutMsg s) Field'ordinal
Field'ordinal (MutMsg s)
raw_)
        (Field'ordinal'explicit Word16
arg_) ->
            (Field'ordinal (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'ordinal (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'explicit Cerial (MutMsg s) Field'ordinal
Field'ordinal (MutMsg s)
raw_ Word16
arg_)
        (Field'ordinal'unknown' Word16
tag) ->
            (Field'ordinal (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Field'ordinal (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'unknown' Cerial (MutMsg s) Field'ordinal
Field'ordinal (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Enumerant)) where
    fromStruct :: Struct ConstMsg -> m Enumerant
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Enumerant ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Enumerant ConstMsg)
-> (Enumerant ConstMsg -> m Enumerant) -> m Enumerant
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Enumerant ConstMsg -> m Enumerant
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Enumerant)) where
    type Cerial msg (Enumerant) = (Capnp.Gen.ById.Xa93fc509624c72d9.Enumerant msg)
    decerialize :: Cerial ConstMsg Enumerant -> m Enumerant
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Enumerant msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'name Cerial ConstMsg Enumerant
Enumerant ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Enumerant msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'codeOrder Cerial ConstMsg Enumerant
Enumerant ConstMsg
raw)
                                 m (Vector Annotation -> Enumerant)
-> m (Vector Annotation) -> m Enumerant
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Enumerant ConstMsg -> m (List ConstMsg (Annotation ConstMsg))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Enumerant msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'annotations Cerial ConstMsg Enumerant
Enumerant ConstMsg
raw) m (List ConstMsg (Annotation ConstMsg))
-> (List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Enumerant)) where
    marshalInto :: Cerial (MutMsg s) Enumerant -> Enumerant -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Enumerant (MutMsg s) -> InMessage (Enumerant (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Enumerant
Enumerant (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Enumerant (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Enumerant (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'name Cerial (MutMsg s) Enumerant
Enumerant (MutMsg s)
raw_))
                (Enumerant (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Enumerant (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'codeOrder Cerial (MutMsg s) Enumerant
Enumerant (MutMsg s)
raw_ Word16
codeOrder)
                ((MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Enumerant (MutMsg s) -> InMessage (Enumerant (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Enumerant
Enumerant (MutMsg s)
raw_) Vector Annotation
annotations) m (List (MutMsg s) (Annotation (MutMsg s)))
-> (List (MutMsg s) (Annotation (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Enumerant (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Annotation (MutMsg s)))) =>
Enumerant (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'annotations Cerial (MutMsg s) Enumerant
Enumerant (MutMsg 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 :: MutMsg s
-> Vector Enumerant -> m (Cerial (MutMsg s) (Vector Enumerant))
cerialize  = MutMsg s
-> Vector Enumerant -> m (Cerial (MutMsg s) (Vector Enumerant))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Enumerant)))) where
    cerialize :: MutMsg s
-> Vector (Vector Enumerant)
-> m (Cerial (MutMsg s) (Vector (Vector Enumerant)))
cerialize  = MutMsg s
-> Vector (Vector Enumerant)
-> m (Cerial (MutMsg s) (Vector (Vector Enumerant)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Enumerant))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Enumerant))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Enumerant))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Enumerant))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Enumerant))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Enumerant)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Enumerant)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Enumerant)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Enumerant)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Enumerant)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Enumerant))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Enumerant))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Enumerant))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Enumerant))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Enumerant))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Enumerant)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Enumerant)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Enumerant))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Superclass)) where
    fromStruct :: Struct ConstMsg -> m Superclass
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Superclass ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Superclass ConstMsg)
-> (Superclass ConstMsg -> m Superclass) -> m Superclass
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Superclass ConstMsg -> m Superclass
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Superclass)) where
    type Cerial msg (Superclass) = (Capnp.Gen.ById.Xa93fc509624c72d9.Superclass msg)
    decerialize :: Cerial ConstMsg Superclass -> m Superclass
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Superclass msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'id Cerial ConstMsg Superclass
Superclass ConstMsg
raw)
                                  m (Brand -> Superclass) -> m Brand -> m Superclass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Superclass ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Superclass msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'brand Cerial ConstMsg Superclass
Superclass ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Superclass)) where
    marshalInto :: Cerial (MutMsg s) Superclass -> Superclass -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Superclass (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'id Cerial (MutMsg s) Superclass
Superclass (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Superclass (MutMsg s) -> InMessage (Superclass (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Superclass
Superclass (MutMsg s)
raw_) Brand
brand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Superclass (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Superclass (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'brand Cerial (MutMsg s) Superclass
Superclass (MutMsg 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 :: MutMsg s
-> Vector Superclass -> m (Cerial (MutMsg s) (Vector Superclass))
cerialize  = MutMsg s
-> Vector Superclass -> m (Cerial (MutMsg s) (Vector Superclass))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Superclass)))) where
    cerialize :: MutMsg s
-> Vector (Vector Superclass)
-> m (Cerial (MutMsg s) (Vector (Vector Superclass)))
cerialize  = MutMsg s
-> Vector (Vector Superclass)
-> m (Cerial (MutMsg s) (Vector (Vector Superclass)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Superclass))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Superclass))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Superclass))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Superclass))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Superclass))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Superclass)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Superclass)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Superclass)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Superclass)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Superclass)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Superclass))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Superclass))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Superclass))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Superclass))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Superclass))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Superclass)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Superclass)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Superclass))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Method)) where
    fromStruct :: Struct ConstMsg -> m Method
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Method ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Method ConstMsg) -> (Method ConstMsg -> m Method) -> m Method
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Method ConstMsg -> m Method
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Method)) where
    type Cerial msg (Method) = (Capnp.Gen.ById.Xa93fc509624c72d9.Method msg)
    decerialize :: Cerial ConstMsg Method -> m Method
decerialize Cerial ConstMsg 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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
Method msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'name Cerial ConstMsg Method
Method ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg. ReadCtx m msg => Method msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'codeOrder Cerial ConstMsg Method
Method ConstMsg
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 ConstMsg -> m Word64
forall (m :: * -> *) msg. ReadCtx m msg => Method msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramStructType Cerial ConstMsg Method
Method ConstMsg
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 ConstMsg -> m Word64
forall (m :: * -> *) msg. ReadCtx m msg => Method msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultStructType Cerial ConstMsg Method
Method ConstMsg
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 ConstMsg -> m (List ConstMsg (Annotation ConstMsg))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (List msg (Annotation msg))) =>
Method msg -> m (List msg (Annotation msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'annotations Cerial ConstMsg Method
Method ConstMsg
raw) m (List ConstMsg (Annotation ConstMsg))
-> (List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation))
-> m (Vector Annotation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Annotation ConstMsg) -> m (Vector Annotation)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Method msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramBrand Cerial ConstMsg Method
Method ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Method msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultBrand Cerial ConstMsg Method
Method ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Node'Parameter ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Method
Method ConstMsg
raw) m (List ConstMsg (Node'Parameter ConstMsg))
-> (List ConstMsg (Node'Parameter ConstMsg)
    -> m (Vector Node'Parameter))
-> m (Vector Node'Parameter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node'Parameter ConstMsg)
-> m (Vector Node'Parameter)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Method)) where
    marshalInto :: Cerial (MutMsg s) Method -> Method -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Method
Method (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Method (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'name Cerial (MutMsg s) Method
Method (MutMsg s)
raw_))
                (Method (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'codeOrder Cerial (MutMsg s) Method
Method (MutMsg s)
raw_ Word16
codeOrder)
                (Method (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramStructType Cerial (MutMsg s) Method
Method (MutMsg s)
raw_ Word64
paramStructType)
                (Method (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Method (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultStructType Cerial (MutMsg s) Method
Method (MutMsg s)
raw_ Word64
resultStructType)
                ((MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Method
Method (MutMsg s)
raw_) Vector Annotation
annotations) m (List (MutMsg s) (Annotation (MutMsg s)))
-> (List (MutMsg s) (Annotation (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Annotation (MutMsg s)))) =>
Method (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'annotations Cerial (MutMsg s) Method
Method (MutMsg s)
raw_))
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Method
Method (MutMsg s)
raw_) Brand
paramBrand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Method (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramBrand Cerial (MutMsg s) Method
Method (MutMsg s)
raw_))
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Method
Method (MutMsg s)
raw_) Brand
resultBrand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Method (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultBrand Cerial (MutMsg s) Method
Method (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Node'Parameter
-> m (Cerial (MutMsg s) (Vector Node'Parameter))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Method
Method (MutMsg s)
raw_) Vector Node'Parameter
implicitParameters) m (List (MutMsg s) (Node'Parameter (MutMsg s)))
-> (List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Method (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Node'Parameter (MutMsg s)))) =>
Method (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'implicitParameters Cerial (MutMsg s) Method
Method (MutMsg 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 :: MutMsg s -> Vector Method -> m (Cerial (MutMsg s) (Vector Method))
cerialize  = MutMsg s -> Vector Method -> m (Cerial (MutMsg s) (Vector Method))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Method)))) where
    cerialize :: MutMsg s
-> Vector (Vector Method)
-> m (Cerial (MutMsg s) (Vector (Vector Method)))
cerialize  = MutMsg s
-> Vector (Vector Method)
-> m (Cerial (MutMsg s) (Vector (Vector Method)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Method))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Method))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Method))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Method))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Method))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Method)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Method)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Method)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Method)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Method)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Method))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Method))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Method))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Method))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Method))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Method)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Method)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Method)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Method)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Method)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Method))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Method))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Method))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Method))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type)) where
    fromStruct :: Struct ConstMsg -> m Type
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type ConstMsg) -> (Type ConstMsg -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type ConstMsg -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Type)) where
    type Cerial msg (Type) = (Capnp.Gen.ById.Xa93fc509624c72d9.Type msg)
    decerialize :: Cerial ConstMsg Type -> m Type
decerialize Cerial ConstMsg Type
raw = (do
        Type' ConstMsg
raw <- (Type ConstMsg -> m (Type' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Type' msg)) =>
Type msg -> m (Type' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type' Cerial ConstMsg Type
Type ConstMsg
raw)
        case Type' ConstMsg
raw of
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'void) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'void)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'bool) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'bool)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int8) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int8)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int16) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int16)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int32)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'int64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'int64)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint8) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint8)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint16) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint16)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint32)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'uint64)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'float32) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'float32)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'float64) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'float64)
            (Type' ConstMsg
Capnp.Gen.ById.Xa93fc509624c72d9.Type'text) ->
                (Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type
Type'text)
            (Type' ConstMsg
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 ConstMsg
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 ConstMsg Type'list -> m Type'list
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'list
Type'list ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'enum Type'enum ConstMsg
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 ConstMsg Type'enum -> m Type'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'enum
Type'enum ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'struct Type'struct ConstMsg
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 ConstMsg Type'struct -> m Type'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'struct
Type'struct ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'interface Type'interface ConstMsg
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 ConstMsg Type'interface -> m Type'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'interface
Type'interface ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer Type'anyPointer ConstMsg
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 ConstMsg Type'anyPointer -> m Type'anyPointer
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'anyPointer
Type'anyPointer ConstMsg
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 (MutMsg s) Type -> Type -> m ()
marshalInto Cerial (MutMsg s) Type
raw_ Type
value_ = case Type
value_ of
        (Type
Type'void) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'void Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'bool) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'bool Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'int8) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int8 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'int16) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int16 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'int32) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int32 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'int64) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int64 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'uint8) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint8 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'uint16) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint16 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'uint32) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint32 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'uint64) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint64 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'float32) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float32 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'float64) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float64 Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'text) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'text Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type
Type'data_) ->
            (Type (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'data_ Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
        (Type'list Type'list
arg_) ->
            (do
                Type'list (MutMsg s)
raw_ <- (Type (MutMsg s) -> m (Type'list (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Type'list (MutMsg s))) =>
Type (MutMsg s) -> m (Type'list (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'list -> Type'list -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'list
Type'list (MutMsg s)
raw_ Type'list
arg_)
                )
        (Type'enum Type'enum
arg_) ->
            (do
                Type'enum (MutMsg s)
raw_ <- (Type (MutMsg s) -> m (Type'enum (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Type'enum (MutMsg s))) =>
Type (MutMsg s) -> m (Type'enum (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'enum -> Type'enum -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'enum
Type'enum (MutMsg s)
raw_ Type'enum
arg_)
                )
        (Type'struct Type'struct
arg_) ->
            (do
                Type'struct (MutMsg s)
raw_ <- (Type (MutMsg s) -> m (Type'struct (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Type'struct (MutMsg s))) =>
Type (MutMsg s) -> m (Type'struct (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'struct -> Type'struct -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'struct
Type'struct (MutMsg s)
raw_ Type'struct
arg_)
                )
        (Type'interface Type'interface
arg_) ->
            (do
                Type'interface (MutMsg s)
raw_ <- (Type (MutMsg s) -> m (Type'interface (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Type'interface (MutMsg s))) =>
Type (MutMsg s) -> m (Type'interface (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'interface -> Type'interface -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'interface
Type'interface (MutMsg s)
raw_ Type'interface
arg_)
                )
        (Type'anyPointer Type'anyPointer
arg_) ->
            (do
                Type'anyPointer (MutMsg s)
raw_ <- (Type (MutMsg s) -> m (Type'anyPointer (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s, FromStruct (MutMsg s) (Type'anyPointer (MutMsg s))) =>
Type (MutMsg s) -> m (Type'anyPointer (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer Cerial (MutMsg s) Type
Type (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'anyPointer -> Type'anyPointer -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'anyPointer
Type'anyPointer (MutMsg s)
raw_ Type'anyPointer
arg_)
                )
        (Type'unknown' Word16
tag) ->
            (Type (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'unknown' Cerial (MutMsg s) Type
Type (MutMsg s)
raw_ Word16
tag)
instance (Classes.Cerialize s (Type))
instance (Classes.Cerialize s (V.Vector (Type))) where
    cerialize :: MutMsg s -> Vector Type -> m (Cerial (MutMsg s) (Vector Type))
cerialize  = MutMsg s -> Vector Type -> m (Cerial (MutMsg s) (Vector Type))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Type)))) where
    cerialize :: MutMsg s
-> Vector (Vector Type)
-> m (Cerial (MutMsg s) (Vector (Vector Type)))
cerialize  = MutMsg s
-> Vector (Vector Type)
-> m (Cerial (MutMsg s) (Vector (Vector Type)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Type))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Type))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Type))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Type))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Type))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Type)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Type)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Type)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Type)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Type)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Type))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Type))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Type))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Type))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Type))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Type)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Type)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Type)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Type)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Type)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Type))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Type))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Type))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Type))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'list)) where
    fromStruct :: Struct ConstMsg -> m Type'list
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'list ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'list ConstMsg)
-> (Type'list ConstMsg -> m Type'list) -> m Type'list
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'list ConstMsg -> m Type'list
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'list -> m Type'list
decerialize Cerial ConstMsg 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 ConstMsg -> m (Type ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Type msg)) =>
Type'list msg -> m (Type msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'list'elementType Cerial ConstMsg Type'list
Type'list ConstMsg
raw) m (Type ConstMsg) -> (Type ConstMsg -> m Type) -> m Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type ConstMsg -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Type'list)) where
    marshalInto :: Cerial (MutMsg s) Type'list -> Type'list -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Type -> m (Cerial (MutMsg s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Type'list (MutMsg s) -> InMessage (Type'list (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Type'list
Type'list (MutMsg s)
raw_) Type
elementType) m (Type (MutMsg s)) -> (Type (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'list (MutMsg s) -> Type (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type (MutMsg s))) =>
Type'list (MutMsg s) -> Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list'elementType Cerial (MutMsg s) Type'list
Type'list (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'enum)) where
    fromStruct :: Struct ConstMsg -> m Type'enum
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'enum ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'enum ConstMsg)
-> (Type'enum ConstMsg -> m Type'enum) -> m Type'enum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'enum ConstMsg -> m Type'enum
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'enum -> m Type'enum
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'enum msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'typeId Cerial ConstMsg Type'enum
Type'enum ConstMsg
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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'enum msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'brand Cerial ConstMsg Type'enum
Type'enum ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Type'enum)) where
    marshalInto :: Cerial (MutMsg s) Type'enum -> Type'enum -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'enum (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'typeId Cerial (MutMsg s) Type'enum
Type'enum (MutMsg s)
raw_ Word64
typeId)
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Type'enum (MutMsg s) -> InMessage (Type'enum (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Type'enum
Type'enum (MutMsg s)
raw_) Brand
brand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'enum (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Type'enum (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'brand Cerial (MutMsg s) Type'enum
Type'enum (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'struct)) where
    fromStruct :: Struct ConstMsg -> m Type'struct
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'struct ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'struct ConstMsg)
-> (Type'struct ConstMsg -> m Type'struct) -> m Type'struct
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'struct ConstMsg -> m Type'struct
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'struct -> m Type'struct
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'struct msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'typeId Cerial ConstMsg Type'struct
Type'struct ConstMsg
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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'struct msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'brand Cerial ConstMsg Type'struct
Type'struct ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Type'struct)) where
    marshalInto :: Cerial (MutMsg s) Type'struct -> Type'struct -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'struct (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'typeId Cerial (MutMsg s) Type'struct
Type'struct (MutMsg s)
raw_ Word64
typeId)
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Type'struct (MutMsg s) -> InMessage (Type'struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Type'struct
Type'struct (MutMsg s)
raw_) Brand
brand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'struct (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Type'struct (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'brand Cerial (MutMsg s) Type'struct
Type'struct (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'interface)) where
    fromStruct :: Struct ConstMsg -> m Type'interface
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'interface ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'interface ConstMsg)
-> (Type'interface ConstMsg -> m Type'interface)
-> m Type'interface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'interface ConstMsg -> m Type'interface
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'interface -> m Type'interface
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'interface msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'typeId Cerial ConstMsg Type'interface
Type'interface ConstMsg
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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Type'interface msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'brand Cerial ConstMsg Type'interface
Type'interface ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Type'interface)) where
    marshalInto :: Cerial (MutMsg s) Type'interface -> Type'interface -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'interface (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'typeId Cerial (MutMsg s) Type'interface
Type'interface (MutMsg s)
raw_ Word64
typeId)
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Type'interface (MutMsg s) -> InMessage (Type'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Type'interface
Type'interface (MutMsg s)
raw_) Brand
brand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Type'interface (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Type'interface (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'brand Cerial (MutMsg s) Type'interface
Type'interface (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'anyPointer)) where
    fromStruct :: Struct ConstMsg -> m Type'anyPointer
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'anyPointer ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'anyPointer ConstMsg)
-> (Type'anyPointer ConstMsg -> m Type'anyPointer)
-> m Type'anyPointer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer ConstMsg -> m Type'anyPointer
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'anyPointer -> m Type'anyPointer
decerialize Cerial ConstMsg Type'anyPointer
raw = (do
        Type'anyPointer' ConstMsg
raw <- (Type'anyPointer ConstMsg -> m (Type'anyPointer' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Type'anyPointer' msg)) =>
Type'anyPointer msg -> m (Type'anyPointer' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer' Cerial ConstMsg Type'anyPointer
Type'anyPointer ConstMsg
raw)
        case Type'anyPointer' ConstMsg
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained Type'anyPointer'unconstrained ConstMsg
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 ConstMsg Type'anyPointer'unconstrained
-> m Type'anyPointer'unconstrained
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'parameter Type'anyPointer'parameter ConstMsg
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 ConstMsg Type'anyPointer'parameter
-> m Type'anyPointer'parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'anyPointer'parameter
Type'anyPointer'parameter ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter ConstMsg
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 ConstMsg Type'anyPointer'implicitMethodParameter
-> m Type'anyPointer'implicitMethodParameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter ConstMsg
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 (MutMsg s) Type'anyPointer -> Type'anyPointer -> m ()
marshalInto Cerial (MutMsg s) Type'anyPointer
raw_ Type'anyPointer
value_ = case Type'anyPointer
value_ of
        (Type'anyPointer'unconstrained Type'anyPointer'unconstrained
arg_) ->
            (do
                Type'anyPointer'unconstrained (MutMsg s)
raw_ <- (Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'unconstrained (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct
   (MutMsg s) (Type'anyPointer'unconstrained (MutMsg s))) =>
Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'unconstrained (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained Cerial (MutMsg s) Type'anyPointer
Type'anyPointer (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg s)
raw_ Type'anyPointer'unconstrained
arg_)
                )
        (Type'anyPointer'parameter Type'anyPointer'parameter
arg_) ->
            (do
                Type'anyPointer'parameter (MutMsg s)
raw_ <- (Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'parameter (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct (MutMsg s) (Type'anyPointer'parameter (MutMsg s))) =>
Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'parameter (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter Cerial (MutMsg s) Type'anyPointer
Type'anyPointer (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'anyPointer'parameter
-> Type'anyPointer'parameter -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'anyPointer'parameter
Type'anyPointer'parameter (MutMsg s)
raw_ Type'anyPointer'parameter
arg_)
                )
        (Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter
arg_) ->
            (do
                Type'anyPointer'implicitMethodParameter (MutMsg s)
raw_ <- (Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'implicitMethodParameter (MutMsg s))
forall (m :: * -> *) s.
(RWCtx m s,
 FromStruct
   (MutMsg s) (Type'anyPointer'implicitMethodParameter (MutMsg s))) =>
Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'implicitMethodParameter (MutMsg s))
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter Cerial (MutMsg s) Type'anyPointer
Type'anyPointer (MutMsg s)
raw_)
                (Cerial (MutMsg s) Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter (MutMsg s)
raw_ Type'anyPointer'implicitMethodParameter
arg_)
                )
        (Type'anyPointer'unknown' Word16
tag) ->
            (Type'anyPointer (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unknown' Cerial (MutMsg s) Type'anyPointer
Type'anyPointer (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'anyPointer'unconstrained)) where
    fromStruct :: Struct ConstMsg -> m Type'anyPointer'unconstrained
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'anyPointer'unconstrained ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'anyPointer'unconstrained ConstMsg)
-> (Type'anyPointer'unconstrained ConstMsg
    -> m Type'anyPointer'unconstrained)
-> m Type'anyPointer'unconstrained
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'unconstrained ConstMsg
-> m Type'anyPointer'unconstrained
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'anyPointer'unconstrained
-> m Type'anyPointer'unconstrained
decerialize Cerial ConstMsg Type'anyPointer'unconstrained
raw = (do
        Type'anyPointer'unconstrained' ConstMsg
raw <- (Type'anyPointer'unconstrained ConstMsg
-> m (Type'anyPointer'unconstrained' ConstMsg)
forall (m :: * -> *) msg.
(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 ConstMsg Type'anyPointer'unconstrained
Type'anyPointer'unconstrained ConstMsg
raw)
        case Type'anyPointer'unconstrained' ConstMsg
raw of
            (Type'anyPointer'unconstrained' ConstMsg
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' ConstMsg
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' ConstMsg
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' ConstMsg
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 (MutMsg s) Type'anyPointer'unconstrained
-> Type'anyPointer'unconstrained -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'anyKind Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'struct) ->
            (Type'anyPointer'unconstrained (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'struct Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'list) ->
            (Type'anyPointer'unconstrained (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'list Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg s)
raw_)
        (Type'anyPointer'unconstrained
Type'anyPointer'unconstrained'capability) ->
            (Type'anyPointer'unconstrained (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'capability Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg s)
raw_)
        (Type'anyPointer'unconstrained'unknown' Word16
tag) ->
            (Type'anyPointer'unconstrained (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'unconstrained (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'unknown' Cerial (MutMsg s) Type'anyPointer'unconstrained
Type'anyPointer'unconstrained (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'anyPointer'parameter)) where
    fromStruct :: Struct ConstMsg -> m Type'anyPointer'parameter
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Type'anyPointer'parameter ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'anyPointer'parameter ConstMsg)
-> (Type'anyPointer'parameter ConstMsg
    -> m Type'anyPointer'parameter)
-> m Type'anyPointer'parameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'parameter ConstMsg -> m Type'anyPointer'parameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'anyPointer'parameter
-> m Type'anyPointer'parameter
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'anyPointer'parameter msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'scopeId Cerial ConstMsg Type'anyPointer'parameter
Type'anyPointer'parameter ConstMsg
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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'anyPointer'parameter msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'parameterIndex Cerial ConstMsg Type'anyPointer'parameter
Type'anyPointer'parameter ConstMsg
raw))
instance (Classes.Marshal s (Type'anyPointer'parameter)) where
    marshalInto :: Cerial (MutMsg s) Type'anyPointer'parameter
-> Type'anyPointer'parameter -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'parameter (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'scopeId Cerial (MutMsg s) Type'anyPointer'parameter
Type'anyPointer'parameter (MutMsg s)
raw_ Word64
scopeId)
                (Type'anyPointer'parameter (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'parameter (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'parameterIndex Cerial (MutMsg s) Type'anyPointer'parameter
Type'anyPointer'parameter (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Type'anyPointer'implicitMethodParameter)) where
    fromStruct :: Struct ConstMsg -> m Type'anyPointer'implicitMethodParameter
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg
-> m (Type'anyPointer'implicitMethodParameter ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Type'anyPointer'implicitMethodParameter ConstMsg)
-> (Type'anyPointer'implicitMethodParameter ConstMsg
    -> m Type'anyPointer'implicitMethodParameter)
-> m Type'anyPointer'implicitMethodParameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type'anyPointer'implicitMethodParameter ConstMsg
-> m Type'anyPointer'implicitMethodParameter
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Type'anyPointer'implicitMethodParameter
-> m Type'anyPointer'implicitMethodParameter
decerialize Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Type'anyPointer'implicitMethodParameter msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'implicitMethodParameter'parameterIndex Cerial ConstMsg Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter ConstMsg
raw))
instance (Classes.Marshal s (Type'anyPointer'implicitMethodParameter)) where
    marshalInto :: Cerial (MutMsg s) Type'anyPointer'implicitMethodParameter
-> Type'anyPointer'implicitMethodParameter -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s)
-> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Type'anyPointer'implicitMethodParameter (MutMsg s)
-> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter'parameterIndex Cerial (MutMsg s) Type'anyPointer'implicitMethodParameter
Type'anyPointer'implicitMethodParameter (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Brand)) where
    fromStruct :: Struct ConstMsg -> m Brand
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Brand ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Brand)) where
    type Cerial msg (Brand) = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand msg)
    decerialize :: Cerial ConstMsg Brand -> m Brand
decerialize Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Brand'Scope ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg Brand
Brand ConstMsg
raw) m (List ConstMsg (Brand'Scope ConstMsg))
-> (List ConstMsg (Brand'Scope ConstMsg) -> m (Vector Brand'Scope))
-> m (Vector Brand'Scope)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Brand'Scope ConstMsg) -> m (Vector Brand'Scope)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Brand)) where
    marshalInto :: Cerial (MutMsg s) Brand -> Brand -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s
-> Vector Brand'Scope -> m (Cerial (MutMsg s) (Vector Brand'Scope))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Brand (MutMsg s) -> InMessage (Brand (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Brand
Brand (MutMsg s)
raw_) Vector Brand'Scope
scopes) m (List (MutMsg s) (Brand'Scope (MutMsg s)))
-> (List (MutMsg s) (Brand'Scope (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand (MutMsg s)
-> List (MutMsg s) (Brand'Scope (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Brand'Scope (MutMsg s)))) =>
Brand (MutMsg s)
-> List (MutMsg s) (Brand'Scope (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'scopes Cerial (MutMsg s) Brand
Brand (MutMsg 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 :: MutMsg s -> Vector Brand -> m (Cerial (MutMsg s) (Vector Brand))
cerialize  = MutMsg s -> Vector Brand -> m (Cerial (MutMsg s) (Vector Brand))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Brand)))) where
    cerialize :: MutMsg s
-> Vector (Vector Brand)
-> m (Cerial (MutMsg s) (Vector (Vector Brand)))
cerialize  = MutMsg s
-> Vector (Vector Brand)
-> m (Cerial (MutMsg s) (Vector (Vector Brand)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Brand))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Brand))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Brand))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Brand)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Brand)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Brand)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Brand)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Brand)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Brand))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Brand))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Brand)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Brand)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Brand'Scope)) where
    fromStruct :: Struct ConstMsg -> m Brand'Scope
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Brand'Scope ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Brand'Scope ConstMsg)
-> (Brand'Scope ConstMsg -> m Brand'Scope) -> m Brand'Scope
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Scope ConstMsg -> m Brand'Scope
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Brand'Scope -> m Brand'Scope
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Brand'Scope msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope'scopeId Cerial ConstMsg Brand'Scope
Brand'Scope ConstMsg
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 ConstMsg Brand'Scope' -> m Brand'Scope'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Brand'Scope'
Cerial ConstMsg Brand'Scope
raw))
instance (Classes.Marshal s (Brand'Scope)) where
    marshalInto :: Cerial (MutMsg s) Brand'Scope -> Brand'Scope -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Scope (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'scopeId Cerial (MutMsg s) Brand'Scope
Brand'Scope (MutMsg s)
raw_ Word64
scopeId)
                (do
                    (Cerial (MutMsg s) Brand'Scope' -> Brand'Scope' -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial (MutMsg s) a -> a -> m ()
Classes.marshalInto Cerial (MutMsg s) Brand'Scope'
Cerial (MutMsg 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 :: MutMsg s
-> Vector Brand'Scope -> m (Cerial (MutMsg s) (Vector Brand'Scope))
cerialize  = MutMsg s
-> Vector Brand'Scope -> m (Cerial (MutMsg s) (Vector Brand'Scope))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Brand'Scope)))) where
    cerialize :: MutMsg s
-> Vector (Vector Brand'Scope)
-> m (Cerial (MutMsg s) (Vector (Vector Brand'Scope)))
cerialize  = MutMsg s
-> Vector (Vector Brand'Scope)
-> m (Cerial (MutMsg s) (Vector (Vector Brand'Scope)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Brand'Scope))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Brand'Scope))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand'Scope))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Brand'Scope))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand'Scope))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Scope)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Brand'Scope)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Brand'Scope)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Brand'Scope)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Brand'Scope)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Scope))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand'Scope))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand'Scope))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Scope)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Brand'Scope))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Brand'Scope')) where
    fromStruct :: Struct ConstMsg -> m Brand'Scope'
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Brand'Scope ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Brand'Scope ConstMsg)
-> (Brand'Scope ConstMsg -> m Brand'Scope') -> m Brand'Scope'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Scope ConstMsg -> m Brand'Scope'
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Brand'Scope' -> m Brand'Scope'
decerialize Cerial ConstMsg Brand'Scope'
raw = (do
        Brand'Scope' ConstMsg
raw <- (Brand'Scope ConstMsg -> m (Brand'Scope' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Brand'Scope' msg)) =>
Brand'Scope msg -> m (Brand'Scope' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope' Cerial ConstMsg Brand'Scope'
Brand'Scope ConstMsg
raw)
        case Brand'Scope' ConstMsg
raw of
            (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'bind List ConstMsg (Brand'Binding ConstMsg)
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 ConstMsg (Vector Brand'Binding) -> m (Vector Brand'Binding)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg (Vector Brand'Binding)
List ConstMsg (Brand'Binding ConstMsg)
raw))
            (Brand'Scope' ConstMsg
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 (MutMsg s) Brand'Scope' -> Brand'Scope' -> m ()
marshalInto Cerial (MutMsg s) Brand'Scope'
raw_ Brand'Scope'
value_ = case Brand'Scope'
value_ of
        (Brand'Scope'bind Vector Brand'Binding
arg_) ->
            ((MutMsg s
-> Vector Brand'Binding
-> m (Cerial (MutMsg s) (Vector Brand'Binding))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Brand'Scope (MutMsg s) -> InMessage (Brand'Scope (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Brand'Scope'
Brand'Scope (MutMsg s)
raw_) Vector Brand'Binding
arg_) m (List (MutMsg s) (Brand'Binding (MutMsg s)))
-> (List (MutMsg s) (Brand'Binding (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand'Scope (MutMsg s)
-> List (MutMsg s) (Brand'Binding (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Brand'Binding (MutMsg s)))) =>
Brand'Scope (MutMsg s)
-> List (MutMsg s) (Brand'Binding (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'bind Cerial (MutMsg s) Brand'Scope'
Brand'Scope (MutMsg s)
raw_))
        (Brand'Scope'
Brand'Scope'inherit) ->
            (Brand'Scope (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Brand'Scope (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'inherit Cerial (MutMsg s) Brand'Scope'
Brand'Scope (MutMsg s)
raw_)
        (Brand'Scope'unknown' Word16
tag) ->
            (Brand'Scope (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Scope (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'unknown' Cerial (MutMsg s) Brand'Scope'
Brand'Scope (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Brand'Binding)) where
    fromStruct :: Struct ConstMsg -> m Brand'Binding
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Brand'Binding ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Brand'Binding ConstMsg)
-> (Brand'Binding ConstMsg -> m Brand'Binding) -> m Brand'Binding
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand'Binding ConstMsg -> m Brand'Binding
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg Brand'Binding -> m Brand'Binding
decerialize Cerial ConstMsg Brand'Binding
raw = (do
        Brand'Binding' ConstMsg
raw <- (Brand'Binding ConstMsg -> m (Brand'Binding' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Brand'Binding' msg)) =>
Brand'Binding msg -> m (Brand'Binding' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Binding' Cerial ConstMsg Brand'Binding
Brand'Binding ConstMsg
raw)
        case Brand'Binding' ConstMsg
raw of
            (Brand'Binding' ConstMsg
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 ConstMsg
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 ConstMsg Type -> m Type
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Type
Type ConstMsg
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 (MutMsg s) Brand'Binding -> Brand'Binding -> m ()
marshalInto Cerial (MutMsg s) Brand'Binding
raw_ Brand'Binding
value_ = case Brand'Binding
value_ of
        (Brand'Binding
Brand'Binding'unbound) ->
            (Brand'Binding (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Binding (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unbound Cerial (MutMsg s) Brand'Binding
Brand'Binding (MutMsg s)
raw_)
        (Brand'Binding'type_ Type
arg_) ->
            ((MutMsg s -> Type -> m (Cerial (MutMsg s) Type)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Brand'Binding (MutMsg s) -> InMessage (Brand'Binding (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Brand'Binding
Brand'Binding (MutMsg s)
raw_) Type
arg_) m (Type (MutMsg s)) -> (Type (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Brand'Binding (MutMsg s) -> Type (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Type (MutMsg s))) =>
Brand'Binding (MutMsg s) -> Type (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'type_ Cerial (MutMsg s) Brand'Binding
Brand'Binding (MutMsg s)
raw_))
        (Brand'Binding'unknown' Word16
tag) ->
            (Brand'Binding (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Brand'Binding (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' Cerial (MutMsg s) Brand'Binding
Brand'Binding (MutMsg s)
raw_ Word16
tag)
instance (Classes.Cerialize s (Brand'Binding))
instance (Classes.Cerialize s (V.Vector (Brand'Binding))) where
    cerialize :: MutMsg s
-> Vector Brand'Binding
-> m (Cerial (MutMsg s) (Vector Brand'Binding))
cerialize  = MutMsg s
-> Vector Brand'Binding
-> m (Cerial (MutMsg s) (Vector Brand'Binding))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Brand'Binding)))) where
    cerialize :: MutMsg s
-> Vector (Vector Brand'Binding)
-> m (Cerial (MutMsg s) (Vector (Vector Brand'Binding)))
cerialize  = MutMsg s
-> Vector (Vector Brand'Binding)
-> m (Cerial (MutMsg s) (Vector (Vector Brand'Binding)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Brand'Binding))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Brand'Binding))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand'Binding))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Brand'Binding))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Brand'Binding))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Binding)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Brand'Binding)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Brand'Binding)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Brand'Binding)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Brand'Binding)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Binding))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand'Binding))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Brand'Binding))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Brand'Binding)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector Brand'Binding)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector Brand'Binding))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Value)) where
    fromStruct :: Struct ConstMsg -> m Value
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Value ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Value ConstMsg) -> (Value ConstMsg -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value ConstMsg -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Value)) where
    type Cerial msg (Value) = (Capnp.Gen.ById.Xa93fc509624c72d9.Value msg)
    decerialize :: Cerial ConstMsg Value -> m Value
decerialize Cerial ConstMsg Value
raw = (do
        Value' ConstMsg
raw <- (Value ConstMsg -> m (Value' ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromStruct msg (Value' msg)) =>
Value msg -> m (Value' msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Value' Cerial ConstMsg Value
Value ConstMsg
raw)
        case Value' ConstMsg
raw of
            (Value' ConstMsg
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 ConstMsg
raw) ->
                (Text -> Value
Value'text (Text -> Value) -> m Text -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial ConstMsg Text -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg Text
Text ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'data_ Data ConstMsg
raw) ->
                (ByteString -> Value
Value'data_ (ByteString -> Value) -> m ByteString -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cerial ConstMsg ByteString -> m ByteString
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Cerial ConstMsg ByteString
Data ConstMsg
raw))
            (Capnp.Gen.ById.Xa93fc509624c72d9.Value'list Maybe (Ptr ConstMsg)
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 ConstMsg (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Maybe (Ptr ConstMsg)
Cerial ConstMsg (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 ConstMsg)
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 ConstMsg (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Maybe (Ptr ConstMsg)
Cerial ConstMsg (Maybe Ptr)
raw))
            (Value' ConstMsg
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 ConstMsg)
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 ConstMsg (Maybe Ptr) -> m (Maybe Ptr)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize Maybe (Ptr ConstMsg)
Cerial ConstMsg (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 (MutMsg s) Value -> Value -> m ()
marshalInto Cerial (MutMsg s) Value
raw_ Value
value_ = case Value
value_ of
        (Value
Value'void) ->
            (Value (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Value (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'void Cerial (MutMsg s) Value
Value (MutMsg s)
raw_)
        (Value'bool Bool
arg_) ->
            (Value (MutMsg s) -> Bool -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Bool -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'bool Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Bool
arg_)
        (Value'int8 Int8
arg_) ->
            (Value (MutMsg s) -> Int8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Int8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int8 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Int8
arg_)
        (Value'int16 Int16
arg_) ->
            (Value (MutMsg s) -> Int16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Int16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int16 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Int16
arg_)
        (Value'int32 Int32
arg_) ->
            (Value (MutMsg s) -> Int32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Int32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int32 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Int32
arg_)
        (Value'int64 Int64
arg_) ->
            (Value (MutMsg s) -> Int64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Int64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int64 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Int64
arg_)
        (Value'uint8 Word8
arg_) ->
            (Value (MutMsg s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint8 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word8
arg_)
        (Value'uint16 Word16
arg_) ->
            (Value (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint16 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word16
arg_)
        (Value'uint32 Word32
arg_) ->
            (Value (MutMsg s) -> Word32 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word32 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint32 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word32
arg_)
        (Value'uint64 Word64
arg_) ->
            (Value (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint64 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word64
arg_)
        (Value'float32 Float
arg_) ->
            (Value (MutMsg s) -> Float -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Float -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float32 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Float
arg_)
        (Value'float64 Double
arg_) ->
            (Value (MutMsg s) -> Double -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Double -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float64 Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Double
arg_)
        (Value'text Text
arg_) ->
            ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Value (MutMsg s) -> InMessage (Value (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Value
Value (MutMsg s)
raw_) Text
arg_) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value (MutMsg s) -> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
Value (MutMsg s) -> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'text Cerial (MutMsg s) Value
Value (MutMsg s)
raw_))
        (Value'data_ ByteString
arg_) ->
            ((MutMsg s -> ByteString -> m (Cerial (MutMsg s) ByteString)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Value (MutMsg s) -> InMessage (Value (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Value
Value (MutMsg s)
raw_) ByteString
arg_) m (Data (MutMsg s)) -> (Data (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value (MutMsg s) -> Data (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Data (MutMsg s))) =>
Value (MutMsg s) -> Data (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'data_ Cerial (MutMsg s) Value
Value (MutMsg s)
raw_))
        (Value'list Maybe Ptr
arg_) ->
            ((MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Value (MutMsg s) -> InMessage (Value (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Value
Value (MutMsg s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr (MutMsg s)))
-> (Maybe (Ptr (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr (MutMsg s)))) =>
Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'list Cerial (MutMsg s) Value
Value (MutMsg s)
raw_))
        (Value'enum Word16
arg_) ->
            (Value (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'enum Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word16
arg_)
        (Value'struct Maybe Ptr
arg_) ->
            ((MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Value (MutMsg s) -> InMessage (Value (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Value
Value (MutMsg s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr (MutMsg s)))
-> (Maybe (Ptr (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr (MutMsg s)))) =>
Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'struct Cerial (MutMsg s) Value
Value (MutMsg s)
raw_))
        (Value
Value'interface) ->
            (Value (MutMsg s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Value (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'interface Cerial (MutMsg s) Value
Value (MutMsg s)
raw_)
        (Value'anyPointer Maybe Ptr
arg_) ->
            ((MutMsg s -> Maybe Ptr -> m (Cerial (MutMsg s) (Maybe Ptr))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Value (MutMsg s) -> InMessage (Value (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Value
Value (MutMsg s)
raw_) Maybe Ptr
arg_) m (Maybe (Ptr (MutMsg s)))
-> (Maybe (Ptr (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Maybe (Ptr (MutMsg s)))) =>
Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'anyPointer Cerial (MutMsg s) Value
Value (MutMsg s)
raw_))
        (Value'unknown' Word16
tag) ->
            (Value (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Value (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'unknown' Cerial (MutMsg s) Value
Value (MutMsg s)
raw_ Word16
tag)
instance (Classes.Cerialize s (Value))
instance (Classes.Cerialize s (V.Vector (Value))) where
    cerialize :: MutMsg s -> Vector Value -> m (Cerial (MutMsg s) (Vector Value))
cerialize  = MutMsg s -> Vector Value -> m (Cerial (MutMsg s) (Vector Value))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Value)))) where
    cerialize :: MutMsg s
-> Vector (Vector Value)
-> m (Cerial (MutMsg s) (Vector (Vector Value)))
cerialize  = MutMsg s
-> Vector (Vector Value)
-> m (Cerial (MutMsg s) (Vector (Vector Value)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Value))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Value))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Value))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Value))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Value))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Value)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Value)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Value)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Value)))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector (Vector Value)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Value))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Value))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Value))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Value))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Value))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Value)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Value)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Value)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Value)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Value)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Value))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Value))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Value))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Value))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (Annotation)) where
    fromStruct :: Struct ConstMsg -> m Annotation
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (Annotation ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (Annotation ConstMsg)
-> (Annotation ConstMsg -> m Annotation) -> m Annotation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Annotation ConstMsg -> m Annotation
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (Annotation)) where
    type Cerial msg (Annotation) = (Capnp.Gen.ById.Xa93fc509624c72d9.Annotation msg)
    decerialize :: Cerial ConstMsg Annotation -> m Annotation
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Annotation msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'id Cerial ConstMsg Annotation
Annotation ConstMsg
raw)
                                  m (Value -> Brand -> Annotation)
-> m Value -> m (Brand -> Annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Annotation ConstMsg -> m (Value ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Value msg)) =>
Annotation msg -> m (Value msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'value Cerial ConstMsg Annotation
Annotation ConstMsg
raw) m (Value ConstMsg) -> (Value ConstMsg -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value ConstMsg -> m Value
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (Brand ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Brand msg)) =>
Annotation msg -> m (Brand msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'brand Cerial ConstMsg Annotation
Annotation ConstMsg
raw) m (Brand ConstMsg) -> (Brand ConstMsg -> m Brand) -> m Brand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Brand ConstMsg -> m Brand
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (Annotation)) where
    marshalInto :: Cerial (MutMsg s) Annotation -> Annotation -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Annotation (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'id Cerial (MutMsg s) Annotation
Annotation (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Value -> m (Cerial (MutMsg s) Value)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Annotation (MutMsg s) -> InMessage (Annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Annotation
Annotation (MutMsg s)
raw_) Value
value) m (Value (MutMsg s)) -> (Value (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Annotation (MutMsg s) -> Value (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Value (MutMsg s))) =>
Annotation (MutMsg s) -> Value (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'value Cerial (MutMsg s) Annotation
Annotation (MutMsg s)
raw_))
                ((MutMsg s -> Brand -> m (Cerial (MutMsg s) Brand)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (Annotation (MutMsg s) -> InMessage (Annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) Annotation
Annotation (MutMsg s)
raw_) Brand
brand) m (Brand (MutMsg s)) -> (Brand (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Annotation (MutMsg s) -> Brand (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Brand (MutMsg s))) =>
Annotation (MutMsg s) -> Brand (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'brand Cerial (MutMsg s) Annotation
Annotation (MutMsg 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 :: MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
cerialize  = MutMsg s
-> Vector Annotation -> m (Cerial (MutMsg s) (Vector Annotation))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (Annotation)))) where
    cerialize :: MutMsg s
-> Vector (Vector Annotation)
-> m (Cerial (MutMsg s) (Vector (Vector Annotation)))
cerialize  = MutMsg s
-> Vector (Vector Annotation)
-> m (Cerial (MutMsg s) (Vector (Vector Annotation)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (Annotation))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector Annotation))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Annotation))))
cerialize  = MutMsg s
-> Vector (Vector (Vector Annotation))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector Annotation))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (Annotation)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector Annotation)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Annotation)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector Annotation)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector Annotation)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Annotation))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector Annotation))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Annotation))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector Annotation))))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector (Vector Annotation))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (Annotation)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector Annotation)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector (Vector Annotation))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (CapnpVersion)) where
    fromStruct :: Struct ConstMsg -> m CapnpVersion
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (CapnpVersion ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (CapnpVersion ConstMsg)
-> (CapnpVersion ConstMsg -> m CapnpVersion) -> m CapnpVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CapnpVersion ConstMsg -> m CapnpVersion
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (CapnpVersion)) where
    type Cerial msg (CapnpVersion) = (Capnp.Gen.ById.Xa93fc509624c72d9.CapnpVersion msg)
    decerialize :: Cerial ConstMsg CapnpVersion -> m CapnpVersion
decerialize Cerial ConstMsg 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 ConstMsg -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
CapnpVersion msg -> m Word16
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'major Cerial ConstMsg CapnpVersion
CapnpVersion ConstMsg
raw)
                                    m (Word8 -> Word8 -> CapnpVersion)
-> m Word8 -> m (Word8 -> CapnpVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CapnpVersion ConstMsg -> m Word8
forall (m :: * -> *) msg.
ReadCtx m msg =>
CapnpVersion msg -> m Word8
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'minor Cerial ConstMsg CapnpVersion
CapnpVersion ConstMsg
raw)
                                    m (Word8 -> CapnpVersion) -> m Word8 -> m CapnpVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CapnpVersion ConstMsg -> m Word8
forall (m :: * -> *) msg.
ReadCtx m msg =>
CapnpVersion msg -> m Word8
Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'micro Cerial ConstMsg CapnpVersion
CapnpVersion ConstMsg
raw))
instance (Classes.Marshal s (CapnpVersion)) where
    marshalInto :: Cerial (MutMsg s) CapnpVersion -> CapnpVersion -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word16 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion (MutMsg s) -> Word16 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'major Cerial (MutMsg s) CapnpVersion
CapnpVersion (MutMsg s)
raw_ Word16
major)
                (CapnpVersion (MutMsg s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion (MutMsg s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'minor Cerial (MutMsg s) CapnpVersion
CapnpVersion (MutMsg s)
raw_ Word8
minor)
                (CapnpVersion (MutMsg s) -> Word8 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CapnpVersion (MutMsg s) -> Word8 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'micro Cerial (MutMsg s) CapnpVersion
CapnpVersion (MutMsg 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 :: MutMsg s
-> Vector CapnpVersion
-> m (Cerial (MutMsg s) (Vector CapnpVersion))
cerialize  = MutMsg s
-> Vector CapnpVersion
-> m (Cerial (MutMsg s) (Vector CapnpVersion))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (CapnpVersion)))) where
    cerialize :: MutMsg s
-> Vector (Vector CapnpVersion)
-> m (Cerial (MutMsg s) (Vector (Vector CapnpVersion)))
cerialize  = MutMsg s
-> Vector (Vector CapnpVersion)
-> m (Cerial (MutMsg s) (Vector (Vector CapnpVersion)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (CapnpVersion))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector CapnpVersion))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector CapnpVersion))))
cerialize  = MutMsg s
-> Vector (Vector (Vector CapnpVersion))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector CapnpVersion))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (CapnpVersion)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector CapnpVersion)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector CapnpVersion)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector CapnpVersion)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector CapnpVersion)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CapnpVersion))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector CapnpVersion))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector CapnpVersion))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CapnpVersion)))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector (Vector (Vector CapnpVersion))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (CodeGeneratorRequest)) where
    fromStruct :: Struct ConstMsg -> m CodeGeneratorRequest
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (CodeGeneratorRequest ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (CodeGeneratorRequest ConstMsg)
-> (CodeGeneratorRequest ConstMsg -> m CodeGeneratorRequest)
-> m CodeGeneratorRequest
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest ConstMsg -> m CodeGeneratorRequest
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize)
instance (Classes.Decerialize (CodeGeneratorRequest)) where
    type Cerial msg (CodeGeneratorRequest) = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg)
    decerialize :: Cerial ConstMsg CodeGeneratorRequest -> m CodeGeneratorRequest
decerialize Cerial ConstMsg 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 ConstMsg -> m (List ConstMsg (Node ConstMsg))
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (List msg (Node msg))) =>
CodeGeneratorRequest msg -> m (List msg (Node msg))
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'nodes Cerial ConstMsg CodeGeneratorRequest
CodeGeneratorRequest ConstMsg
raw) m (List ConstMsg (Node ConstMsg))
-> (List ConstMsg (Node ConstMsg) -> m (Vector Node))
-> m (Vector Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node ConstMsg) -> m (Vector Node)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg
-> m (List ConstMsg (CodeGeneratorRequest'RequestedFile ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg CodeGeneratorRequest
CodeGeneratorRequest ConstMsg
raw) m (List ConstMsg (CodeGeneratorRequest'RequestedFile ConstMsg))
-> (List ConstMsg (CodeGeneratorRequest'RequestedFile ConstMsg)
    -> m (Vector CodeGeneratorRequest'RequestedFile))
-> m (Vector CodeGeneratorRequest'RequestedFile)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (CodeGeneratorRequest'RequestedFile ConstMsg)
-> m (Vector CodeGeneratorRequest'RequestedFile)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg -> m (CapnpVersion ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (CapnpVersion msg)) =>
CodeGeneratorRequest msg -> m (CapnpVersion msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'capnpVersion Cerial ConstMsg CodeGeneratorRequest
CodeGeneratorRequest ConstMsg
raw) m (CapnpVersion ConstMsg)
-> (CapnpVersion ConstMsg -> m CapnpVersion) -> m CapnpVersion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CapnpVersion ConstMsg -> m CapnpVersion
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg
-> m (List ConstMsg (Node'SourceInfo ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg CodeGeneratorRequest
CodeGeneratorRequest ConstMsg
raw) m (List ConstMsg (Node'SourceInfo ConstMsg))
-> (List ConstMsg (Node'SourceInfo ConstMsg)
    -> m (Vector Node'SourceInfo))
-> m (Vector Node'SourceInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (Node'SourceInfo ConstMsg)
-> m (Vector Node'SourceInfo)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (CodeGeneratorRequest)) where
    marshalInto :: Cerial (MutMsg s) CodeGeneratorRequest
-> CodeGeneratorRequest -> m ()
marshalInto Cerial (MutMsg 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
                ((MutMsg s -> Vector Node -> m (Cerial (MutMsg s) (Vector Node))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_) Vector Node
nodes) m (List (MutMsg s) (Node (MutMsg s)))
-> (List (MutMsg s) (Node (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (List (MutMsg s) (Node (MutMsg s)))) =>
CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'nodes Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_))
                ((MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_) Vector CodeGeneratorRequest'RequestedFile
requestedFiles) m (List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
-> (List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
    -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr
   s
   (List
      (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))) =>
CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'requestedFiles Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_))
                ((MutMsg s -> CapnpVersion -> m (Cerial (MutMsg s) CapnpVersion)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_) CapnpVersion
capnpVersion) m (CapnpVersion (MutMsg s))
-> (CapnpVersion (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest (MutMsg s) -> CapnpVersion (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (CapnpVersion (MutMsg s))) =>
CodeGeneratorRequest (MutMsg s) -> CapnpVersion (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'capnpVersion Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_))
                ((MutMsg s
-> Vector Node'SourceInfo
-> m (Cerial (MutMsg s) (Vector Node'SourceInfo))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg s)
raw_) Vector Node'SourceInfo
sourceInfo) m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
-> (List (MutMsg s) (Node'SourceInfo (MutMsg s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo (MutMsg s)) -> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr s (List (MutMsg s) (Node'SourceInfo (MutMsg s)))) =>
CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo (MutMsg s)) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'sourceInfo Cerial (MutMsg s) CodeGeneratorRequest
CodeGeneratorRequest (MutMsg 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 :: MutMsg s
-> Vector CodeGeneratorRequest
-> m (Cerial (MutMsg s) (Vector CodeGeneratorRequest))
cerialize  = MutMsg s
-> Vector CodeGeneratorRequest
-> m (Cerial (MutMsg s) (Vector CodeGeneratorRequest))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (CodeGeneratorRequest)))) where
    cerialize :: MutMsg s
-> Vector (Vector CodeGeneratorRequest)
-> m (Cerial (MutMsg s) (Vector (Vector CodeGeneratorRequest)))
cerialize  = MutMsg s
-> Vector (Vector CodeGeneratorRequest)
-> m (Cerial (MutMsg s) (Vector (Vector CodeGeneratorRequest)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector CodeGeneratorRequest))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector CodeGeneratorRequest))))
cerialize  = MutMsg s
-> Vector (Vector (Vector CodeGeneratorRequest))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector CodeGeneratorRequest))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest)))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector CodeGeneratorRequest)))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector CodeGeneratorRequest)))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest))))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector (Vector CodeGeneratorRequest))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (CodeGeneratorRequest'RequestedFile)) where
    fromStruct :: Struct ConstMsg -> m CodeGeneratorRequest'RequestedFile
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg -> m (CodeGeneratorRequest'RequestedFile ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (CodeGeneratorRequest'RequestedFile ConstMsg)
-> (CodeGeneratorRequest'RequestedFile ConstMsg
    -> m CodeGeneratorRequest'RequestedFile)
-> m CodeGeneratorRequest'RequestedFile
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest'RequestedFile ConstMsg
-> m CodeGeneratorRequest'RequestedFile
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg CodeGeneratorRequest'RequestedFile
-> m CodeGeneratorRequest'RequestedFile
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
CodeGeneratorRequest'RequestedFile msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'id Cerial ConstMsg CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ConstMsg
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 ConstMsg -> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
CodeGeneratorRequest'RequestedFile msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'filename Cerial ConstMsg CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg
-> m (List
        ConstMsg (CodeGeneratorRequest'RequestedFile'Import ConstMsg))
forall (m :: * -> *) msg.
(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 ConstMsg CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile ConstMsg
raw) m (List
     ConstMsg (CodeGeneratorRequest'RequestedFile'Import ConstMsg))
-> (List
      ConstMsg (CodeGeneratorRequest'RequestedFile'Import ConstMsg)
    -> m (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Vector CodeGeneratorRequest'RequestedFile'Import)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List ConstMsg (CodeGeneratorRequest'RequestedFile'Import ConstMsg)
-> m (Vector CodeGeneratorRequest'RequestedFile'Import)
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (CodeGeneratorRequest'RequestedFile)) where
    marshalInto :: Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
-> CodeGeneratorRequest'RequestedFile -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s) -> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CodeGeneratorRequest'RequestedFile (MutMsg s) -> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'id Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (MutMsg s)
raw_) Text
filename) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
CodeGeneratorRequest'RequestedFile (MutMsg s)
-> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'filename Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (MutMsg s)
raw_))
                ((MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile'Import))
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (MutMsg s)
raw_) Vector CodeGeneratorRequest'RequestedFile'Import
imports) m (List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
-> (List
      (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
    -> m ())
-> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m ()
forall (m :: * -> *) s.
(RWCtx m s,
 ToPtr
   s
   (List
      (MutMsg s)
      (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))) =>
CodeGeneratorRequest'RequestedFile (MutMsg s)
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'imports Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile
CodeGeneratorRequest'RequestedFile (MutMsg 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 :: MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile))
cerialize  = MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile)))) where
    cerialize :: MutMsg s
-> Vector (Vector CodeGeneratorRequest'RequestedFile)
-> m (Cerial
        (MutMsg s) (Vector (Vector CodeGeneratorRequest'RequestedFile)))
cerialize  = MutMsg s
-> Vector (Vector CodeGeneratorRequest'RequestedFile)
-> m (Cerial
        (MutMsg s) (Vector (Vector CodeGeneratorRequest'RequestedFile)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
cerialize  = MutMsg s
-> Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile)))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile)))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector (Vector CodeGeneratorRequest'RequestedFile))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg (Cerial ConstMsg a)) =>
a
GenHelpersPure.defaultStruct
instance (Classes.FromStruct Message.ConstMsg (CodeGeneratorRequest'RequestedFile'Import)) where
    fromStruct :: Struct ConstMsg -> m CodeGeneratorRequest'RequestedFile'Import
fromStruct Struct ConstMsg
struct = ((Struct ConstMsg
-> m (CodeGeneratorRequest'RequestedFile'Import ConstMsg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct ConstMsg
struct) m (CodeGeneratorRequest'RequestedFile'Import ConstMsg)
-> (CodeGeneratorRequest'RequestedFile'Import ConstMsg
    -> m CodeGeneratorRequest'RequestedFile'Import)
-> m CodeGeneratorRequest'RequestedFile'Import
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeGeneratorRequest'RequestedFile'Import ConstMsg
-> m CodeGeneratorRequest'RequestedFile'Import
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 ConstMsg CodeGeneratorRequest'RequestedFile'Import
-> m CodeGeneratorRequest'RequestedFile'Import
decerialize Cerial ConstMsg 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 ConstMsg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
CodeGeneratorRequest'RequestedFile'Import msg -> m Word64
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'id Cerial ConstMsg CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import ConstMsg
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 ConstMsg
-> m (Text ConstMsg)
forall (m :: * -> *) msg.
(ReadCtx m msg, FromPtr msg (Text msg)) =>
CodeGeneratorRequest'RequestedFile'Import msg -> m (Text msg)
Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'name Cerial ConstMsg CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import ConstMsg
raw) m (Text ConstMsg) -> (Text ConstMsg -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text ConstMsg -> m Text
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
Classes.decerialize))
instance (Classes.Marshal s (CodeGeneratorRequest'RequestedFile'Import)) where
    marshalInto :: Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile'Import
-> CodeGeneratorRequest'RequestedFile'Import -> m ()
marshalInto Cerial (MutMsg 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 (MutMsg s)
-> Word64 -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Word64 -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'id Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
raw_ Word64
id)
                ((MutMsg s -> Text -> m (Cerial (MutMsg s) Text)
forall s a (m :: * -> *).
(Cerialize s a, RWCtx m s) =>
MutMsg s -> a -> m (Cerial (MutMsg s) a)
Classes.cerialize (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
raw_) Text
name) m (Text (MutMsg s)) -> (Text (MutMsg s) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Text (MutMsg s) -> m ()
forall (m :: * -> *) s.
(RWCtx m s, ToPtr s (Text (MutMsg s))) =>
CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Text (MutMsg s) -> m ()
Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'name Cerial (MutMsg s) CodeGeneratorRequest'RequestedFile'Import
CodeGeneratorRequest'RequestedFile'Import (MutMsg 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 :: MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile'Import))
cerialize  = MutMsg s
-> Vector CodeGeneratorRequest'RequestedFile'Import
-> m (Cerial
        (MutMsg s) (Vector CodeGeneratorRequest'RequestedFile'Import))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Marshal s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeCompositeVec
instance (Classes.Cerialize s (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile'Import)))) where
    cerialize :: MutMsg s
-> Vector (Vector CodeGeneratorRequest'RequestedFile'Import)
-> m (Cerial
        (MutMsg s)
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
cerialize  = MutMsg s
-> Vector (Vector CodeGeneratorRequest'RequestedFile'Import)
-> m (Cerial
        (MutMsg s)
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile'Import))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
cerialize  = MutMsg s
-> Vector
     (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile'Import)))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
GenHelpersPure.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (CodeGeneratorRequest'RequestedFile'Import))))))) where
    cerialize :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector (Vector CodeGeneratorRequest'RequestedFile'Import)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector
                       (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))))
cerialize  = MutMsg s
-> Vector
     (Vector
        (Vector
           (Vector
              (Vector
                 (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))
-> m (Cerial
        (MutMsg s)
        (Vector
           (Vector
              (Vector
                 (Vector
                    (Vector
                       (Vector (Vector CodeGeneratorRequest'RequestedFile'Import))))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 ConstMsg ElementSize -> m ElementSize
decerialize  = Cerial ConstMsg ElementSize -> m ElementSize
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure
instance (Classes.Cerialize s Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize) where
    cerialize :: MutMsg s -> ElementSize -> m (Cerial (MutMsg s) ElementSize)
cerialize MutMsg s
_ = ElementSize -> m (Cerial (MutMsg 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 :: MutMsg s
-> Vector ElementSize -> m (Cerial (MutMsg s) (Vector ElementSize))
cerialize  = MutMsg s
-> Vector ElementSize -> m (Cerial (MutMsg s) (Vector ElementSize))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))) where
    cerialize :: MutMsg s
-> Vector (Vector ElementSize)
-> m (Cerial (MutMsg s) (Vector (Vector ElementSize)))
cerialize  = MutMsg s
-> Vector (Vector ElementSize)
-> m (Cerial (MutMsg s) (Vector (Vector ElementSize)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector ElementSize))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector ElementSize))))
cerialize  = MutMsg s
-> Vector (Vector (Vector ElementSize))
-> m (Cerial (MutMsg s) (Vector (Vector (Vector ElementSize))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
Classes.cerializeBasicVec
instance (Classes.Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))))) where
    cerialize :: MutMsg s
-> Vector (Vector (Vector (Vector ElementSize)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector ElementSize)))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector ElementSize)))
-> m (Cerial
        (MutMsg s) (Vector (Vector (Vector (Vector ElementSize)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector ElementSize))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector ElementSize))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector ElementSize))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector ElementSize))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg 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 :: MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))))
cerialize  = MutMsg s
-> Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))
-> m (Cerial
        (MutMsg s)
        (Vector (Vector (Vector (Vector (Vector (Vector ElementSize)))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial (MutMsg s) a), Cerialize s a) =>
MutMsg s -> Vector a -> m (List (MutMsg s) (Cerial (MutMsg s) a))
Classes.cerializeBasicVec