{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-dodgy-exports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Capnp.Gen.Capnp.Schema where
import qualified Capnp.Message as Message
import qualified Capnp.Untyped as Untyped
import qualified Capnp.Basics as Basics
import qualified Capnp.GenHelpers as GenHelpers
import qualified Capnp.Classes as Classes
import qualified GHC.Generics as Generics
import qualified Capnp.Bits as Std_
import qualified Data.Maybe as Std_
import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
import qualified Prelude as Std_
import qualified Data.Word as Std_
import qualified Data.Int as Std_
import Prelude ((<$>), (<*>), (>>=))
newtype Node msg
    = Node'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node msg)) where
    fromStruct :: Struct msg -> m (Node msg)
fromStruct Struct msg
struct = (Node msg -> m (Node msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node msg
forall msg. Struct msg -> Node msg
Node'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node msg)) where
    toStruct :: Node msg -> Struct msg
toStruct (Node'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node msg)) where
    type InMessage (Node msg) = msg
    message :: Node msg -> InMessage (Node msg)
message (Node'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node msg)) where
    messageDefault :: InMessage (Node msg) -> Node msg
messageDefault InMessage (Node msg)
msg = (Struct msg -> Node msg
forall msg. Struct msg -> Node msg
Node'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node msg)
msg))
instance (Classes.FromPtr msg (Node msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Node msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Node msg
forall msg. Struct msg -> Node msg
Node'newtype_ (Struct msg -> Node msg) -> m (Struct msg) -> m (Node msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Node (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Node (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Node'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Node (Message.MutMsg s))) where
    new :: MutMsg s -> m (Node (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Node (MutMsg s)
forall msg. Struct msg -> Node msg
Node'newtype_ (Struct (MutMsg s) -> Node (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Node (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
5 Word16
6))
instance (Basics.ListElem msg (Node msg)) where
    newtype List msg (Node msg)
        = Node'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Node msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Node msg)
forall msg. ListOf msg (Struct msg) -> List msg (Node msg)
Node'List_ (ListOf msg (Struct msg) -> List msg (Node msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Node msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Node msg) -> List msg
toUntypedList (Node'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Node msg) -> Int
length (Node'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Node msg) -> m (Node msg)
index Int
i (Node'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Node msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Node (Message.MutMsg s))) where
    setIndex :: Node (MutMsg s) -> Int -> List (MutMsg s) (Node (MutMsg s)) -> m ()
setIndex (Node'newtype_ Struct (MutMsg s)
elt) Int
i (Node'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Node (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Node (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Node msg)
Node'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Node (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Node (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
5 Word16
6 Int
len))
get_Node'id :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64)
get_Node'id :: Node msg -> m Word64
get_Node'id (Node'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Node'id :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Node'id :: Node (MutMsg s) -> Word64 -> m ()
set_Node'id (Node'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_Node'displayName :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Basics.Text msg))) => (Node msg) -> (m (Basics.Text msg))
get_Node'displayName :: Node msg -> m (Text msg)
get_Node'displayName (Node'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'displayName :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Node'displayName :: Node (MutMsg s) -> Text (MutMsg s) -> m ()
set_Node'displayName (Node'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Node'displayName :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
has_Node'displayName :: Node msg -> m Bool
has_Node'displayName (Node'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Node'displayName :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Node'displayName :: Int -> Node (MutMsg s) -> m (Text (MutMsg s))
new_Node'displayName Int
len Node (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'displayName Node (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Node'displayNamePrefixLength :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word32)
get_Node'displayNamePrefixLength :: Node msg -> m Word32
get_Node'displayNamePrefixLength (Node'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0)
set_Node'displayNamePrefixLength :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Node'displayNamePrefixLength :: Node (MutMsg s) -> Word32 -> m ()
set_Node'displayNamePrefixLength (Node'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
1 Int
0 Word64
0)
get_Node'scopeId :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64)
get_Node'scopeId :: Node msg -> m Word64
get_Node'scopeId (Node'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
2 Int
0 Word64
0)
set_Node'scopeId :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Node'scopeId :: Node (MutMsg s) -> Word64 -> m ()
set_Node'scopeId (Node'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
2 Int
0 Word64
0)
get_Node'nestedNodes :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Basics.List msg (Node'NestedNode msg)))) => (Node msg) -> (m (Basics.List msg (Node'NestedNode msg)))
get_Node'nestedNodes :: Node msg -> m (List msg (Node'NestedNode msg))
get_Node'nestedNodes (Node'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node'NestedNode msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'nestedNodes :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))))) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))) -> (m ())
set_Node'nestedNodes :: Node (MutMsg s)
-> List (MutMsg s) (Node'NestedNode (MutMsg s)) -> m ()
set_Node'nestedNodes (Node'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node'NestedNode (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node'NestedNode (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node'NestedNode (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Node'nestedNodes :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
has_Node'nestedNodes :: Node msg -> m Bool
has_Node'nestedNodes (Node'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Node'nestedNodes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))))
new_Node'nestedNodes :: Int
-> Node (MutMsg s)
-> m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
new_Node'nestedNodes Int
len Node (MutMsg s)
struct = (do
    List (MutMsg s) (Node'NestedNode (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'nestedNodes Node (MutMsg s)
struct List (MutMsg s) (Node'NestedNode (MutMsg s))
result)
    (List (MutMsg s) (Node'NestedNode (MutMsg s))
-> m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node'NestedNode (MutMsg s))
result)
    )
get_Node'annotations :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Basics.List msg (Annotation msg)))) => (Node msg) -> (m (Basics.List msg (Annotation msg)))
get_Node'annotations :: Node msg -> m (List msg (Annotation msg))
get_Node'annotations (Node'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Annotation msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'annotations :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
set_Node'annotations :: Node (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
set_Node'annotations (Node'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Annotation (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
2 Struct (MutMsg s)
struct)
    )
has_Node'annotations :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
has_Node'annotations :: Node msg -> m Bool
has_Node'annotations (Node'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct))
new_Node'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
new_Node'annotations :: Int
-> Node (MutMsg s) -> m (List (MutMsg s) (Annotation (MutMsg s)))
new_Node'annotations Int
len Node (MutMsg s)
struct = (do
    List (MutMsg s) (Annotation (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Annotation (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'annotations Node (MutMsg s)
struct List (MutMsg s) (Annotation (MutMsg s))
result)
    (List (MutMsg s) (Annotation (MutMsg s))
-> m (List (MutMsg s) (Annotation (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Annotation (MutMsg s))
result)
    )
get_Node'parameters :: ((Untyped.ReadCtx m msg)
                       ,(Classes.FromPtr msg (Basics.List msg (Node'Parameter msg)))) => (Node msg) -> (m (Basics.List msg (Node'Parameter msg)))
get_Node'parameters :: Node msg -> m (List msg (Node'Parameter msg))
get_Node'parameters (Node'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
5 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node'Parameter msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'parameters :: ((Untyped.RWCtx m s)
                       ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ())
set_Node'parameters :: Node (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
set_Node'parameters (Node'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node'Parameter (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node'Parameter (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node'Parameter (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
5 Struct (MutMsg s)
struct)
    )
has_Node'parameters :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
has_Node'parameters :: Node msg -> m Bool
has_Node'parameters (Node'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
5 Struct msg
struct))
new_Node'parameters :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))
new_Node'parameters :: Int
-> Node (MutMsg s)
-> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
new_Node'parameters Int
len Node (MutMsg s)
struct = (do
    List (MutMsg s) (Node'Parameter (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node (MutMsg s) -> InMessage (Node (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'parameters Node (MutMsg s)
struct List (MutMsg s) (Node'Parameter (MutMsg s))
result)
    (List (MutMsg s) (Node'Parameter (MutMsg s))
-> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node'Parameter (MutMsg s))
result)
    )
get_Node'isGeneric :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
get_Node'isGeneric :: Node msg -> m Bool
get_Node'isGeneric (Node'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
4 Int
32 Word64
0)
set_Node'isGeneric :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'isGeneric :: Node (MutMsg s) -> Bool -> m ()
set_Node'isGeneric (Node'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
4 Int
32 Word64
0)
data Node' msg
    = Node'file 
    | Node'struct (Node'struct msg)
    | Node'enum (Node'enum msg)
    | Node'interface (Node'interface msg)
    | Node'const (Node'const msg)
    | Node'annotation (Node'annotation msg)
    | Node'unknown' Std_.Word16
instance (Classes.FromStruct msg (Node' msg)) where
    fromStruct :: Struct msg -> m (Node' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
6)
        case Word16
tag of
            Word16
0 ->
                (Node' msg -> m (Node' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Node' msg
forall msg. Node' msg
Node'file)
            Word16
1 ->
                (Node'struct msg -> Node' msg
forall msg. Node'struct msg -> Node' msg
Node'struct (Node'struct msg -> Node' msg)
-> m (Node'struct msg) -> m (Node' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Node'struct msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
2 ->
                (Node'enum msg -> Node' msg
forall msg. Node'enum msg -> Node' msg
Node'enum (Node'enum msg -> Node' msg) -> m (Node'enum msg) -> m (Node' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Node'enum msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
3 ->
                (Node'interface msg -> Node' msg
forall msg. Node'interface msg -> Node' msg
Node'interface (Node'interface msg -> Node' msg)
-> m (Node'interface msg) -> m (Node' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Node'interface msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
4 ->
                (Node'const msg -> Node' msg
forall msg. Node'const msg -> Node' msg
Node'const (Node'const msg -> Node' msg)
-> m (Node'const msg) -> m (Node' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Node'const msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
5 ->
                (Node'annotation msg -> Node' msg
forall msg. Node'annotation msg -> Node' msg
Node'annotation (Node'annotation msg -> Node' msg)
-> m (Node'annotation msg) -> m (Node' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Node'annotation msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
_ ->
                (Node' msg -> m (Node' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Node' msg
forall msg. Word16 -> Node' msg
Node'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Node' :: ((Untyped.ReadCtx m msg)
             ,(Classes.FromStruct msg (Node' msg))) => (Node msg) -> (m (Node' msg))
get_Node' :: Node msg -> m (Node' msg)
get_Node' (Node'newtype_ Struct msg
struct) = (Struct msg -> m (Node' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Node'file :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m ())
set_Node'file :: Node (MutMsg s) -> m ()
set_Node'file (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Node'struct :: ((Untyped.RWCtx m s)
                   ,(Classes.FromStruct (Message.MutMsg s) (Node'struct (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (m (Node'struct (Message.MutMsg s)))
set_Node'struct :: Node (MutMsg s) -> m (Node'struct (MutMsg s))
set_Node'struct (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (Struct (MutMsg s) -> m (Node'struct (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Node'enum :: ((Untyped.RWCtx m s)
                 ,(Classes.FromStruct (Message.MutMsg s) (Node'enum (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (m (Node'enum (Message.MutMsg s)))
set_Node'enum :: Node (MutMsg s) -> m (Node'enum (MutMsg s))
set_Node'enum (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
2 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (Struct (MutMsg s) -> m (Node'enum (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Node'interface :: ((Untyped.RWCtx m s)
                      ,(Classes.FromStruct (Message.MutMsg s) (Node'interface (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (m (Node'interface (Message.MutMsg s)))
set_Node'interface :: Node (MutMsg s) -> m (Node'interface (MutMsg s))
set_Node'interface (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
3 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (Struct (MutMsg s) -> m (Node'interface (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Node'const :: ((Untyped.RWCtx m s)
                  ,(Classes.FromStruct (Message.MutMsg s) (Node'const (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (m (Node'const (Message.MutMsg s)))
set_Node'const :: Node (MutMsg s) -> m (Node'const (MutMsg s))
set_Node'const (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
4 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (Struct (MutMsg s) -> m (Node'const (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Node'annotation :: ((Untyped.RWCtx m s)
                       ,(Classes.FromStruct (Message.MutMsg s) (Node'annotation (Message.MutMsg s)))) => (Node (Message.MutMsg s)) -> (m (Node'annotation (Message.MutMsg s)))
set_Node'annotation :: Node (MutMsg s) -> m (Node'annotation (MutMsg s))
set_Node'annotation (Node'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
5 :: Std_.Word16) Int
1 Int
32 Word64
0)
    (Struct (MutMsg s) -> m (Node'annotation (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Node'unknown' :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Node'unknown' :: Node (MutMsg s) -> Word16 -> m ()
set_Node'unknown' (Node'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
32 Word64
0)
newtype Node'struct msg
    = Node'struct'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'struct msg)) where
    fromStruct :: Struct msg -> m (Node'struct msg)
fromStruct Struct msg
struct = (Node'struct msg -> m (Node'struct msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'struct msg
forall msg. Struct msg -> Node'struct msg
Node'struct'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'struct msg)) where
    toStruct :: Node'struct msg -> Struct msg
toStruct (Node'struct'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'struct msg)) where
    type InMessage (Node'struct msg) = msg
    message :: Node'struct msg -> InMessage (Node'struct msg)
message (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'struct msg)) where
    messageDefault :: InMessage (Node'struct msg) -> Node'struct msg
messageDefault InMessage (Node'struct msg)
msg = (Struct msg -> Node'struct msg
forall msg. Struct msg -> Node'struct msg
Node'struct'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'struct msg)
msg))
get_Node'struct'dataWordCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
get_Node'struct'dataWordCount :: Node'struct msg -> m Word16
get_Node'struct'dataWordCount (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
48 Word64
0)
set_Node'struct'dataWordCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Node'struct'dataWordCount :: Node'struct (MutMsg s) -> Word16 -> m ()
set_Node'struct'dataWordCount (Node'struct'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
48 Word64
0)
get_Node'struct'pointerCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
get_Node'struct'pointerCount :: Node'struct msg -> m Word16
get_Node'struct'pointerCount (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
3 Int
0 Word64
0)
set_Node'struct'pointerCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Node'struct'pointerCount :: Node'struct (MutMsg s) -> Word16 -> m ()
set_Node'struct'pointerCount (Node'struct'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
3 Int
0 Word64
0)
get_Node'struct'preferredListEncoding :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m ElementSize)
get_Node'struct'preferredListEncoding :: Node'struct msg -> m ElementSize
get_Node'struct'preferredListEncoding (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m ElementSize
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
3 Int
16 Word64
0)
set_Node'struct'preferredListEncoding :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> ElementSize -> (m ())
set_Node'struct'preferredListEncoding :: Node'struct (MutMsg s) -> ElementSize -> m ()
set_Node'struct'preferredListEncoding (Node'struct'newtype_ Struct (MutMsg s)
struct) ElementSize
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (ElementSize -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord ElementSize
value)) :: Std_.Word16) Int
3 Int
16 Word64
0)
get_Node'struct'isGroup :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool)
get_Node'struct'isGroup :: Node'struct msg -> m Bool
get_Node'struct'isGroup (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
3 Int
32 Word64
0)
set_Node'struct'isGroup :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'struct'isGroup :: Node'struct (MutMsg s) -> Bool -> m ()
set_Node'struct'isGroup (Node'struct'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
3 Int
32 Word64
0)
get_Node'struct'discriminantCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
get_Node'struct'discriminantCount :: Node'struct msg -> m Word16
get_Node'struct'discriminantCount (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
3 Int
48 Word64
0)
set_Node'struct'discriminantCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Node'struct'discriminantCount :: Node'struct (MutMsg s) -> Word16 -> m ()
set_Node'struct'discriminantCount (Node'struct'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
3 Int
48 Word64
0)
get_Node'struct'discriminantOffset :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word32)
get_Node'struct'discriminantOffset :: Node'struct msg -> m Word32
get_Node'struct'discriminantOffset (Node'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
4 Int
0 Word64
0)
set_Node'struct'discriminantOffset :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Node'struct'discriminantOffset :: Node'struct (MutMsg s) -> Word32 -> m ()
set_Node'struct'discriminantOffset (Node'struct'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
4 Int
0 Word64
0)
get_Node'struct'fields :: ((Untyped.ReadCtx m msg)
                          ,(Classes.FromPtr msg (Basics.List msg (Field msg)))) => (Node'struct msg) -> (m (Basics.List msg (Field msg)))
get_Node'struct'fields :: Node'struct msg -> m (List msg (Field msg))
get_Node'struct'fields (Node'struct'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Field msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'struct'fields :: ((Untyped.RWCtx m s)
                          ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))))) => (Node'struct (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))) -> (m ())
set_Node'struct'fields :: Node'struct (MutMsg s)
-> List (MutMsg s) (Field (MutMsg s)) -> m ()
set_Node'struct'fields (Node'struct'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Field (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Field (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Field (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Node'struct'fields :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool)
has_Node'struct'fields :: Node'struct msg -> m Bool
has_Node'struct'fields (Node'struct'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Node'struct'fields :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'struct (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))))
new_Node'struct'fields :: Int
-> Node'struct (MutMsg s) -> m (List (MutMsg s) (Field (MutMsg s)))
new_Node'struct'fields Int
len Node'struct (MutMsg s)
struct = (do
    List (MutMsg s) (Field (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Field (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node'struct (MutMsg s) -> InMessage (Node'struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'struct (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'struct'fields Node'struct (MutMsg s)
struct List (MutMsg s) (Field (MutMsg s))
result)
    (List (MutMsg s) (Field (MutMsg s))
-> m (List (MutMsg s) (Field (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Field (MutMsg s))
result)
    )
newtype Node'enum msg
    = Node'enum'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'enum msg)) where
    fromStruct :: Struct msg -> m (Node'enum msg)
fromStruct Struct msg
struct = (Node'enum msg -> m (Node'enum msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'enum msg
forall msg. Struct msg -> Node'enum msg
Node'enum'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'enum msg)) where
    toStruct :: Node'enum msg -> Struct msg
toStruct (Node'enum'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'enum msg)) where
    type InMessage (Node'enum msg) = msg
    message :: Node'enum msg -> InMessage (Node'enum msg)
message (Node'enum'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'enum msg)) where
    messageDefault :: InMessage (Node'enum msg) -> Node'enum msg
messageDefault InMessage (Node'enum msg)
msg = (Struct msg -> Node'enum msg
forall msg. Struct msg -> Node'enum msg
Node'enum'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'enum msg)
msg))
get_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)
                            ,(Classes.FromPtr msg (Basics.List msg (Enumerant msg)))) => (Node'enum msg) -> (m (Basics.List msg (Enumerant msg)))
get_Node'enum'enumerants :: Node'enum msg -> m (List msg (Enumerant msg))
get_Node'enum'enumerants (Node'enum'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Enumerant msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'enum'enumerants :: ((Untyped.RWCtx m s)
                            ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))))) => (Node'enum (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))) -> (m ())
set_Node'enum'enumerants :: Node'enum (MutMsg s)
-> List (MutMsg s) (Enumerant (MutMsg s)) -> m ()
set_Node'enum'enumerants (Node'enum'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Enumerant (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Enumerant (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Enumerant (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)) => (Node'enum msg) -> (m Std_.Bool)
has_Node'enum'enumerants :: Node'enum msg -> m Bool
has_Node'enum'enumerants (Node'enum'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Node'enum'enumerants :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'enum (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))))
new_Node'enum'enumerants :: Int
-> Node'enum (MutMsg s)
-> m (List (MutMsg s) (Enumerant (MutMsg s)))
new_Node'enum'enumerants Int
len Node'enum (MutMsg s)
struct = (do
    List (MutMsg s) (Enumerant (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Enumerant (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node'enum (MutMsg s) -> InMessage (Node'enum (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'enum (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'enum'enumerants Node'enum (MutMsg s)
struct List (MutMsg s) (Enumerant (MutMsg s))
result)
    (List (MutMsg s) (Enumerant (MutMsg s))
-> m (List (MutMsg s) (Enumerant (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Enumerant (MutMsg s))
result)
    )
newtype Node'interface msg
    = Node'interface'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'interface msg)) where
    fromStruct :: Struct msg -> m (Node'interface msg)
fromStruct Struct msg
struct = (Node'interface msg -> m (Node'interface msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'interface msg
forall msg. Struct msg -> Node'interface msg
Node'interface'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'interface msg)) where
    toStruct :: Node'interface msg -> Struct msg
toStruct (Node'interface'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'interface msg)) where
    type InMessage (Node'interface msg) = msg
    message :: Node'interface msg -> InMessage (Node'interface msg)
message (Node'interface'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'interface msg)) where
    messageDefault :: InMessage (Node'interface msg) -> Node'interface msg
messageDefault InMessage (Node'interface msg)
msg = (Struct msg -> Node'interface msg
forall msg. Struct msg -> Node'interface msg
Node'interface'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'interface msg)
msg))
get_Node'interface'methods :: ((Untyped.ReadCtx m msg)
                              ,(Classes.FromPtr msg (Basics.List msg (Method msg)))) => (Node'interface msg) -> (m (Basics.List msg (Method msg)))
get_Node'interface'methods :: Node'interface msg -> m (List msg (Method msg))
get_Node'interface'methods (Node'interface'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Method msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'interface'methods :: ((Untyped.RWCtx m s)
                              ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))))) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))) -> (m ())
set_Node'interface'methods :: Node'interface (MutMsg s)
-> List (MutMsg s) (Method (MutMsg s)) -> m ()
set_Node'interface'methods (Node'interface'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Method (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Method (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Method (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Node'interface'methods :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool)
has_Node'interface'methods :: Node'interface msg -> m Bool
has_Node'interface'methods (Node'interface'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Node'interface'methods :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'interface (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))))
new_Node'interface'methods :: Int
-> Node'interface (MutMsg s)
-> m (List (MutMsg s) (Method (MutMsg s)))
new_Node'interface'methods Int
len Node'interface (MutMsg s)
struct = (do
    List (MutMsg s) (Method (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Method (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node'interface (MutMsg s) -> InMessage (Node'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'interface (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'interface'methods Node'interface (MutMsg s)
struct List (MutMsg s) (Method (MutMsg s))
result)
    (List (MutMsg s) (Method (MutMsg s))
-> m (List (MutMsg s) (Method (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Method (MutMsg s))
result)
    )
get_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)
                                   ,(Classes.FromPtr msg (Basics.List msg (Superclass msg)))) => (Node'interface msg) -> (m (Basics.List msg (Superclass msg)))
get_Node'interface'superclasses :: Node'interface msg -> m (List msg (Superclass msg))
get_Node'interface'superclasses (Node'interface'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Superclass msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'interface'superclasses :: ((Untyped.RWCtx m s)
                                   ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))))) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))) -> (m ())
set_Node'interface'superclasses :: Node'interface (MutMsg s)
-> List (MutMsg s) (Superclass (MutMsg s)) -> m ()
set_Node'interface'superclasses (Node'interface'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Superclass (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Superclass (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Superclass (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
4 Struct (MutMsg s)
struct)
    )
has_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool)
has_Node'interface'superclasses :: Node'interface msg -> m Bool
has_Node'interface'superclasses (Node'interface'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct))
new_Node'interface'superclasses :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'interface (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))))
new_Node'interface'superclasses :: Int
-> Node'interface (MutMsg s)
-> m (List (MutMsg s) (Superclass (MutMsg s)))
new_Node'interface'superclasses Int
len Node'interface (MutMsg s)
struct = (do
    List (MutMsg s) (Superclass (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Superclass (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node'interface (MutMsg s) -> InMessage (Node'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'interface (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'interface'superclasses Node'interface (MutMsg s)
struct List (MutMsg s) (Superclass (MutMsg s))
result)
    (List (MutMsg s) (Superclass (MutMsg s))
-> m (List (MutMsg s) (Superclass (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Superclass (MutMsg s))
result)
    )
newtype Node'const msg
    = Node'const'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'const msg)) where
    fromStruct :: Struct msg -> m (Node'const msg)
fromStruct Struct msg
struct = (Node'const msg -> m (Node'const msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'const msg
forall msg. Struct msg -> Node'const msg
Node'const'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'const msg)) where
    toStruct :: Node'const msg -> Struct msg
toStruct (Node'const'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'const msg)) where
    type InMessage (Node'const msg) = msg
    message :: Node'const msg -> InMessage (Node'const msg)
message (Node'const'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'const msg)) where
    messageDefault :: InMessage (Node'const msg) -> Node'const msg
messageDefault InMessage (Node'const msg)
msg = (Struct msg -> Node'const msg
forall msg. Struct msg -> Node'const msg
Node'const'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'const msg)
msg))
get_Node'const'type_ :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Type msg))) => (Node'const msg) -> (m (Type msg))
get_Node'const'type_ :: Node'const msg -> m (Type msg)
get_Node'const'type_ (Node'const'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Type msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'const'type_ :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Type (Message.MutMsg s)))) => (Node'const (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
set_Node'const'type_ :: Node'const (MutMsg s) -> Type (MutMsg s) -> m ()
set_Node'const'type_ (Node'const'newtype_ Struct (MutMsg s)
struct) Type (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Type (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Node'const'type_ :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool)
has_Node'const'type_ :: Node'const msg -> m Bool
has_Node'const'type_ (Node'const'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Node'const'type_ :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
new_Node'const'type_ :: Node'const (MutMsg s) -> m (Type (MutMsg s))
new_Node'const'type_ Node'const (MutMsg s)
struct = (do
    Type (MutMsg s)
result <- (MutMsg s -> m (Type (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Node'const (MutMsg s) -> InMessage (Node'const (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'const (MutMsg s)
struct))
    (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 ()
set_Node'const'type_ Node'const (MutMsg s)
struct Type (MutMsg s)
result)
    (Type (MutMsg s) -> m (Type (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type (MutMsg s)
result)
    )
get_Node'const'value :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Value msg))) => (Node'const msg) -> (m (Value msg))
get_Node'const'value :: Node'const msg -> m (Value msg)
get_Node'const'value (Node'const'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Value msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'const'value :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Value (Message.MutMsg s)))) => (Node'const (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
set_Node'const'value :: Node'const (MutMsg s) -> Value (MutMsg s) -> m ()
set_Node'const'value (Node'const'newtype_ Struct (MutMsg s)
struct) Value (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Value (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Value (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
4 Struct (MutMsg s)
struct)
    )
has_Node'const'value :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool)
has_Node'const'value :: Node'const msg -> m Bool
has_Node'const'value (Node'const'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct))
new_Node'const'value :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
new_Node'const'value :: Node'const (MutMsg s) -> m (Value (MutMsg s))
new_Node'const'value Node'const (MutMsg s)
struct = (do
    Value (MutMsg s)
result <- (MutMsg s -> m (Value (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Node'const (MutMsg s) -> InMessage (Node'const (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'const (MutMsg s)
struct))
    (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 ()
set_Node'const'value Node'const (MutMsg s)
struct Value (MutMsg s)
result)
    (Value (MutMsg s) -> m (Value (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value (MutMsg s)
result)
    )
newtype Node'annotation msg
    = Node'annotation'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'annotation msg)) where
    fromStruct :: Struct msg -> m (Node'annotation msg)
fromStruct Struct msg
struct = (Node'annotation msg -> m (Node'annotation msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'annotation msg
forall msg. Struct msg -> Node'annotation msg
Node'annotation'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'annotation msg)) where
    toStruct :: Node'annotation msg -> Struct msg
toStruct (Node'annotation'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'annotation msg)) where
    type InMessage (Node'annotation msg) = msg
    message :: Node'annotation msg -> InMessage (Node'annotation msg)
message (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'annotation msg)) where
    messageDefault :: InMessage (Node'annotation msg) -> Node'annotation msg
messageDefault InMessage (Node'annotation msg)
msg = (Struct msg -> Node'annotation msg
forall msg. Struct msg -> Node'annotation msg
Node'annotation'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'annotation msg)
msg))
get_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)
                             ,(Classes.FromPtr msg (Type msg))) => (Node'annotation msg) -> (m (Type msg))
get_Node'annotation'type_ :: Node'annotation msg -> m (Type msg)
get_Node'annotation'type_ (Node'annotation'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Type msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'annotation'type_ :: ((Untyped.RWCtx m s)
                             ,(Classes.ToPtr s (Type (Message.MutMsg s)))) => (Node'annotation (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
set_Node'annotation'type_ :: Node'annotation (MutMsg s) -> Type (MutMsg s) -> m ()
set_Node'annotation'type_ (Node'annotation'newtype_ Struct (MutMsg s)
struct) Type (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Type (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
has_Node'annotation'type_ :: Node'annotation msg -> m Bool
has_Node'annotation'type_ (Node'annotation'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Node'annotation'type_ :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
new_Node'annotation'type_ :: Node'annotation (MutMsg s) -> m (Type (MutMsg s))
new_Node'annotation'type_ Node'annotation (MutMsg s)
struct = (do
    Type (MutMsg s)
result <- (MutMsg s -> m (Type (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Node'annotation (MutMsg s)
-> InMessage (Node'annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'annotation (MutMsg s)
struct))
    (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 ()
set_Node'annotation'type_ Node'annotation (MutMsg s)
struct Type (MutMsg s)
result)
    (Type (MutMsg s) -> m (Type (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type (MutMsg s)
result)
    )
get_Node'annotation'targetsFile :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsFile :: Node'annotation msg -> m Bool
get_Node'annotation'targetsFile (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
48 Word64
0)
set_Node'annotation'targetsFile :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsFile :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsFile (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
48 Word64
0)
get_Node'annotation'targetsConst :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsConst :: Node'annotation msg -> m Bool
get_Node'annotation'targetsConst (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
49 Word64
0)
set_Node'annotation'targetsConst :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsConst :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsConst (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
49 Word64
0)
get_Node'annotation'targetsEnum :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsEnum :: Node'annotation msg -> m Bool
get_Node'annotation'targetsEnum (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
50 Word64
0)
set_Node'annotation'targetsEnum :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsEnum :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsEnum (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
50 Word64
0)
get_Node'annotation'targetsEnumerant :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsEnumerant :: Node'annotation msg -> m Bool
get_Node'annotation'targetsEnumerant (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
51 Word64
0)
set_Node'annotation'targetsEnumerant :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsEnumerant :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsEnumerant (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
51 Word64
0)
get_Node'annotation'targetsStruct :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsStruct :: Node'annotation msg -> m Bool
get_Node'annotation'targetsStruct (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
52 Word64
0)
set_Node'annotation'targetsStruct :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsStruct :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsStruct (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
52 Word64
0)
get_Node'annotation'targetsField :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsField :: Node'annotation msg -> m Bool
get_Node'annotation'targetsField (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
53 Word64
0)
set_Node'annotation'targetsField :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsField :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsField (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
53 Word64
0)
get_Node'annotation'targetsUnion :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsUnion :: Node'annotation msg -> m Bool
get_Node'annotation'targetsUnion (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
54 Word64
0)
set_Node'annotation'targetsUnion :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsUnion :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsUnion (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
54 Word64
0)
get_Node'annotation'targetsGroup :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsGroup :: Node'annotation msg -> m Bool
get_Node'annotation'targetsGroup (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
55 Word64
0)
set_Node'annotation'targetsGroup :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsGroup :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsGroup (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
55 Word64
0)
get_Node'annotation'targetsInterface :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsInterface :: Node'annotation msg -> m Bool
get_Node'annotation'targetsInterface (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
56 Word64
0)
set_Node'annotation'targetsInterface :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsInterface :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsInterface (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
56 Word64
0)
get_Node'annotation'targetsMethod :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsMethod :: Node'annotation msg -> m Bool
get_Node'annotation'targetsMethod (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
57 Word64
0)
set_Node'annotation'targetsMethod :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsMethod :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsMethod (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
57 Word64
0)
get_Node'annotation'targetsParam :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsParam :: Node'annotation msg -> m Bool
get_Node'annotation'targetsParam (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
58 Word64
0)
set_Node'annotation'targetsParam :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsParam :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsParam (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
58 Word64
0)
get_Node'annotation'targetsAnnotation :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
get_Node'annotation'targetsAnnotation :: Node'annotation msg -> m Bool
get_Node'annotation'targetsAnnotation (Node'annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
59 Word64
0)
set_Node'annotation'targetsAnnotation :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Node'annotation'targetsAnnotation :: Node'annotation (MutMsg s) -> Bool -> m ()
set_Node'annotation'targetsAnnotation (Node'annotation'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
1 Int
59 Word64
0)
newtype Node'Parameter msg
    = Node'Parameter'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'Parameter msg)) where
    fromStruct :: Struct msg -> m (Node'Parameter msg)
fromStruct Struct msg
struct = (Node'Parameter msg -> m (Node'Parameter msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'Parameter msg
forall msg. Struct msg -> Node'Parameter msg
Node'Parameter'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'Parameter msg)) where
    toStruct :: Node'Parameter msg -> Struct msg
toStruct (Node'Parameter'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'Parameter msg)) where
    type InMessage (Node'Parameter msg) = msg
    message :: Node'Parameter msg -> InMessage (Node'Parameter msg)
message (Node'Parameter'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'Parameter msg)) where
    messageDefault :: InMessage (Node'Parameter msg) -> Node'Parameter msg
messageDefault InMessage (Node'Parameter msg)
msg = (Struct msg -> Node'Parameter msg
forall msg. Struct msg -> Node'Parameter msg
Node'Parameter'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'Parameter msg)
msg))
instance (Classes.FromPtr msg (Node'Parameter msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Node'Parameter msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Node'Parameter msg
forall msg. Struct msg -> Node'Parameter msg
Node'Parameter'newtype_ (Struct msg -> Node'Parameter msg)
-> m (Struct msg) -> m (Node'Parameter msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Node'Parameter (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Node'Parameter (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Node'Parameter'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Node'Parameter (Message.MutMsg s))) where
    new :: MutMsg s -> m (Node'Parameter (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Node'Parameter (MutMsg s)
forall msg. Struct msg -> Node'Parameter msg
Node'Parameter'newtype_ (Struct (MutMsg s) -> Node'Parameter (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Node'Parameter (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
1))
instance (Basics.ListElem msg (Node'Parameter msg)) where
    newtype List msg (Node'Parameter msg)
        = Node'Parameter'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Node'Parameter msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Node'Parameter msg)
forall msg.
ListOf msg (Struct msg) -> List msg (Node'Parameter msg)
Node'Parameter'List_ (ListOf msg (Struct msg) -> List msg (Node'Parameter msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Node'Parameter msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Node'Parameter msg) -> List msg
toUntypedList (Node'Parameter'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Node'Parameter msg) -> Int
length (Node'Parameter'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Node'Parameter msg) -> m (Node'Parameter msg)
index Int
i (Node'Parameter'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Node'Parameter msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Node'Parameter (Message.MutMsg s))) where
    setIndex :: Node'Parameter (MutMsg s)
-> Int -> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
setIndex (Node'Parameter'newtype_ Struct (MutMsg s)
elt) Int
i (Node'Parameter'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Node'Parameter (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (Node'Parameter msg)
Node'Parameter'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Node'Parameter (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
1 Int
len))
get_Node'Parameter'name :: ((Untyped.ReadCtx m msg)
                           ,(Classes.FromPtr msg (Basics.Text msg))) => (Node'Parameter msg) -> (m (Basics.Text msg))
get_Node'Parameter'name :: Node'Parameter msg -> m (Text msg)
get_Node'Parameter'name (Node'Parameter'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'Parameter'name :: ((Untyped.RWCtx m s)
                           ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Node'Parameter (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Node'Parameter'name :: Node'Parameter (MutMsg s) -> Text (MutMsg s) -> m ()
set_Node'Parameter'name (Node'Parameter'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Node'Parameter'name :: ((Untyped.ReadCtx m msg)) => (Node'Parameter msg) -> (m Std_.Bool)
has_Node'Parameter'name :: Node'Parameter msg -> m Bool
has_Node'Parameter'name (Node'Parameter'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Node'Parameter'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'Parameter (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Node'Parameter'name :: Int -> Node'Parameter (MutMsg s) -> m (Text (MutMsg s))
new_Node'Parameter'name Int
len Node'Parameter (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Node'Parameter (MutMsg s) -> InMessage (Node'Parameter (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'Parameter (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'Parameter'name Node'Parameter (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
newtype Node'NestedNode msg
    = Node'NestedNode'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'NestedNode msg)) where
    fromStruct :: Struct msg -> m (Node'NestedNode msg)
fromStruct Struct msg
struct = (Node'NestedNode msg -> m (Node'NestedNode msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'NestedNode msg
forall msg. Struct msg -> Node'NestedNode msg
Node'NestedNode'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'NestedNode msg)) where
    toStruct :: Node'NestedNode msg -> Struct msg
toStruct (Node'NestedNode'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'NestedNode msg)) where
    type InMessage (Node'NestedNode msg) = msg
    message :: Node'NestedNode msg -> InMessage (Node'NestedNode msg)
message (Node'NestedNode'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'NestedNode msg)) where
    messageDefault :: InMessage (Node'NestedNode msg) -> Node'NestedNode msg
messageDefault InMessage (Node'NestedNode msg)
msg = (Struct msg -> Node'NestedNode msg
forall msg. Struct msg -> Node'NestedNode msg
Node'NestedNode'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'NestedNode msg)
msg))
instance (Classes.FromPtr msg (Node'NestedNode msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Node'NestedNode msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Node'NestedNode msg
forall msg. Struct msg -> Node'NestedNode msg
Node'NestedNode'newtype_ (Struct msg -> Node'NestedNode msg)
-> m (Struct msg) -> m (Node'NestedNode msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Node'NestedNode (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> Node'NestedNode (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Node'NestedNode'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Node'NestedNode (Message.MutMsg s))) where
    new :: MutMsg s -> m (Node'NestedNode (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Node'NestedNode (MutMsg s)
forall msg. Struct msg -> Node'NestedNode msg
Node'NestedNode'newtype_ (Struct (MutMsg s) -> Node'NestedNode (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Node'NestedNode (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
1))
instance (Basics.ListElem msg (Node'NestedNode msg)) where
    newtype List msg (Node'NestedNode msg)
        = Node'NestedNode'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Node'NestedNode msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Node'NestedNode msg)
forall msg.
ListOf msg (Struct msg) -> List msg (Node'NestedNode msg)
Node'NestedNode'List_ (ListOf msg (Struct msg) -> List msg (Node'NestedNode msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (Node'NestedNode msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Node'NestedNode msg) -> List msg
toUntypedList (Node'NestedNode'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Node'NestedNode msg) -> Int
length (Node'NestedNode'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Node'NestedNode msg) -> m (Node'NestedNode msg)
index Int
i (Node'NestedNode'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Node'NestedNode msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Node'NestedNode (Message.MutMsg s))) where
    setIndex :: Node'NestedNode (MutMsg s)
-> Int -> List (MutMsg s) (Node'NestedNode (MutMsg s)) -> m ()
setIndex (Node'NestedNode'newtype_ Struct (MutMsg s)
elt) Int
i (Node'NestedNode'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Node'NestedNode (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (Node'NestedNode msg)
Node'NestedNode'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Node'NestedNode (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Node'NestedNode (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
1 Int
len))
get_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)
                            ,(Classes.FromPtr msg (Basics.Text msg))) => (Node'NestedNode msg) -> (m (Basics.Text msg))
get_Node'NestedNode'name :: Node'NestedNode msg -> m (Text msg)
get_Node'NestedNode'name (Node'NestedNode'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'NestedNode'name :: ((Untyped.RWCtx m s)
                            ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Node'NestedNode (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Node'NestedNode'name :: Node'NestedNode (MutMsg s) -> Text (MutMsg s) -> m ()
set_Node'NestedNode'name (Node'NestedNode'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Bool)
has_Node'NestedNode'name :: Node'NestedNode msg -> m Bool
has_Node'NestedNode'name (Node'NestedNode'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Node'NestedNode'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'NestedNode (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Node'NestedNode'name :: Int -> Node'NestedNode (MutMsg s) -> m (Text (MutMsg s))
new_Node'NestedNode'name Int
len Node'NestedNode (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Node'NestedNode (MutMsg s)
-> InMessage (Node'NestedNode (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'NestedNode (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'NestedNode'name Node'NestedNode (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Node'NestedNode'id :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Word64)
get_Node'NestedNode'id :: Node'NestedNode msg -> m Word64
get_Node'NestedNode'id (Node'NestedNode'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Node'NestedNode'id :: ((Untyped.RWCtx m s)) => (Node'NestedNode (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Node'NestedNode'id :: Node'NestedNode (MutMsg s) -> Word64 -> m ()
set_Node'NestedNode'id (Node'NestedNode'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
newtype Node'SourceInfo msg
    = Node'SourceInfo'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'SourceInfo msg)) where
    fromStruct :: Struct msg -> m (Node'SourceInfo msg)
fromStruct Struct msg
struct = (Node'SourceInfo msg -> m (Node'SourceInfo msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'SourceInfo msg
forall msg. Struct msg -> Node'SourceInfo msg
Node'SourceInfo'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'SourceInfo msg)) where
    toStruct :: Node'SourceInfo msg -> Struct msg
toStruct (Node'SourceInfo'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'SourceInfo msg)) where
    type InMessage (Node'SourceInfo msg) = msg
    message :: Node'SourceInfo msg -> InMessage (Node'SourceInfo msg)
message (Node'SourceInfo'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'SourceInfo msg)) where
    messageDefault :: InMessage (Node'SourceInfo msg) -> Node'SourceInfo msg
messageDefault InMessage (Node'SourceInfo msg)
msg = (Struct msg -> Node'SourceInfo msg
forall msg. Struct msg -> Node'SourceInfo msg
Node'SourceInfo'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'SourceInfo msg)
msg))
instance (Classes.FromPtr msg (Node'SourceInfo msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Node'SourceInfo msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Node'SourceInfo msg
forall msg. Struct msg -> Node'SourceInfo msg
Node'SourceInfo'newtype_ (Struct msg -> Node'SourceInfo msg)
-> m (Struct msg) -> m (Node'SourceInfo msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Node'SourceInfo (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> Node'SourceInfo (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Node'SourceInfo'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Node'SourceInfo (Message.MutMsg s))) where
    new :: MutMsg s -> m (Node'SourceInfo (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Node'SourceInfo (MutMsg s)
forall msg. Struct msg -> Node'SourceInfo msg
Node'SourceInfo'newtype_ (Struct (MutMsg s) -> Node'SourceInfo (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Node'SourceInfo (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
2))
instance (Basics.ListElem msg (Node'SourceInfo msg)) where
    newtype List msg (Node'SourceInfo msg)
        = Node'SourceInfo'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Node'SourceInfo msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Node'SourceInfo msg)
forall msg.
ListOf msg (Struct msg) -> List msg (Node'SourceInfo msg)
Node'SourceInfo'List_ (ListOf msg (Struct msg) -> List msg (Node'SourceInfo msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (Node'SourceInfo msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Node'SourceInfo msg) -> List msg
toUntypedList (Node'SourceInfo'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Node'SourceInfo msg) -> Int
length (Node'SourceInfo'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Node'SourceInfo msg) -> m (Node'SourceInfo msg)
index Int
i (Node'SourceInfo'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Node'SourceInfo msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Node'SourceInfo (Message.MutMsg s))) where
    setIndex :: Node'SourceInfo (MutMsg s)
-> Int -> List (MutMsg s) (Node'SourceInfo (MutMsg s)) -> m ()
setIndex (Node'SourceInfo'newtype_ Struct (MutMsg s)
elt) Int
i (Node'SourceInfo'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Node'SourceInfo (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (Node'SourceInfo msg)
Node'SourceInfo'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Node'SourceInfo (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
2 Int
len))
get_Node'SourceInfo'id :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Word64)
get_Node'SourceInfo'id :: Node'SourceInfo msg -> m Word64
get_Node'SourceInfo'id (Node'SourceInfo'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Node'SourceInfo'id :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Node'SourceInfo'id :: Node'SourceInfo (MutMsg s) -> Word64 -> m ()
set_Node'SourceInfo'id (Node'SourceInfo'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)
                                  ,(Classes.FromPtr msg (Basics.Text msg))) => (Node'SourceInfo msg) -> (m (Basics.Text msg))
get_Node'SourceInfo'docComment :: Node'SourceInfo msg -> m (Text msg)
get_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'SourceInfo'docComment :: ((Untyped.RWCtx m s)
                                  ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Node'SourceInfo'docComment :: Node'SourceInfo (MutMsg s) -> Text (MutMsg s) -> m ()
set_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool)
has_Node'SourceInfo'docComment :: Node'SourceInfo msg -> m Bool
has_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Node'SourceInfo'docComment :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Node'SourceInfo'docComment :: Int -> Node'SourceInfo (MutMsg s) -> m (Text (MutMsg s))
new_Node'SourceInfo'docComment Int
len Node'SourceInfo (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Node'SourceInfo (MutMsg s)
-> InMessage (Node'SourceInfo (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'SourceInfo (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'SourceInfo'docComment Node'SourceInfo (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)
                               ,(Classes.FromPtr msg (Basics.List msg (Node'SourceInfo'Member msg)))) => (Node'SourceInfo msg) -> (m (Basics.List msg (Node'SourceInfo'Member msg)))
get_Node'SourceInfo'members :: Node'SourceInfo msg -> m (List msg (Node'SourceInfo'Member msg))
get_Node'SourceInfo'members (Node'SourceInfo'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node'SourceInfo'Member msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'SourceInfo'members :: ((Untyped.RWCtx m s)
                               ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))))) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))) -> (m ())
set_Node'SourceInfo'members :: Node'SourceInfo (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)) -> m ()
set_Node'SourceInfo'members (Node'SourceInfo'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool)
has_Node'SourceInfo'members :: Node'SourceInfo msg -> m Bool
has_Node'SourceInfo'members (Node'SourceInfo'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Node'SourceInfo'members :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))))
new_Node'SourceInfo'members :: Int
-> Node'SourceInfo (MutMsg s)
-> m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
new_Node'SourceInfo'members Int
len Node'SourceInfo (MutMsg s)
struct = (do
    List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
result <- (MutMsg s
-> Int -> m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Node'SourceInfo (MutMsg s)
-> InMessage (Node'SourceInfo (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'SourceInfo (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'SourceInfo'members Node'SourceInfo (MutMsg s)
struct List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
result)
    (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
-> m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
result)
    )
newtype Node'SourceInfo'Member msg
    = Node'SourceInfo'Member'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Node'SourceInfo'Member msg)) where
    fromStruct :: Struct msg -> m (Node'SourceInfo'Member msg)
fromStruct Struct msg
struct = (Node'SourceInfo'Member msg -> m (Node'SourceInfo'Member msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Node'SourceInfo'Member msg
forall msg. Struct msg -> Node'SourceInfo'Member msg
Node'SourceInfo'Member'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Node'SourceInfo'Member msg)) where
    toStruct :: Node'SourceInfo'Member msg -> Struct msg
toStruct (Node'SourceInfo'Member'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Node'SourceInfo'Member msg)) where
    type InMessage (Node'SourceInfo'Member msg) = msg
    message :: Node'SourceInfo'Member msg
-> InMessage (Node'SourceInfo'Member msg)
message (Node'SourceInfo'Member'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Node'SourceInfo'Member msg)) where
    messageDefault :: InMessage (Node'SourceInfo'Member msg)
-> Node'SourceInfo'Member msg
messageDefault InMessage (Node'SourceInfo'Member msg)
msg = (Struct msg -> Node'SourceInfo'Member msg
forall msg. Struct msg -> Node'SourceInfo'Member msg
Node'SourceInfo'Member'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Node'SourceInfo'Member msg)
msg))
instance (Classes.FromPtr msg (Node'SourceInfo'Member msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Node'SourceInfo'Member msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Node'SourceInfo'Member msg
forall msg. Struct msg -> Node'SourceInfo'Member msg
Node'SourceInfo'Member'newtype_ (Struct msg -> Node'SourceInfo'Member msg)
-> m (Struct msg) -> m (Node'SourceInfo'Member msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Node'SourceInfo'Member (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> Node'SourceInfo'Member (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Node'SourceInfo'Member'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Node'SourceInfo'Member (Message.MutMsg s))) where
    new :: MutMsg s -> m (Node'SourceInfo'Member (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Node'SourceInfo'Member (MutMsg s)
forall msg. Struct msg -> Node'SourceInfo'Member msg
Node'SourceInfo'Member'newtype_ (Struct (MutMsg s) -> Node'SourceInfo'Member (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Node'SourceInfo'Member (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
1))
instance (Basics.ListElem msg (Node'SourceInfo'Member msg)) where
    newtype List msg (Node'SourceInfo'Member msg)
        = Node'SourceInfo'Member'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Node'SourceInfo'Member msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Node'SourceInfo'Member msg)
forall msg.
ListOf msg (Struct msg) -> List msg (Node'SourceInfo'Member msg)
Node'SourceInfo'Member'List_ (ListOf msg (Struct msg) -> List msg (Node'SourceInfo'Member msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (Node'SourceInfo'Member msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Node'SourceInfo'Member msg) -> List msg
toUntypedList (Node'SourceInfo'Member'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Node'SourceInfo'Member msg) -> Int
length (Node'SourceInfo'Member'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int
-> List msg (Node'SourceInfo'Member msg)
-> m (Node'SourceInfo'Member msg)
index Int
i (Node'SourceInfo'Member'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Node'SourceInfo'Member msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Node'SourceInfo'Member (Message.MutMsg s))) where
    setIndex :: Node'SourceInfo'Member (MutMsg s)
-> Int
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
-> m ()
setIndex (Node'SourceInfo'Member'newtype_ Struct (MutMsg s)
elt) Int
i (Node'SourceInfo'Member'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s
-> Int -> m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (Node'SourceInfo'Member msg)
Node'SourceInfo'Member'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Node'SourceInfo'Member (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
1 Int
len))
get_Node'SourceInfo'Member'docComment :: ((Untyped.ReadCtx m msg)
                                         ,(Classes.FromPtr msg (Basics.Text msg))) => (Node'SourceInfo'Member msg) -> (m (Basics.Text msg))
get_Node'SourceInfo'Member'docComment :: Node'SourceInfo'Member msg -> m (Text msg)
get_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Node'SourceInfo'Member'docComment :: ((Untyped.RWCtx m s)
                                         ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Node'SourceInfo'Member (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Node'SourceInfo'Member'docComment :: Node'SourceInfo'Member (MutMsg s) -> Text (MutMsg s) -> m ()
set_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Node'SourceInfo'Member'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo'Member msg) -> (m Std_.Bool)
has_Node'SourceInfo'Member'docComment :: Node'SourceInfo'Member msg -> m Bool
has_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Node'SourceInfo'Member'docComment :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo'Member (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Node'SourceInfo'Member'docComment :: Int -> Node'SourceInfo'Member (MutMsg s) -> m (Text (MutMsg s))
new_Node'SourceInfo'Member'docComment Int
len Node'SourceInfo'Member (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Node'SourceInfo'Member (MutMsg s)
-> InMessage (Node'SourceInfo'Member (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Node'SourceInfo'Member (MutMsg s)
struct) Int
len)
    (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 ()
set_Node'SourceInfo'Member'docComment Node'SourceInfo'Member (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
newtype Field msg
    = Field'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Field msg)) where
    fromStruct :: Struct msg -> m (Field msg)
fromStruct Struct msg
struct = (Field msg -> m (Field msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Field msg
forall msg. Struct msg -> Field msg
Field'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Field msg)) where
    toStruct :: Field msg -> Struct msg
toStruct (Field'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Field msg)) where
    type InMessage (Field msg) = msg
    message :: Field msg -> InMessage (Field msg)
message (Field'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Field msg)) where
    messageDefault :: InMessage (Field msg) -> Field msg
messageDefault InMessage (Field msg)
msg = (Struct msg -> Field msg
forall msg. Struct msg -> Field msg
Field'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Field msg)
msg))
instance (Classes.FromPtr msg (Field msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Field msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Field msg
forall msg. Struct msg -> Field msg
Field'newtype_ (Struct msg -> Field msg) -> m (Struct msg) -> m (Field msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Field (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Field (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Field'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Field (Message.MutMsg s))) where
    new :: MutMsg s -> m (Field (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Field (MutMsg s)
forall msg. Struct msg -> Field msg
Field'newtype_ (Struct (MutMsg s) -> Field (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Field (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
3 Word16
4))
instance (Basics.ListElem msg (Field msg)) where
    newtype List msg (Field msg)
        = Field'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Field msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Field msg)
forall msg. ListOf msg (Struct msg) -> List msg (Field msg)
Field'List_ (ListOf msg (Struct msg) -> List msg (Field msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Field msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Field msg) -> List msg
toUntypedList (Field'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Field msg) -> Int
length (Field'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Field msg) -> m (Field msg)
index Int
i (Field'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Field msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Field (Message.MutMsg s))) where
    setIndex :: Field (MutMsg s)
-> Int -> List (MutMsg s) (Field (MutMsg s)) -> m ()
setIndex (Field'newtype_ Struct (MutMsg s)
elt) Int
i (Field'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Field (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Field (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Field msg)
Field'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Field (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Field (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
3 Word16
4 Int
len))
get_Field'name :: ((Untyped.ReadCtx m msg)
                  ,(Classes.FromPtr msg (Basics.Text msg))) => (Field msg) -> (m (Basics.Text msg))
get_Field'name :: Field msg -> m (Text msg)
get_Field'name (Field'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Field'name :: ((Untyped.RWCtx m s)
                  ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Field (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Field'name :: Field (MutMsg s) -> Text (MutMsg s) -> m ()
set_Field'name (Field'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Field'name :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool)
has_Field'name :: Field msg -> m Bool
has_Field'name (Field'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Field'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Field (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Field'name :: Int -> Field (MutMsg s) -> m (Text (MutMsg s))
new_Field'name Int
len Field (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Field (MutMsg s) -> InMessage (Field (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Field (MutMsg s)
struct) Int
len)
    (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 ()
set_Field'name Field (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Field'codeOrder :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16)
get_Field'codeOrder :: Field msg -> m Word16
get_Field'codeOrder (Field'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Field'codeOrder :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Field'codeOrder :: Field (MutMsg s) -> Word16 -> m ()
set_Field'codeOrder (Field'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
get_Field'annotations :: ((Untyped.ReadCtx m msg)
                         ,(Classes.FromPtr msg (Basics.List msg (Annotation msg)))) => (Field msg) -> (m (Basics.List msg (Annotation msg)))
get_Field'annotations :: Field msg -> m (List msg (Annotation msg))
get_Field'annotations (Field'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Annotation msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Field'annotations :: ((Untyped.RWCtx m s)
                         ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))) => (Field (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
set_Field'annotations :: Field (MutMsg s) -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
set_Field'annotations (Field'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Annotation (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Field'annotations :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool)
has_Field'annotations :: Field msg -> m Bool
has_Field'annotations (Field'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Field'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Field (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
new_Field'annotations :: Int
-> Field (MutMsg s) -> m (List (MutMsg s) (Annotation (MutMsg s)))
new_Field'annotations Int
len Field (MutMsg s)
struct = (do
    List (MutMsg s) (Annotation (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Annotation (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Field (MutMsg s) -> InMessage (Field (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Field (MutMsg s)
struct) Int
len)
    (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 ()
set_Field'annotations Field (MutMsg s)
struct List (MutMsg s) (Annotation (MutMsg s))
result)
    (List (MutMsg s) (Annotation (MutMsg s))
-> m (List (MutMsg s) (Annotation (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Annotation (MutMsg s))
result)
    )
get_Field'discriminantValue :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16)
get_Field'discriminantValue :: Field msg -> m Word16
get_Field'discriminantValue (Field'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
65535)
set_Field'discriminantValue :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Field'discriminantValue :: Field (MutMsg s) -> Word16 -> m ()
set_Field'discriminantValue (Field'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
16 Word64
65535)
get_Field'ordinal :: ((Untyped.ReadCtx m msg)
                     ,(Classes.FromStruct msg (Field'ordinal msg))) => (Field msg) -> (m (Field'ordinal msg))
get_Field'ordinal :: Field msg -> m (Field'ordinal msg)
get_Field'ordinal (Field'newtype_ Struct msg
struct) = (Struct msg -> m (Field'ordinal msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
data Field' msg
    = Field'slot (Field'slot msg)
    | Field'group (Field'group msg)
    | Field'unknown' Std_.Word16
instance (Classes.FromStruct msg (Field' msg)) where
    fromStruct :: Struct msg -> m (Field' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
4)
        case Word16
tag of
            Word16
0 ->
                (Field'slot msg -> Field' msg
forall msg. Field'slot msg -> Field' msg
Field'slot (Field'slot msg -> Field' msg)
-> m (Field'slot msg) -> m (Field' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Field'slot msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
1 ->
                (Field'group msg -> Field' msg
forall msg. Field'group msg -> Field' msg
Field'group (Field'group msg -> Field' msg)
-> m (Field'group msg) -> m (Field' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Field'group msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
_ ->
                (Field' msg -> m (Field' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Field' msg
forall msg. Word16 -> Field' msg
Field'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Field' :: ((Untyped.ReadCtx m msg)
              ,(Classes.FromStruct msg (Field' msg))) => (Field msg) -> (m (Field' msg))
get_Field' :: Field msg -> m (Field' msg)
get_Field' (Field'newtype_ Struct msg
struct) = (Struct msg -> m (Field' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Field'slot :: ((Untyped.RWCtx m s)
                  ,(Classes.FromStruct (Message.MutMsg s) (Field'slot (Message.MutMsg s)))) => (Field (Message.MutMsg s)) -> (m (Field'slot (Message.MutMsg s)))
set_Field'slot :: Field (MutMsg s) -> m (Field'slot (MutMsg s))
set_Field'slot (Field'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Field'slot (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Field'group :: ((Untyped.RWCtx m s)
                   ,(Classes.FromStruct (Message.MutMsg s) (Field'group (Message.MutMsg s)))) => (Field (Message.MutMsg s)) -> (m (Field'group (Message.MutMsg s)))
set_Field'group :: Field (MutMsg s) -> m (Field'group (MutMsg s))
set_Field'group (Field'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Field'group (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Field'unknown' :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Field'unknown' :: Field (MutMsg s) -> Word16 -> m ()
set_Field'unknown' (Field'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
0 Word64
0)
newtype Field'slot msg
    = Field'slot'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Field'slot msg)) where
    fromStruct :: Struct msg -> m (Field'slot msg)
fromStruct Struct msg
struct = (Field'slot msg -> m (Field'slot msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Field'slot msg
forall msg. Struct msg -> Field'slot msg
Field'slot'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Field'slot msg)) where
    toStruct :: Field'slot msg -> Struct msg
toStruct (Field'slot'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Field'slot msg)) where
    type InMessage (Field'slot msg) = msg
    message :: Field'slot msg -> InMessage (Field'slot msg)
message (Field'slot'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Field'slot msg)) where
    messageDefault :: InMessage (Field'slot msg) -> Field'slot msg
messageDefault InMessage (Field'slot msg)
msg = (Struct msg -> Field'slot msg
forall msg. Struct msg -> Field'slot msg
Field'slot'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Field'slot msg)
msg))
get_Field'slot'offset :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Word32)
get_Field'slot'offset :: Field'slot msg -> m Word32
get_Field'slot'offset (Field'slot'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0)
set_Field'slot'offset :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Field'slot'offset :: Field'slot (MutMsg s) -> Word32 -> m ()
set_Field'slot'offset (Field'slot'newtype_ Struct (MutMsg s)
struct) Word32
value = (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
0 Int
32 Word64
0)
get_Field'slot'type_ :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Type msg))) => (Field'slot msg) -> (m (Type msg))
get_Field'slot'type_ :: Field'slot msg -> m (Type msg)
get_Field'slot'type_ (Field'slot'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Type msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Field'slot'type_ :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Type (Message.MutMsg s)))) => (Field'slot (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
set_Field'slot'type_ :: Field'slot (MutMsg s) -> Type (MutMsg s) -> m ()
set_Field'slot'type_ (Field'slot'newtype_ Struct (MutMsg s)
struct) Type (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Type (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
2 Struct (MutMsg s)
struct)
    )
has_Field'slot'type_ :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
has_Field'slot'type_ :: Field'slot msg -> m Bool
has_Field'slot'type_ (Field'slot'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct))
new_Field'slot'type_ :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
new_Field'slot'type_ :: Field'slot (MutMsg s) -> m (Type (MutMsg s))
new_Field'slot'type_ Field'slot (MutMsg s)
struct = (do
    Type (MutMsg s)
result <- (MutMsg s -> m (Type (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Field'slot (MutMsg s) -> InMessage (Field'slot (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Field'slot (MutMsg s)
struct))
    (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 ()
set_Field'slot'type_ Field'slot (MutMsg s)
struct Type (MutMsg s)
result)
    (Type (MutMsg s) -> m (Type (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type (MutMsg s)
result)
    )
get_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)
                               ,(Classes.FromPtr msg (Value msg))) => (Field'slot msg) -> (m (Value msg))
get_Field'slot'defaultValue :: Field'slot msg -> m (Value msg)
get_Field'slot'defaultValue (Field'slot'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Value msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Field'slot'defaultValue :: ((Untyped.RWCtx m s)
                               ,(Classes.ToPtr s (Value (Message.MutMsg s)))) => (Field'slot (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
set_Field'slot'defaultValue :: Field'slot (MutMsg s) -> Value (MutMsg s) -> m ()
set_Field'slot'defaultValue (Field'slot'newtype_ Struct (MutMsg s)
struct) Value (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Value (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Value (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
has_Field'slot'defaultValue :: Field'slot msg -> m Bool
has_Field'slot'defaultValue (Field'slot'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Field'slot'defaultValue :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
new_Field'slot'defaultValue :: Field'slot (MutMsg s) -> m (Value (MutMsg s))
new_Field'slot'defaultValue Field'slot (MutMsg s)
struct = (do
    Value (MutMsg s)
result <- (MutMsg s -> m (Value (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Field'slot (MutMsg s) -> InMessage (Field'slot (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Field'slot (MutMsg s)
struct))
    (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 ()
set_Field'slot'defaultValue Field'slot (MutMsg s)
struct Value (MutMsg s)
result)
    (Value (MutMsg s) -> m (Value (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value (MutMsg s)
result)
    )
get_Field'slot'hadExplicitDefault :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
get_Field'slot'hadExplicitDefault :: Field'slot msg -> m Bool
get_Field'slot'hadExplicitDefault (Field'slot'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
2 Int
0 Word64
0)
set_Field'slot'hadExplicitDefault :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Field'slot'hadExplicitDefault :: Field'slot (MutMsg s) -> Bool -> m ()
set_Field'slot'hadExplicitDefault (Field'slot'newtype_ Struct (MutMsg s)
struct) Bool
value = (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
2 Int
0 Word64
0)
newtype Field'group msg
    = Field'group'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Field'group msg)) where
    fromStruct :: Struct msg -> m (Field'group msg)
fromStruct Struct msg
struct = (Field'group msg -> m (Field'group msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Field'group msg
forall msg. Struct msg -> Field'group msg
Field'group'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Field'group msg)) where
    toStruct :: Field'group msg -> Struct msg
toStruct (Field'group'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Field'group msg)) where
    type InMessage (Field'group msg) = msg
    message :: Field'group msg -> InMessage (Field'group msg)
message (Field'group'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Field'group msg)) where
    messageDefault :: InMessage (Field'group msg) -> Field'group msg
messageDefault InMessage (Field'group msg)
msg = (Struct msg -> Field'group msg
forall msg. Struct msg -> Field'group msg
Field'group'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Field'group msg)
msg))
get_Field'group'typeId :: ((Untyped.ReadCtx m msg)) => (Field'group msg) -> (m Std_.Word64)
get_Field'group'typeId :: Field'group msg -> m Word64
get_Field'group'typeId (Field'group'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
2 Int
0 Word64
0)
set_Field'group'typeId :: ((Untyped.RWCtx m s)) => (Field'group (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Field'group'typeId :: Field'group (MutMsg s) -> Word64 -> m ()
set_Field'group'typeId (Field'group'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
2 Int
0 Word64
0)
newtype Field'ordinal msg
    = Field'ordinal'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Field'ordinal msg)) where
    fromStruct :: Struct msg -> m (Field'ordinal msg)
fromStruct Struct msg
struct = (Field'ordinal msg -> m (Field'ordinal msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Field'ordinal msg
forall msg. Struct msg -> Field'ordinal msg
Field'ordinal'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Field'ordinal msg)) where
    toStruct :: Field'ordinal msg -> Struct msg
toStruct (Field'ordinal'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Field'ordinal msg)) where
    type InMessage (Field'ordinal msg) = msg
    message :: Field'ordinal msg -> InMessage (Field'ordinal msg)
message (Field'ordinal'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Field'ordinal msg)) where
    messageDefault :: InMessage (Field'ordinal msg) -> Field'ordinal msg
messageDefault InMessage (Field'ordinal msg)
msg = (Struct msg -> Field'ordinal msg
forall msg. Struct msg -> Field'ordinal msg
Field'ordinal'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Field'ordinal msg)
msg))
data Field'ordinal' msg
    = Field'ordinal'implicit 
    | Field'ordinal'explicit Std_.Word16
    | Field'ordinal'unknown' Std_.Word16
instance (Classes.FromStruct msg (Field'ordinal' msg)) where
    fromStruct :: Struct msg -> m (Field'ordinal' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
5)
        case Word16
tag of
            Word16
0 ->
                (Field'ordinal' msg -> m (Field'ordinal' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Field'ordinal' msg
forall msg. Field'ordinal' msg
Field'ordinal'implicit)
            Word16
1 ->
                (Word16 -> Field'ordinal' msg
forall msg. Word16 -> Field'ordinal' msg
Field'ordinal'explicit (Word16 -> Field'ordinal' msg)
-> m Word16 -> m (Field'ordinal' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
32 Word64
0))
            Word16
_ ->
                (Field'ordinal' msg -> m (Field'ordinal' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Field'ordinal' msg
forall msg. Word16 -> Field'ordinal' msg
Field'ordinal'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Field'ordinal' :: ((Untyped.ReadCtx m msg)
                      ,(Classes.FromStruct msg (Field'ordinal' msg))) => (Field'ordinal msg) -> (m (Field'ordinal' msg))
get_Field'ordinal' :: Field'ordinal msg -> m (Field'ordinal' msg)
get_Field'ordinal' (Field'ordinal'newtype_ Struct msg
struct) = (Struct msg -> m (Field'ordinal' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Field'ordinal'implicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> (m ())
set_Field'ordinal'implicit :: Field'ordinal (MutMsg s) -> m ()
set_Field'ordinal'implicit (Field'ordinal'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Field'ordinal'explicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Field'ordinal'explicit :: Field'ordinal (MutMsg s) -> Word16 -> m ()
set_Field'ordinal'explicit (Field'ordinal'newtype_ Struct (MutMsg s)
struct) Word16
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
32 Word64
0)
    )
set_Field'ordinal'unknown' :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Field'ordinal'unknown' :: Field'ordinal (MutMsg s) -> Word16 -> m ()
set_Field'ordinal'unknown' (Field'ordinal'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
16 Word64
0)
field'noDiscriminant :: Std_.Word16
field'noDiscriminant :: Word16
field'noDiscriminant  = (Word64 -> Word16
forall a. IsWord a => Word64 -> a
Classes.fromWord Word64
65535)
newtype Enumerant msg
    = Enumerant'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Enumerant msg)) where
    fromStruct :: Struct msg -> m (Enumerant msg)
fromStruct Struct msg
struct = (Enumerant msg -> m (Enumerant msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Enumerant msg
forall msg. Struct msg -> Enumerant msg
Enumerant'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Enumerant msg)) where
    toStruct :: Enumerant msg -> Struct msg
toStruct (Enumerant'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Enumerant msg)) where
    type InMessage (Enumerant msg) = msg
    message :: Enumerant msg -> InMessage (Enumerant msg)
message (Enumerant'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Enumerant msg)) where
    messageDefault :: InMessage (Enumerant msg) -> Enumerant msg
messageDefault InMessage (Enumerant msg)
msg = (Struct msg -> Enumerant msg
forall msg. Struct msg -> Enumerant msg
Enumerant'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Enumerant msg)
msg))
instance (Classes.FromPtr msg (Enumerant msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Enumerant msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Enumerant msg
forall msg. Struct msg -> Enumerant msg
Enumerant'newtype_ (Struct msg -> Enumerant msg)
-> m (Struct msg) -> m (Enumerant msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Enumerant (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Enumerant (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Enumerant'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Enumerant (Message.MutMsg s))) where
    new :: MutMsg s -> m (Enumerant (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Enumerant (MutMsg s)
forall msg. Struct msg -> Enumerant msg
Enumerant'newtype_ (Struct (MutMsg s) -> Enumerant (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Enumerant (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
2))
instance (Basics.ListElem msg (Enumerant msg)) where
    newtype List msg (Enumerant msg)
        = Enumerant'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Enumerant msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Enumerant msg)
forall msg. ListOf msg (Struct msg) -> List msg (Enumerant msg)
Enumerant'List_ (ListOf msg (Struct msg) -> List msg (Enumerant msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Enumerant msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Enumerant msg) -> List msg
toUntypedList (Enumerant'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Enumerant msg) -> Int
length (Enumerant'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Enumerant msg) -> m (Enumerant msg)
index Int
i (Enumerant'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Enumerant msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Enumerant (Message.MutMsg s))) where
    setIndex :: Enumerant (MutMsg s)
-> Int -> List (MutMsg s) (Enumerant (MutMsg s)) -> m ()
setIndex (Enumerant'newtype_ Struct (MutMsg s)
elt) Int
i (Enumerant'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Enumerant (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Enumerant (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Enumerant msg)
Enumerant'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Enumerant (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Enumerant (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
2 Int
len))
get_Enumerant'name :: ((Untyped.ReadCtx m msg)
                      ,(Classes.FromPtr msg (Basics.Text msg))) => (Enumerant msg) -> (m (Basics.Text msg))
get_Enumerant'name :: Enumerant msg -> m (Text msg)
get_Enumerant'name (Enumerant'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Enumerant'name :: ((Untyped.RWCtx m s)
                      ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Enumerant (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Enumerant'name :: Enumerant (MutMsg s) -> Text (MutMsg s) -> m ()
set_Enumerant'name (Enumerant'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Enumerant'name :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool)
has_Enumerant'name :: Enumerant msg -> m Bool
has_Enumerant'name (Enumerant'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Enumerant'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Enumerant (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Enumerant'name :: Int -> Enumerant (MutMsg s) -> m (Text (MutMsg s))
new_Enumerant'name Int
len Enumerant (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Enumerant (MutMsg s) -> InMessage (Enumerant (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Enumerant (MutMsg s)
struct) Int
len)
    (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 ()
set_Enumerant'name Enumerant (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Enumerant'codeOrder :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Word16)
get_Enumerant'codeOrder :: Enumerant msg -> m Word16
get_Enumerant'codeOrder (Enumerant'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Enumerant'codeOrder :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Enumerant'codeOrder :: Enumerant (MutMsg s) -> Word16 -> m ()
set_Enumerant'codeOrder (Enumerant'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
get_Enumerant'annotations :: ((Untyped.ReadCtx m msg)
                             ,(Classes.FromPtr msg (Basics.List msg (Annotation msg)))) => (Enumerant msg) -> (m (Basics.List msg (Annotation msg)))
get_Enumerant'annotations :: Enumerant msg -> m (List msg (Annotation msg))
get_Enumerant'annotations (Enumerant'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Annotation msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Enumerant'annotations :: ((Untyped.RWCtx m s)
                             ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))) => (Enumerant (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
set_Enumerant'annotations :: Enumerant (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
set_Enumerant'annotations (Enumerant'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Annotation (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Enumerant'annotations :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool)
has_Enumerant'annotations :: Enumerant msg -> m Bool
has_Enumerant'annotations (Enumerant'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Enumerant'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Enumerant (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
new_Enumerant'annotations :: Int
-> Enumerant (MutMsg s)
-> m (List (MutMsg s) (Annotation (MutMsg s)))
new_Enumerant'annotations Int
len Enumerant (MutMsg s)
struct = (do
    List (MutMsg s) (Annotation (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Annotation (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Enumerant (MutMsg s) -> InMessage (Enumerant (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Enumerant (MutMsg s)
struct) Int
len)
    (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 ()
set_Enumerant'annotations Enumerant (MutMsg s)
struct List (MutMsg s) (Annotation (MutMsg s))
result)
    (List (MutMsg s) (Annotation (MutMsg s))
-> m (List (MutMsg s) (Annotation (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Annotation (MutMsg s))
result)
    )
newtype Superclass msg
    = Superclass'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Superclass msg)) where
    fromStruct :: Struct msg -> m (Superclass msg)
fromStruct Struct msg
struct = (Superclass msg -> m (Superclass msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Superclass msg
forall msg. Struct msg -> Superclass msg
Superclass'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Superclass msg)) where
    toStruct :: Superclass msg -> Struct msg
toStruct (Superclass'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Superclass msg)) where
    type InMessage (Superclass msg) = msg
    message :: Superclass msg -> InMessage (Superclass msg)
message (Superclass'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Superclass msg)) where
    messageDefault :: InMessage (Superclass msg) -> Superclass msg
messageDefault InMessage (Superclass msg)
msg = (Struct msg -> Superclass msg
forall msg. Struct msg -> Superclass msg
Superclass'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Superclass msg)
msg))
instance (Classes.FromPtr msg (Superclass msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Superclass msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Superclass msg
forall msg. Struct msg -> Superclass msg
Superclass'newtype_ (Struct msg -> Superclass msg)
-> m (Struct msg) -> m (Superclass msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Superclass (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Superclass (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Superclass'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Superclass (Message.MutMsg s))) where
    new :: MutMsg s -> m (Superclass (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Superclass (MutMsg s)
forall msg. Struct msg -> Superclass msg
Superclass'newtype_ (Struct (MutMsg s) -> Superclass (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Superclass (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
1))
instance (Basics.ListElem msg (Superclass msg)) where
    newtype List msg (Superclass msg)
        = Superclass'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Superclass msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Superclass msg)
forall msg. ListOf msg (Struct msg) -> List msg (Superclass msg)
Superclass'List_ (ListOf msg (Struct msg) -> List msg (Superclass msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Superclass msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Superclass msg) -> List msg
toUntypedList (Superclass'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Superclass msg) -> Int
length (Superclass'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Superclass msg) -> m (Superclass msg)
index Int
i (Superclass'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Superclass msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Superclass (Message.MutMsg s))) where
    setIndex :: Superclass (MutMsg s)
-> Int -> List (MutMsg s) (Superclass (MutMsg s)) -> m ()
setIndex (Superclass'newtype_ Struct (MutMsg s)
elt) Int
i (Superclass'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Superclass (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Superclass (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Superclass msg)
Superclass'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Superclass (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Superclass (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
1 Int
len))
get_Superclass'id :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Word64)
get_Superclass'id :: Superclass msg -> m Word64
get_Superclass'id (Superclass'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Superclass'id :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Superclass'id :: Superclass (MutMsg s) -> Word64 -> m ()
set_Superclass'id (Superclass'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_Superclass'brand :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Brand msg))) => (Superclass msg) -> (m (Brand msg))
get_Superclass'brand :: Superclass msg -> m (Brand msg)
get_Superclass'brand (Superclass'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Superclass'brand :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Superclass (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Superclass'brand :: Superclass (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Superclass'brand (Superclass'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Superclass'brand :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Bool)
has_Superclass'brand :: Superclass msg -> m Bool
has_Superclass'brand (Superclass'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Superclass'brand :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Superclass'brand :: Superclass (MutMsg s) -> m (Brand (MutMsg s))
new_Superclass'brand Superclass (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Superclass (MutMsg s) -> InMessage (Superclass (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Superclass (MutMsg s)
struct))
    (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 ()
set_Superclass'brand Superclass (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
newtype Method msg
    = Method'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Method msg)) where
    fromStruct :: Struct msg -> m (Method msg)
fromStruct Struct msg
struct = (Method msg -> m (Method msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Method msg
forall msg. Struct msg -> Method msg
Method'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Method msg)) where
    toStruct :: Method msg -> Struct msg
toStruct (Method'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Method msg)) where
    type InMessage (Method msg) = msg
    message :: Method msg -> InMessage (Method msg)
message (Method'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Method msg)) where
    messageDefault :: InMessage (Method msg) -> Method msg
messageDefault InMessage (Method msg)
msg = (Struct msg -> Method msg
forall msg. Struct msg -> Method msg
Method'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Method msg)
msg))
instance (Classes.FromPtr msg (Method msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Method msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Method msg
forall msg. Struct msg -> Method msg
Method'newtype_ (Struct msg -> Method msg) -> m (Struct msg) -> m (Method msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Method (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Method (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Method'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Method (Message.MutMsg s))) where
    new :: MutMsg s -> m (Method (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Method (MutMsg s)
forall msg. Struct msg -> Method msg
Method'newtype_ (Struct (MutMsg s) -> Method (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Method (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
3 Word16
5))
instance (Basics.ListElem msg (Method msg)) where
    newtype List msg (Method msg)
        = Method'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Method msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Method msg)
forall msg. ListOf msg (Struct msg) -> List msg (Method msg)
Method'List_ (ListOf msg (Struct msg) -> List msg (Method msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Method msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Method msg) -> List msg
toUntypedList (Method'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Method msg) -> Int
length (Method'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Method msg) -> m (Method msg)
index Int
i (Method'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Method msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Method (Message.MutMsg s))) where
    setIndex :: Method (MutMsg s)
-> Int -> List (MutMsg s) (Method (MutMsg s)) -> m ()
setIndex (Method'newtype_ Struct (MutMsg s)
elt) Int
i (Method'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Method (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Method (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Method msg)
Method'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Method (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Method (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
3 Word16
5 Int
len))
get_Method'name :: ((Untyped.ReadCtx m msg)
                   ,(Classes.FromPtr msg (Basics.Text msg))) => (Method msg) -> (m (Basics.Text msg))
get_Method'name :: Method msg -> m (Text msg)
get_Method'name (Method'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Method'name :: ((Untyped.RWCtx m s)
                   ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Method (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Method'name :: Method (MutMsg s) -> Text (MutMsg s) -> m ()
set_Method'name (Method'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Method'name :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
has_Method'name :: Method msg -> m Bool
has_Method'name (Method'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Method'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Method'name :: Int -> Method (MutMsg s) -> m (Text (MutMsg s))
new_Method'name Int
len Method (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Method (MutMsg s)
struct) Int
len)
    (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 ()
set_Method'name Method (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_Method'codeOrder :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word16)
get_Method'codeOrder :: Method msg -> m Word16
get_Method'codeOrder (Method'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Method'codeOrder :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Method'codeOrder :: Method (MutMsg s) -> Word16 -> m ()
set_Method'codeOrder (Method'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
get_Method'paramStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64)
get_Method'paramStructType :: Method msg -> m Word64
get_Method'paramStructType (Method'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0)
set_Method'paramStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Method'paramStructType :: Method (MutMsg s) -> Word64 -> m ()
set_Method'paramStructType (Method'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
get_Method'resultStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64)
get_Method'resultStructType :: Method msg -> m Word64
get_Method'resultStructType (Method'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
2 Int
0 Word64
0)
set_Method'resultStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Method'resultStructType :: Method (MutMsg s) -> Word64 -> m ()
set_Method'resultStructType (Method'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
2 Int
0 Word64
0)
get_Method'annotations :: ((Untyped.ReadCtx m msg)
                          ,(Classes.FromPtr msg (Basics.List msg (Annotation msg)))) => (Method msg) -> (m (Basics.List msg (Annotation msg)))
get_Method'annotations :: Method msg -> m (List msg (Annotation msg))
get_Method'annotations (Method'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Annotation msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Method'annotations :: ((Untyped.RWCtx m s)
                          ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
set_Method'annotations :: Method (MutMsg s)
-> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
set_Method'annotations (Method'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Annotation (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Annotation (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Method'annotations :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
has_Method'annotations :: Method msg -> m Bool
has_Method'annotations (Method'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Method'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
new_Method'annotations :: Int
-> Method (MutMsg s) -> m (List (MutMsg s) (Annotation (MutMsg s)))
new_Method'annotations Int
len Method (MutMsg s)
struct = (do
    List (MutMsg s) (Annotation (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Annotation (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Method (MutMsg s)
struct) Int
len)
    (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 ()
set_Method'annotations Method (MutMsg s)
struct List (MutMsg s) (Annotation (MutMsg s))
result)
    (List (MutMsg s) (Annotation (MutMsg s))
-> m (List (MutMsg s) (Annotation (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Annotation (MutMsg s))
result)
    )
get_Method'paramBrand :: ((Untyped.ReadCtx m msg)
                         ,(Classes.FromPtr msg (Brand msg))) => (Method msg) -> (m (Brand msg))
get_Method'paramBrand :: Method msg -> m (Brand msg)
get_Method'paramBrand (Method'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Method'paramBrand :: ((Untyped.RWCtx m s)
                         ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Method'paramBrand :: Method (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Method'paramBrand (Method'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
2 Struct (MutMsg s)
struct)
    )
has_Method'paramBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
has_Method'paramBrand :: Method msg -> m Bool
has_Method'paramBrand (Method'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct))
new_Method'paramBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Method'paramBrand :: Method (MutMsg s) -> m (Brand (MutMsg s))
new_Method'paramBrand Method (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Method (MutMsg s)
struct))
    (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 ()
set_Method'paramBrand Method (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
get_Method'resultBrand :: ((Untyped.ReadCtx m msg)
                          ,(Classes.FromPtr msg (Brand msg))) => (Method msg) -> (m (Brand msg))
get_Method'resultBrand :: Method msg -> m (Brand msg)
get_Method'resultBrand (Method'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Method'resultBrand :: ((Untyped.RWCtx m s)
                          ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Method'resultBrand :: Method (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Method'resultBrand (Method'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_Method'resultBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
has_Method'resultBrand :: Method msg -> m Bool
has_Method'resultBrand (Method'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_Method'resultBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Method'resultBrand :: Method (MutMsg s) -> m (Brand (MutMsg s))
new_Method'resultBrand Method (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Method (MutMsg s)
struct))
    (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 ()
set_Method'resultBrand Method (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
get_Method'implicitParameters :: ((Untyped.ReadCtx m msg)
                                 ,(Classes.FromPtr msg (Basics.List msg (Node'Parameter msg)))) => (Method msg) -> (m (Basics.List msg (Node'Parameter msg)))
get_Method'implicitParameters :: Method msg -> m (List msg (Node'Parameter msg))
get_Method'implicitParameters (Method'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node'Parameter msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Method'implicitParameters :: ((Untyped.RWCtx m s)
                                 ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ())
set_Method'implicitParameters :: Method (MutMsg s)
-> List (MutMsg s) (Node'Parameter (MutMsg s)) -> m ()
set_Method'implicitParameters (Method'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node'Parameter (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node'Parameter (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node'Parameter (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
4 Struct (MutMsg s)
struct)
    )
has_Method'implicitParameters :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
has_Method'implicitParameters :: Method msg -> m Bool
has_Method'implicitParameters (Method'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
4 Struct msg
struct))
new_Method'implicitParameters :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))
new_Method'implicitParameters :: Int
-> Method (MutMsg s)
-> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
new_Method'implicitParameters Int
len Method (MutMsg s)
struct = (do
    List (MutMsg s) (Node'Parameter (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Method (MutMsg s) -> InMessage (Method (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Method (MutMsg s)
struct) Int
len)
    (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 ()
set_Method'implicitParameters Method (MutMsg s)
struct List (MutMsg s) (Node'Parameter (MutMsg s))
result)
    (List (MutMsg s) (Node'Parameter (MutMsg s))
-> m (List (MutMsg s) (Node'Parameter (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node'Parameter (MutMsg s))
result)
    )
newtype Type msg
    = Type'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type msg)) where
    fromStruct :: Struct msg -> m (Type msg)
fromStruct Struct msg
struct = (Type msg -> m (Type msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type msg
forall msg. Struct msg -> Type msg
Type'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type msg)) where
    toStruct :: Type msg -> Struct msg
toStruct (Type'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type msg)) where
    type InMessage (Type msg) = msg
    message :: Type msg -> InMessage (Type msg)
message (Type'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type msg)) where
    messageDefault :: InMessage (Type msg) -> Type msg
messageDefault InMessage (Type msg)
msg = (Struct msg -> Type msg
forall msg. Struct msg -> Type msg
Type'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type msg)
msg))
instance (Classes.FromPtr msg (Type msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Type msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Type msg
forall msg. Struct msg -> Type msg
Type'newtype_ (Struct msg -> Type msg) -> m (Struct msg) -> m (Type msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Type (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Type'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Type (Message.MutMsg s))) where
    new :: MutMsg s -> m (Type (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Type (MutMsg s)
forall msg. Struct msg -> Type msg
Type'newtype_ (Struct (MutMsg s) -> Type (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Type (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
3 Word16
1))
instance (Basics.ListElem msg (Type msg)) where
    newtype List msg (Type msg)
        = Type'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Type msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Type msg)
forall msg. ListOf msg (Struct msg) -> List msg (Type msg)
Type'List_ (ListOf msg (Struct msg) -> List msg (Type msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Type msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Type msg) -> List msg
toUntypedList (Type'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Type msg) -> Int
length (Type'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Type msg) -> m (Type msg)
index Int
i (Type'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Type msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Type (Message.MutMsg s))) where
    setIndex :: Type (MutMsg s) -> Int -> List (MutMsg s) (Type (MutMsg s)) -> m ()
setIndex (Type'newtype_ Struct (MutMsg s)
elt) Int
i (Type'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Type (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Type (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Type msg)
Type'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Type (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Type (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
3 Word16
1 Int
len))
data Type' msg
    = Type'void 
    | Type'bool 
    | Type'int8 
    | Type'int16 
    | Type'int32 
    | Type'int64 
    | Type'uint8 
    | Type'uint16 
    | Type'uint32 
    | Type'uint64 
    | Type'float32 
    | Type'float64 
    | Type'text 
    | Type'data_ 
    | Type'list (Type'list msg)
    | Type'enum (Type'enum msg)
    | Type'struct (Type'struct msg)
    | Type'interface (Type'interface msg)
    | Type'anyPointer (Type'anyPointer msg)
    | Type'unknown' Std_.Word16
instance (Classes.FromStruct msg (Type' msg)) where
    fromStruct :: Struct msg -> m (Type' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
0)
        case Word16
tag of
            Word16
0 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'void)
            Word16
1 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'bool)
            Word16
2 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'int8)
            Word16
3 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'int16)
            Word16
4 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'int32)
            Word16
5 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'int64)
            Word16
6 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'uint8)
            Word16
7 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'uint16)
            Word16
8 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'uint32)
            Word16
9 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'uint64)
            Word16
10 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'float32)
            Word16
11 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'float64)
            Word16
12 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'text)
            Word16
13 ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type' msg
forall msg. Type' msg
Type'data_)
            Word16
14 ->
                (Type'list msg -> Type' msg
forall msg. Type'list msg -> Type' msg
Type'list (Type'list msg -> Type' msg) -> m (Type'list msg) -> m (Type' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'list msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
15 ->
                (Type'enum msg -> Type' msg
forall msg. Type'enum msg -> Type' msg
Type'enum (Type'enum msg -> Type' msg) -> m (Type'enum msg) -> m (Type' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'enum msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
16 ->
                (Type'struct msg -> Type' msg
forall msg. Type'struct msg -> Type' msg
Type'struct (Type'struct msg -> Type' msg)
-> m (Type'struct msg) -> m (Type' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'struct msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
17 ->
                (Type'interface msg -> Type' msg
forall msg. Type'interface msg -> Type' msg
Type'interface (Type'interface msg -> Type' msg)
-> m (Type'interface msg) -> m (Type' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'interface msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
18 ->
                (Type'anyPointer msg -> Type' msg
forall msg. Type'anyPointer msg -> Type' msg
Type'anyPointer (Type'anyPointer msg -> Type' msg)
-> m (Type'anyPointer msg) -> m (Type' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'anyPointer msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
_ ->
                (Type' msg -> m (Type' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type' msg
forall msg. Word16 -> Type' msg
Type'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Type' :: ((Untyped.ReadCtx m msg)
             ,(Classes.FromStruct msg (Type' msg))) => (Type msg) -> (m (Type' msg))
get_Type' :: Type msg -> m (Type' msg)
get_Type' (Type'newtype_ Struct msg
struct) = (Struct msg -> m (Type' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Type'void :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'void :: Type (MutMsg s) -> m ()
set_Type'void (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'bool :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'bool :: Type (MutMsg s) -> m ()
set_Type'bool (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'int8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'int8 :: Type (MutMsg s) -> m ()
set_Type'int8 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
2 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'int16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'int16 :: Type (MutMsg s) -> m ()
set_Type'int16 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
3 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'int32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'int32 :: Type (MutMsg s) -> m ()
set_Type'int32 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
4 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'int64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'int64 :: Type (MutMsg s) -> m ()
set_Type'int64 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
5 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'uint8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'uint8 :: Type (MutMsg s) -> m ()
set_Type'uint8 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
6 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'uint16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'uint16 :: Type (MutMsg s) -> m ()
set_Type'uint16 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
7 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'uint32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'uint32 :: Type (MutMsg s) -> m ()
set_Type'uint32 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
8 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'uint64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'uint64 :: Type (MutMsg s) -> m ()
set_Type'uint64 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
9 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'float32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'float32 :: Type (MutMsg s) -> m ()
set_Type'float32 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
10 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'float64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'float64 :: Type (MutMsg s) -> m ()
set_Type'float64 (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
11 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'text :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'text :: Type (MutMsg s) -> m ()
set_Type'text (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
12 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'data_ :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
set_Type'data_ :: Type (MutMsg s) -> m ()
set_Type'data_ (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
13 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'list :: ((Untyped.RWCtx m s)
                 ,(Classes.FromStruct (Message.MutMsg s) (Type'list (Message.MutMsg s)))) => (Type (Message.MutMsg s)) -> (m (Type'list (Message.MutMsg s)))
set_Type'list :: Type (MutMsg s) -> m (Type'list (MutMsg s))
set_Type'list (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
14 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'list (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'enum :: ((Untyped.RWCtx m s)
                 ,(Classes.FromStruct (Message.MutMsg s) (Type'enum (Message.MutMsg s)))) => (Type (Message.MutMsg s)) -> (m (Type'enum (Message.MutMsg s)))
set_Type'enum :: Type (MutMsg s) -> m (Type'enum (MutMsg s))
set_Type'enum (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
15 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'enum (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'struct :: ((Untyped.RWCtx m s)
                   ,(Classes.FromStruct (Message.MutMsg s) (Type'struct (Message.MutMsg s)))) => (Type (Message.MutMsg s)) -> (m (Type'struct (Message.MutMsg s)))
set_Type'struct :: Type (MutMsg s) -> m (Type'struct (MutMsg s))
set_Type'struct (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
16 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'struct (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'interface :: ((Untyped.RWCtx m s)
                      ,(Classes.FromStruct (Message.MutMsg s) (Type'interface (Message.MutMsg s)))) => (Type (Message.MutMsg s)) -> (m (Type'interface (Message.MutMsg s)))
set_Type'interface :: Type (MutMsg s) -> m (Type'interface (MutMsg s))
set_Type'interface (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
17 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'interface (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'anyPointer :: ((Untyped.RWCtx m s)
                       ,(Classes.FromStruct (Message.MutMsg s) (Type'anyPointer (Message.MutMsg s)))) => (Type (Message.MutMsg s)) -> (m (Type'anyPointer (Message.MutMsg s)))
set_Type'anyPointer :: Type (MutMsg s) -> m (Type'anyPointer (MutMsg s))
set_Type'anyPointer (Type'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
18 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'anyPointer (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'unknown' :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Type'unknown' :: Type (MutMsg s) -> Word16 -> m ()
set_Type'unknown' (Type'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
newtype Type'list msg
    = Type'list'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'list msg)) where
    fromStruct :: Struct msg -> m (Type'list msg)
fromStruct Struct msg
struct = (Type'list msg -> m (Type'list msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'list msg
forall msg. Struct msg -> Type'list msg
Type'list'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'list msg)) where
    toStruct :: Type'list msg -> Struct msg
toStruct (Type'list'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'list msg)) where
    type InMessage (Type'list msg) = msg
    message :: Type'list msg -> InMessage (Type'list msg)
message (Type'list'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'list msg)) where
    messageDefault :: InMessage (Type'list msg) -> Type'list msg
messageDefault InMessage (Type'list msg)
msg = (Struct msg -> Type'list msg
forall msg. Struct msg -> Type'list msg
Type'list'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'list msg)
msg))
get_Type'list'elementType :: ((Untyped.ReadCtx m msg)
                             ,(Classes.FromPtr msg (Type msg))) => (Type'list msg) -> (m (Type msg))
get_Type'list'elementType :: Type'list msg -> m (Type msg)
get_Type'list'elementType (Type'list'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Type msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Type'list'elementType :: ((Untyped.RWCtx m s)
                             ,(Classes.ToPtr s (Type (Message.MutMsg s)))) => (Type'list (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
set_Type'list'elementType :: Type'list (MutMsg s) -> Type (MutMsg s) -> m ()
set_Type'list'elementType (Type'list'newtype_ Struct (MutMsg s)
struct) Type (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Type (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Type'list'elementType :: ((Untyped.ReadCtx m msg)) => (Type'list msg) -> (m Std_.Bool)
has_Type'list'elementType :: Type'list msg -> m Bool
has_Type'list'elementType (Type'list'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Type'list'elementType :: ((Untyped.RWCtx m s)) => (Type'list (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
new_Type'list'elementType :: Type'list (MutMsg s) -> m (Type (MutMsg s))
new_Type'list'elementType Type'list (MutMsg s)
struct = (do
    Type (MutMsg s)
result <- (MutMsg s -> m (Type (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Type'list (MutMsg s) -> InMessage (Type'list (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Type'list (MutMsg s)
struct))
    (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 ()
set_Type'list'elementType Type'list (MutMsg s)
struct Type (MutMsg s)
result)
    (Type (MutMsg s) -> m (Type (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type (MutMsg s)
result)
    )
newtype Type'enum msg
    = Type'enum'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'enum msg)) where
    fromStruct :: Struct msg -> m (Type'enum msg)
fromStruct Struct msg
struct = (Type'enum msg -> m (Type'enum msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'enum msg
forall msg. Struct msg -> Type'enum msg
Type'enum'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'enum msg)) where
    toStruct :: Type'enum msg -> Struct msg
toStruct (Type'enum'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'enum msg)) where
    type InMessage (Type'enum msg) = msg
    message :: Type'enum msg -> InMessage (Type'enum msg)
message (Type'enum'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'enum msg)) where
    messageDefault :: InMessage (Type'enum msg) -> Type'enum msg
messageDefault InMessage (Type'enum msg)
msg = (Struct msg -> Type'enum msg
forall msg. Struct msg -> Type'enum msg
Type'enum'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'enum msg)
msg))
get_Type'enum'typeId :: ((Untyped.ReadCtx m msg)) => (Type'enum msg) -> (m Std_.Word64)
get_Type'enum'typeId :: Type'enum msg -> m Word64
get_Type'enum'typeId (Type'enum'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0)
set_Type'enum'typeId :: ((Untyped.RWCtx m s)) => (Type'enum (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Type'enum'typeId :: Type'enum (MutMsg s) -> Word64 -> m ()
set_Type'enum'typeId (Type'enum'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
get_Type'enum'brand :: ((Untyped.ReadCtx m msg)
                       ,(Classes.FromPtr msg (Brand msg))) => (Type'enum msg) -> (m (Brand msg))
get_Type'enum'brand :: Type'enum msg -> m (Brand msg)
get_Type'enum'brand (Type'enum'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Type'enum'brand :: ((Untyped.RWCtx m s)
                       ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Type'enum (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Type'enum'brand :: Type'enum (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Type'enum'brand (Type'enum'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Type'enum'brand :: ((Untyped.ReadCtx m msg)) => (Type'enum msg) -> (m Std_.Bool)
has_Type'enum'brand :: Type'enum msg -> m Bool
has_Type'enum'brand (Type'enum'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Type'enum'brand :: ((Untyped.RWCtx m s)) => (Type'enum (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Type'enum'brand :: Type'enum (MutMsg s) -> m (Brand (MutMsg s))
new_Type'enum'brand Type'enum (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Type'enum (MutMsg s) -> InMessage (Type'enum (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Type'enum (MutMsg s)
struct))
    (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 ()
set_Type'enum'brand Type'enum (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
newtype Type'struct msg
    = Type'struct'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'struct msg)) where
    fromStruct :: Struct msg -> m (Type'struct msg)
fromStruct Struct msg
struct = (Type'struct msg -> m (Type'struct msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'struct msg
forall msg. Struct msg -> Type'struct msg
Type'struct'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'struct msg)) where
    toStruct :: Type'struct msg -> Struct msg
toStruct (Type'struct'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'struct msg)) where
    type InMessage (Type'struct msg) = msg
    message :: Type'struct msg -> InMessage (Type'struct msg)
message (Type'struct'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'struct msg)) where
    messageDefault :: InMessage (Type'struct msg) -> Type'struct msg
messageDefault InMessage (Type'struct msg)
msg = (Struct msg -> Type'struct msg
forall msg. Struct msg -> Type'struct msg
Type'struct'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'struct msg)
msg))
get_Type'struct'typeId :: ((Untyped.ReadCtx m msg)) => (Type'struct msg) -> (m Std_.Word64)
get_Type'struct'typeId :: Type'struct msg -> m Word64
get_Type'struct'typeId (Type'struct'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0)
set_Type'struct'typeId :: ((Untyped.RWCtx m s)) => (Type'struct (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Type'struct'typeId :: Type'struct (MutMsg s) -> Word64 -> m ()
set_Type'struct'typeId (Type'struct'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
get_Type'struct'brand :: ((Untyped.ReadCtx m msg)
                         ,(Classes.FromPtr msg (Brand msg))) => (Type'struct msg) -> (m (Brand msg))
get_Type'struct'brand :: Type'struct msg -> m (Brand msg)
get_Type'struct'brand (Type'struct'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Type'struct'brand :: ((Untyped.RWCtx m s)
                         ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Type'struct (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Type'struct'brand :: Type'struct (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Type'struct'brand (Type'struct'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Type'struct'brand :: ((Untyped.ReadCtx m msg)) => (Type'struct msg) -> (m Std_.Bool)
has_Type'struct'brand :: Type'struct msg -> m Bool
has_Type'struct'brand (Type'struct'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Type'struct'brand :: ((Untyped.RWCtx m s)) => (Type'struct (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Type'struct'brand :: Type'struct (MutMsg s) -> m (Brand (MutMsg s))
new_Type'struct'brand Type'struct (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Type'struct (MutMsg s) -> InMessage (Type'struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Type'struct (MutMsg s)
struct))
    (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 ()
set_Type'struct'brand Type'struct (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
newtype Type'interface msg
    = Type'interface'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'interface msg)) where
    fromStruct :: Struct msg -> m (Type'interface msg)
fromStruct Struct msg
struct = (Type'interface msg -> m (Type'interface msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'interface msg
forall msg. Struct msg -> Type'interface msg
Type'interface'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'interface msg)) where
    toStruct :: Type'interface msg -> Struct msg
toStruct (Type'interface'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'interface msg)) where
    type InMessage (Type'interface msg) = msg
    message :: Type'interface msg -> InMessage (Type'interface msg)
message (Type'interface'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'interface msg)) where
    messageDefault :: InMessage (Type'interface msg) -> Type'interface msg
messageDefault InMessage (Type'interface msg)
msg = (Struct msg -> Type'interface msg
forall msg. Struct msg -> Type'interface msg
Type'interface'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'interface msg)
msg))
get_Type'interface'typeId :: ((Untyped.ReadCtx m msg)) => (Type'interface msg) -> (m Std_.Word64)
get_Type'interface'typeId :: Type'interface msg -> m Word64
get_Type'interface'typeId (Type'interface'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0)
set_Type'interface'typeId :: ((Untyped.RWCtx m s)) => (Type'interface (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Type'interface'typeId :: Type'interface (MutMsg s) -> Word64 -> m ()
set_Type'interface'typeId (Type'interface'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
get_Type'interface'brand :: ((Untyped.ReadCtx m msg)
                            ,(Classes.FromPtr msg (Brand msg))) => (Type'interface msg) -> (m (Brand msg))
get_Type'interface'brand :: Type'interface msg -> m (Brand msg)
get_Type'interface'brand (Type'interface'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Type'interface'brand :: ((Untyped.RWCtx m s)
                            ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Type'interface (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Type'interface'brand :: Type'interface (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Type'interface'brand (Type'interface'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Type'interface'brand :: ((Untyped.ReadCtx m msg)) => (Type'interface msg) -> (m Std_.Bool)
has_Type'interface'brand :: Type'interface msg -> m Bool
has_Type'interface'brand (Type'interface'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Type'interface'brand :: ((Untyped.RWCtx m s)) => (Type'interface (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Type'interface'brand :: Type'interface (MutMsg s) -> m (Brand (MutMsg s))
new_Type'interface'brand Type'interface (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Type'interface (MutMsg s) -> InMessage (Type'interface (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Type'interface (MutMsg s)
struct))
    (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 ()
set_Type'interface'brand Type'interface (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
newtype Type'anyPointer msg
    = Type'anyPointer'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'anyPointer msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer msg)
fromStruct Struct msg
struct = (Type'anyPointer msg -> m (Type'anyPointer msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'anyPointer msg
forall msg. Struct msg -> Type'anyPointer msg
Type'anyPointer'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'anyPointer msg)) where
    toStruct :: Type'anyPointer msg -> Struct msg
toStruct (Type'anyPointer'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'anyPointer msg)) where
    type InMessage (Type'anyPointer msg) = msg
    message :: Type'anyPointer msg -> InMessage (Type'anyPointer msg)
message (Type'anyPointer'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'anyPointer msg)) where
    messageDefault :: InMessage (Type'anyPointer msg) -> Type'anyPointer msg
messageDefault InMessage (Type'anyPointer msg)
msg = (Struct msg -> Type'anyPointer msg
forall msg. Struct msg -> Type'anyPointer msg
Type'anyPointer'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'anyPointer msg)
msg))
data Type'anyPointer' msg
    = Type'anyPointer'unconstrained (Type'anyPointer'unconstrained msg)
    | Type'anyPointer'parameter (Type'anyPointer'parameter msg)
    | Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter msg)
    | Type'anyPointer'unknown' Std_.Word16
instance (Classes.FromStruct msg (Type'anyPointer' msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
4)
        case Word16
tag of
            Word16
0 ->
                (Type'anyPointer'unconstrained msg -> Type'anyPointer' msg
forall msg.
Type'anyPointer'unconstrained msg -> Type'anyPointer' msg
Type'anyPointer'unconstrained (Type'anyPointer'unconstrained msg -> Type'anyPointer' msg)
-> m (Type'anyPointer'unconstrained msg)
-> m (Type'anyPointer' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'anyPointer'unconstrained msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
1 ->
                (Type'anyPointer'parameter msg -> Type'anyPointer' msg
forall msg. Type'anyPointer'parameter msg -> Type'anyPointer' msg
Type'anyPointer'parameter (Type'anyPointer'parameter msg -> Type'anyPointer' msg)
-> m (Type'anyPointer'parameter msg) -> m (Type'anyPointer' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'anyPointer'parameter msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
2 ->
                (Type'anyPointer'implicitMethodParameter msg -> Type'anyPointer' msg
forall msg.
Type'anyPointer'implicitMethodParameter msg -> Type'anyPointer' msg
Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter msg
 -> Type'anyPointer' msg)
-> m (Type'anyPointer'implicitMethodParameter msg)
-> m (Type'anyPointer' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> m (Type'anyPointer'implicitMethodParameter msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct))
            Word16
_ ->
                (Type'anyPointer' msg -> m (Type'anyPointer' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type'anyPointer' msg
forall msg. Word16 -> Type'anyPointer' msg
Type'anyPointer'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Type'anyPointer' :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromStruct msg (Type'anyPointer' msg))) => (Type'anyPointer msg) -> (m (Type'anyPointer' msg))
get_Type'anyPointer' :: Type'anyPointer msg -> m (Type'anyPointer' msg)
get_Type'anyPointer' (Type'anyPointer'newtype_ Struct msg
struct) = (Struct msg -> m (Type'anyPointer' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Type'anyPointer'unconstrained :: ((Untyped.RWCtx m s)
                                     ,(Classes.FromStruct (Message.MutMsg s) (Type'anyPointer'unconstrained (Message.MutMsg s)))) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'unconstrained (Message.MutMsg s)))
set_Type'anyPointer'unconstrained :: Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'unconstrained (MutMsg s))
set_Type'anyPointer'unconstrained (Type'anyPointer'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'anyPointer'unconstrained (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'anyPointer'parameter :: ((Untyped.RWCtx m s)
                                 ,(Classes.FromStruct (Message.MutMsg s) (Type'anyPointer'parameter (Message.MutMsg s)))) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'parameter (Message.MutMsg s)))
set_Type'anyPointer'parameter :: Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'parameter (MutMsg s))
set_Type'anyPointer'parameter (Type'anyPointer'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (Struct (MutMsg s) -> m (Type'anyPointer'parameter (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'anyPointer'implicitMethodParameter :: ((Untyped.RWCtx m s)
                                               ,(Classes.FromStruct (Message.MutMsg s) (Type'anyPointer'implicitMethodParameter (Message.MutMsg s)))) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'implicitMethodParameter (Message.MutMsg s)))
set_Type'anyPointer'implicitMethodParameter :: Type'anyPointer (MutMsg s)
-> m (Type'anyPointer'implicitMethodParameter (MutMsg s))
set_Type'anyPointer'implicitMethodParameter (Type'anyPointer'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
2 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (Struct (MutMsg s)
-> m (Type'anyPointer'implicitMethodParameter (MutMsg s))
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct (MutMsg s)
struct)
    )
set_Type'anyPointer'unknown' :: ((Untyped.RWCtx m s)) => (Type'anyPointer (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Type'anyPointer'unknown' :: Type'anyPointer (MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'unknown' (Type'anyPointer'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
0 Word64
0)
newtype Type'anyPointer'unconstrained msg
    = Type'anyPointer'unconstrained'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'anyPointer'unconstrained msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer'unconstrained msg)
fromStruct Struct msg
struct = (Type'anyPointer'unconstrained msg
-> m (Type'anyPointer'unconstrained msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'anyPointer'unconstrained msg
forall msg. Struct msg -> Type'anyPointer'unconstrained msg
Type'anyPointer'unconstrained'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'anyPointer'unconstrained msg)) where
    toStruct :: Type'anyPointer'unconstrained msg -> Struct msg
toStruct (Type'anyPointer'unconstrained'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'anyPointer'unconstrained msg)) where
    type InMessage (Type'anyPointer'unconstrained msg) = msg
    message :: Type'anyPointer'unconstrained msg
-> InMessage (Type'anyPointer'unconstrained msg)
message (Type'anyPointer'unconstrained'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'anyPointer'unconstrained msg)) where
    messageDefault :: InMessage (Type'anyPointer'unconstrained msg)
-> Type'anyPointer'unconstrained msg
messageDefault InMessage (Type'anyPointer'unconstrained msg)
msg = (Struct msg -> Type'anyPointer'unconstrained msg
forall msg. Struct msg -> Type'anyPointer'unconstrained msg
Type'anyPointer'unconstrained'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'anyPointer'unconstrained msg)
msg))
data Type'anyPointer'unconstrained' msg
    = Type'anyPointer'unconstrained'anyKind 
    | Type'anyPointer'unconstrained'struct 
    | Type'anyPointer'unconstrained'list 
    | Type'anyPointer'unconstrained'capability 
    | Type'anyPointer'unconstrained'unknown' Std_.Word16
instance (Classes.FromStruct msg (Type'anyPointer'unconstrained' msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer'unconstrained' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
5)
        case Word16
tag of
            Word16
0 ->
                (Type'anyPointer'unconstrained' msg
-> m (Type'anyPointer'unconstrained' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained' msg
forall msg. Type'anyPointer'unconstrained' msg
Type'anyPointer'unconstrained'anyKind)
            Word16
1 ->
                (Type'anyPointer'unconstrained' msg
-> m (Type'anyPointer'unconstrained' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained' msg
forall msg. Type'anyPointer'unconstrained' msg
Type'anyPointer'unconstrained'struct)
            Word16
2 ->
                (Type'anyPointer'unconstrained' msg
-> m (Type'anyPointer'unconstrained' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained' msg
forall msg. Type'anyPointer'unconstrained' msg
Type'anyPointer'unconstrained'list)
            Word16
3 ->
                (Type'anyPointer'unconstrained' msg
-> m (Type'anyPointer'unconstrained' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Type'anyPointer'unconstrained' msg
forall msg. Type'anyPointer'unconstrained' msg
Type'anyPointer'unconstrained'capability)
            Word16
_ ->
                (Type'anyPointer'unconstrained' msg
-> m (Type'anyPointer'unconstrained' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Type'anyPointer'unconstrained' msg
forall msg. Word16 -> Type'anyPointer'unconstrained' msg
Type'anyPointer'unconstrained'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Type'anyPointer'unconstrained' :: ((Untyped.ReadCtx m msg)
                                      ,(Classes.FromStruct msg (Type'anyPointer'unconstrained' msg))) => (Type'anyPointer'unconstrained msg) -> (m (Type'anyPointer'unconstrained' msg))
get_Type'anyPointer'unconstrained' :: Type'anyPointer'unconstrained msg
-> m (Type'anyPointer'unconstrained' msg)
get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained'newtype_ Struct msg
struct) = (Struct msg -> m (Type'anyPointer'unconstrained' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Type'anyPointer'unconstrained'anyKind :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
set_Type'anyPointer'unconstrained'anyKind :: Type'anyPointer'unconstrained (MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'anyKind (Type'anyPointer'unconstrained'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'anyPointer'unconstrained'struct :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
set_Type'anyPointer'unconstrained'struct :: Type'anyPointer'unconstrained (MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'struct (Type'anyPointer'unconstrained'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'anyPointer'unconstrained'list :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
set_Type'anyPointer'unconstrained'list :: Type'anyPointer'unconstrained (MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'list (Type'anyPointer'unconstrained'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
2 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'anyPointer'unconstrained'capability :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
set_Type'anyPointer'unconstrained'capability :: Type'anyPointer'unconstrained (MutMsg s) -> m ()
set_Type'anyPointer'unconstrained'capability (Type'anyPointer'unconstrained'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
3 :: Std_.Word16) Int
1 Int
16 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Type'anyPointer'unconstrained'unknown' :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Type'anyPointer'unconstrained'unknown' :: Type'anyPointer'unconstrained (MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'unconstrained'unknown' (Type'anyPointer'unconstrained'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
16 Word64
0)
newtype Type'anyPointer'parameter msg
    = Type'anyPointer'parameter'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'anyPointer'parameter msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer'parameter msg)
fromStruct Struct msg
struct = (Type'anyPointer'parameter msg -> m (Type'anyPointer'parameter msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'anyPointer'parameter msg
forall msg. Struct msg -> Type'anyPointer'parameter msg
Type'anyPointer'parameter'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'anyPointer'parameter msg)) where
    toStruct :: Type'anyPointer'parameter msg -> Struct msg
toStruct (Type'anyPointer'parameter'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'anyPointer'parameter msg)) where
    type InMessage (Type'anyPointer'parameter msg) = msg
    message :: Type'anyPointer'parameter msg
-> InMessage (Type'anyPointer'parameter msg)
message (Type'anyPointer'parameter'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'anyPointer'parameter msg)) where
    messageDefault :: InMessage (Type'anyPointer'parameter msg)
-> Type'anyPointer'parameter msg
messageDefault InMessage (Type'anyPointer'parameter msg)
msg = (Struct msg -> Type'anyPointer'parameter msg
forall msg. Struct msg -> Type'anyPointer'parameter msg
Type'anyPointer'parameter'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'anyPointer'parameter msg)
msg))
get_Type'anyPointer'parameter'scopeId :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'parameter msg) -> (m Std_.Word64)
get_Type'anyPointer'parameter'scopeId :: Type'anyPointer'parameter msg -> m Word64
get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
2 Int
0 Word64
0)
set_Type'anyPointer'parameter'scopeId :: ((Untyped.RWCtx m s)) => (Type'anyPointer'parameter (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Type'anyPointer'parameter'scopeId :: Type'anyPointer'parameter (MutMsg s) -> Word64 -> m ()
set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
2 Int
0 Word64
0)
get_Type'anyPointer'parameter'parameterIndex :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'parameter msg) -> (m Std_.Word16)
get_Type'anyPointer'parameter'parameterIndex :: Type'anyPointer'parameter msg -> m Word16
get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
16 Word64
0)
set_Type'anyPointer'parameter'parameterIndex :: ((Untyped.RWCtx m s)) => (Type'anyPointer'parameter (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Type'anyPointer'parameter'parameterIndex :: Type'anyPointer'parameter (MutMsg s) -> Word16 -> m ()
set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
16 Word64
0)
newtype Type'anyPointer'implicitMethodParameter msg
    = Type'anyPointer'implicitMethodParameter'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Type'anyPointer'implicitMethodParameter msg)) where
    fromStruct :: Struct msg -> m (Type'anyPointer'implicitMethodParameter msg)
fromStruct Struct msg
struct = (Type'anyPointer'implicitMethodParameter msg
-> m (Type'anyPointer'implicitMethodParameter msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Type'anyPointer'implicitMethodParameter msg
forall msg.
Struct msg -> Type'anyPointer'implicitMethodParameter msg
Type'anyPointer'implicitMethodParameter'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Type'anyPointer'implicitMethodParameter msg)) where
    toStruct :: Type'anyPointer'implicitMethodParameter msg -> Struct msg
toStruct (Type'anyPointer'implicitMethodParameter'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Type'anyPointer'implicitMethodParameter msg)) where
    type InMessage (Type'anyPointer'implicitMethodParameter msg) = msg
    message :: Type'anyPointer'implicitMethodParameter msg
-> InMessage (Type'anyPointer'implicitMethodParameter msg)
message (Type'anyPointer'implicitMethodParameter'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Type'anyPointer'implicitMethodParameter msg)) where
    messageDefault :: InMessage (Type'anyPointer'implicitMethodParameter msg)
-> Type'anyPointer'implicitMethodParameter msg
messageDefault InMessage (Type'anyPointer'implicitMethodParameter msg)
msg = (Struct msg -> Type'anyPointer'implicitMethodParameter msg
forall msg.
Struct msg -> Type'anyPointer'implicitMethodParameter msg
Type'anyPointer'implicitMethodParameter'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Type'anyPointer'implicitMethodParameter msg)
msg))
get_Type'anyPointer'implicitMethodParameter'parameterIndex :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'implicitMethodParameter msg) -> (m Std_.Word16)
get_Type'anyPointer'implicitMethodParameter'parameterIndex :: Type'anyPointer'implicitMethodParameter msg -> m Word16
get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
16 Word64
0)
set_Type'anyPointer'implicitMethodParameter'parameterIndex :: ((Untyped.RWCtx m s)) => (Type'anyPointer'implicitMethodParameter (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Type'anyPointer'implicitMethodParameter'parameterIndex :: Type'anyPointer'implicitMethodParameter (MutMsg s)
-> Word16 -> m ()
set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
16 Word64
0)
newtype Brand msg
    = Brand'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Brand msg)) where
    fromStruct :: Struct msg -> m (Brand msg)
fromStruct Struct msg
struct = (Brand msg -> m (Brand msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Brand msg
forall msg. Struct msg -> Brand msg
Brand'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Brand msg)) where
    toStruct :: Brand msg -> Struct msg
toStruct (Brand'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Brand msg)) where
    type InMessage (Brand msg) = msg
    message :: Brand msg -> InMessage (Brand msg)
message (Brand'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Brand msg)) where
    messageDefault :: InMessage (Brand msg) -> Brand msg
messageDefault InMessage (Brand msg)
msg = (Struct msg -> Brand msg
forall msg. Struct msg -> Brand msg
Brand'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Brand msg)
msg))
instance (Classes.FromPtr msg (Brand msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Brand msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Brand msg
forall msg. Struct msg -> Brand msg
Brand'newtype_ (Struct msg -> Brand msg) -> m (Struct msg) -> m (Brand msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Brand (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Brand'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Brand (Message.MutMsg s))) where
    new :: MutMsg s -> m (Brand (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Brand (MutMsg s)
forall msg. Struct msg -> Brand msg
Brand'newtype_ (Struct (MutMsg s) -> Brand (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Brand (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
1))
instance (Basics.ListElem msg (Brand msg)) where
    newtype List msg (Brand msg)
        = Brand'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Brand msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Brand msg)
forall msg. ListOf msg (Struct msg) -> List msg (Brand msg)
Brand'List_ (ListOf msg (Struct msg) -> List msg (Brand msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Brand msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Brand msg) -> List msg
toUntypedList (Brand'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Brand msg) -> Int
length (Brand'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Brand msg) -> m (Brand msg)
index Int
i (Brand'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Brand msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Brand (Message.MutMsg s))) where
    setIndex :: Brand (MutMsg s)
-> Int -> List (MutMsg s) (Brand (MutMsg s)) -> m ()
setIndex (Brand'newtype_ Struct (MutMsg s)
elt) Int
i (Brand'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Brand (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Brand (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Brand msg)
Brand'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Brand (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Brand (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
1 Int
len))
get_Brand'scopes :: ((Untyped.ReadCtx m msg)
                    ,(Classes.FromPtr msg (Basics.List msg (Brand'Scope msg)))) => (Brand msg) -> (m (Basics.List msg (Brand'Scope msg)))
get_Brand'scopes :: Brand msg -> m (List msg (Brand'Scope msg))
get_Brand'scopes (Brand'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Brand'Scope msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Brand'scopes :: ((Untyped.RWCtx m s)
                    ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Brand'Scope (Message.MutMsg s))))) => (Brand (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Brand'Scope (Message.MutMsg s))) -> (m ())
set_Brand'scopes :: Brand (MutMsg s)
-> List (MutMsg s) (Brand'Scope (MutMsg s)) -> m ()
set_Brand'scopes (Brand'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Brand'Scope (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Brand'Scope (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Brand'Scope (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Brand'scopes :: ((Untyped.ReadCtx m msg)) => (Brand msg) -> (m Std_.Bool)
has_Brand'scopes :: Brand msg -> m Bool
has_Brand'scopes (Brand'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Brand'scopes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Brand (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Brand'Scope (Message.MutMsg s))))
new_Brand'scopes :: Int
-> Brand (MutMsg s) -> m (List (MutMsg s) (Brand'Scope (MutMsg s)))
new_Brand'scopes Int
len Brand (MutMsg s)
struct = (do
    List (MutMsg s) (Brand'Scope (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Brand'Scope (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (Brand (MutMsg s) -> InMessage (Brand (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Brand (MutMsg s)
struct) Int
len)
    (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 ()
set_Brand'scopes Brand (MutMsg s)
struct List (MutMsg s) (Brand'Scope (MutMsg s))
result)
    (List (MutMsg s) (Brand'Scope (MutMsg s))
-> m (List (MutMsg s) (Brand'Scope (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Brand'Scope (MutMsg s))
result)
    )
newtype Brand'Scope msg
    = Brand'Scope'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Brand'Scope msg)) where
    fromStruct :: Struct msg -> m (Brand'Scope msg)
fromStruct Struct msg
struct = (Brand'Scope msg -> m (Brand'Scope msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Brand'Scope msg
forall msg. Struct msg -> Brand'Scope msg
Brand'Scope'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Brand'Scope msg)) where
    toStruct :: Brand'Scope msg -> Struct msg
toStruct (Brand'Scope'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Brand'Scope msg)) where
    type InMessage (Brand'Scope msg) = msg
    message :: Brand'Scope msg -> InMessage (Brand'Scope msg)
message (Brand'Scope'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Brand'Scope msg)) where
    messageDefault :: InMessage (Brand'Scope msg) -> Brand'Scope msg
messageDefault InMessage (Brand'Scope msg)
msg = (Struct msg -> Brand'Scope msg
forall msg. Struct msg -> Brand'Scope msg
Brand'Scope'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Brand'Scope msg)
msg))
instance (Classes.FromPtr msg (Brand'Scope msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Brand'Scope msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Brand'Scope msg
forall msg. Struct msg -> Brand'Scope msg
Brand'Scope'newtype_ (Struct msg -> Brand'Scope msg)
-> m (Struct msg) -> m (Brand'Scope msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Brand'Scope (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Brand'Scope (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Brand'Scope'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Brand'Scope (Message.MutMsg s))) where
    new :: MutMsg s -> m (Brand'Scope (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Brand'Scope (MutMsg s)
forall msg. Struct msg -> Brand'Scope msg
Brand'Scope'newtype_ (Struct (MutMsg s) -> Brand'Scope (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Brand'Scope (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
2 Word16
1))
instance (Basics.ListElem msg (Brand'Scope msg)) where
    newtype List msg (Brand'Scope msg)
        = Brand'Scope'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Brand'Scope msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Brand'Scope msg)
forall msg. ListOf msg (Struct msg) -> List msg (Brand'Scope msg)
Brand'Scope'List_ (ListOf msg (Struct msg) -> List msg (Brand'Scope msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Brand'Scope msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Brand'Scope msg) -> List msg
toUntypedList (Brand'Scope'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Brand'Scope msg) -> Int
length (Brand'Scope'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Brand'Scope msg) -> m (Brand'Scope msg)
index Int
i (Brand'Scope'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Brand'Scope msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Brand'Scope (Message.MutMsg s))) where
    setIndex :: Brand'Scope (MutMsg s)
-> Int -> List (MutMsg s) (Brand'Scope (MutMsg s)) -> m ()
setIndex (Brand'Scope'newtype_ Struct (MutMsg s)
elt) Int
i (Brand'Scope'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Brand'Scope (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Brand'Scope (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Brand'Scope msg)
Brand'Scope'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Brand'Scope (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Brand'Scope (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
2 Word16
1 Int
len))
get_Brand'Scope'scopeId :: ((Untyped.ReadCtx m msg)) => (Brand'Scope msg) -> (m Std_.Word64)
get_Brand'Scope'scopeId :: Brand'Scope msg -> m Word64
get_Brand'Scope'scopeId (Brand'Scope'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Brand'Scope'scopeId :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Brand'Scope'scopeId :: Brand'Scope (MutMsg s) -> Word64 -> m ()
set_Brand'Scope'scopeId (Brand'Scope'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
data Brand'Scope' msg
    = Brand'Scope'bind (Basics.List msg (Brand'Binding msg))
    | Brand'Scope'inherit 
    | Brand'Scope'unknown' Std_.Word16
instance (Classes.FromStruct msg (Brand'Scope' msg)) where
    fromStruct :: Struct msg -> m (Brand'Scope' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
4)
        case Word16
tag of
            Word16
0 ->
                (List msg (Brand'Binding msg) -> Brand'Scope' msg
forall msg. List msg (Brand'Binding msg) -> Brand'Scope' msg
Brand'Scope'bind (List msg (Brand'Binding msg) -> Brand'Scope' msg)
-> m (List msg (Brand'Binding msg)) -> m (Brand'Scope' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (List msg (Brand'Binding msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
1 ->
                (Brand'Scope' msg -> m (Brand'Scope' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand'Scope' msg
forall msg. Brand'Scope' msg
Brand'Scope'inherit)
            Word16
_ ->
                (Brand'Scope' msg -> m (Brand'Scope' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Brand'Scope' msg
forall msg. Word16 -> Brand'Scope' msg
Brand'Scope'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Brand'Scope' :: ((Untyped.ReadCtx m msg)
                    ,(Classes.FromStruct msg (Brand'Scope' msg))) => (Brand'Scope msg) -> (m (Brand'Scope' msg))
get_Brand'Scope' :: Brand'Scope msg -> m (Brand'Scope' msg)
get_Brand'Scope' (Brand'Scope'newtype_ Struct msg
struct) = (Struct msg -> m (Brand'Scope' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Brand'Scope'bind :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Brand'Binding (Message.MutMsg s))))) => (Brand'Scope (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Brand'Binding (Message.MutMsg s))) -> (m ())
set_Brand'Scope'bind :: Brand'Scope (MutMsg s)
-> List (MutMsg s) (Brand'Binding (MutMsg s)) -> m ()
set_Brand'Scope'bind (Brand'Scope'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Brand'Binding (MutMsg s))
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Brand'Binding (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Brand'Binding (MutMsg s))
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Brand'Scope'inherit :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> (m ())
set_Brand'Scope'inherit :: Brand'Scope (MutMsg s) -> m ()
set_Brand'Scope'inherit (Brand'Scope'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
1 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Brand'Scope'unknown' :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Brand'Scope'unknown' :: Brand'Scope (MutMsg s) -> Word16 -> m ()
set_Brand'Scope'unknown' (Brand'Scope'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
1 Int
0 Word64
0)
newtype Brand'Binding msg
    = Brand'Binding'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Brand'Binding msg)) where
    fromStruct :: Struct msg -> m (Brand'Binding msg)
fromStruct Struct msg
struct = (Brand'Binding msg -> m (Brand'Binding msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Brand'Binding msg
forall msg. Struct msg -> Brand'Binding msg
Brand'Binding'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Brand'Binding msg)) where
    toStruct :: Brand'Binding msg -> Struct msg
toStruct (Brand'Binding'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Brand'Binding msg)) where
    type InMessage (Brand'Binding msg) = msg
    message :: Brand'Binding msg -> InMessage (Brand'Binding msg)
message (Brand'Binding'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Brand'Binding msg)) where
    messageDefault :: InMessage (Brand'Binding msg) -> Brand'Binding msg
messageDefault InMessage (Brand'Binding msg)
msg = (Struct msg -> Brand'Binding msg
forall msg. Struct msg -> Brand'Binding msg
Brand'Binding'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Brand'Binding msg)
msg))
instance (Classes.FromPtr msg (Brand'Binding msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Brand'Binding msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Brand'Binding msg
forall msg. Struct msg -> Brand'Binding msg
Brand'Binding'newtype_ (Struct msg -> Brand'Binding msg)
-> m (Struct msg) -> m (Brand'Binding msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Brand'Binding (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Brand'Binding (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Brand'Binding'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Brand'Binding (Message.MutMsg s))) where
    new :: MutMsg s -> m (Brand'Binding (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Brand'Binding (MutMsg s)
forall msg. Struct msg -> Brand'Binding msg
Brand'Binding'newtype_ (Struct (MutMsg s) -> Brand'Binding (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Brand'Binding (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
1))
instance (Basics.ListElem msg (Brand'Binding msg)) where
    newtype List msg (Brand'Binding msg)
        = Brand'Binding'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Brand'Binding msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Brand'Binding msg)
forall msg. ListOf msg (Struct msg) -> List msg (Brand'Binding msg)
Brand'Binding'List_ (ListOf msg (Struct msg) -> List msg (Brand'Binding msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Brand'Binding msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Brand'Binding msg) -> List msg
toUntypedList (Brand'Binding'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Brand'Binding msg) -> Int
length (Brand'Binding'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Brand'Binding msg) -> m (Brand'Binding msg)
index Int
i (Brand'Binding'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Brand'Binding msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Brand'Binding (Message.MutMsg s))) where
    setIndex :: Brand'Binding (MutMsg s)
-> Int -> List (MutMsg s) (Brand'Binding (MutMsg s)) -> m ()
setIndex (Brand'Binding'newtype_ Struct (MutMsg s)
elt) Int
i (Brand'Binding'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Brand'Binding (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Brand'Binding (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Brand'Binding msg)
Brand'Binding'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Brand'Binding (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Brand'Binding (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
1 Int
len))
data Brand'Binding' msg
    = Brand'Binding'unbound 
    | Brand'Binding'type_ (Type msg)
    | Brand'Binding'unknown' Std_.Word16
instance (Classes.FromStruct msg (Brand'Binding' msg)) where
    fromStruct :: Struct msg -> m (Brand'Binding' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
0)
        case Word16
tag of
            Word16
0 ->
                (Brand'Binding' msg -> m (Brand'Binding' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand'Binding' msg
forall msg. Brand'Binding' msg
Brand'Binding'unbound)
            Word16
1 ->
                (Type msg -> Brand'Binding' msg
forall msg. Type msg -> Brand'Binding' msg
Brand'Binding'type_ (Type msg -> Brand'Binding' msg)
-> m (Type msg) -> m (Brand'Binding' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Type msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
_ ->
                (Brand'Binding' msg -> m (Brand'Binding' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Brand'Binding' msg
forall msg. Word16 -> Brand'Binding' msg
Brand'Binding'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Brand'Binding' :: ((Untyped.ReadCtx m msg)
                      ,(Classes.FromStruct msg (Brand'Binding' msg))) => (Brand'Binding msg) -> (m (Brand'Binding' msg))
get_Brand'Binding' :: Brand'Binding msg -> m (Brand'Binding' msg)
get_Brand'Binding' (Brand'Binding'newtype_ Struct msg
struct) = (Struct msg -> m (Brand'Binding' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Brand'Binding'unbound :: ((Untyped.RWCtx m s)) => (Brand'Binding (Message.MutMsg s)) -> (m ())
set_Brand'Binding'unbound :: Brand'Binding (MutMsg s) -> m ()
set_Brand'Binding'unbound (Brand'Binding'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Brand'Binding'type_ :: ((Untyped.RWCtx m s)
                           ,(Classes.ToPtr s (Type (Message.MutMsg s)))) => (Brand'Binding (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
set_Brand'Binding'type_ :: Brand'Binding (MutMsg s) -> Type (MutMsg s) -> m ()
set_Brand'Binding'type_ (Brand'Binding'newtype_ Struct (MutMsg s)
struct) Type (MutMsg s)
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Type (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Type (MutMsg s)
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Brand'Binding'unknown' :: ((Untyped.RWCtx m s)) => (Brand'Binding (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Brand'Binding'unknown' :: Brand'Binding (MutMsg s) -> Word16 -> m ()
set_Brand'Binding'unknown' (Brand'Binding'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
newtype Value msg
    = Value'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Value msg)) where
    fromStruct :: Struct msg -> m (Value msg)
fromStruct Struct msg
struct = (Value msg -> m (Value msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Value msg
forall msg. Struct msg -> Value msg
Value'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Value msg)) where
    toStruct :: Value msg -> Struct msg
toStruct (Value'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Value msg)) where
    type InMessage (Value msg) = msg
    message :: Value msg -> InMessage (Value msg)
message (Value'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Value msg)) where
    messageDefault :: InMessage (Value msg) -> Value msg
messageDefault InMessage (Value msg)
msg = (Struct msg -> Value msg
forall msg. Struct msg -> Value msg
Value'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Value msg)
msg))
instance (Classes.FromPtr msg (Value msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Value msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Value msg
forall msg. Struct msg -> Value msg
Value'newtype_ (Struct msg -> Value msg) -> m (Struct msg) -> m (Value msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Value (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Value (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Value'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Value (Message.MutMsg s))) where
    new :: MutMsg s -> m (Value (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Value (MutMsg s)
forall msg. Struct msg -> Value msg
Value'newtype_ (Struct (MutMsg s) -> Value (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Value (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
2 Word16
1))
instance (Basics.ListElem msg (Value msg)) where
    newtype List msg (Value msg)
        = Value'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Value msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Value msg)
forall msg. ListOf msg (Struct msg) -> List msg (Value msg)
Value'List_ (ListOf msg (Struct msg) -> List msg (Value msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Value msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Value msg) -> List msg
toUntypedList (Value'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Value msg) -> Int
length (Value'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Value msg) -> m (Value msg)
index Int
i (Value'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Value msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Value (Message.MutMsg s))) where
    setIndex :: Value (MutMsg s)
-> Int -> List (MutMsg s) (Value (MutMsg s)) -> m ()
setIndex (Value'newtype_ Struct (MutMsg s)
elt) Int
i (Value'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Value (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Value (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Value msg)
Value'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Value (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Value (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
2 Word16
1 Int
len))
data Value' msg
    = 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 (Basics.Text msg)
    | Value'data_ (Basics.Data msg)
    | Value'list (Std_.Maybe (Untyped.Ptr msg))
    | Value'enum Std_.Word16
    | Value'struct (Std_.Maybe (Untyped.Ptr msg))
    | Value'interface 
    | Value'anyPointer (Std_.Maybe (Untyped.Ptr msg))
    | Value'unknown' Std_.Word16
instance (Classes.FromStruct msg (Value' msg)) where
    fromStruct :: Struct msg -> m (Value' msg)
fromStruct Struct msg
struct = (do
        Word16
tag <- (Struct msg -> Int -> m Word16
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> Int -> m Word16
GenHelpers.getTag Struct msg
struct Int
0)
        case Word16
tag of
            Word16
0 ->
                (Value' msg -> m (Value' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value' msg
forall msg. Value' msg
Value'void)
            Word16
1 ->
                (Bool -> Value' msg
forall msg. Bool -> Value' msg
Value'bool (Bool -> Value' msg) -> m Bool -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Bool
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
2 ->
                (Int8 -> Value' msg
forall msg. Int8 -> Value' msg
Value'int8 (Int8 -> Value' msg) -> m Int8 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Int8
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
3 ->
                (Int16 -> Value' msg
forall msg. Int16 -> Value' msg
Value'int16 (Int16 -> Value' msg) -> m Int16 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Int16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
4 ->
                (Int32 -> Value' msg
forall msg. Int32 -> Value' msg
Value'int32 (Int32 -> Value' msg) -> m Int32 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Int32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0))
            Word16
5 ->
                (Int64 -> Value' msg
forall msg. Int64 -> Value' msg
Value'int64 (Int64 -> Value' msg) -> m Int64 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Int64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0))
            Word16
6 ->
                (Word8 -> Value' msg
forall msg. Word8 -> Value' msg
Value'uint8 (Word8 -> Value' msg) -> m Word8 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word8
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
7 ->
                (Word16 -> Value' msg
forall msg. Word16 -> Value' msg
Value'uint16 (Word16 -> Value' msg) -> m Word16 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
8 ->
                (Word32 -> Value' msg
forall msg. Word32 -> Value' msg
Value'uint32 (Word32 -> Value' msg) -> m Word32 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word32
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0))
            Word16
9 ->
                (Word64 -> Value' msg
forall msg. Word64 -> Value' msg
Value'uint64 (Word64 -> Value' msg) -> m Word64 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0))
            Word16
10 ->
                (Float -> Value' msg
forall msg. Float -> Value' msg
Value'float32 (Float -> Value' msg) -> m Float -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Float
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
32 Word64
0))
            Word16
11 ->
                (Double -> Value' msg
forall msg. Double -> Value' msg
Value'float64 (Double -> Value' msg) -> m Double -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Double
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
1 Int
0 Word64
0))
            Word16
12 ->
                (Text msg -> Value' msg
forall msg. Text msg -> Value' msg
Value'text (Text msg -> Value' msg) -> m (Text msg) -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
13 ->
                (Data msg -> Value' msg
forall msg. Data msg -> Value' msg
Value'data_ (Data msg -> Value' msg) -> m (Data msg) -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Data msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
14 ->
                (Maybe (Ptr msg) -> Value' msg
forall msg. Maybe (Ptr msg) -> Value' msg
Value'list (Maybe (Ptr msg) -> Value' msg)
-> m (Maybe (Ptr msg)) -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
15 ->
                (Word16 -> Value' msg
forall msg. Word16 -> Value' msg
Value'enum (Word16 -> Value' msg) -> m Word16 -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0))
            Word16
16 ->
                (Maybe (Ptr msg) -> Value' msg
forall msg. Maybe (Ptr msg) -> Value' msg
Value'struct (Maybe (Ptr msg) -> Value' msg)
-> m (Maybe (Ptr msg)) -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
17 ->
                (Value' msg -> m (Value' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value' msg
forall msg. Value' msg
Value'interface)
            Word16
18 ->
                (Maybe (Ptr msg) -> Value' msg
forall msg. Maybe (Ptr msg) -> Value' msg
Value'anyPointer (Maybe (Ptr msg) -> Value' msg)
-> m (Maybe (Ptr msg)) -> m (Value' msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
                    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
                    (msg -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
                    ))
            Word16
_ ->
                (Value' msg -> m (Value' msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Word16 -> Value' msg
forall msg. Word16 -> Value' msg
Value'unknown' (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)))
        )
get_Value' :: ((Untyped.ReadCtx m msg)
              ,(Classes.FromStruct msg (Value' msg))) => (Value msg) -> (m (Value' msg))
get_Value' :: Value msg -> m (Value' msg)
get_Value' (Value'newtype_ Struct msg
struct) = (Struct msg -> m (Value' msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
struct)
set_Value'void :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (m ())
set_Value'void :: Value (MutMsg s) -> m ()
set_Value'void (Value'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
0 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Value'bool :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Value'bool :: Value (MutMsg s) -> Bool -> m ()
set_Value'bool (Value'newtype_ Struct (MutMsg s)
struct) Bool
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
1 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word1 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word1
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Bool -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Bool
value)) :: Std_.Word1) Int
0 Int
16 Word64
0)
    )
set_Value'int8 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int8 -> (m ())
set_Value'int8 :: Value (MutMsg s) -> Int8 -> m ()
set_Value'int8 (Value'newtype_ Struct (MutMsg s)
struct) Int8
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
2 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word8 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Int8 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Int8
value)) :: Std_.Word8) Int
0 Int
16 Word64
0)
    )
set_Value'int16 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_Value'int16 :: Value (MutMsg s) -> Int16 -> m ()
set_Value'int16 (Value'newtype_ Struct (MutMsg s)
struct) Int16
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
3 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Int16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Int16
value)) :: Std_.Word16) Int
0 Int
16 Word64
0)
    )
set_Value'int32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_Value'int32 :: Value (MutMsg s) -> Int32 -> m ()
set_Value'int32 (Value'newtype_ Struct (MutMsg s)
struct) Int32
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
4 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Int32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Int32
value)) :: Std_.Word32) Int
0 Int
32 Word64
0)
    )
set_Value'int64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_Value'int64 :: Value (MutMsg s) -> Int64 -> m ()
set_Value'int64 (Value'newtype_ Struct (MutMsg s)
struct) Int64
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
5 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Int64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Int64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
    )
set_Value'uint8 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_Value'uint8 :: Value (MutMsg s) -> Word8 -> m ()
set_Value'uint8 (Value'newtype_ Struct (MutMsg s)
struct) Word8
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
6 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word8 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word8 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word8
value)) :: Std_.Word8) Int
0 Int
16 Word64
0)
    )
set_Value'uint16 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Value'uint16 :: Value (MutMsg s) -> Word16 -> m ()
set_Value'uint16 (Value'newtype_ Struct (MutMsg s)
struct) Word16
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
7 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
16 Word64
0)
    )
set_Value'uint32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Value'uint32 :: Value (MutMsg s) -> Word32 -> m ()
set_Value'uint32 (Value'newtype_ Struct (MutMsg s)
struct) Word32
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
8 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word32 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word32
value)) :: Std_.Word32) Int
0 Int
32 Word64
0)
    )
set_Value'uint64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Value'uint64 :: Value (MutMsg s) -> Word64 -> m ()
set_Value'uint64 (Value'newtype_ Struct (MutMsg s)
struct) Word64
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
9 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
    )
set_Value'float32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Float -> (m ())
set_Value'float32 :: Value (MutMsg s) -> Float -> m ()
set_Value'float32 (Value'newtype_ Struct (MutMsg s)
struct) Float
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
10 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word32 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Float -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Float
value)) :: Std_.Word32) Int
0 Int
32 Word64
0)
    )
set_Value'float64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Double -> (m ())
set_Value'float64 :: Value (MutMsg s) -> Double -> m ()
set_Value'float64 (Value'newtype_ Struct (MutMsg s)
struct) Double
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
11 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Double -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Double
value)) :: Std_.Word64) Int
1 Int
0 Word64
0)
    )
set_Value'text :: ((Untyped.RWCtx m s)
                  ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (Value (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Value'text :: Value (MutMsg s) -> Text (MutMsg s) -> m ()
set_Value'text (Value'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
12 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Value'data_ :: ((Untyped.RWCtx m s)
                   ,(Classes.ToPtr s (Basics.Data (Message.MutMsg s)))) => (Value (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
set_Value'data_ :: Value (MutMsg s) -> Data (MutMsg s) -> m ()
set_Value'data_ (Value'newtype_ Struct (MutMsg s)
struct) Data (MutMsg s)
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
13 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Data (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Data (MutMsg s)
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Value'list :: ((Untyped.RWCtx m s)
                  ,(Classes.ToPtr s (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))))) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
set_Value'list :: Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
set_Value'list (Value'newtype_ Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
14 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Value'enum :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Value'enum :: Value (MutMsg s) -> Word16 -> m ()
set_Value'enum (Value'newtype_ Struct (MutMsg s)
struct) Word16
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
15 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
16 Word64
0)
    )
set_Value'struct :: ((Untyped.RWCtx m s)
                    ,(Classes.ToPtr s (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))))) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
set_Value'struct :: Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
set_Value'struct (Value'newtype_ Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
16 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Value'interface :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (m ())
set_Value'interface :: Value (MutMsg s) -> m ()
set_Value'interface (Value'newtype_ Struct (MutMsg s)
struct) = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
17 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure ())
    )
set_Value'anyPointer :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))))) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
set_Value'anyPointer :: Value (MutMsg s) -> Maybe (Ptr (MutMsg s)) -> m ()
set_Value'anyPointer (Value'newtype_ Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value = (do
    (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct (Word16
18 :: Std_.Word16) Int
0 Int
0 Word64
0)
    (do
        Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Maybe (Ptr (MutMsg s))
value)
        (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
        )
    )
set_Value'unknown' :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Value'unknown' :: Value (MutMsg s) -> Word16 -> m ()
set_Value'unknown' (Value'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
newtype Annotation msg
    = Annotation'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (Annotation msg)) where
    fromStruct :: Struct msg -> m (Annotation msg)
fromStruct Struct msg
struct = (Annotation msg -> m (Annotation msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> Annotation msg
forall msg. Struct msg -> Annotation msg
Annotation'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (Annotation msg)) where
    toStruct :: Annotation msg -> Struct msg
toStruct (Annotation'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (Annotation msg)) where
    type InMessage (Annotation msg) = msg
    message :: Annotation msg -> InMessage (Annotation msg)
message (Annotation'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (Annotation msg)) where
    messageDefault :: InMessage (Annotation msg) -> Annotation msg
messageDefault InMessage (Annotation msg)
msg = (Struct msg -> Annotation msg
forall msg. Struct msg -> Annotation msg
Annotation'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (Annotation msg)
msg))
instance (Classes.FromPtr msg (Annotation msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Annotation msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> Annotation msg
forall msg. Struct msg -> Annotation msg
Annotation'newtype_ (Struct msg -> Annotation msg)
-> m (Struct msg) -> m (Annotation msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (Annotation (Message.MutMsg s))) where
    toPtr :: MutMsg s -> Annotation (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Annotation'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (Annotation (Message.MutMsg s))) where
    new :: MutMsg s -> m (Annotation (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> Annotation (MutMsg s)
forall msg. Struct msg -> Annotation msg
Annotation'newtype_ (Struct (MutMsg s) -> Annotation (MutMsg s))
-> m (Struct (MutMsg s)) -> m (Annotation (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
2))
instance (Basics.ListElem msg (Annotation msg)) where
    newtype List msg (Annotation msg)
        = Annotation'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Annotation msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (Annotation msg)
forall msg. ListOf msg (Struct msg) -> List msg (Annotation msg)
Annotation'List_ (ListOf msg (Struct msg) -> List msg (Annotation msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (Annotation msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (Annotation msg) -> List msg
toUntypedList (Annotation'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (Annotation msg) -> Int
length (Annotation'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (Annotation msg) -> m (Annotation msg)
index Int
i (Annotation'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (Annotation msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (Annotation (Message.MutMsg s))) where
    setIndex :: Annotation (MutMsg s)
-> Int -> List (MutMsg s) (Annotation (MutMsg s)) -> m ()
setIndex (Annotation'newtype_ Struct (MutMsg s)
elt) Int
i (Annotation'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Annotation (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (Annotation (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (Annotation msg)
Annotation'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (Annotation (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (Annotation (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
2 Int
len))
get_Annotation'id :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Word64)
get_Annotation'id :: Annotation msg -> m Word64
get_Annotation'id (Annotation'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_Annotation'id :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Annotation'id :: Annotation (MutMsg s) -> Word64 -> m ()
set_Annotation'id (Annotation'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_Annotation'value :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Value msg))) => (Annotation msg) -> (m (Value msg))
get_Annotation'value :: Annotation msg -> m (Value msg)
get_Annotation'value (Annotation'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Value msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Annotation'value :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Value (Message.MutMsg s)))) => (Annotation (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
set_Annotation'value :: Annotation (MutMsg s) -> Value (MutMsg s) -> m ()
set_Annotation'value (Annotation'newtype_ Struct (MutMsg s)
struct) Value (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Value (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Value (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_Annotation'value :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Bool)
has_Annotation'value :: Annotation msg -> m Bool
has_Annotation'value (Annotation'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_Annotation'value :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
new_Annotation'value :: Annotation (MutMsg s) -> m (Value (MutMsg s))
new_Annotation'value Annotation (MutMsg s)
struct = (do
    Value (MutMsg s)
result <- (MutMsg s -> m (Value (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Annotation (MutMsg s) -> InMessage (Annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Annotation (MutMsg s)
struct))
    (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 ()
set_Annotation'value Annotation (MutMsg s)
struct Value (MutMsg s)
result)
    (Value (MutMsg s) -> m (Value (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Value (MutMsg s)
result)
    )
get_Annotation'brand :: ((Untyped.ReadCtx m msg)
                        ,(Classes.FromPtr msg (Brand msg))) => (Annotation msg) -> (m (Brand msg))
get_Annotation'brand :: Annotation msg -> m (Brand msg)
get_Annotation'brand (Annotation'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Brand msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_Annotation'brand :: ((Untyped.RWCtx m s)
                        ,(Classes.ToPtr s (Brand (Message.MutMsg s)))) => (Annotation (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
set_Annotation'brand :: Annotation (MutMsg s) -> Brand (MutMsg s) -> m ()
set_Annotation'brand (Annotation'newtype_ Struct (MutMsg s)
struct) Brand (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Brand (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Brand (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_Annotation'brand :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Bool)
has_Annotation'brand :: Annotation msg -> m Bool
has_Annotation'brand (Annotation'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_Annotation'brand :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
new_Annotation'brand :: Annotation (MutMsg s) -> m (Brand (MutMsg s))
new_Annotation'brand Annotation (MutMsg s)
struct = (do
    Brand (MutMsg s)
result <- (MutMsg s -> m (Brand (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (Annotation (MutMsg s) -> InMessage (Annotation (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Annotation (MutMsg s)
struct))
    (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 ()
set_Annotation'brand Annotation (MutMsg s)
struct Brand (MutMsg s)
result)
    (Brand (MutMsg s) -> m (Brand (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Brand (MutMsg s)
result)
    )
data ElementSize 
    = ElementSize'empty 
    | ElementSize'bit 
    | ElementSize'byte 
    | ElementSize'twoBytes 
    | ElementSize'fourBytes 
    | ElementSize'eightBytes 
    | ElementSize'pointer 
    | ElementSize'inlineComposite 
    | ElementSize'unknown' Std_.Word16
    deriving(Int -> ElementSize -> ShowS
[ElementSize] -> ShowS
ElementSize -> String
(Int -> ElementSize -> ShowS)
-> (ElementSize -> String)
-> ([ElementSize] -> ShowS)
-> Show ElementSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementSize] -> ShowS
$cshowList :: [ElementSize] -> ShowS
show :: ElementSize -> String
$cshow :: ElementSize -> String
showsPrec :: Int -> ElementSize -> ShowS
$cshowsPrec :: Int -> ElementSize -> ShowS
Std_.Show
            ,ReadPrec [ElementSize]
ReadPrec ElementSize
Int -> ReadS ElementSize
ReadS [ElementSize]
(Int -> ReadS ElementSize)
-> ReadS [ElementSize]
-> ReadPrec ElementSize
-> ReadPrec [ElementSize]
-> Read ElementSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ElementSize]
$creadListPrec :: ReadPrec [ElementSize]
readPrec :: ReadPrec ElementSize
$creadPrec :: ReadPrec ElementSize
readList :: ReadS [ElementSize]
$creadList :: ReadS [ElementSize]
readsPrec :: Int -> ReadS ElementSize
$creadsPrec :: Int -> ReadS ElementSize
Std_.Read
            ,ElementSize -> ElementSize -> Bool
(ElementSize -> ElementSize -> Bool)
-> (ElementSize -> ElementSize -> Bool) -> Eq ElementSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementSize -> ElementSize -> Bool
$c/= :: ElementSize -> ElementSize -> Bool
== :: ElementSize -> ElementSize -> Bool
$c== :: ElementSize -> ElementSize -> Bool
Std_.Eq
            ,(forall x. ElementSize -> Rep ElementSize x)
-> (forall x. Rep ElementSize x -> ElementSize)
-> Generic ElementSize
forall x. Rep ElementSize x -> ElementSize
forall x. ElementSize -> Rep ElementSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElementSize x -> ElementSize
$cfrom :: forall x. ElementSize -> Rep ElementSize x
Generics.Generic)
instance (Classes.IsWord ElementSize) where
    fromWord :: Word64 -> ElementSize
fromWord Word64
n = case ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word64
n) :: Std_.Word16) of
        Word16
0 ->
            ElementSize
ElementSize'empty
        Word16
1 ->
            ElementSize
ElementSize'bit
        Word16
2 ->
            ElementSize
ElementSize'byte
        Word16
3 ->
            ElementSize
ElementSize'twoBytes
        Word16
4 ->
            ElementSize
ElementSize'fourBytes
        Word16
5 ->
            ElementSize
ElementSize'eightBytes
        Word16
6 ->
            ElementSize
ElementSize'pointer
        Word16
7 ->
            ElementSize
ElementSize'inlineComposite
        Word16
tag ->
            (Word16 -> ElementSize
ElementSize'unknown' Word16
tag)
    toWord :: ElementSize -> Word64
toWord (ElementSize
ElementSize'empty) = Word64
0
    toWord (ElementSize
ElementSize'bit) = Word64
1
    toWord (ElementSize
ElementSize'byte) = Word64
2
    toWord (ElementSize
ElementSize'twoBytes) = Word64
3
    toWord (ElementSize
ElementSize'fourBytes) = Word64
4
    toWord (ElementSize
ElementSize'eightBytes) = Word64
5
    toWord (ElementSize
ElementSize'pointer) = Word64
6
    toWord (ElementSize
ElementSize'inlineComposite) = Word64
7
    toWord (ElementSize'unknown' Word16
tag) = (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Word16
tag)
instance (Std_.Enum ElementSize) where
    fromEnum :: ElementSize -> Int
fromEnum ElementSize
x = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (ElementSize -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord ElementSize
x))
    toEnum :: Int -> ElementSize
toEnum Int
x = (Word64 -> ElementSize
forall a. IsWord a => Word64 -> a
Classes.fromWord (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral Int
x))
instance (Basics.ListElem msg ElementSize) where
    newtype List msg ElementSize
        = ElementSize'List_ (Untyped.ListOf msg Std_.Word16)
    index :: Int -> List msg ElementSize -> m ElementSize
index Int
i (ElementSize'List_ l) = (Word64 -> ElementSize
forall a. IsWord a => Word64 -> a
Classes.fromWord (Word64 -> ElementSize) -> m Word64 -> m ElementSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64) -> m Word16 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ListOf msg Word16 -> m Word16
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg Word16
l)))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg ElementSize)
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg Word16 -> List msg ElementSize
forall msg. ListOf msg Word16 -> List msg ElementSize
ElementSize'List_ (ListOf msg Word16 -> List msg ElementSize)
-> m (ListOf msg Word16) -> m (List msg ElementSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg Word16)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg ElementSize -> List msg
toUntypedList (ElementSize'List_ l) = (ListOf msg Word16 -> List msg
forall msg. ListOf msg Word16 -> List msg
Untyped.List16 ListOf msg Word16
l)
    length :: List msg ElementSize -> Int
length (ElementSize'List_ l) = (ListOf msg Word16 -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg Word16
l)
instance (Classes.MutListElem s ElementSize) where
    setIndex :: ElementSize -> Int -> List (MutMsg s) ElementSize -> m ()
setIndex ElementSize
elt Int
i (ElementSize'List_ l) = (Word16 -> Int -> ListOf (MutMsg s) Word16 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (ElementSize -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord ElementSize
elt)) Int
i ListOf (MutMsg s) Word16
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) ElementSize)
newList MutMsg s
msg Int
size = (ListOf (MutMsg s) Word16 -> List (MutMsg s) ElementSize
forall msg. ListOf msg Word16 -> List msg ElementSize
ElementSize'List_ (ListOf (MutMsg s) Word16 -> List (MutMsg s) ElementSize)
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s) ElementSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
Untyped.allocList16 MutMsg s
msg Int
size))
newtype CapnpVersion msg
    = CapnpVersion'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (CapnpVersion msg)) where
    fromStruct :: Struct msg -> m (CapnpVersion msg)
fromStruct Struct msg
struct = (CapnpVersion msg -> m (CapnpVersion msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> CapnpVersion msg
forall msg. Struct msg -> CapnpVersion msg
CapnpVersion'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (CapnpVersion msg)) where
    toStruct :: CapnpVersion msg -> Struct msg
toStruct (CapnpVersion'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (CapnpVersion msg)) where
    type InMessage (CapnpVersion msg) = msg
    message :: CapnpVersion msg -> InMessage (CapnpVersion msg)
message (CapnpVersion'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (CapnpVersion msg)) where
    messageDefault :: InMessage (CapnpVersion msg) -> CapnpVersion msg
messageDefault InMessage (CapnpVersion msg)
msg = (Struct msg -> CapnpVersion msg
forall msg. Struct msg -> CapnpVersion msg
CapnpVersion'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (CapnpVersion msg)
msg))
instance (Classes.FromPtr msg (CapnpVersion msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (CapnpVersion msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> CapnpVersion msg
forall msg. Struct msg -> CapnpVersion msg
CapnpVersion'newtype_ (Struct msg -> CapnpVersion msg)
-> m (Struct msg) -> m (CapnpVersion msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (CapnpVersion (Message.MutMsg s))) where
    toPtr :: MutMsg s -> CapnpVersion (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (CapnpVersion'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (CapnpVersion (Message.MutMsg s))) where
    new :: MutMsg s -> m (CapnpVersion (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> CapnpVersion (MutMsg s)
forall msg. Struct msg -> CapnpVersion msg
CapnpVersion'newtype_ (Struct (MutMsg s) -> CapnpVersion (MutMsg s))
-> m (Struct (MutMsg s)) -> m (CapnpVersion (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
0))
instance (Basics.ListElem msg (CapnpVersion msg)) where
    newtype List msg (CapnpVersion msg)
        = CapnpVersion'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (CapnpVersion msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (CapnpVersion msg)
forall msg. ListOf msg (Struct msg) -> List msg (CapnpVersion msg)
CapnpVersion'List_ (ListOf msg (Struct msg) -> List msg (CapnpVersion msg))
-> m (ListOf msg (Struct msg)) -> m (List msg (CapnpVersion msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (CapnpVersion msg) -> List msg
toUntypedList (CapnpVersion'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (CapnpVersion msg) -> Int
length (CapnpVersion'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int -> List msg (CapnpVersion msg) -> m (CapnpVersion msg)
index Int
i (CapnpVersion'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (CapnpVersion msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (CapnpVersion (Message.MutMsg s))) where
    setIndex :: CapnpVersion (MutMsg s)
-> Int -> List (MutMsg s) (CapnpVersion (MutMsg s)) -> m ()
setIndex (CapnpVersion'newtype_ Struct (MutMsg s)
elt) Int
i (CapnpVersion'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (CapnpVersion (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (CapnpVersion (MutMsg s))
forall msg. ListOf msg (Struct msg) -> List msg (CapnpVersion msg)
CapnpVersion'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (CapnpVersion (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (CapnpVersion (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
0 Int
len))
get_CapnpVersion'major :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word16)
get_CapnpVersion'major :: CapnpVersion msg -> m Word16
get_CapnpVersion'major (CapnpVersion'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word16
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_CapnpVersion'major :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_CapnpVersion'major :: CapnpVersion (MutMsg s) -> Word16 -> m ()
set_CapnpVersion'major (CapnpVersion'newtype_ Struct (MutMsg s)
struct) Word16
value = (Struct (MutMsg s) -> Word16 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word16 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word16
value)) :: Std_.Word16) Int
0 Int
0 Word64
0)
get_CapnpVersion'minor :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word8)
get_CapnpVersion'minor :: CapnpVersion msg -> m Word8
get_CapnpVersion'minor (CapnpVersion'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word8
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
16 Word64
0)
set_CapnpVersion'minor :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_CapnpVersion'minor :: CapnpVersion (MutMsg s) -> Word8 -> m ()
set_CapnpVersion'minor (CapnpVersion'newtype_ Struct (MutMsg s)
struct) Word8
value = (Struct (MutMsg s) -> Word8 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word8 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word8
value)) :: Std_.Word8) Int
0 Int
16 Word64
0)
get_CapnpVersion'micro :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word8)
get_CapnpVersion'micro :: CapnpVersion msg -> m Word8
get_CapnpVersion'micro (CapnpVersion'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word8
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
24 Word64
0)
set_CapnpVersion'micro :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_CapnpVersion'micro :: CapnpVersion (MutMsg s) -> Word8 -> m ()
set_CapnpVersion'micro (CapnpVersion'newtype_ Struct (MutMsg s)
struct) Word8
value = (Struct (MutMsg s) -> Word8 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word8 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word8
value)) :: Std_.Word8) Int
0 Int
24 Word64
0)
newtype CodeGeneratorRequest msg
    = CodeGeneratorRequest'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (CodeGeneratorRequest msg)) where
    fromStruct :: Struct msg -> m (CodeGeneratorRequest msg)
fromStruct Struct msg
struct = (CodeGeneratorRequest msg -> m (CodeGeneratorRequest msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> CodeGeneratorRequest msg
forall msg. Struct msg -> CodeGeneratorRequest msg
CodeGeneratorRequest'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (CodeGeneratorRequest msg)) where
    toStruct :: CodeGeneratorRequest msg -> Struct msg
toStruct (CodeGeneratorRequest'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (CodeGeneratorRequest msg)) where
    type InMessage (CodeGeneratorRequest msg) = msg
    message :: CodeGeneratorRequest msg -> InMessage (CodeGeneratorRequest msg)
message (CodeGeneratorRequest'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (CodeGeneratorRequest msg)) where
    messageDefault :: InMessage (CodeGeneratorRequest msg) -> CodeGeneratorRequest msg
messageDefault InMessage (CodeGeneratorRequest msg)
msg = (Struct msg -> CodeGeneratorRequest msg
forall msg. Struct msg -> CodeGeneratorRequest msg
CodeGeneratorRequest'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (CodeGeneratorRequest msg)
msg))
instance (Classes.FromPtr msg (CodeGeneratorRequest msg)) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (CodeGeneratorRequest msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> CodeGeneratorRequest msg
forall msg. Struct msg -> CodeGeneratorRequest msg
CodeGeneratorRequest'newtype_ (Struct msg -> CodeGeneratorRequest msg)
-> m (Struct msg) -> m (CodeGeneratorRequest msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (CodeGeneratorRequest (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> CodeGeneratorRequest (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (CodeGeneratorRequest (Message.MutMsg s))) where
    new :: MutMsg s -> m (CodeGeneratorRequest (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> CodeGeneratorRequest (MutMsg s)
forall msg. Struct msg -> CodeGeneratorRequest msg
CodeGeneratorRequest'newtype_ (Struct (MutMsg s) -> CodeGeneratorRequest (MutMsg s))
-> m (Struct (MutMsg s)) -> m (CodeGeneratorRequest (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
0 Word16
4))
instance (Basics.ListElem msg (CodeGeneratorRequest msg)) where
    newtype List msg (CodeGeneratorRequest msg)
        = CodeGeneratorRequest'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (CodeGeneratorRequest msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg) -> List msg (CodeGeneratorRequest msg)
forall msg.
ListOf msg (Struct msg) -> List msg (CodeGeneratorRequest msg)
CodeGeneratorRequest'List_ (ListOf msg (Struct msg) -> List msg (CodeGeneratorRequest msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (CodeGeneratorRequest msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (CodeGeneratorRequest msg) -> List msg
toUntypedList (CodeGeneratorRequest'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (CodeGeneratorRequest msg) -> Int
length (CodeGeneratorRequest'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int
-> List msg (CodeGeneratorRequest msg)
-> m (CodeGeneratorRequest msg)
index Int
i (CodeGeneratorRequest'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (CodeGeneratorRequest msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (CodeGeneratorRequest (Message.MutMsg s))) where
    setIndex :: CodeGeneratorRequest (MutMsg s)
-> Int -> List (MutMsg s) (CodeGeneratorRequest (MutMsg s)) -> m ()
setIndex (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
elt) Int
i (CodeGeneratorRequest'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s
-> Int -> m (List (MutMsg s) (CodeGeneratorRequest (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (CodeGeneratorRequest (MutMsg s))
forall msg.
ListOf msg (Struct msg) -> List msg (CodeGeneratorRequest msg)
CodeGeneratorRequest'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (CodeGeneratorRequest (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List (MutMsg s) (CodeGeneratorRequest (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
0 Word16
4 Int
len))
get_CodeGeneratorRequest'nodes :: ((Untyped.ReadCtx m msg)
                                  ,(Classes.FromPtr msg (Basics.List msg (Node msg)))) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (Node msg)))
get_CodeGeneratorRequest'nodes :: CodeGeneratorRequest msg -> m (List msg (Node msg))
get_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'nodes :: ((Untyped.RWCtx m s)
                                  ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node (Message.MutMsg s))))) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node (Message.MutMsg s))) -> (m ())
set_CodeGeneratorRequest'nodes :: CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node (MutMsg s)) -> m ()
set_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'nodes :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'nodes :: CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_CodeGeneratorRequest'nodes :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node (Message.MutMsg s))))
new_CodeGeneratorRequest'nodes :: Int
-> CodeGeneratorRequest (MutMsg s)
-> m (List (MutMsg s) (Node (MutMsg s)))
new_CodeGeneratorRequest'nodes Int
len CodeGeneratorRequest (MutMsg s)
struct = (do
    List (MutMsg s) (Node (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Node (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'nodes CodeGeneratorRequest (MutMsg s)
struct List (MutMsg s) (Node (MutMsg s))
result)
    (List (MutMsg s) (Node (MutMsg s))
-> m (List (MutMsg s) (Node (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node (MutMsg s))
result)
    )
get_CodeGeneratorRequest'requestedFiles :: ((Untyped.ReadCtx m msg)
                                           ,(Classes.FromPtr msg (Basics.List msg (CodeGeneratorRequest'RequestedFile msg)))) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (CodeGeneratorRequest'RequestedFile msg)))
get_CodeGeneratorRequest'requestedFiles :: CodeGeneratorRequest msg
-> m (List msg (CodeGeneratorRequest'RequestedFile msg))
get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg
-> Maybe (Ptr msg)
-> m (List msg (CodeGeneratorRequest'RequestedFile msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'requestedFiles :: ((Untyped.RWCtx m s)
                                           ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))))) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) -> (m ())
set_CodeGeneratorRequest'requestedFiles :: CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m ()
set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'requestedFiles :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'requestedFiles :: CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_CodeGeneratorRequest'requestedFiles :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))))
new_CodeGeneratorRequest'requestedFiles :: Int
-> CodeGeneratorRequest (MutMsg s)
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
new_CodeGeneratorRequest'requestedFiles Int
len CodeGeneratorRequest (MutMsg s)
struct = (do
    List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
result <- (MutMsg s
-> Int
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'requestedFiles CodeGeneratorRequest (MutMsg s)
struct List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
result)
    (List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
result)
    )
get_CodeGeneratorRequest'capnpVersion :: ((Untyped.ReadCtx m msg)
                                         ,(Classes.FromPtr msg (CapnpVersion msg))) => (CodeGeneratorRequest msg) -> (m (CapnpVersion msg))
get_CodeGeneratorRequest'capnpVersion :: CodeGeneratorRequest msg -> m (CapnpVersion msg)
get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (CapnpVersion msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'capnpVersion :: ((Untyped.RWCtx m s)
                                         ,(Classes.ToPtr s (CapnpVersion (Message.MutMsg s)))) => (CodeGeneratorRequest (Message.MutMsg s)) -> (CapnpVersion (Message.MutMsg s)) -> (m ())
set_CodeGeneratorRequest'capnpVersion :: CodeGeneratorRequest (MutMsg s) -> CapnpVersion (MutMsg s) -> m ()
set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
struct) CapnpVersion (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> CapnpVersion (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) CapnpVersion (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
2 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'capnpVersion :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'capnpVersion :: CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
2 Struct msg
struct))
new_CodeGeneratorRequest'capnpVersion :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (m (CapnpVersion (Message.MutMsg s)))
new_CodeGeneratorRequest'capnpVersion :: CodeGeneratorRequest (MutMsg s) -> m (CapnpVersion (MutMsg s))
new_CodeGeneratorRequest'capnpVersion CodeGeneratorRequest (MutMsg s)
struct = (do
    CapnpVersion (MutMsg s)
result <- (MutMsg s -> m (CapnpVersion (MutMsg s))
forall s e (m :: * -> *).
(Allocate s e, WriteCtx m s) =>
MutMsg s -> m e
Classes.new (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest (MutMsg s)
struct))
    (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 ()
set_CodeGeneratorRequest'capnpVersion CodeGeneratorRequest (MutMsg s)
struct CapnpVersion (MutMsg s)
result)
    (CapnpVersion (MutMsg s) -> m (CapnpVersion (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure CapnpVersion (MutMsg s)
result)
    )
get_CodeGeneratorRequest'sourceInfo :: ((Untyped.ReadCtx m msg)
                                       ,(Classes.FromPtr msg (Basics.List msg (Node'SourceInfo msg)))) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (Node'SourceInfo msg)))
get_CodeGeneratorRequest'sourceInfo :: CodeGeneratorRequest msg -> m (List msg (Node'SourceInfo msg))
get_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (List msg (Node'SourceInfo msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'sourceInfo :: ((Untyped.RWCtx m s)
                                       ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (Node'SourceInfo (Message.MutMsg s))))) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'SourceInfo (Message.MutMsg s))) -> (m ())
set_CodeGeneratorRequest'sourceInfo :: CodeGeneratorRequest (MutMsg s)
-> List (MutMsg s) (Node'SourceInfo (MutMsg s)) -> m ()
set_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ Struct (MutMsg s)
struct) List (MutMsg s) (Node'SourceInfo (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List (MutMsg s) (Node'SourceInfo (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List (MutMsg s) (Node'SourceInfo (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
3 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'sourceInfo :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'sourceInfo :: CodeGeneratorRequest msg -> m Bool
has_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
3 Struct msg
struct))
new_CodeGeneratorRequest'sourceInfo :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'SourceInfo (Message.MutMsg s))))
new_CodeGeneratorRequest'sourceInfo :: Int
-> CodeGeneratorRequest (MutMsg s)
-> m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
new_CodeGeneratorRequest'sourceInfo Int
len CodeGeneratorRequest (MutMsg s)
struct = (do
    List (MutMsg s) (Node'SourceInfo (MutMsg s))
result <- (MutMsg s -> Int -> m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (CodeGeneratorRequest (MutMsg s)
-> InMessage (CodeGeneratorRequest (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'sourceInfo CodeGeneratorRequest (MutMsg s)
struct List (MutMsg s) (Node'SourceInfo (MutMsg s))
result)
    (List (MutMsg s) (Node'SourceInfo (MutMsg s))
-> m (List (MutMsg s) (Node'SourceInfo (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List (MutMsg s) (Node'SourceInfo (MutMsg s))
result)
    )
newtype CodeGeneratorRequest'RequestedFile msg
    = CodeGeneratorRequest'RequestedFile'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (CodeGeneratorRequest'RequestedFile msg)) where
    fromStruct :: Struct msg -> m (CodeGeneratorRequest'RequestedFile msg)
fromStruct Struct msg
struct = (CodeGeneratorRequest'RequestedFile msg
-> m (CodeGeneratorRequest'RequestedFile msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> CodeGeneratorRequest'RequestedFile msg
forall msg. Struct msg -> CodeGeneratorRequest'RequestedFile msg
CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (CodeGeneratorRequest'RequestedFile msg)) where
    toStruct :: CodeGeneratorRequest'RequestedFile msg -> Struct msg
toStruct (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (CodeGeneratorRequest'RequestedFile msg)) where
    type InMessage (CodeGeneratorRequest'RequestedFile msg) = msg
    message :: CodeGeneratorRequest'RequestedFile msg
-> InMessage (CodeGeneratorRequest'RequestedFile msg)
message (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (CodeGeneratorRequest'RequestedFile msg)) where
    messageDefault :: InMessage (CodeGeneratorRequest'RequestedFile msg)
-> CodeGeneratorRequest'RequestedFile msg
messageDefault InMessage (CodeGeneratorRequest'RequestedFile msg)
msg = (Struct msg -> CodeGeneratorRequest'RequestedFile msg
forall msg. Struct msg -> CodeGeneratorRequest'RequestedFile msg
CodeGeneratorRequest'RequestedFile'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (CodeGeneratorRequest'RequestedFile msg)
msg))
instance (Classes.FromPtr msg (CodeGeneratorRequest'RequestedFile msg)) where
    fromPtr :: msg
-> Maybe (Ptr msg) -> m (CodeGeneratorRequest'RequestedFile msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> CodeGeneratorRequest'RequestedFile msg
forall msg. Struct msg -> CodeGeneratorRequest'RequestedFile msg
CodeGeneratorRequest'RequestedFile'newtype_ (Struct msg -> CodeGeneratorRequest'RequestedFile msg)
-> m (Struct msg) -> m (CodeGeneratorRequest'RequestedFile msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> CodeGeneratorRequest'RequestedFile (MutMsg s)
-> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (CodeGeneratorRequest'RequestedFile'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
    new :: MutMsg s -> m (CodeGeneratorRequest'RequestedFile (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s) -> CodeGeneratorRequest'RequestedFile (MutMsg s)
forall msg. Struct msg -> CodeGeneratorRequest'RequestedFile msg
CodeGeneratorRequest'RequestedFile'newtype_ (Struct (MutMsg s)
 -> CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m (Struct (MutMsg s))
-> m (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
2))
instance (Basics.ListElem msg (CodeGeneratorRequest'RequestedFile msg)) where
    newtype List msg (CodeGeneratorRequest'RequestedFile msg)
        = CodeGeneratorRequest'RequestedFile'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg
-> Maybe (Ptr msg)
-> m (List msg (CodeGeneratorRequest'RequestedFile msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile msg)
forall msg.
ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile msg)
CodeGeneratorRequest'RequestedFile'List_ (ListOf msg (Struct msg)
 -> List msg (CodeGeneratorRequest'RequestedFile msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (CodeGeneratorRequest'RequestedFile msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (CodeGeneratorRequest'RequestedFile msg) -> List msg
toUntypedList (CodeGeneratorRequest'RequestedFile'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (CodeGeneratorRequest'RequestedFile msg) -> Int
length (CodeGeneratorRequest'RequestedFile'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int
-> List msg (CodeGeneratorRequest'RequestedFile msg)
-> m (CodeGeneratorRequest'RequestedFile msg)
index Int
i (CodeGeneratorRequest'RequestedFile'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (CodeGeneratorRequest'RequestedFile msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
    setIndex :: CodeGeneratorRequest'RequestedFile (MutMsg s)
-> Int
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
-> m ()
setIndex (CodeGeneratorRequest'RequestedFile'newtype_ Struct (MutMsg s)
elt) Int
i (CodeGeneratorRequest'RequestedFile'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s
-> Int
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall msg.
ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile msg)
CodeGeneratorRequest'RequestedFile'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
2 Int
len))
get_CodeGeneratorRequest'RequestedFile'id :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Word64)
get_CodeGeneratorRequest'RequestedFile'id :: CodeGeneratorRequest'RequestedFile msg -> m Word64
get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_CodeGeneratorRequest'RequestedFile'id :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_CodeGeneratorRequest'RequestedFile'id :: CodeGeneratorRequest'RequestedFile (MutMsg s) -> Word64 -> m ()
set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.ReadCtx m msg)
                                                   ,(Classes.FromPtr msg (Basics.Text msg))) => (CodeGeneratorRequest'RequestedFile msg) -> (m (Basics.Text msg))
get_CodeGeneratorRequest'RequestedFile'filename :: CodeGeneratorRequest'RequestedFile msg -> m (Text msg)
get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.RWCtx m s)
                                                   ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_CodeGeneratorRequest'RequestedFile'filename :: CodeGeneratorRequest'RequestedFile (MutMsg s)
-> Text (MutMsg s) -> m ()
set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'RequestedFile'filename :: CodeGeneratorRequest'RequestedFile msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_CodeGeneratorRequest'RequestedFile'filename :: Int
-> CodeGeneratorRequest'RequestedFile (MutMsg s)
-> m (Text (MutMsg s))
new_CodeGeneratorRequest'RequestedFile'filename Int
len CodeGeneratorRequest'RequestedFile (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest'RequestedFile (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'RequestedFile'filename CodeGeneratorRequest'RequestedFile (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )
get_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.ReadCtx m msg)
                                                  ,(Classes.FromPtr msg (Basics.List msg (CodeGeneratorRequest'RequestedFile'Import msg)))) => (CodeGeneratorRequest'RequestedFile msg) -> (m (Basics.List msg (CodeGeneratorRequest'RequestedFile'Import msg)))
get_CodeGeneratorRequest'RequestedFile'imports :: CodeGeneratorRequest'RequestedFile msg
-> m (List msg (CodeGeneratorRequest'RequestedFile'Import msg))
get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct)
    (msg
-> Maybe (Ptr msg)
-> m (List msg (CodeGeneratorRequest'RequestedFile'Import msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.RWCtx m s)
                                                  ,(Classes.ToPtr s (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))))) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) -> (m ())
set_CodeGeneratorRequest'RequestedFile'imports :: CodeGeneratorRequest'RequestedFile (MutMsg s)
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m ()
set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ Struct (MutMsg s)
struct) List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
1 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'RequestedFile'imports :: CodeGeneratorRequest'RequestedFile msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
1 Struct msg
struct))
new_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))))
new_CodeGeneratorRequest'RequestedFile'imports :: Int
-> CodeGeneratorRequest'RequestedFile (MutMsg s)
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
new_CodeGeneratorRequest'RequestedFile'imports Int
len CodeGeneratorRequest'RequestedFile (MutMsg s)
struct = (do
    List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
result <- (MutMsg s
-> Int
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
forall s e (m :: * -> *).
(MutListElem s e, WriteCtx m s) =>
MutMsg s -> Int -> m (List (MutMsg s) e)
Classes.newList (CodeGeneratorRequest'RequestedFile (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest'RequestedFile (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'RequestedFile'imports CodeGeneratorRequest'RequestedFile (MutMsg s)
struct List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
result)
    (List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure List
  (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
result)
    )
newtype CodeGeneratorRequest'RequestedFile'Import msg
    = CodeGeneratorRequest'RequestedFile'Import'newtype_ (Untyped.Struct msg)
instance (Classes.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
    fromStruct :: Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg)
fromStruct Struct msg
struct = (CodeGeneratorRequest'RequestedFile'Import msg
-> m (CodeGeneratorRequest'RequestedFile'Import msg)
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure (Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
forall msg.
Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct))
instance (Classes.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
    toStruct :: CodeGeneratorRequest'RequestedFile'Import msg -> Struct msg
toStruct (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct) = Struct msg
struct
instance (Untyped.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg)) where
    type InMessage (CodeGeneratorRequest'RequestedFile'Import msg) = msg
    message :: CodeGeneratorRequest'RequestedFile'Import msg
-> InMessage (CodeGeneratorRequest'RequestedFile'Import msg)
message (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct) = (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct)
instance (Untyped.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg)) where
    messageDefault :: InMessage (CodeGeneratorRequest'RequestedFile'Import msg)
-> CodeGeneratorRequest'RequestedFile'Import msg
messageDefault InMessage (CodeGeneratorRequest'RequestedFile'Import msg)
msg = (Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
forall msg.
Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
CodeGeneratorRequest'RequestedFile'Import'newtype_ (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
Untyped.messageDefault InMessage (Struct msg)
InMessage (CodeGeneratorRequest'RequestedFile'Import msg)
msg))
instance (Classes.FromPtr msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
    fromPtr :: msg
-> Maybe (Ptr msg)
-> m (CodeGeneratorRequest'RequestedFile'Import msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = (Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
forall msg.
Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
CodeGeneratorRequest'RequestedFile'Import'newtype_ (Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg)
-> m (Struct msg)
-> m (CodeGeneratorRequest'RequestedFile'Import msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (Struct msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
instance (Classes.ToPtr s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
    toPtr :: MutMsg s
-> CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct (MutMsg s)
struct) = (MutMsg s -> Struct (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr MutMsg s
msg Struct (MutMsg s)
struct)
instance (Classes.Allocate s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
    new :: MutMsg s
-> m (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
new MutMsg s
msg = (Struct (MutMsg s)
-> CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
forall msg.
Struct msg -> CodeGeneratorRequest'RequestedFile'Import msg
CodeGeneratorRequest'RequestedFile'Import'newtype_ (Struct (MutMsg s)
 -> CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m (Struct (MutMsg s))
-> m (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
Untyped.allocStruct MutMsg s
msg Word16
1 Word16
1))
instance (Basics.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
    newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg)
        = CodeGeneratorRequest'RequestedFile'Import'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr :: msg
-> Maybe (Ptr msg)
-> m (List msg (CodeGeneratorRequest'RequestedFile'Import msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = (ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile'Import msg)
forall msg.
ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile'Import msg)
CodeGeneratorRequest'RequestedFile'Import'List_ (ListOf msg (Struct msg)
 -> List msg (CodeGeneratorRequest'RequestedFile'Import msg))
-> m (ListOf msg (Struct msg))
-> m (List msg (CodeGeneratorRequest'RequestedFile'Import msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msg -> Maybe (Ptr msg) -> m (ListOf msg (Struct msg))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr msg
msg Maybe (Ptr msg)
ptr))
    toUntypedList :: List msg (CodeGeneratorRequest'RequestedFile'Import msg)
-> List msg
toUntypedList (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
Untyped.ListStruct ListOf msg (Struct msg)
l)
    length :: List msg (CodeGeneratorRequest'RequestedFile'Import msg) -> Int
length (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
Untyped.length ListOf msg (Struct msg)
l)
    index :: Int
-> List msg (CodeGeneratorRequest'RequestedFile'Import msg)
-> m (CodeGeneratorRequest'RequestedFile'Import msg)
index Int
i (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (do
        Struct msg
elt <- (Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
Untyped.index Int
i ListOf msg (Struct msg)
l)
        (Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
Classes.fromStruct Struct msg
elt)
        )
instance (Basics.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
    setIndex :: CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Int
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
-> m ()
setIndex (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct (MutMsg s)
elt) Int
i (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (Struct (MutMsg s)
-> Int -> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
Untyped.setIndex Struct (MutMsg s)
elt Int
i ListOf (MutMsg s) (Struct (MutMsg s))
l)
    newList :: MutMsg s
-> Int
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
newList MutMsg s
msg Int
len = (ListOf (MutMsg s) (Struct (MutMsg s))
-> List
     (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
forall msg.
ListOf msg (Struct msg)
-> List msg (CodeGeneratorRequest'RequestedFile'Import msg)
CodeGeneratorRequest'RequestedFile'Import'List_ (ListOf (MutMsg s) (Struct (MutMsg s))
 -> List
      (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
-> m (List
        (MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
Untyped.allocCompositeList MutMsg s
msg Word16
1 Word16
1 Int
len))
get_CodeGeneratorRequest'RequestedFile'Import'id :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m Std_.Word64)
get_CodeGeneratorRequest'RequestedFile'Import'id :: CodeGeneratorRequest'RequestedFile'Import msg -> m Word64
get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct) = (Struct msg -> Int -> Int -> Word64 -> m Word64
forall (m :: * -> *) msg a.
(ReadCtx m msg, IsWord a) =>
Struct msg -> Int -> Int -> Word64 -> m a
GenHelpers.getWordField Struct msg
struct Int
0 Int
0 Word64
0)
set_CodeGeneratorRequest'RequestedFile'Import'id :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_CodeGeneratorRequest'RequestedFile'Import'id :: CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Word64 -> m ()
set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct (MutMsg s)
struct) Word64
value = (Struct (MutMsg s) -> Word64 -> Int -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(RWCtx m s, Bounded a, Integral a, IsWord a, Bits a) =>
Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
GenHelpers.setWordField Struct (MutMsg s)
struct ((Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
Std_.fromIntegral (Word64 -> Word64
forall a. IsWord a => a -> Word64
Classes.toWord Word64
value)) :: Std_.Word64) Int
0 Int
0 Word64
0)
get_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.ReadCtx m msg)
                                                      ,(Classes.FromPtr msg (Basics.Text msg))) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m (Basics.Text msg))
get_CodeGeneratorRequest'RequestedFile'Import'name :: CodeGeneratorRequest'RequestedFile'Import msg -> m (Text msg)
get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct) = (do
    Maybe (Ptr msg)
ptr <- (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct)
    (msg -> Maybe (Ptr msg) -> m (Text msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
Classes.fromPtr (Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct msg
struct) Maybe (Ptr msg)
ptr)
    )
set_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.RWCtx m s)
                                                      ,(Classes.ToPtr s (Basics.Text (Message.MutMsg s)))) => (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_CodeGeneratorRequest'RequestedFile'Import'name :: CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> Text (MutMsg s) -> m ()
set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct (MutMsg s)
struct) Text (MutMsg s)
value = (do
    Maybe (Ptr (MutMsg s))
ptr <- (MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
Classes.toPtr (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message Struct (MutMsg s)
struct) Text (MutMsg s)
value)
    (Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
Untyped.setPtr Maybe (Ptr (MutMsg s))
ptr Int
0 Struct (MutMsg s)
struct)
    )
has_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m Std_.Bool)
has_CodeGeneratorRequest'RequestedFile'Import'name :: CodeGeneratorRequest'RequestedFile'Import msg -> m Bool
has_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ Struct msg
struct) = (Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
Std_.isJust (Maybe (Ptr msg) -> Bool) -> m (Maybe (Ptr msg)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
Untyped.getPtr Int
0 Struct msg
struct))
new_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_CodeGeneratorRequest'RequestedFile'Import'name :: Int
-> CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> m (Text (MutMsg s))
new_CodeGeneratorRequest'RequestedFile'Import'name Int
len CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
struct = (do
    Text (MutMsg s)
result <- (MutMsg s -> Int -> m (Text (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (Text (MutMsg s))
Basics.newText (CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
-> InMessage (CodeGeneratorRequest'RequestedFile'Import (MutMsg s))
forall a. HasMessage a => a -> InMessage a
Untyped.message CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
struct) Int
len)
    (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 ()
set_CodeGeneratorRequest'RequestedFile'Import'name CodeGeneratorRequest'RequestedFile'Import (MutMsg s)
struct Text (MutMsg s)
result)
    (Text (MutMsg s) -> m (Text (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
Std_.pure Text (MutMsg s)
result)
    )