{-# 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.Aircraft 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 ((<$>), (<*>), (>>=))
constDate :: (Zdate Message.ConstMsg)
constDate  = (GenHelpers.getPtrConst ("\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\223\a\b\ESC\NUL\NUL\NUL\NUL" :: BS.ByteString))
constList :: (Basics.List Message.ConstMsg (Zdate Message.ConstMsg))
constList  = (GenHelpers.getPtrConst ("\NUL\NUL\NUL\NUL\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\SOH\NUL\NUL\NUL\ETB\NUL\NUL\NUL\b\NUL\NUL\NUL\SOH\NUL\NUL\NUL\223\a\b\ESC\NUL\NUL\NUL\NUL\223\a\b\FS\NUL\NUL\NUL\NUL" :: BS.ByteString))
constEnum :: Airport
constEnum  = (Classes.fromWord 1)
newtype Zdate msg
    = Zdate'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Zdate) where
    tMsg f (Zdate'newtype_ s) = (Zdate'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Zdate msg)) where
    fromStruct struct = (Std_.pure (Zdate'newtype_ struct))
instance (Classes.ToStruct msg (Zdate msg)) where
    toStruct (Zdate'newtype_ struct) = struct
instance (Untyped.HasMessage (Zdate msg)) where
    type InMessage (Zdate msg) = msg
    message (Zdate'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Zdate msg)) where
    messageDefault msg = (Zdate'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Zdate msg)) where
    fromPtr msg ptr = (Zdate'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Zdate (Message.MutMsg s))) where
    toPtr msg (Zdate'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Zdate (Message.MutMsg s))) where
    new msg = (Zdate'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (Zdate msg)) where
    newtype List msg (Zdate msg)
        = Zdate'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Zdate'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Zdate'List_ l) = (Untyped.ListStruct l)
    length (Zdate'List_ l) = (Untyped.length l)
    index i (Zdate'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Zdate (Message.MutMsg s))) where
    setIndex (Zdate'newtype_ elt) i (Zdate'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Zdate'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
get_Zdate'year :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Int16)
get_Zdate'year (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_Zdate'year :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_Zdate'year (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
get_Zdate'month :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Word8)
get_Zdate'month (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 16 0)
set_Zdate'month :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_Zdate'month (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 16 0)
get_Zdate'day :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Word8)
get_Zdate'day (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 24 0)
set_Zdate'day :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_Zdate'day (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 24 0)
newtype Zdata msg
    = Zdata'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Zdata) where
    tMsg f (Zdata'newtype_ s) = (Zdata'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Zdata msg)) where
    fromStruct struct = (Std_.pure (Zdata'newtype_ struct))
instance (Classes.ToStruct msg (Zdata msg)) where
    toStruct (Zdata'newtype_ struct) = struct
instance (Untyped.HasMessage (Zdata msg)) where
    type InMessage (Zdata msg) = msg
    message (Zdata'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Zdata msg)) where
    messageDefault msg = (Zdata'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Zdata msg)) where
    fromPtr msg ptr = (Zdata'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Zdata (Message.MutMsg s))) where
    toPtr msg (Zdata'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Zdata (Message.MutMsg s))) where
    new msg = (Zdata'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Zdata msg)) where
    newtype List msg (Zdata msg)
        = Zdata'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Zdata'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Zdata'List_ l) = (Untyped.ListStruct l)
    length (Zdata'List_ l) = (Untyped.length l)
    index i (Zdata'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Zdata (Message.MutMsg s))) where
    setIndex (Zdata'newtype_ elt) i (Zdata'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Zdata'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Zdata'data_ :: ((Untyped.ReadCtx m msg)) => (Zdata msg) -> (m (Basics.Data msg))
get_Zdata'data_ (Zdata'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Zdata'data_ :: ((Untyped.RWCtx m s)) => (Zdata (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
set_Zdata'data_ (Zdata'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Zdata'data_ :: ((Untyped.ReadCtx m msg)) => (Zdata msg) -> (m Std_.Bool)
has_Zdata'data_ (Zdata'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Zdata'data_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zdata (Message.MutMsg s)) -> (m (Basics.Data (Message.MutMsg s)))
new_Zdata'data_ len struct = (do
    result <- (Basics.newData (Untyped.message struct) len)
    (set_Zdata'data_ struct result)
    (Std_.pure result)
    )
data Airport 
    = Airport'none 
    | Airport'jfk 
    | Airport'lax 
    | Airport'sfo 
    | Airport'luv 
    | Airport'dfw 
    | Airport'test 
    | Airport'unknown' Std_.Word16
    deriving(Std_.Show
            ,Std_.Read
            ,Std_.Eq
            ,Generics.Generic)
instance (Classes.IsWord Airport) where
    fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
        0 ->
            Airport'none
        1 ->
            Airport'jfk
        2 ->
            Airport'lax
        3 ->
            Airport'sfo
        4 ->
            Airport'luv
        5 ->
            Airport'dfw
        6 ->
            Airport'test
        tag ->
            (Airport'unknown' tag)
    toWord (Airport'none) = 0
    toWord (Airport'jfk) = 1
    toWord (Airport'lax) = 2
    toWord (Airport'sfo) = 3
    toWord (Airport'luv) = 4
    toWord (Airport'dfw) = 5
    toWord (Airport'test) = 6
    toWord (Airport'unknown' tag) = (Std_.fromIntegral tag)
instance (Std_.Enum Airport) where
    fromEnum x = (Std_.fromIntegral (Classes.toWord x))
    toEnum x = (Classes.fromWord (Std_.fromIntegral x))
instance (Basics.ListElem msg Airport) where
    newtype List msg Airport
        = Airport'List_ (Untyped.ListOf msg Std_.Word16)
    index i (Airport'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
    listFromPtr msg ptr = (Airport'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Airport'List_ l) = (Untyped.List16 l)
    length (Airport'List_ l) = (Untyped.length l)
instance (Classes.MutListElem s Airport) where
    setIndex elt i (Airport'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
    newList msg size = (Airport'List_ <$> (Untyped.allocList16 msg size))
newtype PlaneBase msg
    = PlaneBase'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg PlaneBase) where
    tMsg f (PlaneBase'newtype_ s) = (PlaneBase'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (PlaneBase msg)) where
    fromStruct struct = (Std_.pure (PlaneBase'newtype_ struct))
instance (Classes.ToStruct msg (PlaneBase msg)) where
    toStruct (PlaneBase'newtype_ struct) = struct
instance (Untyped.HasMessage (PlaneBase msg)) where
    type InMessage (PlaneBase msg) = msg
    message (PlaneBase'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (PlaneBase msg)) where
    messageDefault msg = (PlaneBase'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (PlaneBase msg)) where
    fromPtr msg ptr = (PlaneBase'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (PlaneBase (Message.MutMsg s))) where
    toPtr msg (PlaneBase'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (PlaneBase (Message.MutMsg s))) where
    new msg = (PlaneBase'newtype_ <$> (Untyped.allocStruct msg 4 2))
instance (Basics.ListElem msg (PlaneBase msg)) where
    newtype List msg (PlaneBase msg)
        = PlaneBase'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (PlaneBase'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (PlaneBase'List_ l) = (Untyped.ListStruct l)
    length (PlaneBase'List_ l) = (Untyped.length l)
    index i (PlaneBase'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (PlaneBase (Message.MutMsg s))) where
    setIndex (PlaneBase'newtype_ elt) i (PlaneBase'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (PlaneBase'List_ <$> (Untyped.allocCompositeList msg 4 2 len))
get_PlaneBase'name :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m (Basics.Text msg))
get_PlaneBase'name (PlaneBase'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_PlaneBase'name :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_PlaneBase'name (PlaneBase'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_PlaneBase'name :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
has_PlaneBase'name (PlaneBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_PlaneBase'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (PlaneBase (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_PlaneBase'name len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_PlaneBase'name struct result)
    (Std_.pure result)
    )
get_PlaneBase'homes :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m (Basics.List msg Airport))
get_PlaneBase'homes (PlaneBase'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_PlaneBase'homes :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Airport) -> (m ())
set_PlaneBase'homes (PlaneBase'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_PlaneBase'homes :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
has_PlaneBase'homes (PlaneBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_PlaneBase'homes :: ((Untyped.RWCtx m s)) => Std_.Int -> (PlaneBase (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Airport))
new_PlaneBase'homes len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_PlaneBase'homes struct result)
    (Std_.pure result)
    )
get_PlaneBase'rating :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Int64)
get_PlaneBase'rating (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_PlaneBase'rating :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_PlaneBase'rating (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
get_PlaneBase'canFly :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
get_PlaneBase'canFly (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_PlaneBase'canFly :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_PlaneBase'canFly (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 0 0)
get_PlaneBase'capacity :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Int64)
get_PlaneBase'capacity (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
set_PlaneBase'capacity :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_PlaneBase'capacity (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
get_PlaneBase'maxSpeed :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Double)
get_PlaneBase'maxSpeed (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 3 0 0)
set_PlaneBase'maxSpeed :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Double -> (m ())
set_PlaneBase'maxSpeed (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 3 0 0)
newtype B737 msg
    = B737'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg B737) where
    tMsg f (B737'newtype_ s) = (B737'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (B737 msg)) where
    fromStruct struct = (Std_.pure (B737'newtype_ struct))
instance (Classes.ToStruct msg (B737 msg)) where
    toStruct (B737'newtype_ struct) = struct
instance (Untyped.HasMessage (B737 msg)) where
    type InMessage (B737 msg) = msg
    message (B737'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (B737 msg)) where
    messageDefault msg = (B737'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (B737 msg)) where
    fromPtr msg ptr = (B737'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (B737 (Message.MutMsg s))) where
    toPtr msg (B737'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (B737 (Message.MutMsg s))) where
    new msg = (B737'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (B737 msg)) where
    newtype List msg (B737 msg)
        = B737'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (B737'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (B737'List_ l) = (Untyped.ListStruct l)
    length (B737'List_ l) = (Untyped.length l)
    index i (B737'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (B737 (Message.MutMsg s))) where
    setIndex (B737'newtype_ elt) i (B737'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (B737'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_B737'base :: ((Untyped.ReadCtx m msg)) => (B737 msg) -> (m (PlaneBase msg))
get_B737'base (B737'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_B737'base :: ((Untyped.RWCtx m s)) => (B737 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
set_B737'base (B737'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_B737'base :: ((Untyped.ReadCtx m msg)) => (B737 msg) -> (m Std_.Bool)
has_B737'base (B737'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_B737'base :: ((Untyped.RWCtx m s)) => (B737 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
new_B737'base struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_B737'base struct result)
    (Std_.pure result)
    )
newtype A320 msg
    = A320'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg A320) where
    tMsg f (A320'newtype_ s) = (A320'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (A320 msg)) where
    fromStruct struct = (Std_.pure (A320'newtype_ struct))
instance (Classes.ToStruct msg (A320 msg)) where
    toStruct (A320'newtype_ struct) = struct
instance (Untyped.HasMessage (A320 msg)) where
    type InMessage (A320 msg) = msg
    message (A320'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (A320 msg)) where
    messageDefault msg = (A320'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (A320 msg)) where
    fromPtr msg ptr = (A320'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (A320 (Message.MutMsg s))) where
    toPtr msg (A320'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (A320 (Message.MutMsg s))) where
    new msg = (A320'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (A320 msg)) where
    newtype List msg (A320 msg)
        = A320'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (A320'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (A320'List_ l) = (Untyped.ListStruct l)
    length (A320'List_ l) = (Untyped.length l)
    index i (A320'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (A320 (Message.MutMsg s))) where
    setIndex (A320'newtype_ elt) i (A320'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (A320'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_A320'base :: ((Untyped.ReadCtx m msg)) => (A320 msg) -> (m (PlaneBase msg))
get_A320'base (A320'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_A320'base :: ((Untyped.RWCtx m s)) => (A320 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
set_A320'base (A320'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_A320'base :: ((Untyped.ReadCtx m msg)) => (A320 msg) -> (m Std_.Bool)
has_A320'base (A320'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_A320'base :: ((Untyped.RWCtx m s)) => (A320 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
new_A320'base struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_A320'base struct result)
    (Std_.pure result)
    )
newtype F16 msg
    = F16'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg F16) where
    tMsg f (F16'newtype_ s) = (F16'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (F16 msg)) where
    fromStruct struct = (Std_.pure (F16'newtype_ struct))
instance (Classes.ToStruct msg (F16 msg)) where
    toStruct (F16'newtype_ struct) = struct
instance (Untyped.HasMessage (F16 msg)) where
    type InMessage (F16 msg) = msg
    message (F16'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (F16 msg)) where
    messageDefault msg = (F16'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (F16 msg)) where
    fromPtr msg ptr = (F16'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (F16 (Message.MutMsg s))) where
    toPtr msg (F16'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (F16 (Message.MutMsg s))) where
    new msg = (F16'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (F16 msg)) where
    newtype List msg (F16 msg)
        = F16'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (F16'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (F16'List_ l) = (Untyped.ListStruct l)
    length (F16'List_ l) = (Untyped.length l)
    index i (F16'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (F16 (Message.MutMsg s))) where
    setIndex (F16'newtype_ elt) i (F16'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (F16'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_F16'base :: ((Untyped.ReadCtx m msg)) => (F16 msg) -> (m (PlaneBase msg))
get_F16'base (F16'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_F16'base :: ((Untyped.RWCtx m s)) => (F16 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
set_F16'base (F16'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_F16'base :: ((Untyped.ReadCtx m msg)) => (F16 msg) -> (m Std_.Bool)
has_F16'base (F16'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_F16'base :: ((Untyped.RWCtx m s)) => (F16 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
new_F16'base struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_F16'base struct result)
    (Std_.pure result)
    )
newtype Regression msg
    = Regression'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Regression) where
    tMsg f (Regression'newtype_ s) = (Regression'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Regression msg)) where
    fromStruct struct = (Std_.pure (Regression'newtype_ struct))
instance (Classes.ToStruct msg (Regression msg)) where
    toStruct (Regression'newtype_ struct) = struct
instance (Untyped.HasMessage (Regression msg)) where
    type InMessage (Regression msg) = msg
    message (Regression'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Regression msg)) where
    messageDefault msg = (Regression'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Regression msg)) where
    fromPtr msg ptr = (Regression'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Regression (Message.MutMsg s))) where
    toPtr msg (Regression'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Regression (Message.MutMsg s))) where
    new msg = (Regression'newtype_ <$> (Untyped.allocStruct msg 3 3))
instance (Basics.ListElem msg (Regression msg)) where
    newtype List msg (Regression msg)
        = Regression'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Regression'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Regression'List_ l) = (Untyped.ListStruct l)
    length (Regression'List_ l) = (Untyped.length l)
    index i (Regression'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Regression (Message.MutMsg s))) where
    setIndex (Regression'newtype_ elt) i (Regression'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Regression'List_ <$> (Untyped.allocCompositeList msg 3 3 len))
get_Regression'base :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (PlaneBase msg))
get_Regression'base (Regression'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Regression'base :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
set_Regression'base (Regression'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Regression'base :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
has_Regression'base (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Regression'base :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
new_Regression'base struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_Regression'base struct result)
    (Std_.pure result)
    )
get_Regression'b0 :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
get_Regression'b0 (Regression'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_Regression'b0 :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
set_Regression'b0 (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
get_Regression'beta :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (Basics.List msg Std_.Double))
get_Regression'beta (Regression'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Regression'beta :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Double) -> (m ())
set_Regression'beta (Regression'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_Regression'beta :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
has_Regression'beta (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_Regression'beta :: ((Untyped.RWCtx m s)) => Std_.Int -> (Regression (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Std_.Double))
new_Regression'beta len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Regression'beta struct result)
    (Std_.pure result)
    )
get_Regression'planes :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (Basics.List msg (Aircraft msg)))
get_Regression'planes (Regression'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 2 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Regression'planes :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))) -> (m ())
set_Regression'planes (Regression'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 2 struct)
    )
has_Regression'planes :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
has_Regression'planes (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
new_Regression'planes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Regression (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))))
new_Regression'planes len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Regression'planes struct result)
    (Std_.pure result)
    )
get_Regression'ymu :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
get_Regression'ymu (Regression'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_Regression'ymu :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
set_Regression'ymu (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
get_Regression'ysd :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
get_Regression'ysd (Regression'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
set_Regression'ysd :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
set_Regression'ysd (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
newtype Aircraft msg
    = Aircraft'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Aircraft) where
    tMsg f (Aircraft'newtype_ s) = (Aircraft'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Aircraft msg)) where
    fromStruct struct = (Std_.pure (Aircraft'newtype_ struct))
instance (Classes.ToStruct msg (Aircraft msg)) where
    toStruct (Aircraft'newtype_ struct) = struct
instance (Untyped.HasMessage (Aircraft msg)) where
    type InMessage (Aircraft msg) = msg
    message (Aircraft'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Aircraft msg)) where
    messageDefault msg = (Aircraft'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Aircraft msg)) where
    fromPtr msg ptr = (Aircraft'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Aircraft (Message.MutMsg s))) where
    toPtr msg (Aircraft'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Aircraft (Message.MutMsg s))) where
    new msg = (Aircraft'newtype_ <$> (Untyped.allocStruct msg 1 1))
instance (Basics.ListElem msg (Aircraft msg)) where
    newtype List msg (Aircraft msg)
        = Aircraft'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Aircraft'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Aircraft'List_ l) = (Untyped.ListStruct l)
    length (Aircraft'List_ l) = (Untyped.length l)
    index i (Aircraft'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Aircraft (Message.MutMsg s))) where
    setIndex (Aircraft'newtype_ elt) i (Aircraft'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Aircraft'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
data Aircraft' msg
    = Aircraft'void 
    | Aircraft'b737 (B737 msg)
    | Aircraft'a320 (A320 msg)
    | Aircraft'f16 (F16 msg)
    | Aircraft'unknown' Std_.Word16
instance (Classes.FromStruct msg (Aircraft' msg)) where
    fromStruct struct = (do
        tag <- (GenHelpers.getTag struct 0)
        case tag of
            0 ->
                (Std_.pure Aircraft'void)
            1 ->
                (Aircraft'b737 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            2 ->
                (Aircraft'a320 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            3 ->
                (Aircraft'f16 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            _ ->
                (Std_.pure (Aircraft'unknown' (Std_.fromIntegral tag)))
        )
get_Aircraft' :: ((Untyped.ReadCtx m msg)) => (Aircraft msg) -> (m (Aircraft' msg))
get_Aircraft' (Aircraft'newtype_ struct) = (Classes.fromStruct struct)
set_Aircraft'void :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (m ())
set_Aircraft'void (Aircraft'newtype_ struct) = (do
    (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
    (Std_.pure ())
    )
set_Aircraft'b737 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (B737 (Message.MutMsg s)) -> (m ())
set_Aircraft'b737 (Aircraft'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Aircraft'a320 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (A320 (Message.MutMsg s)) -> (m ())
set_Aircraft'a320 (Aircraft'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Aircraft'f16 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (F16 (Message.MutMsg s)) -> (m ())
set_Aircraft'f16 (Aircraft'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Aircraft'unknown' :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Aircraft'unknown' (Aircraft'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
newtype Z msg
    = Z'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Z) where
    tMsg f (Z'newtype_ s) = (Z'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Z msg)) where
    fromStruct struct = (Std_.pure (Z'newtype_ struct))
instance (Classes.ToStruct msg (Z msg)) where
    toStruct (Z'newtype_ struct) = struct
instance (Untyped.HasMessage (Z msg)) where
    type InMessage (Z msg) = msg
    message (Z'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Z msg)) where
    messageDefault msg = (Z'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Z msg)) where
    fromPtr msg ptr = (Z'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Z (Message.MutMsg s))) where
    toPtr msg (Z'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Z (Message.MutMsg s))) where
    new msg = (Z'newtype_ <$> (Untyped.allocStruct msg 3 1))
instance (Basics.ListElem msg (Z msg)) where
    newtype List msg (Z msg)
        = Z'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Z'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Z'List_ l) = (Untyped.ListStruct l)
    length (Z'List_ l) = (Untyped.length l)
    index i (Z'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Z (Message.MutMsg s))) where
    setIndex (Z'newtype_ elt) i (Z'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Z'List_ <$> (Untyped.allocCompositeList msg 3 1 len))
data Z' msg
    = Z'void 
    | Z'zz (Z msg)
    | Z'f64 Std_.Double
    | Z'f32 Std_.Float
    | Z'i64 Std_.Int64
    | Z'i32 Std_.Int32
    | Z'i16 Std_.Int16
    | Z'i8 Std_.Int8
    | Z'u64 Std_.Word64
    | Z'u32 Std_.Word32
    | Z'u16 Std_.Word16
    | Z'u8 Std_.Word8
    | Z'bool Std_.Bool
    | Z'text (Basics.Text msg)
    | Z'blob (Basics.Data msg)
    | Z'f64vec (Basics.List msg Std_.Double)
    | Z'f32vec (Basics.List msg Std_.Float)
    | Z'i64vec (Basics.List msg Std_.Int64)
    | Z'i32vec (Basics.List msg Std_.Int32)
    | Z'i16vec (Basics.List msg Std_.Int16)
    | Z'i8vec (Basics.List msg Std_.Int8)
    | Z'u64vec (Basics.List msg Std_.Word64)
    | Z'u32vec (Basics.List msg Std_.Word32)
    | Z'u16vec (Basics.List msg Std_.Word16)
    | Z'u8vec (Basics.List msg Std_.Word8)
    | Z'zvec (Basics.List msg (Z msg))
    | Z'zvecvec (Basics.List msg (Basics.List msg (Z msg)))
    | Z'zdate (Zdate msg)
    | Z'zdata (Zdata msg)
    | Z'aircraftvec (Basics.List msg (Aircraft msg))
    | Z'aircraft (Aircraft msg)
    | Z'regression (Regression msg)
    | Z'planebase (PlaneBase msg)
    | Z'airport Airport
    | Z'b737 (B737 msg)
    | Z'a320 (A320 msg)
    | Z'f16 (F16 msg)
    | Z'zdatevec (Basics.List msg (Zdate msg))
    | Z'zdatavec (Basics.List msg (Zdata msg))
    | Z'boolvec (Basics.List msg Std_.Bool)
    | Z'datavec (Basics.List msg (Basics.Data msg))
    | Z'textvec (Basics.List msg (Basics.Text msg))
    | Z'grp (Z'grp msg)
    | Z'echo (Echo msg)
    | Z'echoBases (EchoBases msg)
    | Z'unknown' Std_.Word16
instance (Classes.FromStruct msg (Z' msg)) where
    fromStruct struct = (do
        tag <- (GenHelpers.getTag struct 0)
        case tag of
            0 ->
                (Std_.pure Z'void)
            1 ->
                (Z'zz <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            2 ->
                (Z'f64 <$> (GenHelpers.getWordField struct 1 0 0))
            3 ->
                (Z'f32 <$> (GenHelpers.getWordField struct 1 0 0))
            4 ->
                (Z'i64 <$> (GenHelpers.getWordField struct 1 0 0))
            5 ->
                (Z'i32 <$> (GenHelpers.getWordField struct 1 0 0))
            6 ->
                (Z'i16 <$> (GenHelpers.getWordField struct 1 0 0))
            7 ->
                (Z'i8 <$> (GenHelpers.getWordField struct 1 0 0))
            8 ->
                (Z'u64 <$> (GenHelpers.getWordField struct 1 0 0))
            9 ->
                (Z'u32 <$> (GenHelpers.getWordField struct 1 0 0))
            10 ->
                (Z'u16 <$> (GenHelpers.getWordField struct 1 0 0))
            11 ->
                (Z'u8 <$> (GenHelpers.getWordField struct 1 0 0))
            12 ->
                (Z'bool <$> (GenHelpers.getWordField struct 1 0 0))
            13 ->
                (Z'text <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            14 ->
                (Z'blob <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            15 ->
                (Z'f64vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            16 ->
                (Z'f32vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            17 ->
                (Z'i64vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            18 ->
                (Z'i32vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            19 ->
                (Z'i16vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            20 ->
                (Z'i8vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            21 ->
                (Z'u64vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            22 ->
                (Z'u32vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            23 ->
                (Z'u16vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            24 ->
                (Z'u8vec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            25 ->
                (Z'zvec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            26 ->
                (Z'zvecvec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            27 ->
                (Z'zdate <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            28 ->
                (Z'zdata <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            29 ->
                (Z'aircraftvec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            30 ->
                (Z'aircraft <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            31 ->
                (Z'regression <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            32 ->
                (Z'planebase <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            33 ->
                (Z'airport <$> (GenHelpers.getWordField struct 1 0 0))
            34 ->
                (Z'b737 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            35 ->
                (Z'a320 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            36 ->
                (Z'f16 <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            37 ->
                (Z'zdatevec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            38 ->
                (Z'zdatavec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            39 ->
                (Z'boolvec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            40 ->
                (Z'datavec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            41 ->
                (Z'textvec <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            42 ->
                (Z'grp <$> (Classes.fromStruct struct))
            43 ->
                (Z'echo <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            44 ->
                (Z'echoBases <$> (do
                    ptr <- (Untyped.getPtr 0 struct)
                    (Classes.fromPtr (Untyped.message struct) ptr)
                    ))
            _ ->
                (Std_.pure (Z'unknown' (Std_.fromIntegral tag)))
        )
get_Z' :: ((Untyped.ReadCtx m msg)) => (Z msg) -> (m (Z' msg))
get_Z' (Z'newtype_ struct) = (Classes.fromStruct struct)
set_Z'void :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (m ())
set_Z'void (Z'newtype_ struct) = (do
    (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
    (Std_.pure ())
    )
set_Z'zz :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Z (Message.MutMsg s)) -> (m ())
set_Z'zz (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'f64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Double -> (m ())
set_Z'f64 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
    )
set_Z'f32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Float -> (m ())
set_Z'f32 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
    )
set_Z'i64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_Z'i64 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
    )
set_Z'i32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_Z'i32 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
    )
set_Z'i16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_Z'i16 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
    )
set_Z'i8 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int8 -> (m ())
set_Z'i8 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 1 0 0)
    )
set_Z'u64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Z'u64 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
    )
set_Z'u32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Z'u32 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
    )
set_Z'u16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Z'u16 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
    )
set_Z'u8 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word8 -> (m ())
set_Z'u8 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 1 0 0)
    )
set_Z'bool :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_Z'bool (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (12 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 0 0)
    )
set_Z'text :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Z'text (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (13 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'blob :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
set_Z'blob (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (14 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'f64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Double) -> (m ())
set_Z'f64vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (15 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'f32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Float) -> (m ())
set_Z'f32vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (16 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'i64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int64) -> (m ())
set_Z'i64vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (17 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'i32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int32) -> (m ())
set_Z'i32vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (18 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'i16vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int16) -> (m ())
set_Z'i16vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (19 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'i8vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int8) -> (m ())
set_Z'i8vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (20 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'u64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word64) -> (m ())
set_Z'u64vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (21 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'u32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word32) -> (m ())
set_Z'u32vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (22 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'u16vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word16) -> (m ())
set_Z'u16vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (23 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'u8vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word8) -> (m ())
set_Z'u8vec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (24 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Z (Message.MutMsg s))) -> (m ())
set_Z'zvec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (25 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zvecvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Z (Message.MutMsg s)))) -> (m ())
set_Z'zvecvec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (26 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zdate :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Zdate (Message.MutMsg s)) -> (m ())
set_Z'zdate (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (27 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zdata :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Zdata (Message.MutMsg s)) -> (m ())
set_Z'zdata (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (28 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'aircraftvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))) -> (m ())
set_Z'aircraftvec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (29 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'aircraft :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Aircraft (Message.MutMsg s)) -> (m ())
set_Z'aircraft (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (30 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'regression :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Regression (Message.MutMsg s)) -> (m ())
set_Z'regression (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (31 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'planebase :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
set_Z'planebase (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (32 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'airport :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Airport -> (m ())
set_Z'airport (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (33 :: Std_.Word16) 0 0 0)
    (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
    )
set_Z'b737 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (B737 (Message.MutMsg s)) -> (m ())
set_Z'b737 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (34 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'a320 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (A320 (Message.MutMsg s)) -> (m ())
set_Z'a320 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (35 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'f16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (F16 (Message.MutMsg s)) -> (m ())
set_Z'f16 (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (36 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zdatevec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zdate (Message.MutMsg s))) -> (m ())
set_Z'zdatevec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (37 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'zdatavec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zdata (Message.MutMsg s))) -> (m ())
set_Z'zdatavec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (38 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'boolvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Bool) -> (m ())
set_Z'boolvec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (39 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'datavec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Data (Message.MutMsg s))) -> (m ())
set_Z'datavec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (40 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'textvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
set_Z'textvec (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (41 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'grp :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (m (Z'grp (Message.MutMsg s)))
set_Z'grp (Z'newtype_ struct) = (do
    (GenHelpers.setWordField struct (42 :: Std_.Word16) 0 0 0)
    (Classes.fromStruct struct)
    )
set_Z'echo :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Echo (Message.MutMsg s)) -> (m ())
set_Z'echo (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (43 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'echoBases :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (EchoBases (Message.MutMsg s)) -> (m ())
set_Z'echoBases (Z'newtype_ struct) value = (do
    (GenHelpers.setWordField struct (44 :: Std_.Word16) 0 0 0)
    (do
        ptr <- (Classes.toPtr (Untyped.message struct) value)
        (Untyped.setPtr ptr 0 struct)
        )
    )
set_Z'unknown' :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_Z'unknown' (Z'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
newtype Z'grp msg
    = Z'grp'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Z'grp) where
    tMsg f (Z'grp'newtype_ s) = (Z'grp'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Z'grp msg)) where
    fromStruct struct = (Std_.pure (Z'grp'newtype_ struct))
instance (Classes.ToStruct msg (Z'grp msg)) where
    toStruct (Z'grp'newtype_ struct) = struct
instance (Untyped.HasMessage (Z'grp msg)) where
    type InMessage (Z'grp msg) = msg
    message (Z'grp'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Z'grp msg)) where
    messageDefault msg = (Z'grp'newtype_ (Untyped.messageDefault msg))
get_Z'grp'first :: ((Untyped.ReadCtx m msg)) => (Z'grp msg) -> (m Std_.Word64)
get_Z'grp'first (Z'grp'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_Z'grp'first :: ((Untyped.RWCtx m s)) => (Z'grp (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Z'grp'first (Z'grp'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
get_Z'grp'second :: ((Untyped.ReadCtx m msg)) => (Z'grp msg) -> (m Std_.Word64)
get_Z'grp'second (Z'grp'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
set_Z'grp'second :: ((Untyped.RWCtx m s)) => (Z'grp (Message.MutMsg s)) -> Std_.Word64 -> (m ())
set_Z'grp'second (Z'grp'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
newtype Counter msg
    = Counter'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Counter) where
    tMsg f (Counter'newtype_ s) = (Counter'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Counter msg)) where
    fromStruct struct = (Std_.pure (Counter'newtype_ struct))
instance (Classes.ToStruct msg (Counter msg)) where
    toStruct (Counter'newtype_ struct) = struct
instance (Untyped.HasMessage (Counter msg)) where
    type InMessage (Counter msg) = msg
    message (Counter'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Counter msg)) where
    messageDefault msg = (Counter'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Counter msg)) where
    fromPtr msg ptr = (Counter'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Counter (Message.MutMsg s))) where
    toPtr msg (Counter'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Counter (Message.MutMsg s))) where
    new msg = (Counter'newtype_ <$> (Untyped.allocStruct msg 1 2))
instance (Basics.ListElem msg (Counter msg)) where
    newtype List msg (Counter msg)
        = Counter'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Counter'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Counter'List_ l) = (Untyped.ListStruct l)
    length (Counter'List_ l) = (Untyped.length l)
    index i (Counter'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Counter (Message.MutMsg s))) where
    setIndex (Counter'newtype_ elt) i (Counter'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Counter'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
get_Counter'size :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Int64)
get_Counter'size (Counter'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_Counter'size :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_Counter'size (Counter'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
get_Counter'words :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m (Basics.Text msg))
get_Counter'words (Counter'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Counter'words :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Counter'words (Counter'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Counter'words :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Bool)
has_Counter'words (Counter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Counter'words :: ((Untyped.RWCtx m s)) => Std_.Int -> (Counter (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Counter'words len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_Counter'words struct result)
    (Std_.pure result)
    )
get_Counter'wordlist :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m (Basics.List msg (Basics.Text msg)))
get_Counter'wordlist (Counter'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Counter'wordlist :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
set_Counter'wordlist (Counter'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_Counter'wordlist :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Bool)
has_Counter'wordlist (Counter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_Counter'wordlist :: ((Untyped.RWCtx m s)) => Std_.Int -> (Counter (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
new_Counter'wordlist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Counter'wordlist struct result)
    (Std_.pure result)
    )
newtype Bag msg
    = Bag'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Bag) where
    tMsg f (Bag'newtype_ s) = (Bag'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Bag msg)) where
    fromStruct struct = (Std_.pure (Bag'newtype_ struct))
instance (Classes.ToStruct msg (Bag msg)) where
    toStruct (Bag'newtype_ struct) = struct
instance (Untyped.HasMessage (Bag msg)) where
    type InMessage (Bag msg) = msg
    message (Bag'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Bag msg)) where
    messageDefault msg = (Bag'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Bag msg)) where
    fromPtr msg ptr = (Bag'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Bag (Message.MutMsg s))) where
    toPtr msg (Bag'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Bag (Message.MutMsg s))) where
    new msg = (Bag'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Bag msg)) where
    newtype List msg (Bag msg)
        = Bag'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Bag'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Bag'List_ l) = (Untyped.ListStruct l)
    length (Bag'List_ l) = (Untyped.length l)
    index i (Bag'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Bag (Message.MutMsg s))) where
    setIndex (Bag'newtype_ elt) i (Bag'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Bag'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Bag'counter :: ((Untyped.ReadCtx m msg)) => (Bag msg) -> (m (Counter msg))
get_Bag'counter (Bag'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Bag'counter :: ((Untyped.RWCtx m s)) => (Bag (Message.MutMsg s)) -> (Counter (Message.MutMsg s)) -> (m ())
set_Bag'counter (Bag'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Bag'counter :: ((Untyped.ReadCtx m msg)) => (Bag msg) -> (m Std_.Bool)
has_Bag'counter (Bag'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Bag'counter :: ((Untyped.RWCtx m s)) => (Bag (Message.MutMsg s)) -> (m (Counter (Message.MutMsg s)))
new_Bag'counter struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_Bag'counter struct result)
    (Std_.pure result)
    )
newtype Zserver msg
    = Zserver'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Zserver) where
    tMsg f (Zserver'newtype_ s) = (Zserver'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Zserver msg)) where
    fromStruct struct = (Std_.pure (Zserver'newtype_ struct))
instance (Classes.ToStruct msg (Zserver msg)) where
    toStruct (Zserver'newtype_ struct) = struct
instance (Untyped.HasMessage (Zserver msg)) where
    type InMessage (Zserver msg) = msg
    message (Zserver'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Zserver msg)) where
    messageDefault msg = (Zserver'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Zserver msg)) where
    fromPtr msg ptr = (Zserver'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Zserver (Message.MutMsg s))) where
    toPtr msg (Zserver'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Zserver (Message.MutMsg s))) where
    new msg = (Zserver'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Zserver msg)) where
    newtype List msg (Zserver msg)
        = Zserver'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Zserver'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Zserver'List_ l) = (Untyped.ListStruct l)
    length (Zserver'List_ l) = (Untyped.length l)
    index i (Zserver'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Zserver (Message.MutMsg s))) where
    setIndex (Zserver'newtype_ elt) i (Zserver'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Zserver'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Zserver'waitingjobs :: ((Untyped.ReadCtx m msg)) => (Zserver msg) -> (m (Basics.List msg (Zjob msg)))
get_Zserver'waitingjobs (Zserver'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Zserver'waitingjobs :: ((Untyped.RWCtx m s)) => (Zserver (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zjob (Message.MutMsg s))) -> (m ())
set_Zserver'waitingjobs (Zserver'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Zserver'waitingjobs :: ((Untyped.ReadCtx m msg)) => (Zserver msg) -> (m Std_.Bool)
has_Zserver'waitingjobs (Zserver'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Zserver'waitingjobs :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zserver (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Zjob (Message.MutMsg s))))
new_Zserver'waitingjobs len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Zserver'waitingjobs struct result)
    (Std_.pure result)
    )
newtype Zjob msg
    = Zjob'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Zjob) where
    tMsg f (Zjob'newtype_ s) = (Zjob'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Zjob msg)) where
    fromStruct struct = (Std_.pure (Zjob'newtype_ struct))
instance (Classes.ToStruct msg (Zjob msg)) where
    toStruct (Zjob'newtype_ struct) = struct
instance (Untyped.HasMessage (Zjob msg)) where
    type InMessage (Zjob msg) = msg
    message (Zjob'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Zjob msg)) where
    messageDefault msg = (Zjob'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Zjob msg)) where
    fromPtr msg ptr = (Zjob'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Zjob (Message.MutMsg s))) where
    toPtr msg (Zjob'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Zjob (Message.MutMsg s))) where
    new msg = (Zjob'newtype_ <$> (Untyped.allocStruct msg 0 2))
instance (Basics.ListElem msg (Zjob msg)) where
    newtype List msg (Zjob msg)
        = Zjob'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Zjob'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Zjob'List_ l) = (Untyped.ListStruct l)
    length (Zjob'List_ l) = (Untyped.length l)
    index i (Zjob'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Zjob (Message.MutMsg s))) where
    setIndex (Zjob'newtype_ elt) i (Zjob'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Zjob'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
get_Zjob'cmd :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m (Basics.Text msg))
get_Zjob'cmd (Zjob'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Zjob'cmd :: ((Untyped.RWCtx m s)) => (Zjob (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Zjob'cmd (Zjob'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Zjob'cmd :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m Std_.Bool)
has_Zjob'cmd (Zjob'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Zjob'cmd :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zjob (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Zjob'cmd len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_Zjob'cmd struct result)
    (Std_.pure result)
    )
get_Zjob'args :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m (Basics.List msg (Basics.Text msg)))
get_Zjob'args (Zjob'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Zjob'args :: ((Untyped.RWCtx m s)) => (Zjob (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
set_Zjob'args (Zjob'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_Zjob'args :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m Std_.Bool)
has_Zjob'args (Zjob'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_Zjob'args :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zjob (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
new_Zjob'args len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Zjob'args struct result)
    (Std_.pure result)
    )
newtype VerEmpty msg
    = VerEmpty'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerEmpty) where
    tMsg f (VerEmpty'newtype_ s) = (VerEmpty'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerEmpty msg)) where
    fromStruct struct = (Std_.pure (VerEmpty'newtype_ struct))
instance (Classes.ToStruct msg (VerEmpty msg)) where
    toStruct (VerEmpty'newtype_ struct) = struct
instance (Untyped.HasMessage (VerEmpty msg)) where
    type InMessage (VerEmpty msg) = msg
    message (VerEmpty'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerEmpty msg)) where
    messageDefault msg = (VerEmpty'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerEmpty msg)) where
    fromPtr msg ptr = (VerEmpty'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerEmpty (Message.MutMsg s))) where
    toPtr msg (VerEmpty'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerEmpty (Message.MutMsg s))) where
    new msg = (VerEmpty'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (VerEmpty msg)) where
    newtype List msg (VerEmpty msg)
        = VerEmpty'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerEmpty'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerEmpty'List_ l) = (Untyped.ListStruct l)
    length (VerEmpty'List_ l) = (Untyped.length l)
    index i (VerEmpty'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerEmpty (Message.MutMsg s))) where
    setIndex (VerEmpty'newtype_ elt) i (VerEmpty'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerEmpty'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype VerOneData msg
    = VerOneData'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerOneData) where
    tMsg f (VerOneData'newtype_ s) = (VerOneData'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerOneData msg)) where
    fromStruct struct = (Std_.pure (VerOneData'newtype_ struct))
instance (Classes.ToStruct msg (VerOneData msg)) where
    toStruct (VerOneData'newtype_ struct) = struct
instance (Untyped.HasMessage (VerOneData msg)) where
    type InMessage (VerOneData msg) = msg
    message (VerOneData'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerOneData msg)) where
    messageDefault msg = (VerOneData'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerOneData msg)) where
    fromPtr msg ptr = (VerOneData'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerOneData (Message.MutMsg s))) where
    toPtr msg (VerOneData'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerOneData (Message.MutMsg s))) where
    new msg = (VerOneData'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (VerOneData msg)) where
    newtype List msg (VerOneData msg)
        = VerOneData'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerOneData'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerOneData'List_ l) = (Untyped.ListStruct l)
    length (VerOneData'List_ l) = (Untyped.length l)
    index i (VerOneData'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerOneData (Message.MutMsg s))) where
    setIndex (VerOneData'newtype_ elt) i (VerOneData'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerOneData'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
get_VerOneData'val :: ((Untyped.ReadCtx m msg)) => (VerOneData msg) -> (m Std_.Int16)
get_VerOneData'val (VerOneData'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_VerOneData'val :: ((Untyped.RWCtx m s)) => (VerOneData (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_VerOneData'val (VerOneData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
newtype VerTwoData msg
    = VerTwoData'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerTwoData) where
    tMsg f (VerTwoData'newtype_ s) = (VerTwoData'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerTwoData msg)) where
    fromStruct struct = (Std_.pure (VerTwoData'newtype_ struct))
instance (Classes.ToStruct msg (VerTwoData msg)) where
    toStruct (VerTwoData'newtype_ struct) = struct
instance (Untyped.HasMessage (VerTwoData msg)) where
    type InMessage (VerTwoData msg) = msg
    message (VerTwoData'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerTwoData msg)) where
    messageDefault msg = (VerTwoData'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerTwoData msg)) where
    fromPtr msg ptr = (VerTwoData'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerTwoData (Message.MutMsg s))) where
    toPtr msg (VerTwoData'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerTwoData (Message.MutMsg s))) where
    new msg = (VerTwoData'newtype_ <$> (Untyped.allocStruct msg 2 0))
instance (Basics.ListElem msg (VerTwoData msg)) where
    newtype List msg (VerTwoData msg)
        = VerTwoData'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerTwoData'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerTwoData'List_ l) = (Untyped.ListStruct l)
    length (VerTwoData'List_ l) = (Untyped.length l)
    index i (VerTwoData'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerTwoData (Message.MutMsg s))) where
    setIndex (VerTwoData'newtype_ elt) i (VerTwoData'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerTwoData'List_ <$> (Untyped.allocCompositeList msg 2 0 len))
get_VerTwoData'val :: ((Untyped.ReadCtx m msg)) => (VerTwoData msg) -> (m Std_.Int16)
get_VerTwoData'val (VerTwoData'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_VerTwoData'val :: ((Untyped.RWCtx m s)) => (VerTwoData (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_VerTwoData'val (VerTwoData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
get_VerTwoData'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoData msg) -> (m Std_.Int64)
get_VerTwoData'duo (VerTwoData'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_VerTwoData'duo :: ((Untyped.RWCtx m s)) => (VerTwoData (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_VerTwoData'duo (VerTwoData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
newtype VerOnePtr msg
    = VerOnePtr'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerOnePtr) where
    tMsg f (VerOnePtr'newtype_ s) = (VerOnePtr'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerOnePtr msg)) where
    fromStruct struct = (Std_.pure (VerOnePtr'newtype_ struct))
instance (Classes.ToStruct msg (VerOnePtr msg)) where
    toStruct (VerOnePtr'newtype_ struct) = struct
instance (Untyped.HasMessage (VerOnePtr msg)) where
    type InMessage (VerOnePtr msg) = msg
    message (VerOnePtr'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerOnePtr msg)) where
    messageDefault msg = (VerOnePtr'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerOnePtr msg)) where
    fromPtr msg ptr = (VerOnePtr'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerOnePtr (Message.MutMsg s))) where
    toPtr msg (VerOnePtr'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerOnePtr (Message.MutMsg s))) where
    new msg = (VerOnePtr'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (VerOnePtr msg)) where
    newtype List msg (VerOnePtr msg)
        = VerOnePtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerOnePtr'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerOnePtr'List_ l) = (Untyped.ListStruct l)
    length (VerOnePtr'List_ l) = (Untyped.length l)
    index i (VerOnePtr'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerOnePtr (Message.MutMsg s))) where
    setIndex (VerOnePtr'newtype_ elt) i (VerOnePtr'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerOnePtr'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_VerOnePtr'ptr :: ((Untyped.ReadCtx m msg)) => (VerOnePtr msg) -> (m (VerOneData msg))
get_VerOnePtr'ptr (VerOnePtr'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerOnePtr'ptr :: ((Untyped.RWCtx m s)) => (VerOnePtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
set_VerOnePtr'ptr (VerOnePtr'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_VerOnePtr'ptr :: ((Untyped.ReadCtx m msg)) => (VerOnePtr msg) -> (m Std_.Bool)
has_VerOnePtr'ptr (VerOnePtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_VerOnePtr'ptr :: ((Untyped.RWCtx m s)) => (VerOnePtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
new_VerOnePtr'ptr struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerOnePtr'ptr struct result)
    (Std_.pure result)
    )
newtype VerTwoPtr msg
    = VerTwoPtr'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerTwoPtr) where
    tMsg f (VerTwoPtr'newtype_ s) = (VerTwoPtr'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerTwoPtr msg)) where
    fromStruct struct = (Std_.pure (VerTwoPtr'newtype_ struct))
instance (Classes.ToStruct msg (VerTwoPtr msg)) where
    toStruct (VerTwoPtr'newtype_ struct) = struct
instance (Untyped.HasMessage (VerTwoPtr msg)) where
    type InMessage (VerTwoPtr msg) = msg
    message (VerTwoPtr'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerTwoPtr msg)) where
    messageDefault msg = (VerTwoPtr'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerTwoPtr msg)) where
    fromPtr msg ptr = (VerTwoPtr'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerTwoPtr (Message.MutMsg s))) where
    toPtr msg (VerTwoPtr'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerTwoPtr (Message.MutMsg s))) where
    new msg = (VerTwoPtr'newtype_ <$> (Untyped.allocStruct msg 0 2))
instance (Basics.ListElem msg (VerTwoPtr msg)) where
    newtype List msg (VerTwoPtr msg)
        = VerTwoPtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerTwoPtr'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerTwoPtr'List_ l) = (Untyped.ListStruct l)
    length (VerTwoPtr'List_ l) = (Untyped.length l)
    index i (VerTwoPtr'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerTwoPtr (Message.MutMsg s))) where
    setIndex (VerTwoPtr'newtype_ elt) i (VerTwoPtr'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerTwoPtr'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
get_VerTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m (VerOneData msg))
get_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
set_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_VerTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m Std_.Bool)
has_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_VerTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
new_VerTwoPtr'ptr1 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoPtr'ptr1 struct result)
    (Std_.pure result)
    )
get_VerTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m (VerOneData msg))
get_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
set_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_VerTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m Std_.Bool)
has_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_VerTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
new_VerTwoPtr'ptr2 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoPtr'ptr2 struct result)
    (Std_.pure result)
    )
newtype VerTwoDataTwoPtr msg
    = VerTwoDataTwoPtr'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerTwoDataTwoPtr) where
    tMsg f (VerTwoDataTwoPtr'newtype_ s) = (VerTwoDataTwoPtr'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerTwoDataTwoPtr msg)) where
    fromStruct struct = (Std_.pure (VerTwoDataTwoPtr'newtype_ struct))
instance (Classes.ToStruct msg (VerTwoDataTwoPtr msg)) where
    toStruct (VerTwoDataTwoPtr'newtype_ struct) = struct
instance (Untyped.HasMessage (VerTwoDataTwoPtr msg)) where
    type InMessage (VerTwoDataTwoPtr msg) = msg
    message (VerTwoDataTwoPtr'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerTwoDataTwoPtr msg)) where
    messageDefault msg = (VerTwoDataTwoPtr'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerTwoDataTwoPtr msg)) where
    fromPtr msg ptr = (VerTwoDataTwoPtr'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerTwoDataTwoPtr (Message.MutMsg s))) where
    toPtr msg (VerTwoDataTwoPtr'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerTwoDataTwoPtr (Message.MutMsg s))) where
    new msg = (VerTwoDataTwoPtr'newtype_ <$> (Untyped.allocStruct msg 2 2))
instance (Basics.ListElem msg (VerTwoDataTwoPtr msg)) where
    newtype List msg (VerTwoDataTwoPtr msg)
        = VerTwoDataTwoPtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerTwoDataTwoPtr'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerTwoDataTwoPtr'List_ l) = (Untyped.ListStruct l)
    length (VerTwoDataTwoPtr'List_ l) = (Untyped.length l)
    index i (VerTwoDataTwoPtr'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerTwoDataTwoPtr (Message.MutMsg s))) where
    setIndex (VerTwoDataTwoPtr'newtype_ elt) i (VerTwoDataTwoPtr'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerTwoDataTwoPtr'List_ <$> (Untyped.allocCompositeList msg 2 2 len))
get_VerTwoDataTwoPtr'val :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Int16)
get_VerTwoDataTwoPtr'val (VerTwoDataTwoPtr'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_VerTwoDataTwoPtr'val :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_VerTwoDataTwoPtr'val (VerTwoDataTwoPtr'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
get_VerTwoDataTwoPtr'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Int64)
get_VerTwoDataTwoPtr'duo (VerTwoDataTwoPtr'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_VerTwoDataTwoPtr'duo :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_VerTwoDataTwoPtr'duo (VerTwoDataTwoPtr'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
get_VerTwoDataTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m (VerOneData msg))
get_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoDataTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
set_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_VerTwoDataTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Bool)
has_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_VerTwoDataTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
new_VerTwoDataTwoPtr'ptr1 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoDataTwoPtr'ptr1 struct result)
    (Std_.pure result)
    )
get_VerTwoDataTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m (VerOneData msg))
get_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoDataTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
set_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_VerTwoDataTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Bool)
has_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_VerTwoDataTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
new_VerTwoDataTwoPtr'ptr2 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoDataTwoPtr'ptr2 struct result)
    (Std_.pure result)
    )
newtype HoldsVerEmptyList msg
    = HoldsVerEmptyList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerEmptyList) where
    tMsg f (HoldsVerEmptyList'newtype_ s) = (HoldsVerEmptyList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerEmptyList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerEmptyList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerEmptyList msg)) where
    toStruct (HoldsVerEmptyList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerEmptyList msg)) where
    type InMessage (HoldsVerEmptyList msg) = msg
    message (HoldsVerEmptyList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerEmptyList msg)) where
    messageDefault msg = (HoldsVerEmptyList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerEmptyList msg)) where
    fromPtr msg ptr = (HoldsVerEmptyList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerEmptyList (Message.MutMsg s))) where
    toPtr msg (HoldsVerEmptyList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerEmptyList (Message.MutMsg s))) where
    new msg = (HoldsVerEmptyList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerEmptyList msg)) where
    newtype List msg (HoldsVerEmptyList msg)
        = HoldsVerEmptyList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerEmptyList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerEmptyList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerEmptyList'List_ l) = (Untyped.length l)
    index i (HoldsVerEmptyList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerEmptyList (Message.MutMsg s))) where
    setIndex (HoldsVerEmptyList'newtype_ elt) i (HoldsVerEmptyList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerEmptyList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerEmptyList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerEmptyList msg) -> (m (Basics.List msg (VerEmpty msg)))
get_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerEmptyList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerEmptyList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerEmpty (Message.MutMsg s))) -> (m ())
set_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerEmptyList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerEmptyList msg) -> (m Std_.Bool)
has_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerEmptyList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerEmptyList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerEmpty (Message.MutMsg s))))
new_HoldsVerEmptyList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerEmptyList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerOneDataList msg
    = HoldsVerOneDataList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerOneDataList) where
    tMsg f (HoldsVerOneDataList'newtype_ s) = (HoldsVerOneDataList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerOneDataList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerOneDataList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerOneDataList msg)) where
    toStruct (HoldsVerOneDataList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerOneDataList msg)) where
    type InMessage (HoldsVerOneDataList msg) = msg
    message (HoldsVerOneDataList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerOneDataList msg)) where
    messageDefault msg = (HoldsVerOneDataList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerOneDataList msg)) where
    fromPtr msg ptr = (HoldsVerOneDataList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerOneDataList (Message.MutMsg s))) where
    toPtr msg (HoldsVerOneDataList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerOneDataList (Message.MutMsg s))) where
    new msg = (HoldsVerOneDataList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerOneDataList msg)) where
    newtype List msg (HoldsVerOneDataList msg)
        = HoldsVerOneDataList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerOneDataList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerOneDataList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerOneDataList'List_ l) = (Untyped.length l)
    index i (HoldsVerOneDataList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerOneDataList (Message.MutMsg s))) where
    setIndex (HoldsVerOneDataList'newtype_ elt) i (HoldsVerOneDataList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerOneDataList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerOneDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOneDataList msg) -> (m (Basics.List msg (VerOneData msg)))
get_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerOneDataList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerOneDataList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerOneData (Message.MutMsg s))) -> (m ())
set_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerOneDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOneDataList msg) -> (m Std_.Bool)
has_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerOneDataList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerOneDataList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerOneData (Message.MutMsg s))))
new_HoldsVerOneDataList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerOneDataList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerTwoDataList msg
    = HoldsVerTwoDataList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerTwoDataList) where
    tMsg f (HoldsVerTwoDataList'newtype_ s) = (HoldsVerTwoDataList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerTwoDataList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerTwoDataList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerTwoDataList msg)) where
    toStruct (HoldsVerTwoDataList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerTwoDataList msg)) where
    type InMessage (HoldsVerTwoDataList msg) = msg
    message (HoldsVerTwoDataList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerTwoDataList msg)) where
    messageDefault msg = (HoldsVerTwoDataList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerTwoDataList msg)) where
    fromPtr msg ptr = (HoldsVerTwoDataList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerTwoDataList (Message.MutMsg s))) where
    toPtr msg (HoldsVerTwoDataList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerTwoDataList (Message.MutMsg s))) where
    new msg = (HoldsVerTwoDataList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerTwoDataList msg)) where
    newtype List msg (HoldsVerTwoDataList msg)
        = HoldsVerTwoDataList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerTwoDataList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerTwoDataList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerTwoDataList'List_ l) = (Untyped.length l)
    index i (HoldsVerTwoDataList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerTwoDataList (Message.MutMsg s))) where
    setIndex (HoldsVerTwoDataList'newtype_ elt) i (HoldsVerTwoDataList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerTwoDataList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerTwoDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoDataList msg) -> (m (Basics.List msg (VerTwoData msg)))
get_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerTwoDataList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoDataList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoData (Message.MutMsg s))) -> (m ())
set_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerTwoDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoDataList msg) -> (m Std_.Bool)
has_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerTwoDataList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoDataList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoData (Message.MutMsg s))))
new_HoldsVerTwoDataList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerTwoDataList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerOnePtrList msg
    = HoldsVerOnePtrList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerOnePtrList) where
    tMsg f (HoldsVerOnePtrList'newtype_ s) = (HoldsVerOnePtrList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerOnePtrList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerOnePtrList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerOnePtrList msg)) where
    toStruct (HoldsVerOnePtrList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerOnePtrList msg)) where
    type InMessage (HoldsVerOnePtrList msg) = msg
    message (HoldsVerOnePtrList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerOnePtrList msg)) where
    messageDefault msg = (HoldsVerOnePtrList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerOnePtrList msg)) where
    fromPtr msg ptr = (HoldsVerOnePtrList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerOnePtrList (Message.MutMsg s))) where
    toPtr msg (HoldsVerOnePtrList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerOnePtrList (Message.MutMsg s))) where
    new msg = (HoldsVerOnePtrList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerOnePtrList msg)) where
    newtype List msg (HoldsVerOnePtrList msg)
        = HoldsVerOnePtrList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerOnePtrList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerOnePtrList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerOnePtrList'List_ l) = (Untyped.length l)
    index i (HoldsVerOnePtrList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerOnePtrList (Message.MutMsg s))) where
    setIndex (HoldsVerOnePtrList'newtype_ elt) i (HoldsVerOnePtrList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerOnePtrList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerOnePtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOnePtrList msg) -> (m (Basics.List msg (VerOnePtr msg)))
get_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerOnePtrList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerOnePtrList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerOnePtr (Message.MutMsg s))) -> (m ())
set_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerOnePtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOnePtrList msg) -> (m Std_.Bool)
has_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerOnePtrList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerOnePtrList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerOnePtr (Message.MutMsg s))))
new_HoldsVerOnePtrList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerOnePtrList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerTwoPtrList msg
    = HoldsVerTwoPtrList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerTwoPtrList) where
    tMsg f (HoldsVerTwoPtrList'newtype_ s) = (HoldsVerTwoPtrList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerTwoPtrList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerTwoPtrList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerTwoPtrList msg)) where
    toStruct (HoldsVerTwoPtrList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerTwoPtrList msg)) where
    type InMessage (HoldsVerTwoPtrList msg) = msg
    message (HoldsVerTwoPtrList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerTwoPtrList msg)) where
    messageDefault msg = (HoldsVerTwoPtrList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerTwoPtrList msg)) where
    fromPtr msg ptr = (HoldsVerTwoPtrList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerTwoPtrList (Message.MutMsg s))) where
    toPtr msg (HoldsVerTwoPtrList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerTwoPtrList (Message.MutMsg s))) where
    new msg = (HoldsVerTwoPtrList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerTwoPtrList msg)) where
    newtype List msg (HoldsVerTwoPtrList msg)
        = HoldsVerTwoPtrList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerTwoPtrList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerTwoPtrList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerTwoPtrList'List_ l) = (Untyped.length l)
    index i (HoldsVerTwoPtrList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerTwoPtrList (Message.MutMsg s))) where
    setIndex (HoldsVerTwoPtrList'newtype_ elt) i (HoldsVerTwoPtrList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerTwoPtrList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerTwoPtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoPtrList msg) -> (m (Basics.List msg (VerTwoPtr msg)))
get_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerTwoPtrList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoPtrList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoPtr (Message.MutMsg s))) -> (m ())
set_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerTwoPtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoPtrList msg) -> (m Std_.Bool)
has_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerTwoPtrList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoPtrList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoPtr (Message.MutMsg s))))
new_HoldsVerTwoPtrList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerTwoPtrList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerTwoTwoList msg
    = HoldsVerTwoTwoList'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerTwoTwoList) where
    tMsg f (HoldsVerTwoTwoList'newtype_ s) = (HoldsVerTwoTwoList'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerTwoTwoList msg)) where
    fromStruct struct = (Std_.pure (HoldsVerTwoTwoList'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerTwoTwoList msg)) where
    toStruct (HoldsVerTwoTwoList'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerTwoTwoList msg)) where
    type InMessage (HoldsVerTwoTwoList msg) = msg
    message (HoldsVerTwoTwoList'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerTwoTwoList msg)) where
    messageDefault msg = (HoldsVerTwoTwoList'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerTwoTwoList msg)) where
    fromPtr msg ptr = (HoldsVerTwoTwoList'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerTwoTwoList (Message.MutMsg s))) where
    toPtr msg (HoldsVerTwoTwoList'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerTwoTwoList (Message.MutMsg s))) where
    new msg = (HoldsVerTwoTwoList'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerTwoTwoList msg)) where
    newtype List msg (HoldsVerTwoTwoList msg)
        = HoldsVerTwoTwoList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerTwoTwoList'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerTwoTwoList'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerTwoTwoList'List_ l) = (Untyped.length l)
    index i (HoldsVerTwoTwoList'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerTwoTwoList (Message.MutMsg s))) where
    setIndex (HoldsVerTwoTwoList'newtype_ elt) i (HoldsVerTwoTwoList'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerTwoTwoList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerTwoTwoList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoList msg) -> (m (Basics.List msg (VerTwoDataTwoPtr msg)))
get_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerTwoTwoList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoTwoList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoDataTwoPtr (Message.MutMsg s))) -> (m ())
set_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerTwoTwoList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoList msg) -> (m Std_.Bool)
has_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerTwoTwoList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoTwoList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoDataTwoPtr (Message.MutMsg s))))
new_HoldsVerTwoTwoList'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerTwoTwoList'mylist struct result)
    (Std_.pure result)
    )
newtype HoldsVerTwoTwoPlus msg
    = HoldsVerTwoTwoPlus'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsVerTwoTwoPlus) where
    tMsg f (HoldsVerTwoTwoPlus'newtype_ s) = (HoldsVerTwoTwoPlus'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsVerTwoTwoPlus msg)) where
    fromStruct struct = (Std_.pure (HoldsVerTwoTwoPlus'newtype_ struct))
instance (Classes.ToStruct msg (HoldsVerTwoTwoPlus msg)) where
    toStruct (HoldsVerTwoTwoPlus'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsVerTwoTwoPlus msg)) where
    type InMessage (HoldsVerTwoTwoPlus msg) = msg
    message (HoldsVerTwoTwoPlus'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsVerTwoTwoPlus msg)) where
    messageDefault msg = (HoldsVerTwoTwoPlus'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsVerTwoTwoPlus msg)) where
    fromPtr msg ptr = (HoldsVerTwoTwoPlus'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
    toPtr msg (HoldsVerTwoTwoPlus'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
    new msg = (HoldsVerTwoTwoPlus'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (HoldsVerTwoTwoPlus msg)) where
    newtype List msg (HoldsVerTwoTwoPlus msg)
        = HoldsVerTwoTwoPlus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsVerTwoTwoPlus'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsVerTwoTwoPlus'List_ l) = (Untyped.ListStruct l)
    length (HoldsVerTwoTwoPlus'List_ l) = (Untyped.length l)
    index i (HoldsVerTwoTwoPlus'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
    setIndex (HoldsVerTwoTwoPlus'newtype_ elt) i (HoldsVerTwoTwoPlus'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsVerTwoTwoPlus'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_HoldsVerTwoTwoPlus'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoPlus msg) -> (m (Basics.List msg (VerTwoTwoPlus msg)))
get_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsVerTwoTwoPlus'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoTwoPlus (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoTwoPlus (Message.MutMsg s))) -> (m ())
set_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsVerTwoTwoPlus'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoPlus msg) -> (m Std_.Bool)
has_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsVerTwoTwoPlus'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoTwoPlus (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoTwoPlus (Message.MutMsg s))))
new_HoldsVerTwoTwoPlus'mylist len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsVerTwoTwoPlus'mylist struct result)
    (Std_.pure result)
    )
newtype VerTwoTwoPlus msg
    = VerTwoTwoPlus'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VerTwoTwoPlus) where
    tMsg f (VerTwoTwoPlus'newtype_ s) = (VerTwoTwoPlus'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VerTwoTwoPlus msg)) where
    fromStruct struct = (Std_.pure (VerTwoTwoPlus'newtype_ struct))
instance (Classes.ToStruct msg (VerTwoTwoPlus msg)) where
    toStruct (VerTwoTwoPlus'newtype_ struct) = struct
instance (Untyped.HasMessage (VerTwoTwoPlus msg)) where
    type InMessage (VerTwoTwoPlus msg) = msg
    message (VerTwoTwoPlus'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VerTwoTwoPlus msg)) where
    messageDefault msg = (VerTwoTwoPlus'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VerTwoTwoPlus msg)) where
    fromPtr msg ptr = (VerTwoTwoPlus'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VerTwoTwoPlus (Message.MutMsg s))) where
    toPtr msg (VerTwoTwoPlus'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VerTwoTwoPlus (Message.MutMsg s))) where
    new msg = (VerTwoTwoPlus'newtype_ <$> (Untyped.allocStruct msg 3 3))
instance (Basics.ListElem msg (VerTwoTwoPlus msg)) where
    newtype List msg (VerTwoTwoPlus msg)
        = VerTwoTwoPlus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VerTwoTwoPlus'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VerTwoTwoPlus'List_ l) = (Untyped.ListStruct l)
    length (VerTwoTwoPlus'List_ l) = (Untyped.length l)
    index i (VerTwoTwoPlus'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VerTwoTwoPlus (Message.MutMsg s))) where
    setIndex (VerTwoTwoPlus'newtype_ elt) i (VerTwoTwoPlus'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VerTwoTwoPlus'List_ <$> (Untyped.allocCompositeList msg 3 3 len))
get_VerTwoTwoPlus'val :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int16)
get_VerTwoTwoPlus'val (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_VerTwoTwoPlus'val :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int16 -> (m ())
set_VerTwoTwoPlus'val (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
get_VerTwoTwoPlus'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int64)
get_VerTwoTwoPlus'duo (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_VerTwoTwoPlus'duo :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_VerTwoTwoPlus'duo (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
get_VerTwoTwoPlus'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (VerTwoDataTwoPtr msg))
get_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoTwoPlus'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
set_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_VerTwoTwoPlus'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
has_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_VerTwoTwoPlus'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
new_VerTwoTwoPlus'ptr1 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoTwoPlus'ptr1 struct result)
    (Std_.pure result)
    )
get_VerTwoTwoPlus'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (VerTwoDataTwoPtr msg))
get_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoTwoPlus'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
set_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_VerTwoTwoPlus'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
has_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_VerTwoTwoPlus'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
new_VerTwoTwoPlus'ptr2 struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_VerTwoTwoPlus'ptr2 struct result)
    (Std_.pure result)
    )
get_VerTwoTwoPlus'tre :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int64)
get_VerTwoTwoPlus'tre (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
set_VerTwoTwoPlus'tre :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_VerTwoTwoPlus'tre (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
get_VerTwoTwoPlus'lst3 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (Basics.List msg Std_.Int64))
get_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 2 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_VerTwoTwoPlus'lst3 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int64) -> (m ())
set_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 2 struct)
    )
has_VerTwoTwoPlus'lst3 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
has_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
new_VerTwoTwoPlus'lst3 :: ((Untyped.RWCtx m s)) => Std_.Int -> (VerTwoTwoPlus (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Std_.Int64))
new_VerTwoTwoPlus'lst3 len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_VerTwoTwoPlus'lst3 struct result)
    (Std_.pure result)
    )
newtype HoldsText msg
    = HoldsText'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg HoldsText) where
    tMsg f (HoldsText'newtype_ s) = (HoldsText'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (HoldsText msg)) where
    fromStruct struct = (Std_.pure (HoldsText'newtype_ struct))
instance (Classes.ToStruct msg (HoldsText msg)) where
    toStruct (HoldsText'newtype_ struct) = struct
instance (Untyped.HasMessage (HoldsText msg)) where
    type InMessage (HoldsText msg) = msg
    message (HoldsText'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (HoldsText msg)) where
    messageDefault msg = (HoldsText'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (HoldsText msg)) where
    fromPtr msg ptr = (HoldsText'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (HoldsText (Message.MutMsg s))) where
    toPtr msg (HoldsText'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (HoldsText (Message.MutMsg s))) where
    new msg = (HoldsText'newtype_ <$> (Untyped.allocStruct msg 0 3))
instance (Basics.ListElem msg (HoldsText msg)) where
    newtype List msg (HoldsText msg)
        = HoldsText'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (HoldsText'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (HoldsText'List_ l) = (Untyped.ListStruct l)
    length (HoldsText'List_ l) = (Untyped.length l)
    index i (HoldsText'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (HoldsText (Message.MutMsg s))) where
    setIndex (HoldsText'newtype_ elt) i (HoldsText'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (HoldsText'List_ <$> (Untyped.allocCompositeList msg 0 3 len))
get_HoldsText'txt :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.Text msg))
get_HoldsText'txt (HoldsText'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsText'txt :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_HoldsText'txt (HoldsText'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_HoldsText'txt :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
has_HoldsText'txt (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_HoldsText'txt :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_HoldsText'txt len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_HoldsText'txt struct result)
    (Std_.pure result)
    )
get_HoldsText'lst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.List msg (Basics.Text msg)))
get_HoldsText'lst (HoldsText'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsText'lst :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
set_HoldsText'lst (HoldsText'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_HoldsText'lst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
has_HoldsText'lst (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_HoldsText'lst :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
new_HoldsText'lst len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsText'lst struct result)
    (Std_.pure result)
    )
get_HoldsText'lstlst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.List msg (Basics.List msg (Basics.Text msg))))
get_HoldsText'lstlst (HoldsText'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 2 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_HoldsText'lstlst :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s)))) -> (m ())
set_HoldsText'lstlst (HoldsText'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 2 struct)
    )
has_HoldsText'lstlst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
has_HoldsText'lstlst (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
new_HoldsText'lstlst :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s)))))
new_HoldsText'lstlst len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_HoldsText'lstlst struct result)
    (Std_.pure result)
    )
newtype WrapEmpty msg
    = WrapEmpty'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg WrapEmpty) where
    tMsg f (WrapEmpty'newtype_ s) = (WrapEmpty'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (WrapEmpty msg)) where
    fromStruct struct = (Std_.pure (WrapEmpty'newtype_ struct))
instance (Classes.ToStruct msg (WrapEmpty msg)) where
    toStruct (WrapEmpty'newtype_ struct) = struct
instance (Untyped.HasMessage (WrapEmpty msg)) where
    type InMessage (WrapEmpty msg) = msg
    message (WrapEmpty'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (WrapEmpty msg)) where
    messageDefault msg = (WrapEmpty'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (WrapEmpty msg)) where
    fromPtr msg ptr = (WrapEmpty'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (WrapEmpty (Message.MutMsg s))) where
    toPtr msg (WrapEmpty'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (WrapEmpty (Message.MutMsg s))) where
    new msg = (WrapEmpty'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (WrapEmpty msg)) where
    newtype List msg (WrapEmpty msg)
        = WrapEmpty'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (WrapEmpty'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (WrapEmpty'List_ l) = (Untyped.ListStruct l)
    length (WrapEmpty'List_ l) = (Untyped.length l)
    index i (WrapEmpty'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (WrapEmpty (Message.MutMsg s))) where
    setIndex (WrapEmpty'newtype_ elt) i (WrapEmpty'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (WrapEmpty'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (WrapEmpty msg) -> (m (VerEmpty msg))
get_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (WrapEmpty (Message.MutMsg s)) -> (VerEmpty (Message.MutMsg s)) -> (m ())
set_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (WrapEmpty msg) -> (m Std_.Bool)
has_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (WrapEmpty (Message.MutMsg s)) -> (m (VerEmpty (Message.MutMsg s)))
new_WrapEmpty'mightNotBeReallyEmpty struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_WrapEmpty'mightNotBeReallyEmpty struct result)
    (Std_.pure result)
    )
newtype Wrap2x2 msg
    = Wrap2x2'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Wrap2x2) where
    tMsg f (Wrap2x2'newtype_ s) = (Wrap2x2'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Wrap2x2 msg)) where
    fromStruct struct = (Std_.pure (Wrap2x2'newtype_ struct))
instance (Classes.ToStruct msg (Wrap2x2 msg)) where
    toStruct (Wrap2x2'newtype_ struct) = struct
instance (Untyped.HasMessage (Wrap2x2 msg)) where
    type InMessage (Wrap2x2 msg) = msg
    message (Wrap2x2'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Wrap2x2 msg)) where
    messageDefault msg = (Wrap2x2'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Wrap2x2 msg)) where
    fromPtr msg ptr = (Wrap2x2'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Wrap2x2 (Message.MutMsg s))) where
    toPtr msg (Wrap2x2'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Wrap2x2 (Message.MutMsg s))) where
    new msg = (Wrap2x2'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Wrap2x2 msg)) where
    newtype List msg (Wrap2x2 msg)
        = Wrap2x2'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Wrap2x2'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Wrap2x2'List_ l) = (Untyped.ListStruct l)
    length (Wrap2x2'List_ l) = (Untyped.length l)
    index i (Wrap2x2'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Wrap2x2 (Message.MutMsg s))) where
    setIndex (Wrap2x2'newtype_ elt) i (Wrap2x2'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Wrap2x2'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2 msg) -> (m (VerTwoDataTwoPtr msg))
get_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2 (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
set_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2 msg) -> (m Std_.Bool)
has_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2 (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
new_Wrap2x2'mightNotBeReallyEmpty struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_Wrap2x2'mightNotBeReallyEmpty struct result)
    (Std_.pure result)
    )
newtype Wrap2x2plus msg
    = Wrap2x2plus'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Wrap2x2plus) where
    tMsg f (Wrap2x2plus'newtype_ s) = (Wrap2x2plus'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Wrap2x2plus msg)) where
    fromStruct struct = (Std_.pure (Wrap2x2plus'newtype_ struct))
instance (Classes.ToStruct msg (Wrap2x2plus msg)) where
    toStruct (Wrap2x2plus'newtype_ struct) = struct
instance (Untyped.HasMessage (Wrap2x2plus msg)) where
    type InMessage (Wrap2x2plus msg) = msg
    message (Wrap2x2plus'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Wrap2x2plus msg)) where
    messageDefault msg = (Wrap2x2plus'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Wrap2x2plus msg)) where
    fromPtr msg ptr = (Wrap2x2plus'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Wrap2x2plus (Message.MutMsg s))) where
    toPtr msg (Wrap2x2plus'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Wrap2x2plus (Message.MutMsg s))) where
    new msg = (Wrap2x2plus'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Wrap2x2plus msg)) where
    newtype List msg (Wrap2x2plus msg)
        = Wrap2x2plus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Wrap2x2plus'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Wrap2x2plus'List_ l) = (Untyped.ListStruct l)
    length (Wrap2x2plus'List_ l) = (Untyped.length l)
    index i (Wrap2x2plus'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Wrap2x2plus (Message.MutMsg s))) where
    setIndex (Wrap2x2plus'newtype_ elt) i (Wrap2x2plus'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Wrap2x2plus'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2plus msg) -> (m (VerTwoTwoPlus msg))
get_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2plus (Message.MutMsg s)) -> (VerTwoTwoPlus (Message.MutMsg s)) -> (m ())
set_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2plus msg) -> (m Std_.Bool)
has_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2plus (Message.MutMsg s)) -> (m (VerTwoTwoPlus (Message.MutMsg s)))
new_Wrap2x2plus'mightNotBeReallyEmpty struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_Wrap2x2plus'mightNotBeReallyEmpty struct result)
    (Std_.pure result)
    )
newtype VoidUnion msg
    = VoidUnion'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg VoidUnion) where
    tMsg f (VoidUnion'newtype_ s) = (VoidUnion'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (VoidUnion msg)) where
    fromStruct struct = (Std_.pure (VoidUnion'newtype_ struct))
instance (Classes.ToStruct msg (VoidUnion msg)) where
    toStruct (VoidUnion'newtype_ struct) = struct
instance (Untyped.HasMessage (VoidUnion msg)) where
    type InMessage (VoidUnion msg) = msg
    message (VoidUnion'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (VoidUnion msg)) where
    messageDefault msg = (VoidUnion'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (VoidUnion msg)) where
    fromPtr msg ptr = (VoidUnion'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (VoidUnion (Message.MutMsg s))) where
    toPtr msg (VoidUnion'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (VoidUnion (Message.MutMsg s))) where
    new msg = (VoidUnion'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (VoidUnion msg)) where
    newtype List msg (VoidUnion msg)
        = VoidUnion'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (VoidUnion'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (VoidUnion'List_ l) = (Untyped.ListStruct l)
    length (VoidUnion'List_ l) = (Untyped.length l)
    index i (VoidUnion'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (VoidUnion (Message.MutMsg s))) where
    setIndex (VoidUnion'newtype_ elt) i (VoidUnion'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (VoidUnion'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
data VoidUnion' msg
    = VoidUnion'a 
    | VoidUnion'b 
    | VoidUnion'unknown' Std_.Word16
instance (Classes.FromStruct msg (VoidUnion' msg)) where
    fromStruct struct = (do
        tag <- (GenHelpers.getTag struct 0)
        case tag of
            0 ->
                (Std_.pure VoidUnion'a)
            1 ->
                (Std_.pure VoidUnion'b)
            _ ->
                (Std_.pure (VoidUnion'unknown' (Std_.fromIntegral tag)))
        )
get_VoidUnion' :: ((Untyped.ReadCtx m msg)) => (VoidUnion msg) -> (m (VoidUnion' msg))
get_VoidUnion' (VoidUnion'newtype_ struct) = (Classes.fromStruct struct)
set_VoidUnion'a :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> (m ())
set_VoidUnion'a (VoidUnion'newtype_ struct) = (do
    (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
    (Std_.pure ())
    )
set_VoidUnion'b :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> (m ())
set_VoidUnion'b (VoidUnion'newtype_ struct) = (do
    (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
    (Std_.pure ())
    )
set_VoidUnion'unknown' :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> Std_.Word16 -> (m ())
set_VoidUnion'unknown' (VoidUnion'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
newtype Nester1Capn msg
    = Nester1Capn'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Nester1Capn) where
    tMsg f (Nester1Capn'newtype_ s) = (Nester1Capn'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Nester1Capn msg)) where
    fromStruct struct = (Std_.pure (Nester1Capn'newtype_ struct))
instance (Classes.ToStruct msg (Nester1Capn msg)) where
    toStruct (Nester1Capn'newtype_ struct) = struct
instance (Untyped.HasMessage (Nester1Capn msg)) where
    type InMessage (Nester1Capn msg) = msg
    message (Nester1Capn'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Nester1Capn msg)) where
    messageDefault msg = (Nester1Capn'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Nester1Capn msg)) where
    fromPtr msg ptr = (Nester1Capn'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Nester1Capn (Message.MutMsg s))) where
    toPtr msg (Nester1Capn'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Nester1Capn (Message.MutMsg s))) where
    new msg = (Nester1Capn'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Nester1Capn msg)) where
    newtype List msg (Nester1Capn msg)
        = Nester1Capn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Nester1Capn'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Nester1Capn'List_ l) = (Untyped.ListStruct l)
    length (Nester1Capn'List_ l) = (Untyped.length l)
    index i (Nester1Capn'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Nester1Capn (Message.MutMsg s))) where
    setIndex (Nester1Capn'newtype_ elt) i (Nester1Capn'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Nester1Capn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Nester1Capn'strs :: ((Untyped.ReadCtx m msg)) => (Nester1Capn msg) -> (m (Basics.List msg (Basics.Text msg)))
get_Nester1Capn'strs (Nester1Capn'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Nester1Capn'strs :: ((Untyped.RWCtx m s)) => (Nester1Capn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
set_Nester1Capn'strs (Nester1Capn'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Nester1Capn'strs :: ((Untyped.ReadCtx m msg)) => (Nester1Capn msg) -> (m Std_.Bool)
has_Nester1Capn'strs (Nester1Capn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Nester1Capn'strs :: ((Untyped.RWCtx m s)) => Std_.Int -> (Nester1Capn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
new_Nester1Capn'strs len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_Nester1Capn'strs struct result)
    (Std_.pure result)
    )
newtype RWTestCapn msg
    = RWTestCapn'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg RWTestCapn) where
    tMsg f (RWTestCapn'newtype_ s) = (RWTestCapn'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (RWTestCapn msg)) where
    fromStruct struct = (Std_.pure (RWTestCapn'newtype_ struct))
instance (Classes.ToStruct msg (RWTestCapn msg)) where
    toStruct (RWTestCapn'newtype_ struct) = struct
instance (Untyped.HasMessage (RWTestCapn msg)) where
    type InMessage (RWTestCapn msg) = msg
    message (RWTestCapn'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (RWTestCapn msg)) where
    messageDefault msg = (RWTestCapn'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (RWTestCapn msg)) where
    fromPtr msg ptr = (RWTestCapn'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (RWTestCapn (Message.MutMsg s))) where
    toPtr msg (RWTestCapn'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (RWTestCapn (Message.MutMsg s))) where
    new msg = (RWTestCapn'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (RWTestCapn msg)) where
    newtype List msg (RWTestCapn msg)
        = RWTestCapn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (RWTestCapn'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (RWTestCapn'List_ l) = (Untyped.ListStruct l)
    length (RWTestCapn'List_ l) = (Untyped.length l)
    index i (RWTestCapn'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (RWTestCapn (Message.MutMsg s))) where
    setIndex (RWTestCapn'newtype_ elt) i (RWTestCapn'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (RWTestCapn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_RWTestCapn'nestMatrix :: ((Untyped.ReadCtx m msg)) => (RWTestCapn msg) -> (m (Basics.List msg (Basics.List msg (Nester1Capn msg))))
get_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_RWTestCapn'nestMatrix :: ((Untyped.RWCtx m s)) => (RWTestCapn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s)))) -> (m ())
set_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_RWTestCapn'nestMatrix :: ((Untyped.ReadCtx m msg)) => (RWTestCapn msg) -> (m Std_.Bool)
has_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_RWTestCapn'nestMatrix :: ((Untyped.RWCtx m s)) => Std_.Int -> (RWTestCapn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s)))))
new_RWTestCapn'nestMatrix len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_RWTestCapn'nestMatrix struct result)
    (Std_.pure result)
    )
newtype ListStructCapn msg
    = ListStructCapn'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg ListStructCapn) where
    tMsg f (ListStructCapn'newtype_ s) = (ListStructCapn'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (ListStructCapn msg)) where
    fromStruct struct = (Std_.pure (ListStructCapn'newtype_ struct))
instance (Classes.ToStruct msg (ListStructCapn msg)) where
    toStruct (ListStructCapn'newtype_ struct) = struct
instance (Untyped.HasMessage (ListStructCapn msg)) where
    type InMessage (ListStructCapn msg) = msg
    message (ListStructCapn'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (ListStructCapn msg)) where
    messageDefault msg = (ListStructCapn'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (ListStructCapn msg)) where
    fromPtr msg ptr = (ListStructCapn'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (ListStructCapn (Message.MutMsg s))) where
    toPtr msg (ListStructCapn'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (ListStructCapn (Message.MutMsg s))) where
    new msg = (ListStructCapn'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (ListStructCapn msg)) where
    newtype List msg (ListStructCapn msg)
        = ListStructCapn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (ListStructCapn'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (ListStructCapn'List_ l) = (Untyped.ListStruct l)
    length (ListStructCapn'List_ l) = (Untyped.length l)
    index i (ListStructCapn'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (ListStructCapn (Message.MutMsg s))) where
    setIndex (ListStructCapn'newtype_ elt) i (ListStructCapn'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (ListStructCapn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_ListStructCapn'vec :: ((Untyped.ReadCtx m msg)) => (ListStructCapn msg) -> (m (Basics.List msg (Nester1Capn msg)))
get_ListStructCapn'vec (ListStructCapn'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_ListStructCapn'vec :: ((Untyped.RWCtx m s)) => (ListStructCapn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s))) -> (m ())
set_ListStructCapn'vec (ListStructCapn'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_ListStructCapn'vec :: ((Untyped.ReadCtx m msg)) => (ListStructCapn msg) -> (m Std_.Bool)
has_ListStructCapn'vec (ListStructCapn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_ListStructCapn'vec :: ((Untyped.RWCtx m s)) => Std_.Int -> (ListStructCapn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s))))
new_ListStructCapn'vec len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_ListStructCapn'vec struct result)
    (Std_.pure result)
    )
newtype Echo msg
    = Echo'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (Echo msg)) where
    fromPtr msg ptr = (Echo'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Echo (Message.MutMsg s))) where
    toPtr msg (Echo'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (Echo'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype Echo'echo'params msg
    = Echo'echo'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Echo'echo'params) where
    tMsg f (Echo'echo'params'newtype_ s) = (Echo'echo'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Echo'echo'params msg)) where
    fromStruct struct = (Std_.pure (Echo'echo'params'newtype_ struct))
instance (Classes.ToStruct msg (Echo'echo'params msg)) where
    toStruct (Echo'echo'params'newtype_ struct) = struct
instance (Untyped.HasMessage (Echo'echo'params msg)) where
    type InMessage (Echo'echo'params msg) = msg
    message (Echo'echo'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Echo'echo'params msg)) where
    messageDefault msg = (Echo'echo'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Echo'echo'params msg)) where
    fromPtr msg ptr = (Echo'echo'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Echo'echo'params (Message.MutMsg s))) where
    toPtr msg (Echo'echo'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Echo'echo'params (Message.MutMsg s))) where
    new msg = (Echo'echo'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Echo'echo'params msg)) where
    newtype List msg (Echo'echo'params msg)
        = Echo'echo'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Echo'echo'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Echo'echo'params'List_ l) = (Untyped.ListStruct l)
    length (Echo'echo'params'List_ l) = (Untyped.length l)
    index i (Echo'echo'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Echo'echo'params (Message.MutMsg s))) where
    setIndex (Echo'echo'params'newtype_ elt) i (Echo'echo'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Echo'echo'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Echo'echo'params'in_ :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m (Basics.Text msg))
get_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Echo'echo'params'in_ :: ((Untyped.RWCtx m s)) => (Echo'echo'params (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Echo'echo'params'in_ :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m Std_.Bool)
has_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Echo'echo'params'in_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'params (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Echo'echo'params'in_ len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_Echo'echo'params'in_ struct result)
    (Std_.pure result)
    )
newtype Echo'echo'results msg
    = Echo'echo'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Echo'echo'results) where
    tMsg f (Echo'echo'results'newtype_ s) = (Echo'echo'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Echo'echo'results msg)) where
    fromStruct struct = (Std_.pure (Echo'echo'results'newtype_ struct))
instance (Classes.ToStruct msg (Echo'echo'results msg)) where
    toStruct (Echo'echo'results'newtype_ struct) = struct
instance (Untyped.HasMessage (Echo'echo'results msg)) where
    type InMessage (Echo'echo'results msg) = msg
    message (Echo'echo'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Echo'echo'results msg)) where
    messageDefault msg = (Echo'echo'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Echo'echo'results msg)) where
    fromPtr msg ptr = (Echo'echo'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Echo'echo'results (Message.MutMsg s))) where
    toPtr msg (Echo'echo'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Echo'echo'results (Message.MutMsg s))) where
    new msg = (Echo'echo'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Echo'echo'results msg)) where
    newtype List msg (Echo'echo'results msg)
        = Echo'echo'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Echo'echo'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Echo'echo'results'List_ l) = (Untyped.ListStruct l)
    length (Echo'echo'results'List_ l) = (Untyped.length l)
    index i (Echo'echo'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Echo'echo'results (Message.MutMsg s))) where
    setIndex (Echo'echo'results'newtype_ elt) i (Echo'echo'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Echo'echo'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Echo'echo'results'out :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m (Basics.Text msg))
get_Echo'echo'results'out (Echo'echo'results'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Echo'echo'results'out :: ((Untyped.RWCtx m s)) => (Echo'echo'results (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Echo'echo'results'out (Echo'echo'results'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Echo'echo'results'out :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m Std_.Bool)
has_Echo'echo'results'out (Echo'echo'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Echo'echo'results'out :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'results (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Echo'echo'results'out len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_Echo'echo'results'out struct result)
    (Std_.pure result)
    )
newtype Hoth msg
    = Hoth'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Hoth) where
    tMsg f (Hoth'newtype_ s) = (Hoth'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Hoth msg)) where
    fromStruct struct = (Std_.pure (Hoth'newtype_ struct))
instance (Classes.ToStruct msg (Hoth msg)) where
    toStruct (Hoth'newtype_ struct) = struct
instance (Untyped.HasMessage (Hoth msg)) where
    type InMessage (Hoth msg) = msg
    message (Hoth'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Hoth msg)) where
    messageDefault msg = (Hoth'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Hoth msg)) where
    fromPtr msg ptr = (Hoth'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Hoth (Message.MutMsg s))) where
    toPtr msg (Hoth'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Hoth (Message.MutMsg s))) where
    new msg = (Hoth'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (Hoth msg)) where
    newtype List msg (Hoth msg)
        = Hoth'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Hoth'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Hoth'List_ l) = (Untyped.ListStruct l)
    length (Hoth'List_ l) = (Untyped.length l)
    index i (Hoth'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Hoth (Message.MutMsg s))) where
    setIndex (Hoth'newtype_ elt) i (Hoth'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Hoth'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_Hoth'base :: ((Untyped.ReadCtx m msg)) => (Hoth msg) -> (m (EchoBase msg))
get_Hoth'base (Hoth'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Hoth'base :: ((Untyped.RWCtx m s)) => (Hoth (Message.MutMsg s)) -> (EchoBase (Message.MutMsg s)) -> (m ())
set_Hoth'base (Hoth'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Hoth'base :: ((Untyped.ReadCtx m msg)) => (Hoth msg) -> (m Std_.Bool)
has_Hoth'base (Hoth'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Hoth'base :: ((Untyped.RWCtx m s)) => (Hoth (Message.MutMsg s)) -> (m (EchoBase (Message.MutMsg s)))
new_Hoth'base struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_Hoth'base struct result)
    (Std_.pure result)
    )
newtype EchoBase msg
    = EchoBase'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg EchoBase) where
    tMsg f (EchoBase'newtype_ s) = (EchoBase'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (EchoBase msg)) where
    fromStruct struct = (Std_.pure (EchoBase'newtype_ struct))
instance (Classes.ToStruct msg (EchoBase msg)) where
    toStruct (EchoBase'newtype_ struct) = struct
instance (Untyped.HasMessage (EchoBase msg)) where
    type InMessage (EchoBase msg) = msg
    message (EchoBase'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (EchoBase msg)) where
    messageDefault msg = (EchoBase'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (EchoBase msg)) where
    fromPtr msg ptr = (EchoBase'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (EchoBase (Message.MutMsg s))) where
    toPtr msg (EchoBase'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (EchoBase (Message.MutMsg s))) where
    new msg = (EchoBase'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (EchoBase msg)) where
    newtype List msg (EchoBase msg)
        = EchoBase'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (EchoBase'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (EchoBase'List_ l) = (Untyped.ListStruct l)
    length (EchoBase'List_ l) = (Untyped.length l)
    index i (EchoBase'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (EchoBase (Message.MutMsg s))) where
    setIndex (EchoBase'newtype_ elt) i (EchoBase'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (EchoBase'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_EchoBase'echo :: ((Untyped.ReadCtx m msg)) => (EchoBase msg) -> (m (Echo msg))
get_EchoBase'echo (EchoBase'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_EchoBase'echo :: ((Untyped.RWCtx m s)) => (EchoBase (Message.MutMsg s)) -> (Echo (Message.MutMsg s)) -> (m ())
set_EchoBase'echo (EchoBase'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_EchoBase'echo :: ((Untyped.ReadCtx m msg)) => (EchoBase msg) -> (m Std_.Bool)
has_EchoBase'echo (EchoBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
newtype EchoBases msg
    = EchoBases'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg EchoBases) where
    tMsg f (EchoBases'newtype_ s) = (EchoBases'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (EchoBases msg)) where
    fromStruct struct = (Std_.pure (EchoBases'newtype_ struct))
instance (Classes.ToStruct msg (EchoBases msg)) where
    toStruct (EchoBases'newtype_ struct) = struct
instance (Untyped.HasMessage (EchoBases msg)) where
    type InMessage (EchoBases msg) = msg
    message (EchoBases'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (EchoBases msg)) where
    messageDefault msg = (EchoBases'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (EchoBases msg)) where
    fromPtr msg ptr = (EchoBases'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (EchoBases (Message.MutMsg s))) where
    toPtr msg (EchoBases'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (EchoBases (Message.MutMsg s))) where
    new msg = (EchoBases'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (EchoBases msg)) where
    newtype List msg (EchoBases msg)
        = EchoBases'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (EchoBases'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (EchoBases'List_ l) = (Untyped.ListStruct l)
    length (EchoBases'List_ l) = (Untyped.length l)
    index i (EchoBases'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (EchoBases (Message.MutMsg s))) where
    setIndex (EchoBases'newtype_ elt) i (EchoBases'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (EchoBases'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_EchoBases'bases :: ((Untyped.ReadCtx m msg)) => (EchoBases msg) -> (m (Basics.List msg (EchoBase msg)))
get_EchoBases'bases (EchoBases'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_EchoBases'bases :: ((Untyped.RWCtx m s)) => (EchoBases (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (EchoBase (Message.MutMsg s))) -> (m ())
set_EchoBases'bases (EchoBases'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_EchoBases'bases :: ((Untyped.ReadCtx m msg)) => (EchoBases msg) -> (m Std_.Bool)
has_EchoBases'bases (EchoBases'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_EchoBases'bases :: ((Untyped.RWCtx m s)) => Std_.Int -> (EchoBases (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (EchoBase (Message.MutMsg s))))
new_EchoBases'bases len struct = (do
    result <- (Classes.newList (Untyped.message struct) len)
    (set_EchoBases'bases struct result)
    (Std_.pure result)
    )
newtype StackingRoot msg
    = StackingRoot'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg StackingRoot) where
    tMsg f (StackingRoot'newtype_ s) = (StackingRoot'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (StackingRoot msg)) where
    fromStruct struct = (Std_.pure (StackingRoot'newtype_ struct))
instance (Classes.ToStruct msg (StackingRoot msg)) where
    toStruct (StackingRoot'newtype_ struct) = struct
instance (Untyped.HasMessage (StackingRoot msg)) where
    type InMessage (StackingRoot msg) = msg
    message (StackingRoot'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (StackingRoot msg)) where
    messageDefault msg = (StackingRoot'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (StackingRoot msg)) where
    fromPtr msg ptr = (StackingRoot'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (StackingRoot (Message.MutMsg s))) where
    toPtr msg (StackingRoot'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (StackingRoot (Message.MutMsg s))) where
    new msg = (StackingRoot'newtype_ <$> (Untyped.allocStruct msg 0 2))
instance (Basics.ListElem msg (StackingRoot msg)) where
    newtype List msg (StackingRoot msg)
        = StackingRoot'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (StackingRoot'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (StackingRoot'List_ l) = (Untyped.ListStruct l)
    length (StackingRoot'List_ l) = (Untyped.length l)
    index i (StackingRoot'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (StackingRoot (Message.MutMsg s))) where
    setIndex (StackingRoot'newtype_ elt) i (StackingRoot'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (StackingRoot'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
get_StackingRoot'aWithDefault :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m (StackingA msg))
get_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_StackingRoot'aWithDefault :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (StackingA (Message.MutMsg s)) -> (m ())
set_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_StackingRoot'aWithDefault :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m Std_.Bool)
has_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_StackingRoot'aWithDefault :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (m (StackingA (Message.MutMsg s)))
new_StackingRoot'aWithDefault struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_StackingRoot'aWithDefault struct result)
    (Std_.pure result)
    )
get_StackingRoot'a :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m (StackingA msg))
get_StackingRoot'a (StackingRoot'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_StackingRoot'a :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (StackingA (Message.MutMsg s)) -> (m ())
set_StackingRoot'a (StackingRoot'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_StackingRoot'a :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m Std_.Bool)
has_StackingRoot'a (StackingRoot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_StackingRoot'a :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (m (StackingA (Message.MutMsg s)))
new_StackingRoot'a struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_StackingRoot'a struct result)
    (Std_.pure result)
    )
newtype StackingA msg
    = StackingA'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg StackingA) where
    tMsg f (StackingA'newtype_ s) = (StackingA'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (StackingA msg)) where
    fromStruct struct = (Std_.pure (StackingA'newtype_ struct))
instance (Classes.ToStruct msg (StackingA msg)) where
    toStruct (StackingA'newtype_ struct) = struct
instance (Untyped.HasMessage (StackingA msg)) where
    type InMessage (StackingA msg) = msg
    message (StackingA'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (StackingA msg)) where
    messageDefault msg = (StackingA'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (StackingA msg)) where
    fromPtr msg ptr = (StackingA'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (StackingA (Message.MutMsg s))) where
    toPtr msg (StackingA'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (StackingA (Message.MutMsg s))) where
    new msg = (StackingA'newtype_ <$> (Untyped.allocStruct msg 1 1))
instance (Basics.ListElem msg (StackingA msg)) where
    newtype List msg (StackingA msg)
        = StackingA'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (StackingA'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (StackingA'List_ l) = (Untyped.ListStruct l)
    length (StackingA'List_ l) = (Untyped.length l)
    index i (StackingA'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (StackingA (Message.MutMsg s))) where
    setIndex (StackingA'newtype_ elt) i (StackingA'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (StackingA'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
get_StackingA'num :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m Std_.Int32)
get_StackingA'num (StackingA'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_StackingA'num :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_StackingA'num (StackingA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
get_StackingA'b :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m (StackingB msg))
get_StackingA'b (StackingA'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_StackingA'b :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> (StackingB (Message.MutMsg s)) -> (m ())
set_StackingA'b (StackingA'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_StackingA'b :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m Std_.Bool)
has_StackingA'b (StackingA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_StackingA'b :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> (m (StackingB (Message.MutMsg s)))
new_StackingA'b struct = (do
    result <- (Classes.new (Untyped.message struct))
    (set_StackingA'b struct result)
    (Std_.pure result)
    )
newtype StackingB msg
    = StackingB'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg StackingB) where
    tMsg f (StackingB'newtype_ s) = (StackingB'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (StackingB msg)) where
    fromStruct struct = (Std_.pure (StackingB'newtype_ struct))
instance (Classes.ToStruct msg (StackingB msg)) where
    toStruct (StackingB'newtype_ struct) = struct
instance (Untyped.HasMessage (StackingB msg)) where
    type InMessage (StackingB msg) = msg
    message (StackingB'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (StackingB msg)) where
    messageDefault msg = (StackingB'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (StackingB msg)) where
    fromPtr msg ptr = (StackingB'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (StackingB (Message.MutMsg s))) where
    toPtr msg (StackingB'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (StackingB (Message.MutMsg s))) where
    new msg = (StackingB'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (StackingB msg)) where
    newtype List msg (StackingB msg)
        = StackingB'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (StackingB'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (StackingB'List_ l) = (Untyped.ListStruct l)
    length (StackingB'List_ l) = (Untyped.length l)
    index i (StackingB'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (StackingB (Message.MutMsg s))) where
    setIndex (StackingB'newtype_ elt) i (StackingB'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (StackingB'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
get_StackingB'num :: ((Untyped.ReadCtx m msg)) => (StackingB msg) -> (m Std_.Int32)
get_StackingB'num (StackingB'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_StackingB'num :: ((Untyped.RWCtx m s)) => (StackingB (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_StackingB'num (StackingB'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
newtype CallSequence msg
    = CallSequence'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (CallSequence msg)) where
    fromPtr msg ptr = (CallSequence'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CallSequence (Message.MutMsg s))) where
    toPtr msg (CallSequence'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (CallSequence'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype CallSequence'getNumber'params msg
    = CallSequence'getNumber'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CallSequence'getNumber'params) where
    tMsg f (CallSequence'getNumber'params'newtype_ s) = (CallSequence'getNumber'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CallSequence'getNumber'params msg)) where
    fromStruct struct = (Std_.pure (CallSequence'getNumber'params'newtype_ struct))
instance (Classes.ToStruct msg (CallSequence'getNumber'params msg)) where
    toStruct (CallSequence'getNumber'params'newtype_ struct) = struct
instance (Untyped.HasMessage (CallSequence'getNumber'params msg)) where
    type InMessage (CallSequence'getNumber'params msg) = msg
    message (CallSequence'getNumber'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CallSequence'getNumber'params msg)) where
    messageDefault msg = (CallSequence'getNumber'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CallSequence'getNumber'params msg)) where
    fromPtr msg ptr = (CallSequence'getNumber'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CallSequence'getNumber'params (Message.MutMsg s))) where
    toPtr msg (CallSequence'getNumber'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CallSequence'getNumber'params (Message.MutMsg s))) where
    new msg = (CallSequence'getNumber'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (CallSequence'getNumber'params msg)) where
    newtype List msg (CallSequence'getNumber'params msg)
        = CallSequence'getNumber'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CallSequence'getNumber'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CallSequence'getNumber'params'List_ l) = (Untyped.ListStruct l)
    length (CallSequence'getNumber'params'List_ l) = (Untyped.length l)
    index i (CallSequence'getNumber'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CallSequence'getNumber'params (Message.MutMsg s))) where
    setIndex (CallSequence'getNumber'params'newtype_ elt) i (CallSequence'getNumber'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CallSequence'getNumber'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype CallSequence'getNumber'results msg
    = CallSequence'getNumber'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CallSequence'getNumber'results) where
    tMsg f (CallSequence'getNumber'results'newtype_ s) = (CallSequence'getNumber'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CallSequence'getNumber'results msg)) where
    fromStruct struct = (Std_.pure (CallSequence'getNumber'results'newtype_ struct))
instance (Classes.ToStruct msg (CallSequence'getNumber'results msg)) where
    toStruct (CallSequence'getNumber'results'newtype_ struct) = struct
instance (Untyped.HasMessage (CallSequence'getNumber'results msg)) where
    type InMessage (CallSequence'getNumber'results msg) = msg
    message (CallSequence'getNumber'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CallSequence'getNumber'results msg)) where
    messageDefault msg = (CallSequence'getNumber'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CallSequence'getNumber'results msg)) where
    fromPtr msg ptr = (CallSequence'getNumber'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CallSequence'getNumber'results (Message.MutMsg s))) where
    toPtr msg (CallSequence'getNumber'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CallSequence'getNumber'results (Message.MutMsg s))) where
    new msg = (CallSequence'getNumber'results'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (CallSequence'getNumber'results msg)) where
    newtype List msg (CallSequence'getNumber'results msg)
        = CallSequence'getNumber'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CallSequence'getNumber'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CallSequence'getNumber'results'List_ l) = (Untyped.ListStruct l)
    length (CallSequence'getNumber'results'List_ l) = (Untyped.length l)
    index i (CallSequence'getNumber'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CallSequence'getNumber'results (Message.MutMsg s))) where
    setIndex (CallSequence'getNumber'results'newtype_ elt) i (CallSequence'getNumber'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CallSequence'getNumber'results'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
get_CallSequence'getNumber'results'n :: ((Untyped.ReadCtx m msg)) => (CallSequence'getNumber'results msg) -> (m Std_.Word32)
get_CallSequence'getNumber'results'n (CallSequence'getNumber'results'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_CallSequence'getNumber'results'n :: ((Untyped.RWCtx m s)) => (CallSequence'getNumber'results (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_CallSequence'getNumber'results'n (CallSequence'getNumber'results'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
newtype CounterFactory msg
    = CounterFactory'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (CounterFactory msg)) where
    fromPtr msg ptr = (CounterFactory'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterFactory (Message.MutMsg s))) where
    toPtr msg (CounterFactory'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (CounterFactory'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype CounterFactory'newCounter'params msg
    = CounterFactory'newCounter'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CounterFactory'newCounter'params) where
    tMsg f (CounterFactory'newCounter'params'newtype_ s) = (CounterFactory'newCounter'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CounterFactory'newCounter'params msg)) where
    fromStruct struct = (Std_.pure (CounterFactory'newCounter'params'newtype_ struct))
instance (Classes.ToStruct msg (CounterFactory'newCounter'params msg)) where
    toStruct (CounterFactory'newCounter'params'newtype_ struct) = struct
instance (Untyped.HasMessage (CounterFactory'newCounter'params msg)) where
    type InMessage (CounterFactory'newCounter'params msg) = msg
    message (CounterFactory'newCounter'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CounterFactory'newCounter'params msg)) where
    messageDefault msg = (CounterFactory'newCounter'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CounterFactory'newCounter'params msg)) where
    fromPtr msg ptr = (CounterFactory'newCounter'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterFactory'newCounter'params (Message.MutMsg s))) where
    toPtr msg (CounterFactory'newCounter'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CounterFactory'newCounter'params (Message.MutMsg s))) where
    new msg = (CounterFactory'newCounter'params'newtype_ <$> (Untyped.allocStruct msg 1 0))
instance (Basics.ListElem msg (CounterFactory'newCounter'params msg)) where
    newtype List msg (CounterFactory'newCounter'params msg)
        = CounterFactory'newCounter'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CounterFactory'newCounter'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CounterFactory'newCounter'params'List_ l) = (Untyped.ListStruct l)
    length (CounterFactory'newCounter'params'List_ l) = (Untyped.length l)
    index i (CounterFactory'newCounter'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CounterFactory'newCounter'params (Message.MutMsg s))) where
    setIndex (CounterFactory'newCounter'params'newtype_ elt) i (CounterFactory'newCounter'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CounterFactory'newCounter'params'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
get_CounterFactory'newCounter'params'start :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'params msg) -> (m Std_.Word32)
get_CounterFactory'newCounter'params'start (CounterFactory'newCounter'params'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_CounterFactory'newCounter'params'start :: ((Untyped.RWCtx m s)) => (CounterFactory'newCounter'params (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_CounterFactory'newCounter'params'start (CounterFactory'newCounter'params'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
newtype CounterFactory'newCounter'results msg
    = CounterFactory'newCounter'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CounterFactory'newCounter'results) where
    tMsg f (CounterFactory'newCounter'results'newtype_ s) = (CounterFactory'newCounter'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CounterFactory'newCounter'results msg)) where
    fromStruct struct = (Std_.pure (CounterFactory'newCounter'results'newtype_ struct))
instance (Classes.ToStruct msg (CounterFactory'newCounter'results msg)) where
    toStruct (CounterFactory'newCounter'results'newtype_ struct) = struct
instance (Untyped.HasMessage (CounterFactory'newCounter'results msg)) where
    type InMessage (CounterFactory'newCounter'results msg) = msg
    message (CounterFactory'newCounter'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CounterFactory'newCounter'results msg)) where
    messageDefault msg = (CounterFactory'newCounter'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CounterFactory'newCounter'results msg)) where
    fromPtr msg ptr = (CounterFactory'newCounter'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterFactory'newCounter'results (Message.MutMsg s))) where
    toPtr msg (CounterFactory'newCounter'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CounterFactory'newCounter'results (Message.MutMsg s))) where
    new msg = (CounterFactory'newCounter'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (CounterFactory'newCounter'results msg)) where
    newtype List msg (CounterFactory'newCounter'results msg)
        = CounterFactory'newCounter'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CounterFactory'newCounter'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CounterFactory'newCounter'results'List_ l) = (Untyped.ListStruct l)
    length (CounterFactory'newCounter'results'List_ l) = (Untyped.length l)
    index i (CounterFactory'newCounter'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CounterFactory'newCounter'results (Message.MutMsg s))) where
    setIndex (CounterFactory'newCounter'results'newtype_ elt) i (CounterFactory'newCounter'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CounterFactory'newCounter'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_CounterFactory'newCounter'results'counter :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'results msg) -> (m (CallSequence msg))
get_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_CounterFactory'newCounter'results'counter :: ((Untyped.RWCtx m s)) => (CounterFactory'newCounter'results (Message.MutMsg s)) -> (CallSequence (Message.MutMsg s)) -> (m ())
set_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_CounterFactory'newCounter'results'counter :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'results msg) -> (m Std_.Bool)
has_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
newtype CounterAcceptor msg
    = CounterAcceptor'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (CounterAcceptor msg)) where
    fromPtr msg ptr = (CounterAcceptor'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterAcceptor (Message.MutMsg s))) where
    toPtr msg (CounterAcceptor'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (CounterAcceptor'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype CounterAcceptor'accept'params msg
    = CounterAcceptor'accept'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CounterAcceptor'accept'params) where
    tMsg f (CounterAcceptor'accept'params'newtype_ s) = (CounterAcceptor'accept'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CounterAcceptor'accept'params msg)) where
    fromStruct struct = (Std_.pure (CounterAcceptor'accept'params'newtype_ struct))
instance (Classes.ToStruct msg (CounterAcceptor'accept'params msg)) where
    toStruct (CounterAcceptor'accept'params'newtype_ struct) = struct
instance (Untyped.HasMessage (CounterAcceptor'accept'params msg)) where
    type InMessage (CounterAcceptor'accept'params msg) = msg
    message (CounterAcceptor'accept'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CounterAcceptor'accept'params msg)) where
    messageDefault msg = (CounterAcceptor'accept'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CounterAcceptor'accept'params msg)) where
    fromPtr msg ptr = (CounterAcceptor'accept'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterAcceptor'accept'params (Message.MutMsg s))) where
    toPtr msg (CounterAcceptor'accept'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CounterAcceptor'accept'params (Message.MutMsg s))) where
    new msg = (CounterAcceptor'accept'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
instance (Basics.ListElem msg (CounterAcceptor'accept'params msg)) where
    newtype List msg (CounterAcceptor'accept'params msg)
        = CounterAcceptor'accept'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CounterAcceptor'accept'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CounterAcceptor'accept'params'List_ l) = (Untyped.ListStruct l)
    length (CounterAcceptor'accept'params'List_ l) = (Untyped.length l)
    index i (CounterAcceptor'accept'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CounterAcceptor'accept'params (Message.MutMsg s))) where
    setIndex (CounterAcceptor'accept'params'newtype_ elt) i (CounterAcceptor'accept'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CounterAcceptor'accept'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
get_CounterAcceptor'accept'params'counter :: ((Untyped.ReadCtx m msg)) => (CounterAcceptor'accept'params msg) -> (m (CallSequence msg))
get_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_CounterAcceptor'accept'params'counter :: ((Untyped.RWCtx m s)) => (CounterAcceptor'accept'params (Message.MutMsg s)) -> (CallSequence (Message.MutMsg s)) -> (m ())
set_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_CounterAcceptor'accept'params'counter :: ((Untyped.ReadCtx m msg)) => (CounterAcceptor'accept'params msg) -> (m Std_.Bool)
has_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
newtype CounterAcceptor'accept'results msg
    = CounterAcceptor'accept'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg CounterAcceptor'accept'results) where
    tMsg f (CounterAcceptor'accept'results'newtype_ s) = (CounterAcceptor'accept'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (CounterAcceptor'accept'results msg)) where
    fromStruct struct = (Std_.pure (CounterAcceptor'accept'results'newtype_ struct))
instance (Classes.ToStruct msg (CounterAcceptor'accept'results msg)) where
    toStruct (CounterAcceptor'accept'results'newtype_ struct) = struct
instance (Untyped.HasMessage (CounterAcceptor'accept'results msg)) where
    type InMessage (CounterAcceptor'accept'results msg) = msg
    message (CounterAcceptor'accept'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (CounterAcceptor'accept'results msg)) where
    messageDefault msg = (CounterAcceptor'accept'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (CounterAcceptor'accept'results msg)) where
    fromPtr msg ptr = (CounterAcceptor'accept'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (CounterAcceptor'accept'results (Message.MutMsg s))) where
    toPtr msg (CounterAcceptor'accept'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (CounterAcceptor'accept'results (Message.MutMsg s))) where
    new msg = (CounterAcceptor'accept'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (CounterAcceptor'accept'results msg)) where
    newtype List msg (CounterAcceptor'accept'results msg)
        = CounterAcceptor'accept'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (CounterAcceptor'accept'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (CounterAcceptor'accept'results'List_ l) = (Untyped.ListStruct l)
    length (CounterAcceptor'accept'results'List_ l) = (Untyped.length l)
    index i (CounterAcceptor'accept'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (CounterAcceptor'accept'results (Message.MutMsg s))) where
    setIndex (CounterAcceptor'accept'results'newtype_ elt) i (CounterAcceptor'accept'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (CounterAcceptor'accept'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Top msg
    = Top'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (Top msg)) where
    fromPtr msg ptr = (Top'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Top (Message.MutMsg s))) where
    toPtr msg (Top'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (Top'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype Top'top'params msg
    = Top'top'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Top'top'params) where
    tMsg f (Top'top'params'newtype_ s) = (Top'top'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Top'top'params msg)) where
    fromStruct struct = (Std_.pure (Top'top'params'newtype_ struct))
instance (Classes.ToStruct msg (Top'top'params msg)) where
    toStruct (Top'top'params'newtype_ struct) = struct
instance (Untyped.HasMessage (Top'top'params msg)) where
    type InMessage (Top'top'params msg) = msg
    message (Top'top'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Top'top'params msg)) where
    messageDefault msg = (Top'top'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Top'top'params msg)) where
    fromPtr msg ptr = (Top'top'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Top'top'params (Message.MutMsg s))) where
    toPtr msg (Top'top'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Top'top'params (Message.MutMsg s))) where
    new msg = (Top'top'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Top'top'params msg)) where
    newtype List msg (Top'top'params msg)
        = Top'top'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Top'top'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Top'top'params'List_ l) = (Untyped.ListStruct l)
    length (Top'top'params'List_ l) = (Untyped.length l)
    index i (Top'top'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Top'top'params (Message.MutMsg s))) where
    setIndex (Top'top'params'newtype_ elt) i (Top'top'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Top'top'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Top'top'results msg
    = Top'top'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Top'top'results) where
    tMsg f (Top'top'results'newtype_ s) = (Top'top'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Top'top'results msg)) where
    fromStruct struct = (Std_.pure (Top'top'results'newtype_ struct))
instance (Classes.ToStruct msg (Top'top'results msg)) where
    toStruct (Top'top'results'newtype_ struct) = struct
instance (Untyped.HasMessage (Top'top'results msg)) where
    type InMessage (Top'top'results msg) = msg
    message (Top'top'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Top'top'results msg)) where
    messageDefault msg = (Top'top'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Top'top'results msg)) where
    fromPtr msg ptr = (Top'top'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Top'top'results (Message.MutMsg s))) where
    toPtr msg (Top'top'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Top'top'results (Message.MutMsg s))) where
    new msg = (Top'top'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Top'top'results msg)) where
    newtype List msg (Top'top'results msg)
        = Top'top'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Top'top'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Top'top'results'List_ l) = (Untyped.ListStruct l)
    length (Top'top'results'List_ l) = (Untyped.length l)
    index i (Top'top'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Top'top'results (Message.MutMsg s))) where
    setIndex (Top'top'results'newtype_ elt) i (Top'top'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Top'top'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Left msg
    = Left'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (Left msg)) where
    fromPtr msg ptr = (Left'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Left (Message.MutMsg s))) where
    toPtr msg (Left'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (Left'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype Left'left'params msg
    = Left'left'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Left'left'params) where
    tMsg f (Left'left'params'newtype_ s) = (Left'left'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Left'left'params msg)) where
    fromStruct struct = (Std_.pure (Left'left'params'newtype_ struct))
instance (Classes.ToStruct msg (Left'left'params msg)) where
    toStruct (Left'left'params'newtype_ struct) = struct
instance (Untyped.HasMessage (Left'left'params msg)) where
    type InMessage (Left'left'params msg) = msg
    message (Left'left'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Left'left'params msg)) where
    messageDefault msg = (Left'left'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Left'left'params msg)) where
    fromPtr msg ptr = (Left'left'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Left'left'params (Message.MutMsg s))) where
    toPtr msg (Left'left'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Left'left'params (Message.MutMsg s))) where
    new msg = (Left'left'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Left'left'params msg)) where
    newtype List msg (Left'left'params msg)
        = Left'left'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Left'left'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Left'left'params'List_ l) = (Untyped.ListStruct l)
    length (Left'left'params'List_ l) = (Untyped.length l)
    index i (Left'left'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Left'left'params (Message.MutMsg s))) where
    setIndex (Left'left'params'newtype_ elt) i (Left'left'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Left'left'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Left'left'results msg
    = Left'left'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Left'left'results) where
    tMsg f (Left'left'results'newtype_ s) = (Left'left'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Left'left'results msg)) where
    fromStruct struct = (Std_.pure (Left'left'results'newtype_ struct))
instance (Classes.ToStruct msg (Left'left'results msg)) where
    toStruct (Left'left'results'newtype_ struct) = struct
instance (Untyped.HasMessage (Left'left'results msg)) where
    type InMessage (Left'left'results msg) = msg
    message (Left'left'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Left'left'results msg)) where
    messageDefault msg = (Left'left'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Left'left'results msg)) where
    fromPtr msg ptr = (Left'left'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Left'left'results (Message.MutMsg s))) where
    toPtr msg (Left'left'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Left'left'results (Message.MutMsg s))) where
    new msg = (Left'left'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Left'left'results msg)) where
    newtype List msg (Left'left'results msg)
        = Left'left'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Left'left'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Left'left'results'List_ l) = (Untyped.ListStruct l)
    length (Left'left'results'List_ l) = (Untyped.length l)
    index i (Left'left'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Left'left'results (Message.MutMsg s))) where
    setIndex (Left'left'results'newtype_ elt) i (Left'left'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Left'left'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Right msg
    = Right'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (Right msg)) where
    fromPtr msg ptr = (Right'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Right (Message.MutMsg s))) where
    toPtr msg (Right'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (Right'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype Right'right'params msg
    = Right'right'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Right'right'params) where
    tMsg f (Right'right'params'newtype_ s) = (Right'right'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Right'right'params msg)) where
    fromStruct struct = (Std_.pure (Right'right'params'newtype_ struct))
instance (Classes.ToStruct msg (Right'right'params msg)) where
    toStruct (Right'right'params'newtype_ struct) = struct
instance (Untyped.HasMessage (Right'right'params msg)) where
    type InMessage (Right'right'params msg) = msg
    message (Right'right'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Right'right'params msg)) where
    messageDefault msg = (Right'right'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Right'right'params msg)) where
    fromPtr msg ptr = (Right'right'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Right'right'params (Message.MutMsg s))) where
    toPtr msg (Right'right'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Right'right'params (Message.MutMsg s))) where
    new msg = (Right'right'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Right'right'params msg)) where
    newtype List msg (Right'right'params msg)
        = Right'right'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Right'right'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Right'right'params'List_ l) = (Untyped.ListStruct l)
    length (Right'right'params'List_ l) = (Untyped.length l)
    index i (Right'right'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Right'right'params (Message.MutMsg s))) where
    setIndex (Right'right'params'newtype_ elt) i (Right'right'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Right'right'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Right'right'results msg
    = Right'right'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Right'right'results) where
    tMsg f (Right'right'results'newtype_ s) = (Right'right'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Right'right'results msg)) where
    fromStruct struct = (Std_.pure (Right'right'results'newtype_ struct))
instance (Classes.ToStruct msg (Right'right'results msg)) where
    toStruct (Right'right'results'newtype_ struct) = struct
instance (Untyped.HasMessage (Right'right'results msg)) where
    type InMessage (Right'right'results msg) = msg
    message (Right'right'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Right'right'results msg)) where
    messageDefault msg = (Right'right'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Right'right'results msg)) where
    fromPtr msg ptr = (Right'right'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Right'right'results (Message.MutMsg s))) where
    toPtr msg (Right'right'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Right'right'results (Message.MutMsg s))) where
    new msg = (Right'right'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Right'right'results msg)) where
    newtype List msg (Right'right'results msg)
        = Right'right'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Right'right'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Right'right'results'List_ l) = (Untyped.ListStruct l)
    length (Right'right'results'List_ l) = (Untyped.length l)
    index i (Right'right'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Right'right'results (Message.MutMsg s))) where
    setIndex (Right'right'results'newtype_ elt) i (Right'right'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Right'right'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Bottom msg
    = Bottom'newtype_ (Std_.Maybe (Untyped.Cap msg))
instance (Classes.FromPtr msg (Bottom msg)) where
    fromPtr msg ptr = (Bottom'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Bottom (Message.MutMsg s))) where
    toPtr msg (Bottom'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
    toPtr msg (Bottom'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
newtype Bottom'bottom'params msg
    = Bottom'bottom'params'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Bottom'bottom'params) where
    tMsg f (Bottom'bottom'params'newtype_ s) = (Bottom'bottom'params'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Bottom'bottom'params msg)) where
    fromStruct struct = (Std_.pure (Bottom'bottom'params'newtype_ struct))
instance (Classes.ToStruct msg (Bottom'bottom'params msg)) where
    toStruct (Bottom'bottom'params'newtype_ struct) = struct
instance (Untyped.HasMessage (Bottom'bottom'params msg)) where
    type InMessage (Bottom'bottom'params msg) = msg
    message (Bottom'bottom'params'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Bottom'bottom'params msg)) where
    messageDefault msg = (Bottom'bottom'params'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Bottom'bottom'params msg)) where
    fromPtr msg ptr = (Bottom'bottom'params'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Bottom'bottom'params (Message.MutMsg s))) where
    toPtr msg (Bottom'bottom'params'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Bottom'bottom'params (Message.MutMsg s))) where
    new msg = (Bottom'bottom'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Bottom'bottom'params msg)) where
    newtype List msg (Bottom'bottom'params msg)
        = Bottom'bottom'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Bottom'bottom'params'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Bottom'bottom'params'List_ l) = (Untyped.ListStruct l)
    length (Bottom'bottom'params'List_ l) = (Untyped.length l)
    index i (Bottom'bottom'params'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Bottom'bottom'params (Message.MutMsg s))) where
    setIndex (Bottom'bottom'params'newtype_ elt) i (Bottom'bottom'params'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Bottom'bottom'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Bottom'bottom'results msg
    = Bottom'bottom'results'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Bottom'bottom'results) where
    tMsg f (Bottom'bottom'results'newtype_ s) = (Bottom'bottom'results'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Bottom'bottom'results msg)) where
    fromStruct struct = (Std_.pure (Bottom'bottom'results'newtype_ struct))
instance (Classes.ToStruct msg (Bottom'bottom'results msg)) where
    toStruct (Bottom'bottom'results'newtype_ struct) = struct
instance (Untyped.HasMessage (Bottom'bottom'results msg)) where
    type InMessage (Bottom'bottom'results msg) = msg
    message (Bottom'bottom'results'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Bottom'bottom'results msg)) where
    messageDefault msg = (Bottom'bottom'results'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Bottom'bottom'results msg)) where
    fromPtr msg ptr = (Bottom'bottom'results'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Bottom'bottom'results (Message.MutMsg s))) where
    toPtr msg (Bottom'bottom'results'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Bottom'bottom'results (Message.MutMsg s))) where
    new msg = (Bottom'bottom'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
instance (Basics.ListElem msg (Bottom'bottom'results msg)) where
    newtype List msg (Bottom'bottom'results msg)
        = Bottom'bottom'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Bottom'bottom'results'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Bottom'bottom'results'List_ l) = (Untyped.ListStruct l)
    length (Bottom'bottom'results'List_ l) = (Untyped.length l)
    index i (Bottom'bottom'results'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Bottom'bottom'results (Message.MutMsg s))) where
    setIndex (Bottom'bottom'results'newtype_ elt) i (Bottom'bottom'results'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Bottom'bottom'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
newtype Defaults msg
    = Defaults'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg Defaults) where
    tMsg f (Defaults'newtype_ s) = (Defaults'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (Defaults msg)) where
    fromStruct struct = (Std_.pure (Defaults'newtype_ struct))
instance (Classes.ToStruct msg (Defaults msg)) where
    toStruct (Defaults'newtype_ struct) = struct
instance (Untyped.HasMessage (Defaults msg)) where
    type InMessage (Defaults msg) = msg
    message (Defaults'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (Defaults msg)) where
    messageDefault msg = (Defaults'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (Defaults msg)) where
    fromPtr msg ptr = (Defaults'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (Defaults (Message.MutMsg s))) where
    toPtr msg (Defaults'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (Defaults (Message.MutMsg s))) where
    new msg = (Defaults'newtype_ <$> (Untyped.allocStruct msg 2 2))
instance (Basics.ListElem msg (Defaults msg)) where
    newtype List msg (Defaults msg)
        = Defaults'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (Defaults'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (Defaults'List_ l) = (Untyped.ListStruct l)
    length (Defaults'List_ l) = (Untyped.length l)
    index i (Defaults'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (Defaults (Message.MutMsg s))) where
    setIndex (Defaults'newtype_ elt) i (Defaults'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (Defaults'List_ <$> (Untyped.allocCompositeList msg 2 2 len))
get_Defaults'text :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m (Basics.Text msg))
get_Defaults'text (Defaults'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Defaults'text :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_Defaults'text (Defaults'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_Defaults'text :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Bool)
has_Defaults'text (Defaults'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_Defaults'text :: ((Untyped.RWCtx m s)) => Std_.Int -> (Defaults (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_Defaults'text len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_Defaults'text struct result)
    (Std_.pure result)
    )
get_Defaults'data_ :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m (Basics.Data msg))
get_Defaults'data_ (Defaults'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_Defaults'data_ :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
set_Defaults'data_ (Defaults'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_Defaults'data_ :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Bool)
has_Defaults'data_ (Defaults'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_Defaults'data_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Defaults (Message.MutMsg s)) -> (m (Basics.Data (Message.MutMsg s)))
new_Defaults'data_ len struct = (do
    result <- (Basics.newData (Untyped.message struct) len)
    (set_Defaults'data_ struct result)
    (Std_.pure result)
    )
get_Defaults'float :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Float)
get_Defaults'float (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 0 0 1078523331)
set_Defaults'float :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Float -> (m ())
set_Defaults'float (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 1078523331)
get_Defaults'int :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Int32)
get_Defaults'int (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 0 32 18446744073709551493)
set_Defaults'int :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_Defaults'int (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 18446744073709551493)
get_Defaults'uint :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Word32)
get_Defaults'uint (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 1 0 42)
set_Defaults'uint :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Word32 -> (m ())
set_Defaults'uint (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 42)
newtype BenchmarkA msg
    = BenchmarkA'newtype_ (Untyped.Struct msg)
instance (Untyped.TraverseMsg BenchmarkA) where
    tMsg f (BenchmarkA'newtype_ s) = (BenchmarkA'newtype_ <$> (Untyped.tMsg f s))
instance (Classes.FromStruct msg (BenchmarkA msg)) where
    fromStruct struct = (Std_.pure (BenchmarkA'newtype_ struct))
instance (Classes.ToStruct msg (BenchmarkA msg)) where
    toStruct (BenchmarkA'newtype_ struct) = struct
instance (Untyped.HasMessage (BenchmarkA msg)) where
    type InMessage (BenchmarkA msg) = msg
    message (BenchmarkA'newtype_ struct) = (Untyped.message struct)
instance (Untyped.MessageDefault (BenchmarkA msg)) where
    messageDefault msg = (BenchmarkA'newtype_ (Untyped.messageDefault msg))
instance (Classes.FromPtr msg (BenchmarkA msg)) where
    fromPtr msg ptr = (BenchmarkA'newtype_ <$> (Classes.fromPtr msg ptr))
instance (Classes.ToPtr s (BenchmarkA (Message.MutMsg s))) where
    toPtr msg (BenchmarkA'newtype_ struct) = (Classes.toPtr msg struct)
instance (Classes.Allocate s (BenchmarkA (Message.MutMsg s))) where
    new msg = (BenchmarkA'newtype_ <$> (Untyped.allocStruct msg 3 2))
instance (Basics.ListElem msg (BenchmarkA msg)) where
    newtype List msg (BenchmarkA msg)
        = BenchmarkA'List_ (Untyped.ListOf msg (Untyped.Struct msg))
    listFromPtr msg ptr = (BenchmarkA'List_ <$> (Classes.fromPtr msg ptr))
    toUntypedList (BenchmarkA'List_ l) = (Untyped.ListStruct l)
    length (BenchmarkA'List_ l) = (Untyped.length l)
    index i (BenchmarkA'List_ l) = (do
        elt <- (Untyped.index i l)
        (Classes.fromStruct elt)
        )
instance (Basics.MutListElem s (BenchmarkA (Message.MutMsg s))) where
    setIndex (BenchmarkA'newtype_ elt) i (BenchmarkA'List_ l) = (Untyped.setIndex elt i l)
    newList msg len = (BenchmarkA'List_ <$> (Untyped.allocCompositeList msg 3 2 len))
get_BenchmarkA'name :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m (Basics.Text msg))
get_BenchmarkA'name (BenchmarkA'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 0 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_BenchmarkA'name :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_BenchmarkA'name (BenchmarkA'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 0 struct)
    )
has_BenchmarkA'name :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
has_BenchmarkA'name (BenchmarkA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
new_BenchmarkA'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (BenchmarkA (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_BenchmarkA'name len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_BenchmarkA'name struct result)
    (Std_.pure result)
    )
get_BenchmarkA'birthDay :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Int64)
get_BenchmarkA'birthDay (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
set_BenchmarkA'birthDay :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Int64 -> (m ())
set_BenchmarkA'birthDay (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
get_BenchmarkA'phone :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m (Basics.Text msg))
get_BenchmarkA'phone (BenchmarkA'newtype_ struct) = (do
    ptr <- (Untyped.getPtr 1 struct)
    (Classes.fromPtr (Untyped.message struct) ptr)
    )
set_BenchmarkA'phone :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
set_BenchmarkA'phone (BenchmarkA'newtype_ struct) value = (do
    ptr <- (Classes.toPtr (Untyped.message struct) value)
    (Untyped.setPtr ptr 1 struct)
    )
has_BenchmarkA'phone :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
has_BenchmarkA'phone (BenchmarkA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
new_BenchmarkA'phone :: ((Untyped.RWCtx m s)) => Std_.Int -> (BenchmarkA (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
new_BenchmarkA'phone len struct = (do
    result <- (Basics.newText (Untyped.message struct) len)
    (set_BenchmarkA'phone struct result)
    (Std_.pure result)
    )
get_BenchmarkA'siblings :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Int32)
get_BenchmarkA'siblings (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
set_BenchmarkA'siblings :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Int32 -> (m ())
set_BenchmarkA'siblings (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
get_BenchmarkA'spouse :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
get_BenchmarkA'spouse (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 1 32 0)
set_BenchmarkA'spouse :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Bool -> (m ())
set_BenchmarkA'spouse (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 32 0)
get_BenchmarkA'money :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Double)
get_BenchmarkA'money (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
set_BenchmarkA'money :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Double -> (m ())
set_BenchmarkA'money (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)