{-# 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 (Untyped.TraverseMsg Node) where tMsg f (Node'newtype_ s) = (Node'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node msg)) where fromStruct struct = (Std_.pure (Node'newtype_ struct)) instance (Classes.ToStruct msg (Node msg)) where toStruct (Node'newtype_ struct) = struct instance (Untyped.HasMessage (Node msg)) where type InMessage (Node msg) = msg message (Node'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node msg)) where messageDefault msg = (Node'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Node msg)) where fromPtr msg ptr = (Node'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Node (Message.MutMsg s))) where toPtr msg (Node'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Node (Message.MutMsg s))) where new msg = (Node'newtype_ <$> (Untyped.allocStruct msg 5 6)) instance (Basics.ListElem msg (Node msg)) where newtype List msg (Node msg) = Node'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Node'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Node'List_ l) = (Untyped.ListStruct l) length (Node'List_ l) = (Untyped.length l) index i (Node'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Node (Message.MutMsg s))) where setIndex (Node'newtype_ elt) i (Node'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Node'List_ <$> (Untyped.allocCompositeList msg 5 6 len)) get_Node'id :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64) get_Node'id (Node'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Node'id :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Node'id (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0) get_Node'displayName :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.Text msg)) get_Node'displayName (Node'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'displayName :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Node'displayName (Node'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Node'displayName :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool) has_Node'displayName (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct)) new_Node'displayName :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s))) new_Node'displayName len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Node'displayName struct result) (Std_.pure result) ) get_Node'displayNamePrefixLength :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word32) get_Node'displayNamePrefixLength (Node'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0) set_Node'displayNamePrefixLength :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word32 -> (m ()) set_Node'displayNamePrefixLength (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0) get_Node'scopeId :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64) get_Node'scopeId (Node'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0) set_Node'scopeId :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Node'scopeId (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0) get_Node'nestedNodes :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Node'NestedNode msg))) get_Node'nestedNodes (Node'newtype_ struct) = (do ptr <- (Untyped.getPtr 1 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'nestedNodes :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))) -> (m ()) set_Node'nestedNodes (Node'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 1 struct) ) has_Node'nestedNodes :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool) has_Node'nestedNodes (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'nestedNodes struct result) (Std_.pure result) ) get_Node'annotations :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Annotation msg))) get_Node'annotations (Node'newtype_ struct) = (do ptr <- (Untyped.getPtr 2 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'annotations :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ()) set_Node'annotations (Node'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 2 struct) ) has_Node'annotations :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool) has_Node'annotations (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'annotations struct result) (Std_.pure result) ) get_Node'parameters :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Node'Parameter msg))) get_Node'parameters (Node'newtype_ struct) = (do ptr <- (Untyped.getPtr 5 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'parameters :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ()) set_Node'parameters (Node'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 5 struct) ) has_Node'parameters :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool) has_Node'parameters (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 5 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'parameters struct result) (Std_.pure result) ) get_Node'isGeneric :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool) get_Node'isGeneric (Node'newtype_ struct) = (GenHelpers.getWordField struct 4 32 0) set_Node'isGeneric :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'isGeneric (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 4 32 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 = (do tag <- (GenHelpers.getTag struct 6) case tag of 0 -> (Std_.pure Node'file) 1 -> (Node'struct <$> (Classes.fromStruct struct)) 2 -> (Node'enum <$> (Classes.fromStruct struct)) 3 -> (Node'interface <$> (Classes.fromStruct struct)) 4 -> (Node'const <$> (Classes.fromStruct struct)) 5 -> (Node'annotation <$> (Classes.fromStruct struct)) _ -> (Std_.pure (Node'unknown' (Std_.fromIntegral tag))) ) get_Node' :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Node' msg)) get_Node' (Node'newtype_ struct) = (Classes.fromStruct struct) set_Node'file :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m ()) set_Node'file (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 32 0) (Std_.pure ()) ) set_Node'struct :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'struct (Message.MutMsg s))) set_Node'struct (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 32 0) (Classes.fromStruct struct) ) set_Node'enum :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'enum (Message.MutMsg s))) set_Node'enum (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (2 :: Std_.Word16) 1 32 0) (Classes.fromStruct struct) ) set_Node'interface :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'interface (Message.MutMsg s))) set_Node'interface (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (3 :: Std_.Word16) 1 32 0) (Classes.fromStruct struct) ) set_Node'const :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'const (Message.MutMsg s))) set_Node'const (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (4 :: Std_.Word16) 1 32 0) (Classes.fromStruct struct) ) set_Node'annotation :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'annotation (Message.MutMsg s))) set_Node'annotation (Node'newtype_ struct) = (do (GenHelpers.setWordField struct (5 :: Std_.Word16) 1 32 0) (Classes.fromStruct struct) ) set_Node'unknown' :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Node'unknown' (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 32 0) newtype Node'struct msg = Node'struct'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'struct) where tMsg f (Node'struct'newtype_ s) = (Node'struct'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'struct msg)) where fromStruct struct = (Std_.pure (Node'struct'newtype_ struct)) instance (Classes.ToStruct msg (Node'struct msg)) where toStruct (Node'struct'newtype_ struct) = struct instance (Untyped.HasMessage (Node'struct msg)) where type InMessage (Node'struct msg) = msg message (Node'struct'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'struct msg)) where messageDefault msg = (Node'struct'newtype_ (Untyped.messageDefault msg)) get_Node'struct'dataWordCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16) get_Node'struct'dataWordCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 1 48 0) set_Node'struct'dataWordCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Node'struct'dataWordCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 48 0) get_Node'struct'pointerCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16) get_Node'struct'pointerCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 0 0) set_Node'struct'pointerCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Node'struct'pointerCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 0 0) get_Node'struct'preferredListEncoding :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m ElementSize) get_Node'struct'preferredListEncoding (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 16 0) set_Node'struct'preferredListEncoding :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> ElementSize -> (m ()) set_Node'struct'preferredListEncoding (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 16 0) get_Node'struct'isGroup :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool) get_Node'struct'isGroup (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 32 0) set_Node'struct'isGroup :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'struct'isGroup (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 3 32 0) get_Node'struct'discriminantCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16) get_Node'struct'discriminantCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 48 0) set_Node'struct'discriminantCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Node'struct'discriminantCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 48 0) get_Node'struct'discriminantOffset :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word32) get_Node'struct'discriminantOffset (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 4 0 0) set_Node'struct'discriminantOffset :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word32 -> (m ()) set_Node'struct'discriminantOffset (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 4 0 0) get_Node'struct'fields :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m (Basics.List msg (Field msg))) get_Node'struct'fields (Node'struct'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'struct'fields :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))) -> (m ()) set_Node'struct'fields (Node'struct'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Node'struct'fields :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool) has_Node'struct'fields (Node'struct'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'struct'fields struct result) (Std_.pure result) ) newtype Node'enum msg = Node'enum'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'enum) where tMsg f (Node'enum'newtype_ s) = (Node'enum'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'enum msg)) where fromStruct struct = (Std_.pure (Node'enum'newtype_ struct)) instance (Classes.ToStruct msg (Node'enum msg)) where toStruct (Node'enum'newtype_ struct) = struct instance (Untyped.HasMessage (Node'enum msg)) where type InMessage (Node'enum msg) = msg message (Node'enum'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'enum msg)) where messageDefault msg = (Node'enum'newtype_ (Untyped.messageDefault msg)) get_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)) => (Node'enum msg) -> (m (Basics.List msg (Enumerant msg))) get_Node'enum'enumerants (Node'enum'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'enum'enumerants :: ((Untyped.RWCtx m s)) => (Node'enum (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))) -> (m ()) set_Node'enum'enumerants (Node'enum'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)) => (Node'enum msg) -> (m Std_.Bool) has_Node'enum'enumerants (Node'enum'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'enum'enumerants struct result) (Std_.pure result) ) newtype Node'interface msg = Node'interface'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'interface) where tMsg f (Node'interface'newtype_ s) = (Node'interface'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'interface msg)) where fromStruct struct = (Std_.pure (Node'interface'newtype_ struct)) instance (Classes.ToStruct msg (Node'interface msg)) where toStruct (Node'interface'newtype_ struct) = struct instance (Untyped.HasMessage (Node'interface msg)) where type InMessage (Node'interface msg) = msg message (Node'interface'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'interface msg)) where messageDefault msg = (Node'interface'newtype_ (Untyped.messageDefault msg)) get_Node'interface'methods :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m (Basics.List msg (Method msg))) get_Node'interface'methods (Node'interface'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'interface'methods :: ((Untyped.RWCtx m s)) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))) -> (m ()) set_Node'interface'methods (Node'interface'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Node'interface'methods :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool) has_Node'interface'methods (Node'interface'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'interface'methods struct result) (Std_.pure result) ) get_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m (Basics.List msg (Superclass msg))) get_Node'interface'superclasses (Node'interface'newtype_ struct) = (do ptr <- (Untyped.getPtr 4 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'interface'superclasses :: ((Untyped.RWCtx m s)) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))) -> (m ()) set_Node'interface'superclasses (Node'interface'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 4 struct) ) has_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool) has_Node'interface'superclasses (Node'interface'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'interface'superclasses struct result) (Std_.pure result) ) newtype Node'const msg = Node'const'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'const) where tMsg f (Node'const'newtype_ s) = (Node'const'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'const msg)) where fromStruct struct = (Std_.pure (Node'const'newtype_ struct)) instance (Classes.ToStruct msg (Node'const msg)) where toStruct (Node'const'newtype_ struct) = struct instance (Untyped.HasMessage (Node'const msg)) where type InMessage (Node'const msg) = msg message (Node'const'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'const msg)) where messageDefault msg = (Node'const'newtype_ (Untyped.messageDefault msg)) get_Node'const'type_ :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m (Type msg)) get_Node'const'type_ (Node'const'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'const'type_ :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ()) set_Node'const'type_ (Node'const'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Node'const'type_ :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool) has_Node'const'type_ (Node'const'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct)) new_Node'const'type_ :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Type (Message.MutMsg s))) new_Node'const'type_ struct = (do result <- (Classes.new (Untyped.message struct)) (set_Node'const'type_ struct result) (Std_.pure result) ) get_Node'const'value :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m (Value msg)) get_Node'const'value (Node'const'newtype_ struct) = (do ptr <- (Untyped.getPtr 4 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'const'value :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ()) set_Node'const'value (Node'const'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 4 struct) ) has_Node'const'value :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool) has_Node'const'value (Node'const'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 struct)) new_Node'const'value :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Value (Message.MutMsg s))) new_Node'const'value struct = (do result <- (Classes.new (Untyped.message struct)) (set_Node'const'value struct result) (Std_.pure result) ) newtype Node'annotation msg = Node'annotation'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'annotation) where tMsg f (Node'annotation'newtype_ s) = (Node'annotation'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'annotation msg)) where fromStruct struct = (Std_.pure (Node'annotation'newtype_ struct)) instance (Classes.ToStruct msg (Node'annotation msg)) where toStruct (Node'annotation'newtype_ struct) = struct instance (Untyped.HasMessage (Node'annotation msg)) where type InMessage (Node'annotation msg) = msg message (Node'annotation'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'annotation msg)) where messageDefault msg = (Node'annotation'newtype_ (Untyped.messageDefault msg)) get_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m (Type msg)) get_Node'annotation'type_ (Node'annotation'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'annotation'type_ :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ()) set_Node'annotation'type_ (Node'annotation'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) has_Node'annotation'type_ (Node'annotation'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct)) new_Node'annotation'type_ :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> (m (Type (Message.MutMsg s))) new_Node'annotation'type_ struct = (do result <- (Classes.new (Untyped.message struct)) (set_Node'annotation'type_ struct result) (Std_.pure result) ) get_Node'annotation'targetsFile :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsFile (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 48 0) set_Node'annotation'targetsFile :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsFile (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 48 0) get_Node'annotation'targetsConst :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsConst (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 49 0) set_Node'annotation'targetsConst :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsConst (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 49 0) get_Node'annotation'targetsEnum :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsEnum (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 50 0) set_Node'annotation'targetsEnum :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsEnum (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 50 0) get_Node'annotation'targetsEnumerant :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsEnumerant (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 51 0) set_Node'annotation'targetsEnumerant :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsEnumerant (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 51 0) get_Node'annotation'targetsStruct :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsStruct (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 52 0) set_Node'annotation'targetsStruct :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsStruct (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 52 0) get_Node'annotation'targetsField :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsField (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 53 0) set_Node'annotation'targetsField :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsField (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 53 0) get_Node'annotation'targetsUnion :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsUnion (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 54 0) set_Node'annotation'targetsUnion :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsUnion (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 54 0) get_Node'annotation'targetsGroup :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsGroup (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 55 0) set_Node'annotation'targetsGroup :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsGroup (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 55 0) get_Node'annotation'targetsInterface :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsInterface (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 56 0) set_Node'annotation'targetsInterface :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsInterface (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 56 0) get_Node'annotation'targetsMethod :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsMethod (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 57 0) set_Node'annotation'targetsMethod :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsMethod (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 57 0) get_Node'annotation'targetsParam :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsParam (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 58 0) set_Node'annotation'targetsParam :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsParam (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 58 0) get_Node'annotation'targetsAnnotation :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool) get_Node'annotation'targetsAnnotation (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 59 0) set_Node'annotation'targetsAnnotation :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Node'annotation'targetsAnnotation (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 59 0) newtype Node'Parameter msg = Node'Parameter'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'Parameter) where tMsg f (Node'Parameter'newtype_ s) = (Node'Parameter'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'Parameter msg)) where fromStruct struct = (Std_.pure (Node'Parameter'newtype_ struct)) instance (Classes.ToStruct msg (Node'Parameter msg)) where toStruct (Node'Parameter'newtype_ struct) = struct instance (Untyped.HasMessage (Node'Parameter msg)) where type InMessage (Node'Parameter msg) = msg message (Node'Parameter'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'Parameter msg)) where messageDefault msg = (Node'Parameter'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Node'Parameter msg)) where fromPtr msg ptr = (Node'Parameter'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Node'Parameter (Message.MutMsg s))) where toPtr msg (Node'Parameter'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Node'Parameter (Message.MutMsg s))) where new msg = (Node'Parameter'newtype_ <$> (Untyped.allocStruct msg 0 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 ptr = (Node'Parameter'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Node'Parameter'List_ l) = (Untyped.ListStruct l) length (Node'Parameter'List_ l) = (Untyped.length l) index i (Node'Parameter'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Node'Parameter (Message.MutMsg s))) where setIndex (Node'Parameter'newtype_ elt) i (Node'Parameter'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Node'Parameter'List_ <$> (Untyped.allocCompositeList msg 0 1 len)) get_Node'Parameter'name :: ((Untyped.ReadCtx m msg)) => (Node'Parameter msg) -> (m (Basics.Text msg)) get_Node'Parameter'name (Node'Parameter'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'Parameter'name :: ((Untyped.RWCtx m s)) => (Node'Parameter (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Node'Parameter'name (Node'Parameter'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Node'Parameter'name :: ((Untyped.ReadCtx m msg)) => (Node'Parameter msg) -> (m Std_.Bool) has_Node'Parameter'name (Node'Parameter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 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 len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Node'Parameter'name struct result) (Std_.pure result) ) newtype Node'NestedNode msg = Node'NestedNode'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'NestedNode) where tMsg f (Node'NestedNode'newtype_ s) = (Node'NestedNode'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'NestedNode msg)) where fromStruct struct = (Std_.pure (Node'NestedNode'newtype_ struct)) instance (Classes.ToStruct msg (Node'NestedNode msg)) where toStruct (Node'NestedNode'newtype_ struct) = struct instance (Untyped.HasMessage (Node'NestedNode msg)) where type InMessage (Node'NestedNode msg) = msg message (Node'NestedNode'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'NestedNode msg)) where messageDefault msg = (Node'NestedNode'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Node'NestedNode msg)) where fromPtr msg ptr = (Node'NestedNode'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Node'NestedNode (Message.MutMsg s))) where toPtr msg (Node'NestedNode'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Node'NestedNode (Message.MutMsg s))) where new msg = (Node'NestedNode'newtype_ <$> (Untyped.allocStruct msg 1 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 ptr = (Node'NestedNode'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Node'NestedNode'List_ l) = (Untyped.ListStruct l) length (Node'NestedNode'List_ l) = (Untyped.length l) index i (Node'NestedNode'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Node'NestedNode (Message.MutMsg s))) where setIndex (Node'NestedNode'newtype_ elt) i (Node'NestedNode'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Node'NestedNode'List_ <$> (Untyped.allocCompositeList msg 1 1 len)) get_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m (Basics.Text msg)) get_Node'NestedNode'name (Node'NestedNode'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'NestedNode'name :: ((Untyped.RWCtx m s)) => (Node'NestedNode (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Node'NestedNode'name (Node'NestedNode'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Bool) has_Node'NestedNode'name (Node'NestedNode'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 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 len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Node'NestedNode'name struct result) (Std_.pure result) ) get_Node'NestedNode'id :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Word64) get_Node'NestedNode'id (Node'NestedNode'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Node'NestedNode'id :: ((Untyped.RWCtx m s)) => (Node'NestedNode (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Node'NestedNode'id (Node'NestedNode'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0) newtype Node'SourceInfo msg = Node'SourceInfo'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'SourceInfo) where tMsg f (Node'SourceInfo'newtype_ s) = (Node'SourceInfo'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'SourceInfo msg)) where fromStruct struct = (Std_.pure (Node'SourceInfo'newtype_ struct)) instance (Classes.ToStruct msg (Node'SourceInfo msg)) where toStruct (Node'SourceInfo'newtype_ struct) = struct instance (Untyped.HasMessage (Node'SourceInfo msg)) where type InMessage (Node'SourceInfo msg) = msg message (Node'SourceInfo'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'SourceInfo msg)) where messageDefault msg = (Node'SourceInfo'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Node'SourceInfo msg)) where fromPtr msg ptr = (Node'SourceInfo'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Node'SourceInfo (Message.MutMsg s))) where toPtr msg (Node'SourceInfo'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Node'SourceInfo (Message.MutMsg s))) where new msg = (Node'SourceInfo'newtype_ <$> (Untyped.allocStruct msg 1 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 ptr = (Node'SourceInfo'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Node'SourceInfo'List_ l) = (Untyped.ListStruct l) length (Node'SourceInfo'List_ l) = (Untyped.length l) index i (Node'SourceInfo'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Node'SourceInfo (Message.MutMsg s))) where setIndex (Node'SourceInfo'newtype_ elt) i (Node'SourceInfo'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Node'SourceInfo'List_ <$> (Untyped.allocCompositeList msg 1 2 len)) get_Node'SourceInfo'id :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Word64) get_Node'SourceInfo'id (Node'SourceInfo'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Node'SourceInfo'id :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Node'SourceInfo'id (Node'SourceInfo'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0) get_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m (Basics.Text msg)) get_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'SourceInfo'docComment :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool) has_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 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 len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Node'SourceInfo'docComment struct result) (Std_.pure result) ) get_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m (Basics.List msg (Node'SourceInfo'Member msg))) get_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) = (do ptr <- (Untyped.getPtr 1 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'SourceInfo'members :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))) -> (m ()) set_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 1 struct) ) has_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool) has_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Node'SourceInfo'members struct result) (Std_.pure result) ) newtype Node'SourceInfo'Member msg = Node'SourceInfo'Member'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Node'SourceInfo'Member) where tMsg f (Node'SourceInfo'Member'newtype_ s) = (Node'SourceInfo'Member'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Node'SourceInfo'Member msg)) where fromStruct struct = (Std_.pure (Node'SourceInfo'Member'newtype_ struct)) instance (Classes.ToStruct msg (Node'SourceInfo'Member msg)) where toStruct (Node'SourceInfo'Member'newtype_ struct) = struct instance (Untyped.HasMessage (Node'SourceInfo'Member msg)) where type InMessage (Node'SourceInfo'Member msg) = msg message (Node'SourceInfo'Member'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Node'SourceInfo'Member msg)) where messageDefault msg = (Node'SourceInfo'Member'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Node'SourceInfo'Member msg)) where fromPtr msg ptr = (Node'SourceInfo'Member'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Node'SourceInfo'Member (Message.MutMsg s))) where toPtr msg (Node'SourceInfo'Member'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Node'SourceInfo'Member (Message.MutMsg s))) where new msg = (Node'SourceInfo'Member'newtype_ <$> (Untyped.allocStruct msg 0 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 ptr = (Node'SourceInfo'Member'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Node'SourceInfo'Member'List_ l) = (Untyped.ListStruct l) length (Node'SourceInfo'Member'List_ l) = (Untyped.length l) index i (Node'SourceInfo'Member'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Node'SourceInfo'Member (Message.MutMsg s))) where setIndex (Node'SourceInfo'Member'newtype_ elt) i (Node'SourceInfo'Member'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Node'SourceInfo'Member'List_ <$> (Untyped.allocCompositeList msg 0 1 len)) get_Node'SourceInfo'Member'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo'Member msg) -> (m (Basics.Text msg)) get_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Node'SourceInfo'Member'docComment :: ((Untyped.RWCtx m s)) => (Node'SourceInfo'Member (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 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'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 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 len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Node'SourceInfo'Member'docComment struct result) (Std_.pure result) ) newtype Field msg = Field'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Field) where tMsg f (Field'newtype_ s) = (Field'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Field msg)) where fromStruct struct = (Std_.pure (Field'newtype_ struct)) instance (Classes.ToStruct msg (Field msg)) where toStruct (Field'newtype_ struct) = struct instance (Untyped.HasMessage (Field msg)) where type InMessage (Field msg) = msg message (Field'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Field msg)) where messageDefault msg = (Field'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Field msg)) where fromPtr msg ptr = (Field'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Field (Message.MutMsg s))) where toPtr msg (Field'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Field (Message.MutMsg s))) where new msg = (Field'newtype_ <$> (Untyped.allocStruct msg 3 4)) instance (Basics.ListElem msg (Field msg)) where newtype List msg (Field msg) = Field'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Field'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Field'List_ l) = (Untyped.ListStruct l) length (Field'List_ l) = (Untyped.length l) index i (Field'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Field (Message.MutMsg s))) where setIndex (Field'newtype_ elt) i (Field'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Field'List_ <$> (Untyped.allocCompositeList msg 3 4 len)) get_Field'name :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Basics.Text msg)) get_Field'name (Field'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Field'name :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Field'name (Field'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Field'name :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool) has_Field'name (Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct)) new_Field'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Field (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s))) new_Field'name len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Field'name struct result) (Std_.pure result) ) get_Field'codeOrder :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16) get_Field'codeOrder (Field'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Field'codeOrder :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Field'codeOrder (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0) get_Field'annotations :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Basics.List msg (Annotation msg))) get_Field'annotations (Field'newtype_ struct) = (do ptr <- (Untyped.getPtr 1 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Field'annotations :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ()) set_Field'annotations (Field'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 1 struct) ) has_Field'annotations :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool) has_Field'annotations (Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Field'annotations struct result) (Std_.pure result) ) get_Field'discriminantValue :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16) get_Field'discriminantValue (Field'newtype_ struct) = (GenHelpers.getWordField struct 0 16 65535) set_Field'discriminantValue :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Field'discriminantValue (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 65535) get_Field'ordinal :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Field'ordinal msg)) get_Field'ordinal (Field'newtype_ struct) = (Classes.fromStruct 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 = (do tag <- (GenHelpers.getTag struct 4) case tag of 0 -> (Field'slot <$> (Classes.fromStruct struct)) 1 -> (Field'group <$> (Classes.fromStruct struct)) _ -> (Std_.pure (Field'unknown' (Std_.fromIntegral tag))) ) get_Field' :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Field' msg)) get_Field' (Field'newtype_ struct) = (Classes.fromStruct struct) set_Field'slot :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (m (Field'slot (Message.MutMsg s))) set_Field'slot (Field'newtype_ struct) = (do (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 0 0) (Classes.fromStruct struct) ) set_Field'group :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (m (Field'group (Message.MutMsg s))) set_Field'group (Field'newtype_ struct) = (do (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 0 0) (Classes.fromStruct struct) ) set_Field'unknown' :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Field'unknown' (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0) newtype Field'slot msg = Field'slot'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Field'slot) where tMsg f (Field'slot'newtype_ s) = (Field'slot'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Field'slot msg)) where fromStruct struct = (Std_.pure (Field'slot'newtype_ struct)) instance (Classes.ToStruct msg (Field'slot msg)) where toStruct (Field'slot'newtype_ struct) = struct instance (Untyped.HasMessage (Field'slot msg)) where type InMessage (Field'slot msg) = msg message (Field'slot'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Field'slot msg)) where messageDefault msg = (Field'slot'newtype_ (Untyped.messageDefault msg)) get_Field'slot'offset :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Word32) get_Field'slot'offset (Field'slot'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0) set_Field'slot'offset :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Word32 -> (m ()) set_Field'slot'offset (Field'slot'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0) get_Field'slot'type_ :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m (Type msg)) get_Field'slot'type_ (Field'slot'newtype_ struct) = (do ptr <- (Untyped.getPtr 2 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Field'slot'type_ :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ()) set_Field'slot'type_ (Field'slot'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 2 struct) ) has_Field'slot'type_ :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool) has_Field'slot'type_ (Field'slot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct)) new_Field'slot'type_ :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Type (Message.MutMsg s))) new_Field'slot'type_ struct = (do result <- (Classes.new (Untyped.message struct)) (set_Field'slot'type_ struct result) (Std_.pure result) ) get_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m (Value msg)) get_Field'slot'defaultValue (Field'slot'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Field'slot'defaultValue :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ()) set_Field'slot'defaultValue (Field'slot'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool) has_Field'slot'defaultValue (Field'slot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct)) new_Field'slot'defaultValue :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Value (Message.MutMsg s))) new_Field'slot'defaultValue struct = (do result <- (Classes.new (Untyped.message struct)) (set_Field'slot'defaultValue struct result) (Std_.pure result) ) get_Field'slot'hadExplicitDefault :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool) get_Field'slot'hadExplicitDefault (Field'slot'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0) set_Field'slot'hadExplicitDefault :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Bool -> (m ()) set_Field'slot'hadExplicitDefault (Field'slot'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 2 0 0) newtype Field'group msg = Field'group'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Field'group) where tMsg f (Field'group'newtype_ s) = (Field'group'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Field'group msg)) where fromStruct struct = (Std_.pure (Field'group'newtype_ struct)) instance (Classes.ToStruct msg (Field'group msg)) where toStruct (Field'group'newtype_ struct) = struct instance (Untyped.HasMessage (Field'group msg)) where type InMessage (Field'group msg) = msg message (Field'group'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Field'group msg)) where messageDefault msg = (Field'group'newtype_ (Untyped.messageDefault msg)) get_Field'group'typeId :: ((Untyped.ReadCtx m msg)) => (Field'group msg) -> (m Std_.Word64) get_Field'group'typeId (Field'group'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0) set_Field'group'typeId :: ((Untyped.RWCtx m s)) => (Field'group (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Field'group'typeId (Field'group'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0) newtype Field'ordinal msg = Field'ordinal'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Field'ordinal) where tMsg f (Field'ordinal'newtype_ s) = (Field'ordinal'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Field'ordinal msg)) where fromStruct struct = (Std_.pure (Field'ordinal'newtype_ struct)) instance (Classes.ToStruct msg (Field'ordinal msg)) where toStruct (Field'ordinal'newtype_ struct) = struct instance (Untyped.HasMessage (Field'ordinal msg)) where type InMessage (Field'ordinal msg) = msg message (Field'ordinal'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Field'ordinal msg)) where messageDefault msg = (Field'ordinal'newtype_ (Untyped.messageDefault 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 = (do tag <- (GenHelpers.getTag struct 5) case tag of 0 -> (Std_.pure Field'ordinal'implicit) 1 -> (Field'ordinal'explicit <$> (GenHelpers.getWordField struct 1 32 0)) _ -> (Std_.pure (Field'ordinal'unknown' (Std_.fromIntegral tag))) ) get_Field'ordinal' :: ((Untyped.ReadCtx m msg)) => (Field'ordinal msg) -> (m (Field'ordinal' msg)) get_Field'ordinal' (Field'ordinal'newtype_ struct) = (Classes.fromStruct struct) set_Field'ordinal'implicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> (m ()) set_Field'ordinal'implicit (Field'ordinal'newtype_ struct) = (do (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 16 0) (Std_.pure ()) ) set_Field'ordinal'explicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Field'ordinal'explicit (Field'ordinal'newtype_ struct) value = (do (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 16 0) (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 32 0) ) set_Field'ordinal'unknown' :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Field'ordinal'unknown' (Field'ordinal'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 16 0) field'noDiscriminant :: Std_.Word16 field'noDiscriminant = (Classes.fromWord 65535) newtype Enumerant msg = Enumerant'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Enumerant) where tMsg f (Enumerant'newtype_ s) = (Enumerant'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Enumerant msg)) where fromStruct struct = (Std_.pure (Enumerant'newtype_ struct)) instance (Classes.ToStruct msg (Enumerant msg)) where toStruct (Enumerant'newtype_ struct) = struct instance (Untyped.HasMessage (Enumerant msg)) where type InMessage (Enumerant msg) = msg message (Enumerant'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Enumerant msg)) where messageDefault msg = (Enumerant'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Enumerant msg)) where fromPtr msg ptr = (Enumerant'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Enumerant (Message.MutMsg s))) where toPtr msg (Enumerant'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Enumerant (Message.MutMsg s))) where new msg = (Enumerant'newtype_ <$> (Untyped.allocStruct msg 1 2)) instance (Basics.ListElem msg (Enumerant msg)) where newtype List msg (Enumerant msg) = Enumerant'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Enumerant'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Enumerant'List_ l) = (Untyped.ListStruct l) length (Enumerant'List_ l) = (Untyped.length l) index i (Enumerant'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Enumerant (Message.MutMsg s))) where setIndex (Enumerant'newtype_ elt) i (Enumerant'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Enumerant'List_ <$> (Untyped.allocCompositeList msg 1 2 len)) get_Enumerant'name :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m (Basics.Text msg)) get_Enumerant'name (Enumerant'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Enumerant'name :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Enumerant'name (Enumerant'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Enumerant'name :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool) has_Enumerant'name (Enumerant'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct)) new_Enumerant'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Enumerant (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s))) new_Enumerant'name len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Enumerant'name struct result) (Std_.pure result) ) get_Enumerant'codeOrder :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Word16) get_Enumerant'codeOrder (Enumerant'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Enumerant'codeOrder :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Enumerant'codeOrder (Enumerant'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0) get_Enumerant'annotations :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m (Basics.List msg (Annotation msg))) get_Enumerant'annotations (Enumerant'newtype_ struct) = (do ptr <- (Untyped.getPtr 1 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Enumerant'annotations :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ()) set_Enumerant'annotations (Enumerant'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 1 struct) ) has_Enumerant'annotations :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool) has_Enumerant'annotations (Enumerant'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Enumerant'annotations struct result) (Std_.pure result) ) newtype Superclass msg = Superclass'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Superclass) where tMsg f (Superclass'newtype_ s) = (Superclass'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Superclass msg)) where fromStruct struct = (Std_.pure (Superclass'newtype_ struct)) instance (Classes.ToStruct msg (Superclass msg)) where toStruct (Superclass'newtype_ struct) = struct instance (Untyped.HasMessage (Superclass msg)) where type InMessage (Superclass msg) = msg message (Superclass'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Superclass msg)) where messageDefault msg = (Superclass'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Superclass msg)) where fromPtr msg ptr = (Superclass'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Superclass (Message.MutMsg s))) where toPtr msg (Superclass'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Superclass (Message.MutMsg s))) where new msg = (Superclass'newtype_ <$> (Untyped.allocStruct msg 1 1)) instance (Basics.ListElem msg (Superclass msg)) where newtype List msg (Superclass msg) = Superclass'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Superclass'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Superclass'List_ l) = (Untyped.ListStruct l) length (Superclass'List_ l) = (Untyped.length l) index i (Superclass'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Superclass (Message.MutMsg s))) where setIndex (Superclass'newtype_ elt) i (Superclass'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Superclass'List_ <$> (Untyped.allocCompositeList msg 1 1 len)) get_Superclass'id :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Word64) get_Superclass'id (Superclass'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Superclass'id :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Superclass'id (Superclass'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0) get_Superclass'brand :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m (Brand msg)) get_Superclass'brand (Superclass'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Superclass'brand :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ()) set_Superclass'brand (Superclass'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Superclass'brand :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Bool) has_Superclass'brand (Superclass'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct)) new_Superclass'brand :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s))) new_Superclass'brand struct = (do result <- (Classes.new (Untyped.message struct)) (set_Superclass'brand struct result) (Std_.pure result) ) newtype Method msg = Method'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Method) where tMsg f (Method'newtype_ s) = (Method'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Method msg)) where fromStruct struct = (Std_.pure (Method'newtype_ struct)) instance (Classes.ToStruct msg (Method msg)) where toStruct (Method'newtype_ struct) = struct instance (Untyped.HasMessage (Method msg)) where type InMessage (Method msg) = msg message (Method'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Method msg)) where messageDefault msg = (Method'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Method msg)) where fromPtr msg ptr = (Method'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Method (Message.MutMsg s))) where toPtr msg (Method'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Method (Message.MutMsg s))) where new msg = (Method'newtype_ <$> (Untyped.allocStruct msg 3 5)) instance (Basics.ListElem msg (Method msg)) where newtype List msg (Method msg) = Method'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Method'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Method'List_ l) = (Untyped.ListStruct l) length (Method'List_ l) = (Untyped.length l) index i (Method'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Method (Message.MutMsg s))) where setIndex (Method'newtype_ elt) i (Method'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Method'List_ <$> (Untyped.allocCompositeList msg 3 5 len)) get_Method'name :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.Text msg)) get_Method'name (Method'newtype_ struct) = (do ptr <- (Untyped.getPtr 0 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Method'name :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ()) set_Method'name (Method'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 0 struct) ) has_Method'name :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool) has_Method'name (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct)) new_Method'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s))) new_Method'name len struct = (do result <- (Basics.newText (Untyped.message struct) len) (set_Method'name struct result) (Std_.pure result) ) get_Method'codeOrder :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word16) get_Method'codeOrder (Method'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0) set_Method'codeOrder :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word16 -> (m ()) set_Method'codeOrder (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0) get_Method'paramStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64) get_Method'paramStructType (Method'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0) set_Method'paramStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Method'paramStructType (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0) get_Method'resultStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64) get_Method'resultStructType (Method'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0) set_Method'resultStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ()) set_Method'resultStructType (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0) get_Method'annotations :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.List msg (Annotation msg))) get_Method'annotations (Method'newtype_ struct) = (do ptr <- (Untyped.getPtr 1 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Method'annotations :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ()) set_Method'annotations (Method'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 1 struct) ) has_Method'annotations :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool) has_Method'annotations (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Method'annotations struct result) (Std_.pure result) ) get_Method'paramBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Brand msg)) get_Method'paramBrand (Method'newtype_ struct) = (do ptr <- (Untyped.getPtr 2 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Method'paramBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ()) set_Method'paramBrand (Method'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 2 struct) ) has_Method'paramBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool) has_Method'paramBrand (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct)) new_Method'paramBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s))) new_Method'paramBrand struct = (do result <- (Classes.new (Untyped.message struct)) (set_Method'paramBrand struct result) (Std_.pure result) ) get_Method'resultBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Brand msg)) get_Method'resultBrand (Method'newtype_ struct) = (do ptr <- (Untyped.getPtr 3 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Method'resultBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ()) set_Method'resultBrand (Method'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 3 struct) ) has_Method'resultBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool) has_Method'resultBrand (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct)) new_Method'resultBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s))) new_Method'resultBrand struct = (do result <- (Classes.new (Untyped.message struct)) (set_Method'resultBrand struct result) (Std_.pure result) ) get_Method'implicitParameters :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.List msg (Node'Parameter msg))) get_Method'implicitParameters (Method'newtype_ struct) = (do ptr <- (Untyped.getPtr 4 struct) (Classes.fromPtr (Untyped.message struct) ptr) ) set_Method'implicitParameters :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ()) set_Method'implicitParameters (Method'newtype_ struct) value = (do ptr <- (Classes.toPtr (Untyped.message struct) value) (Untyped.setPtr ptr 4 struct) ) has_Method'implicitParameters :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool) has_Method'implicitParameters (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 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 len struct = (do result <- (Classes.newList (Untyped.message struct) len) (set_Method'implicitParameters struct result) (Std_.pure result) ) newtype Type msg = Type'newtype_ (Untyped.Struct msg) instance (Untyped.TraverseMsg Type) where tMsg f (Type'newtype_ s) = (Type'newtype_ <$> (Untyped.tMsg f s)) instance (Classes.FromStruct msg (Type msg)) where fromStruct struct = (Std_.pure (Type'newtype_ struct)) instance (Classes.ToStruct msg (Type msg)) where toStruct (Type'newtype_ struct) = struct instance (Untyped.HasMessage (Type msg)) where type InMessage (Type msg) = msg message (Type'newtype_ struct) = (Untyped.message struct) instance (Untyped.MessageDefault (Type msg)) where messageDefault msg = (Type'newtype_ (Untyped.messageDefault msg)) instance (Classes.FromPtr msg (Type msg)) where fromPtr msg ptr = (Type'newtype_ <$> (Classes.fromPtr msg ptr)) instance (Classes.ToPtr s (Type (Message.MutMsg s))) where toPtr msg (Type'newtype_ struct) = (Classes.toPtr msg struct) instance (Classes.Allocate s (Type (Message.MutMsg s))) where new msg = (Type'newtype_ <$> (Untyped.allocStruct msg 3 1)) instance (Basics.ListElem msg (Type msg)) where newtype List msg (Type msg) = Type'List_ (Untyped.ListOf msg (Untyped.Struct msg)) listFromPtr msg ptr = (Type'List_ <$> (Classes.fromPtr msg ptr)) toUntypedList (Type'List_ l) = (Untyped.ListStruct l) length (Type'List_ l) = (Untyped.length l) index i (Type'List_ l) = (do elt <- (Untyped.index i l) (Classes.fromStruct elt) ) instance (Basics.MutListElem s (Type (Message.MutMsg s))) where setIndex (Type'newtype_ elt) i (Type'List_ l) = (Untyped.setIndex elt i l) newList msg len = (Type'List_ <$> (Untyped.allocCompositeList msg 3 1 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 = (do tag <- (GenHelpers.getTag struct 0) case tag of 0 -> (Std_.pure Type'void) 1 -> (Std_.pure Type'bool) 2 -> (Std_.pure Type'int8) 3 -> (Std_.pure Type'int16) 4 -> (Std_.pure Type'int32) 5 -> (Std_.pure Type'int64) 6 -> (Std_.pure Type'uint8) 7 -> (Std_.pure Type'uint16) 8 -> (Std_.pure Type'uint32) 9 -> (Std_.pure Type'uint64) 10 -> (Std_.pure Type'float32) 11 -> (Std_.pure Type'float64) 12 -> (Std_.pure Type'text) 13 -> (Std_.pure Type'data_) 14 -> (Type'list <$> (Classes.fromStruct struct)) 15 -> (Type'enum <$> (Classes.fromStruct struct)) 16 -> (Type'struct <$> (Classes.fromStruct struct)) 17 -> (Type'interface <$> (Classes.fromStruct struct)) 18 -> (Type'anyPointer <$> (Classes.fromStruct struct)) _ -> (Std_.pure (Type'unknown' (Std_.fromIntegral tag))) ) get_Type' :: ((Untyped.ReadCtx m msg)) => (Type msg) -> (m (Type' msg)) get_Type' (Type'newtype_ struct) = (Classes.fromStruct struct) set_Type'void :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'void (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'bool :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'bool (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'int8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'int8 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'int16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'int16 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'int32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'int32 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'int64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'int64 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'uint8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'uint8 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'uint16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'uint16 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'uint32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'uint32 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'uint64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'uint64 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'float32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'float32 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'float64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'float64 (Type'newtype_ struct) = (do (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0) (Std_.pure ()) ) set_Type'text :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ()) set_Type'text (