diff --git a/.gitattributes b/.gitattributes --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,4 @@ # Mark generated output as such for GitHub diffs: /lib/Capnp/ linguist-generated=true /lib/Capnp/ linguist-generated=true -/lib/Data/Capnp/BuiltinTypes/Lists.hs +/lib/Internal/Gen/ linguist-generated=true diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,26 @@ +# 0.3.0.0 + +* Instances of some type classes are no longer generated for "second + class" types (i.e. types which cannot appear as stand-alone + definitions in schema files -- groups and unions). +* `has_*` functions are now only generated for pointer fields. +* Various non-functional changes in the output of the code generator. +* We now generate constants for (most) pointer types; previously + constants defined in a schema would not result in any generated code + ([#41][issue41]). +* The `set_*` functions now check if the arguments are in the same + message, and copy if need be ([#34][issue34]). +* `MutMsg` is now an instance of `Eq`. +* The `HasMessage` class from `Data.Capnp.Untyped` is now a type family, + rather than a multi-parameter type class. This improves inference and + removes some superfluous generalization. +* The module `Data.Capnp.Pure` has been folded into `Data.Capnp`. If you + were previously using the `Text` and `Data` type aliases it exported, + you should instead use `Text` from `Data.Text` and `ByteString` from + `Data.ByteString`; the `Text` and `Data` exported by `Data.Capnp` are + types from the low-level API. + # 0.2.0.0 * Redesign the 'Mutable' type class's API. @@ -8,3 +30,6 @@ # 0.1.0.0 * First release; basic read & write support, serialization only. + +[issue41]: https://github.com/zenhack/haskell-capnp/issues/41 +[issue34]: https://github.com/zenhack/haskell-capnp/issues/34 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,5 @@ [![build status][ci-img]][ci] +[![hackage][hackage-img]][hackage] A Haskell library for the [Cap'N Proto][1] Cerialization protocol. @@ -32,3 +33,6 @@ [ci-img]: https://gitlab.com/isd/haskell-capnp/badges/master/build.svg [ci]: https://gitlab.com/isd/haskell-capnp/pipelines + +[hackage-img]: https://img.shields.io/hackage/v/capnp.svg +[hackage]: https://hackage.haskell.org/package/capnp diff --git a/capnp.cabal b/capnp.cabal --- a/capnp.cabal +++ b/capnp.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: capnp -version: 0.2.0.0 +version: 0.3.0.0 stability: Experimental category: Data, Serialization copyright: 2016-2018 haskell-capnp contributors (see CONTRIBUTORS file). @@ -86,12 +86,12 @@ hs-source-dirs: lib exposed-modules: Data.Capnp - , Data.Capnp.Pure , Data.Capnp.Address , Data.Capnp.Basics , Data.Capnp.Basics.Pure , Data.Capnp.Bits , Data.Capnp.Classes + , Data.Capnp.Convert , Data.Capnp.Errors , Data.Capnp.GenHelpers , Data.Capnp.GenHelpers.Pure @@ -106,7 +106,6 @@ , Data.Mutable , Capnp - , Capnp.ById , Capnp.Capnp -- BEGIN GENERATED SCHEMA MODULES @@ -137,6 +136,7 @@ -- END GENERATED SCHEMA MODULES other-modules: Internal.Util + , Internal.AppendVec , Internal.Gen.Instances , Internal.BuildPure , Codec.Capnp @@ -153,6 +153,7 @@ main-is: Main.hs other-modules: FrontEnd + , Fmt , IR , Backends.Common , Backends.Pure @@ -176,7 +177,7 @@ import: shared-opts type: exitcode-stdio-1.0 main-is: Main.hs - hs-source-dirs: tests/simple-tests + hs-source-dirs: tests other-modules: Tests.Module.Capnp.Capnp.Schema , Tests.Module.Capnp.Capnp.Schema.Pure @@ -188,6 +189,7 @@ , Tests.SchemaGeneration , Tests.SchemaQuickCheck , Tests.Util + , Instances build-depends: capnp , data-default diff --git a/exe/capnpc-haskell/Backends/Pure.hs b/exe/capnpc-haskell/Backends/Pure.hs --- a/exe/capnpc-haskell/Backends/Pure.hs +++ b/exe/capnpc-haskell/Backends/Pure.hs @@ -17,11 +17,10 @@ import qualified Data.Text as T import qualified Text.PrettyPrint.Leijen.Text as PP +import Fmt import IR import Util -indent = PP.indent 4 - -- | If a module reference refers to a generated module, does it -- refer to the raw, low-level module or the *.Pure variant (which -- this module generates)? @@ -54,6 +53,7 @@ , ( printf "Capnp/ById/X%x/Pure.hs" modId , vcat [ "{-# OPTIONS_GHC -Wno-unused-imports #-}" + , "{-# OPTIONS_HADDOCK hide #-}" , "{- |" , hcat [ "Module: ", machineMod ] , hcat [ "Description: Machine-addressable alias for '", humanMod, "'." ] @@ -124,14 +124,22 @@ mintercalate ", " (map (fmtExport modId) (M.toList modDecls)) fmtExport :: Id -> (Name, Decl) -> PP.Doc -fmtExport thisMod (name, DeclDef DataDef{dataCerialType}) = case dataCerialType of - CTyStruct _ _ -> - fmtName Pure thisMod name <> "(..)" - CTyEnum -> - -- This one is 'Raw' because we're just re-exporting these. - fmtName Raw thisMod name <> "(..)" -fmtExport thisMod (name, DeclConst _) = fmtName Pure thisMod (valueName name) +fmtExport thisMod (name, DeclDef DefStruct{}) = + fmtName Pure thisMod name <> "(..)" +fmtExport thisMod (name, DeclDef DefUnion{}) = + fmtName Pure thisMod name <> "(..)" +-- These are 'Raw' because we're just re-exporting them: +fmtExport thisMod (name, DeclDef DefEnum{}) = + fmtName Raw thisMod name <> "(..)" +fmtExport thisMod (name, DeclConst VoidConst) = + fmtName Raw thisMod (valueName name) +fmtExport thisMod (name, DeclConst WordConst{}) = + fmtName Raw thisMod (valueName name) + +fmtExport thisMod (name, DeclConst _) = + fmtName Pure thisMod (valueName name) + fmtImport :: ModRefType -> Import -> PP.Doc fmtImport ty (Import ref) = "import qualified " <> fmtModRef ty ref @@ -194,67 +202,122 @@ fmtConst thisMod name value = let pureName = fmtName Pure thisMod (valueName name) rawName = fmtName Raw thisMod (valueName name) - in vcat - -- We just define this as an alias for the one in the raw module. - -- TODO: we should just re-export the existing constant instead - -- (but note that when we support struct and list constants we'll - -- have to handle those separately). - [ hcat - [ pureName, " :: ", case value of - VoidConst -> "()" - WordConst{wordType=PrimWord ty} -> fmtPrimWord ty - WordConst{wordType=EnumType typeName} -> fmtName Raw thisMod typeName + in case value of + -- For word types, We just re-export the definitions from the + -- low-level module, so we don't need to declare anything here: + VoidConst -> "" + WordConst{} -> "" + + PtrConst{ptrType} -> vcat + [ hcat [ pureName, " :: ", fmtType thisMod (PtrType ptrType) ] + , hcat [ pureName, " = PH'.toPurePtrConst ", rawName ] ] - , hcat [ pureName, " = ", rawName ] - ] fmtDataDef :: Id -> Name -> DataDef -> PP.Doc -fmtDataDef thisMod dataName DataDef{dataCerialType=CTyEnum} = +fmtDataDef thisMod dataName DefEnum{} = -- We end up re-exporting these, but doing nothing else. "" -fmtDataDef thisMod dataName DataDef{dataVariants} = +fmtDataDef thisMod dataName dataDef = let rawName = fmtName Raw thisMod dataName pureName = fmtName Pure thisMod dataName + + unknownName = subName dataName "unknown'" in vcat - [ hcat [ "data ", fmtName Pure thisMod dataName ] - , indent $ " = " <> vcat (PP.punctuate " |" $ map (fmtVariant thisMod) dataVariants) - , indent "deriving(Show, Read, Eq, Generic)" - , hcat [ "instance C'.Decerialize ", pureName, " where" ] - , indent $ vcat - [ hcat [ "type Cerial msg ", pureName, " = ", rawName, " msg" ] - , "decerialize raw = do" - , indent $ case dataVariants of - [Variant{variantName,variantParams=Record fields}] -> - fmtDecerializeArgs variantName fields - _ -> vcat - [ hcat [ "raw <- ", fmtName Raw thisMod $ prefixName "get_" (subName dataName ""), " raw" ] - , "case raw of" - , indent $ vcat (map fmtDecerializeVariant dataVariants) + [ case dataDef of + DefEnum{} -> + -- TODO: refactor so we don't need this case. + error "BUG: this should have been ruled out above." + DefStruct StructDef{fields,info} -> + let dataVariant = + -- TODO: some of the functions we use still expect structs + -- to just be single-variant unions; this is a stand-in, + -- but we should update those at some point. + Variant + { variantName = dataName + , variantParams = Record fields + , variantTag = 0 -- doesn't matter; just formatting + -- the data constructor, so this + -- isn't used. + } + in vcat + [ data_ (fmtName Pure thisMod dataName) + [ fmtVariant thisMod dataVariant ] + ["Show", "Read", "Eq", "Generic"] + , instance_ [] ("C'.Decerialize " <> pureName) + [ hcat [ "type Cerial msg ", pureName, " = ", rawName, " msg" ] + , "decerialize raw = do" + , indent $ fmtDecerializeArgs dataName fields ] - ] - , hcat [ "instance C'.FromStruct M'.ConstMsg ", pureName, " where" ] - , indent $ vcat + , instance_ [] ("C'.Marshal " <> pureName) + [ "marshalInto raw value = do" + , indent $ vcat + [ "case value of\n" + , indent $ vcat + [ fmtCerializeVariant False dataVariant ] + ] + ] + , case info of + IsStandalone{} -> + instance_ [] ("C'.Cerialize s " <> pureName) + [] + _ -> + "" + ] + DefUnion{dataVariants,parentStructName,parentStruct=StructDef{info}} -> + let unknownVariantName = subName parentStructName "unknown'" + in vcat + [ data_ + (fmtName Pure thisMod dataName) + (map (fmtVariant thisMod) dataVariants ++ + [ fmtName Pure thisMod unknownVariantName <> " Word16" ] + ) + ["Show", "Read", "Eq", "Generic"] + , instance_ [] ("C'.Decerialize " <> pureName) + [ hcat [ "type Cerial msg ", pureName, " = ", rawName, " msg" ] + , "decerialize raw = do" + , indent $ vcat + [ hcat [ "raw <- ", fmtName Raw thisMod $ prefixName "get_" (subName dataName ""), " raw" ] + , "case raw of" + , indent $ vcat + [ vcat (map fmtDecerializeVariant dataVariants) + , hcat + [ fmtName Raw thisMod unknownName, " val -> pure $ " + , fmtName Pure thisMod unknownVariantName, " val" + ] + ] + ] + ] + , instance_ [] ("C'.Marshal " <> pureName) + [ "marshalInto raw value = do" + , indent $ vcat + [ "case value of\n" + , indent $ vcat + [ vcat $ map (fmtCerializeVariant True) dataVariants + , hcat + [ fmtName Pure thisMod unknownVariantName, " arg_ -> " + , fmtName Raw thisMod $ prefixName "set_" unknownName, " raw arg_" + ] + ] + ] + ] + , case info of + IsStandalone{} -> + instance_ [] ("C'.Cerialize s " <> pureName) + [] + _ -> + "" + ] + , instance_ [] ("C'.FromStruct M'.ConstMsg " <> pureName) [ "fromStruct struct = do" , indent $ vcat [ "raw <- C'.fromStruct struct" , hcat [ "C'.decerialize (raw :: ", rawName, " M'.ConstMsg)" ] ] ] - , hcat [ "instance C'.Marshal ", pureName, " where" ] - , indent $ vcat - [ "marshalInto raw value = do" - , indent $ vcat - [ "case value of\n" - , indent $ vcat $ map - (fmtCerializeVariant (length dataVariants /= 1)) - dataVariants - ] - ] - , hcat [ "instance C'.Cerialize s ", pureName ] - , hcat [ "instance Default ", pureName, " where" ] - , indent $ vcat + , instance_ [] ("Default " <> pureName) [ "def = PH'.defaultStruct" ] + ] where fmtDecerializeArgs variantName fields = vcat diff --git a/exe/capnpc-haskell/Backends/Raw.hs b/exe/capnpc-haskell/Backends/Raw.hs --- a/exe/capnpc-haskell/Backends/Raw.hs +++ b/exe/capnpc-haskell/Backends/Raw.hs @@ -7,26 +7,31 @@ ( fmtModule ) where -import Data.Word - +import Data.Function ((&)) import Data.List (sortOn) import Data.Monoid ((<>)) import Data.Ord (Down(..)) import Data.String (IsString(..)) +import GHC.Exts (IsList(fromList)) import Text.PrettyPrint.Leijen.Text (hcat, vcat) import Text.Printf (printf) +import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Text.PrettyPrint.Leijen.Text as PP +import Fmt import IR import Util import Backends.Common (dataFieldSize, fmtPrimWord) -indent = PP.indent 4 +import Data.Capnp + (cerialize, createPure, defaultLimit, msgToLBS, newMessage, setRoot) +import qualified Data.Capnp.Untyped.Pure as Untyped + -- | Sort varaints by their tag, in decending order (with no tag at all being last). sortVariants = sortOn (Down . variantTag) @@ -38,6 +43,7 @@ , ( printf "Capnp/ById/X%x.hs" modId , vcat [ "{-# OPTIONS_GHC -Wno-unused-imports #-}" + , "{-# OPTIONS_HADDOCK hide #-}" , "{- |" , hcat [ "Module: ", machineMod ] , hcat [ "Description: machine-addressable alias for '", humanMod, "'." ] @@ -79,6 +85,7 @@ , "" , "import qualified Data.Bits" , "import qualified Data.Maybe" + , "import qualified Data.ByteString" -- The trailing ' is to avoid possible name collisions: , "import qualified Data.Capnp.Classes as C'" , "import qualified Data.Capnp.Basics as B'" @@ -102,13 +109,11 @@ -- | format the IsPtr instance for a list of the struct type with -- the given name. fmtStructListIsPtr :: PP.Doc -> PP.Doc -fmtStructListIsPtr nameText = vcat - [ hcat [ "instance C'.IsPtr msg (B'.List msg (", nameText, " msg)) where" ] - , indent $ vcat +fmtStructListIsPtr nameText = + instance_ [] ("C'.IsPtr msg (B'.List msg (" <> nameText <> " msg))") [ hcat [ "fromPtr msg ptr = List_", nameText, " <$> C'.fromPtr msg ptr" ] , hcat [ "toPtr (List_", nameText, " l) = C'.toPtr l" ] ] - ] -- | Generate declarations common to all types which are represented -- by 'Untyped.Struct'. @@ -117,74 +122,63 @@ -- -- * thisMod - the module that we are generating. -- * name - the name of the type. --- * dataSz - the size of the data section, in words. --- * ptrSz - the size of the pointer section. -fmtNewtypeStruct :: Module -> Name -> Word16 -> Word16 -> PP.Doc -fmtNewtypeStruct thisMod name dataSz ptrSz = +-- * info - the StructInfo; this is a group, some instances will be skipped. +fmtNewtypeStruct :: Module -> Name -> IR.StructInfo -> PP.Doc +fmtNewtypeStruct thisMod name info = let typeCon = fmtName thisMod name dataCon = typeCon <> "_newtype_" in vcat [ hcat [ "newtype ", typeCon, " msg = ", dataCon, " (U'.Struct msg)" ] - - , hcat [ "instance C'.FromStruct msg (", typeCon, " msg) where" ] - , indent $ vcat + , instance_ [] ("C'.FromStruct msg (" <> typeCon <> " msg)") [ hcat [ "fromStruct = pure . ", dataCon ] ] - - , hcat [ "instance C'.ToStruct msg (", typeCon, " msg) where" ] - , indent $ vcat + , instance_ [] ("C'.ToStruct msg (" <> typeCon <> " msg)") [ hcat [ "toStruct (", dataCon, " struct) = struct" ] ] - - , hcat [ "instance C'.IsPtr msg (", typeCon, " msg) where" ] - , indent $ vcat - [ hcat [ "fromPtr msg ptr = ", dataCon, " <$> C'.fromPtr msg ptr" ] - , hcat [ "toPtr (", dataCon, " struct) = C'.toPtr struct" ] - ] - , fmtStructListElem typeCon - - , hcat [ "instance B'.MutListElem s (", typeCon, " (M'.MutMsg s)) where" ] - , indent $ vcat - [ hcat [ "setIndex (", dataCon, " elt) i (List_", typeCon, " l) = U'.setIndex elt i l" ] - , hcat - [ "newList msg len = List_", typeCon, " <$> U'.allocCompositeList msg " - , fromString (show dataSz), " " - , fromString (show ptrSz), " len" - ] - ] - - , hcat [ "instance U'.HasMessage (", typeCon, " msg) msg where" ] - , indent $ vcat - [ hcat [ "message (", dataCon, " struct) = U'.message struct" ] + , instance_ [] ("U'.HasMessage (" <> typeCon <> " msg)") + [ hcat [ "type InMessage (", typeCon, " msg) = msg" ] + , hcat [ "message (", dataCon, " struct) = U'.message struct" ] ] - - , hcat [ "instance U'.MessageDefault (", typeCon, " msg) msg where" ] - , indent $ vcat + , instance_ [] ("U'.MessageDefault (" <> typeCon <> " msg)") [ hcat [ "messageDefault = ", dataCon, " . U'.messageDefault" ] ] - - , hcat [ "instance C'.Allocate s (", typeCon, " (M'.MutMsg s)) where" ] - , indent $ vcat - [ hcat - [ "new msg = ", dataCon , " <$> U'.allocStruct msg " - , fromString (show dataSz), " " - , fromString (show ptrSz) + , case info of + IR.IsGroup -> + "" + IR.IsStandalone{dataSz, ptrSz} -> vcat + [ fmtStructListElem typeCon + , instance_ [] ("C'.IsPtr msg (" <> typeCon <> " msg)") + [ hcat [ "fromPtr msg ptr = ", dataCon, " <$> C'.fromPtr msg ptr" ] + , hcat [ "toPtr (", dataCon, " struct) = C'.toPtr struct" ] + ] + , instance_ [] ("B'.MutListElem s (" <> typeCon <> " (M'.MutMsg s))") + [ hcat [ "setIndex (", dataCon, " elt) i (List_", typeCon, " l) = U'.setIndex elt i l" ] + , hcat + [ "newList msg len = List_", typeCon, " <$> U'.allocCompositeList msg " + , fromString (show dataSz), " " + , fromString (show ptrSz), " len" + ] + ] + , instance_ [] ("C'.Allocate s (" <> typeCon <> " (M'.MutMsg s))") + [ hcat + [ "new msg = ", dataCon , " <$> U'.allocStruct msg " + , fromString (show dataSz), " " + , fromString (show ptrSz) + ] + ] + , fmtStructListIsPtr typeCon ] - ] - , fmtStructListIsPtr typeCon ] -- | Generate an instance of ListElem for a struct type. The parameter is the name of -- the type constructor. fmtStructListElem :: PP.Doc -> PP.Doc -fmtStructListElem nameText = vcat - [ hcat [ "instance B'.ListElem msg (", nameText, " msg) where" ] - , indent $ vcat +fmtStructListElem nameText = + instance_ [] ("B'.ListElem msg (" <> nameText <> " msg)") [ hcat [ "newtype List msg (", nameText, " msg) = List_", nameText, " (U'.ListOf msg (U'.Struct msg))" ] , hcat [ "length (List_", nameText, " l) = U'.length l" ] , hcat [ "index i (List_", nameText, " l) = U'.index i l >>= ", fmtRestrictedFromStruct nameText ] ] - ] -- | Output an expression equivalent to fromStruct, but restricted to the type -- with the given type constructor (which must have kind * -> *). @@ -272,19 +266,18 @@ , getDef " Data.Capnp.TraversalLimit.invoice 1 >> pure ()" ] fmtHas = - let hasType = typeCon <> " msg -> m Bool" - in vcat - [ hcat [ hasName, " :: U'.ReadCtx m msg => ", hasType ] - , hcat - [ hasName, "(", dataCon, " struct) = ", case fieldLocType of - DataField DataLoc{dataIdx} _ -> - "pure $ " <> fromString (show dataIdx) <> " < U'.length (U'.dataSection struct)" - PtrField idx _ -> - "Data.Maybe.isJust <$> U'.getPtr " <> fromString (show idx) <> " struct" - HereField _ -> "pure True" - VoidField -> "pure True" - ] - ] + case fieldLocType of + PtrField idx _ -> vcat + [ hcat [ hasName, " :: U'.ReadCtx m msg => ", typeCon, " msg -> m Bool" ] + , hcat + [ hasName, "(", dataCon, " struct) = " + , "Data.Maybe.isJust <$> U'.getPtr " + , fromString (show idx) + , " struct" + ] + ] + _ -> + "" fmtSetter = let setType fieldType = typeCon <> " (M'.MutMsg s) -> " <> fmtType thisMod "(M'.MutMsg s)" fieldType <> " -> m ()" typeAnnotation fieldType = setName <> " :: U'.RWCtx m s => " <> setType fieldType @@ -372,31 +365,36 @@ -- Generate setters for union variants, plus new_* functions where the argument -- is a pointer type. -fmtUnionSetter :: Module -> Name -> DataLoc -> Variant -> PP.Doc -fmtUnionSetter thisMod parentType tagLoc Variant{..} = go variantTag - where - accessorName prefix = prefix <> fmtName thisMod variantName - setName = "set_" <> fmtName thisMod variantName - parentTypeCon = fmtName thisMod parentType - parentDataCon = parentTypeCon <> "_newtype_" - fmtSetTag = fmtSetWordField "struct" - (hcat - [ "(" - , case variantTag of - Just tagValue -> - fromString (show tagValue) +fmtUnionSetter :: Module -> Name -> DataLoc -> Maybe Variant -> PP.Doc +fmtUnionSetter thisMod parentType tagLoc variant = + let (variantName, variantParams) = case variant of + Just Variant{..} -> + (variantName, Just variantParams) + Nothing -> + ( subName parentType "unknown'" + , Nothing + ) + accessorName prefix = prefix <> fmtName thisMod variantName + setName = "set_" <> fmtName thisMod variantName + parentTypeCon = fmtName thisMod parentType + parentDataCon = parentTypeCon <> "_newtype_" + fmtSetTag = fmtSetWordField + "struct" + (case variant of + Just Variant{variantTag} -> + hcat [ "(", fromString (show variantTag), " :: Word16)" ] Nothing -> - "tagValue" - , " :: Word16)" - ]) - tagLoc - go Nothing = vcat - -- this is the unknown' variant; we just accept the tag as an argument. - [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> Word16 -> m ()" ] - , hcat [ setName, "(", parentDataCon, " struct) tagValue = ", fmtSetTag ] - ] - go (Just _) = case variantParams of - Record _ -> + "(tagValue :: Word16)") + tagLoc + in case variantParams of + Nothing -> vcat + [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> Word16 -> m ()" ] + , hcat + [ setName, "(", parentDataCon, " struct) tagValue = " + , fmtSetTag + ] + ] + Just (Record _) -> -- Variant is a group; we return a reference to the group so the user can -- modify it. let childTypeCon = fmtName thisMod (subName variantName "group'") @@ -412,7 +410,7 @@ , hcat [ "pure $ ", childDataCon, " struct" ] ] ] - Unnamed _ (DataField loc typ) -> vcat + Just (Unnamed _ (DataField loc typ)) -> vcat [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> " , fmtType thisMod "(M'.MutMsg s)" (WordType typ), " -> m ()" @@ -426,7 +424,7 @@ loc ] ] - Unnamed _ fieldLocType@(PtrField index typ) -> vcat + Just (Unnamed _ fieldLocType@(PtrField index typ)) -> vcat [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> " , fmtType thisMod "(M'.MutMsg s)" (PtrType typ), " -> m ()" @@ -440,11 +438,11 @@ -- Also generate a new_* function. , fmtNew thisMod accessorName parentTypeCon fieldLocType ] - Unnamed _ VoidField -> vcat + Just (Unnamed _ VoidField) -> vcat [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> m ()" ] , hcat [ setName, " (", parentDataCon, " struct) = ", fmtSetTag ] ] - Unnamed _ (HereField typ) -> vcat + Just (Unnamed _ (HereField typ)) -> vcat [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> " , "m (", fmtType thisMod " (M'.MutMsg s)" (CompositeType typ), ")" @@ -478,37 +476,68 @@ [ hcat [ nameText, " :: ()" ] , hcat [ nameText, " = ()" ] ] + PtrConst{ptrType,ptrValue} -> + vcat + [ hcat [ nameText, " :: ", fmtType thisMod "M'.ConstMsg" (PtrType ptrType) ] + , hcat + [ nameText, " = H'.getPtrConst $ Data.ByteString.pack " + , makePtrByteList ptrValue + ] + ] + where + makePtrByteList ptr = + let assertRight (Left e) = error (show e) + assertRight (Right v) = v + msg = assertRight $ createPure defaultLimit $ do + msg <- newMessage + rootPtr <- cerialize msg $ Untyped.Struct + (fromList []) + (fromList [ptr]) + setRoot rootPtr + pure msg + in + msgToLBS msg & + LBS.unpack & + show & + T.pack & + PP.textStrict fmtDataDef :: Module -> Name -> DataDef -> PP.Doc -fmtDataDef thisMod dataName DataDef{dataVariants=[Variant{..}], dataCerialType=CTyStruct dataSz ptrSz, ..} = - vcat - [ fmtNewtypeStruct thisMod dataName dataSz ptrSz - , case variantParams of - Record fields -> - vcat $ map (fmtFieldAccessor thisMod dataName variantName) fields - _ -> "" - ] -fmtDataDef thisMod dataName DataDef{dataCerialType=CTyStruct dataSz ptrSz,dataTagLoc=Just tagLoc,dataVariants} = +fmtDataDef thisMod dataName (DefStruct StructDef{fields, info}) = vcat + [ fmtNewtypeStruct thisMod dataName info + , vcat $ map (fmtFieldAccessor thisMod dataName dataName) fields + ] +fmtDataDef thisMod dataName DefUnion{dataVariants,dataTagLoc,parentStruct=StructDef{info}} = let unionName = subName dataName "" unionNameText = fmtName thisMod unionName + unknownName = subName dataName "unknown'" in vcat - [ fmtNewtypeStruct thisMod dataName dataSz ptrSz - , hcat [ "data ", unionNameText, " msg =" ] - , indent $ vcat $ PP.punctuate " |" (map fmtDataVariant dataVariants) + [ fmtNewtypeStruct thisMod dataName info + , data_ + (unionNameText <> " msg") + (map fmtDataVariant dataVariants ++ + [fmtName thisMod unknownName <> " Word16"] + ) + [] , fmtFieldAccessor thisMod dataName dataName Field { fieldName = "" , fieldLocType = HereField $ StructType unionName [] } - , vcat $ map (fmtUnionSetter thisMod dataName tagLoc) dataVariants + , vcat $ map (fmtUnionSetter thisMod dataName dataTagLoc . Just) dataVariants + , fmtUnionSetter thisMod dataName dataTagLoc Nothing -- Generate auxiliary newtype definitions for group fields: , vcat $ map fmtVariantAuxNewtype dataVariants - , hcat [ "instance C'.FromStruct msg (", unionNameText, " msg) where" ] - , indent $ vcat - [ "fromStruct struct = do" - , indent $ vcat - [ hcat [ "tag <- ", fmtGetWordField "struct" tagLoc ] - , "case tag of" - , indent $ vcat $ map fmtVariantCase $ sortVariants dataVariants + , instance_ [] ("C'.FromStruct msg (" <> unionNameText <> " msg)") + [ vcat + [ "fromStruct struct = do" + , indent $ vcat + [ hcat [ "tag <- ", fmtGetWordField "struct" dataTagLoc ] + , "case tag of" + , indent $ vcat + [ vcat $ map fmtVariantCase $ sortVariants dataVariants + , hcat [ "_ -> pure $ ", fmtName thisMod unknownName, " tag" ] + ] + ] ] ] ] @@ -520,95 +549,81 @@ Unnamed ty _ -> " " <> fmtType thisMod "msg" ty fmtVariantCase Variant{..} = let nameText = fmtName thisMod variantName - in case variantTag of - Just tag -> - hcat - [ fromString (show tag), " -> " - , case variantParams of - Record _ -> nameText <> " <$> C'.fromStruct struct" - Unnamed _ (HereField _) -> nameText <> " <$> C'.fromStruct struct" - Unnamed _ VoidField -> - "pure " <> nameText - Unnamed _ (DataField loc _) -> - nameText <> " <$> " <> fmtGetWordField "struct" loc - Unnamed _ (PtrField idx _) -> hcat - [ nameText," <$> " - , " (U'.getPtr ", fromString (show idx), " struct" - , " >>= C'.fromPtr (U'.message struct))" - ] - ] - Nothing -> - "_ -> pure $ " <> nameText <> " tag" + in hcat + [ fromString (show variantTag), " -> " + , case variantParams of + Record _ -> nameText <> " <$> C'.fromStruct struct" + Unnamed _ (HereField _) -> nameText <> " <$> C'.fromStruct struct" + Unnamed _ VoidField -> + "pure " <> nameText + Unnamed _ (DataField loc _) -> + nameText <> " <$> " <> fmtGetWordField "struct" loc + Unnamed _ (PtrField idx _) -> hcat + [ nameText," <$> " + , " (U'.getPtr ", fromString (show idx), " struct" + , " >>= C'.fromPtr (U'.message struct))" + ] + ] fmtVariantAuxNewtype Variant{variantName, variantParams=Record fields} = let typeName = subName variantName "group'" in vcat - [ fmtNewtypeStruct thisMod typeName dataSz ptrSz + [ fmtNewtypeStruct thisMod typeName IR.IsGroup , vcat $ map (fmtFieldAccessor thisMod typeName variantName) fields ] fmtVariantAuxNewtype _ = "" -fmtDataDef thisMod dataName DataDef{dataCerialType=CTyEnum,..} = +fmtDataDef thisMod dataName (DefEnum enumerants) = let typeName = fmtName thisMod dataName + unknownName = subName dataName "unknown'" in vcat - [ hcat [ "data ", typeName, " =" ] - , indent $ vcat - [ vcat $ PP.punctuate " |" $ map fmtEnumVariant dataVariants - , "deriving(Show, Read, Eq, Generic)" - ] - -- Generate an Enum instance. This is a trivial wrapper around the - -- IsWord instance, below. - , hcat [ "instance Enum ", typeName, " where" ] - , indent $ vcat - [ "toEnum = C'.fromWord . fromIntegral" - , "fromEnum = fromIntegral . C'.toWord" - ] - -- Generate an IsWord instance. - , hcat [ "instance C'.IsWord ", typeName, " where" ] - , indent $ vcat - [ "fromWord n = go (fromIntegral n :: Word16) where" - , indent $ vcat $ - map (("go " <>) . fmtEnumFromWordCase) $ sortVariants dataVariants - , vcat $ - map (("toWord " <>) . fmtEnumToWordCase) $ sortVariants dataVariants - ] - , hcat [ "instance B'.ListElem msg ", typeName, " where" ] - , indent $ vcat - [ hcat [ "newtype List msg ", typeName, " = List_", typeName, " (U'.ListOf msg Word16)" ] - , hcat [ "length (List_", typeName, " l) = U'.length l" ] - , hcat [ "index i (List_", typeName, " l) = (C'.fromWord . fromIntegral) <$> U'.index i l" ] - ] - , hcat [ "instance B'.MutListElem s ", typeName, " where" ] - , indent $ vcat - [ hcat [ "setIndex elt i (List_", typeName, " l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l" ] - , hcat [ "newList msg size = List_", typeName, " <$> U'.allocList16 msg size" ] - ] - , hcat [ "instance C'.IsPtr msg (B'.List msg ", typeName, ") where" ] - , indent $ vcat - [ hcat [ "fromPtr msg ptr = List_", typeName, " <$> C'.fromPtr msg ptr" ] - , hcat [ "toPtr (List_", typeName, " l) = C'.toPtr l" ] + [ data_ typeName + (map (fmtName thisMod) enumerants ++ + [fmtName thisMod unknownName <> " Word16"] + ) + ["Show", "Read", "Eq", "Generic"] + -- Generate an Enum instance. This is a trivial wrapper around the + -- IsWord instance, below. + , instance_ [] ("Enum " <> typeName) + [ "toEnum = C'.fromWord . fromIntegral" + , "fromEnum = fromIntegral . C'.toWord" + ] + -- Generate an IsWord instance. + , instance_ [] ("C'.IsWord " <> typeName) + [ "fromWord n = go (fromIntegral n :: Word16) where" + , indent $ vcat $ + zipWith fmtFromWordCase enumerants [0..] + ++ + [ hcat + [ "go tag = " + , fmtName thisMod unknownName + , " (fromIntegral tag)" + ] ] + , vcat $ + zipWith fmtToWordCase enumerants [0..] + ++ + [ hcat [ "toWord (", fmtName thisMod unknownName, " tag) = fromIntegral tag" ] ] ] + , instance_ [] ("B'.ListElem msg " <> typeName) + [ hcat [ "newtype List msg ", typeName, " = List_", typeName, " (U'.ListOf msg Word16)" ] + , hcat [ "length (List_", typeName, " l) = U'.length l" ] + , hcat [ "index i (List_", typeName, " l) = (C'.fromWord . fromIntegral) <$> U'.index i l" ] + ] + , instance_ [] ("B'.MutListElem s " <> typeName) + [ hcat [ "setIndex elt i (List_", typeName, " l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l" ] + , hcat [ "newList msg size = List_", typeName, " <$> U'.allocList16 msg size" ] + ] + , instance_ [] ("C'.IsPtr msg (B'.List msg " <> typeName <> ")") + [ hcat [ "fromPtr msg ptr = List_", typeName, " <$> C'.fromPtr msg ptr" ] + , hcat [ "toPtr (List_", typeName, " l) = C'.toPtr l" ] + ] + ] where - -- | Format a data constructor in the definition of a data type for an enum. - fmtEnumVariant Variant{variantName,variantParams=Unnamed VoidType _,variantTag=Just _} = - fmtName thisMod variantName - fmtEnumVariant Variant{variantName,variantParams=Unnamed ty _, variantTag=Nothing} = - fmtName thisMod variantName <> " " <> fmtType thisMod "msg" ty - fmtEnumVariant variant = - error $ "Unexpected variant for enum: " ++ show variant -- | Format an equation in an enum's IsWord.fromWord implementation. - fmtEnumFromWordCase Variant{variantTag=Just tag,variantName} = - -- For the tags we know about: - fromString (show tag) <> " = " <> fmtName thisMod variantName - fmtEnumFromWordCase Variant{variantTag=Nothing,variantName} = - -- For other tags: - "tag = " <> fmtName thisMod variantName <> " (fromIntegral tag)" + fmtFromWordCase name ordinal = + hcat [ "go ", fromString (show ordinal), " = ", fmtName thisMod name ] -- | Format an equation in an enum's IsWord.toWord implementation. - fmtEnumToWordCase Variant{variantTag=Just tag,variantName} = - fmtName thisMod variantName <> " = " <> fromString (show tag) - fmtEnumToWordCase Variant{variantTag=Nothing,variantName} = - "(" <> fmtName thisMod variantName <> " tag) = fromIntegral tag" -fmtDataDef _ dataName dataDef = - error $ "Unexpected data definition: " ++ show (dataName, dataDef) + fmtToWordCase name ordinal = + hcat [ "toWord ", fmtName thisMod name, " = ", fromString (show ordinal) ] -- | @'fmtType ident msg ty@ formats the type @ty@ from module @ident@, -- using @msg@ as the message parameter, if any. diff --git a/exe/capnpc-haskell/Fmt.hs b/exe/capnpc-haskell/Fmt.hs new file mode 100644 --- /dev/null +++ b/exe/capnpc-haskell/Fmt.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module: Fmt +Description: Helpers for generating haskell code. + +This module defines combinators for generating haskell code, on top of +wl-pprint. + +We will expand this to cover more constructs, make it more type safe, +and so forth as we go. +-} +module Fmt where + +import Text.PrettyPrint.Leijen.Text (Doc, hcat, vcat) + +import qualified Text.PrettyPrint.Leijen.Text as PP + +indent = PP.indent 4 + +-- | @'data_' typeCon dataCons derving_@ generates a @data@ +-- declaration. @typeCon@ is the texst of the type constructor +-- *and type parameters*. @dataCons@ are the data constructors. +-- @deriving_@ is a list of type classes to go in the deriving +-- clause, if any. +data_ :: Doc -> [Doc] -> [Doc] -> Doc +data_ typeCon dataCons deriving_ = vcat + [ hcat [ "data ", typeCon ] + , indent $ vcat + [ case dataCons of + (d:ds) -> vcat $ + ("= " <> d) : map ("| " <>) ds + [] -> + "" + , case deriving_ of + [] -> "" + _ -> "deriving" <> PP.tupled deriving_ + ] + ] + +-- @'instance_' ctx typeCon defs@ defines an instance for @typeCon@ +-- given the context @ctx@. @defs@ is the set of definitions in the +-- instance. +instance_ :: [Doc] -> Doc -> [Doc] -> Doc +instance_ ctx typeCon defs = vcat + [ hcat + [ "instance " + , case ctx of + [] -> "" + [one] -> one <> " => " + _ -> PP.tupled ctx <> " => " + , typeCon + , case defs of + [] -> "" + _ -> " where" + ] + , indent $ vcat defs + ] diff --git a/exe/capnpc-haskell/FrontEnd.hs b/exe/capnpc-haskell/FrontEnd.hs --- a/exe/capnpc-haskell/FrontEnd.hs +++ b/exe/capnpc-haskell/FrontEnd.hs @@ -13,8 +13,10 @@ import Data.List (partition) import Data.Monoid ((<>)) import Data.ReinterpretCast (doubleToWord, floatToWord) +import Data.Text.Encoding (encodeUtf8) import Util (Id, splitOn) +import qualified Data.ByteString as BS import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Vector as V @@ -23,6 +25,7 @@ import Backends.Common (dataFieldSize) +import qualified Data.Capnp.Untyped.Pure as Untyped import qualified IR type NodeMap = M.Map Id NodeMetaData @@ -191,45 +194,31 @@ let allFields = V.toList fields (unionFields, commonFields) = partition isUnionField allFields typeName = name - -- variants to generate that go inside the union: - unionVariants = - map (generateVariant thisModule nodeMap name) unionFields - ++ - -- Every union gets an extra "unknown" varaint, which is used - -- whenever what's on the wire has a discriminant that's not - -- in our schema. - [ IR.Variant - { variantName = IR.subName name "unknown'" - , variantParams = IR.Unnamed - (IR.WordType $ IR.PrimWord IR.PrimInt{isSigned=False, size=16}) - IR.VoidField -- We won't end up actually fetching this from anywhere. - , variantTag = Nothing - } - ] - bodyFields = - ( typeName - , IR.DeclDef IR.DataDef - { dataVariants = - [ IR.Variant - { variantName = typeName - , variantParams = formatStructBody thisModule nodeMap typeName allFields - , variantTag = Nothing - } - ] - , dataTagLoc = Nothing - , dataCerialType = IR.CTyStruct dataWordCount pointerCount - } - ) - bodyUnion = IR.DeclDef IR.DataDef - { dataVariants = unionVariants - , dataTagLoc = Just $ dataLoc + unionName = IR.subName name "" + + structDef = IR.StructDef + { fields = formatStructBody thisModule nodeMap typeName allFields + , info = if isGroup + then IR.IsGroup + else IR.IsStandalone + { dataSz = dataWordCount + , ptrSz = pointerCount + } + } + bodyFields = IR.DeclDef (IR.DefStruct structDef) + + bodyUnion = IR.DeclDef IR.DefUnion + { dataVariants = + map (generateVariant thisModule nodeMap name) unionFields + , dataTagLoc = dataLoc discriminantOffset (IR.PrimWord IR.PrimInt{isSigned = False, size = 16}) -- The default value for a union tag is always zero: (Value'uint16 0) - , dataCerialType = IR.CTyStruct dataWordCount pointerCount + , parentStructName = name + , parentStruct = structDef } - unionName = IR.subName name "" + in case (unionFields, commonFields) of ([], []) -> -- I(zenhack) don't fully understand this case. It seems like @@ -242,33 +231,24 @@ [] ([], _:_) -> -- There's no anonymous union; just declare the fields. - [ bodyFields ] + [ ( typeName, bodyFields ) ] (_:_, []) -> -- The struct is just one big anonymous union; expand the variants -- in-line, rather than making a wrapper. - [ (typeName, bodyUnion) ] + [ ( typeName, bodyUnion ) ] (_:_, _:_) -> -- There are both common fields and an anonymous union. Generate -- an auxiliary type for the union. - [ bodyFields - , (unionName, bodyUnion) + [ ( typeName, bodyFields ) + , ( unionName, bodyUnion ) ] Node'enum{..} -> [ ( name - , IR.DeclDef IR.DataDef - { dataVariants = - map (generateEnum thisModule nodeMap name) (V.toList enumerants) - <> [ IR.Variant - { variantName = IR.subName name "unknown'" - , variantParams = IR.Unnamed - (IR.WordType $ IR.PrimWord IR.PrimInt {isSigned=False, size=16}) - IR.VoidField - , variantTag = Nothing - } - ] - , dataTagLoc = Nothing - , dataCerialType = IR.CTyEnum - } + , IR.DeclDef $ IR.DefEnum $ map + (\Enumerant{name=variantName} -> + IR.subName name variantName + ) + (V.toList enumerants) ) ] Node'const{type_=Type'void,value=Value'void} -> @@ -295,7 +275,79 @@ [(name, primWordConst IR.PrimFloat32 (floatToWord v))] Node'const{type_=Type'float64,value=Value'float64 v} -> [(name, primWordConst IR.PrimFloat64 (doubleToWord v))] - -- TODO: other constants. + Node'const{type_=Type'text,value=Value'text v} -> + [ ( name + , IR.DeclConst IR.PtrConst + { ptrType = IR.PrimPtr IR.PrimText + , ptrValue = Just $ Untyped.PtrList $ Untyped.List8 $ + encodeUtf8 v + & BS.unpack + & (++ [0]) + & V.fromList + } + ) + ] + Node'const{type_=Type'data_,value=Value'data_ v} -> + [ ( name + , IR.DeclConst IR.PtrConst + { ptrType = IR.PrimPtr IR.PrimData + , ptrValue = Just $ Untyped.PtrList $ Untyped.List8 $ + BS.unpack v + & V.fromList + } + ) + ] + Node'const{type_=Type'list{elementType},value=Value'list v} -> + [ ( name + , IR.DeclConst IR.PtrConst + { ptrType = IR.ListOf (formatType thisModule nodeMap elementType) + , ptrValue = v + } + ) + ] + Node'const{type_=Type'enum{typeId},value=Value'enum v} -> + -- TODO: do something with brand. + [ ( name + , IR.DeclConst IR.WordConst + { wordValue = fromIntegral v + , wordType = IR.EnumType $ identifierFromMetaData thisModule (nodeMap M.! typeId) + } + ) + ] + -- TODO: group constants? + Node'const{type_=Type'struct{typeId},value=Value'struct v} -> + [ ( name + , IR.DeclConst IR.PtrConst + { ptrType = IR.PtrComposite $ IR.StructType + (identifierFromMetaData thisModule (nodeMap M.! typeId)) + [] + , ptrValue = v + } + ) + ] + -- TODO: interface constants + Node'const + { type_=Type'anyPointer{union'=Type'anyPointer'unconstrained{union'}} + , value=Value'anyPointer v + } -> + [ ( name + , IR.DeclConst IR.PtrConst + { ptrValue = v + , ptrType = IR.PrimPtr $ IR.PrimAnyPtr $ case union' of + Type'anyPointer'unconstrained'anyKind -> IR.Ptr + Type'anyPointer'unconstrained'struct -> IR.Struct + Type'anyPointer'unconstrained'list -> IR.List + + -- TODO: we'll want to restrict this once we actually + -- support interfaces: + Type'anyPointer'unconstrained'capability -> IR.Ptr + + Type'anyPointer'unconstrained'unknown' _ -> IR.Ptr + } + ) + ] + -- TODO: "constrained" anyPointer constants. This has to wait until + -- we support type parameters. _ -> [] -- TODO primWordConst :: Integral a => IR.PrimWord -> a -> IR.Decl @@ -315,20 +367,12 @@ , dataDef = valueBits defaultVal } -generateEnum :: Id -> NodeMap -> IR.Name -> Enumerant -> IR.Variant -generateEnum thisModule nodeMap parentName Enumerant{..} = - IR.Variant - { variantName = IR.subName parentName name - , variantParams = IR.Unnamed IR.VoidType IR.VoidField - , variantTag = Just codeOrder - } - -- | Return whether the field is part of a union within its struct. isUnionField :: Field -> Bool isUnionField Field{..} = discriminantValue /= field'noDiscriminant -formatStructBody :: Id -> NodeMap -> IR.Name -> [Field] -> IR.VariantParams -formatStructBody thisModule nodeMap parentName fields = IR.Record $ +formatStructBody :: Id -> NodeMap -> IR.Name -> [Field] -> [IR.Field] +formatStructBody thisModule nodeMap parentName fields = let (unionFields, commonFields) = partition isUnionField fields in map (generateField thisModule nodeMap) commonFields <> case unionFields of @@ -367,16 +411,16 @@ , variantParams = IR.Unnamed (formatType thisModule nodeMap type_) (getFieldLoc thisModule nodeMap union') - , variantTag = Just discriminantValue + , variantTag = discriminantValue } Field'group{..} -> let NodeMetaData{node=node@Node{..},..} = nodeMap M.! typeId in case union' of Node'struct{..} -> IR.Variant - { variantName = variantName + { variantName , variantParams = - formatStructBody thisModule nodeMap variantName $ V.toList fields - , variantTag = Just discriminantValue + IR.Record $ formatStructBody thisModule nodeMap variantName $ V.toList fields + , variantTag = discriminantValue } _ -> error "A group field referenced a non-struct node." @@ -387,7 +431,7 @@ IR.Variant { variantName , variantParams = IR.Unnamed IR.VoidType IR.VoidField - , variantTag = Nothing + , variantTag = discriminantValue } where variantName = IR.subName parentName (makeLegalName name) diff --git a/exe/capnpc-haskell/IR.hs b/exe/capnpc-haskell/IR.hs --- a/exe/capnpc-haskell/IR.hs +++ b/exe/capnpc-haskell/IR.hs @@ -39,10 +39,11 @@ , Field(..) , Decl(..) , DataDef(..) - , CerialType(..) + , StructDef(..) , Const(..) , FieldLocType(..) , DataLoc(..) + , StructInfo(..) , subName , prefixName , valueName @@ -62,6 +63,8 @@ import Util +import qualified Data.Capnp.Untyped.Pure as Untyped + newtype Namespace = Namespace [Text] deriving(Show, Read, Eq, Ord) @@ -175,7 +178,7 @@ data Variant = Variant { variantName :: Name , variantParams :: VariantParams - , variantTag :: Maybe Word16 + , variantTag :: !Word16 } deriving(Show, Read, Eq) @@ -196,27 +199,41 @@ , wordType :: WordType } | VoidConst - -- TODO: support pointer types. + | PtrConst + { ptrValue :: Maybe Untyped.PtrType + , ptrType :: PtrType + } deriving(Show, Read, Eq) -data DataDef = DataDef - { dataVariants :: [Variant] - -- | The location of the tag for the union, if any. - , dataTagLoc :: Maybe DataLoc - , dataCerialType :: CerialType +data DataDef + = DefUnion + { dataVariants :: [Variant] + -- | The location of the tag for the union. + , dataTagLoc :: DataLoc + -- | The name of the containing struct. + , parentStructName :: Name + , parentStruct :: StructDef + } + | DefStruct StructDef + | DefEnum [Name] + deriving(Show, Read, Eq) + +data StructDef = StructDef + { fields :: [Field] + , info :: StructInfo } deriving(Show, Read, Eq) --- | What kind of value is this; struct, enum, or...? --- --- Unlike 'Type', this only encodes types of values that we may be asked to --- define, and encodes less detail (no type parameters, name etc). -data CerialType - -- | A struct. Arguments are the size of the data and pointer - -- sections, respectively. - = CTyStruct !Word16 !Word16 - -- | An Enum. Stored in the data section of a struct as a 16-bit value. - | CTyEnum +data StructInfo + = IsGroup + -- ^ The struct is really a group. + | IsStandalone + { dataSz :: !Word16 + , ptrSz :: !Word16 + } + -- ^ The struct is a full-fledged struct that can be directly + -- allocated, stored in a list, etc. Info contains the sizes + -- of its sections. deriving(Show, Read, Eq) -- | The type and location of a field. diff --git a/exe/capnpc-haskell/Main.hs b/exe/capnpc-haskell/Main.hs --- a/exe/capnpc-haskell/Main.hs +++ b/exe/capnpc-haskell/Main.hs @@ -9,7 +9,7 @@ import qualified Text.PrettyPrint.Leijen.Text as PP import Capnp.Capnp.Schema.Pure (CodeGeneratorRequest) -import Data.Capnp.Pure (defaultLimit, getValue) +import Data.Capnp (defaultLimit, getValue) import qualified Backends.Pure import qualified Backends.Raw diff --git a/lib/Capnp/ById.hs b/lib/Capnp/ById.hs deleted file mode 100644 --- a/lib/Capnp/ById.hs +++ /dev/null @@ -1,16 +0,0 @@ -{- | -Module: Capnp.ById -Description: Machine-addressable aliases for modules generated by the schema compiler. - -In addition to modules with human readable names, the schema compiler also generates -modules of the form @Capnp.ById.X\@. These are used internally by generated -code, so that generated modules with dependencies on other schema don't have to know -what the human-readable names of those schema are -- they import by id. - -Each module in this heirarchy just re-exports everthing from the module with -a human-readable name. - -This hierarchy is an implementation detail that most users don't need to know -about. --} -module Capnp.ById () where diff --git a/lib/Capnp/ById/X8ef99297a43a5e34.hs b/lib/Capnp/ById/X8ef99297a43a5e34.hs --- a/lib/Capnp/ById/X8ef99297a43a5e34.hs +++ b/lib/Capnp/ById/X8ef99297a43a5e34.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.X8ef99297a43a5e34 Description: machine-addressable alias for 'Capnp.Capnp.Json'. diff --git a/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs b/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs --- a/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs +++ b/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.X8ef99297a43a5e34.Pure Description: Machine-addressable alias for 'Capnp.Capnp.Json.Pure'. diff --git a/lib/Capnp/ById/Xa184c7885cdaf2a1.hs b/lib/Capnp/ById/Xa184c7885cdaf2a1.hs --- a/lib/Capnp/ById/Xa184c7885cdaf2a1.hs +++ b/lib/Capnp/ById/Xa184c7885cdaf2a1.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xa184c7885cdaf2a1 Description: machine-addressable alias for 'Capnp.Capnp.RpcTwoparty'. diff --git a/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs b/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs --- a/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs +++ b/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xa184c7885cdaf2a1.Pure Description: Machine-addressable alias for 'Capnp.Capnp.RpcTwoparty.Pure'. diff --git a/lib/Capnp/ById/Xa93fc509624c72d9.hs b/lib/Capnp/ById/Xa93fc509624c72d9.hs --- a/lib/Capnp/ById/Xa93fc509624c72d9.hs +++ b/lib/Capnp/ById/Xa93fc509624c72d9.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xa93fc509624c72d9 Description: machine-addressable alias for 'Capnp.Capnp.Schema'. diff --git a/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs b/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs --- a/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs +++ b/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xa93fc509624c72d9.Pure Description: Machine-addressable alias for 'Capnp.Capnp.Schema.Pure'. diff --git a/lib/Capnp/ById/Xb312981b2552a250.hs b/lib/Capnp/ById/Xb312981b2552a250.hs --- a/lib/Capnp/ById/Xb312981b2552a250.hs +++ b/lib/Capnp/ById/Xb312981b2552a250.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xb312981b2552a250 Description: machine-addressable alias for 'Capnp.Capnp.Rpc'. diff --git a/lib/Capnp/ById/Xb312981b2552a250/Pure.hs b/lib/Capnp/ById/Xb312981b2552a250/Pure.hs --- a/lib/Capnp/ById/Xb312981b2552a250/Pure.hs +++ b/lib/Capnp/ById/Xb312981b2552a250/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xb312981b2552a250.Pure Description: Machine-addressable alias for 'Capnp.Capnp.Rpc.Pure'. diff --git a/lib/Capnp/ById/Xb8630836983feed7.hs b/lib/Capnp/ById/Xb8630836983feed7.hs --- a/lib/Capnp/ById/Xb8630836983feed7.hs +++ b/lib/Capnp/ById/Xb8630836983feed7.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xb8630836983feed7 Description: machine-addressable alias for 'Capnp.Capnp.Persistent'. diff --git a/lib/Capnp/ById/Xb8630836983feed7/Pure.hs b/lib/Capnp/ById/Xb8630836983feed7/Pure.hs --- a/lib/Capnp/ById/Xb8630836983feed7/Pure.hs +++ b/lib/Capnp/ById/Xb8630836983feed7/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xb8630836983feed7.Pure Description: Machine-addressable alias for 'Capnp.Capnp.Persistent.Pure'. diff --git a/lib/Capnp/ById/Xbdf87d7bb8304e81.hs b/lib/Capnp/ById/Xbdf87d7bb8304e81.hs --- a/lib/Capnp/ById/Xbdf87d7bb8304e81.hs +++ b/lib/Capnp/ById/Xbdf87d7bb8304e81.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xbdf87d7bb8304e81 Description: machine-addressable alias for 'Capnp.Capnp.Cxx'. diff --git a/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs b/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs --- a/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs +++ b/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Capnp.ById.Xbdf87d7bb8304e81.Pure Description: Machine-addressable alias for 'Capnp.Capnp.Cxx.Pure'. diff --git a/lib/Capnp/Capnp/Cxx.hs b/lib/Capnp/Capnp/Cxx.hs --- a/lib/Capnp/Capnp/Cxx.hs +++ b/lib/Capnp/Capnp/Cxx.hs @@ -19,6 +19,7 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe +import qualified Data.ByteString import qualified Data.Capnp.Classes as C' import qualified Data.Capnp.Basics as B' import qualified Data.Capnp.GenHelpers as H' diff --git a/lib/Capnp/Capnp/Json.hs b/lib/Capnp/Capnp/Json.hs --- a/lib/Capnp/Capnp/Json.hs +++ b/lib/Capnp/Capnp/Json.hs @@ -19,6 +19,7 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe +import qualified Data.ByteString import qualified Data.Capnp.Classes as C' import qualified Data.Capnp.Basics as B' import qualified Data.Capnp.GenHelpers as H' @@ -31,38 +32,37 @@ fromStruct = pure . JsonValue_newtype_ instance C'.ToStruct msg (JsonValue msg) where toStruct (JsonValue_newtype_ struct) = struct -instance C'.IsPtr msg (JsonValue msg) where - fromPtr msg ptr = JsonValue_newtype_ <$> C'.fromPtr msg ptr - toPtr (JsonValue_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (JsonValue msg) where + type InMessage (JsonValue msg) = msg + message (JsonValue_newtype_ struct) = U'.message struct +instance U'.MessageDefault (JsonValue msg) where + messageDefault = JsonValue_newtype_ . U'.messageDefault instance B'.ListElem msg (JsonValue msg) where newtype List msg (JsonValue msg) = List_JsonValue (U'.ListOf msg (U'.Struct msg)) length (List_JsonValue l) = U'.length l index i (List_JsonValue l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (JsonValue msg) where + fromPtr msg ptr = JsonValue_newtype_ <$> C'.fromPtr msg ptr + toPtr (JsonValue_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (JsonValue (M'.MutMsg s)) where setIndex (JsonValue_newtype_ elt) i (List_JsonValue l) = U'.setIndex elt i l newList msg len = List_JsonValue <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (JsonValue msg) msg where - message (JsonValue_newtype_ struct) = U'.message struct -instance U'.MessageDefault (JsonValue msg) msg where - messageDefault = JsonValue_newtype_ . U'.messageDefault instance C'.Allocate s (JsonValue (M'.MutMsg s)) where new msg = JsonValue_newtype_ <$> U'.allocStruct msg 2 1 instance C'.IsPtr msg (B'.List msg (JsonValue msg)) where fromPtr msg ptr = List_JsonValue <$> C'.fromPtr msg ptr toPtr (List_JsonValue l) = C'.toPtr l -data JsonValue' msg = - JsonValue'null | - JsonValue'boolean Bool | - JsonValue'number Double | - JsonValue'string (B'.Text msg) | - JsonValue'array (B'.List msg (JsonValue msg)) | - JsonValue'object (B'.List msg (JsonValue'Field msg)) | - JsonValue'call (JsonValue'Call msg) | - JsonValue'unknown' Word16 +data JsonValue' msg + = JsonValue'null + | JsonValue'boolean Bool + | JsonValue'number Double + | JsonValue'string (B'.Text msg) + | JsonValue'array (B'.List msg (JsonValue msg)) + | JsonValue'object (B'.List msg (JsonValue'Field msg)) + | JsonValue'call (JsonValue'Call msg) + | JsonValue'unknown' Word16 get_JsonValue' :: U'.ReadCtx m msg => JsonValue msg -> m (JsonValue' msg) get_JsonValue' (JsonValue_newtype_ struct) = C'.fromStruct struct -has_JsonValue' :: U'.ReadCtx m msg => JsonValue msg -> m Bool -has_JsonValue'(JsonValue_newtype_ struct) = pure True set_JsonValue'null :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> m () set_JsonValue'null (JsonValue_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 set_JsonValue'boolean :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> Bool -> m () @@ -128,20 +128,21 @@ fromStruct = pure . JsonValue'Call_newtype_ instance C'.ToStruct msg (JsonValue'Call msg) where toStruct (JsonValue'Call_newtype_ struct) = struct -instance C'.IsPtr msg (JsonValue'Call msg) where - fromPtr msg ptr = JsonValue'Call_newtype_ <$> C'.fromPtr msg ptr - toPtr (JsonValue'Call_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (JsonValue'Call msg) where + type InMessage (JsonValue'Call msg) = msg + message (JsonValue'Call_newtype_ struct) = U'.message struct +instance U'.MessageDefault (JsonValue'Call msg) where + messageDefault = JsonValue'Call_newtype_ . U'.messageDefault instance B'.ListElem msg (JsonValue'Call msg) where newtype List msg (JsonValue'Call msg) = List_JsonValue'Call (U'.ListOf msg (U'.Struct msg)) length (List_JsonValue'Call l) = U'.length l index i (List_JsonValue'Call l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue'Call msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (JsonValue'Call msg) where + fromPtr msg ptr = JsonValue'Call_newtype_ <$> C'.fromPtr msg ptr + toPtr (JsonValue'Call_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (JsonValue'Call (M'.MutMsg s)) where setIndex (JsonValue'Call_newtype_ elt) i (List_JsonValue'Call l) = U'.setIndex elt i l newList msg len = List_JsonValue'Call <$> U'.allocCompositeList msg 0 2 len -instance U'.HasMessage (JsonValue'Call msg) msg where - message (JsonValue'Call_newtype_ struct) = U'.message struct -instance U'.MessageDefault (JsonValue'Call msg) msg where - messageDefault = JsonValue'Call_newtype_ . U'.messageDefault instance C'.Allocate s (JsonValue'Call (M'.MutMsg s)) where new msg = JsonValue'Call_newtype_ <$> U'.allocStruct msg 0 2 instance C'.IsPtr msg (B'.List msg (JsonValue'Call msg)) where @@ -178,20 +179,21 @@ fromStruct = pure . JsonValue'Field_newtype_ instance C'.ToStruct msg (JsonValue'Field msg) where toStruct (JsonValue'Field_newtype_ struct) = struct -instance C'.IsPtr msg (JsonValue'Field msg) where - fromPtr msg ptr = JsonValue'Field_newtype_ <$> C'.fromPtr msg ptr - toPtr (JsonValue'Field_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (JsonValue'Field msg) where + type InMessage (JsonValue'Field msg) = msg + message (JsonValue'Field_newtype_ struct) = U'.message struct +instance U'.MessageDefault (JsonValue'Field msg) where + messageDefault = JsonValue'Field_newtype_ . U'.messageDefault instance B'.ListElem msg (JsonValue'Field msg) where newtype List msg (JsonValue'Field msg) = List_JsonValue'Field (U'.ListOf msg (U'.Struct msg)) length (List_JsonValue'Field l) = U'.length l index i (List_JsonValue'Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue'Field msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (JsonValue'Field msg) where + fromPtr msg ptr = JsonValue'Field_newtype_ <$> C'.fromPtr msg ptr + toPtr (JsonValue'Field_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (JsonValue'Field (M'.MutMsg s)) where setIndex (JsonValue'Field_newtype_ elt) i (List_JsonValue'Field l) = U'.setIndex elt i l newList msg len = List_JsonValue'Field <$> U'.allocCompositeList msg 0 2 len -instance U'.HasMessage (JsonValue'Field msg) msg where - message (JsonValue'Field_newtype_ struct) = U'.message struct -instance U'.MessageDefault (JsonValue'Field msg) msg where - messageDefault = JsonValue'Field_newtype_ . U'.messageDefault instance C'.Allocate s (JsonValue'Field (M'.MutMsg s)) where new msg = JsonValue'Field_newtype_ <$> U'.allocStruct msg 0 2 instance C'.IsPtr msg (B'.List msg (JsonValue'Field msg)) where diff --git a/lib/Capnp/Capnp/Json/Pure.hs b/lib/Capnp/Capnp/Json/Pure.hs --- a/lib/Capnp/Capnp/Json/Pure.hs +++ b/lib/Capnp/Capnp/Json/Pure.hs @@ -36,15 +36,15 @@ import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure import qualified Capnp.ById.Xbdf87d7bb8304e81 data JsonValue - = JsonValue'null | - JsonValue'boolean (Bool) | - JsonValue'number (Double) | - JsonValue'string (Text) | - JsonValue'array (PU'.ListOf (JsonValue)) | - JsonValue'object (PU'.ListOf (JsonValue'Field)) | - JsonValue'call (JsonValue'Call) | - JsonValue'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = JsonValue'null + | JsonValue'boolean (Bool) + | JsonValue'number (Double) + | JsonValue'string (Text) + | JsonValue'array (PU'.ListOf (JsonValue)) + | JsonValue'object (PU'.ListOf (JsonValue'Field)) + | JsonValue'call (JsonValue'Call) + | JsonValue'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize JsonValue where type Cerial msg JsonValue = Capnp.ById.X8ef99297a43a5e34.JsonValue msg decerialize raw = do @@ -57,11 +57,7 @@ Capnp.ById.X8ef99297a43a5e34.JsonValue'array val -> JsonValue'array <$> C'.decerialize val Capnp.ById.X8ef99297a43a5e34.JsonValue'object val -> JsonValue'object <$> C'.decerialize val Capnp.ById.X8ef99297a43a5e34.JsonValue'call val -> JsonValue'call <$> C'.decerialize val - Capnp.ById.X8ef99297a43a5e34.JsonValue'unknown' val -> pure (JsonValue'unknown' val) -instance C'.FromStruct M'.ConstMsg JsonValue where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue M'.ConstMsg) + Capnp.ById.X8ef99297a43a5e34.JsonValue'unknown' val -> pure $ JsonValue'unknown' val instance C'.Marshal JsonValue where marshalInto raw value = do case value of @@ -88,23 +84,23 @@ C'.marshalInto field_ arg_ JsonValue'unknown' arg_ -> Capnp.ById.X8ef99297a43a5e34.set_JsonValue'unknown' raw arg_ instance C'.Cerialize s JsonValue +instance C'.FromStruct M'.ConstMsg JsonValue where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue M'.ConstMsg) instance Default JsonValue where def = PH'.defaultStruct data JsonValue'Call - = JsonValue'Call + = JsonValue'Call {function :: Text, params :: PU'.ListOf (JsonValue)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize JsonValue'Call where type Cerial msg JsonValue'Call = Capnp.ById.X8ef99297a43a5e34.JsonValue'Call msg decerialize raw = do JsonValue'Call <$> (Capnp.ById.X8ef99297a43a5e34.get_JsonValue'Call'function raw >>= C'.decerialize) <*> (Capnp.ById.X8ef99297a43a5e34.get_JsonValue'Call'params raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg JsonValue'Call where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Call M'.ConstMsg) instance C'.Marshal JsonValue'Call where marshalInto raw value = do case value of @@ -117,23 +113,23 @@ elt <- C'.index i field_ C'.marshalInto elt (params V.! i) instance C'.Cerialize s JsonValue'Call +instance C'.FromStruct M'.ConstMsg JsonValue'Call where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Call M'.ConstMsg) instance Default JsonValue'Call where def = PH'.defaultStruct data JsonValue'Field - = JsonValue'Field + = JsonValue'Field {name :: Text, value :: JsonValue} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize JsonValue'Field where type Cerial msg JsonValue'Field = Capnp.ById.X8ef99297a43a5e34.JsonValue'Field msg decerialize raw = do JsonValue'Field <$> (Capnp.ById.X8ef99297a43a5e34.get_JsonValue'Field'name raw >>= C'.decerialize) <*> (Capnp.ById.X8ef99297a43a5e34.get_JsonValue'Field'value raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg JsonValue'Field where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Field M'.ConstMsg) instance C'.Marshal JsonValue'Field where marshalInto raw value = do case value of @@ -143,5 +139,9 @@ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'Field'value raw C'.marshalInto field_ value instance C'.Cerialize s JsonValue'Field +instance C'.FromStruct M'.ConstMsg JsonValue'Field where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Field M'.ConstMsg) instance Default JsonValue'Field where def = PH'.defaultStruct diff --git a/lib/Capnp/Capnp/Persistent.hs b/lib/Capnp/Capnp/Persistent.hs --- a/lib/Capnp/Capnp/Persistent.hs +++ b/lib/Capnp/Capnp/Persistent.hs @@ -19,6 +19,7 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe +import qualified Data.ByteString import qualified Data.Capnp.Classes as C' import qualified Data.Capnp.Basics as B' import qualified Data.Capnp.GenHelpers as H' @@ -31,20 +32,21 @@ fromStruct = pure . Persistent'SaveParams_newtype_ instance C'.ToStruct msg (Persistent'SaveParams msg) where toStruct (Persistent'SaveParams_newtype_ struct) = struct -instance C'.IsPtr msg (Persistent'SaveParams msg) where - fromPtr msg ptr = Persistent'SaveParams_newtype_ <$> C'.fromPtr msg ptr - toPtr (Persistent'SaveParams_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Persistent'SaveParams msg) where + type InMessage (Persistent'SaveParams msg) = msg + message (Persistent'SaveParams_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Persistent'SaveParams msg) where + messageDefault = Persistent'SaveParams_newtype_ . U'.messageDefault instance B'.ListElem msg (Persistent'SaveParams msg) where newtype List msg (Persistent'SaveParams msg) = List_Persistent'SaveParams (U'.ListOf msg (U'.Struct msg)) length (List_Persistent'SaveParams l) = U'.length l index i (List_Persistent'SaveParams l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Persistent'SaveParams msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Persistent'SaveParams msg) where + fromPtr msg ptr = Persistent'SaveParams_newtype_ <$> C'.fromPtr msg ptr + toPtr (Persistent'SaveParams_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Persistent'SaveParams (M'.MutMsg s)) where setIndex (Persistent'SaveParams_newtype_ elt) i (List_Persistent'SaveParams l) = U'.setIndex elt i l newList msg len = List_Persistent'SaveParams <$> U'.allocCompositeList msg 0 1 len -instance U'.HasMessage (Persistent'SaveParams msg) msg where - message (Persistent'SaveParams_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Persistent'SaveParams msg) msg where - messageDefault = Persistent'SaveParams_newtype_ . U'.messageDefault instance C'.Allocate s (Persistent'SaveParams (M'.MutMsg s)) where new msg = Persistent'SaveParams_newtype_ <$> U'.allocStruct msg 0 1 instance C'.IsPtr msg (B'.List msg (Persistent'SaveParams msg)) where @@ -63,20 +65,21 @@ fromStruct = pure . Persistent'SaveResults_newtype_ instance C'.ToStruct msg (Persistent'SaveResults msg) where toStruct (Persistent'SaveResults_newtype_ struct) = struct -instance C'.IsPtr msg (Persistent'SaveResults msg) where - fromPtr msg ptr = Persistent'SaveResults_newtype_ <$> C'.fromPtr msg ptr - toPtr (Persistent'SaveResults_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Persistent'SaveResults msg) where + type InMessage (Persistent'SaveResults msg) = msg + message (Persistent'SaveResults_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Persistent'SaveResults msg) where + messageDefault = Persistent'SaveResults_newtype_ . U'.messageDefault instance B'.ListElem msg (Persistent'SaveResults msg) where newtype List msg (Persistent'SaveResults msg) = List_Persistent'SaveResults (U'.ListOf msg (U'.Struct msg)) length (List_Persistent'SaveResults l) = U'.length l index i (List_Persistent'SaveResults l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Persistent'SaveResults msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Persistent'SaveResults msg) where + fromPtr msg ptr = Persistent'SaveResults_newtype_ <$> C'.fromPtr msg ptr + toPtr (Persistent'SaveResults_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Persistent'SaveResults (M'.MutMsg s)) where setIndex (Persistent'SaveResults_newtype_ elt) i (List_Persistent'SaveResults l) = U'.setIndex elt i l newList msg len = List_Persistent'SaveResults <$> U'.allocCompositeList msg 0 1 len -instance U'.HasMessage (Persistent'SaveResults msg) msg where - message (Persistent'SaveResults_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Persistent'SaveResults msg) msg where - messageDefault = Persistent'SaveResults_newtype_ . U'.messageDefault instance C'.Allocate s (Persistent'SaveResults (M'.MutMsg s)) where new msg = Persistent'SaveResults_newtype_ <$> U'.allocStruct msg 0 1 instance C'.IsPtr msg (B'.List msg (Persistent'SaveResults msg)) where diff --git a/lib/Capnp/Capnp/Persistent/Pure.hs b/lib/Capnp/Capnp/Persistent/Pure.hs --- a/lib/Capnp/Capnp/Persistent/Pure.hs +++ b/lib/Capnp/Capnp/Persistent/Pure.hs @@ -36,18 +36,14 @@ import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure import qualified Capnp.ById.Xbdf87d7bb8304e81 data Persistent'SaveParams - = Persistent'SaveParams + = Persistent'SaveParams {sealFor :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Persistent'SaveParams where type Cerial msg Persistent'SaveParams = Capnp.ById.Xb8630836983feed7.Persistent'SaveParams msg decerialize raw = do Persistent'SaveParams <$> (Capnp.ById.Xb8630836983feed7.get_Persistent'SaveParams'sealFor raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Persistent'SaveParams where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveParams M'.ConstMsg) instance C'.Marshal Persistent'SaveParams where marshalInto raw value = do case value of @@ -55,21 +51,21 @@ field_ <- C'.cerialize (U'.message raw) sealFor Capnp.ById.Xb8630836983feed7.set_Persistent'SaveParams'sealFor raw field_ instance C'.Cerialize s Persistent'SaveParams +instance C'.FromStruct M'.ConstMsg Persistent'SaveParams where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveParams M'.ConstMsg) instance Default Persistent'SaveParams where def = PH'.defaultStruct data Persistent'SaveResults - = Persistent'SaveResults + = Persistent'SaveResults {sturdyRef :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Persistent'SaveResults where type Cerial msg Persistent'SaveResults = Capnp.ById.Xb8630836983feed7.Persistent'SaveResults msg decerialize raw = do Persistent'SaveResults <$> (Capnp.ById.Xb8630836983feed7.get_Persistent'SaveResults'sturdyRef raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Persistent'SaveResults where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveResults M'.ConstMsg) instance C'.Marshal Persistent'SaveResults where marshalInto raw value = do case value of @@ -77,5 +73,9 @@ field_ <- C'.cerialize (U'.message raw) sturdyRef Capnp.ById.Xb8630836983feed7.set_Persistent'SaveResults'sturdyRef raw field_ instance C'.Cerialize s Persistent'SaveResults +instance C'.FromStruct M'.ConstMsg Persistent'SaveResults where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveResults M'.ConstMsg) instance Default Persistent'SaveResults where def = PH'.defaultStruct diff --git a/lib/Capnp/Capnp/Rpc.hs b/lib/Capnp/Capnp/Rpc.hs --- a/lib/Capnp/Capnp/Rpc.hs +++ b/lib/Capnp/Capnp/Rpc.hs @@ -19,6 +19,7 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe +import qualified Data.ByteString import qualified Data.Capnp.Classes as C' import qualified Data.Capnp.Basics as B' import qualified Data.Capnp.GenHelpers as H' @@ -31,20 +32,21 @@ fromStruct = pure . Accept_newtype_ instance C'.ToStruct msg (Accept msg) where toStruct (Accept_newtype_ struct) = struct -instance C'.IsPtr msg (Accept msg) where - fromPtr msg ptr = Accept_newtype_ <$> C'.fromPtr msg ptr - toPtr (Accept_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Accept msg) where + type InMessage (Accept msg) = msg + message (Accept_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Accept msg) where + messageDefault = Accept_newtype_ . U'.messageDefault instance B'.ListElem msg (Accept msg) where newtype List msg (Accept msg) = List_Accept (U'.ListOf msg (U'.Struct msg)) length (List_Accept l) = U'.length l index i (List_Accept l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Accept msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Accept msg) where + fromPtr msg ptr = Accept_newtype_ <$> C'.fromPtr msg ptr + toPtr (Accept_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Accept (M'.MutMsg s)) where setIndex (Accept_newtype_ elt) i (List_Accept l) = U'.setIndex elt i l newList msg len = List_Accept <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Accept msg) msg where - message (Accept_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Accept msg) msg where - messageDefault = Accept_newtype_ . U'.messageDefault instance C'.Allocate s (Accept (M'.MutMsg s)) where new msg = Accept_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Accept msg)) where @@ -52,8 +54,6 @@ toPtr (List_Accept l) = C'.toPtr l get_Accept'questionId :: U'.ReadCtx m msg => Accept msg -> m Word32 get_Accept'questionId (Accept_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Accept'questionId :: U'.ReadCtx m msg => Accept msg -> m Bool -has_Accept'questionId(Accept_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Accept'questionId :: U'.RWCtx m s => Accept (M'.MutMsg s) -> Word32 -> m () set_Accept'questionId (Accept_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Accept'provision :: U'.ReadCtx m msg => Accept msg -> m (Maybe (U'.Ptr msg)) @@ -66,8 +66,6 @@ set_Accept'provision (Accept_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct get_Accept'embargo :: U'.ReadCtx m msg => Accept msg -> m Bool get_Accept'embargo (Accept_newtype_ struct) = H'.getWordField struct 0 32 0 -has_Accept'embargo :: U'.ReadCtx m msg => Accept msg -> m Bool -has_Accept'embargo(Accept_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Accept'embargo :: U'.RWCtx m s => Accept (M'.MutMsg s) -> Bool -> m () set_Accept'embargo (Accept_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 32 0 newtype Bootstrap msg = Bootstrap_newtype_ (U'.Struct msg) @@ -75,20 +73,21 @@ fromStruct = pure . Bootstrap_newtype_ instance C'.ToStruct msg (Bootstrap msg) where toStruct (Bootstrap_newtype_ struct) = struct -instance C'.IsPtr msg (Bootstrap msg) where - fromPtr msg ptr = Bootstrap_newtype_ <$> C'.fromPtr msg ptr - toPtr (Bootstrap_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Bootstrap msg) where + type InMessage (Bootstrap msg) = msg + message (Bootstrap_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Bootstrap msg) where + messageDefault = Bootstrap_newtype_ . U'.messageDefault instance B'.ListElem msg (Bootstrap msg) where newtype List msg (Bootstrap msg) = List_Bootstrap (U'.ListOf msg (U'.Struct msg)) length (List_Bootstrap l) = U'.length l index i (List_Bootstrap l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Bootstrap msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Bootstrap msg) where + fromPtr msg ptr = Bootstrap_newtype_ <$> C'.fromPtr msg ptr + toPtr (Bootstrap_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Bootstrap (M'.MutMsg s)) where setIndex (Bootstrap_newtype_ elt) i (List_Bootstrap l) = U'.setIndex elt i l newList msg len = List_Bootstrap <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Bootstrap msg) msg where - message (Bootstrap_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Bootstrap msg) msg where - messageDefault = Bootstrap_newtype_ . U'.messageDefault instance C'.Allocate s (Bootstrap (M'.MutMsg s)) where new msg = Bootstrap_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Bootstrap msg)) where @@ -96,8 +95,6 @@ toPtr (List_Bootstrap l) = C'.toPtr l get_Bootstrap'questionId :: U'.ReadCtx m msg => Bootstrap msg -> m Word32 get_Bootstrap'questionId (Bootstrap_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Bootstrap'questionId :: U'.ReadCtx m msg => Bootstrap msg -> m Bool -has_Bootstrap'questionId(Bootstrap_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Bootstrap'questionId :: U'.RWCtx m s => Bootstrap (M'.MutMsg s) -> Word32 -> m () set_Bootstrap'questionId (Bootstrap_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Bootstrap'deprecatedObjectId :: U'.ReadCtx m msg => Bootstrap msg -> m (Maybe (U'.Ptr msg)) @@ -113,20 +110,21 @@ fromStruct = pure . Call_newtype_ instance C'.ToStruct msg (Call msg) where toStruct (Call_newtype_ struct) = struct -instance C'.IsPtr msg (Call msg) where - fromPtr msg ptr = Call_newtype_ <$> C'.fromPtr msg ptr - toPtr (Call_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Call msg) where + type InMessage (Call msg) = msg + message (Call_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Call msg) where + messageDefault = Call_newtype_ . U'.messageDefault instance B'.ListElem msg (Call msg) where newtype List msg (Call msg) = List_Call (U'.ListOf msg (U'.Struct msg)) length (List_Call l) = U'.length l index i (List_Call l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Call msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Call msg) where + fromPtr msg ptr = Call_newtype_ <$> C'.fromPtr msg ptr + toPtr (Call_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Call (M'.MutMsg s)) where setIndex (Call_newtype_ elt) i (List_Call l) = U'.setIndex elt i l newList msg len = List_Call <$> U'.allocCompositeList msg 3 3 len -instance U'.HasMessage (Call msg) msg where - message (Call_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Call msg) msg where - messageDefault = Call_newtype_ . U'.messageDefault instance C'.Allocate s (Call (M'.MutMsg s)) where new msg = Call_newtype_ <$> U'.allocStruct msg 3 3 instance C'.IsPtr msg (B'.List msg (Call msg)) where @@ -134,8 +132,6 @@ toPtr (List_Call l) = C'.toPtr l get_Call'questionId :: U'.ReadCtx m msg => Call msg -> m Word32 get_Call'questionId (Call_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Call'questionId :: U'.ReadCtx m msg => Call msg -> m Bool -has_Call'questionId(Call_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Call'questionId :: U'.RWCtx m s => Call (M'.MutMsg s) -> Word32 -> m () set_Call'questionId (Call_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Call'target :: U'.ReadCtx m msg => Call msg -> m (MessageTarget msg) @@ -153,14 +149,10 @@ pure result get_Call'interfaceId :: U'.ReadCtx m msg => Call msg -> m Word64 get_Call'interfaceId (Call_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Call'interfaceId :: U'.ReadCtx m msg => Call msg -> m Bool -has_Call'interfaceId(Call_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) set_Call'interfaceId :: U'.RWCtx m s => Call (M'.MutMsg s) -> Word64 -> m () set_Call'interfaceId (Call_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 get_Call'methodId :: U'.ReadCtx m msg => Call msg -> m Word16 get_Call'methodId (Call_newtype_ struct) = H'.getWordField struct 0 32 0 -has_Call'methodId :: U'.ReadCtx m msg => Call msg -> m Bool -has_Call'methodId(Call_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Call'methodId :: U'.RWCtx m s => Call (M'.MutMsg s) -> Word16 -> m () set_Call'methodId (Call_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 32 0 get_Call'params :: U'.ReadCtx m msg => Call msg -> m (Payload msg) @@ -178,12 +170,8 @@ pure result get_Call'sendResultsTo :: U'.ReadCtx m msg => Call msg -> m (Call'sendResultsTo msg) get_Call'sendResultsTo (Call_newtype_ struct) = C'.fromStruct struct -has_Call'sendResultsTo :: U'.ReadCtx m msg => Call msg -> m Bool -has_Call'sendResultsTo(Call_newtype_ struct) = pure True get_Call'allowThirdPartyTailCall :: U'.ReadCtx m msg => Call msg -> m Bool get_Call'allowThirdPartyTailCall (Call_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Call'allowThirdPartyTailCall :: U'.ReadCtx m msg => Call msg -> m Bool -has_Call'allowThirdPartyTailCall(Call_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) set_Call'allowThirdPartyTailCall :: U'.RWCtx m s => Call (M'.MutMsg s) -> Bool -> m () set_Call'allowThirdPartyTailCall (Call_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 2 0 0 newtype CapDescriptor msg = CapDescriptor_newtype_ (U'.Struct msg) @@ -191,37 +179,36 @@ fromStruct = pure . CapDescriptor_newtype_ instance C'.ToStruct msg (CapDescriptor msg) where toStruct (CapDescriptor_newtype_ struct) = struct -instance C'.IsPtr msg (CapDescriptor msg) where - fromPtr msg ptr = CapDescriptor_newtype_ <$> C'.fromPtr msg ptr - toPtr (CapDescriptor_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (CapDescriptor msg) where + type InMessage (CapDescriptor msg) = msg + message (CapDescriptor_newtype_ struct) = U'.message struct +instance U'.MessageDefault (CapDescriptor msg) where + messageDefault = CapDescriptor_newtype_ . U'.messageDefault instance B'.ListElem msg (CapDescriptor msg) where newtype List msg (CapDescriptor msg) = List_CapDescriptor (U'.ListOf msg (U'.Struct msg)) length (List_CapDescriptor l) = U'.length l index i (List_CapDescriptor l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapDescriptor msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (CapDescriptor msg) where + fromPtr msg ptr = CapDescriptor_newtype_ <$> C'.fromPtr msg ptr + toPtr (CapDescriptor_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (CapDescriptor (M'.MutMsg s)) where setIndex (CapDescriptor_newtype_ elt) i (List_CapDescriptor l) = U'.setIndex elt i l newList msg len = List_CapDescriptor <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (CapDescriptor msg) msg where - message (CapDescriptor_newtype_ struct) = U'.message struct -instance U'.MessageDefault (CapDescriptor msg) msg where - messageDefault = CapDescriptor_newtype_ . U'.messageDefault instance C'.Allocate s (CapDescriptor (M'.MutMsg s)) where new msg = CapDescriptor_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (CapDescriptor msg)) where fromPtr msg ptr = List_CapDescriptor <$> C'.fromPtr msg ptr toPtr (List_CapDescriptor l) = C'.toPtr l -data CapDescriptor' msg = - CapDescriptor'none | - CapDescriptor'senderHosted Word32 | - CapDescriptor'senderPromise Word32 | - CapDescriptor'receiverHosted Word32 | - CapDescriptor'receiverAnswer (PromisedAnswer msg) | - CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor msg) | - CapDescriptor'unknown' Word16 +data CapDescriptor' msg + = CapDescriptor'none + | CapDescriptor'senderHosted Word32 + | CapDescriptor'senderPromise Word32 + | CapDescriptor'receiverHosted Word32 + | CapDescriptor'receiverAnswer (PromisedAnswer msg) + | CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor msg) + | CapDescriptor'unknown' Word16 get_CapDescriptor' :: U'.ReadCtx m msg => CapDescriptor msg -> m (CapDescriptor' msg) get_CapDescriptor' (CapDescriptor_newtype_ struct) = C'.fromStruct struct -has_CapDescriptor' :: U'.ReadCtx m msg => CapDescriptor msg -> m Bool -has_CapDescriptor'(CapDescriptor_newtype_ struct) = pure True set_CapDescriptor'none :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> m () set_CapDescriptor'none (CapDescriptor_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 set_CapDescriptor'senderHosted :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> Word32 -> m () @@ -272,20 +259,21 @@ fromStruct = pure . Disembargo_newtype_ instance C'.ToStruct msg (Disembargo msg) where toStruct (Disembargo_newtype_ struct) = struct -instance C'.IsPtr msg (Disembargo msg) where - fromPtr msg ptr = Disembargo_newtype_ <$> C'.fromPtr msg ptr - toPtr (Disembargo_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Disembargo msg) where + type InMessage (Disembargo msg) = msg + message (Disembargo_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Disembargo msg) where + messageDefault = Disembargo_newtype_ . U'.messageDefault instance B'.ListElem msg (Disembargo msg) where newtype List msg (Disembargo msg) = List_Disembargo (U'.ListOf msg (U'.Struct msg)) length (List_Disembargo l) = U'.length l index i (List_Disembargo l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Disembargo msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Disembargo msg) where + fromPtr msg ptr = Disembargo_newtype_ <$> C'.fromPtr msg ptr + toPtr (Disembargo_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Disembargo (M'.MutMsg s)) where setIndex (Disembargo_newtype_ elt) i (List_Disembargo l) = U'.setIndex elt i l newList msg len = List_Disembargo <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Disembargo msg) msg where - message (Disembargo_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Disembargo msg) msg where - messageDefault = Disembargo_newtype_ . U'.messageDefault instance C'.Allocate s (Disembargo (M'.MutMsg s)) where new msg = Disembargo_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Disembargo msg)) where @@ -306,27 +294,26 @@ pure result get_Disembargo'context :: U'.ReadCtx m msg => Disembargo msg -> m (Disembargo'context msg) get_Disembargo'context (Disembargo_newtype_ struct) = C'.fromStruct struct -has_Disembargo'context :: U'.ReadCtx m msg => Disembargo msg -> m Bool -has_Disembargo'context(Disembargo_newtype_ struct) = pure True newtype Exception msg = Exception_newtype_ (U'.Struct msg) instance C'.FromStruct msg (Exception msg) where fromStruct = pure . Exception_newtype_ instance C'.ToStruct msg (Exception msg) where toStruct (Exception_newtype_ struct) = struct -instance C'.IsPtr msg (Exception msg) where - fromPtr msg ptr = Exception_newtype_ <$> C'.fromPtr msg ptr - toPtr (Exception_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Exception msg) where + type InMessage (Exception msg) = msg + message (Exception_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Exception msg) where + messageDefault = Exception_newtype_ . U'.messageDefault instance B'.ListElem msg (Exception msg) where newtype List msg (Exception msg) = List_Exception (U'.ListOf msg (U'.Struct msg)) length (List_Exception l) = U'.length l index i (List_Exception l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Exception msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Exception msg) where + fromPtr msg ptr = Exception_newtype_ <$> C'.fromPtr msg ptr + toPtr (Exception_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Exception (M'.MutMsg s)) where setIndex (Exception_newtype_ elt) i (List_Exception l) = U'.setIndex elt i l newList msg len = List_Exception <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Exception msg) msg where - message (Exception_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Exception msg) msg where - messageDefault = Exception_newtype_ . U'.messageDefault instance C'.Allocate s (Exception (M'.MutMsg s)) where new msg = Exception_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Exception msg)) where @@ -347,20 +334,14 @@ pure result get_Exception'obsoleteIsCallersFault :: U'.ReadCtx m msg => Exception msg -> m Bool get_Exception'obsoleteIsCallersFault (Exception_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Exception'obsoleteIsCallersFault :: U'.ReadCtx m msg => Exception msg -> m Bool -has_Exception'obsoleteIsCallersFault(Exception_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Exception'obsoleteIsCallersFault :: U'.RWCtx m s => Exception (M'.MutMsg s) -> Bool -> m () set_Exception'obsoleteIsCallersFault (Exception_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 0 0 get_Exception'obsoleteDurability :: U'.ReadCtx m msg => Exception msg -> m Word16 get_Exception'obsoleteDurability (Exception_newtype_ struct) = H'.getWordField struct 0 16 0 -has_Exception'obsoleteDurability :: U'.ReadCtx m msg => Exception msg -> m Bool -has_Exception'obsoleteDurability(Exception_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Exception'obsoleteDurability :: U'.RWCtx m s => Exception (M'.MutMsg s) -> Word16 -> m () set_Exception'obsoleteDurability (Exception_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 get_Exception'type_ :: U'.ReadCtx m msg => Exception msg -> m Exception'Type get_Exception'type_ (Exception_newtype_ struct) = H'.getWordField struct 0 32 0 -has_Exception'type_ :: U'.ReadCtx m msg => Exception msg -> m Bool -has_Exception'type_(Exception_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Exception'type_ :: U'.RWCtx m s => Exception (M'.MutMsg s) -> Exception'Type -> m () set_Exception'type_ (Exception_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 32 0 newtype Finish msg = Finish_newtype_ (U'.Struct msg) @@ -368,20 +349,21 @@ fromStruct = pure . Finish_newtype_ instance C'.ToStruct msg (Finish msg) where toStruct (Finish_newtype_ struct) = struct -instance C'.IsPtr msg (Finish msg) where - fromPtr msg ptr = Finish_newtype_ <$> C'.fromPtr msg ptr - toPtr (Finish_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Finish msg) where + type InMessage (Finish msg) = msg + message (Finish_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Finish msg) where + messageDefault = Finish_newtype_ . U'.messageDefault instance B'.ListElem msg (Finish msg) where newtype List msg (Finish msg) = List_Finish (U'.ListOf msg (U'.Struct msg)) length (List_Finish l) = U'.length l index i (List_Finish l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Finish msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Finish msg) where + fromPtr msg ptr = Finish_newtype_ <$> C'.fromPtr msg ptr + toPtr (Finish_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Finish (M'.MutMsg s)) where setIndex (Finish_newtype_ elt) i (List_Finish l) = U'.setIndex elt i l newList msg len = List_Finish <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (Finish msg) msg where - message (Finish_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Finish msg) msg where - messageDefault = Finish_newtype_ . U'.messageDefault instance C'.Allocate s (Finish (M'.MutMsg s)) where new msg = Finish_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (Finish msg)) where @@ -389,14 +371,10 @@ toPtr (List_Finish l) = C'.toPtr l get_Finish'questionId :: U'.ReadCtx m msg => Finish msg -> m Word32 get_Finish'questionId (Finish_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Finish'questionId :: U'.ReadCtx m msg => Finish msg -> m Bool -has_Finish'questionId(Finish_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Finish'questionId :: U'.RWCtx m s => Finish (M'.MutMsg s) -> Word32 -> m () set_Finish'questionId (Finish_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Finish'releaseResultCaps :: U'.ReadCtx m msg => Finish msg -> m Bool get_Finish'releaseResultCaps (Finish_newtype_ struct) = H'.getWordField struct 0 32 1 -has_Finish'releaseResultCaps :: U'.ReadCtx m msg => Finish msg -> m Bool -has_Finish'releaseResultCaps(Finish_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Finish'releaseResultCaps :: U'.RWCtx m s => Finish (M'.MutMsg s) -> Bool -> m () set_Finish'releaseResultCaps (Finish_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 32 1 newtype Join msg = Join_newtype_ (U'.Struct msg) @@ -404,20 +382,21 @@ fromStruct = pure . Join_newtype_ instance C'.ToStruct msg (Join msg) where toStruct (Join_newtype_ struct) = struct -instance C'.IsPtr msg (Join msg) where - fromPtr msg ptr = Join_newtype_ <$> C'.fromPtr msg ptr - toPtr (Join_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Join msg) where + type InMessage (Join msg) = msg + message (Join_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Join msg) where + messageDefault = Join_newtype_ . U'.messageDefault instance B'.ListElem msg (Join msg) where newtype List msg (Join msg) = List_Join (U'.ListOf msg (U'.Struct msg)) length (List_Join l) = U'.length l index i (List_Join l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Join msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Join msg) where + fromPtr msg ptr = Join_newtype_ <$> C'.fromPtr msg ptr + toPtr (Join_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Join (M'.MutMsg s)) where setIndex (Join_newtype_ elt) i (List_Join l) = U'.setIndex elt i l newList msg len = List_Join <$> U'.allocCompositeList msg 1 2 len -instance U'.HasMessage (Join msg) msg where - message (Join_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Join msg) msg where - messageDefault = Join_newtype_ . U'.messageDefault instance C'.Allocate s (Join (M'.MutMsg s)) where new msg = Join_newtype_ <$> U'.allocStruct msg 1 2 instance C'.IsPtr msg (B'.List msg (Join msg)) where @@ -425,8 +404,6 @@ toPtr (List_Join l) = C'.toPtr l get_Join'questionId :: U'.ReadCtx m msg => Join msg -> m Word32 get_Join'questionId (Join_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Join'questionId :: U'.ReadCtx m msg => Join msg -> m Bool -has_Join'questionId(Join_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Join'questionId :: U'.RWCtx m s => Join (M'.MutMsg s) -> Word32 -> m () set_Join'questionId (Join_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Join'target :: U'.ReadCtx m msg => Join msg -> m (MessageTarget msg) @@ -455,45 +432,44 @@ fromStruct = pure . Message_newtype_ instance C'.ToStruct msg (Message msg) where toStruct (Message_newtype_ struct) = struct -instance C'.IsPtr msg (Message msg) where - fromPtr msg ptr = Message_newtype_ <$> C'.fromPtr msg ptr - toPtr (Message_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Message msg) where + type InMessage (Message msg) = msg + message (Message_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Message msg) where + messageDefault = Message_newtype_ . U'.messageDefault instance B'.ListElem msg (Message msg) where newtype List msg (Message msg) = List_Message (U'.ListOf msg (U'.Struct msg)) length (List_Message l) = U'.length l index i (List_Message l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Message msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Message msg) where + fromPtr msg ptr = Message_newtype_ <$> C'.fromPtr msg ptr + toPtr (Message_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Message (M'.MutMsg s)) where setIndex (Message_newtype_ elt) i (List_Message l) = U'.setIndex elt i l newList msg len = List_Message <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Message msg) msg where - message (Message_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Message msg) msg where - messageDefault = Message_newtype_ . U'.messageDefault instance C'.Allocate s (Message (M'.MutMsg s)) where new msg = Message_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Message msg)) where fromPtr msg ptr = List_Message <$> C'.fromPtr msg ptr toPtr (List_Message l) = C'.toPtr l -data Message' msg = - Message'unimplemented (Message msg) | - Message'abort (Exception msg) | - Message'call (Call msg) | - Message'return (Return msg) | - Message'finish (Finish msg) | - Message'resolve (Resolve msg) | - Message'release (Release msg) | - Message'obsoleteSave (Maybe (U'.Ptr msg)) | - Message'bootstrap (Bootstrap msg) | - Message'obsoleteDelete (Maybe (U'.Ptr msg)) | - Message'provide (Provide msg) | - Message'accept (Accept msg) | - Message'join (Join msg) | - Message'disembargo (Disembargo msg) | - Message'unknown' Word16 +data Message' msg + = Message'unimplemented (Message msg) + | Message'abort (Exception msg) + | Message'call (Call msg) + | Message'return (Return msg) + | Message'finish (Finish msg) + | Message'resolve (Resolve msg) + | Message'release (Release msg) + | Message'obsoleteSave (Maybe (U'.Ptr msg)) + | Message'bootstrap (Bootstrap msg) + | Message'obsoleteDelete (Maybe (U'.Ptr msg)) + | Message'provide (Provide msg) + | Message'accept (Accept msg) + | Message'join (Join msg) + | Message'disembargo (Disembargo msg) + | Message'unknown' Word16 get_Message' :: U'.ReadCtx m msg => Message msg -> m (Message' msg) get_Message' (Message_newtype_ struct) = C'.fromStruct struct -has_Message' :: U'.ReadCtx m msg => Message msg -> m Bool -has_Message'(Message_newtype_ struct) = pure True set_Message'unimplemented :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Message (M'.MutMsg s)) -> m () set_Message'unimplemented(Message_newtype_ struct) value = do H'.setWordField struct (0 :: Word16) 0 0 0 @@ -636,33 +612,32 @@ fromStruct = pure . MessageTarget_newtype_ instance C'.ToStruct msg (MessageTarget msg) where toStruct (MessageTarget_newtype_ struct) = struct -instance C'.IsPtr msg (MessageTarget msg) where - fromPtr msg ptr = MessageTarget_newtype_ <$> C'.fromPtr msg ptr - toPtr (MessageTarget_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (MessageTarget msg) where + type InMessage (MessageTarget msg) = msg + message (MessageTarget_newtype_ struct) = U'.message struct +instance U'.MessageDefault (MessageTarget msg) where + messageDefault = MessageTarget_newtype_ . U'.messageDefault instance B'.ListElem msg (MessageTarget msg) where newtype List msg (MessageTarget msg) = List_MessageTarget (U'.ListOf msg (U'.Struct msg)) length (List_MessageTarget l) = U'.length l index i (List_MessageTarget l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (MessageTarget msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (MessageTarget msg) where + fromPtr msg ptr = MessageTarget_newtype_ <$> C'.fromPtr msg ptr + toPtr (MessageTarget_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (MessageTarget (M'.MutMsg s)) where setIndex (MessageTarget_newtype_ elt) i (List_MessageTarget l) = U'.setIndex elt i l newList msg len = List_MessageTarget <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (MessageTarget msg) msg where - message (MessageTarget_newtype_ struct) = U'.message struct -instance U'.MessageDefault (MessageTarget msg) msg where - messageDefault = MessageTarget_newtype_ . U'.messageDefault instance C'.Allocate s (MessageTarget (M'.MutMsg s)) where new msg = MessageTarget_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (MessageTarget msg)) where fromPtr msg ptr = List_MessageTarget <$> C'.fromPtr msg ptr toPtr (List_MessageTarget l) = C'.toPtr l -data MessageTarget' msg = - MessageTarget'importedCap Word32 | - MessageTarget'promisedAnswer (PromisedAnswer msg) | - MessageTarget'unknown' Word16 +data MessageTarget' msg + = MessageTarget'importedCap Word32 + | MessageTarget'promisedAnswer (PromisedAnswer msg) + | MessageTarget'unknown' Word16 get_MessageTarget' :: U'.ReadCtx m msg => MessageTarget msg -> m (MessageTarget' msg) get_MessageTarget' (MessageTarget_newtype_ struct) = C'.fromStruct struct -has_MessageTarget' :: U'.ReadCtx m msg => MessageTarget msg -> m Bool -has_MessageTarget'(MessageTarget_newtype_ struct) = pure True set_MessageTarget'importedCap :: U'.RWCtx m s => MessageTarget (M'.MutMsg s) -> Word32 -> m () set_MessageTarget'importedCap (MessageTarget_newtype_ struct) value = do H'.setWordField struct (0 :: Word16) 0 32 0 @@ -690,20 +665,21 @@ fromStruct = pure . Payload_newtype_ instance C'.ToStruct msg (Payload msg) where toStruct (Payload_newtype_ struct) = struct -instance C'.IsPtr msg (Payload msg) where - fromPtr msg ptr = Payload_newtype_ <$> C'.fromPtr msg ptr - toPtr (Payload_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Payload msg) where + type InMessage (Payload msg) = msg + message (Payload_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Payload msg) where + messageDefault = Payload_newtype_ . U'.messageDefault instance B'.ListElem msg (Payload msg) where newtype List msg (Payload msg) = List_Payload (U'.ListOf msg (U'.Struct msg)) length (List_Payload l) = U'.length l index i (List_Payload l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Payload msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Payload msg) where + fromPtr msg ptr = Payload_newtype_ <$> C'.fromPtr msg ptr + toPtr (Payload_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Payload (M'.MutMsg s)) where setIndex (Payload_newtype_ elt) i (List_Payload l) = U'.setIndex elt i l newList msg len = List_Payload <$> U'.allocCompositeList msg 0 2 len -instance U'.HasMessage (Payload msg) msg where - message (Payload_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Payload msg) msg where - messageDefault = Payload_newtype_ . U'.messageDefault instance C'.Allocate s (Payload (M'.MutMsg s)) where new msg = Payload_newtype_ <$> U'.allocStruct msg 0 2 instance C'.IsPtr msg (B'.List msg (Payload msg)) where @@ -735,20 +711,21 @@ fromStruct = pure . PromisedAnswer_newtype_ instance C'.ToStruct msg (PromisedAnswer msg) where toStruct (PromisedAnswer_newtype_ struct) = struct -instance C'.IsPtr msg (PromisedAnswer msg) where - fromPtr msg ptr = PromisedAnswer_newtype_ <$> C'.fromPtr msg ptr - toPtr (PromisedAnswer_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (PromisedAnswer msg) where + type InMessage (PromisedAnswer msg) = msg + message (PromisedAnswer_newtype_ struct) = U'.message struct +instance U'.MessageDefault (PromisedAnswer msg) where + messageDefault = PromisedAnswer_newtype_ . U'.messageDefault instance B'.ListElem msg (PromisedAnswer msg) where newtype List msg (PromisedAnswer msg) = List_PromisedAnswer (U'.ListOf msg (U'.Struct msg)) length (List_PromisedAnswer l) = U'.length l index i (List_PromisedAnswer l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (PromisedAnswer msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (PromisedAnswer msg) where + fromPtr msg ptr = PromisedAnswer_newtype_ <$> C'.fromPtr msg ptr + toPtr (PromisedAnswer_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (PromisedAnswer (M'.MutMsg s)) where setIndex (PromisedAnswer_newtype_ elt) i (List_PromisedAnswer l) = U'.setIndex elt i l newList msg len = List_PromisedAnswer <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (PromisedAnswer msg) msg where - message (PromisedAnswer_newtype_ struct) = U'.message struct -instance U'.MessageDefault (PromisedAnswer msg) msg where - messageDefault = PromisedAnswer_newtype_ . U'.messageDefault instance C'.Allocate s (PromisedAnswer (M'.MutMsg s)) where new msg = PromisedAnswer_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (PromisedAnswer msg)) where @@ -756,8 +733,6 @@ toPtr (List_PromisedAnswer l) = C'.toPtr l get_PromisedAnswer'questionId :: U'.ReadCtx m msg => PromisedAnswer msg -> m Word32 get_PromisedAnswer'questionId (PromisedAnswer_newtype_ struct) = H'.getWordField struct 0 0 0 -has_PromisedAnswer'questionId :: U'.ReadCtx m msg => PromisedAnswer msg -> m Bool -has_PromisedAnswer'questionId(PromisedAnswer_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_PromisedAnswer'questionId :: U'.RWCtx m s => PromisedAnswer (M'.MutMsg s) -> Word32 -> m () set_PromisedAnswer'questionId (PromisedAnswer_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_PromisedAnswer'transform :: U'.ReadCtx m msg => PromisedAnswer msg -> m (B'.List msg (PromisedAnswer'Op msg)) @@ -778,20 +753,21 @@ fromStruct = pure . Provide_newtype_ instance C'.ToStruct msg (Provide msg) where toStruct (Provide_newtype_ struct) = struct -instance C'.IsPtr msg (Provide msg) where - fromPtr msg ptr = Provide_newtype_ <$> C'.fromPtr msg ptr - toPtr (Provide_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Provide msg) where + type InMessage (Provide msg) = msg + message (Provide_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Provide msg) where + messageDefault = Provide_newtype_ . U'.messageDefault instance B'.ListElem msg (Provide msg) where newtype List msg (Provide msg) = List_Provide (U'.ListOf msg (U'.Struct msg)) length (List_Provide l) = U'.length l index i (List_Provide l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Provide msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Provide msg) where + fromPtr msg ptr = Provide_newtype_ <$> C'.fromPtr msg ptr + toPtr (Provide_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Provide (M'.MutMsg s)) where setIndex (Provide_newtype_ elt) i (List_Provide l) = U'.setIndex elt i l newList msg len = List_Provide <$> U'.allocCompositeList msg 1 2 len -instance U'.HasMessage (Provide msg) msg where - message (Provide_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Provide msg) msg where - messageDefault = Provide_newtype_ . U'.messageDefault instance C'.Allocate s (Provide (M'.MutMsg s)) where new msg = Provide_newtype_ <$> U'.allocStruct msg 1 2 instance C'.IsPtr msg (B'.List msg (Provide msg)) where @@ -799,8 +775,6 @@ toPtr (List_Provide l) = C'.toPtr l get_Provide'questionId :: U'.ReadCtx m msg => Provide msg -> m Word32 get_Provide'questionId (Provide_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Provide'questionId :: U'.ReadCtx m msg => Provide msg -> m Bool -has_Provide'questionId(Provide_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Provide'questionId :: U'.RWCtx m s => Provide (M'.MutMsg s) -> Word32 -> m () set_Provide'questionId (Provide_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Provide'target :: U'.ReadCtx m msg => Provide msg -> m (MessageTarget msg) @@ -829,20 +803,21 @@ fromStruct = pure . Release_newtype_ instance C'.ToStruct msg (Release msg) where toStruct (Release_newtype_ struct) = struct -instance C'.IsPtr msg (Release msg) where - fromPtr msg ptr = Release_newtype_ <$> C'.fromPtr msg ptr - toPtr (Release_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Release msg) where + type InMessage (Release msg) = msg + message (Release_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Release msg) where + messageDefault = Release_newtype_ . U'.messageDefault instance B'.ListElem msg (Release msg) where newtype List msg (Release msg) = List_Release (U'.ListOf msg (U'.Struct msg)) length (List_Release l) = U'.length l index i (List_Release l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Release msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Release msg) where + fromPtr msg ptr = Release_newtype_ <$> C'.fromPtr msg ptr + toPtr (Release_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Release (M'.MutMsg s)) where setIndex (Release_newtype_ elt) i (List_Release l) = U'.setIndex elt i l newList msg len = List_Release <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (Release msg) msg where - message (Release_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Release msg) msg where - messageDefault = Release_newtype_ . U'.messageDefault instance C'.Allocate s (Release (M'.MutMsg s)) where new msg = Release_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (Release msg)) where @@ -850,14 +825,10 @@ toPtr (List_Release l) = C'.toPtr l get_Release'id :: U'.ReadCtx m msg => Release msg -> m Word32 get_Release'id (Release_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Release'id :: U'.ReadCtx m msg => Release msg -> m Bool -has_Release'id(Release_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Release'id :: U'.RWCtx m s => Release (M'.MutMsg s) -> Word32 -> m () set_Release'id (Release_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Release'referenceCount :: U'.ReadCtx m msg => Release msg -> m Word32 get_Release'referenceCount (Release_newtype_ struct) = H'.getWordField struct 0 32 0 -has_Release'referenceCount :: U'.ReadCtx m msg => Release msg -> m Bool -has_Release'referenceCount(Release_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Release'referenceCount :: U'.RWCtx m s => Release (M'.MutMsg s) -> Word32 -> m () set_Release'referenceCount (Release_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 newtype Resolve msg = Resolve_newtype_ (U'.Struct msg) @@ -865,20 +836,21 @@ fromStruct = pure . Resolve_newtype_ instance C'.ToStruct msg (Resolve msg) where toStruct (Resolve_newtype_ struct) = struct -instance C'.IsPtr msg (Resolve msg) where - fromPtr msg ptr = Resolve_newtype_ <$> C'.fromPtr msg ptr - toPtr (Resolve_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Resolve msg) where + type InMessage (Resolve msg) = msg + message (Resolve_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Resolve msg) where + messageDefault = Resolve_newtype_ . U'.messageDefault instance B'.ListElem msg (Resolve msg) where newtype List msg (Resolve msg) = List_Resolve (U'.ListOf msg (U'.Struct msg)) length (List_Resolve l) = U'.length l index i (List_Resolve l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Resolve msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Resolve msg) where + fromPtr msg ptr = Resolve_newtype_ <$> C'.fromPtr msg ptr + toPtr (Resolve_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Resolve (M'.MutMsg s)) where setIndex (Resolve_newtype_ elt) i (List_Resolve l) = U'.setIndex elt i l newList msg len = List_Resolve <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Resolve msg) msg where - message (Resolve_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Resolve msg) msg where - messageDefault = Resolve_newtype_ . U'.messageDefault instance C'.Allocate s (Resolve (M'.MutMsg s)) where new msg = Resolve_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Resolve msg)) where @@ -886,33 +858,30 @@ toPtr (List_Resolve l) = C'.toPtr l get_Resolve'promiseId :: U'.ReadCtx m msg => Resolve msg -> m Word32 get_Resolve'promiseId (Resolve_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Resolve'promiseId :: U'.ReadCtx m msg => Resolve msg -> m Bool -has_Resolve'promiseId(Resolve_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Resolve'promiseId :: U'.RWCtx m s => Resolve (M'.MutMsg s) -> Word32 -> m () set_Resolve'promiseId (Resolve_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Resolve'union' :: U'.ReadCtx m msg => Resolve msg -> m (Resolve' msg) get_Resolve'union' (Resolve_newtype_ struct) = C'.fromStruct struct -has_Resolve'union' :: U'.ReadCtx m msg => Resolve msg -> m Bool -has_Resolve'union'(Resolve_newtype_ struct) = pure True newtype Return msg = Return_newtype_ (U'.Struct msg) instance C'.FromStruct msg (Return msg) where fromStruct = pure . Return_newtype_ instance C'.ToStruct msg (Return msg) where toStruct (Return_newtype_ struct) = struct -instance C'.IsPtr msg (Return msg) where - fromPtr msg ptr = Return_newtype_ <$> C'.fromPtr msg ptr - toPtr (Return_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Return msg) where + type InMessage (Return msg) = msg + message (Return_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Return msg) where + messageDefault = Return_newtype_ . U'.messageDefault instance B'.ListElem msg (Return msg) where newtype List msg (Return msg) = List_Return (U'.ListOf msg (U'.Struct msg)) length (List_Return l) = U'.length l index i (List_Return l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Return msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Return msg) where + fromPtr msg ptr = Return_newtype_ <$> C'.fromPtr msg ptr + toPtr (Return_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Return (M'.MutMsg s)) where setIndex (Return_newtype_ elt) i (List_Return l) = U'.setIndex elt i l newList msg len = List_Return <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (Return msg) msg where - message (Return_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Return msg) msg where - messageDefault = Return_newtype_ . U'.messageDefault instance C'.Allocate s (Return (M'.MutMsg s)) where new msg = Return_newtype_ <$> U'.allocStruct msg 2 1 instance C'.IsPtr msg (B'.List msg (Return msg)) where @@ -920,39 +889,34 @@ toPtr (List_Return l) = C'.toPtr l get_Return'answerId :: U'.ReadCtx m msg => Return msg -> m Word32 get_Return'answerId (Return_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Return'answerId :: U'.ReadCtx m msg => Return msg -> m Bool -has_Return'answerId(Return_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Return'answerId :: U'.RWCtx m s => Return (M'.MutMsg s) -> Word32 -> m () set_Return'answerId (Return_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_Return'releaseParamCaps :: U'.ReadCtx m msg => Return msg -> m Bool get_Return'releaseParamCaps (Return_newtype_ struct) = H'.getWordField struct 0 32 1 -has_Return'releaseParamCaps :: U'.ReadCtx m msg => Return msg -> m Bool -has_Return'releaseParamCaps(Return_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_Return'releaseParamCaps :: U'.RWCtx m s => Return (M'.MutMsg s) -> Bool -> m () set_Return'releaseParamCaps (Return_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 32 1 get_Return'union' :: U'.ReadCtx m msg => Return msg -> m (Return' msg) get_Return'union' (Return_newtype_ struct) = C'.fromStruct struct -has_Return'union' :: U'.ReadCtx m msg => Return msg -> m Bool -has_Return'union'(Return_newtype_ struct) = pure True newtype ThirdPartyCapDescriptor msg = ThirdPartyCapDescriptor_newtype_ (U'.Struct msg) instance C'.FromStruct msg (ThirdPartyCapDescriptor msg) where fromStruct = pure . ThirdPartyCapDescriptor_newtype_ instance C'.ToStruct msg (ThirdPartyCapDescriptor msg) where toStruct (ThirdPartyCapDescriptor_newtype_ struct) = struct -instance C'.IsPtr msg (ThirdPartyCapDescriptor msg) where - fromPtr msg ptr = ThirdPartyCapDescriptor_newtype_ <$> C'.fromPtr msg ptr - toPtr (ThirdPartyCapDescriptor_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (ThirdPartyCapDescriptor msg) where + type InMessage (ThirdPartyCapDescriptor msg) = msg + message (ThirdPartyCapDescriptor_newtype_ struct) = U'.message struct +instance U'.MessageDefault (ThirdPartyCapDescriptor msg) where + messageDefault = ThirdPartyCapDescriptor_newtype_ . U'.messageDefault instance B'.ListElem msg (ThirdPartyCapDescriptor msg) where newtype List msg (ThirdPartyCapDescriptor msg) = List_ThirdPartyCapDescriptor (U'.ListOf msg (U'.Struct msg)) length (List_ThirdPartyCapDescriptor l) = U'.length l index i (List_ThirdPartyCapDescriptor l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (ThirdPartyCapDescriptor msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (ThirdPartyCapDescriptor msg) where + fromPtr msg ptr = ThirdPartyCapDescriptor_newtype_ <$> C'.fromPtr msg ptr + toPtr (ThirdPartyCapDescriptor_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (ThirdPartyCapDescriptor (M'.MutMsg s)) where setIndex (ThirdPartyCapDescriptor_newtype_ elt) i (List_ThirdPartyCapDescriptor l) = U'.setIndex elt i l newList msg len = List_ThirdPartyCapDescriptor <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (ThirdPartyCapDescriptor msg) msg where - message (ThirdPartyCapDescriptor_newtype_ struct) = U'.message struct -instance U'.MessageDefault (ThirdPartyCapDescriptor msg) msg where - messageDefault = ThirdPartyCapDescriptor_newtype_ . U'.messageDefault instance C'.Allocate s (ThirdPartyCapDescriptor (M'.MutMsg s)) where new msg = ThirdPartyCapDescriptor_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (ThirdPartyCapDescriptor msg)) where @@ -968,8 +932,6 @@ set_ThirdPartyCapDescriptor'id (ThirdPartyCapDescriptor_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct get_ThirdPartyCapDescriptor'vineId :: U'.ReadCtx m msg => ThirdPartyCapDescriptor msg -> m Word32 get_ThirdPartyCapDescriptor'vineId (ThirdPartyCapDescriptor_newtype_ struct) = H'.getWordField struct 0 0 0 -has_ThirdPartyCapDescriptor'vineId :: U'.ReadCtx m msg => ThirdPartyCapDescriptor msg -> m Bool -has_ThirdPartyCapDescriptor'vineId(ThirdPartyCapDescriptor_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_ThirdPartyCapDescriptor'vineId :: U'.RWCtx m s => ThirdPartyCapDescriptor (M'.MutMsg s) -> Word32 -> m () set_ThirdPartyCapDescriptor'vineId (ThirdPartyCapDescriptor_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 newtype Call'sendResultsTo msg = Call'sendResultsTo_newtype_ (U'.Struct msg) @@ -977,34 +939,18 @@ fromStruct = pure . Call'sendResultsTo_newtype_ instance C'.ToStruct msg (Call'sendResultsTo msg) where toStruct (Call'sendResultsTo_newtype_ struct) = struct -instance C'.IsPtr msg (Call'sendResultsTo msg) where - fromPtr msg ptr = Call'sendResultsTo_newtype_ <$> C'.fromPtr msg ptr - toPtr (Call'sendResultsTo_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Call'sendResultsTo msg) where - newtype List msg (Call'sendResultsTo msg) = List_Call'sendResultsTo (U'.ListOf msg (U'.Struct msg)) - length (List_Call'sendResultsTo l) = U'.length l - index i (List_Call'sendResultsTo l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Call'sendResultsTo msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Call'sendResultsTo (M'.MutMsg s)) where - setIndex (Call'sendResultsTo_newtype_ elt) i (List_Call'sendResultsTo l) = U'.setIndex elt i l - newList msg len = List_Call'sendResultsTo <$> U'.allocCompositeList msg 3 3 len -instance U'.HasMessage (Call'sendResultsTo msg) msg where +instance U'.HasMessage (Call'sendResultsTo msg) where + type InMessage (Call'sendResultsTo msg) = msg message (Call'sendResultsTo_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Call'sendResultsTo msg) msg where +instance U'.MessageDefault (Call'sendResultsTo msg) where messageDefault = Call'sendResultsTo_newtype_ . U'.messageDefault -instance C'.Allocate s (Call'sendResultsTo (M'.MutMsg s)) where - new msg = Call'sendResultsTo_newtype_ <$> U'.allocStruct msg 3 3 -instance C'.IsPtr msg (B'.List msg (Call'sendResultsTo msg)) where - fromPtr msg ptr = List_Call'sendResultsTo <$> C'.fromPtr msg ptr - toPtr (List_Call'sendResultsTo l) = C'.toPtr l -data Call'sendResultsTo' msg = - Call'sendResultsTo'caller | - Call'sendResultsTo'yourself | - Call'sendResultsTo'thirdParty (Maybe (U'.Ptr msg)) | - Call'sendResultsTo'unknown' Word16 +data Call'sendResultsTo' msg + = Call'sendResultsTo'caller + | Call'sendResultsTo'yourself + | Call'sendResultsTo'thirdParty (Maybe (U'.Ptr msg)) + | Call'sendResultsTo'unknown' Word16 get_Call'sendResultsTo' :: U'.ReadCtx m msg => Call'sendResultsTo msg -> m (Call'sendResultsTo' msg) get_Call'sendResultsTo' (Call'sendResultsTo_newtype_ struct) = C'.fromStruct struct -has_Call'sendResultsTo' :: U'.ReadCtx m msg => Call'sendResultsTo msg -> m Bool -has_Call'sendResultsTo'(Call'sendResultsTo_newtype_ struct) = pure True set_Call'sendResultsTo'caller :: U'.RWCtx m s => Call'sendResultsTo (M'.MutMsg s) -> m () set_Call'sendResultsTo'caller (Call'sendResultsTo_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 48 0 set_Call'sendResultsTo'yourself :: U'.RWCtx m s => Call'sendResultsTo (M'.MutMsg s) -> m () @@ -1028,35 +974,19 @@ fromStruct = pure . Disembargo'context_newtype_ instance C'.ToStruct msg (Disembargo'context msg) where toStruct (Disembargo'context_newtype_ struct) = struct -instance C'.IsPtr msg (Disembargo'context msg) where - fromPtr msg ptr = Disembargo'context_newtype_ <$> C'.fromPtr msg ptr - toPtr (Disembargo'context_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Disembargo'context msg) where - newtype List msg (Disembargo'context msg) = List_Disembargo'context (U'.ListOf msg (U'.Struct msg)) - length (List_Disembargo'context l) = U'.length l - index i (List_Disembargo'context l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Disembargo'context msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Disembargo'context (M'.MutMsg s)) where - setIndex (Disembargo'context_newtype_ elt) i (List_Disembargo'context l) = U'.setIndex elt i l - newList msg len = List_Disembargo'context <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Disembargo'context msg) msg where +instance U'.HasMessage (Disembargo'context msg) where + type InMessage (Disembargo'context msg) = msg message (Disembargo'context_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Disembargo'context msg) msg where +instance U'.MessageDefault (Disembargo'context msg) where messageDefault = Disembargo'context_newtype_ . U'.messageDefault -instance C'.Allocate s (Disembargo'context (M'.MutMsg s)) where - new msg = Disembargo'context_newtype_ <$> U'.allocStruct msg 1 1 -instance C'.IsPtr msg (B'.List msg (Disembargo'context msg)) where - fromPtr msg ptr = List_Disembargo'context <$> C'.fromPtr msg ptr - toPtr (List_Disembargo'context l) = C'.toPtr l -data Disembargo'context' msg = - Disembargo'context'senderLoopback Word32 | - Disembargo'context'receiverLoopback Word32 | - Disembargo'context'accept | - Disembargo'context'provide Word32 | - Disembargo'context'unknown' Word16 +data Disembargo'context' msg + = Disembargo'context'senderLoopback Word32 + | Disembargo'context'receiverLoopback Word32 + | Disembargo'context'accept + | Disembargo'context'provide Word32 + | Disembargo'context'unknown' Word16 get_Disembargo'context' :: U'.ReadCtx m msg => Disembargo'context msg -> m (Disembargo'context' msg) get_Disembargo'context' (Disembargo'context_newtype_ struct) = C'.fromStruct struct -has_Disembargo'context' :: U'.ReadCtx m msg => Disembargo'context msg -> m Bool -has_Disembargo'context'(Disembargo'context_newtype_ struct) = pure True set_Disembargo'context'senderLoopback :: U'.RWCtx m s => Disembargo'context (M'.MutMsg s) -> Word32 -> m () set_Disembargo'context'senderLoopback (Disembargo'context_newtype_ struct) value = do H'.setWordField struct (0 :: Word16) 0 32 0 @@ -1082,27 +1012,27 @@ 1 -> Disembargo'context'receiverLoopback <$> H'.getWordField struct 0 0 0 0 -> Disembargo'context'senderLoopback <$> H'.getWordField struct 0 0 0 _ -> pure $ Disembargo'context'unknown' tag -data Exception'Type = - Exception'Type'failed | - Exception'Type'overloaded | - Exception'Type'disconnected | - Exception'Type'unimplemented | - Exception'Type'unknown' Word16 - deriving(Show, Read, Eq, Generic) +data Exception'Type + = Exception'Type'failed + | Exception'Type'overloaded + | Exception'Type'disconnected + | Exception'Type'unimplemented + | Exception'Type'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance Enum Exception'Type where toEnum = C'.fromWord . fromIntegral fromEnum = fromIntegral . C'.toWord instance C'.IsWord Exception'Type where fromWord n = go (fromIntegral n :: Word16) where - go 3 = Exception'Type'unimplemented - go 2 = Exception'Type'disconnected - go 1 = Exception'Type'overloaded go 0 = Exception'Type'failed + go 1 = Exception'Type'overloaded + go 2 = Exception'Type'disconnected + go 3 = Exception'Type'unimplemented go tag = Exception'Type'unknown' (fromIntegral tag) - toWord Exception'Type'unimplemented = 3 - toWord Exception'Type'disconnected = 2 - toWord Exception'Type'overloaded = 1 toWord Exception'Type'failed = 0 + toWord Exception'Type'overloaded = 1 + toWord Exception'Type'disconnected = 2 + toWord Exception'Type'unimplemented = 3 toWord (Exception'Type'unknown' tag) = fromIntegral tag instance B'.ListElem msg Exception'Type where newtype List msg Exception'Type = List_Exception'Type (U'.ListOf msg Word16) @@ -1119,33 +1049,32 @@ fromStruct = pure . PromisedAnswer'Op_newtype_ instance C'.ToStruct msg (PromisedAnswer'Op msg) where toStruct (PromisedAnswer'Op_newtype_ struct) = struct -instance C'.IsPtr msg (PromisedAnswer'Op msg) where - fromPtr msg ptr = PromisedAnswer'Op_newtype_ <$> C'.fromPtr msg ptr - toPtr (PromisedAnswer'Op_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (PromisedAnswer'Op msg) where + type InMessage (PromisedAnswer'Op msg) = msg + message (PromisedAnswer'Op_newtype_ struct) = U'.message struct +instance U'.MessageDefault (PromisedAnswer'Op msg) where + messageDefault = PromisedAnswer'Op_newtype_ . U'.messageDefault instance B'.ListElem msg (PromisedAnswer'Op msg) where newtype List msg (PromisedAnswer'Op msg) = List_PromisedAnswer'Op (U'.ListOf msg (U'.Struct msg)) length (List_PromisedAnswer'Op l) = U'.length l index i (List_PromisedAnswer'Op l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (PromisedAnswer'Op msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (PromisedAnswer'Op msg) where + fromPtr msg ptr = PromisedAnswer'Op_newtype_ <$> C'.fromPtr msg ptr + toPtr (PromisedAnswer'Op_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (PromisedAnswer'Op (M'.MutMsg s)) where setIndex (PromisedAnswer'Op_newtype_ elt) i (List_PromisedAnswer'Op l) = U'.setIndex elt i l newList msg len = List_PromisedAnswer'Op <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (PromisedAnswer'Op msg) msg where - message (PromisedAnswer'Op_newtype_ struct) = U'.message struct -instance U'.MessageDefault (PromisedAnswer'Op msg) msg where - messageDefault = PromisedAnswer'Op_newtype_ . U'.messageDefault instance C'.Allocate s (PromisedAnswer'Op (M'.MutMsg s)) where new msg = PromisedAnswer'Op_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (PromisedAnswer'Op msg)) where fromPtr msg ptr = List_PromisedAnswer'Op <$> C'.fromPtr msg ptr toPtr (List_PromisedAnswer'Op l) = C'.toPtr l -data PromisedAnswer'Op' msg = - PromisedAnswer'Op'noop | - PromisedAnswer'Op'getPointerField Word16 | - PromisedAnswer'Op'unknown' Word16 +data PromisedAnswer'Op' msg + = PromisedAnswer'Op'noop + | PromisedAnswer'Op'getPointerField Word16 + | PromisedAnswer'Op'unknown' Word16 get_PromisedAnswer'Op' :: U'.ReadCtx m msg => PromisedAnswer'Op msg -> m (PromisedAnswer'Op' msg) get_PromisedAnswer'Op' (PromisedAnswer'Op_newtype_ struct) = C'.fromStruct struct -has_PromisedAnswer'Op' :: U'.ReadCtx m msg => PromisedAnswer'Op msg -> m Bool -has_PromisedAnswer'Op'(PromisedAnswer'Op_newtype_ struct) = pure True set_PromisedAnswer'Op'noop :: U'.RWCtx m s => PromisedAnswer'Op (M'.MutMsg s) -> m () set_PromisedAnswer'Op'noop (PromisedAnswer'Op_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 set_PromisedAnswer'Op'getPointerField :: U'.RWCtx m s => PromisedAnswer'Op (M'.MutMsg s) -> Word16 -> m () @@ -1166,33 +1095,32 @@ fromStruct = pure . Resolve'_newtype_ instance C'.ToStruct msg (Resolve' msg) where toStruct (Resolve'_newtype_ struct) = struct -instance C'.IsPtr msg (Resolve' msg) where - fromPtr msg ptr = Resolve'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Resolve'_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Resolve' msg) where + type InMessage (Resolve' msg) = msg + message (Resolve'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Resolve' msg) where + messageDefault = Resolve'_newtype_ . U'.messageDefault instance B'.ListElem msg (Resolve' msg) where newtype List msg (Resolve' msg) = List_Resolve' (U'.ListOf msg (U'.Struct msg)) length (List_Resolve' l) = U'.length l index i (List_Resolve' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Resolve' msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Resolve' msg) where + fromPtr msg ptr = Resolve'_newtype_ <$> C'.fromPtr msg ptr + toPtr (Resolve'_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Resolve' (M'.MutMsg s)) where setIndex (Resolve'_newtype_ elt) i (List_Resolve' l) = U'.setIndex elt i l newList msg len = List_Resolve' <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Resolve' msg) msg where - message (Resolve'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Resolve' msg) msg where - messageDefault = Resolve'_newtype_ . U'.messageDefault instance C'.Allocate s (Resolve' (M'.MutMsg s)) where new msg = Resolve'_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (Resolve' msg)) where fromPtr msg ptr = List_Resolve' <$> C'.fromPtr msg ptr toPtr (List_Resolve' l) = C'.toPtr l -data Resolve'' msg = - Resolve'cap (CapDescriptor msg) | - Resolve'exception (Exception msg) | - Resolve'unknown' Word16 +data Resolve'' msg + = Resolve'cap (CapDescriptor msg) + | Resolve'exception (Exception msg) + | Resolve''unknown' Word16 get_Resolve'' :: U'.ReadCtx m msg => Resolve' msg -> m (Resolve'' msg) get_Resolve'' (Resolve'_newtype_ struct) = C'.fromStruct struct -has_Resolve'' :: U'.ReadCtx m msg => Resolve' msg -> m Bool -has_Resolve''(Resolve'_newtype_ struct) = pure True set_Resolve'cap :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> (CapDescriptor (M'.MutMsg s)) -> m () set_Resolve'cap(Resolve'_newtype_ struct) value = do H'.setWordField struct (0 :: Word16) 0 32 0 @@ -1211,51 +1139,50 @@ result <- C'.new (U'.message struct) set_Resolve'exception struct result pure result -set_Resolve'unknown' :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> Word16 -> m () -set_Resolve'unknown'(Resolve'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 32 0 +set_Resolve''unknown' :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> Word16 -> m () +set_Resolve''unknown'(Resolve'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 32 0 instance C'.FromStruct msg (Resolve'' msg) where fromStruct struct = do tag <- H'.getWordField struct 0 32 0 case tag of 1 -> Resolve'exception <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) 0 -> Resolve'cap <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - _ -> pure $ Resolve'unknown' tag + _ -> pure $ Resolve''unknown' tag newtype Return' msg = Return'_newtype_ (U'.Struct msg) instance C'.FromStruct msg (Return' msg) where fromStruct = pure . Return'_newtype_ instance C'.ToStruct msg (Return' msg) where toStruct (Return'_newtype_ struct) = struct -instance C'.IsPtr msg (Return' msg) where - fromPtr msg ptr = Return'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Return'_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (Return' msg) where + type InMessage (Return' msg) = msg + message (Return'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Return' msg) where + messageDefault = Return'_newtype_ . U'.messageDefault instance B'.ListElem msg (Return' msg) where newtype List msg (Return' msg) = List_Return' (U'.ListOf msg (U'.Struct msg)) length (List_Return' l) = U'.length l index i (List_Return' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Return' msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Return' msg) where + fromPtr msg ptr = Return'_newtype_ <$> C'.fromPtr msg ptr + toPtr (Return'_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (Return' (M'.MutMsg s)) where setIndex (Return'_newtype_ elt) i (List_Return' l) = U'.setIndex elt i l newList msg len = List_Return' <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (Return' msg) msg where - message (Return'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Return' msg) msg where - messageDefault = Return'_newtype_ . U'.messageDefault instance C'.Allocate s (Return' (M'.MutMsg s)) where new msg = Return'_newtype_ <$> U'.allocStruct msg 2 1 instance C'.IsPtr msg (B'.List msg (Return' msg)) where fromPtr msg ptr = List_Return' <$> C'.fromPtr msg ptr toPtr (List_Return' l) = C'.toPtr l -data Return'' msg = - Return'results (Payload msg) | - Return'exception (Exception msg) | - Return'canceled | - Return'resultsSentElsewhere | - Return'takeFromOtherQuestion Word32 | - Return'acceptFromThirdParty (Maybe (U'.Ptr msg)) | - Return'unknown' Word16 +data Return'' msg + = Return'results (Payload msg) + | Return'exception (Exception msg) + | Return'canceled + | Return'resultsSentElsewhere + | Return'takeFromOtherQuestion Word32 + | Return'acceptFromThirdParty (Maybe (U'.Ptr msg)) + | Return''unknown' Word16 get_Return'' :: U'.ReadCtx m msg => Return' msg -> m (Return'' msg) get_Return'' (Return'_newtype_ struct) = C'.fromStruct struct -has_Return'' :: U'.ReadCtx m msg => Return' msg -> m Bool -has_Return''(Return'_newtype_ struct) = pure True set_Return'results :: U'.RWCtx m s => Return' (M'.MutMsg s) -> (Payload (M'.MutMsg s)) -> m () set_Return'results(Return'_newtype_ struct) value = do H'.setWordField struct (0 :: Word16) 0 48 0 @@ -1286,8 +1213,8 @@ set_Return'acceptFromThirdParty(Return'_newtype_ struct) value = do H'.setWordField struct (5 :: Word16) 0 48 0 U'.setPtr (C'.toPtr value) 0 struct -set_Return'unknown' :: U'.RWCtx m s => Return' (M'.MutMsg s) -> Word16 -> m () -set_Return'unknown'(Return'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 48 0 +set_Return''unknown' :: U'.RWCtx m s => Return' (M'.MutMsg s) -> Word16 -> m () +set_Return''unknown'(Return'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 48 0 instance C'.FromStruct msg (Return'' msg) where fromStruct struct = do tag <- H'.getWordField struct 0 48 0 @@ -1298,4 +1225,4 @@ 2 -> pure Return'canceled 1 -> Return'exception <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) 0 -> Return'results <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - _ -> pure $ Return'unknown' tag + _ -> pure $ Return''unknown' tag diff --git a/lib/Capnp/Capnp/Rpc/Pure.hs b/lib/Capnp/Capnp/Rpc/Pure.hs --- a/lib/Capnp/Capnp/Rpc/Pure.hs +++ b/lib/Capnp/Capnp/Rpc/Pure.hs @@ -36,11 +36,11 @@ import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure import qualified Capnp.ById.Xbdf87d7bb8304e81 data Accept - = Accept + = Accept {questionId :: Word32, provision :: Maybe (PU'.PtrType), embargo :: Bool} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Accept where type Cerial msg Accept = Capnp.ById.Xb312981b2552a250.Accept msg decerialize raw = do @@ -48,10 +48,6 @@ (Capnp.ById.Xb312981b2552a250.get_Accept'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Accept'provision raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Accept'embargo raw) -instance C'.FromStruct M'.ConstMsg Accept where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Accept M'.ConstMsg) instance C'.Marshal Accept where marshalInto raw value = do case value of @@ -61,23 +57,23 @@ Capnp.ById.Xb312981b2552a250.set_Accept'provision raw field_ Capnp.ById.Xb312981b2552a250.set_Accept'embargo raw embargo instance C'.Cerialize s Accept +instance C'.FromStruct M'.ConstMsg Accept where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Accept M'.ConstMsg) instance Default Accept where def = PH'.defaultStruct data Bootstrap - = Bootstrap + = Bootstrap {questionId :: Word32, deprecatedObjectId :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Bootstrap where type Cerial msg Bootstrap = Capnp.ById.Xb312981b2552a250.Bootstrap msg decerialize raw = do Bootstrap <$> (Capnp.ById.Xb312981b2552a250.get_Bootstrap'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Bootstrap'deprecatedObjectId raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Bootstrap where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Bootstrap M'.ConstMsg) instance C'.Marshal Bootstrap where marshalInto raw value = do case value of @@ -86,10 +82,14 @@ field_ <- C'.cerialize (U'.message raw) deprecatedObjectId Capnp.ById.Xb312981b2552a250.set_Bootstrap'deprecatedObjectId raw field_ instance C'.Cerialize s Bootstrap +instance C'.FromStruct M'.ConstMsg Bootstrap where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Bootstrap M'.ConstMsg) instance Default Bootstrap where def = PH'.defaultStruct data Call - = Call + = Call {questionId :: Word32, target :: MessageTarget, interfaceId :: Word64, @@ -97,7 +97,7 @@ params :: Payload, sendResultsTo :: Call'sendResultsTo, allowThirdPartyTailCall :: Bool} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Call where type Cerial msg Call = Capnp.ById.Xb312981b2552a250.Call msg decerialize raw = do @@ -109,10 +109,6 @@ (Capnp.ById.Xb312981b2552a250.get_Call'params raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Call'sendResultsTo raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Call'allowThirdPartyTailCall raw) -instance C'.FromStruct M'.ConstMsg Call where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call M'.ConstMsg) instance C'.Marshal Call where marshalInto raw value = do case value of @@ -128,17 +124,21 @@ C'.marshalInto field_ sendResultsTo Capnp.ById.Xb312981b2552a250.set_Call'allowThirdPartyTailCall raw allowThirdPartyTailCall instance C'.Cerialize s Call +instance C'.FromStruct M'.ConstMsg Call where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call M'.ConstMsg) instance Default Call where def = PH'.defaultStruct data CapDescriptor - = CapDescriptor'none | - CapDescriptor'senderHosted (Word32) | - CapDescriptor'senderPromise (Word32) | - CapDescriptor'receiverHosted (Word32) | - CapDescriptor'receiverAnswer (PromisedAnswer) | - CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor) | - CapDescriptor'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = CapDescriptor'none + | CapDescriptor'senderHosted (Word32) + | CapDescriptor'senderPromise (Word32) + | CapDescriptor'receiverHosted (Word32) + | CapDescriptor'receiverAnswer (PromisedAnswer) + | CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor) + | CapDescriptor'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize CapDescriptor where type Cerial msg CapDescriptor = Capnp.ById.Xb312981b2552a250.CapDescriptor msg decerialize raw = do @@ -150,11 +150,7 @@ Capnp.ById.Xb312981b2552a250.CapDescriptor'receiverHosted val -> pure (CapDescriptor'receiverHosted val) Capnp.ById.Xb312981b2552a250.CapDescriptor'receiverAnswer val -> CapDescriptor'receiverAnswer <$> C'.decerialize val Capnp.ById.Xb312981b2552a250.CapDescriptor'thirdPartyHosted val -> CapDescriptor'thirdPartyHosted <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.CapDescriptor'unknown' val -> pure (CapDescriptor'unknown' val) -instance C'.FromStruct M'.ConstMsg CapDescriptor where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.CapDescriptor M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.CapDescriptor'unknown' val -> pure $ CapDescriptor'unknown' val instance C'.Marshal CapDescriptor where marshalInto raw value = do case value of @@ -170,23 +166,23 @@ C'.marshalInto field_ arg_ CapDescriptor'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'unknown' raw arg_ instance C'.Cerialize s CapDescriptor +instance C'.FromStruct M'.ConstMsg CapDescriptor where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.CapDescriptor M'.ConstMsg) instance Default CapDescriptor where def = PH'.defaultStruct data Disembargo - = Disembargo + = Disembargo {target :: MessageTarget, context :: Disembargo'context} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Disembargo where type Cerial msg Disembargo = Capnp.ById.Xb312981b2552a250.Disembargo msg decerialize raw = do Disembargo <$> (Capnp.ById.Xb312981b2552a250.get_Disembargo'target raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Disembargo'context raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Disembargo where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo M'.ConstMsg) instance C'.Marshal Disembargo where marshalInto raw value = do case value of @@ -196,15 +192,19 @@ field_ <- Capnp.ById.Xb312981b2552a250.get_Disembargo'context raw C'.marshalInto field_ context instance C'.Cerialize s Disembargo +instance C'.FromStruct M'.ConstMsg Disembargo where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo M'.ConstMsg) instance Default Disembargo where def = PH'.defaultStruct data Exception - = Exception + = Exception {reason :: Text, obsoleteIsCallersFault :: Bool, obsoleteDurability :: Word16, type_ :: Capnp.ById.Xb312981b2552a250.Exception'Type} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Exception where type Cerial msg Exception = Capnp.ById.Xb312981b2552a250.Exception msg decerialize raw = do @@ -213,10 +213,6 @@ (Capnp.ById.Xb312981b2552a250.get_Exception'obsoleteIsCallersFault raw) <*> (Capnp.ById.Xb312981b2552a250.get_Exception'obsoleteDurability raw) <*> (Capnp.ById.Xb312981b2552a250.get_Exception'type_ raw) -instance C'.FromStruct M'.ConstMsg Exception where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Exception M'.ConstMsg) instance C'.Marshal Exception where marshalInto raw value = do case value of @@ -227,23 +223,23 @@ Capnp.ById.Xb312981b2552a250.set_Exception'obsoleteDurability raw obsoleteDurability Capnp.ById.Xb312981b2552a250.set_Exception'type_ raw type_ instance C'.Cerialize s Exception +instance C'.FromStruct M'.ConstMsg Exception where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Exception M'.ConstMsg) instance Default Exception where def = PH'.defaultStruct data Finish - = Finish + = Finish {questionId :: Word32, releaseResultCaps :: Bool} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Finish where type Cerial msg Finish = Capnp.ById.Xb312981b2552a250.Finish msg decerialize raw = do Finish <$> (Capnp.ById.Xb312981b2552a250.get_Finish'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Finish'releaseResultCaps raw) -instance C'.FromStruct M'.ConstMsg Finish where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Finish M'.ConstMsg) instance C'.Marshal Finish where marshalInto raw value = do case value of @@ -251,14 +247,18 @@ Capnp.ById.Xb312981b2552a250.set_Finish'questionId raw questionId Capnp.ById.Xb312981b2552a250.set_Finish'releaseResultCaps raw releaseResultCaps instance C'.Cerialize s Finish +instance C'.FromStruct M'.ConstMsg Finish where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Finish M'.ConstMsg) instance Default Finish where def = PH'.defaultStruct data Join - = Join + = Join {questionId :: Word32, target :: MessageTarget, keyPart :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Join where type Cerial msg Join = Capnp.ById.Xb312981b2552a250.Join msg decerialize raw = do @@ -266,10 +266,6 @@ (Capnp.ById.Xb312981b2552a250.get_Join'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Join'target raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Join'keyPart raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Join where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Join M'.ConstMsg) instance C'.Marshal Join where marshalInto raw value = do case value of @@ -280,25 +276,29 @@ field_ <- C'.cerialize (U'.message raw) keyPart Capnp.ById.Xb312981b2552a250.set_Join'keyPart raw field_ instance C'.Cerialize s Join +instance C'.FromStruct M'.ConstMsg Join where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Join M'.ConstMsg) instance Default Join where def = PH'.defaultStruct data Message - = Message'unimplemented (Message) | - Message'abort (Exception) | - Message'call (Call) | - Message'return (Return) | - Message'finish (Finish) | - Message'resolve (Resolve) | - Message'release (Release) | - Message'obsoleteSave (Maybe (PU'.PtrType)) | - Message'bootstrap (Bootstrap) | - Message'obsoleteDelete (Maybe (PU'.PtrType)) | - Message'provide (Provide) | - Message'accept (Accept) | - Message'join (Join) | - Message'disembargo (Disembargo) | - Message'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Message'unimplemented (Message) + | Message'abort (Exception) + | Message'call (Call) + | Message'return (Return) + | Message'finish (Finish) + | Message'resolve (Resolve) + | Message'release (Release) + | Message'obsoleteSave (Maybe (PU'.PtrType)) + | Message'bootstrap (Bootstrap) + | Message'obsoleteDelete (Maybe (PU'.PtrType)) + | Message'provide (Provide) + | Message'accept (Accept) + | Message'join (Join) + | Message'disembargo (Disembargo) + | Message'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Message where type Cerial msg Message = Capnp.ById.Xb312981b2552a250.Message msg decerialize raw = do @@ -318,11 +318,7 @@ Capnp.ById.Xb312981b2552a250.Message'accept val -> Message'accept <$> C'.decerialize val Capnp.ById.Xb312981b2552a250.Message'join val -> Message'join <$> C'.decerialize val Capnp.ById.Xb312981b2552a250.Message'disembargo val -> Message'disembargo <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.Message'unknown' val -> pure (Message'unknown' val) -instance C'.FromStruct M'.ConstMsg Message where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Message M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.Message'unknown' val -> pure $ Message'unknown' val instance C'.Marshal Message where marshalInto raw value = do case value of @@ -370,13 +366,17 @@ C'.marshalInto field_ arg_ Message'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Message'unknown' raw arg_ instance C'.Cerialize s Message +instance C'.FromStruct M'.ConstMsg Message where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Message M'.ConstMsg) instance Default Message where def = PH'.defaultStruct data MessageTarget - = MessageTarget'importedCap (Word32) | - MessageTarget'promisedAnswer (PromisedAnswer) | - MessageTarget'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = MessageTarget'importedCap (Word32) + | MessageTarget'promisedAnswer (PromisedAnswer) + | MessageTarget'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize MessageTarget where type Cerial msg MessageTarget = Capnp.ById.Xb312981b2552a250.MessageTarget msg decerialize raw = do @@ -384,11 +384,7 @@ case raw of Capnp.ById.Xb312981b2552a250.MessageTarget'importedCap val -> pure (MessageTarget'importedCap val) Capnp.ById.Xb312981b2552a250.MessageTarget'promisedAnswer val -> MessageTarget'promisedAnswer <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.MessageTarget'unknown' val -> pure (MessageTarget'unknown' val) -instance C'.FromStruct M'.ConstMsg MessageTarget where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.MessageTarget M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.MessageTarget'unknown' val -> pure $ MessageTarget'unknown' val instance C'.Marshal MessageTarget where marshalInto raw value = do case value of @@ -398,23 +394,23 @@ C'.marshalInto field_ arg_ MessageTarget'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_MessageTarget'unknown' raw arg_ instance C'.Cerialize s MessageTarget +instance C'.FromStruct M'.ConstMsg MessageTarget where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.MessageTarget M'.ConstMsg) instance Default MessageTarget where def = PH'.defaultStruct data Payload - = Payload + = Payload {content :: Maybe (PU'.PtrType), capTable :: PU'.ListOf (CapDescriptor)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Payload where type Cerial msg Payload = Capnp.ById.Xb312981b2552a250.Payload msg decerialize raw = do Payload <$> (Capnp.ById.Xb312981b2552a250.get_Payload'content raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Payload'capTable raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Payload where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Payload M'.ConstMsg) instance C'.Marshal Payload where marshalInto raw value = do case value of @@ -427,23 +423,23 @@ elt <- C'.index i field_ C'.marshalInto elt (capTable V.! i) instance C'.Cerialize s Payload +instance C'.FromStruct M'.ConstMsg Payload where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Payload M'.ConstMsg) instance Default Payload where def = PH'.defaultStruct data PromisedAnswer - = PromisedAnswer + = PromisedAnswer {questionId :: Word32, transform :: PU'.ListOf (PromisedAnswer'Op)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize PromisedAnswer where type Cerial msg PromisedAnswer = Capnp.ById.Xb312981b2552a250.PromisedAnswer msg decerialize raw = do PromisedAnswer <$> (Capnp.ById.Xb312981b2552a250.get_PromisedAnswer'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_PromisedAnswer'transform raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg PromisedAnswer where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer M'.ConstMsg) instance C'.Marshal PromisedAnswer where marshalInto raw value = do case value of @@ -455,14 +451,18 @@ elt <- C'.index i field_ C'.marshalInto elt (transform V.! i) instance C'.Cerialize s PromisedAnswer +instance C'.FromStruct M'.ConstMsg PromisedAnswer where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer M'.ConstMsg) instance Default PromisedAnswer where def = PH'.defaultStruct data Provide - = Provide + = Provide {questionId :: Word32, target :: MessageTarget, recipient :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Provide where type Cerial msg Provide = Capnp.ById.Xb312981b2552a250.Provide msg decerialize raw = do @@ -470,10 +470,6 @@ (Capnp.ById.Xb312981b2552a250.get_Provide'questionId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Provide'target raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_Provide'recipient raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Provide where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Provide M'.ConstMsg) instance C'.Marshal Provide where marshalInto raw value = do case value of @@ -484,23 +480,23 @@ field_ <- C'.cerialize (U'.message raw) recipient Capnp.ById.Xb312981b2552a250.set_Provide'recipient raw field_ instance C'.Cerialize s Provide +instance C'.FromStruct M'.ConstMsg Provide where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Provide M'.ConstMsg) instance Default Provide where def = PH'.defaultStruct data Release - = Release + = Release {id :: Word32, referenceCount :: Word32} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Release where type Cerial msg Release = Capnp.ById.Xb312981b2552a250.Release msg decerialize raw = do Release <$> (Capnp.ById.Xb312981b2552a250.get_Release'id raw) <*> (Capnp.ById.Xb312981b2552a250.get_Release'referenceCount raw) -instance C'.FromStruct M'.ConstMsg Release where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Release M'.ConstMsg) instance C'.Marshal Release where marshalInto raw value = do case value of @@ -508,23 +504,23 @@ Capnp.ById.Xb312981b2552a250.set_Release'id raw id Capnp.ById.Xb312981b2552a250.set_Release'referenceCount raw referenceCount instance C'.Cerialize s Release +instance C'.FromStruct M'.ConstMsg Release where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Release M'.ConstMsg) instance Default Release where def = PH'.defaultStruct data Resolve - = Resolve + = Resolve {promiseId :: Word32, union' :: Resolve'} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Resolve where type Cerial msg Resolve = Capnp.ById.Xb312981b2552a250.Resolve msg decerialize raw = do Resolve <$> (Capnp.ById.Xb312981b2552a250.get_Resolve'promiseId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Resolve'union' raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Resolve where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve M'.ConstMsg) instance C'.Marshal Resolve where marshalInto raw value = do case value of @@ -533,14 +529,18 @@ field_ <- Capnp.ById.Xb312981b2552a250.get_Resolve'union' raw C'.marshalInto field_ union' instance C'.Cerialize s Resolve +instance C'.FromStruct M'.ConstMsg Resolve where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve M'.ConstMsg) instance Default Resolve where def = PH'.defaultStruct data Return - = Return + = Return {answerId :: Word32, releaseParamCaps :: Bool, union' :: Return'} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Return where type Cerial msg Return = Capnp.ById.Xb312981b2552a250.Return msg decerialize raw = do @@ -548,10 +548,6 @@ (Capnp.ById.Xb312981b2552a250.get_Return'answerId raw) <*> (Capnp.ById.Xb312981b2552a250.get_Return'releaseParamCaps raw) <*> (Capnp.ById.Xb312981b2552a250.get_Return'union' raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Return where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return M'.ConstMsg) instance C'.Marshal Return where marshalInto raw value = do case value of @@ -561,23 +557,23 @@ field_ <- Capnp.ById.Xb312981b2552a250.get_Return'union' raw C'.marshalInto field_ union' instance C'.Cerialize s Return +instance C'.FromStruct M'.ConstMsg Return where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return M'.ConstMsg) instance Default Return where def = PH'.defaultStruct data ThirdPartyCapDescriptor - = ThirdPartyCapDescriptor + = ThirdPartyCapDescriptor {id :: Maybe (PU'.PtrType), vineId :: Word32} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize ThirdPartyCapDescriptor where type Cerial msg ThirdPartyCapDescriptor = Capnp.ById.Xb312981b2552a250.ThirdPartyCapDescriptor msg decerialize raw = do ThirdPartyCapDescriptor <$> (Capnp.ById.Xb312981b2552a250.get_ThirdPartyCapDescriptor'id raw >>= C'.decerialize) <*> (Capnp.ById.Xb312981b2552a250.get_ThirdPartyCapDescriptor'vineId raw) -instance C'.FromStruct M'.ConstMsg ThirdPartyCapDescriptor where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.ThirdPartyCapDescriptor M'.ConstMsg) instance C'.Marshal ThirdPartyCapDescriptor where marshalInto raw value = do case value of @@ -586,14 +582,18 @@ Capnp.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'id raw field_ Capnp.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'vineId raw vineId instance C'.Cerialize s ThirdPartyCapDescriptor +instance C'.FromStruct M'.ConstMsg ThirdPartyCapDescriptor where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.ThirdPartyCapDescriptor M'.ConstMsg) instance Default ThirdPartyCapDescriptor where def = PH'.defaultStruct data Call'sendResultsTo - = Call'sendResultsTo'caller | - Call'sendResultsTo'yourself | - Call'sendResultsTo'thirdParty (Maybe (PU'.PtrType)) | - Call'sendResultsTo'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Call'sendResultsTo'caller + | Call'sendResultsTo'yourself + | Call'sendResultsTo'thirdParty (Maybe (PU'.PtrType)) + | Call'sendResultsTo'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Call'sendResultsTo where type Cerial msg Call'sendResultsTo = Capnp.ById.Xb312981b2552a250.Call'sendResultsTo msg decerialize raw = do @@ -602,11 +602,7 @@ Capnp.ById.Xb312981b2552a250.Call'sendResultsTo'caller -> pure Call'sendResultsTo'caller Capnp.ById.Xb312981b2552a250.Call'sendResultsTo'yourself -> pure Call'sendResultsTo'yourself Capnp.ById.Xb312981b2552a250.Call'sendResultsTo'thirdParty val -> Call'sendResultsTo'thirdParty <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.Call'sendResultsTo'unknown' val -> pure (Call'sendResultsTo'unknown' val) -instance C'.FromStruct M'.ConstMsg Call'sendResultsTo where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call'sendResultsTo M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.Call'sendResultsTo'unknown' val -> pure $ Call'sendResultsTo'unknown' val instance C'.Marshal Call'sendResultsTo where marshalInto raw value = do case value of @@ -616,16 +612,19 @@ field_ <- C'.cerialize (U'.message raw) arg_ Capnp.ById.Xb312981b2552a250.set_Call'sendResultsTo'thirdParty raw field_ Call'sendResultsTo'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Call'sendResultsTo'unknown' raw arg_ -instance C'.Cerialize s Call'sendResultsTo +instance C'.FromStruct M'.ConstMsg Call'sendResultsTo where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call'sendResultsTo M'.ConstMsg) instance Default Call'sendResultsTo where def = PH'.defaultStruct data Disembargo'context - = Disembargo'context'senderLoopback (Word32) | - Disembargo'context'receiverLoopback (Word32) | - Disembargo'context'accept | - Disembargo'context'provide (Word32) | - Disembargo'context'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Disembargo'context'senderLoopback (Word32) + | Disembargo'context'receiverLoopback (Word32) + | Disembargo'context'accept + | Disembargo'context'provide (Word32) + | Disembargo'context'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Disembargo'context where type Cerial msg Disembargo'context = Capnp.ById.Xb312981b2552a250.Disembargo'context msg decerialize raw = do @@ -635,11 +634,7 @@ Capnp.ById.Xb312981b2552a250.Disembargo'context'receiverLoopback val -> pure (Disembargo'context'receiverLoopback val) Capnp.ById.Xb312981b2552a250.Disembargo'context'accept -> pure Disembargo'context'accept Capnp.ById.Xb312981b2552a250.Disembargo'context'provide val -> pure (Disembargo'context'provide val) - Capnp.ById.Xb312981b2552a250.Disembargo'context'unknown' val -> pure (Disembargo'context'unknown' val) -instance C'.FromStruct M'.ConstMsg Disembargo'context where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo'context M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.Disembargo'context'unknown' val -> pure $ Disembargo'context'unknown' val instance C'.Marshal Disembargo'context where marshalInto raw value = do case value of @@ -648,14 +643,17 @@ Disembargo'context'accept -> Capnp.ById.Xb312981b2552a250.set_Disembargo'context'accept raw Disembargo'context'provide arg_ -> Capnp.ById.Xb312981b2552a250.set_Disembargo'context'provide raw arg_ Disembargo'context'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Disembargo'context'unknown' raw arg_ -instance C'.Cerialize s Disembargo'context +instance C'.FromStruct M'.ConstMsg Disembargo'context where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo'context M'.ConstMsg) instance Default Disembargo'context where def = PH'.defaultStruct data PromisedAnswer'Op - = PromisedAnswer'Op'noop | - PromisedAnswer'Op'getPointerField (Word16) | - PromisedAnswer'Op'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = PromisedAnswer'Op'noop + | PromisedAnswer'Op'getPointerField (Word16) + | PromisedAnswer'Op'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize PromisedAnswer'Op where type Cerial msg PromisedAnswer'Op = Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op msg decerialize raw = do @@ -663,11 +661,7 @@ case raw of Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op'noop -> pure PromisedAnswer'Op'noop Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op'getPointerField val -> pure (PromisedAnswer'Op'getPointerField val) - Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op'unknown' val -> pure (PromisedAnswer'Op'unknown' val) -instance C'.FromStruct M'.ConstMsg PromisedAnswer'Op where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op'unknown' val -> pure $ PromisedAnswer'Op'unknown' val instance C'.Marshal PromisedAnswer'Op where marshalInto raw value = do case value of @@ -675,13 +669,17 @@ PromisedAnswer'Op'getPointerField arg_ -> Capnp.ById.Xb312981b2552a250.set_PromisedAnswer'Op'getPointerField raw arg_ PromisedAnswer'Op'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_PromisedAnswer'Op'unknown' raw arg_ instance C'.Cerialize s PromisedAnswer'Op +instance C'.FromStruct M'.ConstMsg PromisedAnswer'Op where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op M'.ConstMsg) instance Default PromisedAnswer'Op where def = PH'.defaultStruct data Resolve' - = Resolve'cap (CapDescriptor) | - Resolve'exception (Exception) | - Resolve'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Resolve'cap (CapDescriptor) + | Resolve'exception (Exception) + | Resolve'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Resolve' where type Cerial msg Resolve' = Capnp.ById.Xb312981b2552a250.Resolve' msg decerialize raw = do @@ -689,11 +687,7 @@ case raw of Capnp.ById.Xb312981b2552a250.Resolve'cap val -> Resolve'cap <$> C'.decerialize val Capnp.ById.Xb312981b2552a250.Resolve'exception val -> Resolve'exception <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.Resolve'unknown' val -> pure (Resolve'unknown' val) -instance C'.FromStruct M'.ConstMsg Resolve' where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve' M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.Resolve''unknown' val -> pure $ Resolve'unknown' val instance C'.Marshal Resolve' where marshalInto raw value = do case value of @@ -703,19 +697,23 @@ Resolve'exception arg_ -> do field_ <- Capnp.ById.Xb312981b2552a250.new_Resolve'exception raw C'.marshalInto field_ arg_ - Resolve'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Resolve'unknown' raw arg_ + Resolve'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Resolve''unknown' raw arg_ instance C'.Cerialize s Resolve' +instance C'.FromStruct M'.ConstMsg Resolve' where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve' M'.ConstMsg) instance Default Resolve' where def = PH'.defaultStruct data Return' - = Return'results (Payload) | - Return'exception (Exception) | - Return'canceled | - Return'resultsSentElsewhere | - Return'takeFromOtherQuestion (Word32) | - Return'acceptFromThirdParty (Maybe (PU'.PtrType)) | - Return'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Return'results (Payload) + | Return'exception (Exception) + | Return'canceled + | Return'resultsSentElsewhere + | Return'takeFromOtherQuestion (Word32) + | Return'acceptFromThirdParty (Maybe (PU'.PtrType)) + | Return'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Return' where type Cerial msg Return' = Capnp.ById.Xb312981b2552a250.Return' msg decerialize raw = do @@ -727,11 +725,7 @@ Capnp.ById.Xb312981b2552a250.Return'resultsSentElsewhere -> pure Return'resultsSentElsewhere Capnp.ById.Xb312981b2552a250.Return'takeFromOtherQuestion val -> pure (Return'takeFromOtherQuestion val) Capnp.ById.Xb312981b2552a250.Return'acceptFromThirdParty val -> Return'acceptFromThirdParty <$> C'.decerialize val - Capnp.ById.Xb312981b2552a250.Return'unknown' val -> pure (Return'unknown' val) -instance C'.FromStruct M'.ConstMsg Return' where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return' M'.ConstMsg) + Capnp.ById.Xb312981b2552a250.Return''unknown' val -> pure $ Return'unknown' val instance C'.Marshal Return' where marshalInto raw value = do case value of @@ -747,7 +741,11 @@ Return'acceptFromThirdParty arg_ -> do field_ <- C'.cerialize (U'.message raw) arg_ Capnp.ById.Xb312981b2552a250.set_Return'acceptFromThirdParty raw field_ - Return'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Return'unknown' raw arg_ + Return'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Return''unknown' raw arg_ instance C'.Cerialize s Return' +instance C'.FromStruct M'.ConstMsg Return' where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return' M'.ConstMsg) instance Default Return' where def = PH'.defaultStruct diff --git a/lib/Capnp/Capnp/RpcTwoparty.hs b/lib/Capnp/Capnp/RpcTwoparty.hs --- a/lib/Capnp/Capnp/RpcTwoparty.hs +++ b/lib/Capnp/Capnp/RpcTwoparty.hs @@ -19,6 +19,7 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe +import qualified Data.ByteString import qualified Data.Capnp.Classes as C' import qualified Data.Capnp.Basics as B' import qualified Data.Capnp.GenHelpers as H' @@ -31,20 +32,21 @@ fromStruct = pure . JoinKeyPart_newtype_ instance C'.ToStruct msg (JoinKeyPart msg) where toStruct (JoinKeyPart_newtype_ struct) = struct -instance C'.IsPtr msg (JoinKeyPart msg) where - fromPtr msg ptr = JoinKeyPart_newtype_ <$> C'.fromPtr msg ptr - toPtr (JoinKeyPart_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (JoinKeyPart msg) where + type InMessage (JoinKeyPart msg) = msg + message (JoinKeyPart_newtype_ struct) = U'.message struct +instance U'.MessageDefault (JoinKeyPart msg) where + messageDefault = JoinKeyPart_newtype_ . U'.messageDefault instance B'.ListElem msg (JoinKeyPart msg) where newtype List msg (JoinKeyPart msg) = List_JoinKeyPart (U'.ListOf msg (U'.Struct msg)) length (List_JoinKeyPart l) = U'.length l index i (List_JoinKeyPart l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JoinKeyPart msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (JoinKeyPart msg) where + fromPtr msg ptr = JoinKeyPart_newtype_ <$> C'.fromPtr msg ptr + toPtr (JoinKeyPart_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (JoinKeyPart (M'.MutMsg s)) where setIndex (JoinKeyPart_newtype_ elt) i (List_JoinKeyPart l) = U'.setIndex elt i l newList msg len = List_JoinKeyPart <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (JoinKeyPart msg) msg where - message (JoinKeyPart_newtype_ struct) = U'.message struct -instance U'.MessageDefault (JoinKeyPart msg) msg where - messageDefault = JoinKeyPart_newtype_ . U'.messageDefault instance C'.Allocate s (JoinKeyPart (M'.MutMsg s)) where new msg = JoinKeyPart_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (JoinKeyPart msg)) where @@ -52,20 +54,14 @@ toPtr (List_JoinKeyPart l) = C'.toPtr l get_JoinKeyPart'joinId :: U'.ReadCtx m msg => JoinKeyPart msg -> m Word32 get_JoinKeyPart'joinId (JoinKeyPart_newtype_ struct) = H'.getWordField struct 0 0 0 -has_JoinKeyPart'joinId :: U'.ReadCtx m msg => JoinKeyPart msg -> m Bool -has_JoinKeyPart'joinId(JoinKeyPart_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_JoinKeyPart'joinId :: U'.RWCtx m s => JoinKeyPart (M'.MutMsg s) -> Word32 -> m () set_JoinKeyPart'joinId (JoinKeyPart_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_JoinKeyPart'partCount :: U'.ReadCtx m msg => JoinKeyPart msg -> m Word16 get_JoinKeyPart'partCount (JoinKeyPart_newtype_ struct) = H'.getWordField struct 0 32 0 -has_JoinKeyPart'partCount :: U'.ReadCtx m msg => JoinKeyPart msg -> m Bool -has_JoinKeyPart'partCount(JoinKeyPart_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_JoinKeyPart'partCount :: U'.RWCtx m s => JoinKeyPart (M'.MutMsg s) -> Word16 -> m () set_JoinKeyPart'partCount (JoinKeyPart_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 32 0 get_JoinKeyPart'partNum :: U'.ReadCtx m msg => JoinKeyPart msg -> m Word16 get_JoinKeyPart'partNum (JoinKeyPart_newtype_ struct) = H'.getWordField struct 0 48 0 -has_JoinKeyPart'partNum :: U'.ReadCtx m msg => JoinKeyPart msg -> m Bool -has_JoinKeyPart'partNum(JoinKeyPart_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_JoinKeyPart'partNum :: U'.RWCtx m s => JoinKeyPart (M'.MutMsg s) -> Word16 -> m () set_JoinKeyPart'partNum (JoinKeyPart_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 48 0 newtype JoinResult msg = JoinResult_newtype_ (U'.Struct msg) @@ -73,20 +69,21 @@ fromStruct = pure . JoinResult_newtype_ instance C'.ToStruct msg (JoinResult msg) where toStruct (JoinResult_newtype_ struct) = struct -instance C'.IsPtr msg (JoinResult msg) where - fromPtr msg ptr = JoinResult_newtype_ <$> C'.fromPtr msg ptr - toPtr (JoinResult_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (JoinResult msg) where + type InMessage (JoinResult msg) = msg + message (JoinResult_newtype_ struct) = U'.message struct +instance U'.MessageDefault (JoinResult msg) where + messageDefault = JoinResult_newtype_ . U'.messageDefault instance B'.ListElem msg (JoinResult msg) where newtype List msg (JoinResult msg) = List_JoinResult (U'.ListOf msg (U'.Struct msg)) length (List_JoinResult l) = U'.length l index i (List_JoinResult l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JoinResult msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (JoinResult msg) where + fromPtr msg ptr = JoinResult_newtype_ <$> C'.fromPtr msg ptr + toPtr (JoinResult_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (JoinResult (M'.MutMsg s)) where setIndex (JoinResult_newtype_ elt) i (List_JoinResult l) = U'.setIndex elt i l newList msg len = List_JoinResult <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (JoinResult msg) msg where - message (JoinResult_newtype_ struct) = U'.message struct -instance U'.MessageDefault (JoinResult msg) msg where - messageDefault = JoinResult_newtype_ . U'.messageDefault instance C'.Allocate s (JoinResult (M'.MutMsg s)) where new msg = JoinResult_newtype_ <$> U'.allocStruct msg 1 1 instance C'.IsPtr msg (B'.List msg (JoinResult msg)) where @@ -94,14 +91,10 @@ toPtr (List_JoinResult l) = C'.toPtr l get_JoinResult'joinId :: U'.ReadCtx m msg => JoinResult msg -> m Word32 get_JoinResult'joinId (JoinResult_newtype_ struct) = H'.getWordField struct 0 0 0 -has_JoinResult'joinId :: U'.ReadCtx m msg => JoinResult msg -> m Bool -has_JoinResult'joinId(JoinResult_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_JoinResult'joinId :: U'.RWCtx m s => JoinResult (M'.MutMsg s) -> Word32 -> m () set_JoinResult'joinId (JoinResult_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 get_JoinResult'succeeded :: U'.ReadCtx m msg => JoinResult msg -> m Bool get_JoinResult'succeeded (JoinResult_newtype_ struct) = H'.getWordField struct 0 32 0 -has_JoinResult'succeeded :: U'.ReadCtx m msg => JoinResult msg -> m Bool -has_JoinResult'succeeded(JoinResult_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_JoinResult'succeeded :: U'.RWCtx m s => JoinResult (M'.MutMsg s) -> Bool -> m () set_JoinResult'succeeded (JoinResult_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 32 0 get_JoinResult'cap :: U'.ReadCtx m msg => JoinResult msg -> m (Maybe (U'.Ptr msg)) @@ -117,20 +110,21 @@ fromStruct = pure . ProvisionId_newtype_ instance C'.ToStruct msg (ProvisionId msg) where toStruct (ProvisionId_newtype_ struct) = struct -instance C'.IsPtr msg (ProvisionId msg) where - fromPtr msg ptr = ProvisionId_newtype_ <$> C'.fromPtr msg ptr - toPtr (ProvisionId_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (ProvisionId msg) where + type InMessage (ProvisionId msg) = msg + message (ProvisionId_newtype_ struct) = U'.message struct +instance U'.MessageDefault (ProvisionId msg) where + messageDefault = ProvisionId_newtype_ . U'.messageDefault instance B'.ListElem msg (ProvisionId msg) where newtype List msg (ProvisionId msg) = List_ProvisionId (U'.ListOf msg (U'.Struct msg)) length (List_ProvisionId l) = U'.length l index i (List_ProvisionId l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (ProvisionId msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (ProvisionId msg) where + fromPtr msg ptr = ProvisionId_newtype_ <$> C'.fromPtr msg ptr + toPtr (ProvisionId_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (ProvisionId (M'.MutMsg s)) where setIndex (ProvisionId_newtype_ elt) i (List_ProvisionId l) = U'.setIndex elt i l newList msg len = List_ProvisionId <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (ProvisionId msg) msg where - message (ProvisionId_newtype_ struct) = U'.message struct -instance U'.MessageDefault (ProvisionId msg) msg where - messageDefault = ProvisionId_newtype_ . U'.messageDefault instance C'.Allocate s (ProvisionId (M'.MutMsg s)) where new msg = ProvisionId_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (ProvisionId msg)) where @@ -138,25 +132,23 @@ toPtr (List_ProvisionId l) = C'.toPtr l get_ProvisionId'joinId :: U'.ReadCtx m msg => ProvisionId msg -> m Word32 get_ProvisionId'joinId (ProvisionId_newtype_ struct) = H'.getWordField struct 0 0 0 -has_ProvisionId'joinId :: U'.ReadCtx m msg => ProvisionId msg -> m Bool -has_ProvisionId'joinId(ProvisionId_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_ProvisionId'joinId :: U'.RWCtx m s => ProvisionId (M'.MutMsg s) -> Word32 -> m () set_ProvisionId'joinId (ProvisionId_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0 -data Side = - Side'server | - Side'client | - Side'unknown' Word16 - deriving(Show, Read, Eq, Generic) +data Side + = Side'server + | Side'client + | Side'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance Enum Side where toEnum = C'.fromWord . fromIntegral fromEnum = fromIntegral . C'.toWord instance C'.IsWord Side where fromWord n = go (fromIntegral n :: Word16) where - go 1 = Side'client go 0 = Side'server + go 1 = Side'client go tag = Side'unknown' (fromIntegral tag) - toWord Side'client = 1 toWord Side'server = 0 + toWord Side'client = 1 toWord (Side'unknown' tag) = fromIntegral tag instance B'.ListElem msg Side where newtype List msg Side = List_Side (U'.ListOf msg Word16) @@ -173,20 +165,21 @@ fromStruct = pure . VatId_newtype_ instance C'.ToStruct msg (VatId msg) where toStruct (VatId_newtype_ struct) = struct -instance C'.IsPtr msg (VatId msg) where - fromPtr msg ptr = VatId_newtype_ <$> C'.fromPtr msg ptr - toPtr (VatId_newtype_ struct) = C'.toPtr struct +instance U'.HasMessage (VatId msg) where + type InMessage (VatId msg) = msg + message (VatId_newtype_ struct) = U'.message struct +instance U'.MessageDefault (VatId msg) where + messageDefault = VatId_newtype_ . U'.messageDefault instance B'.ListElem msg (VatId msg) where newtype List msg (VatId msg) = List_VatId (U'.ListOf msg (U'.Struct msg)) length (List_VatId l) = U'.length l index i (List_VatId l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (VatId msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (VatId msg) where + fromPtr msg ptr = VatId_newtype_ <$> C'.fromPtr msg ptr + toPtr (VatId_newtype_ struct) = C'.toPtr struct instance B'.MutListElem s (VatId (M'.MutMsg s)) where setIndex (VatId_newtype_ elt) i (List_VatId l) = U'.setIndex elt i l newList msg len = List_VatId <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (VatId msg) msg where - message (VatId_newtype_ struct) = U'.message struct -instance U'.MessageDefault (VatId msg) msg where - messageDefault = VatId_newtype_ . U'.messageDefault instance C'.Allocate s (VatId (M'.MutMsg s)) where new msg = VatId_newtype_ <$> U'.allocStruct msg 1 0 instance C'.IsPtr msg (B'.List msg (VatId msg)) where @@ -194,7 +187,5 @@ toPtr (List_VatId l) = C'.toPtr l get_VatId'side :: U'.ReadCtx m msg => VatId msg -> m Side get_VatId'side (VatId_newtype_ struct) = H'.getWordField struct 0 0 0 -has_VatId'side :: U'.ReadCtx m msg => VatId msg -> m Bool -has_VatId'side(VatId_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) set_VatId'side :: U'.RWCtx m s => VatId (M'.MutMsg s) -> Side -> m () set_VatId'side (VatId_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 diff --git a/lib/Capnp/Capnp/RpcTwoparty/Pure.hs b/lib/Capnp/Capnp/RpcTwoparty/Pure.hs --- a/lib/Capnp/Capnp/RpcTwoparty/Pure.hs +++ b/lib/Capnp/Capnp/RpcTwoparty/Pure.hs @@ -36,11 +36,11 @@ import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure import qualified Capnp.ById.Xbdf87d7bb8304e81 data JoinKeyPart - = JoinKeyPart + = JoinKeyPart {joinId :: Word32, partCount :: Word16, partNum :: Word16} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize JoinKeyPart where type Cerial msg JoinKeyPart = Capnp.ById.Xa184c7885cdaf2a1.JoinKeyPart msg decerialize raw = do @@ -48,10 +48,6 @@ (Capnp.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'joinId raw) <*> (Capnp.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'partCount raw) <*> (Capnp.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'partNum raw) -instance C'.FromStruct M'.ConstMsg JoinKeyPart where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinKeyPart M'.ConstMsg) instance C'.Marshal JoinKeyPart where marshalInto raw value = do case value of @@ -60,14 +56,18 @@ Capnp.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partCount raw partCount Capnp.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partNum raw partNum instance C'.Cerialize s JoinKeyPart +instance C'.FromStruct M'.ConstMsg JoinKeyPart where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinKeyPart M'.ConstMsg) instance Default JoinKeyPart where def = PH'.defaultStruct data JoinResult - = JoinResult + = JoinResult {joinId :: Word32, succeeded :: Bool, cap :: Maybe (PU'.PtrType)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize JoinResult where type Cerial msg JoinResult = Capnp.ById.Xa184c7885cdaf2a1.JoinResult msg decerialize raw = do @@ -75,10 +75,6 @@ (Capnp.ById.Xa184c7885cdaf2a1.get_JoinResult'joinId raw) <*> (Capnp.ById.Xa184c7885cdaf2a1.get_JoinResult'succeeded raw) <*> (Capnp.ById.Xa184c7885cdaf2a1.get_JoinResult'cap raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg JoinResult where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinResult M'.ConstMsg) instance C'.Marshal JoinResult where marshalInto raw value = do case value of @@ -88,47 +84,51 @@ field_ <- C'.cerialize (U'.message raw) cap Capnp.ById.Xa184c7885cdaf2a1.set_JoinResult'cap raw field_ instance C'.Cerialize s JoinResult +instance C'.FromStruct M'.ConstMsg JoinResult where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinResult M'.ConstMsg) instance Default JoinResult where def = PH'.defaultStruct data ProvisionId - = ProvisionId + = ProvisionId {joinId :: Word32} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize ProvisionId where type Cerial msg ProvisionId = Capnp.ById.Xa184c7885cdaf2a1.ProvisionId msg decerialize raw = do ProvisionId <$> (Capnp.ById.Xa184c7885cdaf2a1.get_ProvisionId'joinId raw) -instance C'.FromStruct M'.ConstMsg ProvisionId where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.ProvisionId M'.ConstMsg) instance C'.Marshal ProvisionId where marshalInto raw value = do case value of ProvisionId{..} -> do Capnp.ById.Xa184c7885cdaf2a1.set_ProvisionId'joinId raw joinId instance C'.Cerialize s ProvisionId +instance C'.FromStruct M'.ConstMsg ProvisionId where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.ProvisionId M'.ConstMsg) instance Default ProvisionId where def = PH'.defaultStruct data VatId - = VatId + = VatId {side :: Capnp.ById.Xa184c7885cdaf2a1.Side} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize VatId where type Cerial msg VatId = Capnp.ById.Xa184c7885cdaf2a1.VatId msg decerialize raw = do VatId <$> (Capnp.ById.Xa184c7885cdaf2a1.get_VatId'side raw) -instance C'.FromStruct M'.ConstMsg VatId where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.VatId M'.ConstMsg) instance C'.Marshal VatId where marshalInto raw value = do case value of VatId{..} -> do Capnp.ById.Xa184c7885cdaf2a1.set_VatId'side raw side instance C'.Cerialize s VatId +instance C'.FromStruct M'.ConstMsg VatId where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.VatId M'.ConstMsg) instance Default VatId where def = PH'.defaultStruct diff --git a/lib/Capnp/Capnp/Schema.hs b/lib/Capnp/Capnp/Schema.hs --- a/lib/Capnp/Capnp/Schema.hs +++ b/lib/Capnp/Capnp/Schema.hs @@ -19,2189 +19,1836 @@ import Data.Capnp.Bits (Word1) import qualified Data.Bits import qualified Data.Maybe -import qualified Data.Capnp.Classes as C' -import qualified Data.Capnp.Basics as B' -import qualified Data.Capnp.GenHelpers as H' -import qualified Data.Capnp.TraversalLimit as TL' -import qualified Data.Capnp.Untyped as U' -import qualified Data.Capnp.Message as M' -import qualified Capnp.ById.Xbdf87d7bb8304e81 -newtype Annotation msg = Annotation_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Annotation msg) where - fromStruct = pure . Annotation_newtype_ -instance C'.ToStruct msg (Annotation msg) where - toStruct (Annotation_newtype_ struct) = struct -instance C'.IsPtr msg (Annotation msg) where - fromPtr msg ptr = Annotation_newtype_ <$> C'.fromPtr msg ptr - toPtr (Annotation_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Annotation msg) where - newtype List msg (Annotation msg) = List_Annotation (U'.ListOf msg (U'.Struct msg)) - length (List_Annotation l) = U'.length l - index i (List_Annotation l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Annotation msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Annotation (M'.MutMsg s)) where - setIndex (Annotation_newtype_ elt) i (List_Annotation l) = U'.setIndex elt i l - newList msg len = List_Annotation <$> U'.allocCompositeList msg 1 2 len -instance U'.HasMessage (Annotation msg) msg where - message (Annotation_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Annotation msg) msg where - messageDefault = Annotation_newtype_ . U'.messageDefault -instance C'.Allocate s (Annotation (M'.MutMsg s)) where - new msg = Annotation_newtype_ <$> U'.allocStruct msg 1 2 -instance C'.IsPtr msg (B'.List msg (Annotation msg)) where - fromPtr msg ptr = List_Annotation <$> C'.fromPtr msg ptr - toPtr (List_Annotation l) = C'.toPtr l -get_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Word64 -get_Annotation'id (Annotation_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Bool -has_Annotation'id(Annotation_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Annotation'id :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> Word64 -> m () -set_Annotation'id (Annotation_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m (Value msg) -get_Annotation'value (Annotation_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m Bool -has_Annotation'value(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () -set_Annotation'value (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) -new_Annotation'value struct = do - result <- C'.new (U'.message struct) - set_Annotation'value struct result - pure result -get_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m (Brand msg) -get_Annotation'brand (Annotation_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m Bool -has_Annotation'brand(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Annotation'brand (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Annotation'brand struct = do - result <- C'.new (U'.message struct) - set_Annotation'brand struct result - pure result -newtype Brand msg = Brand_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Brand msg) where - fromStruct = pure . Brand_newtype_ -instance C'.ToStruct msg (Brand msg) where - toStruct (Brand_newtype_ struct) = struct -instance C'.IsPtr msg (Brand msg) where - fromPtr msg ptr = Brand_newtype_ <$> C'.fromPtr msg ptr - toPtr (Brand_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Brand msg) where - newtype List msg (Brand msg) = List_Brand (U'.ListOf msg (U'.Struct msg)) - length (List_Brand l) = U'.length l - index i (List_Brand l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Brand (M'.MutMsg s)) where - setIndex (Brand_newtype_ elt) i (List_Brand l) = U'.setIndex elt i l - newList msg len = List_Brand <$> U'.allocCompositeList msg 0 1 len -instance U'.HasMessage (Brand msg) msg where - message (Brand_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Brand msg) msg where - messageDefault = Brand_newtype_ . U'.messageDefault -instance C'.Allocate s (Brand (M'.MutMsg s)) where - new msg = Brand_newtype_ <$> U'.allocStruct msg 0 1 -instance C'.IsPtr msg (B'.List msg (Brand msg)) where - fromPtr msg ptr = List_Brand <$> C'.fromPtr msg ptr - toPtr (List_Brand l) = C'.toPtr l -get_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m (B'.List msg (Brand'Scope msg)) -get_Brand'scopes (Brand_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m Bool -has_Brand'scopes(Brand_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Brand'scopes :: U'.RWCtx m s => Brand (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))) -> m () -set_Brand'scopes (Brand_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Brand'scopes :: U'.RWCtx m s => Int -> Brand (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s)))) -new_Brand'scopes len struct = do - result <- C'.newList (U'.message struct) len - set_Brand'scopes struct result - pure result -newtype CapnpVersion msg = CapnpVersion_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (CapnpVersion msg) where - fromStruct = pure . CapnpVersion_newtype_ -instance C'.ToStruct msg (CapnpVersion msg) where - toStruct (CapnpVersion_newtype_ struct) = struct -instance C'.IsPtr msg (CapnpVersion msg) where - fromPtr msg ptr = CapnpVersion_newtype_ <$> C'.fromPtr msg ptr - toPtr (CapnpVersion_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (CapnpVersion msg) where - newtype List msg (CapnpVersion msg) = List_CapnpVersion (U'.ListOf msg (U'.Struct msg)) - length (List_CapnpVersion l) = U'.length l - index i (List_CapnpVersion l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapnpVersion msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (CapnpVersion (M'.MutMsg s)) where - setIndex (CapnpVersion_newtype_ elt) i (List_CapnpVersion l) = U'.setIndex elt i l - newList msg len = List_CapnpVersion <$> U'.allocCompositeList msg 1 0 len -instance U'.HasMessage (CapnpVersion msg) msg where - message (CapnpVersion_newtype_ struct) = U'.message struct -instance U'.MessageDefault (CapnpVersion msg) msg where - messageDefault = CapnpVersion_newtype_ . U'.messageDefault -instance C'.Allocate s (CapnpVersion (M'.MutMsg s)) where - new msg = CapnpVersion_newtype_ <$> U'.allocStruct msg 1 0 -instance C'.IsPtr msg (B'.List msg (CapnpVersion msg)) where - fromPtr msg ptr = List_CapnpVersion <$> C'.fromPtr msg ptr - toPtr (List_CapnpVersion l) = C'.toPtr l -get_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Word16 -get_CapnpVersion'major (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 0 0 -has_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool -has_CapnpVersion'major(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_CapnpVersion'major :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word16 -> m () -set_CapnpVersion'major (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 -get_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8 -get_CapnpVersion'minor (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 16 0 -has_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool -has_CapnpVersion'minor(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_CapnpVersion'minor :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m () -set_CapnpVersion'minor (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 -get_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8 -get_CapnpVersion'micro (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 24 0 -has_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Bool -has_CapnpVersion'micro(CapnpVersion_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_CapnpVersion'micro :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m () -set_CapnpVersion'micro (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 24 0 -newtype CodeGeneratorRequest msg = CodeGeneratorRequest_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (CodeGeneratorRequest msg) where - fromStruct = pure . CodeGeneratorRequest_newtype_ -instance C'.ToStruct msg (CodeGeneratorRequest msg) where - toStruct (CodeGeneratorRequest_newtype_ struct) = struct -instance C'.IsPtr msg (CodeGeneratorRequest msg) where - fromPtr msg ptr = CodeGeneratorRequest_newtype_ <$> C'.fromPtr msg ptr - toPtr (CodeGeneratorRequest_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (CodeGeneratorRequest msg) where - newtype List msg (CodeGeneratorRequest msg) = List_CodeGeneratorRequest (U'.ListOf msg (U'.Struct msg)) - length (List_CodeGeneratorRequest l) = U'.length l - index i (List_CodeGeneratorRequest l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (CodeGeneratorRequest (M'.MutMsg s)) where - setIndex (CodeGeneratorRequest_newtype_ elt) i (List_CodeGeneratorRequest l) = U'.setIndex elt i l - newList msg len = List_CodeGeneratorRequest <$> U'.allocCompositeList msg 0 3 len -instance U'.HasMessage (CodeGeneratorRequest msg) msg where - message (CodeGeneratorRequest_newtype_ struct) = U'.message struct -instance U'.MessageDefault (CodeGeneratorRequest msg) msg where - messageDefault = CodeGeneratorRequest_newtype_ . U'.messageDefault -instance C'.Allocate s (CodeGeneratorRequest (M'.MutMsg s)) where - new msg = CodeGeneratorRequest_newtype_ <$> U'.allocStruct msg 0 3 -instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest msg)) where - fromPtr msg ptr = List_CodeGeneratorRequest <$> C'.fromPtr msg ptr - toPtr (List_CodeGeneratorRequest l) = C'.toPtr l -get_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (Node msg)) -get_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool -has_CodeGeneratorRequest'nodes(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_CodeGeneratorRequest'nodes :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node (M'.MutMsg s))) -> m () -set_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_CodeGeneratorRequest'nodes :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node (M'.MutMsg s)))) -new_CodeGeneratorRequest'nodes len struct = do - result <- C'.newList (U'.message struct) len - set_CodeGeneratorRequest'nodes struct result - pure result -get_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) -get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool -has_CodeGeneratorRequest'requestedFiles(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))) -> m () -set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)))) -new_CodeGeneratorRequest'requestedFiles len struct = do - result <- C'.newList (U'.message struct) len - set_CodeGeneratorRequest'requestedFiles struct result - pure result -get_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (CapnpVersion msg) -get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) = - U'.getPtr 2 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool -has_CodeGeneratorRequest'capnpVersion(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct -set_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (CapnpVersion (M'.MutMsg s)) -> m () -set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct -new_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> m ((CapnpVersion (M'.MutMsg s))) -new_CodeGeneratorRequest'capnpVersion struct = do - result <- C'.new (U'.message struct) - set_CodeGeneratorRequest'capnpVersion struct result - pure result -data ElementSize = - ElementSize'empty | - ElementSize'bit | - ElementSize'byte | - ElementSize'twoBytes | - ElementSize'fourBytes | - ElementSize'eightBytes | - ElementSize'pointer | - ElementSize'inlineComposite | - ElementSize'unknown' Word16 - deriving(Show, Read, Eq, Generic) -instance Enum ElementSize where - toEnum = C'.fromWord . fromIntegral - fromEnum = fromIntegral . C'.toWord -instance C'.IsWord ElementSize where - fromWord n = go (fromIntegral n :: Word16) where - go 7 = ElementSize'inlineComposite - go 6 = ElementSize'pointer - go 5 = ElementSize'eightBytes - go 4 = ElementSize'fourBytes - go 3 = ElementSize'twoBytes - go 2 = ElementSize'byte - go 1 = ElementSize'bit - go 0 = ElementSize'empty - go tag = ElementSize'unknown' (fromIntegral tag) - toWord ElementSize'inlineComposite = 7 - toWord ElementSize'pointer = 6 - toWord ElementSize'eightBytes = 5 - toWord ElementSize'fourBytes = 4 - toWord ElementSize'twoBytes = 3 - toWord ElementSize'byte = 2 - toWord ElementSize'bit = 1 - toWord ElementSize'empty = 0 - toWord (ElementSize'unknown' tag) = fromIntegral tag -instance B'.ListElem msg ElementSize where - newtype List msg ElementSize = List_ElementSize (U'.ListOf msg Word16) - length (List_ElementSize l) = U'.length l - index i (List_ElementSize l) = (C'.fromWord . fromIntegral) <$> U'.index i l -instance B'.MutListElem s ElementSize where - setIndex elt i (List_ElementSize l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l - newList msg size = List_ElementSize <$> U'.allocList16 msg size -instance C'.IsPtr msg (B'.List msg ElementSize) where - fromPtr msg ptr = List_ElementSize <$> C'.fromPtr msg ptr - toPtr (List_ElementSize l) = C'.toPtr l -newtype Enumerant msg = Enumerant_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Enumerant msg) where - fromStruct = pure . Enumerant_newtype_ -instance C'.ToStruct msg (Enumerant msg) where - toStruct (Enumerant_newtype_ struct) = struct -instance C'.IsPtr msg (Enumerant msg) where - fromPtr msg ptr = Enumerant_newtype_ <$> C'.fromPtr msg ptr - toPtr (Enumerant_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Enumerant msg) where - newtype List msg (Enumerant msg) = List_Enumerant (U'.ListOf msg (U'.Struct msg)) - length (List_Enumerant l) = U'.length l - index i (List_Enumerant l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Enumerant msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Enumerant (M'.MutMsg s)) where - setIndex (Enumerant_newtype_ elt) i (List_Enumerant l) = U'.setIndex elt i l - newList msg len = List_Enumerant <$> U'.allocCompositeList msg 1 2 len -instance U'.HasMessage (Enumerant msg) msg where - message (Enumerant_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Enumerant msg) msg where - messageDefault = Enumerant_newtype_ . U'.messageDefault -instance C'.Allocate s (Enumerant (M'.MutMsg s)) where - new msg = Enumerant_newtype_ <$> U'.allocStruct msg 1 2 -instance C'.IsPtr msg (B'.List msg (Enumerant msg)) where - fromPtr msg ptr = List_Enumerant <$> C'.fromPtr msg ptr - toPtr (List_Enumerant l) = C'.toPtr l -get_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m (B'.Text msg) -get_Enumerant'name (Enumerant_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m Bool -has_Enumerant'name(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Enumerant'name :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Enumerant'name (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Enumerant'name :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Enumerant'name len struct = do - result <- B'.newText (U'.message struct) len - set_Enumerant'name struct result - pure result -get_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Word16 -get_Enumerant'codeOrder (Enumerant_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Bool -has_Enumerant'codeOrder(Enumerant_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Enumerant'codeOrder :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> Word16 -> m () -set_Enumerant'codeOrder (Enumerant_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 -get_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m (B'.List msg (Annotation msg)) -get_Enumerant'annotations (Enumerant_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m Bool -has_Enumerant'annotations(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_Enumerant'annotations :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () -set_Enumerant'annotations (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_Enumerant'annotations :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) -new_Enumerant'annotations len struct = do - result <- C'.newList (U'.message struct) len - set_Enumerant'annotations struct result - pure result -newtype Field msg = Field_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Field msg) where - fromStruct = pure . Field_newtype_ -instance C'.ToStruct msg (Field msg) where - toStruct (Field_newtype_ struct) = struct -instance C'.IsPtr msg (Field msg) where - fromPtr msg ptr = Field_newtype_ <$> C'.fromPtr msg ptr - toPtr (Field_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Field msg) where - newtype List msg (Field msg) = List_Field (U'.ListOf msg (U'.Struct msg)) - length (List_Field l) = U'.length l - index i (List_Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Field (M'.MutMsg s)) where - setIndex (Field_newtype_ elt) i (List_Field l) = U'.setIndex elt i l - newList msg len = List_Field <$> U'.allocCompositeList msg 3 4 len -instance U'.HasMessage (Field msg) msg where - message (Field_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Field msg) msg where - messageDefault = Field_newtype_ . U'.messageDefault -instance C'.Allocate s (Field (M'.MutMsg s)) where - new msg = Field_newtype_ <$> U'.allocStruct msg 3 4 -instance C'.IsPtr msg (B'.List msg (Field msg)) where - fromPtr msg ptr = List_Field <$> C'.fromPtr msg ptr - toPtr (List_Field l) = C'.toPtr l -get_Field'name :: U'.ReadCtx m msg => Field msg -> m (B'.Text msg) -get_Field'name (Field_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Field'name :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'name(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Field'name :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Field'name (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Field'name :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Field'name len struct = do - result <- B'.newText (U'.message struct) len - set_Field'name struct result - pure result -get_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Word16 -get_Field'codeOrder (Field_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'codeOrder(Field_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Field'codeOrder :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m () -set_Field'codeOrder (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 -get_Field'annotations :: U'.ReadCtx m msg => Field msg -> m (B'.List msg (Annotation msg)) -get_Field'annotations (Field_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_Field'annotations :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'annotations(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_Field'annotations :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () -set_Field'annotations (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_Field'annotations :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) -new_Field'annotations len struct = do - result <- C'.newList (U'.message struct) len - set_Field'annotations struct result - pure result -get_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Word16 -get_Field'discriminantValue (Field_newtype_ struct) = H'.getWordField struct 0 16 65535 -has_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'discriminantValue(Field_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Field'discriminantValue :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m () -set_Field'discriminantValue (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 65535 -get_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m (Field'ordinal msg) -get_Field'ordinal (Field_newtype_ struct) = C'.fromStruct struct -has_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'ordinal(Field_newtype_ struct) = pure True -get_Field'union' :: U'.ReadCtx m msg => Field msg -> m (Field' msg) -get_Field'union' (Field_newtype_ struct) = C'.fromStruct struct -has_Field'union' :: U'.ReadCtx m msg => Field msg -> m Bool -has_Field'union'(Field_newtype_ struct) = pure True -newtype Method msg = Method_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Method msg) where - fromStruct = pure . Method_newtype_ -instance C'.ToStruct msg (Method msg) where - toStruct (Method_newtype_ struct) = struct -instance C'.IsPtr msg (Method msg) where - fromPtr msg ptr = Method_newtype_ <$> C'.fromPtr msg ptr - toPtr (Method_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Method msg) where - newtype List msg (Method msg) = List_Method (U'.ListOf msg (U'.Struct msg)) - length (List_Method l) = U'.length l - index i (List_Method l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Method msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Method (M'.MutMsg s)) where - setIndex (Method_newtype_ elt) i (List_Method l) = U'.setIndex elt i l - newList msg len = List_Method <$> U'.allocCompositeList msg 3 5 len -instance U'.HasMessage (Method msg) msg where - message (Method_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Method msg) msg where - messageDefault = Method_newtype_ . U'.messageDefault -instance C'.Allocate s (Method (M'.MutMsg s)) where - new msg = Method_newtype_ <$> U'.allocStruct msg 3 5 -instance C'.IsPtr msg (B'.List msg (Method msg)) where - fromPtr msg ptr = List_Method <$> C'.fromPtr msg ptr - toPtr (List_Method l) = C'.toPtr l -get_Method'name :: U'.ReadCtx m msg => Method msg -> m (B'.Text msg) -get_Method'name (Method_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Method'name :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'name(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Method'name :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Method'name (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Method'name :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Method'name len struct = do - result <- B'.newText (U'.message struct) len - set_Method'name struct result - pure result -get_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Word16 -get_Method'codeOrder (Method_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'codeOrder(Method_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Method'codeOrder :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word16 -> m () -set_Method'codeOrder (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 -get_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Word64 -get_Method'paramStructType (Method_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'paramStructType(Method_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Method'paramStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m () -set_Method'paramStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -get_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Word64 -get_Method'resultStructType (Method_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'resultStructType(Method_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) -set_Method'resultStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m () -set_Method'resultStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 -get_Method'annotations :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Annotation msg)) -get_Method'annotations (Method_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_Method'annotations :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'annotations(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_Method'annotations :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () -set_Method'annotations (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_Method'annotations :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) -new_Method'annotations len struct = do - result <- C'.newList (U'.message struct) len - set_Method'annotations struct result - pure result -get_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg) -get_Method'paramBrand (Method_newtype_ struct) = - U'.getPtr 2 struct - >>= C'.fromPtr (U'.message struct) -has_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'paramBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct -set_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Method'paramBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct -new_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Method'paramBrand struct = do - result <- C'.new (U'.message struct) - set_Method'paramBrand struct result - pure result -get_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg) -get_Method'resultBrand (Method_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'resultBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Method'resultBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Method'resultBrand struct = do - result <- C'.new (U'.message struct) - set_Method'resultBrand struct result - pure result -get_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Node'Parameter msg)) -get_Method'implicitParameters (Method_newtype_ struct) = - U'.getPtr 4 struct - >>= C'.fromPtr (U'.message struct) -has_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m Bool -has_Method'implicitParameters(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct -set_Method'implicitParameters :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m () -set_Method'implicitParameters (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct -new_Method'implicitParameters :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s)))) -new_Method'implicitParameters len struct = do - result <- C'.newList (U'.message struct) len - set_Method'implicitParameters struct result - pure result -newtype Node msg = Node_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node msg) where - fromStruct = pure . Node_newtype_ -instance C'.ToStruct msg (Node msg) where - toStruct (Node_newtype_ struct) = struct -instance C'.IsPtr msg (Node msg) where - fromPtr msg ptr = Node_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node msg) where - newtype List msg (Node msg) = List_Node (U'.ListOf msg (U'.Struct msg)) - length (List_Node l) = U'.length l - index i (List_Node l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node (M'.MutMsg s)) where - setIndex (Node_newtype_ elt) i (List_Node l) = U'.setIndex elt i l - newList msg len = List_Node <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node msg) msg where - message (Node_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node msg) msg where - messageDefault = Node_newtype_ . U'.messageDefault -instance C'.Allocate s (Node (M'.MutMsg s)) where - new msg = Node_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node msg)) where - fromPtr msg ptr = List_Node <$> C'.fromPtr msg ptr - toPtr (List_Node l) = C'.toPtr l -get_Node'id :: U'.ReadCtx m msg => Node msg -> m Word64 -get_Node'id (Node_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Node'id :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'id(Node_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Node'id :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m () -set_Node'id (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_Node'displayName :: U'.ReadCtx m msg => Node msg -> m (B'.Text msg) -get_Node'displayName (Node_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Node'displayName :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'displayName(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Node'displayName :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Node'displayName (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Node'displayName :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Node'displayName len struct = do - result <- B'.newText (U'.message struct) len - set_Node'displayName struct result - pure result -get_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Word32 -get_Node'displayNamePrefixLength (Node_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'displayNamePrefixLength(Node_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'displayNamePrefixLength :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word32 -> m () -set_Node'displayNamePrefixLength (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 1 0 0 -get_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Word64 -get_Node'scopeId (Node_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'scopeId(Node_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) -set_Node'scopeId :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m () -set_Node'scopeId (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 -get_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'NestedNode msg)) -get_Node'nestedNodes (Node_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'nestedNodes(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_Node'nestedNodes :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))) -> m () -set_Node'nestedNodes (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_Node'nestedNodes :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s)))) -new_Node'nestedNodes len struct = do - result <- C'.newList (U'.message struct) len - set_Node'nestedNodes struct result - pure result -get_Node'annotations :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Annotation msg)) -get_Node'annotations (Node_newtype_ struct) = - U'.getPtr 2 struct - >>= C'.fromPtr (U'.message struct) -has_Node'annotations :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'annotations(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct -set_Node'annotations :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () -set_Node'annotations (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct -new_Node'annotations :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) -new_Node'annotations len struct = do - result <- C'.newList (U'.message struct) len - set_Node'annotations struct result - pure result -get_Node'parameters :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'Parameter msg)) -get_Node'parameters (Node_newtype_ struct) = - U'.getPtr 5 struct - >>= C'.fromPtr (U'.message struct) -has_Node'parameters :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'parameters(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 5 struct -set_Node'parameters :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m () -set_Node'parameters (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 5 struct -new_Node'parameters :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s)))) -new_Node'parameters len struct = do - result <- C'.newList (U'.message struct) len - set_Node'parameters struct result - pure result -get_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool -get_Node'isGeneric (Node_newtype_ struct) = H'.getWordField struct 4 32 0 -has_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'isGeneric(Node_newtype_ struct) = pure $ 4 < U'.length (U'.dataSection struct) -set_Node'isGeneric :: U'.RWCtx m s => Node (M'.MutMsg s) -> Bool -> m () -set_Node'isGeneric (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 4 32 0 -get_Node'union' :: U'.ReadCtx m msg => Node msg -> m (Node' msg) -get_Node'union' (Node_newtype_ struct) = C'.fromStruct struct -has_Node'union' :: U'.ReadCtx m msg => Node msg -> m Bool -has_Node'union'(Node_newtype_ struct) = pure True -newtype Superclass msg = Superclass_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Superclass msg) where - fromStruct = pure . Superclass_newtype_ -instance C'.ToStruct msg (Superclass msg) where - toStruct (Superclass_newtype_ struct) = struct -instance C'.IsPtr msg (Superclass msg) where - fromPtr msg ptr = Superclass_newtype_ <$> C'.fromPtr msg ptr - toPtr (Superclass_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Superclass msg) where - newtype List msg (Superclass msg) = List_Superclass (U'.ListOf msg (U'.Struct msg)) - length (List_Superclass l) = U'.length l - index i (List_Superclass l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Superclass msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Superclass (M'.MutMsg s)) where - setIndex (Superclass_newtype_ elt) i (List_Superclass l) = U'.setIndex elt i l - newList msg len = List_Superclass <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Superclass msg) msg where - message (Superclass_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Superclass msg) msg where - messageDefault = Superclass_newtype_ . U'.messageDefault -instance C'.Allocate s (Superclass (M'.MutMsg s)) where - new msg = Superclass_newtype_ <$> U'.allocStruct msg 1 1 -instance C'.IsPtr msg (B'.List msg (Superclass msg)) where - fromPtr msg ptr = List_Superclass <$> C'.fromPtr msg ptr - toPtr (List_Superclass l) = C'.toPtr l -get_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Word64 -get_Superclass'id (Superclass_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Bool -has_Superclass'id(Superclass_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Superclass'id :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> Word64 -> m () -set_Superclass'id (Superclass_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m (Brand msg) -get_Superclass'brand (Superclass_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m Bool -has_Superclass'brand(Superclass_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Superclass'brand (Superclass_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Superclass'brand struct = do - result <- C'.new (U'.message struct) - set_Superclass'brand struct result - pure result -newtype Type msg = Type_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type msg) where - fromStruct = pure . Type_newtype_ -instance C'.ToStruct msg (Type msg) where - toStruct (Type_newtype_ struct) = struct -instance C'.IsPtr msg (Type msg) where - fromPtr msg ptr = Type_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type msg) where - newtype List msg (Type msg) = List_Type (U'.ListOf msg (U'.Struct msg)) - length (List_Type l) = U'.length l - index i (List_Type l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type (M'.MutMsg s)) where - setIndex (Type_newtype_ elt) i (List_Type l) = U'.setIndex elt i l - newList msg len = List_Type <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type msg) msg where - message (Type_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type msg) msg where - messageDefault = Type_newtype_ . U'.messageDefault -instance C'.Allocate s (Type (M'.MutMsg s)) where - new msg = Type_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type msg)) where - fromPtr msg ptr = List_Type <$> C'.fromPtr msg ptr - toPtr (List_Type l) = C'.toPtr l -data Type' msg = - Type'void | - Type'bool | - Type'int8 | - Type'int16 | - Type'int32 | - Type'int64 | - Type'uint8 | - Type'uint16 | - Type'uint32 | - Type'uint64 | - Type'float32 | - Type'float64 | - Type'text | - Type'data_ | - Type'list (Type'list'group' msg) | - Type'enum (Type'enum'group' msg) | - Type'struct (Type'struct'group' msg) | - Type'interface (Type'interface'group' msg) | - Type'anyPointer (Type'anyPointer'group' msg) | - Type'unknown' Word16 -get_Type' :: U'.ReadCtx m msg => Type msg -> m (Type' msg) -get_Type' (Type_newtype_ struct) = C'.fromStruct struct -has_Type' :: U'.ReadCtx m msg => Type msg -> m Bool -has_Type'(Type_newtype_ struct) = pure True -set_Type'void :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'void (Type_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 -set_Type'bool :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'bool (Type_newtype_ struct) = H'.setWordField struct (1 :: Word16) 0 0 0 -set_Type'int8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'int8 (Type_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 0 0 -set_Type'int16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'int16 (Type_newtype_ struct) = H'.setWordField struct (3 :: Word16) 0 0 0 -set_Type'int32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'int32 (Type_newtype_ struct) = H'.setWordField struct (4 :: Word16) 0 0 0 -set_Type'int64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'int64 (Type_newtype_ struct) = H'.setWordField struct (5 :: Word16) 0 0 0 -set_Type'uint8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'uint8 (Type_newtype_ struct) = H'.setWordField struct (6 :: Word16) 0 0 0 -set_Type'uint16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'uint16 (Type_newtype_ struct) = H'.setWordField struct (7 :: Word16) 0 0 0 -set_Type'uint32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'uint32 (Type_newtype_ struct) = H'.setWordField struct (8 :: Word16) 0 0 0 -set_Type'uint64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'uint64 (Type_newtype_ struct) = H'.setWordField struct (9 :: Word16) 0 0 0 -set_Type'float32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'float32 (Type_newtype_ struct) = H'.setWordField struct (10 :: Word16) 0 0 0 -set_Type'float64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'float64 (Type_newtype_ struct) = H'.setWordField struct (11 :: Word16) 0 0 0 -set_Type'text :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'text (Type_newtype_ struct) = H'.setWordField struct (12 :: Word16) 0 0 0 -set_Type'data_ :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () -set_Type'data_ (Type_newtype_ struct) = H'.setWordField struct (13 :: Word16) 0 0 0 -set_Type'list :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'list'group' (M'.MutMsg s)) -set_Type'list (Type_newtype_ struct) = do - H'.setWordField struct (14 :: Word16) 0 0 0 - pure $ Type'list'group'_newtype_ struct -set_Type'enum :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'enum'group' (M'.MutMsg s)) -set_Type'enum (Type_newtype_ struct) = do - H'.setWordField struct (15 :: Word16) 0 0 0 - pure $ Type'enum'group'_newtype_ struct -set_Type'struct :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'struct'group' (M'.MutMsg s)) -set_Type'struct (Type_newtype_ struct) = do - H'.setWordField struct (16 :: Word16) 0 0 0 - pure $ Type'struct'group'_newtype_ struct -set_Type'interface :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'interface'group' (M'.MutMsg s)) -set_Type'interface (Type_newtype_ struct) = do - H'.setWordField struct (17 :: Word16) 0 0 0 - pure $ Type'interface'group'_newtype_ struct -set_Type'anyPointer :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'anyPointer'group' (M'.MutMsg s)) -set_Type'anyPointer (Type_newtype_ struct) = do - H'.setWordField struct (18 :: Word16) 0 0 0 - pure $ Type'anyPointer'group'_newtype_ struct -set_Type'unknown' :: U'.RWCtx m s => Type (M'.MutMsg s) -> Word16 -> m () -set_Type'unknown'(Type_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 -newtype Type'list'group' msg = Type'list'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'list'group' msg) where - fromStruct = pure . Type'list'group'_newtype_ -instance C'.ToStruct msg (Type'list'group' msg) where - toStruct (Type'list'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'list'group' msg) where - fromPtr msg ptr = Type'list'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'list'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'list'group' msg) where - newtype List msg (Type'list'group' msg) = List_Type'list'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'list'group' l) = U'.length l - index i (List_Type'list'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'list'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'list'group' (M'.MutMsg s)) where - setIndex (Type'list'group'_newtype_ elt) i (List_Type'list'group' l) = U'.setIndex elt i l - newList msg len = List_Type'list'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'list'group' msg) msg where - message (Type'list'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'list'group' msg) msg where - messageDefault = Type'list'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'list'group' (M'.MutMsg s)) where - new msg = Type'list'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'list'group' msg)) where - fromPtr msg ptr = List_Type'list'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'list'group' l) = C'.toPtr l -get_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m (Type msg) -get_Type'list'elementType (Type'list'group'_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m Bool -has_Type'list'elementType(Type'list'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () -set_Type'list'elementType (Type'list'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) -new_Type'list'elementType struct = do - result <- C'.new (U'.message struct) - set_Type'list'elementType struct result - pure result -newtype Type'enum'group' msg = Type'enum'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'enum'group' msg) where - fromStruct = pure . Type'enum'group'_newtype_ -instance C'.ToStruct msg (Type'enum'group' msg) where - toStruct (Type'enum'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'enum'group' msg) where - fromPtr msg ptr = Type'enum'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'enum'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'enum'group' msg) where - newtype List msg (Type'enum'group' msg) = List_Type'enum'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'enum'group' l) = U'.length l - index i (List_Type'enum'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'enum'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'enum'group' (M'.MutMsg s)) where - setIndex (Type'enum'group'_newtype_ elt) i (List_Type'enum'group' l) = U'.setIndex elt i l - newList msg len = List_Type'enum'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'enum'group' msg) msg where - message (Type'enum'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'enum'group' msg) msg where - messageDefault = Type'enum'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'enum'group' (M'.MutMsg s)) where - new msg = Type'enum'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'enum'group' msg)) where - fromPtr msg ptr = List_Type'enum'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'enum'group' l) = C'.toPtr l -get_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Word64 -get_Type'enum'typeId (Type'enum'group'_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool -has_Type'enum'typeId(Type'enum'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Type'enum'typeId :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> Word64 -> m () -set_Type'enum'typeId (Type'enum'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -get_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m (Brand msg) -get_Type'enum'brand (Type'enum'group'_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool -has_Type'enum'brand(Type'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Type'enum'brand (Type'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Type'enum'brand struct = do - result <- C'.new (U'.message struct) - set_Type'enum'brand struct result - pure result -newtype Type'struct'group' msg = Type'struct'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'struct'group' msg) where - fromStruct = pure . Type'struct'group'_newtype_ -instance C'.ToStruct msg (Type'struct'group' msg) where - toStruct (Type'struct'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'struct'group' msg) where - fromPtr msg ptr = Type'struct'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'struct'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'struct'group' msg) where - newtype List msg (Type'struct'group' msg) = List_Type'struct'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'struct'group' l) = U'.length l - index i (List_Type'struct'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'struct'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'struct'group' (M'.MutMsg s)) where - setIndex (Type'struct'group'_newtype_ elt) i (List_Type'struct'group' l) = U'.setIndex elt i l - newList msg len = List_Type'struct'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'struct'group' msg) msg where - message (Type'struct'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'struct'group' msg) msg where - messageDefault = Type'struct'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'struct'group' (M'.MutMsg s)) where - new msg = Type'struct'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'struct'group' msg)) where - fromPtr msg ptr = List_Type'struct'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'struct'group' l) = C'.toPtr l -get_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Word64 -get_Type'struct'typeId (Type'struct'group'_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool -has_Type'struct'typeId(Type'struct'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Type'struct'typeId :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> Word64 -> m () -set_Type'struct'typeId (Type'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -get_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m (Brand msg) -get_Type'struct'brand (Type'struct'group'_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool -has_Type'struct'brand(Type'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Type'struct'brand (Type'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Type'struct'brand struct = do - result <- C'.new (U'.message struct) - set_Type'struct'brand struct result - pure result -newtype Type'interface'group' msg = Type'interface'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'interface'group' msg) where - fromStruct = pure . Type'interface'group'_newtype_ -instance C'.ToStruct msg (Type'interface'group' msg) where - toStruct (Type'interface'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'interface'group' msg) where - fromPtr msg ptr = Type'interface'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'interface'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'interface'group' msg) where - newtype List msg (Type'interface'group' msg) = List_Type'interface'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'interface'group' l) = U'.length l - index i (List_Type'interface'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'interface'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'interface'group' (M'.MutMsg s)) where - setIndex (Type'interface'group'_newtype_ elt) i (List_Type'interface'group' l) = U'.setIndex elt i l - newList msg len = List_Type'interface'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'interface'group' msg) msg where - message (Type'interface'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'interface'group' msg) msg where - messageDefault = Type'interface'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'interface'group' (M'.MutMsg s)) where - new msg = Type'interface'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'interface'group' msg)) where - fromPtr msg ptr = List_Type'interface'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'interface'group' l) = C'.toPtr l -get_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Word64 -get_Type'interface'typeId (Type'interface'group'_newtype_ struct) = H'.getWordField struct 1 0 0 -has_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool -has_Type'interface'typeId(Type'interface'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Type'interface'typeId :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> Word64 -> m () -set_Type'interface'typeId (Type'interface'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -get_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m (Brand msg) -get_Type'interface'brand (Type'interface'group'_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool -has_Type'interface'brand(Type'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () -set_Type'interface'brand (Type'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) -new_Type'interface'brand struct = do - result <- C'.new (U'.message struct) - set_Type'interface'brand struct result - pure result -newtype Type'anyPointer'group' msg = Type'anyPointer'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer'group' msg) where - fromStruct = pure . Type'anyPointer'group'_newtype_ -instance C'.ToStruct msg (Type'anyPointer'group' msg) where - toStruct (Type'anyPointer'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer'group' msg) where - fromPtr msg ptr = Type'anyPointer'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer'group' msg) where - newtype List msg (Type'anyPointer'group' msg) = List_Type'anyPointer'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer'group' l) = U'.length l - index i (List_Type'anyPointer'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer'group' (M'.MutMsg s)) where - setIndex (Type'anyPointer'group'_newtype_ elt) i (List_Type'anyPointer'group' l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer'group' msg) msg where - message (Type'anyPointer'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer'group' msg) msg where - messageDefault = Type'anyPointer'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer'group' (M'.MutMsg s)) where - new msg = Type'anyPointer'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer'group' msg)) where - fromPtr msg ptr = List_Type'anyPointer'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer'group' l) = C'.toPtr l -get_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m (Type'anyPointer msg) -get_Type'anyPointer'union' (Type'anyPointer'group'_newtype_ struct) = C'.fromStruct struct -has_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m Bool -has_Type'anyPointer'union'(Type'anyPointer'group'_newtype_ struct) = pure True -instance C'.FromStruct msg (Type' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 0 0 0 - case tag of - 18 -> Type'anyPointer <$> C'.fromStruct struct - 17 -> Type'interface <$> C'.fromStruct struct - 16 -> Type'struct <$> C'.fromStruct struct - 15 -> Type'enum <$> C'.fromStruct struct - 14 -> Type'list <$> C'.fromStruct struct - 13 -> pure Type'data_ - 12 -> pure Type'text - 11 -> pure Type'float64 - 10 -> pure Type'float32 - 9 -> pure Type'uint64 - 8 -> pure Type'uint32 - 7 -> pure Type'uint16 - 6 -> pure Type'uint8 - 5 -> pure Type'int64 - 4 -> pure Type'int32 - 3 -> pure Type'int16 - 2 -> pure Type'int8 - 1 -> pure Type'bool - 0 -> pure Type'void - _ -> pure $ Type'unknown' tag -newtype Value msg = Value_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Value msg) where - fromStruct = pure . Value_newtype_ -instance C'.ToStruct msg (Value msg) where - toStruct (Value_newtype_ struct) = struct -instance C'.IsPtr msg (Value msg) where - fromPtr msg ptr = Value_newtype_ <$> C'.fromPtr msg ptr - toPtr (Value_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Value msg) where - newtype List msg (Value msg) = List_Value (U'.ListOf msg (U'.Struct msg)) - length (List_Value l) = U'.length l - index i (List_Value l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Value msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Value (M'.MutMsg s)) where - setIndex (Value_newtype_ elt) i (List_Value l) = U'.setIndex elt i l - newList msg len = List_Value <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (Value msg) msg where - message (Value_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Value msg) msg where - messageDefault = Value_newtype_ . U'.messageDefault -instance C'.Allocate s (Value (M'.MutMsg s)) where - new msg = Value_newtype_ <$> U'.allocStruct msg 2 1 -instance C'.IsPtr msg (B'.List msg (Value msg)) where - fromPtr msg ptr = List_Value <$> C'.fromPtr msg ptr - toPtr (List_Value l) = C'.toPtr l -data Value' msg = - Value'void | - Value'bool Bool | - Value'int8 Int8 | - Value'int16 Int16 | - Value'int32 Int32 | - Value'int64 Int64 | - Value'uint8 Word8 | - Value'uint16 Word16 | - Value'uint32 Word32 | - Value'uint64 Word64 | - Value'float32 Float | - Value'float64 Double | - Value'text (B'.Text msg) | - Value'data_ (B'.Data msg) | - Value'list (Maybe (U'.Ptr msg)) | - Value'enum Word16 | - Value'struct (Maybe (U'.Ptr msg)) | - Value'interface | - Value'anyPointer (Maybe (U'.Ptr msg)) | - Value'unknown' Word16 -get_Value' :: U'.ReadCtx m msg => Value msg -> m (Value' msg) -get_Value' (Value_newtype_ struct) = C'.fromStruct struct -has_Value' :: U'.ReadCtx m msg => Value msg -> m Bool -has_Value'(Value_newtype_ struct) = pure True -set_Value'void :: U'.RWCtx m s => Value (M'.MutMsg s) -> m () -set_Value'void (Value_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 -set_Value'bool :: U'.RWCtx m s => Value (M'.MutMsg s) -> Bool -> m () -set_Value'bool (Value_newtype_ struct) value = do - H'.setWordField struct (1 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 16 0 -set_Value'int8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int8 -> m () -set_Value'int8 (Value_newtype_ struct) value = do - H'.setWordField struct (2 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 -set_Value'int16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int16 -> m () -set_Value'int16 (Value_newtype_ struct) value = do - H'.setWordField struct (3 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 -set_Value'int32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int32 -> m () -set_Value'int32 (Value_newtype_ struct) value = do - H'.setWordField struct (4 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 -set_Value'int64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int64 -> m () -set_Value'int64 (Value_newtype_ struct) value = do - H'.setWordField struct (5 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -set_Value'uint8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word8 -> m () -set_Value'uint8 (Value_newtype_ struct) value = do - H'.setWordField struct (6 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 -set_Value'uint16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () -set_Value'uint16 (Value_newtype_ struct) value = do - H'.setWordField struct (7 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 -set_Value'uint32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word32 -> m () -set_Value'uint32 (Value_newtype_ struct) value = do - H'.setWordField struct (8 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 -set_Value'uint64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word64 -> m () -set_Value'uint64 (Value_newtype_ struct) value = do - H'.setWordField struct (9 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -set_Value'float32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Float -> m () -set_Value'float32 (Value_newtype_ struct) value = do - H'.setWordField struct (10 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 -set_Value'float64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Double -> m () -set_Value'float64 (Value_newtype_ struct) value = do - H'.setWordField struct (11 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 -set_Value'text :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Value'text(Value_newtype_ struct) value = do - H'.setWordField struct (12 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -new_Value'text :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Value'text len struct = do - result <- B'.newText (U'.message struct) len - set_Value'text struct result - pure result -set_Value'data_ :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Data (M'.MutMsg s)) -> m () -set_Value'data_(Value_newtype_ struct) value = do - H'.setWordField struct (13 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -new_Value'data_ :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Data (M'.MutMsg s))) -new_Value'data_ len struct = do - result <- B'.newData (U'.message struct) len - set_Value'data_ struct result - pure result -set_Value'list :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () -set_Value'list(Value_newtype_ struct) value = do - H'.setWordField struct (14 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -set_Value'enum :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () -set_Value'enum (Value_newtype_ struct) value = do - H'.setWordField struct (15 :: Word16) 0 0 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 -set_Value'struct :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () -set_Value'struct(Value_newtype_ struct) value = do - H'.setWordField struct (16 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -set_Value'interface :: U'.RWCtx m s => Value (M'.MutMsg s) -> m () -set_Value'interface (Value_newtype_ struct) = H'.setWordField struct (17 :: Word16) 0 0 0 -set_Value'anyPointer :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () -set_Value'anyPointer(Value_newtype_ struct) value = do - H'.setWordField struct (18 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -set_Value'unknown' :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () -set_Value'unknown'(Value_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 -instance C'.FromStruct msg (Value' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 0 0 0 - case tag of - 18 -> Value'anyPointer <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 17 -> pure Value'interface - 16 -> Value'struct <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 15 -> Value'enum <$> H'.getWordField struct 0 16 0 - 14 -> Value'list <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 13 -> Value'data_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 12 -> Value'text <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 11 -> Value'float64 <$> H'.getWordField struct 1 0 0 - 10 -> Value'float32 <$> H'.getWordField struct 0 32 0 - 9 -> Value'uint64 <$> H'.getWordField struct 1 0 0 - 8 -> Value'uint32 <$> H'.getWordField struct 0 32 0 - 7 -> Value'uint16 <$> H'.getWordField struct 0 16 0 - 6 -> Value'uint8 <$> H'.getWordField struct 0 16 0 - 5 -> Value'int64 <$> H'.getWordField struct 1 0 0 - 4 -> Value'int32 <$> H'.getWordField struct 0 32 0 - 3 -> Value'int16 <$> H'.getWordField struct 0 16 0 - 2 -> Value'int8 <$> H'.getWordField struct 0 16 0 - 1 -> Value'bool <$> H'.getWordField struct 0 16 0 - 0 -> pure Value'void - _ -> pure $ Value'unknown' tag -newtype Brand'Binding msg = Brand'Binding_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Brand'Binding msg) where - fromStruct = pure . Brand'Binding_newtype_ -instance C'.ToStruct msg (Brand'Binding msg) where - toStruct (Brand'Binding_newtype_ struct) = struct -instance C'.IsPtr msg (Brand'Binding msg) where - fromPtr msg ptr = Brand'Binding_newtype_ <$> C'.fromPtr msg ptr - toPtr (Brand'Binding_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Brand'Binding msg) where - newtype List msg (Brand'Binding msg) = List_Brand'Binding (U'.ListOf msg (U'.Struct msg)) - length (List_Brand'Binding l) = U'.length l - index i (List_Brand'Binding l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Binding msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Brand'Binding (M'.MutMsg s)) where - setIndex (Brand'Binding_newtype_ elt) i (List_Brand'Binding l) = U'.setIndex elt i l - newList msg len = List_Brand'Binding <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Brand'Binding msg) msg where - message (Brand'Binding_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Brand'Binding msg) msg where - messageDefault = Brand'Binding_newtype_ . U'.messageDefault -instance C'.Allocate s (Brand'Binding (M'.MutMsg s)) where - new msg = Brand'Binding_newtype_ <$> U'.allocStruct msg 1 1 -instance C'.IsPtr msg (B'.List msg (Brand'Binding msg)) where - fromPtr msg ptr = List_Brand'Binding <$> C'.fromPtr msg ptr - toPtr (List_Brand'Binding l) = C'.toPtr l -data Brand'Binding' msg = - Brand'Binding'unbound | - Brand'Binding'type_ (Type msg) | - Brand'Binding'unknown' Word16 -get_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m (Brand'Binding' msg) -get_Brand'Binding' (Brand'Binding_newtype_ struct) = C'.fromStruct struct -has_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m Bool -has_Brand'Binding'(Brand'Binding_newtype_ struct) = pure True -set_Brand'Binding'unbound :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m () -set_Brand'Binding'unbound (Brand'Binding_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 -set_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () -set_Brand'Binding'type_(Brand'Binding_newtype_ struct) value = do - H'.setWordField struct (1 :: Word16) 0 0 0 - U'.setPtr (C'.toPtr value) 0 struct -new_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) -new_Brand'Binding'type_ struct = do - result <- C'.new (U'.message struct) - set_Brand'Binding'type_ struct result - pure result -set_Brand'Binding'unknown' :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> Word16 -> m () -set_Brand'Binding'unknown'(Brand'Binding_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 -instance C'.FromStruct msg (Brand'Binding' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 0 0 0 - case tag of - 1 -> Brand'Binding'type_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - 0 -> pure Brand'Binding'unbound - _ -> pure $ Brand'Binding'unknown' tag -newtype Brand'Scope msg = Brand'Scope_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Brand'Scope msg) where - fromStruct = pure . Brand'Scope_newtype_ -instance C'.ToStruct msg (Brand'Scope msg) where - toStruct (Brand'Scope_newtype_ struct) = struct -instance C'.IsPtr msg (Brand'Scope msg) where - fromPtr msg ptr = Brand'Scope_newtype_ <$> C'.fromPtr msg ptr - toPtr (Brand'Scope_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Brand'Scope msg) where - newtype List msg (Brand'Scope msg) = List_Brand'Scope (U'.ListOf msg (U'.Struct msg)) - length (List_Brand'Scope l) = U'.length l - index i (List_Brand'Scope l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Brand'Scope (M'.MutMsg s)) where - setIndex (Brand'Scope_newtype_ elt) i (List_Brand'Scope l) = U'.setIndex elt i l - newList msg len = List_Brand'Scope <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (Brand'Scope msg) msg where - message (Brand'Scope_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Brand'Scope msg) msg where - messageDefault = Brand'Scope_newtype_ . U'.messageDefault -instance C'.Allocate s (Brand'Scope (M'.MutMsg s)) where - new msg = Brand'Scope_newtype_ <$> U'.allocStruct msg 2 1 -instance C'.IsPtr msg (B'.List msg (Brand'Scope msg)) where - fromPtr msg ptr = List_Brand'Scope <$> C'.fromPtr msg ptr - toPtr (List_Brand'Scope l) = C'.toPtr l -get_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Word64 -get_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Bool -has_Brand'Scope'scopeId(Brand'Scope_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Brand'Scope'scopeId :: U'.RWCtx m s => Brand'Scope (M'.MutMsg s) -> Word64 -> m () -set_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m (Brand'Scope' msg) -get_Brand'Scope'union' (Brand'Scope_newtype_ struct) = C'.fromStruct struct -has_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m Bool -has_Brand'Scope'union'(Brand'Scope_newtype_ struct) = pure True -newtype Brand'Scope' msg = Brand'Scope'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Brand'Scope' msg) where - fromStruct = pure . Brand'Scope'_newtype_ -instance C'.ToStruct msg (Brand'Scope' msg) where - toStruct (Brand'Scope'_newtype_ struct) = struct -instance C'.IsPtr msg (Brand'Scope' msg) where - fromPtr msg ptr = Brand'Scope'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Brand'Scope'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Brand'Scope' msg) where - newtype List msg (Brand'Scope' msg) = List_Brand'Scope' (U'.ListOf msg (U'.Struct msg)) - length (List_Brand'Scope' l) = U'.length l - index i (List_Brand'Scope' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Brand'Scope' (M'.MutMsg s)) where - setIndex (Brand'Scope'_newtype_ elt) i (List_Brand'Scope' l) = U'.setIndex elt i l - newList msg len = List_Brand'Scope' <$> U'.allocCompositeList msg 2 1 len -instance U'.HasMessage (Brand'Scope' msg) msg where - message (Brand'Scope'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Brand'Scope' msg) msg where - messageDefault = Brand'Scope'_newtype_ . U'.messageDefault -instance C'.Allocate s (Brand'Scope' (M'.MutMsg s)) where - new msg = Brand'Scope'_newtype_ <$> U'.allocStruct msg 2 1 -instance C'.IsPtr msg (B'.List msg (Brand'Scope' msg)) where - fromPtr msg ptr = List_Brand'Scope' <$> C'.fromPtr msg ptr - toPtr (List_Brand'Scope' l) = C'.toPtr l -data Brand'Scope'' msg = - Brand'Scope'bind (B'.List msg (Brand'Binding msg)) | - Brand'Scope'inherit | - Brand'Scope'unknown' Word16 -get_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m (Brand'Scope'' msg) -get_Brand'Scope'' (Brand'Scope'_newtype_ struct) = C'.fromStruct struct -has_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m Bool -has_Brand'Scope''(Brand'Scope'_newtype_ struct) = pure True -set_Brand'Scope'bind :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))) -> m () -set_Brand'Scope'bind(Brand'Scope'_newtype_ struct) value = do - H'.setWordField struct (0 :: Word16) 1 0 0 - U'.setPtr (C'.toPtr value) 0 struct -new_Brand'Scope'bind :: U'.RWCtx m s => Int -> Brand'Scope' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s)))) -new_Brand'Scope'bind len struct = do - result <- C'.newList (U'.message struct) len - set_Brand'Scope'bind struct result - pure result -set_Brand'Scope'inherit :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> m () -set_Brand'Scope'inherit (Brand'Scope'_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 0 0 -set_Brand'Scope'unknown' :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> Word16 -> m () -set_Brand'Scope'unknown'(Brand'Scope'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 -instance C'.FromStruct msg (Brand'Scope'' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 1 0 0 - case tag of - 1 -> pure Brand'Scope'inherit - 0 -> Brand'Scope'bind <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) - _ -> pure $ Brand'Scope'unknown' tag -newtype CodeGeneratorRequest'RequestedFile msg = CodeGeneratorRequest'RequestedFile_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile msg) where - fromStruct = pure . CodeGeneratorRequest'RequestedFile_newtype_ -instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile msg) where - toStruct (CodeGeneratorRequest'RequestedFile_newtype_ struct) = struct -instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile msg) where - fromPtr msg ptr = CodeGeneratorRequest'RequestedFile_newtype_ <$> C'.fromPtr msg ptr - toPtr (CodeGeneratorRequest'RequestedFile_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile msg) where - newtype List msg (CodeGeneratorRequest'RequestedFile msg) = List_CodeGeneratorRequest'RequestedFile (U'.ListOf msg (U'.Struct msg)) - length (List_CodeGeneratorRequest'RequestedFile l) = U'.length l - index i (List_CodeGeneratorRequest'RequestedFile l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where - setIndex (CodeGeneratorRequest'RequestedFile_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile l) = U'.setIndex elt i l - newList msg len = List_CodeGeneratorRequest'RequestedFile <$> U'.allocCompositeList msg 1 2 len -instance U'.HasMessage (CodeGeneratorRequest'RequestedFile msg) msg where - message (CodeGeneratorRequest'RequestedFile_newtype_ struct) = U'.message struct -instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile msg) msg where - messageDefault = CodeGeneratorRequest'RequestedFile_newtype_ . U'.messageDefault -instance C'.Allocate s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where - new msg = CodeGeneratorRequest'RequestedFile_newtype_ <$> U'.allocStruct msg 1 2 -instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) where - fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile <$> C'.fromPtr msg ptr - toPtr (List_CodeGeneratorRequest'RequestedFile l) = C'.toPtr l -get_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Word64 -get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) = H'.getWordField struct 0 0 0 -has_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool -has_CodeGeneratorRequest'RequestedFile'id(CodeGeneratorRequest'RequestedFile_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_CodeGeneratorRequest'RequestedFile'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> Word64 -> m () -set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.Text msg) -get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool -has_CodeGeneratorRequest'RequestedFile'filename(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_CodeGeneratorRequest'RequestedFile'filename len struct = do - result <- B'.newText (U'.message struct) len - set_CodeGeneratorRequest'RequestedFile'filename struct result - pure result -get_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) -get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) = - U'.getPtr 1 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool -has_CodeGeneratorRequest'RequestedFile'imports(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct -set_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))) -> m () -set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct -new_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)))) -new_CodeGeneratorRequest'RequestedFile'imports len struct = do - result <- C'.newList (U'.message struct) len - set_CodeGeneratorRequest'RequestedFile'imports struct result - pure result -newtype CodeGeneratorRequest'RequestedFile'Import msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where - fromStruct = pure . CodeGeneratorRequest'RequestedFile'Import_newtype_ -instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where - toStruct (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = struct -instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile'Import msg) where - fromPtr msg ptr = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> C'.fromPtr msg ptr - toPtr (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg) where - newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg) = List_CodeGeneratorRequest'RequestedFile'Import (U'.ListOf msg (U'.Struct msg)) - length (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.length l - index i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where - setIndex (CodeGeneratorRequest'RequestedFile'Import_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.setIndex elt i l - newList msg len = List_CodeGeneratorRequest'RequestedFile'Import <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg) msg where - message (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = U'.message struct -instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg) msg where - messageDefault = CodeGeneratorRequest'RequestedFile'Import_newtype_ . U'.messageDefault -instance C'.Allocate s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where - new msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> U'.allocStruct msg 1 1 -instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) where - fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile'Import <$> C'.fromPtr msg ptr - toPtr (List_CodeGeneratorRequest'RequestedFile'Import l) = C'.toPtr l -get_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Word64 -get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = H'.getWordField struct 0 0 0 -has_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool -has_CodeGeneratorRequest'RequestedFile'Import'id(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_CodeGeneratorRequest'RequestedFile'Import'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> Word64 -> m () -set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -get_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m (B'.Text msg) -get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool -has_CodeGeneratorRequest'RequestedFile'Import'name(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_CodeGeneratorRequest'RequestedFile'Import'name len struct = do - result <- B'.newText (U'.message struct) len - set_CodeGeneratorRequest'RequestedFile'Import'name struct result - pure result -newtype Field' msg = Field'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Field' msg) where - fromStruct = pure . Field'_newtype_ -instance C'.ToStruct msg (Field' msg) where - toStruct (Field'_newtype_ struct) = struct -instance C'.IsPtr msg (Field' msg) where - fromPtr msg ptr = Field'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Field'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Field' msg) where - newtype List msg (Field' msg) = List_Field' (U'.ListOf msg (U'.Struct msg)) - length (List_Field' l) = U'.length l - index i (List_Field' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Field' (M'.MutMsg s)) where - setIndex (Field'_newtype_ elt) i (List_Field' l) = U'.setIndex elt i l - newList msg len = List_Field' <$> U'.allocCompositeList msg 3 4 len -instance U'.HasMessage (Field' msg) msg where - message (Field'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Field' msg) msg where - messageDefault = Field'_newtype_ . U'.messageDefault -instance C'.Allocate s (Field' (M'.MutMsg s)) where - new msg = Field'_newtype_ <$> U'.allocStruct msg 3 4 -instance C'.IsPtr msg (B'.List msg (Field' msg)) where - fromPtr msg ptr = List_Field' <$> C'.fromPtr msg ptr - toPtr (List_Field' l) = C'.toPtr l -data Field'' msg = - Field'slot (Field'slot'group' msg) | - Field'group (Field'group'group' msg) | - Field'unknown' Word16 -get_Field'' :: U'.ReadCtx m msg => Field' msg -> m (Field'' msg) -get_Field'' (Field'_newtype_ struct) = C'.fromStruct struct -has_Field'' :: U'.ReadCtx m msg => Field' msg -> m Bool -has_Field''(Field'_newtype_ struct) = pure True -set_Field'slot :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'slot'group' (M'.MutMsg s)) -set_Field'slot (Field'_newtype_ struct) = do - H'.setWordField struct (0 :: Word16) 1 0 0 - pure $ Field'slot'group'_newtype_ struct -set_Field'group :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'group'group' (M'.MutMsg s)) -set_Field'group (Field'_newtype_ struct) = do - H'.setWordField struct (1 :: Word16) 1 0 0 - pure $ Field'group'group'_newtype_ struct -set_Field'unknown' :: U'.RWCtx m s => Field' (M'.MutMsg s) -> Word16 -> m () -set_Field'unknown'(Field'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 -newtype Field'slot'group' msg = Field'slot'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Field'slot'group' msg) where - fromStruct = pure . Field'slot'group'_newtype_ -instance C'.ToStruct msg (Field'slot'group' msg) where - toStruct (Field'slot'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Field'slot'group' msg) where - fromPtr msg ptr = Field'slot'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Field'slot'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Field'slot'group' msg) where - newtype List msg (Field'slot'group' msg) = List_Field'slot'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Field'slot'group' l) = U'.length l - index i (List_Field'slot'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'slot'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Field'slot'group' (M'.MutMsg s)) where - setIndex (Field'slot'group'_newtype_ elt) i (List_Field'slot'group' l) = U'.setIndex elt i l - newList msg len = List_Field'slot'group' <$> U'.allocCompositeList msg 3 4 len -instance U'.HasMessage (Field'slot'group' msg) msg where - message (Field'slot'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Field'slot'group' msg) msg where - messageDefault = Field'slot'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Field'slot'group' (M'.MutMsg s)) where - new msg = Field'slot'group'_newtype_ <$> U'.allocStruct msg 3 4 -instance C'.IsPtr msg (B'.List msg (Field'slot'group' msg)) where - fromPtr msg ptr = List_Field'slot'group' <$> C'.fromPtr msg ptr - toPtr (List_Field'slot'group' l) = C'.toPtr l -get_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Word32 -get_Field'slot'offset (Field'slot'group'_newtype_ struct) = H'.getWordField struct 0 32 0 -has_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool -has_Field'slot'offset(Field'slot'group'_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Field'slot'offset :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Word32 -> m () -set_Field'slot'offset (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 -get_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Type msg) -get_Field'slot'type_ (Field'slot'group'_newtype_ struct) = - U'.getPtr 2 struct - >>= C'.fromPtr (U'.message struct) -has_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool -has_Field'slot'type_(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct -set_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () -set_Field'slot'type_ (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct -new_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) -new_Field'slot'type_ struct = do - result <- C'.new (U'.message struct) - set_Field'slot'type_ struct result - pure result -get_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Value msg) -get_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool -has_Field'slot'defaultValue(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () -set_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) -new_Field'slot'defaultValue struct = do - result <- C'.new (U'.message struct) - set_Field'slot'defaultValue struct result - pure result -get_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool -get_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool -has_Field'slot'hadExplicitDefault(Field'slot'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) -set_Field'slot'hadExplicitDefault :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Bool -> m () -set_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 2 0 0 -newtype Field'group'group' msg = Field'group'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Field'group'group' msg) where - fromStruct = pure . Field'group'group'_newtype_ -instance C'.ToStruct msg (Field'group'group' msg) where - toStruct (Field'group'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Field'group'group' msg) where - fromPtr msg ptr = Field'group'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Field'group'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Field'group'group' msg) where - newtype List msg (Field'group'group' msg) = List_Field'group'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Field'group'group' l) = U'.length l - index i (List_Field'group'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'group'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Field'group'group' (M'.MutMsg s)) where - setIndex (Field'group'group'_newtype_ elt) i (List_Field'group'group' l) = U'.setIndex elt i l - newList msg len = List_Field'group'group' <$> U'.allocCompositeList msg 3 4 len -instance U'.HasMessage (Field'group'group' msg) msg where - message (Field'group'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Field'group'group' msg) msg where - messageDefault = Field'group'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Field'group'group' (M'.MutMsg s)) where - new msg = Field'group'group'_newtype_ <$> U'.allocStruct msg 3 4 -instance C'.IsPtr msg (B'.List msg (Field'group'group' msg)) where - fromPtr msg ptr = List_Field'group'group' <$> C'.fromPtr msg ptr - toPtr (List_Field'group'group' l) = C'.toPtr l -get_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Word64 -get_Field'group'typeId (Field'group'group'_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Bool -has_Field'group'typeId(Field'group'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) -set_Field'group'typeId :: U'.RWCtx m s => Field'group'group' (M'.MutMsg s) -> Word64 -> m () -set_Field'group'typeId (Field'group'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 -instance C'.FromStruct msg (Field'' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 1 0 0 - case tag of - 1 -> Field'group <$> C'.fromStruct struct - 0 -> Field'slot <$> C'.fromStruct struct - _ -> pure $ Field'unknown' tag -field'noDiscriminant :: Word16 -field'noDiscriminant = C'.fromWord 65535 -newtype Field'ordinal msg = Field'ordinal_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Field'ordinal msg) where - fromStruct = pure . Field'ordinal_newtype_ -instance C'.ToStruct msg (Field'ordinal msg) where - toStruct (Field'ordinal_newtype_ struct) = struct -instance C'.IsPtr msg (Field'ordinal msg) where - fromPtr msg ptr = Field'ordinal_newtype_ <$> C'.fromPtr msg ptr - toPtr (Field'ordinal_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Field'ordinal msg) where - newtype List msg (Field'ordinal msg) = List_Field'ordinal (U'.ListOf msg (U'.Struct msg)) - length (List_Field'ordinal l) = U'.length l - index i (List_Field'ordinal l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field'ordinal msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Field'ordinal (M'.MutMsg s)) where - setIndex (Field'ordinal_newtype_ elt) i (List_Field'ordinal l) = U'.setIndex elt i l - newList msg len = List_Field'ordinal <$> U'.allocCompositeList msg 3 4 len -instance U'.HasMessage (Field'ordinal msg) msg where - message (Field'ordinal_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Field'ordinal msg) msg where - messageDefault = Field'ordinal_newtype_ . U'.messageDefault -instance C'.Allocate s (Field'ordinal (M'.MutMsg s)) where - new msg = Field'ordinal_newtype_ <$> U'.allocStruct msg 3 4 -instance C'.IsPtr msg (B'.List msg (Field'ordinal msg)) where - fromPtr msg ptr = List_Field'ordinal <$> C'.fromPtr msg ptr - toPtr (List_Field'ordinal l) = C'.toPtr l -data Field'ordinal' msg = - Field'ordinal'implicit | - Field'ordinal'explicit Word16 | - Field'ordinal'unknown' Word16 -get_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m (Field'ordinal' msg) -get_Field'ordinal' (Field'ordinal_newtype_ struct) = C'.fromStruct struct -has_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m Bool -has_Field'ordinal'(Field'ordinal_newtype_ struct) = pure True -set_Field'ordinal'implicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> m () -set_Field'ordinal'implicit (Field'ordinal_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0 -set_Field'ordinal'explicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m () -set_Field'ordinal'explicit (Field'ordinal_newtype_ struct) value = do - H'.setWordField struct (1 :: Word16) 1 16 0 - H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 32 0 -set_Field'ordinal'unknown' :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m () -set_Field'ordinal'unknown'(Field'ordinal_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0 -instance C'.FromStruct msg (Field'ordinal' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 1 16 0 - case tag of - 1 -> Field'ordinal'explicit <$> H'.getWordField struct 1 32 0 - 0 -> pure Field'ordinal'implicit - _ -> pure $ Field'ordinal'unknown' tag -newtype Node' msg = Node'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node' msg) where - fromStruct = pure . Node'_newtype_ -instance C'.ToStruct msg (Node' msg) where - toStruct (Node'_newtype_ struct) = struct -instance C'.IsPtr msg (Node' msg) where - fromPtr msg ptr = Node'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node' msg) where - newtype List msg (Node' msg) = List_Node' (U'.ListOf msg (U'.Struct msg)) - length (List_Node' l) = U'.length l - index i (List_Node' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node' (M'.MutMsg s)) where - setIndex (Node'_newtype_ elt) i (List_Node' l) = U'.setIndex elt i l - newList msg len = List_Node' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node' msg) msg where - message (Node'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node' msg) msg where - messageDefault = Node'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node' (M'.MutMsg s)) where - new msg = Node'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node' msg)) where - fromPtr msg ptr = List_Node' <$> C'.fromPtr msg ptr - toPtr (List_Node' l) = C'.toPtr l -data Node'' msg = - Node'file | - Node'struct (Node'struct'group' msg) | - Node'enum (Node'enum'group' msg) | - Node'interface (Node'interface'group' msg) | - Node'const (Node'const'group' msg) | - Node'annotation (Node'annotation'group' msg) | - Node'unknown' Word16 -get_Node'' :: U'.ReadCtx m msg => Node' msg -> m (Node'' msg) -get_Node'' (Node'_newtype_ struct) = C'.fromStruct struct -has_Node'' :: U'.ReadCtx m msg => Node' msg -> m Bool -has_Node''(Node'_newtype_ struct) = pure True -set_Node'file :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m () -set_Node'file (Node'_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 32 0 -set_Node'struct :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'struct'group' (M'.MutMsg s)) -set_Node'struct (Node'_newtype_ struct) = do - H'.setWordField struct (1 :: Word16) 1 32 0 - pure $ Node'struct'group'_newtype_ struct -set_Node'enum :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'enum'group' (M'.MutMsg s)) -set_Node'enum (Node'_newtype_ struct) = do - H'.setWordField struct (2 :: Word16) 1 32 0 - pure $ Node'enum'group'_newtype_ struct -set_Node'interface :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'interface'group' (M'.MutMsg s)) -set_Node'interface (Node'_newtype_ struct) = do - H'.setWordField struct (3 :: Word16) 1 32 0 - pure $ Node'interface'group'_newtype_ struct -set_Node'const :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'const'group' (M'.MutMsg s)) -set_Node'const (Node'_newtype_ struct) = do - H'.setWordField struct (4 :: Word16) 1 32 0 - pure $ Node'const'group'_newtype_ struct -set_Node'annotation :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'annotation'group' (M'.MutMsg s)) -set_Node'annotation (Node'_newtype_ struct) = do - H'.setWordField struct (5 :: Word16) 1 32 0 - pure $ Node'annotation'group'_newtype_ struct -set_Node'unknown' :: U'.RWCtx m s => Node' (M'.MutMsg s) -> Word16 -> m () -set_Node'unknown'(Node'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 32 0 -newtype Node'struct'group' msg = Node'struct'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'struct'group' msg) where - fromStruct = pure . Node'struct'group'_newtype_ -instance C'.ToStruct msg (Node'struct'group' msg) where - toStruct (Node'struct'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Node'struct'group' msg) where - fromPtr msg ptr = Node'struct'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'struct'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'struct'group' msg) where - newtype List msg (Node'struct'group' msg) = List_Node'struct'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Node'struct'group' l) = U'.length l - index i (List_Node'struct'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'struct'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'struct'group' (M'.MutMsg s)) where - setIndex (Node'struct'group'_newtype_ elt) i (List_Node'struct'group' l) = U'.setIndex elt i l - newList msg len = List_Node'struct'group' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node'struct'group' msg) msg where - message (Node'struct'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'struct'group' msg) msg where - messageDefault = Node'struct'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'struct'group' (M'.MutMsg s)) where - new msg = Node'struct'group'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node'struct'group' msg)) where - fromPtr msg ptr = List_Node'struct'group' <$> C'.fromPtr msg ptr - toPtr (List_Node'struct'group' l) = C'.toPtr l -get_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 -get_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 1 48 0 -has_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'dataWordCount(Node'struct'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'struct'dataWordCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () -set_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 48 0 -get_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 -get_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 0 0 -has_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'pointerCount(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct) -set_Node'struct'pointerCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () -set_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 0 0 -get_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m ElementSize -get_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 16 0 -has_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'preferredListEncoding(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct) -set_Node'struct'preferredListEncoding :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> ElementSize -> m () -set_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 16 0 -get_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -get_Node'struct'isGroup (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 32 0 -has_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'isGroup(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct) -set_Node'struct'isGroup :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Bool -> m () -set_Node'struct'isGroup (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 3 32 0 -get_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 -get_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 48 0 -has_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'discriminantCount(Node'struct'group'_newtype_ struct) = pure $ 3 < U'.length (U'.dataSection struct) -set_Node'struct'discriminantCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () -set_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 48 0 -get_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word32 -get_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) = H'.getWordField struct 4 0 0 -has_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'discriminantOffset(Node'struct'group'_newtype_ struct) = pure $ 4 < U'.length (U'.dataSection struct) -set_Node'struct'discriminantOffset :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word32 -> m () -set_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 4 0 0 -get_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m (B'.List msg (Field msg)) -get_Node'struct'fields (Node'struct'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool -has_Node'struct'fields(Node'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Node'struct'fields :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Field (M'.MutMsg s))) -> m () -set_Node'struct'fields (Node'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Node'struct'fields :: U'.RWCtx m s => Int -> Node'struct'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Field (M'.MutMsg s)))) -new_Node'struct'fields len struct = do - result <- C'.newList (U'.message struct) len - set_Node'struct'fields struct result - pure result -newtype Node'enum'group' msg = Node'enum'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'enum'group' msg) where - fromStruct = pure . Node'enum'group'_newtype_ -instance C'.ToStruct msg (Node'enum'group' msg) where - toStruct (Node'enum'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Node'enum'group' msg) where - fromPtr msg ptr = Node'enum'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'enum'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'enum'group' msg) where - newtype List msg (Node'enum'group' msg) = List_Node'enum'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Node'enum'group' l) = U'.length l - index i (List_Node'enum'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'enum'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'enum'group' (M'.MutMsg s)) where - setIndex (Node'enum'group'_newtype_ elt) i (List_Node'enum'group' l) = U'.setIndex elt i l - newList msg len = List_Node'enum'group' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node'enum'group' msg) msg where - message (Node'enum'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'enum'group' msg) msg where - messageDefault = Node'enum'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'enum'group' (M'.MutMsg s)) where - new msg = Node'enum'group'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node'enum'group' msg)) where - fromPtr msg ptr = List_Node'enum'group' <$> C'.fromPtr msg ptr - toPtr (List_Node'enum'group' l) = C'.toPtr l -get_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m (B'.List msg (Enumerant msg)) -get_Node'enum'enumerants (Node'enum'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m Bool -has_Node'enum'enumerants(Node'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Node'enum'enumerants :: U'.RWCtx m s => Node'enum'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))) -> m () -set_Node'enum'enumerants (Node'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Node'enum'enumerants :: U'.RWCtx m s => Int -> Node'enum'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s)))) -new_Node'enum'enumerants len struct = do - result <- C'.newList (U'.message struct) len - set_Node'enum'enumerants struct result - pure result -newtype Node'interface'group' msg = Node'interface'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'interface'group' msg) where - fromStruct = pure . Node'interface'group'_newtype_ -instance C'.ToStruct msg (Node'interface'group' msg) where - toStruct (Node'interface'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Node'interface'group' msg) where - fromPtr msg ptr = Node'interface'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'interface'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'interface'group' msg) where - newtype List msg (Node'interface'group' msg) = List_Node'interface'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Node'interface'group' l) = U'.length l - index i (List_Node'interface'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'interface'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'interface'group' (M'.MutMsg s)) where - setIndex (Node'interface'group'_newtype_ elt) i (List_Node'interface'group' l) = U'.setIndex elt i l - newList msg len = List_Node'interface'group' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node'interface'group' msg) msg where - message (Node'interface'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'interface'group' msg) msg where - messageDefault = Node'interface'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'interface'group' (M'.MutMsg s)) where - new msg = Node'interface'group'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node'interface'group' msg)) where - fromPtr msg ptr = List_Node'interface'group' <$> C'.fromPtr msg ptr - toPtr (List_Node'interface'group' l) = C'.toPtr l -get_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Method msg)) -get_Node'interface'methods (Node'interface'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool -has_Node'interface'methods(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Node'interface'methods :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Method (M'.MutMsg s))) -> m () -set_Node'interface'methods (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Node'interface'methods :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Method (M'.MutMsg s)))) -new_Node'interface'methods len struct = do - result <- C'.newList (U'.message struct) len - set_Node'interface'methods struct result - pure result -get_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Superclass msg)) -get_Node'interface'superclasses (Node'interface'group'_newtype_ struct) = - U'.getPtr 4 struct - >>= C'.fromPtr (U'.message struct) -has_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool -has_Node'interface'superclasses(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct -set_Node'interface'superclasses :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))) -> m () -set_Node'interface'superclasses (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct -new_Node'interface'superclasses :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s)))) -new_Node'interface'superclasses len struct = do - result <- C'.newList (U'.message struct) len - set_Node'interface'superclasses struct result - pure result -newtype Node'const'group' msg = Node'const'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'const'group' msg) where - fromStruct = pure . Node'const'group'_newtype_ -instance C'.ToStruct msg (Node'const'group' msg) where - toStruct (Node'const'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Node'const'group' msg) where - fromPtr msg ptr = Node'const'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'const'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'const'group' msg) where - newtype List msg (Node'const'group' msg) = List_Node'const'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Node'const'group' l) = U'.length l - index i (List_Node'const'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'const'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'const'group' (M'.MutMsg s)) where - setIndex (Node'const'group'_newtype_ elt) i (List_Node'const'group' l) = U'.setIndex elt i l - newList msg len = List_Node'const'group' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node'const'group' msg) msg where - message (Node'const'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'const'group' msg) msg where - messageDefault = Node'const'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'const'group' (M'.MutMsg s)) where - new msg = Node'const'group'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node'const'group' msg)) where - fromPtr msg ptr = List_Node'const'group' <$> C'.fromPtr msg ptr - toPtr (List_Node'const'group' l) = C'.toPtr l -get_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m (Type msg) -get_Node'const'type_ (Node'const'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool -has_Node'const'type_(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () -set_Node'const'type_ (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) -new_Node'const'type_ struct = do - result <- C'.new (U'.message struct) - set_Node'const'type_ struct result - pure result -get_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m (Value msg) -get_Node'const'value (Node'const'group'_newtype_ struct) = - U'.getPtr 4 struct - >>= C'.fromPtr (U'.message struct) -has_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool -has_Node'const'value(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct -set_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () -set_Node'const'value (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct -new_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) -new_Node'const'value struct = do - result <- C'.new (U'.message struct) - set_Node'const'value struct result - pure result -newtype Node'annotation'group' msg = Node'annotation'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'annotation'group' msg) where - fromStruct = pure . Node'annotation'group'_newtype_ -instance C'.ToStruct msg (Node'annotation'group' msg) where - toStruct (Node'annotation'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Node'annotation'group' msg) where - fromPtr msg ptr = Node'annotation'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'annotation'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'annotation'group' msg) where - newtype List msg (Node'annotation'group' msg) = List_Node'annotation'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Node'annotation'group' l) = U'.length l - index i (List_Node'annotation'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'annotation'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'annotation'group' (M'.MutMsg s)) where - setIndex (Node'annotation'group'_newtype_ elt) i (List_Node'annotation'group' l) = U'.setIndex elt i l - newList msg len = List_Node'annotation'group' <$> U'.allocCompositeList msg 5 6 len -instance U'.HasMessage (Node'annotation'group' msg) msg where - message (Node'annotation'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'annotation'group' msg) msg where - messageDefault = Node'annotation'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'annotation'group' (M'.MutMsg s)) where - new msg = Node'annotation'group'_newtype_ <$> U'.allocStruct msg 5 6 -instance C'.IsPtr msg (B'.List msg (Node'annotation'group' msg)) where - fromPtr msg ptr = List_Node'annotation'group' <$> C'.fromPtr msg ptr - toPtr (List_Node'annotation'group' l) = C'.toPtr l -get_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m (Type msg) -get_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) = - U'.getPtr 3 struct - >>= C'.fromPtr (U'.message struct) -has_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'type_(Node'annotation'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct -set_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () -set_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct -new_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) -new_Node'annotation'type_ struct = do - result <- C'.new (U'.message struct) - set_Node'annotation'type_ struct result - pure result -get_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 48 0 -has_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsFile(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsFile :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 48 0 -get_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 49 0 -has_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsConst(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsConst :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 49 0 -get_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 50 0 -has_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsEnum(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsEnum :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 50 0 -get_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 51 0 -has_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsEnumerant(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsEnumerant :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 51 0 -get_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 52 0 -has_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsStruct(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsStruct :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 52 0 -get_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 53 0 -has_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsField(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsField :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 53 0 -get_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 54 0 -has_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsUnion(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsUnion :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 54 0 -get_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 55 0 -has_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsGroup(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsGroup :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 55 0 -get_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 56 0 -has_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsInterface(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsInterface :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 56 0 -get_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 57 0 -has_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsMethod(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsMethod :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 57 0 -get_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 58 0 -has_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsParam(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsParam :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 58 0 -get_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -get_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 59 0 -has_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool -has_Node'annotation'targetsAnnotation(Node'annotation'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Node'annotation'targetsAnnotation :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () -set_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 59 0 -instance C'.FromStruct msg (Node'' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 1 32 0 - case tag of - 5 -> Node'annotation <$> C'.fromStruct struct - 4 -> Node'const <$> C'.fromStruct struct - 3 -> Node'interface <$> C'.fromStruct struct - 2 -> Node'enum <$> C'.fromStruct struct - 1 -> Node'struct <$> C'.fromStruct struct - 0 -> pure Node'file - _ -> pure $ Node'unknown' tag -newtype Node'NestedNode msg = Node'NestedNode_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'NestedNode msg) where - fromStruct = pure . Node'NestedNode_newtype_ -instance C'.ToStruct msg (Node'NestedNode msg) where - toStruct (Node'NestedNode_newtype_ struct) = struct -instance C'.IsPtr msg (Node'NestedNode msg) where - fromPtr msg ptr = Node'NestedNode_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'NestedNode_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'NestedNode msg) where - newtype List msg (Node'NestedNode msg) = List_Node'NestedNode (U'.ListOf msg (U'.Struct msg)) - length (List_Node'NestedNode l) = U'.length l - index i (List_Node'NestedNode l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'NestedNode msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'NestedNode (M'.MutMsg s)) where - setIndex (Node'NestedNode_newtype_ elt) i (List_Node'NestedNode l) = U'.setIndex elt i l - newList msg len = List_Node'NestedNode <$> U'.allocCompositeList msg 1 1 len -instance U'.HasMessage (Node'NestedNode msg) msg where - message (Node'NestedNode_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'NestedNode msg) msg where - messageDefault = Node'NestedNode_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'NestedNode (M'.MutMsg s)) where - new msg = Node'NestedNode_newtype_ <$> U'.allocStruct msg 1 1 -instance C'.IsPtr msg (B'.List msg (Node'NestedNode msg)) where - fromPtr msg ptr = List_Node'NestedNode <$> C'.fromPtr msg ptr - toPtr (List_Node'NestedNode l) = C'.toPtr l -get_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m (B'.Text msg) -get_Node'NestedNode'name (Node'NestedNode_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool -has_Node'NestedNode'name(Node'NestedNode_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Node'NestedNode'name :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Node'NestedNode'name (Node'NestedNode_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Node'NestedNode'name :: U'.RWCtx m s => Int -> Node'NestedNode (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Node'NestedNode'name len struct = do - result <- B'.newText (U'.message struct) len - set_Node'NestedNode'name struct result - pure result -get_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Word64 -get_Node'NestedNode'id (Node'NestedNode_newtype_ struct) = H'.getWordField struct 0 0 0 -has_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool -has_Node'NestedNode'id(Node'NestedNode_newtype_ struct) = pure $ 0 < U'.length (U'.dataSection struct) -set_Node'NestedNode'id :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> Word64 -> m () -set_Node'NestedNode'id (Node'NestedNode_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 -newtype Node'Parameter msg = Node'Parameter_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Node'Parameter msg) where - fromStruct = pure . Node'Parameter_newtype_ -instance C'.ToStruct msg (Node'Parameter msg) where - toStruct (Node'Parameter_newtype_ struct) = struct -instance C'.IsPtr msg (Node'Parameter msg) where - fromPtr msg ptr = Node'Parameter_newtype_ <$> C'.fromPtr msg ptr - toPtr (Node'Parameter_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Node'Parameter msg) where - newtype List msg (Node'Parameter msg) = List_Node'Parameter (U'.ListOf msg (U'.Struct msg)) - length (List_Node'Parameter l) = U'.length l - index i (List_Node'Parameter l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'Parameter msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Node'Parameter (M'.MutMsg s)) where - setIndex (Node'Parameter_newtype_ elt) i (List_Node'Parameter l) = U'.setIndex elt i l - newList msg len = List_Node'Parameter <$> U'.allocCompositeList msg 0 1 len -instance U'.HasMessage (Node'Parameter msg) msg where - message (Node'Parameter_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Node'Parameter msg) msg where - messageDefault = Node'Parameter_newtype_ . U'.messageDefault -instance C'.Allocate s (Node'Parameter (M'.MutMsg s)) where - new msg = Node'Parameter_newtype_ <$> U'.allocStruct msg 0 1 -instance C'.IsPtr msg (B'.List msg (Node'Parameter msg)) where - fromPtr msg ptr = List_Node'Parameter <$> C'.fromPtr msg ptr - toPtr (List_Node'Parameter l) = C'.toPtr l -get_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m (B'.Text msg) -get_Node'Parameter'name (Node'Parameter_newtype_ struct) = - U'.getPtr 0 struct - >>= C'.fromPtr (U'.message struct) -has_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m Bool -has_Node'Parameter'name(Node'Parameter_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct -set_Node'Parameter'name :: U'.RWCtx m s => Node'Parameter (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () -set_Node'Parameter'name (Node'Parameter_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct -new_Node'Parameter'name :: U'.RWCtx m s => Int -> Node'Parameter (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) -new_Node'Parameter'name len struct = do - result <- B'.newText (U'.message struct) len - set_Node'Parameter'name struct result - pure result -newtype Type'anyPointer msg = Type'anyPointer_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer msg) where - fromStruct = pure . Type'anyPointer_newtype_ -instance C'.ToStruct msg (Type'anyPointer msg) where - toStruct (Type'anyPointer_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer msg) where - fromPtr msg ptr = Type'anyPointer_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer msg) where - newtype List msg (Type'anyPointer msg) = List_Type'anyPointer (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer l) = U'.length l - index i (List_Type'anyPointer l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer (M'.MutMsg s)) where - setIndex (Type'anyPointer_newtype_ elt) i (List_Type'anyPointer l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer msg) msg where - message (Type'anyPointer_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer msg) msg where - messageDefault = Type'anyPointer_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer (M'.MutMsg s)) where - new msg = Type'anyPointer_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer msg)) where - fromPtr msg ptr = List_Type'anyPointer <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer l) = C'.toPtr l -data Type'anyPointer' msg = - Type'anyPointer'unconstrained (Type'anyPointer'unconstrained'group' msg) | - Type'anyPointer'parameter (Type'anyPointer'parameter'group' msg) | - Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter'group' msg) | - Type'anyPointer'unknown' Word16 -get_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m (Type'anyPointer' msg) -get_Type'anyPointer' (Type'anyPointer_newtype_ struct) = C'.fromStruct struct -has_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m Bool -has_Type'anyPointer'(Type'anyPointer_newtype_ struct) = pure True -set_Type'anyPointer'unconstrained :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) -set_Type'anyPointer'unconstrained (Type'anyPointer_newtype_ struct) = do - H'.setWordField struct (0 :: Word16) 1 0 0 - pure $ Type'anyPointer'unconstrained'group'_newtype_ struct -set_Type'anyPointer'parameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'parameter'group' (M'.MutMsg s)) -set_Type'anyPointer'parameter (Type'anyPointer_newtype_ struct) = do - H'.setWordField struct (1 :: Word16) 1 0 0 - pure $ Type'anyPointer'parameter'group'_newtype_ struct -set_Type'anyPointer'implicitMethodParameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) -set_Type'anyPointer'implicitMethodParameter (Type'anyPointer_newtype_ struct) = do - H'.setWordField struct (2 :: Word16) 1 0 0 - pure $ Type'anyPointer'implicitMethodParameter'group'_newtype_ struct -set_Type'anyPointer'unknown' :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> Word16 -> m () -set_Type'anyPointer'unknown'(Type'anyPointer_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 -newtype Type'anyPointer'unconstrained'group' msg = Type'anyPointer'unconstrained'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer'unconstrained'group' msg) where - fromStruct = pure . Type'anyPointer'unconstrained'group'_newtype_ -instance C'.ToStruct msg (Type'anyPointer'unconstrained'group' msg) where - toStruct (Type'anyPointer'unconstrained'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer'unconstrained'group' msg) where - fromPtr msg ptr = Type'anyPointer'unconstrained'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer'unconstrained'group' msg) where - newtype List msg (Type'anyPointer'unconstrained'group' msg) = List_Type'anyPointer'unconstrained'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer'unconstrained'group' l) = U'.length l - index i (List_Type'anyPointer'unconstrained'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'unconstrained'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) where - setIndex (Type'anyPointer'unconstrained'group'_newtype_ elt) i (List_Type'anyPointer'unconstrained'group' l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer'unconstrained'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer'unconstrained'group' msg) msg where - message (Type'anyPointer'unconstrained'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer'unconstrained'group' msg) msg where - messageDefault = Type'anyPointer'unconstrained'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) where - new msg = Type'anyPointer'unconstrained'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer'unconstrained'group' msg)) where - fromPtr msg ptr = List_Type'anyPointer'unconstrained'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer'unconstrained'group' l) = C'.toPtr l -get_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m (Type'anyPointer'unconstrained msg) -get_Type'anyPointer'unconstrained'union' (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.fromStruct struct -has_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m Bool -has_Type'anyPointer'unconstrained'union'(Type'anyPointer'unconstrained'group'_newtype_ struct) = pure True -newtype Type'anyPointer'parameter'group' msg = Type'anyPointer'parameter'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer'parameter'group' msg) where - fromStruct = pure . Type'anyPointer'parameter'group'_newtype_ -instance C'.ToStruct msg (Type'anyPointer'parameter'group' msg) where - toStruct (Type'anyPointer'parameter'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer'parameter'group' msg) where - fromPtr msg ptr = Type'anyPointer'parameter'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer'parameter'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer'parameter'group' msg) where - newtype List msg (Type'anyPointer'parameter'group' msg) = List_Type'anyPointer'parameter'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer'parameter'group' l) = U'.length l - index i (List_Type'anyPointer'parameter'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'parameter'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer'parameter'group' (M'.MutMsg s)) where - setIndex (Type'anyPointer'parameter'group'_newtype_ elt) i (List_Type'anyPointer'parameter'group' l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer'parameter'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer'parameter'group' msg) msg where - message (Type'anyPointer'parameter'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer'parameter'group' msg) msg where - messageDefault = Type'anyPointer'parameter'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer'parameter'group' (M'.MutMsg s)) where - new msg = Type'anyPointer'parameter'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer'parameter'group' msg)) where - fromPtr msg ptr = List_Type'anyPointer'parameter'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer'parameter'group' l) = C'.toPtr l -get_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word64 -get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 2 0 0 -has_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Bool -has_Type'anyPointer'parameter'scopeId(Type'anyPointer'parameter'group'_newtype_ struct) = pure $ 2 < U'.length (U'.dataSection struct) -set_Type'anyPointer'parameter'scopeId :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word64 -> m () -set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 -get_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word16 -get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0 -has_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Bool -has_Type'anyPointer'parameter'parameterIndex(Type'anyPointer'parameter'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Type'anyPointer'parameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word16 -> m () -set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0 -newtype Type'anyPointer'implicitMethodParameter'group' msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where - fromStruct = pure . Type'anyPointer'implicitMethodParameter'group'_newtype_ -instance C'.ToStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where - toStruct (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer'implicitMethodParameter'group' msg) where - fromPtr msg ptr = Type'anyPointer'implicitMethodParameter'group'_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer'implicitMethodParameter'group' msg) where - newtype List msg (Type'anyPointer'implicitMethodParameter'group' msg) = List_Type'anyPointer'implicitMethodParameter'group' (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.length l - index i (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'implicitMethodParameter'group' msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) where - setIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ elt) i (List_Type'anyPointer'implicitMethodParameter'group' l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer'implicitMethodParameter'group' <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer'implicitMethodParameter'group' msg) msg where - message (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer'implicitMethodParameter'group' msg) msg where - messageDefault = Type'anyPointer'implicitMethodParameter'group'_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) where - new msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer'implicitMethodParameter'group' msg)) where - fromPtr msg ptr = List_Type'anyPointer'implicitMethodParameter'group' <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer'implicitMethodParameter'group' l) = C'.toPtr l -get_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Word16 -get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0 -has_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Bool -has_Type'anyPointer'implicitMethodParameter'parameterIndex(Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = pure $ 1 < U'.length (U'.dataSection struct) -set_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s) -> Word16 -> m () -set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0 -instance C'.FromStruct msg (Type'anyPointer' msg) where - fromStruct struct = do - tag <- H'.getWordField struct 1 0 0 - case tag of - 2 -> Type'anyPointer'implicitMethodParameter <$> C'.fromStruct struct - 1 -> Type'anyPointer'parameter <$> C'.fromStruct struct - 0 -> Type'anyPointer'unconstrained <$> C'.fromStruct struct - _ -> pure $ Type'anyPointer'unknown' tag -newtype Type'anyPointer'unconstrained msg = Type'anyPointer'unconstrained_newtype_ (U'.Struct msg) -instance C'.FromStruct msg (Type'anyPointer'unconstrained msg) where - fromStruct = pure . Type'anyPointer'unconstrained_newtype_ -instance C'.ToStruct msg (Type'anyPointer'unconstrained msg) where - toStruct (Type'anyPointer'unconstrained_newtype_ struct) = struct -instance C'.IsPtr msg (Type'anyPointer'unconstrained msg) where - fromPtr msg ptr = Type'anyPointer'unconstrained_newtype_ <$> C'.fromPtr msg ptr - toPtr (Type'anyPointer'unconstrained_newtype_ struct) = C'.toPtr struct -instance B'.ListElem msg (Type'anyPointer'unconstrained msg) where - newtype List msg (Type'anyPointer'unconstrained msg) = List_Type'anyPointer'unconstrained (U'.ListOf msg (U'.Struct msg)) - length (List_Type'anyPointer'unconstrained l) = U'.length l - index i (List_Type'anyPointer'unconstrained l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type'anyPointer'unconstrained msg); go = C'.fromStruct} in go) -instance B'.MutListElem s (Type'anyPointer'unconstrained (M'.MutMsg s)) where - setIndex (Type'anyPointer'unconstrained_newtype_ elt) i (List_Type'anyPointer'unconstrained l) = U'.setIndex elt i l - newList msg len = List_Type'anyPointer'unconstrained <$> U'.allocCompositeList msg 3 1 len -instance U'.HasMessage (Type'anyPointer'unconstrained msg) msg where - message (Type'anyPointer'unconstrained_newtype_ struct) = U'.message struct -instance U'.MessageDefault (Type'anyPointer'unconstrained msg) msg where - messageDefault = Type'anyPointer'unconstrained_newtype_ . U'.messageDefault -instance C'.Allocate s (Type'anyPointer'unconstrained (M'.MutMsg s)) where - new msg = Type'anyPointer'unconstrained_newtype_ <$> U'.allocStruct msg 3 1 -instance C'.IsPtr msg (B'.List msg (Type'anyPointer'unconstrained msg)) where - fromPtr msg ptr = List_Type'anyPointer'unconstrained <$> C'.fromPtr msg ptr - toPtr (List_Type'anyPointer'unconstrained l) = C'.toPtr l -data Type'anyPointer'unconstrained' msg = - Type'anyPointer'unconstrained'anyKind | - Type'anyPointer'unconstrained'struct | - Type'anyPointer'unconstrained'list | - Type'anyPointer'unconstrained'capability | - Type'anyPointer'unconstrained'unknown' Word16 -get_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m (Type'anyPointer'unconstrained' msg) -get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained_newtype_ struct) = C'.fromStruct struct -has_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m Bool -has_Type'anyPointer'unconstrained'(Type'anyPointer'unconstrained_newtype_ struct) = pure True +import qualified Data.ByteString +import qualified Data.Capnp.Classes as C' +import qualified Data.Capnp.Basics as B' +import qualified Data.Capnp.GenHelpers as H' +import qualified Data.Capnp.TraversalLimit as TL' +import qualified Data.Capnp.Untyped as U' +import qualified Data.Capnp.Message as M' +import qualified Capnp.ById.Xbdf87d7bb8304e81 +newtype Annotation msg = Annotation_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Annotation msg) where + fromStruct = pure . Annotation_newtype_ +instance C'.ToStruct msg (Annotation msg) where + toStruct (Annotation_newtype_ struct) = struct +instance U'.HasMessage (Annotation msg) where + type InMessage (Annotation msg) = msg + message (Annotation_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Annotation msg) where + messageDefault = Annotation_newtype_ . U'.messageDefault +instance B'.ListElem msg (Annotation msg) where + newtype List msg (Annotation msg) = List_Annotation (U'.ListOf msg (U'.Struct msg)) + length (List_Annotation l) = U'.length l + index i (List_Annotation l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Annotation msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Annotation msg) where + fromPtr msg ptr = Annotation_newtype_ <$> C'.fromPtr msg ptr + toPtr (Annotation_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Annotation (M'.MutMsg s)) where + setIndex (Annotation_newtype_ elt) i (List_Annotation l) = U'.setIndex elt i l + newList msg len = List_Annotation <$> U'.allocCompositeList msg 1 2 len +instance C'.Allocate s (Annotation (M'.MutMsg s)) where + new msg = Annotation_newtype_ <$> U'.allocStruct msg 1 2 +instance C'.IsPtr msg (B'.List msg (Annotation msg)) where + fromPtr msg ptr = List_Annotation <$> C'.fromPtr msg ptr + toPtr (List_Annotation l) = C'.toPtr l +get_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Word64 +get_Annotation'id (Annotation_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Annotation'id :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> Word64 -> m () +set_Annotation'id (Annotation_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m (Value msg) +get_Annotation'value (Annotation_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m Bool +has_Annotation'value(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () +set_Annotation'value (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) +new_Annotation'value struct = do + result <- C'.new (U'.message struct) + set_Annotation'value struct result + pure result +get_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m (Brand msg) +get_Annotation'brand (Annotation_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m Bool +has_Annotation'brand(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Annotation'brand (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Annotation'brand struct = do + result <- C'.new (U'.message struct) + set_Annotation'brand struct result + pure result +newtype Brand msg = Brand_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Brand msg) where + fromStruct = pure . Brand_newtype_ +instance C'.ToStruct msg (Brand msg) where + toStruct (Brand_newtype_ struct) = struct +instance U'.HasMessage (Brand msg) where + type InMessage (Brand msg) = msg + message (Brand_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Brand msg) where + messageDefault = Brand_newtype_ . U'.messageDefault +instance B'.ListElem msg (Brand msg) where + newtype List msg (Brand msg) = List_Brand (U'.ListOf msg (U'.Struct msg)) + length (List_Brand l) = U'.length l + index i (List_Brand l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Brand msg) where + fromPtr msg ptr = Brand_newtype_ <$> C'.fromPtr msg ptr + toPtr (Brand_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Brand (M'.MutMsg s)) where + setIndex (Brand_newtype_ elt) i (List_Brand l) = U'.setIndex elt i l + newList msg len = List_Brand <$> U'.allocCompositeList msg 0 1 len +instance C'.Allocate s (Brand (M'.MutMsg s)) where + new msg = Brand_newtype_ <$> U'.allocStruct msg 0 1 +instance C'.IsPtr msg (B'.List msg (Brand msg)) where + fromPtr msg ptr = List_Brand <$> C'.fromPtr msg ptr + toPtr (List_Brand l) = C'.toPtr l +get_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m (B'.List msg (Brand'Scope msg)) +get_Brand'scopes (Brand_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m Bool +has_Brand'scopes(Brand_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Brand'scopes :: U'.RWCtx m s => Brand (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))) -> m () +set_Brand'scopes (Brand_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Brand'scopes :: U'.RWCtx m s => Int -> Brand (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s)))) +new_Brand'scopes len struct = do + result <- C'.newList (U'.message struct) len + set_Brand'scopes struct result + pure result +newtype CapnpVersion msg = CapnpVersion_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (CapnpVersion msg) where + fromStruct = pure . CapnpVersion_newtype_ +instance C'.ToStruct msg (CapnpVersion msg) where + toStruct (CapnpVersion_newtype_ struct) = struct +instance U'.HasMessage (CapnpVersion msg) where + type InMessage (CapnpVersion msg) = msg + message (CapnpVersion_newtype_ struct) = U'.message struct +instance U'.MessageDefault (CapnpVersion msg) where + messageDefault = CapnpVersion_newtype_ . U'.messageDefault +instance B'.ListElem msg (CapnpVersion msg) where + newtype List msg (CapnpVersion msg) = List_CapnpVersion (U'.ListOf msg (U'.Struct msg)) + length (List_CapnpVersion l) = U'.length l + index i (List_CapnpVersion l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapnpVersion msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (CapnpVersion msg) where + fromPtr msg ptr = CapnpVersion_newtype_ <$> C'.fromPtr msg ptr + toPtr (CapnpVersion_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (CapnpVersion (M'.MutMsg s)) where + setIndex (CapnpVersion_newtype_ elt) i (List_CapnpVersion l) = U'.setIndex elt i l + newList msg len = List_CapnpVersion <$> U'.allocCompositeList msg 1 0 len +instance C'.Allocate s (CapnpVersion (M'.MutMsg s)) where + new msg = CapnpVersion_newtype_ <$> U'.allocStruct msg 1 0 +instance C'.IsPtr msg (B'.List msg (CapnpVersion msg)) where + fromPtr msg ptr = List_CapnpVersion <$> C'.fromPtr msg ptr + toPtr (List_CapnpVersion l) = C'.toPtr l +get_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Word16 +get_CapnpVersion'major (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 0 0 +set_CapnpVersion'major :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word16 -> m () +set_CapnpVersion'major (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 +get_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8 +get_CapnpVersion'minor (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 16 0 +set_CapnpVersion'minor :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m () +set_CapnpVersion'minor (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 +get_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8 +get_CapnpVersion'micro (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 24 0 +set_CapnpVersion'micro :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m () +set_CapnpVersion'micro (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 24 0 +newtype CodeGeneratorRequest msg = CodeGeneratorRequest_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (CodeGeneratorRequest msg) where + fromStruct = pure . CodeGeneratorRequest_newtype_ +instance C'.ToStruct msg (CodeGeneratorRequest msg) where + toStruct (CodeGeneratorRequest_newtype_ struct) = struct +instance U'.HasMessage (CodeGeneratorRequest msg) where + type InMessage (CodeGeneratorRequest msg) = msg + message (CodeGeneratorRequest_newtype_ struct) = U'.message struct +instance U'.MessageDefault (CodeGeneratorRequest msg) where + messageDefault = CodeGeneratorRequest_newtype_ . U'.messageDefault +instance B'.ListElem msg (CodeGeneratorRequest msg) where + newtype List msg (CodeGeneratorRequest msg) = List_CodeGeneratorRequest (U'.ListOf msg (U'.Struct msg)) + length (List_CodeGeneratorRequest l) = U'.length l + index i (List_CodeGeneratorRequest l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (CodeGeneratorRequest msg) where + fromPtr msg ptr = CodeGeneratorRequest_newtype_ <$> C'.fromPtr msg ptr + toPtr (CodeGeneratorRequest_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (CodeGeneratorRequest (M'.MutMsg s)) where + setIndex (CodeGeneratorRequest_newtype_ elt) i (List_CodeGeneratorRequest l) = U'.setIndex elt i l + newList msg len = List_CodeGeneratorRequest <$> U'.allocCompositeList msg 0 3 len +instance C'.Allocate s (CodeGeneratorRequest (M'.MutMsg s)) where + new msg = CodeGeneratorRequest_newtype_ <$> U'.allocStruct msg 0 3 +instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest msg)) where + fromPtr msg ptr = List_CodeGeneratorRequest <$> C'.fromPtr msg ptr + toPtr (List_CodeGeneratorRequest l) = C'.toPtr l +get_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (Node msg)) +get_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool +has_CodeGeneratorRequest'nodes(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_CodeGeneratorRequest'nodes :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node (M'.MutMsg s))) -> m () +set_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_CodeGeneratorRequest'nodes :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node (M'.MutMsg s)))) +new_CodeGeneratorRequest'nodes len struct = do + result <- C'.newList (U'.message struct) len + set_CodeGeneratorRequest'nodes struct result + pure result +get_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) +get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool +has_CodeGeneratorRequest'requestedFiles(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))) -> m () +set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)))) +new_CodeGeneratorRequest'requestedFiles len struct = do + result <- C'.newList (U'.message struct) len + set_CodeGeneratorRequest'requestedFiles struct result + pure result +get_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (CapnpVersion msg) +get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) = + U'.getPtr 2 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool +has_CodeGeneratorRequest'capnpVersion(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct +set_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (CapnpVersion (M'.MutMsg s)) -> m () +set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct +new_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> m ((CapnpVersion (M'.MutMsg s))) +new_CodeGeneratorRequest'capnpVersion struct = do + result <- C'.new (U'.message struct) + set_CodeGeneratorRequest'capnpVersion struct result + pure result +data ElementSize + = ElementSize'empty + | ElementSize'bit + | ElementSize'byte + | ElementSize'twoBytes + | ElementSize'fourBytes + | ElementSize'eightBytes + | ElementSize'pointer + | ElementSize'inlineComposite + | ElementSize'unknown' Word16 + deriving(Show,Read,Eq,Generic) +instance Enum ElementSize where + toEnum = C'.fromWord . fromIntegral + fromEnum = fromIntegral . C'.toWord +instance C'.IsWord ElementSize where + fromWord n = go (fromIntegral n :: Word16) where + go 0 = ElementSize'empty + go 1 = ElementSize'bit + go 2 = ElementSize'byte + go 3 = ElementSize'twoBytes + go 4 = ElementSize'fourBytes + go 5 = ElementSize'eightBytes + go 6 = ElementSize'pointer + go 7 = ElementSize'inlineComposite + go tag = ElementSize'unknown' (fromIntegral tag) + toWord ElementSize'empty = 0 + toWord ElementSize'bit = 1 + toWord ElementSize'byte = 2 + toWord ElementSize'twoBytes = 3 + toWord ElementSize'fourBytes = 4 + toWord ElementSize'eightBytes = 5 + toWord ElementSize'pointer = 6 + toWord ElementSize'inlineComposite = 7 + toWord (ElementSize'unknown' tag) = fromIntegral tag +instance B'.ListElem msg ElementSize where + newtype List msg ElementSize = List_ElementSize (U'.ListOf msg Word16) + length (List_ElementSize l) = U'.length l + index i (List_ElementSize l) = (C'.fromWord . fromIntegral) <$> U'.index i l +instance B'.MutListElem s ElementSize where + setIndex elt i (List_ElementSize l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l + newList msg size = List_ElementSize <$> U'.allocList16 msg size +instance C'.IsPtr msg (B'.List msg ElementSize) where + fromPtr msg ptr = List_ElementSize <$> C'.fromPtr msg ptr + toPtr (List_ElementSize l) = C'.toPtr l +newtype Enumerant msg = Enumerant_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Enumerant msg) where + fromStruct = pure . Enumerant_newtype_ +instance C'.ToStruct msg (Enumerant msg) where + toStruct (Enumerant_newtype_ struct) = struct +instance U'.HasMessage (Enumerant msg) where + type InMessage (Enumerant msg) = msg + message (Enumerant_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Enumerant msg) where + messageDefault = Enumerant_newtype_ . U'.messageDefault +instance B'.ListElem msg (Enumerant msg) where + newtype List msg (Enumerant msg) = List_Enumerant (U'.ListOf msg (U'.Struct msg)) + length (List_Enumerant l) = U'.length l + index i (List_Enumerant l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Enumerant msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Enumerant msg) where + fromPtr msg ptr = Enumerant_newtype_ <$> C'.fromPtr msg ptr + toPtr (Enumerant_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Enumerant (M'.MutMsg s)) where + setIndex (Enumerant_newtype_ elt) i (List_Enumerant l) = U'.setIndex elt i l + newList msg len = List_Enumerant <$> U'.allocCompositeList msg 1 2 len +instance C'.Allocate s (Enumerant (M'.MutMsg s)) where + new msg = Enumerant_newtype_ <$> U'.allocStruct msg 1 2 +instance C'.IsPtr msg (B'.List msg (Enumerant msg)) where + fromPtr msg ptr = List_Enumerant <$> C'.fromPtr msg ptr + toPtr (List_Enumerant l) = C'.toPtr l +get_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m (B'.Text msg) +get_Enumerant'name (Enumerant_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m Bool +has_Enumerant'name(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Enumerant'name :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Enumerant'name (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Enumerant'name :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Enumerant'name len struct = do + result <- B'.newText (U'.message struct) len + set_Enumerant'name struct result + pure result +get_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Word16 +get_Enumerant'codeOrder (Enumerant_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Enumerant'codeOrder :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> Word16 -> m () +set_Enumerant'codeOrder (Enumerant_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 +get_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m (B'.List msg (Annotation msg)) +get_Enumerant'annotations (Enumerant_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m Bool +has_Enumerant'annotations(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_Enumerant'annotations :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () +set_Enumerant'annotations (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_Enumerant'annotations :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) +new_Enumerant'annotations len struct = do + result <- C'.newList (U'.message struct) len + set_Enumerant'annotations struct result + pure result +newtype Field msg = Field_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Field msg) where + fromStruct = pure . Field_newtype_ +instance C'.ToStruct msg (Field msg) where + toStruct (Field_newtype_ struct) = struct +instance U'.HasMessage (Field msg) where + type InMessage (Field msg) = msg + message (Field_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Field msg) where + messageDefault = Field_newtype_ . U'.messageDefault +instance B'.ListElem msg (Field msg) where + newtype List msg (Field msg) = List_Field (U'.ListOf msg (U'.Struct msg)) + length (List_Field l) = U'.length l + index i (List_Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Field msg) where + fromPtr msg ptr = Field_newtype_ <$> C'.fromPtr msg ptr + toPtr (Field_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Field (M'.MutMsg s)) where + setIndex (Field_newtype_ elt) i (List_Field l) = U'.setIndex elt i l + newList msg len = List_Field <$> U'.allocCompositeList msg 3 4 len +instance C'.Allocate s (Field (M'.MutMsg s)) where + new msg = Field_newtype_ <$> U'.allocStruct msg 3 4 +instance C'.IsPtr msg (B'.List msg (Field msg)) where + fromPtr msg ptr = List_Field <$> C'.fromPtr msg ptr + toPtr (List_Field l) = C'.toPtr l +get_Field'name :: U'.ReadCtx m msg => Field msg -> m (B'.Text msg) +get_Field'name (Field_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Field'name :: U'.ReadCtx m msg => Field msg -> m Bool +has_Field'name(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Field'name :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Field'name (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Field'name :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Field'name len struct = do + result <- B'.newText (U'.message struct) len + set_Field'name struct result + pure result +get_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Word16 +get_Field'codeOrder (Field_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Field'codeOrder :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m () +set_Field'codeOrder (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 +get_Field'annotations :: U'.ReadCtx m msg => Field msg -> m (B'.List msg (Annotation msg)) +get_Field'annotations (Field_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_Field'annotations :: U'.ReadCtx m msg => Field msg -> m Bool +has_Field'annotations(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_Field'annotations :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () +set_Field'annotations (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_Field'annotations :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) +new_Field'annotations len struct = do + result <- C'.newList (U'.message struct) len + set_Field'annotations struct result + pure result +get_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Word16 +get_Field'discriminantValue (Field_newtype_ struct) = H'.getWordField struct 0 16 65535 +set_Field'discriminantValue :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m () +set_Field'discriminantValue (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 65535 +get_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m (Field'ordinal msg) +get_Field'ordinal (Field_newtype_ struct) = C'.fromStruct struct +get_Field'union' :: U'.ReadCtx m msg => Field msg -> m (Field' msg) +get_Field'union' (Field_newtype_ struct) = C'.fromStruct struct +newtype Method msg = Method_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Method msg) where + fromStruct = pure . Method_newtype_ +instance C'.ToStruct msg (Method msg) where + toStruct (Method_newtype_ struct) = struct +instance U'.HasMessage (Method msg) where + type InMessage (Method msg) = msg + message (Method_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Method msg) where + messageDefault = Method_newtype_ . U'.messageDefault +instance B'.ListElem msg (Method msg) where + newtype List msg (Method msg) = List_Method (U'.ListOf msg (U'.Struct msg)) + length (List_Method l) = U'.length l + index i (List_Method l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Method msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Method msg) where + fromPtr msg ptr = Method_newtype_ <$> C'.fromPtr msg ptr + toPtr (Method_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Method (M'.MutMsg s)) where + setIndex (Method_newtype_ elt) i (List_Method l) = U'.setIndex elt i l + newList msg len = List_Method <$> U'.allocCompositeList msg 3 5 len +instance C'.Allocate s (Method (M'.MutMsg s)) where + new msg = Method_newtype_ <$> U'.allocStruct msg 3 5 +instance C'.IsPtr msg (B'.List msg (Method msg)) where + fromPtr msg ptr = List_Method <$> C'.fromPtr msg ptr + toPtr (List_Method l) = C'.toPtr l +get_Method'name :: U'.ReadCtx m msg => Method msg -> m (B'.Text msg) +get_Method'name (Method_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Method'name :: U'.ReadCtx m msg => Method msg -> m Bool +has_Method'name(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Method'name :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Method'name (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Method'name :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Method'name len struct = do + result <- B'.newText (U'.message struct) len + set_Method'name struct result + pure result +get_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Word16 +get_Method'codeOrder (Method_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Method'codeOrder :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word16 -> m () +set_Method'codeOrder (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0 +get_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Word64 +get_Method'paramStructType (Method_newtype_ struct) = H'.getWordField struct 1 0 0 +set_Method'paramStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m () +set_Method'paramStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +get_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Word64 +get_Method'resultStructType (Method_newtype_ struct) = H'.getWordField struct 2 0 0 +set_Method'resultStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m () +set_Method'resultStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 +get_Method'annotations :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Annotation msg)) +get_Method'annotations (Method_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_Method'annotations :: U'.ReadCtx m msg => Method msg -> m Bool +has_Method'annotations(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_Method'annotations :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () +set_Method'annotations (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_Method'annotations :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) +new_Method'annotations len struct = do + result <- C'.newList (U'.message struct) len + set_Method'annotations struct result + pure result +get_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg) +get_Method'paramBrand (Method_newtype_ struct) = + U'.getPtr 2 struct + >>= C'.fromPtr (U'.message struct) +has_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m Bool +has_Method'paramBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct +set_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Method'paramBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct +new_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Method'paramBrand struct = do + result <- C'.new (U'.message struct) + set_Method'paramBrand struct result + pure result +get_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg) +get_Method'resultBrand (Method_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m Bool +has_Method'resultBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Method'resultBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Method'resultBrand struct = do + result <- C'.new (U'.message struct) + set_Method'resultBrand struct result + pure result +get_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Node'Parameter msg)) +get_Method'implicitParameters (Method_newtype_ struct) = + U'.getPtr 4 struct + >>= C'.fromPtr (U'.message struct) +has_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m Bool +has_Method'implicitParameters(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct +set_Method'implicitParameters :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m () +set_Method'implicitParameters (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct +new_Method'implicitParameters :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s)))) +new_Method'implicitParameters len struct = do + result <- C'.newList (U'.message struct) len + set_Method'implicitParameters struct result + pure result +newtype Node msg = Node_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node msg) where + fromStruct = pure . Node_newtype_ +instance C'.ToStruct msg (Node msg) where + toStruct (Node_newtype_ struct) = struct +instance U'.HasMessage (Node msg) where + type InMessage (Node msg) = msg + message (Node_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node msg) where + messageDefault = Node_newtype_ . U'.messageDefault +instance B'.ListElem msg (Node msg) where + newtype List msg (Node msg) = List_Node (U'.ListOf msg (U'.Struct msg)) + length (List_Node l) = U'.length l + index i (List_Node l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Node msg) where + fromPtr msg ptr = Node_newtype_ <$> C'.fromPtr msg ptr + toPtr (Node_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Node (M'.MutMsg s)) where + setIndex (Node_newtype_ elt) i (List_Node l) = U'.setIndex elt i l + newList msg len = List_Node <$> U'.allocCompositeList msg 5 6 len +instance C'.Allocate s (Node (M'.MutMsg s)) where + new msg = Node_newtype_ <$> U'.allocStruct msg 5 6 +instance C'.IsPtr msg (B'.List msg (Node msg)) where + fromPtr msg ptr = List_Node <$> C'.fromPtr msg ptr + toPtr (List_Node l) = C'.toPtr l +get_Node'id :: U'.ReadCtx m msg => Node msg -> m Word64 +get_Node'id (Node_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Node'id :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m () +set_Node'id (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_Node'displayName :: U'.ReadCtx m msg => Node msg -> m (B'.Text msg) +get_Node'displayName (Node_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Node'displayName :: U'.ReadCtx m msg => Node msg -> m Bool +has_Node'displayName(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Node'displayName :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Node'displayName (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Node'displayName :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Node'displayName len struct = do + result <- B'.newText (U'.message struct) len + set_Node'displayName struct result + pure result +get_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Word32 +get_Node'displayNamePrefixLength (Node_newtype_ struct) = H'.getWordField struct 1 0 0 +set_Node'displayNamePrefixLength :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word32 -> m () +set_Node'displayNamePrefixLength (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 1 0 0 +get_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Word64 +get_Node'scopeId (Node_newtype_ struct) = H'.getWordField struct 2 0 0 +set_Node'scopeId :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m () +set_Node'scopeId (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 +get_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'NestedNode msg)) +get_Node'nestedNodes (Node_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m Bool +has_Node'nestedNodes(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_Node'nestedNodes :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))) -> m () +set_Node'nestedNodes (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_Node'nestedNodes :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s)))) +new_Node'nestedNodes len struct = do + result <- C'.newList (U'.message struct) len + set_Node'nestedNodes struct result + pure result +get_Node'annotations :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Annotation msg)) +get_Node'annotations (Node_newtype_ struct) = + U'.getPtr 2 struct + >>= C'.fromPtr (U'.message struct) +has_Node'annotations :: U'.ReadCtx m msg => Node msg -> m Bool +has_Node'annotations(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct +set_Node'annotations :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m () +set_Node'annotations (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct +new_Node'annotations :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s)))) +new_Node'annotations len struct = do + result <- C'.newList (U'.message struct) len + set_Node'annotations struct result + pure result +get_Node'parameters :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'Parameter msg)) +get_Node'parameters (Node_newtype_ struct) = + U'.getPtr 5 struct + >>= C'.fromPtr (U'.message struct) +has_Node'parameters :: U'.ReadCtx m msg => Node msg -> m Bool +has_Node'parameters(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 5 struct +set_Node'parameters :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m () +set_Node'parameters (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 5 struct +new_Node'parameters :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s)))) +new_Node'parameters len struct = do + result <- C'.newList (U'.message struct) len + set_Node'parameters struct result + pure result +get_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool +get_Node'isGeneric (Node_newtype_ struct) = H'.getWordField struct 4 32 0 +set_Node'isGeneric :: U'.RWCtx m s => Node (M'.MutMsg s) -> Bool -> m () +set_Node'isGeneric (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 4 32 0 +get_Node'union' :: U'.ReadCtx m msg => Node msg -> m (Node' msg) +get_Node'union' (Node_newtype_ struct) = C'.fromStruct struct +newtype Superclass msg = Superclass_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Superclass msg) where + fromStruct = pure . Superclass_newtype_ +instance C'.ToStruct msg (Superclass msg) where + toStruct (Superclass_newtype_ struct) = struct +instance U'.HasMessage (Superclass msg) where + type InMessage (Superclass msg) = msg + message (Superclass_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Superclass msg) where + messageDefault = Superclass_newtype_ . U'.messageDefault +instance B'.ListElem msg (Superclass msg) where + newtype List msg (Superclass msg) = List_Superclass (U'.ListOf msg (U'.Struct msg)) + length (List_Superclass l) = U'.length l + index i (List_Superclass l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Superclass msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Superclass msg) where + fromPtr msg ptr = Superclass_newtype_ <$> C'.fromPtr msg ptr + toPtr (Superclass_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Superclass (M'.MutMsg s)) where + setIndex (Superclass_newtype_ elt) i (List_Superclass l) = U'.setIndex elt i l + newList msg len = List_Superclass <$> U'.allocCompositeList msg 1 1 len +instance C'.Allocate s (Superclass (M'.MutMsg s)) where + new msg = Superclass_newtype_ <$> U'.allocStruct msg 1 1 +instance C'.IsPtr msg (B'.List msg (Superclass msg)) where + fromPtr msg ptr = List_Superclass <$> C'.fromPtr msg ptr + toPtr (List_Superclass l) = C'.toPtr l +get_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Word64 +get_Superclass'id (Superclass_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Superclass'id :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> Word64 -> m () +set_Superclass'id (Superclass_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m (Brand msg) +get_Superclass'brand (Superclass_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m Bool +has_Superclass'brand(Superclass_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Superclass'brand (Superclass_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Superclass'brand struct = do + result <- C'.new (U'.message struct) + set_Superclass'brand struct result + pure result +newtype Type msg = Type_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type msg) where + fromStruct = pure . Type_newtype_ +instance C'.ToStruct msg (Type msg) where + toStruct (Type_newtype_ struct) = struct +instance U'.HasMessage (Type msg) where + type InMessage (Type msg) = msg + message (Type_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type msg) where + messageDefault = Type_newtype_ . U'.messageDefault +instance B'.ListElem msg (Type msg) where + newtype List msg (Type msg) = List_Type (U'.ListOf msg (U'.Struct msg)) + length (List_Type l) = U'.length l + index i (List_Type l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Type msg) where + fromPtr msg ptr = Type_newtype_ <$> C'.fromPtr msg ptr + toPtr (Type_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Type (M'.MutMsg s)) where + setIndex (Type_newtype_ elt) i (List_Type l) = U'.setIndex elt i l + newList msg len = List_Type <$> U'.allocCompositeList msg 3 1 len +instance C'.Allocate s (Type (M'.MutMsg s)) where + new msg = Type_newtype_ <$> U'.allocStruct msg 3 1 +instance C'.IsPtr msg (B'.List msg (Type msg)) where + fromPtr msg ptr = List_Type <$> C'.fromPtr msg ptr + toPtr (List_Type l) = C'.toPtr l +data Type' msg + = Type'void + | Type'bool + | Type'int8 + | Type'int16 + | Type'int32 + | Type'int64 + | Type'uint8 + | Type'uint16 + | Type'uint32 + | Type'uint64 + | Type'float32 + | Type'float64 + | Type'text + | Type'data_ + | Type'list (Type'list'group' msg) + | Type'enum (Type'enum'group' msg) + | Type'struct (Type'struct'group' msg) + | Type'interface (Type'interface'group' msg) + | Type'anyPointer (Type'anyPointer'group' msg) + | Type'unknown' Word16 +get_Type' :: U'.ReadCtx m msg => Type msg -> m (Type' msg) +get_Type' (Type_newtype_ struct) = C'.fromStruct struct +set_Type'void :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'void (Type_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 +set_Type'bool :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'bool (Type_newtype_ struct) = H'.setWordField struct (1 :: Word16) 0 0 0 +set_Type'int8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'int8 (Type_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 0 0 +set_Type'int16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'int16 (Type_newtype_ struct) = H'.setWordField struct (3 :: Word16) 0 0 0 +set_Type'int32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'int32 (Type_newtype_ struct) = H'.setWordField struct (4 :: Word16) 0 0 0 +set_Type'int64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'int64 (Type_newtype_ struct) = H'.setWordField struct (5 :: Word16) 0 0 0 +set_Type'uint8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'uint8 (Type_newtype_ struct) = H'.setWordField struct (6 :: Word16) 0 0 0 +set_Type'uint16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'uint16 (Type_newtype_ struct) = H'.setWordField struct (7 :: Word16) 0 0 0 +set_Type'uint32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'uint32 (Type_newtype_ struct) = H'.setWordField struct (8 :: Word16) 0 0 0 +set_Type'uint64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'uint64 (Type_newtype_ struct) = H'.setWordField struct (9 :: Word16) 0 0 0 +set_Type'float32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'float32 (Type_newtype_ struct) = H'.setWordField struct (10 :: Word16) 0 0 0 +set_Type'float64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'float64 (Type_newtype_ struct) = H'.setWordField struct (11 :: Word16) 0 0 0 +set_Type'text :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'text (Type_newtype_ struct) = H'.setWordField struct (12 :: Word16) 0 0 0 +set_Type'data_ :: U'.RWCtx m s => Type (M'.MutMsg s) -> m () +set_Type'data_ (Type_newtype_ struct) = H'.setWordField struct (13 :: Word16) 0 0 0 +set_Type'list :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'list'group' (M'.MutMsg s)) +set_Type'list (Type_newtype_ struct) = do + H'.setWordField struct (14 :: Word16) 0 0 0 + pure $ Type'list'group'_newtype_ struct +set_Type'enum :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'enum'group' (M'.MutMsg s)) +set_Type'enum (Type_newtype_ struct) = do + H'.setWordField struct (15 :: Word16) 0 0 0 + pure $ Type'enum'group'_newtype_ struct +set_Type'struct :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'struct'group' (M'.MutMsg s)) +set_Type'struct (Type_newtype_ struct) = do + H'.setWordField struct (16 :: Word16) 0 0 0 + pure $ Type'struct'group'_newtype_ struct +set_Type'interface :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'interface'group' (M'.MutMsg s)) +set_Type'interface (Type_newtype_ struct) = do + H'.setWordField struct (17 :: Word16) 0 0 0 + pure $ Type'interface'group'_newtype_ struct +set_Type'anyPointer :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'anyPointer'group' (M'.MutMsg s)) +set_Type'anyPointer (Type_newtype_ struct) = do + H'.setWordField struct (18 :: Word16) 0 0 0 + pure $ Type'anyPointer'group'_newtype_ struct +set_Type'unknown' :: U'.RWCtx m s => Type (M'.MutMsg s) -> Word16 -> m () +set_Type'unknown'(Type_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 +newtype Type'list'group' msg = Type'list'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'list'group' msg) where + fromStruct = pure . Type'list'group'_newtype_ +instance C'.ToStruct msg (Type'list'group' msg) where + toStruct (Type'list'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'list'group' msg) where + type InMessage (Type'list'group' msg) = msg + message (Type'list'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'list'group' msg) where + messageDefault = Type'list'group'_newtype_ . U'.messageDefault +get_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m (Type msg) +get_Type'list'elementType (Type'list'group'_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m Bool +has_Type'list'elementType(Type'list'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () +set_Type'list'elementType (Type'list'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) +new_Type'list'elementType struct = do + result <- C'.new (U'.message struct) + set_Type'list'elementType struct result + pure result +newtype Type'enum'group' msg = Type'enum'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'enum'group' msg) where + fromStruct = pure . Type'enum'group'_newtype_ +instance C'.ToStruct msg (Type'enum'group' msg) where + toStruct (Type'enum'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'enum'group' msg) where + type InMessage (Type'enum'group' msg) = msg + message (Type'enum'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'enum'group' msg) where + messageDefault = Type'enum'group'_newtype_ . U'.messageDefault +get_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Word64 +get_Type'enum'typeId (Type'enum'group'_newtype_ struct) = H'.getWordField struct 1 0 0 +set_Type'enum'typeId :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> Word64 -> m () +set_Type'enum'typeId (Type'enum'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +get_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m (Brand msg) +get_Type'enum'brand (Type'enum'group'_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool +has_Type'enum'brand(Type'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Type'enum'brand (Type'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Type'enum'brand struct = do + result <- C'.new (U'.message struct) + set_Type'enum'brand struct result + pure result +newtype Type'struct'group' msg = Type'struct'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'struct'group' msg) where + fromStruct = pure . Type'struct'group'_newtype_ +instance C'.ToStruct msg (Type'struct'group' msg) where + toStruct (Type'struct'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'struct'group' msg) where + type InMessage (Type'struct'group' msg) = msg + message (Type'struct'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'struct'group' msg) where + messageDefault = Type'struct'group'_newtype_ . U'.messageDefault +get_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Word64 +get_Type'struct'typeId (Type'struct'group'_newtype_ struct) = H'.getWordField struct 1 0 0 +set_Type'struct'typeId :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> Word64 -> m () +set_Type'struct'typeId (Type'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +get_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m (Brand msg) +get_Type'struct'brand (Type'struct'group'_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool +has_Type'struct'brand(Type'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Type'struct'brand (Type'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Type'struct'brand struct = do + result <- C'.new (U'.message struct) + set_Type'struct'brand struct result + pure result +newtype Type'interface'group' msg = Type'interface'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'interface'group' msg) where + fromStruct = pure . Type'interface'group'_newtype_ +instance C'.ToStruct msg (Type'interface'group' msg) where + toStruct (Type'interface'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'interface'group' msg) where + type InMessage (Type'interface'group' msg) = msg + message (Type'interface'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'interface'group' msg) where + messageDefault = Type'interface'group'_newtype_ . U'.messageDefault +get_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Word64 +get_Type'interface'typeId (Type'interface'group'_newtype_ struct) = H'.getWordField struct 1 0 0 +set_Type'interface'typeId :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> Word64 -> m () +set_Type'interface'typeId (Type'interface'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +get_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m (Brand msg) +get_Type'interface'brand (Type'interface'group'_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool +has_Type'interface'brand(Type'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m () +set_Type'interface'brand (Type'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s))) +new_Type'interface'brand struct = do + result <- C'.new (U'.message struct) + set_Type'interface'brand struct result + pure result +newtype Type'anyPointer'group' msg = Type'anyPointer'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer'group' msg) where + fromStruct = pure . Type'anyPointer'group'_newtype_ +instance C'.ToStruct msg (Type'anyPointer'group' msg) where + toStruct (Type'anyPointer'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer'group' msg) where + type InMessage (Type'anyPointer'group' msg) = msg + message (Type'anyPointer'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer'group' msg) where + messageDefault = Type'anyPointer'group'_newtype_ . U'.messageDefault +get_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m (Type'anyPointer msg) +get_Type'anyPointer'union' (Type'anyPointer'group'_newtype_ struct) = C'.fromStruct struct +instance C'.FromStruct msg (Type' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 0 0 0 + case tag of + 18 -> Type'anyPointer <$> C'.fromStruct struct + 17 -> Type'interface <$> C'.fromStruct struct + 16 -> Type'struct <$> C'.fromStruct struct + 15 -> Type'enum <$> C'.fromStruct struct + 14 -> Type'list <$> C'.fromStruct struct + 13 -> pure Type'data_ + 12 -> pure Type'text + 11 -> pure Type'float64 + 10 -> pure Type'float32 + 9 -> pure Type'uint64 + 8 -> pure Type'uint32 + 7 -> pure Type'uint16 + 6 -> pure Type'uint8 + 5 -> pure Type'int64 + 4 -> pure Type'int32 + 3 -> pure Type'int16 + 2 -> pure Type'int8 + 1 -> pure Type'bool + 0 -> pure Type'void + _ -> pure $ Type'unknown' tag +newtype Value msg = Value_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Value msg) where + fromStruct = pure . Value_newtype_ +instance C'.ToStruct msg (Value msg) where + toStruct (Value_newtype_ struct) = struct +instance U'.HasMessage (Value msg) where + type InMessage (Value msg) = msg + message (Value_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Value msg) where + messageDefault = Value_newtype_ . U'.messageDefault +instance B'.ListElem msg (Value msg) where + newtype List msg (Value msg) = List_Value (U'.ListOf msg (U'.Struct msg)) + length (List_Value l) = U'.length l + index i (List_Value l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Value msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Value msg) where + fromPtr msg ptr = Value_newtype_ <$> C'.fromPtr msg ptr + toPtr (Value_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Value (M'.MutMsg s)) where + setIndex (Value_newtype_ elt) i (List_Value l) = U'.setIndex elt i l + newList msg len = List_Value <$> U'.allocCompositeList msg 2 1 len +instance C'.Allocate s (Value (M'.MutMsg s)) where + new msg = Value_newtype_ <$> U'.allocStruct msg 2 1 +instance C'.IsPtr msg (B'.List msg (Value msg)) where + fromPtr msg ptr = List_Value <$> C'.fromPtr msg ptr + toPtr (List_Value l) = C'.toPtr l +data Value' msg + = Value'void + | Value'bool Bool + | Value'int8 Int8 + | Value'int16 Int16 + | Value'int32 Int32 + | Value'int64 Int64 + | Value'uint8 Word8 + | Value'uint16 Word16 + | Value'uint32 Word32 + | Value'uint64 Word64 + | Value'float32 Float + | Value'float64 Double + | Value'text (B'.Text msg) + | Value'data_ (B'.Data msg) + | Value'list (Maybe (U'.Ptr msg)) + | Value'enum Word16 + | Value'struct (Maybe (U'.Ptr msg)) + | Value'interface + | Value'anyPointer (Maybe (U'.Ptr msg)) + | Value'unknown' Word16 +get_Value' :: U'.ReadCtx m msg => Value msg -> m (Value' msg) +get_Value' (Value_newtype_ struct) = C'.fromStruct struct +set_Value'void :: U'.RWCtx m s => Value (M'.MutMsg s) -> m () +set_Value'void (Value_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 +set_Value'bool :: U'.RWCtx m s => Value (M'.MutMsg s) -> Bool -> m () +set_Value'bool (Value_newtype_ struct) value = do + H'.setWordField struct (1 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 16 0 +set_Value'int8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int8 -> m () +set_Value'int8 (Value_newtype_ struct) value = do + H'.setWordField struct (2 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 +set_Value'int16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int16 -> m () +set_Value'int16 (Value_newtype_ struct) value = do + H'.setWordField struct (3 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 +set_Value'int32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int32 -> m () +set_Value'int32 (Value_newtype_ struct) value = do + H'.setWordField struct (4 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 +set_Value'int64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int64 -> m () +set_Value'int64 (Value_newtype_ struct) value = do + H'.setWordField struct (5 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +set_Value'uint8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word8 -> m () +set_Value'uint8 (Value_newtype_ struct) value = do + H'.setWordField struct (6 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0 +set_Value'uint16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () +set_Value'uint16 (Value_newtype_ struct) value = do + H'.setWordField struct (7 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 +set_Value'uint32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word32 -> m () +set_Value'uint32 (Value_newtype_ struct) value = do + H'.setWordField struct (8 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 +set_Value'uint64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word64 -> m () +set_Value'uint64 (Value_newtype_ struct) value = do + H'.setWordField struct (9 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +set_Value'float32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Float -> m () +set_Value'float32 (Value_newtype_ struct) value = do + H'.setWordField struct (10 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 +set_Value'float64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Double -> m () +set_Value'float64 (Value_newtype_ struct) value = do + H'.setWordField struct (11 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0 +set_Value'text :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Value'text(Value_newtype_ struct) value = do + H'.setWordField struct (12 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +new_Value'text :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Value'text len struct = do + result <- B'.newText (U'.message struct) len + set_Value'text struct result + pure result +set_Value'data_ :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Data (M'.MutMsg s)) -> m () +set_Value'data_(Value_newtype_ struct) value = do + H'.setWordField struct (13 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +new_Value'data_ :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Data (M'.MutMsg s))) +new_Value'data_ len struct = do + result <- B'.newData (U'.message struct) len + set_Value'data_ struct result + pure result +set_Value'list :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () +set_Value'list(Value_newtype_ struct) value = do + H'.setWordField struct (14 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +set_Value'enum :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () +set_Value'enum (Value_newtype_ struct) value = do + H'.setWordField struct (15 :: Word16) 0 0 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0 +set_Value'struct :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () +set_Value'struct(Value_newtype_ struct) value = do + H'.setWordField struct (16 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +set_Value'interface :: U'.RWCtx m s => Value (M'.MutMsg s) -> m () +set_Value'interface (Value_newtype_ struct) = H'.setWordField struct (17 :: Word16) 0 0 0 +set_Value'anyPointer :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m () +set_Value'anyPointer(Value_newtype_ struct) value = do + H'.setWordField struct (18 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +set_Value'unknown' :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m () +set_Value'unknown'(Value_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 +instance C'.FromStruct msg (Value' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 0 0 0 + case tag of + 18 -> Value'anyPointer <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 17 -> pure Value'interface + 16 -> Value'struct <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 15 -> Value'enum <$> H'.getWordField struct 0 16 0 + 14 -> Value'list <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 13 -> Value'data_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 12 -> Value'text <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 11 -> Value'float64 <$> H'.getWordField struct 1 0 0 + 10 -> Value'float32 <$> H'.getWordField struct 0 32 0 + 9 -> Value'uint64 <$> H'.getWordField struct 1 0 0 + 8 -> Value'uint32 <$> H'.getWordField struct 0 32 0 + 7 -> Value'uint16 <$> H'.getWordField struct 0 16 0 + 6 -> Value'uint8 <$> H'.getWordField struct 0 16 0 + 5 -> Value'int64 <$> H'.getWordField struct 1 0 0 + 4 -> Value'int32 <$> H'.getWordField struct 0 32 0 + 3 -> Value'int16 <$> H'.getWordField struct 0 16 0 + 2 -> Value'int8 <$> H'.getWordField struct 0 16 0 + 1 -> Value'bool <$> H'.getWordField struct 0 16 0 + 0 -> pure Value'void + _ -> pure $ Value'unknown' tag +newtype Brand'Binding msg = Brand'Binding_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Brand'Binding msg) where + fromStruct = pure . Brand'Binding_newtype_ +instance C'.ToStruct msg (Brand'Binding msg) where + toStruct (Brand'Binding_newtype_ struct) = struct +instance U'.HasMessage (Brand'Binding msg) where + type InMessage (Brand'Binding msg) = msg + message (Brand'Binding_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Brand'Binding msg) where + messageDefault = Brand'Binding_newtype_ . U'.messageDefault +instance B'.ListElem msg (Brand'Binding msg) where + newtype List msg (Brand'Binding msg) = List_Brand'Binding (U'.ListOf msg (U'.Struct msg)) + length (List_Brand'Binding l) = U'.length l + index i (List_Brand'Binding l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Binding msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Brand'Binding msg) where + fromPtr msg ptr = Brand'Binding_newtype_ <$> C'.fromPtr msg ptr + toPtr (Brand'Binding_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Brand'Binding (M'.MutMsg s)) where + setIndex (Brand'Binding_newtype_ elt) i (List_Brand'Binding l) = U'.setIndex elt i l + newList msg len = List_Brand'Binding <$> U'.allocCompositeList msg 1 1 len +instance C'.Allocate s (Brand'Binding (M'.MutMsg s)) where + new msg = Brand'Binding_newtype_ <$> U'.allocStruct msg 1 1 +instance C'.IsPtr msg (B'.List msg (Brand'Binding msg)) where + fromPtr msg ptr = List_Brand'Binding <$> C'.fromPtr msg ptr + toPtr (List_Brand'Binding l) = C'.toPtr l +data Brand'Binding' msg + = Brand'Binding'unbound + | Brand'Binding'type_ (Type msg) + | Brand'Binding'unknown' Word16 +get_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m (Brand'Binding' msg) +get_Brand'Binding' (Brand'Binding_newtype_ struct) = C'.fromStruct struct +set_Brand'Binding'unbound :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m () +set_Brand'Binding'unbound (Brand'Binding_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0 +set_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () +set_Brand'Binding'type_(Brand'Binding_newtype_ struct) value = do + H'.setWordField struct (1 :: Word16) 0 0 0 + U'.setPtr (C'.toPtr value) 0 struct +new_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) +new_Brand'Binding'type_ struct = do + result <- C'.new (U'.message struct) + set_Brand'Binding'type_ struct result + pure result +set_Brand'Binding'unknown' :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> Word16 -> m () +set_Brand'Binding'unknown'(Brand'Binding_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0 +instance C'.FromStruct msg (Brand'Binding' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 0 0 0 + case tag of + 1 -> Brand'Binding'type_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + 0 -> pure Brand'Binding'unbound + _ -> pure $ Brand'Binding'unknown' tag +newtype Brand'Scope msg = Brand'Scope_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Brand'Scope msg) where + fromStruct = pure . Brand'Scope_newtype_ +instance C'.ToStruct msg (Brand'Scope msg) where + toStruct (Brand'Scope_newtype_ struct) = struct +instance U'.HasMessage (Brand'Scope msg) where + type InMessage (Brand'Scope msg) = msg + message (Brand'Scope_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Brand'Scope msg) where + messageDefault = Brand'Scope_newtype_ . U'.messageDefault +instance B'.ListElem msg (Brand'Scope msg) where + newtype List msg (Brand'Scope msg) = List_Brand'Scope (U'.ListOf msg (U'.Struct msg)) + length (List_Brand'Scope l) = U'.length l + index i (List_Brand'Scope l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Brand'Scope msg) where + fromPtr msg ptr = Brand'Scope_newtype_ <$> C'.fromPtr msg ptr + toPtr (Brand'Scope_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Brand'Scope (M'.MutMsg s)) where + setIndex (Brand'Scope_newtype_ elt) i (List_Brand'Scope l) = U'.setIndex elt i l + newList msg len = List_Brand'Scope <$> U'.allocCompositeList msg 2 1 len +instance C'.Allocate s (Brand'Scope (M'.MutMsg s)) where + new msg = Brand'Scope_newtype_ <$> U'.allocStruct msg 2 1 +instance C'.IsPtr msg (B'.List msg (Brand'Scope msg)) where + fromPtr msg ptr = List_Brand'Scope <$> C'.fromPtr msg ptr + toPtr (List_Brand'Scope l) = C'.toPtr l +get_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Word64 +get_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Brand'Scope'scopeId :: U'.RWCtx m s => Brand'Scope (M'.MutMsg s) -> Word64 -> m () +set_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m (Brand'Scope' msg) +get_Brand'Scope'union' (Brand'Scope_newtype_ struct) = C'.fromStruct struct +newtype Brand'Scope' msg = Brand'Scope'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Brand'Scope' msg) where + fromStruct = pure . Brand'Scope'_newtype_ +instance C'.ToStruct msg (Brand'Scope' msg) where + toStruct (Brand'Scope'_newtype_ struct) = struct +instance U'.HasMessage (Brand'Scope' msg) where + type InMessage (Brand'Scope' msg) = msg + message (Brand'Scope'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Brand'Scope' msg) where + messageDefault = Brand'Scope'_newtype_ . U'.messageDefault +instance B'.ListElem msg (Brand'Scope' msg) where + newtype List msg (Brand'Scope' msg) = List_Brand'Scope' (U'.ListOf msg (U'.Struct msg)) + length (List_Brand'Scope' l) = U'.length l + index i (List_Brand'Scope' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope' msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Brand'Scope' msg) where + fromPtr msg ptr = Brand'Scope'_newtype_ <$> C'.fromPtr msg ptr + toPtr (Brand'Scope'_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Brand'Scope' (M'.MutMsg s)) where + setIndex (Brand'Scope'_newtype_ elt) i (List_Brand'Scope' l) = U'.setIndex elt i l + newList msg len = List_Brand'Scope' <$> U'.allocCompositeList msg 2 1 len +instance C'.Allocate s (Brand'Scope' (M'.MutMsg s)) where + new msg = Brand'Scope'_newtype_ <$> U'.allocStruct msg 2 1 +instance C'.IsPtr msg (B'.List msg (Brand'Scope' msg)) where + fromPtr msg ptr = List_Brand'Scope' <$> C'.fromPtr msg ptr + toPtr (List_Brand'Scope' l) = C'.toPtr l +data Brand'Scope'' msg + = Brand'Scope'bind (B'.List msg (Brand'Binding msg)) + | Brand'Scope'inherit + | Brand'Scope''unknown' Word16 +get_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m (Brand'Scope'' msg) +get_Brand'Scope'' (Brand'Scope'_newtype_ struct) = C'.fromStruct struct +set_Brand'Scope'bind :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))) -> m () +set_Brand'Scope'bind(Brand'Scope'_newtype_ struct) value = do + H'.setWordField struct (0 :: Word16) 1 0 0 + U'.setPtr (C'.toPtr value) 0 struct +new_Brand'Scope'bind :: U'.RWCtx m s => Int -> Brand'Scope' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s)))) +new_Brand'Scope'bind len struct = do + result <- C'.newList (U'.message struct) len + set_Brand'Scope'bind struct result + pure result +set_Brand'Scope'inherit :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> m () +set_Brand'Scope'inherit (Brand'Scope'_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 0 0 +set_Brand'Scope''unknown' :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> Word16 -> m () +set_Brand'Scope''unknown'(Brand'Scope'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 +instance C'.FromStruct msg (Brand'Scope'' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 1 0 0 + case tag of + 1 -> pure Brand'Scope'inherit + 0 -> Brand'Scope'bind <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct)) + _ -> pure $ Brand'Scope''unknown' tag +newtype CodeGeneratorRequest'RequestedFile msg = CodeGeneratorRequest'RequestedFile_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile msg) where + fromStruct = pure . CodeGeneratorRequest'RequestedFile_newtype_ +instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile msg) where + toStruct (CodeGeneratorRequest'RequestedFile_newtype_ struct) = struct +instance U'.HasMessage (CodeGeneratorRequest'RequestedFile msg) where + type InMessage (CodeGeneratorRequest'RequestedFile msg) = msg + message (CodeGeneratorRequest'RequestedFile_newtype_ struct) = U'.message struct +instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile msg) where + messageDefault = CodeGeneratorRequest'RequestedFile_newtype_ . U'.messageDefault +instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile msg) where + newtype List msg (CodeGeneratorRequest'RequestedFile msg) = List_CodeGeneratorRequest'RequestedFile (U'.ListOf msg (U'.Struct msg)) + length (List_CodeGeneratorRequest'RequestedFile l) = U'.length l + index i (List_CodeGeneratorRequest'RequestedFile l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile msg) where + fromPtr msg ptr = CodeGeneratorRequest'RequestedFile_newtype_ <$> C'.fromPtr msg ptr + toPtr (CodeGeneratorRequest'RequestedFile_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where + setIndex (CodeGeneratorRequest'RequestedFile_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile l) = U'.setIndex elt i l + newList msg len = List_CodeGeneratorRequest'RequestedFile <$> U'.allocCompositeList msg 1 2 len +instance C'.Allocate s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where + new msg = CodeGeneratorRequest'RequestedFile_newtype_ <$> U'.allocStruct msg 1 2 +instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) where + fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile <$> C'.fromPtr msg ptr + toPtr (List_CodeGeneratorRequest'RequestedFile l) = C'.toPtr l +get_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Word64 +get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) = H'.getWordField struct 0 0 0 +set_CodeGeneratorRequest'RequestedFile'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> Word64 -> m () +set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.Text msg) +get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool +has_CodeGeneratorRequest'RequestedFile'filename(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_CodeGeneratorRequest'RequestedFile'filename len struct = do + result <- B'.newText (U'.message struct) len + set_CodeGeneratorRequest'RequestedFile'filename struct result + pure result +get_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) +get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) = + U'.getPtr 1 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool +has_CodeGeneratorRequest'RequestedFile'imports(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct +set_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))) -> m () +set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct +new_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)))) +new_CodeGeneratorRequest'RequestedFile'imports len struct = do + result <- C'.newList (U'.message struct) len + set_CodeGeneratorRequest'RequestedFile'imports struct result + pure result +newtype CodeGeneratorRequest'RequestedFile'Import msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where + fromStruct = pure . CodeGeneratorRequest'RequestedFile'Import_newtype_ +instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where + toStruct (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = struct +instance U'.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg) where + type InMessage (CodeGeneratorRequest'RequestedFile'Import msg) = msg + message (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = U'.message struct +instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg) where + messageDefault = CodeGeneratorRequest'RequestedFile'Import_newtype_ . U'.messageDefault +instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg) where + newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg) = List_CodeGeneratorRequest'RequestedFile'Import (U'.ListOf msg (U'.Struct msg)) + length (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.length l + index i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile'Import msg) where + fromPtr msg ptr = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> C'.fromPtr msg ptr + toPtr (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where + setIndex (CodeGeneratorRequest'RequestedFile'Import_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.setIndex elt i l + newList msg len = List_CodeGeneratorRequest'RequestedFile'Import <$> U'.allocCompositeList msg 1 1 len +instance C'.Allocate s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where + new msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> U'.allocStruct msg 1 1 +instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) where + fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile'Import <$> C'.fromPtr msg ptr + toPtr (List_CodeGeneratorRequest'RequestedFile'Import l) = C'.toPtr l +get_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Word64 +get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = H'.getWordField struct 0 0 0 +set_CodeGeneratorRequest'RequestedFile'Import'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> Word64 -> m () +set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +get_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m (B'.Text msg) +get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool +has_CodeGeneratorRequest'RequestedFile'Import'name(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_CodeGeneratorRequest'RequestedFile'Import'name len struct = do + result <- B'.newText (U'.message struct) len + set_CodeGeneratorRequest'RequestedFile'Import'name struct result + pure result +newtype Field' msg = Field'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Field' msg) where + fromStruct = pure . Field'_newtype_ +instance C'.ToStruct msg (Field' msg) where + toStruct (Field'_newtype_ struct) = struct +instance U'.HasMessage (Field' msg) where + type InMessage (Field' msg) = msg + message (Field'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Field' msg) where + messageDefault = Field'_newtype_ . U'.messageDefault +instance B'.ListElem msg (Field' msg) where + newtype List msg (Field' msg) = List_Field' (U'.ListOf msg (U'.Struct msg)) + length (List_Field' l) = U'.length l + index i (List_Field' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field' msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Field' msg) where + fromPtr msg ptr = Field'_newtype_ <$> C'.fromPtr msg ptr + toPtr (Field'_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Field' (M'.MutMsg s)) where + setIndex (Field'_newtype_ elt) i (List_Field' l) = U'.setIndex elt i l + newList msg len = List_Field' <$> U'.allocCompositeList msg 3 4 len +instance C'.Allocate s (Field' (M'.MutMsg s)) where + new msg = Field'_newtype_ <$> U'.allocStruct msg 3 4 +instance C'.IsPtr msg (B'.List msg (Field' msg)) where + fromPtr msg ptr = List_Field' <$> C'.fromPtr msg ptr + toPtr (List_Field' l) = C'.toPtr l +data Field'' msg + = Field'slot (Field'slot'group' msg) + | Field'group (Field'group'group' msg) + | Field''unknown' Word16 +get_Field'' :: U'.ReadCtx m msg => Field' msg -> m (Field'' msg) +get_Field'' (Field'_newtype_ struct) = C'.fromStruct struct +set_Field'slot :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'slot'group' (M'.MutMsg s)) +set_Field'slot (Field'_newtype_ struct) = do + H'.setWordField struct (0 :: Word16) 1 0 0 + pure $ Field'slot'group'_newtype_ struct +set_Field'group :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'group'group' (M'.MutMsg s)) +set_Field'group (Field'_newtype_ struct) = do + H'.setWordField struct (1 :: Word16) 1 0 0 + pure $ Field'group'group'_newtype_ struct +set_Field''unknown' :: U'.RWCtx m s => Field' (M'.MutMsg s) -> Word16 -> m () +set_Field''unknown'(Field'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 +newtype Field'slot'group' msg = Field'slot'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Field'slot'group' msg) where + fromStruct = pure . Field'slot'group'_newtype_ +instance C'.ToStruct msg (Field'slot'group' msg) where + toStruct (Field'slot'group'_newtype_ struct) = struct +instance U'.HasMessage (Field'slot'group' msg) where + type InMessage (Field'slot'group' msg) = msg + message (Field'slot'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Field'slot'group' msg) where + messageDefault = Field'slot'group'_newtype_ . U'.messageDefault +get_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Word32 +get_Field'slot'offset (Field'slot'group'_newtype_ struct) = H'.getWordField struct 0 32 0 +set_Field'slot'offset :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Word32 -> m () +set_Field'slot'offset (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0 +get_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Type msg) +get_Field'slot'type_ (Field'slot'group'_newtype_ struct) = + U'.getPtr 2 struct + >>= C'.fromPtr (U'.message struct) +has_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool +has_Field'slot'type_(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct +set_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () +set_Field'slot'type_ (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct +new_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) +new_Field'slot'type_ struct = do + result <- C'.new (U'.message struct) + set_Field'slot'type_ struct result + pure result +get_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Value msg) +get_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool +has_Field'slot'defaultValue(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () +set_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) +new_Field'slot'defaultValue struct = do + result <- C'.new (U'.message struct) + set_Field'slot'defaultValue struct result + pure result +get_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool +get_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) = H'.getWordField struct 2 0 0 +set_Field'slot'hadExplicitDefault :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Bool -> m () +set_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 2 0 0 +newtype Field'group'group' msg = Field'group'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Field'group'group' msg) where + fromStruct = pure . Field'group'group'_newtype_ +instance C'.ToStruct msg (Field'group'group' msg) where + toStruct (Field'group'group'_newtype_ struct) = struct +instance U'.HasMessage (Field'group'group' msg) where + type InMessage (Field'group'group' msg) = msg + message (Field'group'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Field'group'group' msg) where + messageDefault = Field'group'group'_newtype_ . U'.messageDefault +get_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Word64 +get_Field'group'typeId (Field'group'group'_newtype_ struct) = H'.getWordField struct 2 0 0 +set_Field'group'typeId :: U'.RWCtx m s => Field'group'group' (M'.MutMsg s) -> Word64 -> m () +set_Field'group'typeId (Field'group'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 +instance C'.FromStruct msg (Field'' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 1 0 0 + case tag of + 1 -> Field'group <$> C'.fromStruct struct + 0 -> Field'slot <$> C'.fromStruct struct + _ -> pure $ Field''unknown' tag +field'noDiscriminant :: Word16 +field'noDiscriminant = C'.fromWord 65535 +newtype Field'ordinal msg = Field'ordinal_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Field'ordinal msg) where + fromStruct = pure . Field'ordinal_newtype_ +instance C'.ToStruct msg (Field'ordinal msg) where + toStruct (Field'ordinal_newtype_ struct) = struct +instance U'.HasMessage (Field'ordinal msg) where + type InMessage (Field'ordinal msg) = msg + message (Field'ordinal_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Field'ordinal msg) where + messageDefault = Field'ordinal_newtype_ . U'.messageDefault +data Field'ordinal' msg + = Field'ordinal'implicit + | Field'ordinal'explicit Word16 + | Field'ordinal'unknown' Word16 +get_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m (Field'ordinal' msg) +get_Field'ordinal' (Field'ordinal_newtype_ struct) = C'.fromStruct struct +set_Field'ordinal'implicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> m () +set_Field'ordinal'implicit (Field'ordinal_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0 +set_Field'ordinal'explicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m () +set_Field'ordinal'explicit (Field'ordinal_newtype_ struct) value = do + H'.setWordField struct (1 :: Word16) 1 16 0 + H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 32 0 +set_Field'ordinal'unknown' :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m () +set_Field'ordinal'unknown'(Field'ordinal_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0 +instance C'.FromStruct msg (Field'ordinal' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 1 16 0 + case tag of + 1 -> Field'ordinal'explicit <$> H'.getWordField struct 1 32 0 + 0 -> pure Field'ordinal'implicit + _ -> pure $ Field'ordinal'unknown' tag +newtype Node' msg = Node'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node' msg) where + fromStruct = pure . Node'_newtype_ +instance C'.ToStruct msg (Node' msg) where + toStruct (Node'_newtype_ struct) = struct +instance U'.HasMessage (Node' msg) where + type InMessage (Node' msg) = msg + message (Node'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node' msg) where + messageDefault = Node'_newtype_ . U'.messageDefault +instance B'.ListElem msg (Node' msg) where + newtype List msg (Node' msg) = List_Node' (U'.ListOf msg (U'.Struct msg)) + length (List_Node' l) = U'.length l + index i (List_Node' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node' msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Node' msg) where + fromPtr msg ptr = Node'_newtype_ <$> C'.fromPtr msg ptr + toPtr (Node'_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Node' (M'.MutMsg s)) where + setIndex (Node'_newtype_ elt) i (List_Node' l) = U'.setIndex elt i l + newList msg len = List_Node' <$> U'.allocCompositeList msg 5 6 len +instance C'.Allocate s (Node' (M'.MutMsg s)) where + new msg = Node'_newtype_ <$> U'.allocStruct msg 5 6 +instance C'.IsPtr msg (B'.List msg (Node' msg)) where + fromPtr msg ptr = List_Node' <$> C'.fromPtr msg ptr + toPtr (List_Node' l) = C'.toPtr l +data Node'' msg + = Node'file + | Node'struct (Node'struct'group' msg) + | Node'enum (Node'enum'group' msg) + | Node'interface (Node'interface'group' msg) + | Node'const (Node'const'group' msg) + | Node'annotation (Node'annotation'group' msg) + | Node''unknown' Word16 +get_Node'' :: U'.ReadCtx m msg => Node' msg -> m (Node'' msg) +get_Node'' (Node'_newtype_ struct) = C'.fromStruct struct +set_Node'file :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m () +set_Node'file (Node'_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 32 0 +set_Node'struct :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'struct'group' (M'.MutMsg s)) +set_Node'struct (Node'_newtype_ struct) = do + H'.setWordField struct (1 :: Word16) 1 32 0 + pure $ Node'struct'group'_newtype_ struct +set_Node'enum :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'enum'group' (M'.MutMsg s)) +set_Node'enum (Node'_newtype_ struct) = do + H'.setWordField struct (2 :: Word16) 1 32 0 + pure $ Node'enum'group'_newtype_ struct +set_Node'interface :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'interface'group' (M'.MutMsg s)) +set_Node'interface (Node'_newtype_ struct) = do + H'.setWordField struct (3 :: Word16) 1 32 0 + pure $ Node'interface'group'_newtype_ struct +set_Node'const :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'const'group' (M'.MutMsg s)) +set_Node'const (Node'_newtype_ struct) = do + H'.setWordField struct (4 :: Word16) 1 32 0 + pure $ Node'const'group'_newtype_ struct +set_Node'annotation :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'annotation'group' (M'.MutMsg s)) +set_Node'annotation (Node'_newtype_ struct) = do + H'.setWordField struct (5 :: Word16) 1 32 0 + pure $ Node'annotation'group'_newtype_ struct +set_Node''unknown' :: U'.RWCtx m s => Node' (M'.MutMsg s) -> Word16 -> m () +set_Node''unknown'(Node'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 32 0 +newtype Node'struct'group' msg = Node'struct'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'struct'group' msg) where + fromStruct = pure . Node'struct'group'_newtype_ +instance C'.ToStruct msg (Node'struct'group' msg) where + toStruct (Node'struct'group'_newtype_ struct) = struct +instance U'.HasMessage (Node'struct'group' msg) where + type InMessage (Node'struct'group' msg) = msg + message (Node'struct'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'struct'group' msg) where + messageDefault = Node'struct'group'_newtype_ . U'.messageDefault +get_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 +get_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 1 48 0 +set_Node'struct'dataWordCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () +set_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 48 0 +get_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 +get_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 0 0 +set_Node'struct'pointerCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () +set_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 0 0 +get_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m ElementSize +get_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 16 0 +set_Node'struct'preferredListEncoding :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> ElementSize -> m () +set_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 16 0 +get_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool +get_Node'struct'isGroup (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 32 0 +set_Node'struct'isGroup :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Bool -> m () +set_Node'struct'isGroup (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 3 32 0 +get_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16 +get_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 48 0 +set_Node'struct'discriminantCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m () +set_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 48 0 +get_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word32 +get_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) = H'.getWordField struct 4 0 0 +set_Node'struct'discriminantOffset :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word32 -> m () +set_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 4 0 0 +get_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m (B'.List msg (Field msg)) +get_Node'struct'fields (Node'struct'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool +has_Node'struct'fields(Node'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Node'struct'fields :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Field (M'.MutMsg s))) -> m () +set_Node'struct'fields (Node'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Node'struct'fields :: U'.RWCtx m s => Int -> Node'struct'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Field (M'.MutMsg s)))) +new_Node'struct'fields len struct = do + result <- C'.newList (U'.message struct) len + set_Node'struct'fields struct result + pure result +newtype Node'enum'group' msg = Node'enum'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'enum'group' msg) where + fromStruct = pure . Node'enum'group'_newtype_ +instance C'.ToStruct msg (Node'enum'group' msg) where + toStruct (Node'enum'group'_newtype_ struct) = struct +instance U'.HasMessage (Node'enum'group' msg) where + type InMessage (Node'enum'group' msg) = msg + message (Node'enum'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'enum'group' msg) where + messageDefault = Node'enum'group'_newtype_ . U'.messageDefault +get_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m (B'.List msg (Enumerant msg)) +get_Node'enum'enumerants (Node'enum'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m Bool +has_Node'enum'enumerants(Node'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Node'enum'enumerants :: U'.RWCtx m s => Node'enum'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))) -> m () +set_Node'enum'enumerants (Node'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Node'enum'enumerants :: U'.RWCtx m s => Int -> Node'enum'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s)))) +new_Node'enum'enumerants len struct = do + result <- C'.newList (U'.message struct) len + set_Node'enum'enumerants struct result + pure result +newtype Node'interface'group' msg = Node'interface'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'interface'group' msg) where + fromStruct = pure . Node'interface'group'_newtype_ +instance C'.ToStruct msg (Node'interface'group' msg) where + toStruct (Node'interface'group'_newtype_ struct) = struct +instance U'.HasMessage (Node'interface'group' msg) where + type InMessage (Node'interface'group' msg) = msg + message (Node'interface'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'interface'group' msg) where + messageDefault = Node'interface'group'_newtype_ . U'.messageDefault +get_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Method msg)) +get_Node'interface'methods (Node'interface'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool +has_Node'interface'methods(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Node'interface'methods :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Method (M'.MutMsg s))) -> m () +set_Node'interface'methods (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Node'interface'methods :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Method (M'.MutMsg s)))) +new_Node'interface'methods len struct = do + result <- C'.newList (U'.message struct) len + set_Node'interface'methods struct result + pure result +get_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Superclass msg)) +get_Node'interface'superclasses (Node'interface'group'_newtype_ struct) = + U'.getPtr 4 struct + >>= C'.fromPtr (U'.message struct) +has_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool +has_Node'interface'superclasses(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct +set_Node'interface'superclasses :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))) -> m () +set_Node'interface'superclasses (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct +new_Node'interface'superclasses :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s)))) +new_Node'interface'superclasses len struct = do + result <- C'.newList (U'.message struct) len + set_Node'interface'superclasses struct result + pure result +newtype Node'const'group' msg = Node'const'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'const'group' msg) where + fromStruct = pure . Node'const'group'_newtype_ +instance C'.ToStruct msg (Node'const'group' msg) where + toStruct (Node'const'group'_newtype_ struct) = struct +instance U'.HasMessage (Node'const'group' msg) where + type InMessage (Node'const'group' msg) = msg + message (Node'const'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'const'group' msg) where + messageDefault = Node'const'group'_newtype_ . U'.messageDefault +get_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m (Type msg) +get_Node'const'type_ (Node'const'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool +has_Node'const'type_(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () +set_Node'const'type_ (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) +new_Node'const'type_ struct = do + result <- C'.new (U'.message struct) + set_Node'const'type_ struct result + pure result +get_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m (Value msg) +get_Node'const'value (Node'const'group'_newtype_ struct) = + U'.getPtr 4 struct + >>= C'.fromPtr (U'.message struct) +has_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool +has_Node'const'value(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct +set_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m () +set_Node'const'value (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct +new_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s))) +new_Node'const'value struct = do + result <- C'.new (U'.message struct) + set_Node'const'value struct result + pure result +newtype Node'annotation'group' msg = Node'annotation'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'annotation'group' msg) where + fromStruct = pure . Node'annotation'group'_newtype_ +instance C'.ToStruct msg (Node'annotation'group' msg) where + toStruct (Node'annotation'group'_newtype_ struct) = struct +instance U'.HasMessage (Node'annotation'group' msg) where + type InMessage (Node'annotation'group' msg) = msg + message (Node'annotation'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'annotation'group' msg) where + messageDefault = Node'annotation'group'_newtype_ . U'.messageDefault +get_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m (Type msg) +get_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) = + U'.getPtr 3 struct + >>= C'.fromPtr (U'.message struct) +has_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +has_Node'annotation'type_(Node'annotation'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct +set_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m () +set_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct +new_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s))) +new_Node'annotation'type_ struct = do + result <- C'.new (U'.message struct) + set_Node'annotation'type_ struct result + pure result +get_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 48 0 +set_Node'annotation'targetsFile :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 48 0 +get_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 49 0 +set_Node'annotation'targetsConst :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 49 0 +get_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 50 0 +set_Node'annotation'targetsEnum :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 50 0 +get_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 51 0 +set_Node'annotation'targetsEnumerant :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 51 0 +get_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 52 0 +set_Node'annotation'targetsStruct :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 52 0 +get_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 53 0 +set_Node'annotation'targetsField :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 53 0 +get_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 54 0 +set_Node'annotation'targetsUnion :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 54 0 +get_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 55 0 +set_Node'annotation'targetsGroup :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 55 0 +get_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 56 0 +set_Node'annotation'targetsInterface :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 56 0 +get_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 57 0 +set_Node'annotation'targetsMethod :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 57 0 +get_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 58 0 +set_Node'annotation'targetsParam :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 58 0 +get_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool +get_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 59 0 +set_Node'annotation'targetsAnnotation :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m () +set_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 59 0 +instance C'.FromStruct msg (Node'' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 1 32 0 + case tag of + 5 -> Node'annotation <$> C'.fromStruct struct + 4 -> Node'const <$> C'.fromStruct struct + 3 -> Node'interface <$> C'.fromStruct struct + 2 -> Node'enum <$> C'.fromStruct struct + 1 -> Node'struct <$> C'.fromStruct struct + 0 -> pure Node'file + _ -> pure $ Node''unknown' tag +newtype Node'NestedNode msg = Node'NestedNode_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'NestedNode msg) where + fromStruct = pure . Node'NestedNode_newtype_ +instance C'.ToStruct msg (Node'NestedNode msg) where + toStruct (Node'NestedNode_newtype_ struct) = struct +instance U'.HasMessage (Node'NestedNode msg) where + type InMessage (Node'NestedNode msg) = msg + message (Node'NestedNode_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'NestedNode msg) where + messageDefault = Node'NestedNode_newtype_ . U'.messageDefault +instance B'.ListElem msg (Node'NestedNode msg) where + newtype List msg (Node'NestedNode msg) = List_Node'NestedNode (U'.ListOf msg (U'.Struct msg)) + length (List_Node'NestedNode l) = U'.length l + index i (List_Node'NestedNode l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'NestedNode msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Node'NestedNode msg) where + fromPtr msg ptr = Node'NestedNode_newtype_ <$> C'.fromPtr msg ptr + toPtr (Node'NestedNode_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Node'NestedNode (M'.MutMsg s)) where + setIndex (Node'NestedNode_newtype_ elt) i (List_Node'NestedNode l) = U'.setIndex elt i l + newList msg len = List_Node'NestedNode <$> U'.allocCompositeList msg 1 1 len +instance C'.Allocate s (Node'NestedNode (M'.MutMsg s)) where + new msg = Node'NestedNode_newtype_ <$> U'.allocStruct msg 1 1 +instance C'.IsPtr msg (B'.List msg (Node'NestedNode msg)) where + fromPtr msg ptr = List_Node'NestedNode <$> C'.fromPtr msg ptr + toPtr (List_Node'NestedNode l) = C'.toPtr l +get_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m (B'.Text msg) +get_Node'NestedNode'name (Node'NestedNode_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool +has_Node'NestedNode'name(Node'NestedNode_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Node'NestedNode'name :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Node'NestedNode'name (Node'NestedNode_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Node'NestedNode'name :: U'.RWCtx m s => Int -> Node'NestedNode (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Node'NestedNode'name len struct = do + result <- B'.newText (U'.message struct) len + set_Node'NestedNode'name struct result + pure result +get_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Word64 +get_Node'NestedNode'id (Node'NestedNode_newtype_ struct) = H'.getWordField struct 0 0 0 +set_Node'NestedNode'id :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> Word64 -> m () +set_Node'NestedNode'id (Node'NestedNode_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0 +newtype Node'Parameter msg = Node'Parameter_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Node'Parameter msg) where + fromStruct = pure . Node'Parameter_newtype_ +instance C'.ToStruct msg (Node'Parameter msg) where + toStruct (Node'Parameter_newtype_ struct) = struct +instance U'.HasMessage (Node'Parameter msg) where + type InMessage (Node'Parameter msg) = msg + message (Node'Parameter_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Node'Parameter msg) where + messageDefault = Node'Parameter_newtype_ . U'.messageDefault +instance B'.ListElem msg (Node'Parameter msg) where + newtype List msg (Node'Parameter msg) = List_Node'Parameter (U'.ListOf msg (U'.Struct msg)) + length (List_Node'Parameter l) = U'.length l + index i (List_Node'Parameter l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'Parameter msg); go = C'.fromStruct} in go) +instance C'.IsPtr msg (Node'Parameter msg) where + fromPtr msg ptr = Node'Parameter_newtype_ <$> C'.fromPtr msg ptr + toPtr (Node'Parameter_newtype_ struct) = C'.toPtr struct +instance B'.MutListElem s (Node'Parameter (M'.MutMsg s)) where + setIndex (Node'Parameter_newtype_ elt) i (List_Node'Parameter l) = U'.setIndex elt i l + newList msg len = List_Node'Parameter <$> U'.allocCompositeList msg 0 1 len +instance C'.Allocate s (Node'Parameter (M'.MutMsg s)) where + new msg = Node'Parameter_newtype_ <$> U'.allocStruct msg 0 1 +instance C'.IsPtr msg (B'.List msg (Node'Parameter msg)) where + fromPtr msg ptr = List_Node'Parameter <$> C'.fromPtr msg ptr + toPtr (List_Node'Parameter l) = C'.toPtr l +get_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m (B'.Text msg) +get_Node'Parameter'name (Node'Parameter_newtype_ struct) = + U'.getPtr 0 struct + >>= C'.fromPtr (U'.message struct) +has_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m Bool +has_Node'Parameter'name(Node'Parameter_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct +set_Node'Parameter'name :: U'.RWCtx m s => Node'Parameter (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m () +set_Node'Parameter'name (Node'Parameter_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct +new_Node'Parameter'name :: U'.RWCtx m s => Int -> Node'Parameter (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s))) +new_Node'Parameter'name len struct = do + result <- B'.newText (U'.message struct) len + set_Node'Parameter'name struct result + pure result +newtype Type'anyPointer msg = Type'anyPointer_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer msg) where + fromStruct = pure . Type'anyPointer_newtype_ +instance C'.ToStruct msg (Type'anyPointer msg) where + toStruct (Type'anyPointer_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer msg) where + type InMessage (Type'anyPointer msg) = msg + message (Type'anyPointer_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer msg) where + messageDefault = Type'anyPointer_newtype_ . U'.messageDefault +data Type'anyPointer' msg + = Type'anyPointer'unconstrained (Type'anyPointer'unconstrained'group' msg) + | Type'anyPointer'parameter (Type'anyPointer'parameter'group' msg) + | Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter'group' msg) + | Type'anyPointer'unknown' Word16 +get_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m (Type'anyPointer' msg) +get_Type'anyPointer' (Type'anyPointer_newtype_ struct) = C'.fromStruct struct +set_Type'anyPointer'unconstrained :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'unconstrained'group' (M'.MutMsg s)) +set_Type'anyPointer'unconstrained (Type'anyPointer_newtype_ struct) = do + H'.setWordField struct (0 :: Word16) 1 0 0 + pure $ Type'anyPointer'unconstrained'group'_newtype_ struct +set_Type'anyPointer'parameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'parameter'group' (M'.MutMsg s)) +set_Type'anyPointer'parameter (Type'anyPointer_newtype_ struct) = do + H'.setWordField struct (1 :: Word16) 1 0 0 + pure $ Type'anyPointer'parameter'group'_newtype_ struct +set_Type'anyPointer'implicitMethodParameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s)) +set_Type'anyPointer'implicitMethodParameter (Type'anyPointer_newtype_ struct) = do + H'.setWordField struct (2 :: Word16) 1 0 0 + pure $ Type'anyPointer'implicitMethodParameter'group'_newtype_ struct +set_Type'anyPointer'unknown' :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> Word16 -> m () +set_Type'anyPointer'unknown'(Type'anyPointer_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0 +newtype Type'anyPointer'unconstrained'group' msg = Type'anyPointer'unconstrained'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer'unconstrained'group' msg) where + fromStruct = pure . Type'anyPointer'unconstrained'group'_newtype_ +instance C'.ToStruct msg (Type'anyPointer'unconstrained'group' msg) where + toStruct (Type'anyPointer'unconstrained'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer'unconstrained'group' msg) where + type InMessage (Type'anyPointer'unconstrained'group' msg) = msg + message (Type'anyPointer'unconstrained'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer'unconstrained'group' msg) where + messageDefault = Type'anyPointer'unconstrained'group'_newtype_ . U'.messageDefault +get_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m (Type'anyPointer'unconstrained msg) +get_Type'anyPointer'unconstrained'union' (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.fromStruct struct +newtype Type'anyPointer'parameter'group' msg = Type'anyPointer'parameter'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer'parameter'group' msg) where + fromStruct = pure . Type'anyPointer'parameter'group'_newtype_ +instance C'.ToStruct msg (Type'anyPointer'parameter'group' msg) where + toStruct (Type'anyPointer'parameter'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer'parameter'group' msg) where + type InMessage (Type'anyPointer'parameter'group' msg) = msg + message (Type'anyPointer'parameter'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer'parameter'group' msg) where + messageDefault = Type'anyPointer'parameter'group'_newtype_ . U'.messageDefault +get_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word64 +get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 2 0 0 +set_Type'anyPointer'parameter'scopeId :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word64 -> m () +set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0 +get_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word16 +get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0 +set_Type'anyPointer'parameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word16 -> m () +set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0 +newtype Type'anyPointer'implicitMethodParameter'group' msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where + fromStruct = pure . Type'anyPointer'implicitMethodParameter'group'_newtype_ +instance C'.ToStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where + toStruct (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer'implicitMethodParameter'group' msg) where + type InMessage (Type'anyPointer'implicitMethodParameter'group' msg) = msg + message (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer'implicitMethodParameter'group' msg) where + messageDefault = Type'anyPointer'implicitMethodParameter'group'_newtype_ . U'.messageDefault +get_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Word16 +get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0 +set_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s) -> Word16 -> m () +set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0 +instance C'.FromStruct msg (Type'anyPointer' msg) where + fromStruct struct = do + tag <- H'.getWordField struct 1 0 0 + case tag of + 2 -> Type'anyPointer'implicitMethodParameter <$> C'.fromStruct struct + 1 -> Type'anyPointer'parameter <$> C'.fromStruct struct + 0 -> Type'anyPointer'unconstrained <$> C'.fromStruct struct + _ -> pure $ Type'anyPointer'unknown' tag +newtype Type'anyPointer'unconstrained msg = Type'anyPointer'unconstrained_newtype_ (U'.Struct msg) +instance C'.FromStruct msg (Type'anyPointer'unconstrained msg) where + fromStruct = pure . Type'anyPointer'unconstrained_newtype_ +instance C'.ToStruct msg (Type'anyPointer'unconstrained msg) where + toStruct (Type'anyPointer'unconstrained_newtype_ struct) = struct +instance U'.HasMessage (Type'anyPointer'unconstrained msg) where + type InMessage (Type'anyPointer'unconstrained msg) = msg + message (Type'anyPointer'unconstrained_newtype_ struct) = U'.message struct +instance U'.MessageDefault (Type'anyPointer'unconstrained msg) where + messageDefault = Type'anyPointer'unconstrained_newtype_ . U'.messageDefault +data Type'anyPointer'unconstrained' msg + = Type'anyPointer'unconstrained'anyKind + | Type'anyPointer'unconstrained'struct + | Type'anyPointer'unconstrained'list + | Type'anyPointer'unconstrained'capability + | Type'anyPointer'unconstrained'unknown' Word16 +get_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m (Type'anyPointer'unconstrained' msg) +get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained_newtype_ struct) = C'.fromStruct struct set_Type'anyPointer'unconstrained'anyKind :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m () set_Type'anyPointer'unconstrained'anyKind (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0 set_Type'anyPointer'unconstrained'struct :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m () diff --git a/lib/Capnp/Capnp/Schema/Pure.hs b/lib/Capnp/Capnp/Schema/Pure.hs --- a/lib/Capnp/Capnp/Schema/Pure.hs +++ b/lib/Capnp/Capnp/Schema/Pure.hs @@ -13,7 +13,7 @@ This module is the generated code for capnp/schema.capnp, for the high-level api. -} -module Capnp.Capnp.Schema.Pure (Annotation(..), Brand(..), CapnpVersion(..), CodeGeneratorRequest(..), Capnp.ById.Xa93fc509624c72d9.ElementSize(..), Enumerant(..), Field(..), Method(..), Node(..), Superclass(..), Type(..), Value(..), Brand'Binding(..), Brand'Scope(..), Brand'Scope'(..), CodeGeneratorRequest'RequestedFile(..), CodeGeneratorRequest'RequestedFile'Import(..), Field'(..), field'noDiscriminant, Field'ordinal(..), Node'(..), Node'NestedNode(..), Node'Parameter(..), Type'anyPointer(..), Type'anyPointer'unconstrained(..) +module Capnp.Capnp.Schema.Pure (Annotation(..), Brand(..), CapnpVersion(..), CodeGeneratorRequest(..), Capnp.ById.Xa93fc509624c72d9.ElementSize(..), Enumerant(..), Field(..), Method(..), Node(..), Superclass(..), Type(..), Value(..), Brand'Binding(..), Brand'Scope(..), Brand'Scope'(..), CodeGeneratorRequest'RequestedFile(..), CodeGeneratorRequest'RequestedFile'Import(..), Field'(..), Capnp.ById.Xa93fc509624c72d9.field'noDiscriminant, Field'ordinal(..), Node'(..), Node'NestedNode(..), Node'Parameter(..), Type'anyPointer(..), Type'anyPointer'unconstrained(..) ) where -- Code generated by capnpc-haskell. DO NOT EDIT. -- Generated from schema file: capnp/schema.capnp @@ -36,11 +36,11 @@ import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure import qualified Capnp.ById.Xbdf87d7bb8304e81 data Annotation - = Annotation + = Annotation {id :: Word64, value :: Value, brand :: Brand} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Annotation where type Cerial msg Annotation = Capnp.ById.Xa93fc509624c72d9.Annotation msg decerialize raw = do @@ -48,10 +48,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_Annotation'id raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Annotation'value raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Annotation'brand raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Annotation where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Annotation M'.ConstMsg) instance C'.Marshal Annotation where marshalInto raw value = do case value of @@ -62,21 +58,21 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Annotation'brand raw C'.marshalInto field_ brand instance C'.Cerialize s Annotation +instance C'.FromStruct M'.ConstMsg Annotation where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Annotation M'.ConstMsg) instance Default Annotation where def = PH'.defaultStruct data Brand - = Brand + = Brand {scopes :: PU'.ListOf (Brand'Scope)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Brand where type Cerial msg Brand = Capnp.ById.Xa93fc509624c72d9.Brand msg decerialize raw = do Brand <$> (Capnp.ById.Xa93fc509624c72d9.get_Brand'scopes raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Brand where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand M'.ConstMsg) instance C'.Marshal Brand where marshalInto raw value = do case value of @@ -87,14 +83,18 @@ elt <- C'.index i field_ C'.marshalInto elt (scopes V.! i) instance C'.Cerialize s Brand +instance C'.FromStruct M'.ConstMsg Brand where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand M'.ConstMsg) instance Default Brand where def = PH'.defaultStruct data CapnpVersion - = CapnpVersion + = CapnpVersion {major :: Word16, minor :: Word8, micro :: Word8} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize CapnpVersion where type Cerial msg CapnpVersion = Capnp.ById.Xa93fc509624c72d9.CapnpVersion msg decerialize raw = do @@ -102,10 +102,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'major raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'minor raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_CapnpVersion'micro raw) -instance C'.FromStruct M'.ConstMsg CapnpVersion where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CapnpVersion M'.ConstMsg) instance C'.Marshal CapnpVersion where marshalInto raw value = do case value of @@ -114,14 +110,18 @@ Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'minor raw minor Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'micro raw micro instance C'.Cerialize s CapnpVersion +instance C'.FromStruct M'.ConstMsg CapnpVersion where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CapnpVersion M'.ConstMsg) instance Default CapnpVersion where def = PH'.defaultStruct data CodeGeneratorRequest - = CodeGeneratorRequest + = CodeGeneratorRequest {nodes :: PU'.ListOf (Node), requestedFiles :: PU'.ListOf (CodeGeneratorRequest'RequestedFile), capnpVersion :: CapnpVersion} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize CodeGeneratorRequest where type Cerial msg CodeGeneratorRequest = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg decerialize raw = do @@ -129,10 +129,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'nodes raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'requestedFiles raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'capnpVersion raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest M'.ConstMsg) instance C'.Marshal CodeGeneratorRequest where marshalInto raw value = do case value of @@ -150,14 +146,18 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'capnpVersion raw C'.marshalInto field_ capnpVersion instance C'.Cerialize s CodeGeneratorRequest +instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest M'.ConstMsg) instance Default CodeGeneratorRequest where def = PH'.defaultStruct data Enumerant - = Enumerant + = Enumerant {name :: Text, codeOrder :: Word16, annotations :: PU'.ListOf (Annotation)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Enumerant where type Cerial msg Enumerant = Capnp.ById.Xa93fc509624c72d9.Enumerant msg decerialize raw = do @@ -165,10 +165,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'name raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'codeOrder raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Enumerant'annotations raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Enumerant where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Enumerant M'.ConstMsg) instance C'.Marshal Enumerant where marshalInto raw value = do case value of @@ -182,17 +178,21 @@ elt <- C'.index i field_ C'.marshalInto elt (annotations V.! i) instance C'.Cerialize s Enumerant +instance C'.FromStruct M'.ConstMsg Enumerant where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Enumerant M'.ConstMsg) instance Default Enumerant where def = PH'.defaultStruct data Field - = Field + = Field {name :: Text, codeOrder :: Word16, annotations :: PU'.ListOf (Annotation), discriminantValue :: Word16, ordinal :: Field'ordinal, union' :: Field'} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Field where type Cerial msg Field = Capnp.ById.Xa93fc509624c72d9.Field msg decerialize raw = do @@ -203,10 +203,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_Field'discriminantValue raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Field'union' raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Field where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field M'.ConstMsg) instance C'.Marshal Field where marshalInto raw value = do case value of @@ -225,10 +221,14 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Field'union' raw C'.marshalInto field_ union' instance C'.Cerialize s Field +instance C'.FromStruct M'.ConstMsg Field where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field M'.ConstMsg) instance Default Field where def = PH'.defaultStruct data Method - = Method + = Method {name :: Text, codeOrder :: Word16, paramStructType :: Word64, @@ -237,7 +237,7 @@ paramBrand :: Brand, resultBrand :: Brand, implicitParameters :: PU'.ListOf (Node'Parameter)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Method where type Cerial msg Method = Capnp.ById.Xa93fc509624c72d9.Method msg decerialize raw = do @@ -250,10 +250,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_Method'paramBrand raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Method'resultBrand raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Method'implicitParameters raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Method where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Method M'.ConstMsg) instance C'.Marshal Method where marshalInto raw value = do case value of @@ -278,10 +274,14 @@ elt <- C'.index i field_ C'.marshalInto elt (implicitParameters V.! i) instance C'.Cerialize s Method +instance C'.FromStruct M'.ConstMsg Method where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Method M'.ConstMsg) instance Default Method where def = PH'.defaultStruct data Node - = Node + = Node {id :: Word64, displayName :: Text, displayNamePrefixLength :: Word32, @@ -291,7 +291,7 @@ parameters :: PU'.ListOf (Node'Parameter), isGeneric :: Bool, union' :: Node'} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Node where type Cerial msg Node = Capnp.ById.Xa93fc509624c72d9.Node msg decerialize raw = do @@ -305,10 +305,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_Node'parameters raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Node'isGeneric raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Node'union' raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Node where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node M'.ConstMsg) instance C'.Marshal Node where marshalInto raw value = do case value of @@ -337,23 +333,23 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Node'union' raw C'.marshalInto field_ union' instance C'.Cerialize s Node +instance C'.FromStruct M'.ConstMsg Node where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node M'.ConstMsg) instance Default Node where def = PH'.defaultStruct data Superclass - = Superclass + = Superclass {id :: Word64, brand :: Brand} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Superclass where type Cerial msg Superclass = Capnp.ById.Xa93fc509624c72d9.Superclass msg decerialize raw = do Superclass <$> (Capnp.ById.Xa93fc509624c72d9.get_Superclass'id raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Superclass'brand raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Superclass where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Superclass M'.ConstMsg) instance C'.Marshal Superclass where marshalInto raw value = do case value of @@ -362,38 +358,42 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Superclass'brand raw C'.marshalInto field_ brand instance C'.Cerialize s Superclass +instance C'.FromStruct M'.ConstMsg Superclass where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Superclass M'.ConstMsg) instance Default Superclass where def = PH'.defaultStruct data Type - = Type'void | - Type'bool | - Type'int8 | - Type'int16 | - Type'int32 | - Type'int64 | - Type'uint8 | - Type'uint16 | - Type'uint32 | - Type'uint64 | - Type'float32 | - Type'float64 | - Type'text | - Type'data_ | - Type'list - {elementType :: Type} | - Type'enum + = Type'void + | Type'bool + | Type'int8 + | Type'int16 + | Type'int32 + | Type'int64 + | Type'uint8 + | Type'uint16 + | Type'uint32 + | Type'uint64 + | Type'float32 + | Type'float64 + | Type'text + | Type'data_ + | Type'list + {elementType :: Type} + | Type'enum {typeId :: Word64, - brand :: Brand} | - Type'struct + brand :: Brand} + | Type'struct {typeId :: Word64, - brand :: Brand} | - Type'interface + brand :: Brand} + | Type'interface {typeId :: Word64, - brand :: Brand} | - Type'anyPointer - {union' :: Type'anyPointer} | - Type'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + brand :: Brand} + | Type'anyPointer + {union' :: Type'anyPointer} + | Type'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Type where type Cerial msg Type = Capnp.ById.Xa93fc509624c72d9.Type msg decerialize raw = do @@ -426,11 +426,7 @@ (Capnp.ById.Xa93fc509624c72d9.get_Type'interface'brand raw >>= C'.decerialize) Capnp.ById.Xa93fc509624c72d9.Type'anyPointer raw -> Type'anyPointer <$> (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'union' raw >>= C'.decerialize) - Capnp.ById.Xa93fc509624c72d9.Type'unknown' val -> pure (Type'unknown' val) -instance C'.FromStruct M'.ConstMsg Type where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Type'unknown' val -> pure $ Type'unknown' val instance C'.Marshal Type where marshalInto raw value = do case value of @@ -473,30 +469,34 @@ C'.marshalInto field_ union' Type'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'unknown' raw arg_ instance C'.Cerialize s Type +instance C'.FromStruct M'.ConstMsg Type where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type M'.ConstMsg) instance Default Type where def = PH'.defaultStruct data Value - = Value'void | - Value'bool (Bool) | - Value'int8 (Int8) | - Value'int16 (Int16) | - Value'int32 (Int32) | - Value'int64 (Int64) | - Value'uint8 (Word8) | - Value'uint16 (Word16) | - Value'uint32 (Word32) | - Value'uint64 (Word64) | - Value'float32 (Float) | - Value'float64 (Double) | - Value'text (Text) | - Value'data_ (Data) | - Value'list (Maybe (PU'.PtrType)) | - Value'enum (Word16) | - Value'struct (Maybe (PU'.PtrType)) | - Value'interface | - Value'anyPointer (Maybe (PU'.PtrType)) | - Value'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Value'void + | Value'bool (Bool) + | Value'int8 (Int8) + | Value'int16 (Int16) + | Value'int32 (Int32) + | Value'int64 (Int64) + | Value'uint8 (Word8) + | Value'uint16 (Word16) + | Value'uint32 (Word32) + | Value'uint64 (Word64) + | Value'float32 (Float) + | Value'float64 (Double) + | Value'text (Text) + | Value'data_ (Data) + | Value'list (Maybe (PU'.PtrType)) + | Value'enum (Word16) + | Value'struct (Maybe (PU'.PtrType)) + | Value'interface + | Value'anyPointer (Maybe (PU'.PtrType)) + | Value'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Value where type Cerial msg Value = Capnp.ById.Xa93fc509624c72d9.Value msg decerialize raw = do @@ -521,11 +521,7 @@ Capnp.ById.Xa93fc509624c72d9.Value'struct val -> Value'struct <$> C'.decerialize val Capnp.ById.Xa93fc509624c72d9.Value'interface -> pure Value'interface Capnp.ById.Xa93fc509624c72d9.Value'anyPointer val -> Value'anyPointer <$> C'.decerialize val - Capnp.ById.Xa93fc509624c72d9.Value'unknown' val -> pure (Value'unknown' val) -instance C'.FromStruct M'.ConstMsg Value where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Value M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Value'unknown' val -> pure $ Value'unknown' val instance C'.Marshal Value where marshalInto raw value = do case value of @@ -560,13 +556,17 @@ Capnp.ById.Xa93fc509624c72d9.set_Value'anyPointer raw field_ Value'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'unknown' raw arg_ instance C'.Cerialize s Value +instance C'.FromStruct M'.ConstMsg Value where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Value M'.ConstMsg) instance Default Value where def = PH'.defaultStruct data Brand'Binding - = Brand'Binding'unbound | - Brand'Binding'type_ (Type) | - Brand'Binding'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Brand'Binding'unbound + | Brand'Binding'type_ (Type) + | Brand'Binding'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Brand'Binding where type Cerial msg Brand'Binding = Capnp.ById.Xa93fc509624c72d9.Brand'Binding msg decerialize raw = do @@ -574,11 +574,7 @@ case raw of Capnp.ById.Xa93fc509624c72d9.Brand'Binding'unbound -> pure Brand'Binding'unbound Capnp.ById.Xa93fc509624c72d9.Brand'Binding'type_ val -> Brand'Binding'type_ <$> C'.decerialize val - Capnp.ById.Xa93fc509624c72d9.Brand'Binding'unknown' val -> pure (Brand'Binding'unknown' val) -instance C'.FromStruct M'.ConstMsg Brand'Binding where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Binding M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Brand'Binding'unknown' val -> pure $ Brand'Binding'unknown' val instance C'.Marshal Brand'Binding where marshalInto raw value = do case value of @@ -588,23 +584,23 @@ C'.marshalInto field_ arg_ Brand'Binding'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' raw arg_ instance C'.Cerialize s Brand'Binding +instance C'.FromStruct M'.ConstMsg Brand'Binding where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Binding M'.ConstMsg) instance Default Brand'Binding where def = PH'.defaultStruct data Brand'Scope - = Brand'Scope + = Brand'Scope {scopeId :: Word64, union' :: Brand'Scope'} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Brand'Scope where type Cerial msg Brand'Scope = Capnp.ById.Xa93fc509624c72d9.Brand'Scope msg decerialize raw = do Brand'Scope <$> (Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'scopeId raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'union' raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Brand'Scope where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope M'.ConstMsg) instance C'.Marshal Brand'Scope where marshalInto raw value = do case value of @@ -613,13 +609,17 @@ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'union' raw C'.marshalInto field_ union' instance C'.Cerialize s Brand'Scope +instance C'.FromStruct M'.ConstMsg Brand'Scope where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope M'.ConstMsg) instance Default Brand'Scope where def = PH'.defaultStruct data Brand'Scope' - = Brand'Scope'bind (PU'.ListOf (Brand'Binding)) | - Brand'Scope'inherit | - Brand'Scope'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Brand'Scope'bind (PU'.ListOf (Brand'Binding)) + | Brand'Scope'inherit + | Brand'Scope'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Brand'Scope' where type Cerial msg Brand'Scope' = Capnp.ById.Xa93fc509624c72d9.Brand'Scope' msg decerialize raw = do @@ -627,11 +627,7 @@ case raw of Capnp.ById.Xa93fc509624c72d9.Brand'Scope'bind val -> Brand'Scope'bind <$> C'.decerialize val Capnp.ById.Xa93fc509624c72d9.Brand'Scope'inherit -> pure Brand'Scope'inherit - Capnp.ById.Xa93fc509624c72d9.Brand'Scope'unknown' val -> pure (Brand'Scope'unknown' val) -instance C'.FromStruct M'.ConstMsg Brand'Scope' where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope' M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Brand'Scope''unknown' val -> pure $ Brand'Scope'unknown' val instance C'.Marshal Brand'Scope' where marshalInto raw value = do case value of @@ -642,16 +638,20 @@ elt <- C'.index i field_ C'.marshalInto elt (arg_ V.! i) Brand'Scope'inherit -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope'inherit raw - Brand'Scope'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope'unknown' raw arg_ + Brand'Scope'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope''unknown' raw arg_ instance C'.Cerialize s Brand'Scope' +instance C'.FromStruct M'.ConstMsg Brand'Scope' where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope' M'.ConstMsg) instance Default Brand'Scope' where def = PH'.defaultStruct data CodeGeneratorRequest'RequestedFile - = CodeGeneratorRequest'RequestedFile + = CodeGeneratorRequest'RequestedFile {id :: Word64, filename :: Text, imports :: PU'.ListOf (CodeGeneratorRequest'RequestedFile'Import)} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize CodeGeneratorRequest'RequestedFile where type Cerial msg CodeGeneratorRequest'RequestedFile = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile msg decerialize raw = do @@ -659,10 +659,6 @@ (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'id raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'filename raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'imports raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile M'.ConstMsg) instance C'.Marshal CodeGeneratorRequest'RequestedFile where marshalInto raw value = do case value of @@ -676,23 +672,23 @@ elt <- C'.index i field_ C'.marshalInto elt (imports V.! i) instance C'.Cerialize s CodeGeneratorRequest'RequestedFile +instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile M'.ConstMsg) instance Default CodeGeneratorRequest'RequestedFile where def = PH'.defaultStruct data CodeGeneratorRequest'RequestedFile'Import - = CodeGeneratorRequest'RequestedFile'Import + = CodeGeneratorRequest'RequestedFile'Import {id :: Word64, name :: Text} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize CodeGeneratorRequest'RequestedFile'Import where type Cerial msg CodeGeneratorRequest'RequestedFile'Import = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import msg decerialize raw = do CodeGeneratorRequest'RequestedFile'Import <$> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'id raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'name raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile'Import where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import M'.ConstMsg) instance C'.Marshal CodeGeneratorRequest'RequestedFile'Import where marshalInto raw value = do case value of @@ -701,18 +697,22 @@ field_ <- C'.cerialize (U'.message raw) name Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'name raw field_ instance C'.Cerialize s CodeGeneratorRequest'RequestedFile'Import +instance C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile'Import where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import M'.ConstMsg) instance Default CodeGeneratorRequest'RequestedFile'Import where def = PH'.defaultStruct data Field' - = Field'slot + = Field'slot {offset :: Word32, type_ :: Type, defaultValue :: Value, - hadExplicitDefault :: Bool} | - Field'group - {typeId :: Word64} | - Field'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + hadExplicitDefault :: Bool} + | Field'group + {typeId :: Word64} + | Field'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Field' where type Cerial msg Field' = Capnp.ById.Xa93fc509624c72d9.Field' msg decerialize raw = do @@ -725,11 +725,7 @@ (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'hadExplicitDefault raw) Capnp.ById.Xa93fc509624c72d9.Field'group raw -> Field'group <$> (Capnp.ById.Xa93fc509624c72d9.get_Field'group'typeId raw) - Capnp.ById.Xa93fc509624c72d9.Field'unknown' val -> pure (Field'unknown' val) -instance C'.FromStruct M'.ConstMsg Field' where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field' M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Field''unknown' val -> pure $ Field'unknown' val instance C'.Marshal Field' where marshalInto raw value = do case value of @@ -744,17 +740,19 @@ Field'group{..} -> do raw <- Capnp.ById.Xa93fc509624c72d9.set_Field'group raw Capnp.ById.Xa93fc509624c72d9.set_Field'group'typeId raw typeId - Field'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field'unknown' raw arg_ + Field'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field''unknown' raw arg_ instance C'.Cerialize s Field' +instance C'.FromStruct M'.ConstMsg Field' where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field' M'.ConstMsg) instance Default Field' where def = PH'.defaultStruct -field'noDiscriminant :: Word16 -field'noDiscriminant = Capnp.ById.Xa93fc509624c72d9.field'noDiscriminant data Field'ordinal - = Field'ordinal'implicit | - Field'ordinal'explicit (Word16) | - Field'ordinal'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Field'ordinal'implicit + | Field'ordinal'explicit (Word16) + | Field'ordinal'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Field'ordinal where type Cerial msg Field'ordinal = Capnp.ById.Xa93fc509624c72d9.Field'ordinal msg decerialize raw = do @@ -762,39 +760,38 @@ case raw of Capnp.ById.Xa93fc509624c72d9.Field'ordinal'implicit -> pure Field'ordinal'implicit Capnp.ById.Xa93fc509624c72d9.Field'ordinal'explicit val -> pure (Field'ordinal'explicit val) - Capnp.ById.Xa93fc509624c72d9.Field'ordinal'unknown' val -> pure (Field'ordinal'unknown' val) -instance C'.FromStruct M'.ConstMsg Field'ordinal where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field'ordinal M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Field'ordinal'unknown' val -> pure $ Field'ordinal'unknown' val instance C'.Marshal Field'ordinal where marshalInto raw value = do case value of Field'ordinal'implicit -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'implicit raw Field'ordinal'explicit arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'explicit raw arg_ Field'ordinal'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Field'ordinal'unknown' raw arg_ -instance C'.Cerialize s Field'ordinal +instance C'.FromStruct M'.ConstMsg Field'ordinal where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field'ordinal M'.ConstMsg) instance Default Field'ordinal where def = PH'.defaultStruct data Node' - = Node'file | - Node'struct + = Node'file + | Node'struct {dataWordCount :: Word16, pointerCount :: Word16, preferredListEncoding :: Capnp.ById.Xa93fc509624c72d9.ElementSize, isGroup :: Bool, discriminantCount :: Word16, discriminantOffset :: Word32, - fields :: PU'.ListOf (Field)} | - Node'enum - {enumerants :: PU'.ListOf (Enumerant)} | - Node'interface + fields :: PU'.ListOf (Field)} + | Node'enum + {enumerants :: PU'.ListOf (Enumerant)} + | Node'interface {methods :: PU'.ListOf (Method), - superclasses :: PU'.ListOf (Superclass)} | - Node'const + superclasses :: PU'.ListOf (Superclass)} + | Node'const {type_ :: Type, - value :: Value} | - Node'annotation + value :: Value} + | Node'annotation {type_ :: Type, targetsFile :: Bool, targetsConst :: Bool, @@ -807,9 +804,9 @@ targetsInterface :: Bool, targetsMethod :: Bool, targetsParam :: Bool, - targetsAnnotation :: Bool} | - Node'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + targetsAnnotation :: Bool} + | Node'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Node' where type Cerial msg Node' = Capnp.ById.Xa93fc509624c72d9.Node' msg decerialize raw = do @@ -846,11 +843,7 @@ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsMethod raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsParam raw) <*> (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsAnnotation raw) - Capnp.ById.Xa93fc509624c72d9.Node'unknown' val -> pure (Node'unknown' val) -instance C'.FromStruct M'.ConstMsg Node' where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node' M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Node''unknown' val -> pure $ Node'unknown' val instance C'.Marshal Node' where marshalInto raw value = do case value of @@ -909,25 +902,25 @@ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsMethod raw targetsMethod Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsParam raw targetsParam Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsAnnotation raw targetsAnnotation - Node'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Node'unknown' raw arg_ + Node'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Node''unknown' raw arg_ instance C'.Cerialize s Node' +instance C'.FromStruct M'.ConstMsg Node' where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node' M'.ConstMsg) instance Default Node' where def = PH'.defaultStruct data Node'NestedNode - = Node'NestedNode + = Node'NestedNode {name :: Text, id :: Word64} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Node'NestedNode where type Cerial msg Node'NestedNode = Capnp.ById.Xa93fc509624c72d9.Node'NestedNode msg decerialize raw = do Node'NestedNode <$> (Capnp.ById.Xa93fc509624c72d9.get_Node'NestedNode'name raw >>= C'.decerialize) <*> (Capnp.ById.Xa93fc509624c72d9.get_Node'NestedNode'id raw) -instance C'.FromStruct M'.ConstMsg Node'NestedNode where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'NestedNode M'.ConstMsg) instance C'.Marshal Node'NestedNode where marshalInto raw value = do case value of @@ -936,21 +929,21 @@ Capnp.ById.Xa93fc509624c72d9.set_Node'NestedNode'name raw field_ Capnp.ById.Xa93fc509624c72d9.set_Node'NestedNode'id raw id instance C'.Cerialize s Node'NestedNode +instance C'.FromStruct M'.ConstMsg Node'NestedNode where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'NestedNode M'.ConstMsg) instance Default Node'NestedNode where def = PH'.defaultStruct data Node'Parameter - = Node'Parameter + = Node'Parameter {name :: Text} - deriving(Show, Read, Eq, Generic) + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Node'Parameter where type Cerial msg Node'Parameter = Capnp.ById.Xa93fc509624c72d9.Node'Parameter msg decerialize raw = do Node'Parameter <$> (Capnp.ById.Xa93fc509624c72d9.get_Node'Parameter'name raw >>= C'.decerialize) -instance C'.FromStruct M'.ConstMsg Node'Parameter where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'Parameter M'.ConstMsg) instance C'.Marshal Node'Parameter where marshalInto raw value = do case value of @@ -958,18 +951,22 @@ field_ <- C'.cerialize (U'.message raw) name Capnp.ById.Xa93fc509624c72d9.set_Node'Parameter'name raw field_ instance C'.Cerialize s Node'Parameter +instance C'.FromStruct M'.ConstMsg Node'Parameter where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'Parameter M'.ConstMsg) instance Default Node'Parameter where def = PH'.defaultStruct data Type'anyPointer - = Type'anyPointer'unconstrained - {union' :: Type'anyPointer'unconstrained} | - Type'anyPointer'parameter + = Type'anyPointer'unconstrained + {union' :: Type'anyPointer'unconstrained} + | Type'anyPointer'parameter {scopeId :: Word64, - parameterIndex :: Word16} | - Type'anyPointer'implicitMethodParameter - {parameterIndex :: Word16} | - Type'anyPointer'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + parameterIndex :: Word16} + | Type'anyPointer'implicitMethodParameter + {parameterIndex :: Word16} + | Type'anyPointer'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Type'anyPointer where type Cerial msg Type'anyPointer = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer msg decerialize raw = do @@ -982,11 +979,7 @@ (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'parameterIndex raw) Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter raw -> Type'anyPointer'implicitMethodParameter <$> (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'implicitMethodParameter'parameterIndex raw) - Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unknown' val -> pure (Type'anyPointer'unknown' val) -instance C'.FromStruct M'.ConstMsg Type'anyPointer where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unknown' val -> pure $ Type'anyPointer'unknown' val instance C'.Marshal Type'anyPointer where marshalInto raw value = do case value of @@ -1002,16 +995,19 @@ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter raw Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter'parameterIndex raw parameterIndex Type'anyPointer'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unknown' raw arg_ -instance C'.Cerialize s Type'anyPointer +instance C'.FromStruct M'.ConstMsg Type'anyPointer where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer M'.ConstMsg) instance Default Type'anyPointer where def = PH'.defaultStruct data Type'anyPointer'unconstrained - = Type'anyPointer'unconstrained'anyKind | - Type'anyPointer'unconstrained'struct | - Type'anyPointer'unconstrained'list | - Type'anyPointer'unconstrained'capability | - Type'anyPointer'unconstrained'unknown' (Word16) - deriving(Show, Read, Eq, Generic) + = Type'anyPointer'unconstrained'anyKind + | Type'anyPointer'unconstrained'struct + | Type'anyPointer'unconstrained'list + | Type'anyPointer'unconstrained'capability + | Type'anyPointer'unconstrained'unknown' Word16 + deriving(Show,Read,Eq,Generic) instance C'.Decerialize Type'anyPointer'unconstrained where type Cerial msg Type'anyPointer'unconstrained = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained msg decerialize raw = do @@ -1021,11 +1017,7 @@ Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'struct -> pure Type'anyPointer'unconstrained'struct Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'list -> pure Type'anyPointer'unconstrained'list Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'capability -> pure Type'anyPointer'unconstrained'capability - Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'unknown' val -> pure (Type'anyPointer'unconstrained'unknown' val) -instance C'.FromStruct M'.ConstMsg Type'anyPointer'unconstrained where - fromStruct struct = do - raw <- C'.fromStruct struct - C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained M'.ConstMsg) + Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'unknown' val -> pure $ Type'anyPointer'unconstrained'unknown' val instance C'.Marshal Type'anyPointer'unconstrained where marshalInto raw value = do case value of @@ -1034,6 +1026,9 @@ Type'anyPointer'unconstrained'list -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'list raw Type'anyPointer'unconstrained'capability -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'capability raw Type'anyPointer'unconstrained'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'unknown' raw arg_ -instance C'.Cerialize s Type'anyPointer'unconstrained +instance C'.FromStruct M'.ConstMsg Type'anyPointer'unconstrained where + fromStruct struct = do + raw <- C'.fromStruct struct + C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained M'.ConstMsg) instance Default Type'anyPointer'unconstrained where def = PH'.defaultStruct diff --git a/lib/Data/Capnp.hs b/lib/Data/Capnp.hs --- a/lib/Data/Capnp.hs +++ b/lib/Data/Capnp.hs @@ -1,10 +1,9 @@ {- | Module: Data.Capnp -Description: The most commonly used functionality from the low-level API. +Description: The most commonly used functionality in the capnp package. -This module re-exports the most commonly used functionality from the -low-level API. See also "Data.Capnp.Pure", which similarly re-exports -functionality from the high-level API. +This module re-exports the most commonly used functionality from other modules in the +library. Users getting acquainted with the library are *strongly* encouraged to read the "Data.Capnp.Tutorial" module before anything else. @@ -26,29 +25,27 @@ , Message.Message(..) , Message.MutMsg , Message.newMessage - , decodeMessage - , encodeMessage - -- ** Reading and writing messages - , Message.hPutMsg - , Message.putMsg - , Message.hGetMsg - , Message.getMsg - -- * Manipulating the root object of a message , Codec.getRoot , Codec.newRoot , Codec.setRoot - -- * Reading values - , hGetValue - , getValue + -- * Marshalling data into and out of messages + , Classes.Decerialize(..) + , Classes.Cerialize(..) + -- * IO + , module Data.Capnp.IO + -- * Type aliases for common contexts , Message.WriteCtx , Untyped.ReadCtx , Untyped.RWCtx + -- * Converting between messages, Cap'N Proto values, and raw bytes + , module Data.Capnp.Convert + -- * Managing resource limits , module Data.Capnp.TraversalLimit @@ -58,17 +55,18 @@ -- * Building messages in pure code , PureBuilder , createPure - ) where -import Control.Monad.Catch (MonadThrow) + -- * Re-exported from "Data.Default", for convienence. + , def + ) where -import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as BB +import Data.Default (def) +import Data.Capnp.Convert +import Data.Capnp.IO import Data.Capnp.TraversalLimit import Data.Mutable -import Data.Capnp.IO (getValue, hGetValue) import Internal.BuildPure (PureBuilder, createPure) import qualified Codec.Capnp as Codec @@ -76,11 +74,3 @@ import qualified Data.Capnp.Classes as Classes import qualified Data.Capnp.Message as Message import qualified Data.Capnp.Untyped as Untyped - --- | Alias for 'Message.encode' -encodeMessage :: MonadThrow m => Message.ConstMsg -> m BB.Builder -encodeMessage = Message.encode - --- | Alias for 'Message.decode' -decodeMessage :: MonadThrow m => BS.ByteString -> m Message.ConstMsg -decodeMessage = Message.decode diff --git a/lib/Data/Capnp/Convert.hs b/lib/Data/Capnp/Convert.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Capnp/Convert.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-| +Module: Data.Capnp.Convert +Description: Convert between messages, typed capnproto values, and (lazy)bytestring(builders). + +This module provides various helper functions to convert between messages, types defined +in capnproto schema (called "values" in the rest of this module's documentation), +bytestrings (both lazy and strict), and bytestring builders. + +Note that not all conversions exist or necessarily make sense. +-} +module Data.Capnp.Convert + ( msgToBuilder + , msgToLBS + , msgToBS + , msgToValue + , bsToMsg + , bsToValue + , lbsToMsg + , lbsToValue + , valueToBuilder + , valueToBS + , valueToLBS + , valueToMsg + ) where + +import Control.Monad ((>=>)) +import Control.Monad.Catch (MonadThrow) +import Data.Foldable (foldlM) +import Data.Functor.Identity (runIdentity) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as LBS + +import Data.Capnp.Classes + +import Codec.Capnp (getRoot, setRoot) +import Data.Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT) +import Data.Mutable (freeze) + +import qualified Data.Capnp.Message as M + +-- | Compute a reasonable limit based on the size of a message. The limit +-- is the total number of words in all of the message's segments, multiplied +-- by 4 to provide provide a little slack for decoding default values. +limitFromMsg :: (MonadThrow m, M.Message m msg) => msg -> m Int +limitFromMsg msg = do + messageWords <- countMessageWords + pure (messageWords * 4) + where + countMessageWords = do + segCount <- M.numSegs msg + foldlM + (\total i -> do + words <- M.getSegment msg i >>= M.numWords + pure (words + total) + ) + 0 + [0..segCount - 1] + +-- | Convert an immutable message to a bytestring 'BB.Builder'. +-- To convert a mutable message, 'freeze' it first. +msgToBuilder :: M.ConstMsg -> BB.Builder +msgToBuilder = runIdentity . M.encode + +-- | Convert an immutable message to a lazy 'LBS.ByteString'. +-- To convert a mutable message, 'freeze' it first. +msgToLBS :: M.ConstMsg -> LBS.ByteString +msgToLBS = BB.toLazyByteString . msgToBuilder + +-- | Convert an immutable message to a strict 'BS.ByteString'. +-- To convert a mutable message, 'freeze' it first. +msgToBS :: M.ConstMsg -> BS.ByteString +msgToBS = LBS.toStrict . msgToLBS + +-- | Convert a message to a value. +msgToValue :: (MonadThrow m, M.Message (LimitT m) msg, M.Message m msg, FromStruct msg a) => msg -> m a +msgToValue msg = do + limit <- limitFromMsg msg + evalLimitT limit (getRoot msg) + +-- | Convert a strict 'BS.ByteString' to a message. +bsToMsg :: MonadThrow m => BS.ByteString -> m M.ConstMsg +bsToMsg = M.decode + +-- | Convert a strict 'BS.ByteString' to a value. +bsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => BS.ByteString -> m a +bsToValue = bsToMsg >=> msgToValue + +-- | Convert a lazy 'LBS.ByteString' to a message. +lbsToMsg :: MonadThrow m => LBS.ByteString -> m M.ConstMsg +lbsToMsg = bsToMsg . LBS.toStrict + +-- | Convert a lazy 'LBS.ByteString' to a value. +lbsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => LBS.ByteString -> m a +lbsToValue = bsToValue . LBS.toStrict + +-- | Convert a value to a 'BS.Builder'. +valueToBuilder :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BB.Builder +valueToBuilder val = msgToBuilder <$> (valueToMsg val >>= freeze) + +-- | Convert a value to a strict 'BS.ByteString'. +valueToBS :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BS.ByteString +valueToBS = fmap LBS.toStrict . valueToLBS + +-- | Convert a value to a lazy 'LBS.ByteString'. +valueToLBS :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m LBS.ByteString +valueToLBS = fmap BB.toLazyByteString . valueToBuilder + +-- | Convert a value to a message. +valueToMsg :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m (M.MutMsg s) +valueToMsg val = do + msg <- M.newMessage + ret <- cerialize msg val + setRoot ret + pure msg diff --git a/lib/Data/Capnp/GenHelpers.hs b/lib/Data/Capnp/GenHelpers.hs --- a/lib/Data/Capnp/GenHelpers.hs +++ b/lib/Data/Capnp/GenHelpers.hs @@ -10,13 +10,20 @@ -} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_HADDOCK hide #-} module Data.Capnp.GenHelpers where import Data.Bits import Data.Word +import Data.Maybe (fromJust) + +import qualified Data.ByteString as BS + import Data.Capnp.Bits +import Data.Capnp (bsToMsg, evalLimitT) + import qualified Data.Capnp.Classes as C import qualified Data.Capnp.Message as M import qualified Data.Capnp.Untyped as U @@ -46,3 +53,15 @@ old <- U.getData idx struct let new = replaceBits (value `xor` def) old offset U.setData new idx struct + +-- | Get a pointer from a ByteString, where the root object is a struct with +-- one pointer, which is the pointer we will retrieve. This is only safe for +-- trusted inputs; it reads the message with a traversal limit of 'maxBound' +-- (and so is suseptable to denial of service attacks), and it calls 'error' +-- if decoding is not successful. +-- +-- The purpose of this is for defining constants of pointer type from a schema. +getPtrConst :: C.IsPtr M.ConstMsg a => BS.ByteString -> a +getPtrConst bytes = fromJust $ do + msg <- bsToMsg bytes + evalLimitT maxBound $ U.rootPtr msg >>= U.getPtr 0 >>= C.fromPtr msg diff --git a/lib/Data/Capnp/GenHelpers/Pure.hs b/lib/Data/Capnp/GenHelpers/Pure.hs --- a/lib/Data/Capnp/GenHelpers/Pure.hs +++ b/lib/Data/Capnp/GenHelpers/Pure.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_HADDOCK hide #-} {- | Module: Data.Capnp.GenHelpers.Pure Description: Misc. helpers for generated code. @@ -14,9 +15,7 @@ -} module Data.Capnp.GenHelpers.Pure where -import Control.Monad.Catch.Pure (runCatchT) -import Data.Either (fromRight) -import Data.Functor.Identity (runIdentity) +import Data.Maybe (fromJust) import Data.Capnp.TraversalLimit (evalLimitT) @@ -28,8 +27,14 @@ -- the given constraints. defaultStruct :: (C.Decerialize a, C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg a)) => a defaultStruct = - fromRight (error "impossible") $ - runIdentity $ - runCatchT $ + fromJust $ evalLimitT maxBound $ U.rootPtr M.empty >>= C.fromStruct >>= C.decerialize + + +-- | Convert a low-level constant to a high-level constant. This trusts the +-- input, using maxBound as the traversal limit and calling 'error' on +-- decoding failures. It's purpose is defining constants the high-level +-- modules. +toPurePtrConst :: C.Decerialize a => C.Cerial M.ConstMsg a -> a +toPurePtrConst = fromJust . evalLimitT maxBound . C.decerialize diff --git a/lib/Data/Capnp/IO.hs b/lib/Data/Capnp/IO.hs --- a/lib/Data/Capnp/IO.hs +++ b/lib/Data/Capnp/IO.hs @@ -11,6 +11,10 @@ , getValue , hPutValue , putValue + , M.hGetMsg + , M.getMsg + , M.hPutMsg + , M.putMsg ) where import Control.Monad.Primitive (RealWorld) diff --git a/lib/Data/Capnp/Message.hs b/lib/Data/Capnp/Message.hs --- a/lib/Data/Capnp/Message.hs +++ b/lib/Data/Capnp/Message.hs @@ -65,6 +65,7 @@ import Data.Bytes.Get (getWord32le, runGetS) import Data.ByteString.Internal (ByteString(..)) import Data.Either (fromRight) +import Data.Maybe (fromJust) import Data.Primitive (MutVar, newMutVar, readMutVar, writeMutVar) import Data.Word (Word32, Word64) import System.Endian (fromLE64, toLE64) @@ -73,18 +74,21 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BB import qualified Data.Vector as V +import qualified Data.Vector.Generic.Mutable as GMV import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Storable as SV import qualified Data.Vector.Storable.Mutable as SMV import Data.Capnp.Address (WordAddr(..)) import Data.Capnp.Bits (WordCount(..), hi, lo) -import Data.Capnp.Errors (Error(..)) import Data.Capnp.TraversalLimit (LimitT, MonadLimit(invoice), evalLimitT) import Data.Mutable (Mutable(..)) +import Internal.AppendVec (AppendVec) import Internal.Util (checkIndex) +import qualified Internal.AppendVec as AppendVec + -- | The maximum size of a segment supported by this libarary, in words. maxSegmentSize :: Int maxSegmentSize = 1 `shiftL` 28 -- 2 GiB. @@ -181,11 +185,18 @@ decode bytes = fromByteString bytes >>= decodeSeg -- | 'encode' encodes a message as a bytestring builder. -encode :: MonadThrow m => ConstMsg -> m BB.Builder -encode msg = execWriterT $ writeMessage - msg - (tell . BB.word32LE) - (toByteString >=> tell . BB.byteString) +encode :: Monad m => ConstMsg -> m BB.Builder +encode msg = + -- We use Maybe as the MonadThrow instance required by + -- writeMessage/toByteString, but we know this can't actually fail, + -- so we ignore errors. TODO: we should get rid of the Monad constraint + -- on this function and just have the tyep be ConstMsg -> BB.Builder, + -- but that will have some cascading api effects, so we're deferring + -- that for a bit. + pure $ fromJust $ execWriterT $ writeMessage + msg + (tell . BB.word32LE) + (toByteString >=> tell . BB.byteString) -- | 'decodeSeg' decodes a message from a segment, treating the segment as if -- it were raw bytes. @@ -280,49 +291,30 @@ -- -- Due to mutabilty, the implementations of 'toByteString' and 'fromByteString' -- must make full copies, and so are O(n) in the length of the segment. -data MutMsg s = MutMsg - { mutMsgSegs :: MutVar s (MV.MVector s (Segment (MutMsg s))) - -- ^ A vector of segments. A suffix of this may be unused; see below. - , mutMsgLen :: MutVar s Int - -- ^ The "true" number of segments in the message. This may be shorter - -- than @'MV.length' mutMsgSegs@; the remainder is considered - -- unallocated space, and is used for amortized O(1) appending. - } +newtype MutMsg s = MutMsg (MutVar s (AppendVec MV.MVector s (Segment (MutMsg s)))) + deriving(Eq) -- | 'WriteCtx' is the context needed for most write operations. type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m) instance (PrimMonad m, s ~ PrimState m) => Message m (MutMsg s) where - data Segment (MutMsg s) = MutSegment - { mutSegVec :: !(SMV.MVector s Word64) - -- ^ The underlying vector of words storing segment's data. - , mutSegLen :: !Int - -- ^ The "true" length fo the segment. This may be shorter - -- than @'SMV.length' mutSegVec@; it is analogous to 'mutMsgLen' - -- at the message level. - } + newtype Segment (MutMsg s) = MutSegment (AppendVec SMV.MVector s Word64) - numWords MutSegment{mutSegLen} = pure mutSegLen - slice start len MutSegment{mutSegVec,mutSegLen} = - pure MutSegment - { mutSegVec = SMV.slice start len mutSegVec - , mutSegLen = len - } - read MutSegment{mutSegVec} i = fromLE64 <$> SMV.read mutSegVec i + numWords (MutSegment mseg) = pure $ GMV.length (AppendVec.getVector mseg) + slice start len (MutSegment mseg) = + pure $ MutSegment $ AppendVec.fromVector $ + SMV.slice start len (AppendVec.getVector mseg) + read (MutSegment mseg) i = fromLE64 <$> SMV.read (AppendVec.getVector mseg) i fromByteString bytes = do vec <- constSegToVec <$> fromByteString bytes - mvec <- SV.thaw vec - pure MutSegment - { mutSegVec = mvec - , mutSegLen = SV.length vec - } + MutSegment . AppendVec.fromVector <$> SV.thaw vec toByteString mseg = do seg <- freeze mseg toByteString (seg :: Segment ConstMsg) - numSegs = readMutVar . mutMsgLen - internalGetSeg MutMsg{mutMsgSegs} i = do - segs <- readMutVar mutMsgSegs + numSegs (MutMsg segVar) = GMV.length . AppendVec.getVector <$> readMutVar segVar + internalGetSeg (MutMsg segVar) i = do + segs <- AppendVec.getVector <$> readMutVar segVar MV.read segs i @@ -330,48 +322,38 @@ -- index in the message. Most callers should use the 'setSegment' wrapper, -- instead of calling this directly. internalSetSeg :: WriteCtx m s => MutMsg s -> Int -> Segment (MutMsg s) -> m () -internalSetSeg MutMsg{mutMsgSegs} segIndex seg = do - segs <- readMutVar mutMsgSegs +internalSetSeg (MutMsg segVar) segIndex seg = do + segs <- AppendVec.getVector <$> readMutVar segVar MV.write segs segIndex seg -- | @'write' segment index value@ writes a value to the 64-bit word -- at the provided index. Consider using 'setWord' on the message, -- instead of calling this directly. write :: WriteCtx m s => Segment (MutMsg s) -> Int -> Word64 -> m () -write MutSegment{mutSegVec} i val = - SMV.write mutSegVec i (toLE64 val) +write (MutSegment seg) i val = + SMV.write (AppendVec.getVector seg) i (toLE64 val) -- | @'grow' segment amount@ grows the segment by the specified number -- of 64-bit words. The original segment should not be used afterwards. grow :: WriteCtx m s => Segment (MutMsg s) -> Int -> m (Segment (MutMsg s)) -grow MutSegment{mutSegVec} amount = do - -- TODO: use unallocated space if available, instead of actually resizing. - when (maxSegmentSize - amount < SMV.length mutSegVec) $ - throwM SizeError - newVec <- SMV.grow mutSegVec amount - pure MutSegment - { mutSegVec = newVec - , mutSegLen = SMV.length newVec - } +grow (MutSegment vec) amount = + MutSegment <$> AppendVec.grow vec amount maxSegmentSize -- | @'newSegment' msg sizeHint@ allocates a new, initially empty segment in -- @msg@ with a capacity of @sizeHint@. It returns the a pair of the segment -- number and the segment itself. Amortized O(1). newSegment :: WriteCtx m s => MutMsg s -> Int -> m (Int, Segment (MutMsg s)) -newSegment msg@MutMsg{mutMsgSegs,mutMsgLen} sizeHint = do - newSegVec <- SMV.new sizeHint +newSegment msg@(MutMsg segVar) sizeHint = do + -- the next segment number will be equal to the *current* number of + -- segments: segIndex <- numSegs msg - when (segIndex >= maxSegments) $ - throwM SizeError - segs <- readMutVar mutMsgSegs - when (MV.length segs == segIndex) $ do - -- out of space; double the length of the message. - MV.grow segs segIndex >>= writeMutVar mutMsgSegs - writeMutVar mutMsgLen (segIndex * 2) - let newSeg = MutSegment - { mutSegVec = newSegVec - , mutSegLen = 0 - } + + -- make space for th new segment + segs <- readMutVar segVar + segs <- AppendVec.grow segs 1 maxSegments + writeMutVar segVar segs + + newSeg <- MutSegment . AppendVec.makeEmpty <$> SMV.new sizeHint setSegment msg segIndex newSeg pure (segIndex, newSeg) @@ -379,8 +361,11 @@ -- index of the segment in which to allocate the data. allocInSeg :: WriteCtx m s => MutMsg s -> Int -> WordCount -> m WordAddr allocInSeg msg segIndex (WordCount size) = do - oldSeg@MutSegment{mutSegLen} <- getSegment msg segIndex - let ret = WordAt { segIndex, wordIndex = WordCount mutSegLen } + oldSeg@(MutSegment vec) <- getSegment msg segIndex + let ret = WordAt + { segIndex + , wordIndex = WordCount $ GMV.length $ AppendVec.getVector vec + } newSeg <- grow oldSeg size setSegment msg segIndex newSeg pure ret @@ -404,23 +389,16 @@ instance Thaw (Segment ConstMsg) where type Mutable s (Segment ConstMsg) = Segment (MutMsg s) - thaw = thawSeg SV.thaw - unsafeThaw = thawSeg SV.unsafeThaw - freeze = freezeSeg SV.freeze - unsafeFreeze = freezeSeg SV.unsafeFreeze + thaw = thawSeg thaw + unsafeThaw = thawSeg unsafeThaw + freeze = freezeSeg freeze + unsafeFreeze = freezeSeg unsafeFreeze -- Helpers for @Segment ConstMsg@'s Thaw instance. -thawSeg thaw (ConstSegment vec) = do - mvec <- thaw vec - pure MutSegment - { mutSegVec = mvec - , mutSegLen = SV.length vec - } -freezeSeg freeze seg@MutSegment{mutSegLen} = do - -- Slice before freezing, so we don't waste time copying - -- the unallocated portion: - MutSegment{mutSegVec} <- slice 0 mutSegLen seg - ConstSegment <$> freeze mutSegVec +thawSeg thaw (ConstSegment vec) = + MutSegment <$> thaw (AppendVec.FrozenAppendVec vec) +freezeSeg freeze (MutSegment mvec) = + ConstSegment . AppendVec.getFrozenVector <$> freeze mvec instance Thaw ConstMsg where type Mutable s ConstMsg = MutMsg s @@ -433,9 +411,7 @@ -- Helpers for ConstMsg's Thaw instance. thawMsg thaw (ConstMsg vec) = do segments <- V.mapM thaw vec >>= V.unsafeThaw - MutMsg - <$> newMutVar segments - <*> newMutVar (MV.length segments) -freezeMsg freeze msg@MutMsg{mutMsgLen} = do - len <- readMutVar mutMsgLen - ConstMsg <$> V.generateM len (internalGetSeg msg >=> freeze) + MutMsg <$> newMutVar (AppendVec.fromVector segments) +freezeMsg freeze msg = do + len <- numSegs msg + ConstMsg <$> V.generateM len (internalGetSeg msg >=> freeze) diff --git a/lib/Data/Capnp/Pure.hs b/lib/Data/Capnp/Pure.hs deleted file mode 100644 --- a/lib/Data/Capnp/Pure.hs +++ /dev/null @@ -1,52 +0,0 @@ -{- | -Module: Data.Capnp.Pure -Description: The most commonly used functionality from the high-level API. - -This module re-exports the most commonly used functionality from the high-level -API. See also "Data.Capnp", which does the same for the low-level API. - -Users getting acquainted with the library are *strongly* encouraged to read the -"Data.Capnp.Tutorial" module before anything else. --} -module Data.Capnp.Pure - ( - -- * Reading and writing values - hPutValue - , Capnp.hGetValue - , putValue - , Capnp.getValue - - - -- * Working directly with messages - , Capnp.decodeMessage - , Capnp.encodeMessage - , Capnp.ConstMsg - , Capnp.Message(..) - - -- * Getting values in and out of messages - , Capnp.getRoot - , Classes.Decerialize(..) - , Classes.Cerialize(..) - - -- * Managing resource limits - , module Data.Capnp.TraversalLimit - - - -- * Aliases for built-in capnproto types. - , Basics.Text(..) - , Basics.Data(..) - - -- * Re-exported from data-default - , def - ) where - - -import Data.Default (def) - -import Data.Capnp.TraversalLimit - -import Data.Capnp.IO (hPutValue, putValue) - -import qualified Data.Capnp as Capnp -import qualified Data.Capnp.Basics.Pure as Basics -import qualified Data.Capnp.Classes as Classes diff --git a/lib/Data/Capnp/Tutorial.hs b/lib/Data/Capnp/Tutorial.hs --- a/lib/Data/Capnp/Tutorial.hs +++ b/lib/Data/Capnp/Tutorial.hs @@ -32,13 +32,12 @@ ) where -- So haddock references work: -import System.IO (stdin, stdout) +import System.IO (stdout) import qualified Data.ByteString as BS import qualified Data.Text as T import Data.Capnp -import Data.Capnp.Pure import Data.Capnp.Classes (FromStruct) @@ -187,9 +186,9 @@ intended to. The instance maps @'def'@ to the default value as defined by capnproto, so leaving out newly-added fields will do The Right Thing. -The module `Data.Capnp.Pure` exposes the most frequently used -functionality from the high level API. We can output an address book -message to standard output like so: +The module "Data.Capnp" exposes the most frequently used +functionality from the capnp package. We can write an address book +message to standard output using the high-level API like so: > {-# LANGUAGE OverloadedStrings #-} > -- Note that DuplicateRecordFields is usually needed, as the generated @@ -198,8 +197,8 @@ > {-# LANGUAGE DuplicateRecordFields #-} > import Capnp.Addressbook.Pure > -> -- Note that Data.Capnp.Pure re-exports `def`, as a convienence -> import Data.Capnp.Pure (putValue, def) +> -- Note that Data.Capnp re-exports `def`, as a convienence +> import Data.Capnp (putValue, def) > > import qualified Data.Vector as V > @@ -243,7 +242,7 @@ > -- ... > -> import Data.Capnp.Pure (getValue, defaultLimit) +> import Data.Capnp (getValue, defaultLimit) > > -- ... > @@ -256,7 +255,7 @@ used you may have to give GHC a hint for type inference to succeed. The type of 'getValue' is: -> 'getValue' :: 'FromStruct' 'ConstMsg' a => 'Int' -> 'IO' a +@'getValue' :: 'FromStruct' 'ConstMsg' a => 'Int' -> 'IO' a@ ...and so it may be used to read in any struct type. @@ -415,6 +414,7 @@ > import Data.Capnp > ( MutMsg > , PureBuilder +> , cerialize > , createPure > , defaultLimit > , index @@ -422,7 +422,6 @@ > , newRoot > , putMsg > ) -> import Data.Capnp.Pure (cerialize) > > import qualified Data.Text as T > diff --git a/lib/Data/Capnp/Untyped.hs b/lib/Data/Capnp/Untyped.hs --- a/lib/Data/Capnp/Untyped.hs +++ b/lib/Data/Capnp/Untyped.hs @@ -344,10 +344,13 @@ ------------------------------------------------------------------------------- --- | Types @a@ whose storage is owned by a message with blob type @b@. -class HasMessage a msg where +-- | Types @a@ whose storage is owned by a message.. +class HasMessage a where + -- | The type of the messages containing @a@s. + type InMessage a + -- | Get the message in which the @a@ is stored. - message :: a -> msg + message :: a -> InMessage a -- | Types which have a "default" value, but require a message -- to construct it. @@ -355,21 +358,27 @@ -- The default is usually conceptually zero-size. This is mostly useful -- for generated code, so that it can use standard decoding techniques -- on default values. -class HasMessage a msg => MessageDefault a msg where - messageDefault :: msg -> a +class HasMessage a => MessageDefault a where + messageDefault :: InMessage a -> a -instance HasMessage (Ptr msg) msg where +instance HasMessage (Ptr msg) where + type InMessage (Ptr msg) = msg + message (PtrCap msg _) = msg message (PtrList list) = message list message (PtrStruct struct) = message struct -instance HasMessage (Struct msg) msg where +instance HasMessage (Struct msg) where + type InMessage (Struct msg) = msg + message (Struct msg _ _ _) = msg -instance MessageDefault (Struct msg) msg where +instance MessageDefault (Struct msg) where messageDefault msg = Struct msg (WordAt 0 0) 0 0 -instance HasMessage (List msg) msg where +instance HasMessage (List msg) where + type InMessage (List msg) = msg + message (List0 list) = message list message (List1 list) = message list message (List8 list) = message list @@ -379,7 +388,9 @@ message (ListPtr list) = message list message (ListStruct list) = message list -instance HasMessage (ListOf msg a) msg where +instance HasMessage (ListOf msg a) where + type InMessage (ListOf msg a) = msg + message (ListOfVoid msg _) = msg message (ListOfStruct tag _) = message tag message (ListOfBool list) = message list @@ -389,27 +400,29 @@ message (ListOfWord64 list) = message list message (ListOfPtr list) = message list -instance MessageDefault (ListOf msg ()) msg where +instance MessageDefault (ListOf msg ()) where messageDefault msg = ListOfVoid msg 0 -instance MessageDefault (ListOf msg (Struct msg)) msg where +instance MessageDefault (ListOf msg (Struct msg)) where messageDefault msg = ListOfStruct (messageDefault msg) 0 -instance MessageDefault (ListOf msg Bool) msg where +instance MessageDefault (ListOf msg Bool) where messageDefault msg = ListOfBool (messageDefault msg) -instance MessageDefault (ListOf msg Word8) msg where +instance MessageDefault (ListOf msg Word8) where messageDefault msg = ListOfWord8 (messageDefault msg) -instance MessageDefault (ListOf msg Word16) msg where +instance MessageDefault (ListOf msg Word16) where messageDefault msg = ListOfWord16 (messageDefault msg) -instance MessageDefault (ListOf msg Word32) msg where +instance MessageDefault (ListOf msg Word32) where messageDefault msg = ListOfWord32 (messageDefault msg) -instance MessageDefault (ListOf msg Word64) msg where +instance MessageDefault (ListOf msg Word64) where messageDefault msg = ListOfWord64 (messageDefault msg) -instance MessageDefault (ListOf msg (Maybe (Ptr msg))) msg where +instance MessageDefault (ListOf msg (Maybe (Ptr msg))) where messageDefault msg = ListOfPtr (messageDefault msg) -instance HasMessage (NormalList msg) msg where +instance HasMessage (NormalList msg) where + type InMessage (NormalList msg) = msg + message = nMsg -instance MessageDefault (NormalList msg) msg where +instance MessageDefault (NormalList msg) where messageDefault msg = NormalList msg (WordAt 0 0) 0 -- | @get msg addr@ returns the Ptr stored at @addr@ in @msg@. @@ -529,7 +542,7 @@ ptrAddr (PtrList list) = listAddr list -- | @'setIndex value i list@ Set the @i@th element of @list@ to @value@. -setIndex :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) => a -> Int -> ListOf (M.MutMsg s) a -> m () +setIndex :: RWCtx m s => a -> Int -> ListOf (M.MutMsg s) a -> m () setIndex value i list | length list <= i = throwM E.BoundsError { E.index = i, E.maxIndex = length list } setIndex value i list = case list of @@ -540,6 +553,9 @@ ListOfWord32 nlist -> setNIndex nlist 2 value ListOfWord64 nlist -> setNIndex nlist 1 value ListOfPtr nlist -> case value of + Just p | message p /= message list -> do + newPtr <- copyPtr (message list) value + setIndex newPtr i list Nothing -> setNIndex nlist 1 (P.serializePtr Nothing) Just (PtrCap _ cap) -> setNIndex nlist 1 (P.serializePtr (Just (P.CapPtr cap))) Just p@(PtrList ptrList) -> @@ -589,10 +605,56 @@ Left OutOfRange -> error "BUG: segment is too large to set the pointer." +copyPtr :: RWCtx m s => M.MutMsg s -> Maybe (Ptr (M.MutMsg s)) -> m (Maybe (Ptr (M.MutMsg s))) +copyPtr dest Nothing = pure Nothing +copyPtr dest (Just (PtrCap _ n)) = pure $ Just (PtrCap dest n) +copyPtr dest (Just (PtrList src)) = Just . PtrList <$> copyList dest src +copyPtr dest (Just (PtrStruct src)) = Just . PtrStruct <$> do + destStruct <- allocStruct + dest + (fromIntegral $ length (dataSection src)) + (fromIntegral $ length (ptrSection src)) + copyStruct destStruct src + pure destStruct +copyList :: RWCtx m s => M.MutMsg s -> List (M.MutMsg s) -> m (List (M.MutMsg s)) +copyList dest src = case src of + List0 src -> List0 <$> allocList0 dest (length src) + List1 src -> List1 <$> copyNewListOf dest src allocList1 + List8 src -> List8 <$> copyNewListOf dest src allocList8 + List16 src -> List16 <$> copyNewListOf dest src allocList16 + List32 src -> List32 <$> copyNewListOf dest src allocList32 + List64 src -> List64 <$> copyNewListOf dest src allocList64 + ListPtr src -> ListPtr <$> copyNewListOf dest src allocListPtr + ListStruct src -> ListStruct <$> do + destList <- allocCompositeList + dest + (structListDataCount src) + (structListPtrCount src) + (length src) + copyListOf destList src + pure destList + +copyNewListOf + :: RWCtx m s + => M.MutMsg s + -> ListOf (M.MutMsg s) a + -> (M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) a)) + -> m (ListOf (M.MutMsg s) a) +copyNewListOf destMsg src new = do + dest <- new destMsg (length src) + copyListOf dest src + pure dest + + +copyListOf :: RWCtx m s => ListOf (M.MutMsg s) a -> ListOf (M.MutMsg s) a -> m () +copyListOf dest src = + forM_ [0..length src - 1] $ \i -> do + value <- index i src + setIndex value i dest + -- | @'copyStruct' dest src@ copies the source struct to the destination struct. -copyStruct :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) - => Struct (M.MutMsg s) -> Struct (M.MutMsg s) -> m () +copyStruct :: RWCtx m s => Struct (M.MutMsg s) -> Struct (M.MutMsg s) -> m () copyStruct dest src = do -- We copy both the data and pointer sections from src to dest, -- padding the tail of the destination section with zeros/null @@ -607,9 +669,7 @@ where copySection dest src pad = do -- Copy the source section to the destination section: - forM_ [0..length src - 1] $ \i -> do - value <- index i src - setIndex value i dest + copyListOf dest src -- Pad the remainder with zeros/default values: forM_ [length src..length dest - 1] $ \i -> setIndex pad i dest @@ -692,6 +752,22 @@ msg addr { wordIndex = wordIndex + fromIntegral dataSz } (fromIntegral ptrSz) + +-- | Get the size (in words) of a struct's data section. +structDataCount :: Struct msg -> Word16 +structDataCount = fromIntegral . length . dataSection + +-- | Get the size of a struct's pointer section. +structPtrCount :: Struct msg -> Word16 +structPtrCount = fromIntegral . length . ptrSection + +-- | Get the size (in words) of the data sections in a composite list. +structListDataCount :: ListOf msg (Struct msg) -> Word16 +structListDataCount (ListOfStruct s _) = structDataCount s + +-- | Get the size of the pointer sections in a composite list. +structListPtrCount :: ListOf msg (Struct msg) -> Word16 +structListPtrCount (ListOfStruct s _) = structPtrCount s -- | @'getData' i struct@ gets the @i@th word from the struct's data section, -- returning 0 if it is absent. diff --git a/lib/Internal/AppendVec.hs b/lib/Internal/AppendVec.hs new file mode 100644 --- /dev/null +++ b/lib/Internal/AppendVec.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeFamilies #-} +{- | +Module: Internal.AppendVec +Description: Helpers for efficient appending to vectors. +-} +module Internal.AppendVec + ( AppendVec + , fromVector + , makeEmpty + , getVector + , FrozenAppendVec(..) + , grow + ) where + +import Control.Monad (when) +import Control.Monad.Catch (MonadThrow(throwM)) +import Control.Monad.Primitive (PrimMonad, PrimState) + +import qualified Data.Vector.Generic as GV +import qualified Data.Vector.Generic.Mutable as GMV + +import Data.Capnp.Errors (Error(SizeError)) +import Data.Mutable (Thaw(..)) + +-- | 'AppendVec' wraps a mutable vector, and affords amortized O(1) appending. +data AppendVec v s a = AppendVec + { mutVec :: v s a + , mutVecLen :: !Int + } + +-- | 'fromVector' wraps a mutable vector in an appendVector, with no initial +-- spare capacity. +fromVector :: GMV.MVector v a => v s a -> AppendVec v s a +fromVector vec = AppendVec + { mutVec = vec + , mutVecLen = GMV.length vec + } + +-- | 'makeEmpty' makes an initially empty 'AppendVec', using the argument +-- as allocation space for 'grow'. +makeEmpty :: GMV.MVector v a => v s a -> AppendVec v s a +makeEmpty vec = AppendVec + { mutVec = vec + , mutVecLen = 0 + } + +-- | 'getVector' returns the valid portion of the underlying mutable vector. +getVector :: GMV.MVector v a => AppendVec v s a -> v s a +getVector AppendVec{mutVec, mutVecLen} = GMV.slice 0 mutVecLen mutVec + +-- | immutable version of 'AppendVec'; this is defined for the purpose of +-- implementing 'Thaw'. +newtype FrozenAppendVec v a = FrozenAppendVec { getFrozenVector :: v a } + +instance GV.Vector v a => Thaw (FrozenAppendVec v a) where + type Mutable s (FrozenAppendVec v a) = AppendVec (GV.Mutable v) s a + + thaw = thawAppend GV.thaw + unsafeThaw = thawAppend GV.unsafeThaw + freeze = freezeAppend GV.freeze + unsafeFreeze = freezeAppend GV.unsafeFreeze + +-- Helpers for the thaw & freeze methods for the instance above. +thawAppend thaw frozen = do + mvec <- thaw $ getFrozenVector frozen + pure AppendVec + { mutVec = mvec + , mutVecLen = GMV.length mvec + } +freezeAppend freeze = fmap FrozenAppendVec . freeze . getVector + +-- | @'grow' vec amount maxSize@ grows the vector @vec@ by @amount@ elements, +-- provided the result does not exceed @maxSize@. Amortized O(@amount@). Returns +-- the new vector; the original should not be used. +-- . +-- If the result does exceed @maxSize@, throws 'SizeError'. +grow :: (MonadThrow m, PrimMonad m, s ~ PrimState m, GMV.MVector v a) + => AppendVec v s a -> Int -> Int -> m (AppendVec v s a) +grow AppendVec{mutVec,mutVecLen} amount maxSize = do + when (maxSize - amount < mutVecLen) $ + throwM SizeError + mutVec <- + if mutVecLen + amount <= GMV.length mutVec then + -- we have enough un-allocated space already; leave the vector + -- itself alone. + pure mutVec + else + -- Allocate some more space. we at least double the underlying + -- vector's size, to make appending amortized O(1), but if the + -- vector is small enough and the allocation is big enough, we + -- may need to do more to satisfy the request: + GMV.grow mutVec (max amount (mutVecLen * 2)) + pure AppendVec + { mutVec = mutVec + , mutVecLen = mutVecLen + amount + } diff --git a/lib/Internal/Gen/Instances.hs b/lib/Internal/Gen/Instances.hs --- a/lib/Internal/Gen/Instances.hs +++ b/lib/Internal/Gen/Instances.hs @@ -12,6 +12,7 @@ ( ListElem(..) , MutListElem(..) , IsPtr(..) + , Decerialize(..) ) import qualified Data.Capnp.Untyped as U @@ -26,6 +27,9 @@ instance IsPtr msg (List msg Int8) where fromPtr msg ptr = ListInt8 <$> fromPtr msg ptr toPtr (ListInt8 list) = Just (U.PtrList (U.List8 list)) +instance Decerialize Int8 where + type Cerial msg Int8 = Int8 + decerialize val = pure val instance ListElem msg Int16 where newtype List msg Int16 = ListInt16 (U.ListOf msg Word16) length (ListInt16 l) = U.length l @@ -36,6 +40,9 @@ instance IsPtr msg (List msg Int16) where fromPtr msg ptr = ListInt16 <$> fromPtr msg ptr toPtr (ListInt16 list) = Just (U.PtrList (U.List16 list)) +instance Decerialize Int16 where + type Cerial msg Int16 = Int16 + decerialize val = pure val instance ListElem msg Int32 where newtype List msg Int32 = ListInt32 (U.ListOf msg Word32) length (ListInt32 l) = U.length l @@ -46,6 +53,9 @@ instance IsPtr msg (List msg Int32) where fromPtr msg ptr = ListInt32 <$> fromPtr msg ptr toPtr (ListInt32 list) = Just (U.PtrList (U.List32 list)) +instance Decerialize Int32 where + type Cerial msg Int32 = Int32 + decerialize val = pure val instance ListElem msg Int64 where newtype List msg Int64 = ListInt64 (U.ListOf msg Word64) length (ListInt64 l) = U.length l @@ -56,6 +66,9 @@ instance IsPtr msg (List msg Int64) where fromPtr msg ptr = ListInt64 <$> fromPtr msg ptr toPtr (ListInt64 list) = Just (U.PtrList (U.List64 list)) +instance Decerialize Int64 where + type Cerial msg Int64 = Int64 + decerialize val = pure val instance ListElem msg Word8 where newtype List msg Word8 = ListWord8 (U.ListOf msg Word8) length (ListWord8 l) = U.length l @@ -66,6 +79,9 @@ instance IsPtr msg (List msg Word8) where fromPtr msg ptr = ListWord8 <$> fromPtr msg ptr toPtr (ListWord8 list) = Just (U.PtrList (U.List8 list)) +instance Decerialize Word8 where + type Cerial msg Word8 = Word8 + decerialize val = pure val instance ListElem msg Word16 where newtype List msg Word16 = ListWord16 (U.ListOf msg Word16) length (ListWord16 l) = U.length l @@ -76,6 +92,9 @@ instance IsPtr msg (List msg Word16) where fromPtr msg ptr = ListWord16 <$> fromPtr msg ptr toPtr (ListWord16 list) = Just (U.PtrList (U.List16 list)) +instance Decerialize Word16 where + type Cerial msg Word16 = Word16 + decerialize val = pure val instance ListElem msg Word32 where newtype List msg Word32 = ListWord32 (U.ListOf msg Word32) length (ListWord32 l) = U.length l @@ -86,6 +105,9 @@ instance IsPtr msg (List msg Word32) where fromPtr msg ptr = ListWord32 <$> fromPtr msg ptr toPtr (ListWord32 list) = Just (U.PtrList (U.List32 list)) +instance Decerialize Word32 where + type Cerial msg Word32 = Word32 + decerialize val = pure val instance ListElem msg Word64 where newtype List msg Word64 = ListWord64 (U.ListOf msg Word64) length (ListWord64 l) = U.length l @@ -96,6 +118,9 @@ instance IsPtr msg (List msg Word64) where fromPtr msg ptr = ListWord64 <$> fromPtr msg ptr toPtr (ListWord64 list) = Just (U.PtrList (U.List64 list)) +instance Decerialize Word64 where + type Cerial msg Word64 = Word64 + decerialize val = pure val instance ListElem msg Float where newtype List msg Float = ListFloat (U.ListOf msg Word32) length (ListFloat l) = U.length l @@ -106,6 +131,9 @@ instance IsPtr msg (List msg Float) where fromPtr msg ptr = ListFloat <$> fromPtr msg ptr toPtr (ListFloat list) = Just (U.PtrList (U.List32 list)) +instance Decerialize Float where + type Cerial msg Float = Float + decerialize val = pure val instance ListElem msg Double where newtype List msg Double = ListDouble (U.ListOf msg Word64) length (ListDouble l) = U.length l @@ -116,6 +144,9 @@ instance IsPtr msg (List msg Double) where fromPtr msg ptr = ListDouble <$> fromPtr msg ptr toPtr (ListDouble list) = Just (U.PtrList (U.List64 list)) +instance Decerialize Double where + type Cerial msg Double = Double + decerialize val = pure val instance ListElem msg Bool where newtype List msg Bool = ListBool (U.ListOf msg Bool) length (ListBool l) = U.length l @@ -126,3 +157,6 @@ instance IsPtr msg (List msg Bool) where fromPtr msg ptr = ListBool <$> fromPtr msg ptr toPtr (ListBool list) = Just (U.PtrList (U.List1 list)) +instance Decerialize Bool where + type Cerial msg Bool = Bool + decerialize val = pure val diff --git a/scripts/gen-basic-instances.hs b/scripts/gen-basic-instances.hs --- a/scripts/gen-basic-instances.hs +++ b/scripts/gen-basic-instances.hs @@ -18,6 +18,7 @@ , " ( ListElem(..)" , " , MutListElem(..)" , " , IsPtr(..)" + , " , Decerialize(..)" , " )" , "" , "import qualified Data.Capnp.Untyped as U" @@ -44,6 +45,9 @@ , "instance IsPtr msg (List msg ", typed, ") where\n" , " fromPtr msg ptr = List", typed, " <$> fromPtr msg ptr\n" , " toPtr (List", typed, " list) = Just (U.PtrList (U.List", listSuffix, " list))\n" + , "instance Decerialize ", typed, " where\n" + , " type Cerial msg ", typed, " = ", typed, "\n" + , " decerialize val = pure val\n" ] where dataCon = "List" ++ typed diff --git a/tests/Instances.hs b/tests/Instances.hs new file mode 100644 --- /dev/null +++ b/tests/Instances.hs @@ -0,0 +1,322 @@ +{-| +Module: Instances +Description: Instances of Arbitrary for various types. + +In particular, stuff from: + +* "Data.Capnp.Untyped.Pure" +* "Capnp.Capnp.Schema.Pure" +-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} +module Instances () where + +import Data.Word +import Test.QuickCheck + +import Test.QuickCheck.Instances () + +import qualified Data.Vector as V + +import Capnp.Capnp.Schema.Pure + +import qualified Data.Capnp.Untyped.Pure as PU + +-- Generate an arbitrary "unknown" tag, i.e. one with a value unassigned +-- by the schema. The parameter is the number of tags assigned by the schema. +arbitraryTag :: Word16 -> Gen Word16 +arbitraryTag numTags = max numTags <$> arbitrary + +instance Arbitrary Node where + shrink = genericShrink + arbitrary = do + id <- arbitrary + displayName <- arbitrary + displayNamePrefixLength <- arbitrary + scopeId <- arbitrary + parameters <- arbitrarySmallerVec + isGeneric <- arbitrary + nestedNodes <- arbitrarySmallerVec + annotations <- arbitrarySmallerVec + union' <- arbitrary + pure Node{..} + +instance Arbitrary Node' where + shrink = genericShrink + arbitrary = oneof + [ pure Node'file + , do + dataWordCount <- arbitrary + pointerCount <- arbitrary + preferredListEncoding <- arbitrary + isGroup <- arbitrary + discriminantCount <- arbitrary + discriminantOffset <- arbitrary + fields <- arbitrarySmallerVec + pure Node'struct{..} + , Node'enum <$> arbitrarySmallerVec + , Node'interface <$> arbitrarySmallerVec <*> arbitrarySmallerVec + , Node'const <$> arbitrary <*> arbitrary + , do + type_ <- arbitrary + targetsFile <- arbitrary + targetsConst <- arbitrary + targetsEnum <- arbitrary + targetsEnumerant <- arbitrary + targetsStruct <- arbitrary + targetsField <- arbitrary + targetsUnion <- arbitrary + targetsGroup <- arbitrary + targetsInterface <- arbitrary + targetsMethod <- arbitrary + targetsParam <- arbitrary + targetsAnnotation <- arbitrary + pure Node'annotation{..} + , Node'unknown' <$> arbitraryTag 6 + ] + +instance Arbitrary Node'NestedNode where + shrink = genericShrink + arbitrary = Node'NestedNode + <$> arbitrary + <*> arbitrary + +instance Arbitrary Field where + shrink = genericShrink + arbitrary = do + name <- arbitrary + codeOrder <- arbitrary + annotations <- arbitrary + discriminantValue <- arbitrary + union' <- arbitrary + ordinal <- arbitrary + pure Field{..} + +instance Arbitrary Field' where + shrink = genericShrink + arbitrary = oneof + [ do + offset <- arbitrary + type_ <- arbitrary + defaultValue <- arbitrary + hadExplicitDefault <- arbitrary + pure Field'slot{..} + , Field'group <$> arbitrary + ] + +instance Arbitrary Field'ordinal where + shrink = genericShrink + arbitrary = oneof + [ pure Field'ordinal'implicit + , Field'ordinal'explicit <$> arbitrary + ] + +instance Arbitrary Enumerant where + shrink = genericShrink + arbitrary = Enumerant + <$> arbitrary + <*> arbitrary + <*> arbitrarySmallerVec + +instance Arbitrary Superclass where + shrink = genericShrink + arbitrary = Superclass + <$> arbitrary + <*> arbitrary + +instance Arbitrary Method where + shrink = genericShrink + arbitrary = do + name <- arbitrary + codeOrder <- arbitrary + implicitParameters <- arbitrary + paramStructType <- arbitrary + paramBrand <- arbitrary + resultStructType <- arbitrary + resultBrand <- arbitrary + annotations <- arbitrary + pure Method{..} + +instance Arbitrary CapnpVersion where + shrink = genericShrink + arbitrary = CapnpVersion + <$> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary Node'Parameter where + shrink = genericShrink + arbitrary = Node'Parameter <$> arbitrary + +instance Arbitrary Brand where + shrink = genericShrink + arbitrary = Brand <$> arbitrarySmallerVec + +instance Arbitrary Brand'Scope where + shrink = genericShrink + arbitrary = Brand'Scope + <$> arbitrary + <*> arbitrary + +instance Arbitrary Brand'Scope' where + shrink = genericShrink + arbitrary = oneof + [ Brand'Scope'bind <$> arbitrarySmallerVec + , pure Brand'Scope'inherit + , Brand'Scope'unknown' <$> arbitraryTag 2 + ] + +instance Arbitrary Brand'Binding where + shrink = genericShrink + arbitrary = oneof + [ pure Brand'Binding'unbound + , Brand'Binding'type_ <$> arbitrary + , Brand'Binding'unknown' <$> arbitraryTag 2 + ] + +instance Arbitrary Value where + shrink = genericShrink + arbitrary = oneof + [ pure Value'void + , Value'bool <$> arbitrary + , Value'int8 <$> arbitrary + , Value'int16 <$> arbitrary + , Value'int32 <$> arbitrary + , Value'int64 <$> arbitrary + , Value'uint8 <$> arbitrary + , Value'uint16 <$> arbitrary + , Value'uint32 <$> arbitrary + , Value'uint64 <$> arbitrary + , Value'float32 <$> arbitrary + , Value'float64 <$> arbitrary + , Value'text <$> arbitrary + , Value'data_ <$> arbitrary + , Value'list <$> arbitrary + , Value'enum <$> arbitrary + , Value'struct <$> arbitrary + , pure Value'interface + , Value'anyPointer <$> arbitrary + , Value'unknown' <$> arbitraryTag 19 + ] + +instance Arbitrary Annotation where + shrink = genericShrink + arbitrary = Annotation + <$> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary ElementSize where + shrink = genericShrink + arbitrary = oneof + [ pure ElementSize'empty + , pure ElementSize'bit + , pure ElementSize'byte + , pure ElementSize'twoBytes + , pure ElementSize'fourBytes + , pure ElementSize'eightBytes + , pure ElementSize'pointer + , pure ElementSize'inlineComposite + , ElementSize'unknown' <$> arbitraryTag 8 + ] + +instance Arbitrary Type'anyPointer where + shrink = genericShrink + arbitrary = oneof + [ Type'anyPointer'unconstrained <$> arbitrary + , Type'anyPointer'parameter <$> arbitrary <*> arbitrary + , Type'anyPointer'implicitMethodParameter <$> arbitrary + ] + +instance Arbitrary Type'anyPointer'unconstrained where + shrink = genericShrink + arbitrary = oneof + [ pure Type'anyPointer'unconstrained'anyKind + , pure Type'anyPointer'unconstrained'struct + , pure Type'anyPointer'unconstrained'list + , pure Type'anyPointer'unconstrained'capability + ] + +instance Arbitrary Type where + shrink = genericShrink + arbitrary = oneof + [ pure Type'void + , pure Type'bool + , pure Type'int8 + , pure Type'int16 + , pure Type'int32 + , pure Type'int64 + , pure Type'uint8 + , pure Type'uint16 + , pure Type'uint32 + , pure Type'uint64 + , pure Type'float32 + , pure Type'float64 + , pure Type'text + , pure Type'data_ + , Type'list <$> arbitrary + , Type'enum <$> arbitrary <*> arbitrary + , Type'interface <$> arbitrary <*> arbitrary + , Type'anyPointer <$> arbitrary + , Type'unknown' <$> arbitraryTag 21 + ] + +instance Arbitrary CodeGeneratorRequest where + shrink = genericShrink + arbitrary = do + capnpVersion <- arbitrary + nodes <- arbitrarySmallerVec + requestedFiles <- arbitrarySmallerVec + pure CodeGeneratorRequest{..} + +instance Arbitrary CodeGeneratorRequest'RequestedFile where + shrink = genericShrink + arbitrary = CodeGeneratorRequest'RequestedFile + <$> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary CodeGeneratorRequest'RequestedFile'Import where + shrink = genericShrink + arbitrary = CodeGeneratorRequest'RequestedFile'Import + <$> arbitrary + <*> arbitrary + +instance Arbitrary a => Arbitrary (PU.Slice a) where + shrink = genericShrink + arbitrary = PU.Slice <$> arbitrarySmallerVec + +arbitrarySmallerVec :: Arbitrary a => Gen (V.Vector a) +arbitrarySmallerVec = sized $ \size -> do + -- Make sure the elements are scaled down relative to + -- the size of the vector: + vec <- arbitrary :: Gen (V.Vector ()) + let gen = resize (size `div` V.length vec) arbitrary + traverse (const gen) vec + +instance Arbitrary PU.Struct where + shrink = genericShrink + arbitrary = sized $ \size -> PU.Struct + <$> arbitrary + <*> arbitrary + +instance Arbitrary PU.List where + shrink = genericShrink + arbitrary = oneof + [ PU.List0 <$> arbitrarySmallerVec + , PU.List1 <$> arbitrarySmallerVec + , PU.List8 <$> arbitrarySmallerVec + , PU.List16 <$> arbitrarySmallerVec + , PU.List32 <$> arbitrarySmallerVec + , PU.List64 <$> arbitrarySmallerVec + , PU.ListPtr <$> arbitrarySmallerVec + , PU.ListStruct <$> arbitrarySmallerVec + ] + +instance Arbitrary PU.PtrType where + shrink = genericShrink + arbitrary = oneof + [ PU.PtrStruct <$> arbitrary + , PU.PtrList <$> arbitrary + , PU.PtrCap <$> arbitrary + ] diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,23 @@ +module Main (main) where + +import Test.Framework (defaultMain) + +import Tests.Module.Capnp.Capnp.Schema (schemaTests) +import Tests.Module.Capnp.Capnp.Schema.Pure (pureSchemaTests) +import Tests.Module.Data.Capnp.Bits (bitsTests) +import Tests.Module.Data.Capnp.Pointer (ptrTests) +import Tests.Module.Data.Capnp.Untyped (untypedTests) +import Tests.Module.Data.Capnp.Untyped.Pure (pureUntypedTests) +import Tests.SchemaQuickCheck (schemaCGRQuickCheck) +import Tests.WalkSchemaCodeGenRequest (walkSchemaCodeGenRequestTest) + +main :: IO () +main = defaultMain [ bitsTests + , ptrTests + , untypedTests + , pureUntypedTests + , walkSchemaCodeGenRequestTest + , schemaCGRQuickCheck + , schemaTests + , pureSchemaTests + ] diff --git a/tests/Tests/Module/Capnp/Capnp/Schema.hs b/tests/Tests/Module/Capnp/Capnp/Schema.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Capnp/Capnp/Schema.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +module Tests.Module.Capnp.Capnp.Schema (schemaTests) where + +import Control.Monad (when) +import Control.Monad.Primitive (RealWorld) +import Text.Heredoc (there) + +import Capnp.Capnp.Schema + +import Data.Capnp (newRoot) +import Data.Capnp.TraversalLimit (LimitT, evalLimitT) +import Data.Mutable (Thaw(..)) +import Tests.Util (assertionsToTest, decodeValue) + +import qualified Data.Capnp.Message as M + +data BuildTest = BuildTest + { typeName :: String + , expected :: String + , builder :: M.MutMsg RealWorld -> LimitT IO () + } + +schemaTests = assertionsToTest "Test typed setters" $ map testCase + [ BuildTest + { typeName = "Field" + , expected = concat + [ "( codeOrder = 4,\n" + , " discriminantValue = 6,\n" + , " group = (typeId = 322),\n" + , " ordinal = (explicit = 22) )\n" + ] + , builder = \msg -> do + field <- newRoot msg + set_Field'codeOrder field 4 + set_Field'discriminantValue field 6 + union <- get_Field'union' field + group <- set_Field'group union + set_Field'group'typeId group 322 + ordinal <- get_Field'ordinal field + set_Field'ordinal'explicit ordinal 22 + } + ] + where + testCase BuildTest{..} = do + msg <- M.newMessage + evalLimitT maxBound $ builder msg + constMsg <- freeze msg + actual <- decodeValue schemaSchema typeName constMsg + when (actual /= expected) $ + error $ "Expected:\n\n" ++ show expected ++ "\n\n...but got:\n\n" ++ show actual + +schemaSchema = [there|core-schema/capnp/schema.capnp|] diff --git a/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs b/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs @@ -0,0 +1,505 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Tests.Module.Capnp.Capnp.Schema.Pure (pureSchemaTests) where + +import Data.Proxy + +import Control.Exception (bracket) +import Control.Monad (when) +import Control.Monad.Primitive (RealWorld) +import Data.Default (Default(..)) +import System.Directory (removeFile) +import System.IO + (IOMode(ReadMode, WriteMode), hClose, openBinaryTempFile, withBinaryFile) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit.Lang (Assertion, assertEqual) +import Test.QuickCheck (Property) +import Test.QuickCheck.Instances () +import Test.QuickCheck.IO (propertyIO) +import Text.Heredoc (here, there) +import Text.Show.Pretty (ppShow) + +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as LBS + +import Capnp.Capnp.Schema.Pure +import Tests.Util + +import Instances () + +import Data.Capnp (getRoot, hGetValue, hPutValue, setRoot) +import Data.Capnp.Classes + ( Allocate(..) + , Cerialize(..) + , Decerialize(..) + , FromStruct(..) + , ToStruct(..) + ) +import Data.Capnp.TraversalLimit (defaultLimit, evalLimitT) +import Data.Mutable (Thaw(..)) + +import qualified Data.Capnp.Message as M +import qualified Data.Capnp.Untyped as U + +schemaText = [there|tests/data/schema.capnp|] + +pureSchemaTests = testGroup "Tests for generated .Pure modules." + [ decodeTests + , decodeDefaultTests + , encodeTests + , propTests + ] + +encodeTests = testGroup "schema encode tests" + [ testCase + ( "Node.Parameter" + , Node'Parameter { name = "Bob" } + , "(name = \"Bob\")\n" + ) + ] + where + testCase :: + -- TODO: the size of this context is *stupid* + ( Show a + , Eq a + , Cerialize RealWorld a + , FromStruct M.ConstMsg (Cerial M.ConstMsg a) + , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) + , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a) + ) => (String, a, String) -> Test + testCase (name, expectedValue, expectedText) = + assertionsToTest ("Check cerialize against capnp decode (" ++ name ++ ")") $ pure $ do + msg <- evalLimitT maxBound $ do + -- TODO: add some helpers for all this. + msg <- M.newMessage + cerialOut <- cerialize msg expectedValue + setRoot cerialOut + freeze msg + builder <- M.encode msg + actualText <- capnpDecode + (LBS.toStrict $ BB.toLazyByteString builder) + (MsgMetaData schemaText name) + assertEqual ("Encode " ++ show expectedValue) + expectedText + actualText + actualValue <- evalLimitT maxBound $ do + root <- U.rootPtr msg + cerialIn <- fromStruct root + decerialize cerialIn + assertEqual + ("decerialize (cerialize " ++ show expectedValue ++ ") == " ++ show actualValue) + expectedValue + actualValue + +decodeTests = testGroup "schema decode tests" + [ decodeTests "CodeGeneratorRequest" + [ ( [here| + ( capnpVersion = (major = 0, minor = 6, micro = 1) + , nodes = [] + , requestedFiles = + [ ( id = 4 + , filename = "hello.capnp" + , imports = + [ (id = 2, name = "std") + ] + ) + ] + ) + |] + , CodeGeneratorRequest + { capnpVersion = CapnpVersion { major = 0, minor = 6, micro = 1 } + , nodes = [] + , requestedFiles = + [ CodeGeneratorRequest'RequestedFile + 4 + "hello.capnp" + [CodeGeneratorRequest'RequestedFile'Import 2 "std"] + ] + } + ) + ] + , decodeTests "Node" + [ ( [here| + ( id = 7 + , displayName = "foo:MyType" + , displayNamePrefixLength = 4 + , scopeId = 2 + , parameters = [ (name = "theName") ] + , isGeneric = true + , nestedNodes = [(name = "theName", id = 321)] + , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] + , |] ++ unionText ++ [here| + ) + |] + , Node + 7 + "foo:MyType" + 4 + 2 + [Node'NestedNode "theName" 321] + [Annotation 2 (Value'bool True) (Brand [])] + [Node'Parameter "theName" ] + True + unionVal + ) + | (unionText, unionVal) <- + [ ("file = void", Node'file) + , ( [here| struct = + ( dataWordCount = 3 + , pointerCount = 2 + , preferredListEncoding = inlineComposite + , isGroup = false + , discriminantCount = 4 + , discriminantOffset = 2 + , fields = + [ ( name = "fieldName" + , codeOrder = 3 + , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] + , discriminantValue = 7 + , group = (typeId = 4) + , ordinal = (implicit = void) + ) + ] + ) + |] + , Node'struct + { dataWordCount = 3 + , pointerCount = 2 + , preferredListEncoding = ElementSize'inlineComposite + , isGroup = False + , discriminantCount = 4 + , discriminantOffset = 2 + , fields = + [ Field + "fieldName" + 3 + [ Annotation + 2 + (Value'bool True) + (Brand []) + ] + 7 + Field'ordinal'implicit + (Field'group 4) + ] + } + ) + , ( "enum = (enumerants = [(name = \"blue\", codeOrder = 2, annotations = [])])" + , Node'enum [ Enumerant "blue" 2 [] ] + ) + , ( "interface = (methods = [], superclasses = [(id = 0, brand = (scopes = []))])" + , Node'interface [] [Superclass 0 (Brand [])] + ) + , ( "const = (type = (bool = void), value = (bool = false))" + , Node'const Type'bool (Value'bool False) + ) + , ( [here| annotation = + ( type = (bool = void) + , targetsFile = true + , targetsConst = false + , targetsEnum = false + , targetsEnumerant = true + , targetsStruct = true + , targetsField = true + , targetsUnion = false + , targetsGroup = false + , targetsInterface = true + , targetsMethod = false + , targetsParam = true + , targetsAnnotation = false + ) + |] + , Node'annotation + Type'bool + True + False + False + True + True + True + False + False + True + False + True + False + ) + ] + ] + , decodeTests "Node.Parameter" + [ ("(name = \"theName\")", Node'Parameter "theName" ) + ] + , decodeTests "Node.NestedNode" + [ ("(name = \"theName\", id = 321)", Node'NestedNode "theName" 321) + ] + , decodeTests "Value" + [ ("(bool = true)", Value'bool True) + , ("(bool = false)", Value'bool False) + , ("(int8 = -4)", Value'int8 (-4)) + , ("(int8 = -128)", Value'int8 (-128)) + , ("(int8 = 127)", Value'int8 127) + , ("(uint8 = 23)", Value'uint8 23) + , ("(uint8 = 255)", Value'uint8 255) + , ("(int16 = 1012)", Value'int16 1012) + , ("(uint16 = 40000)", Value'uint16 40000) + , ("(uint32 = 1000100)", Value'uint32 1000100) + , ("(int32 = 1000100)", Value'int32 1000100) + , ("(uint64 = 1234567890123456)", Value'uint64 1234567890123456) + , ("(int64 = 12345678901234567)", Value'int64 12345678901234567) + , ("(float32 = 17.32)", Value'float32 17.32) + , ("(float64 = 13.99)", Value'float64 13.99) + , ("(data = \"beep boop.\")", Value'data_ "beep boop.") + , ("(text = \"Hello, World!\")", Value'text "Hello, World!") + , ("(enum = 2313)", Value'enum 2313) + , ("(interface = void)", Value'interface) + -- TODO: It would be nice to test list, struct, and anyPointer + -- variants, but I(zenhack) haven't figured out how to specify + -- an AnyPointer in the input to capnp encode. Maybe capnp eval + -- can do something like this? will have to investigate. + ] + , decodeTests "Annotation" + [ ( "(id = 323, brand = (scopes = []), value = (bool = true))" + , Annotation 323 (Value'bool True) (Brand []) + ) + ] + , decodeTests "CapnpVersion" + [ ("(major = 0, minor = 5, micro = 3)", CapnpVersion 0 5 3) + , ("(major = 1, minor = 0, micro = 2)", CapnpVersion 1 0 2) + ] + , decodeTests "Field" + [ ( [here| + ( name = "fieldName" + , codeOrder = 3 + , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] + , discriminantValue = 3 + , group = (typeId = 4) + , ordinal = (implicit = void) + ) + |] + , Field + "fieldName" + 3 + [Annotation 2 (Value'bool True) (Brand [])] + 3 + Field'ordinal'implicit + (Field'group 4) + ) + , ( [here| + ( name = "fieldName" + , codeOrder = 3 + , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] + , discriminantValue = 3 + , slot = + ( offset = 3 + , type = (bool = void) + , defaultValue = (bool = false) + , hadExplicitDefault = true + ) + , ordinal = (explicit = 7) + ) + |] + , Field + "fieldName" + 3 + [Annotation 2 (Value'bool True) (Brand [])] + 3 + (Field'ordinal'explicit 7) + (Field'slot + 3 + Type'bool + (Value'bool False) + True) + ) + ] + , decodeTests "Enumerant" + [ ( [here| + ( name = "red" + , codeOrder = 4 + , annotations = + [ (id = 23, brand = (scopes = []), value = (uint8 = 3)) + ] + ) + |] + , Enumerant "red" 4 [Annotation 23 (Value'uint8 3) (Brand [])] + ) + ] + , decodeTests "Superclass" + [ ("(id = 34, brand = (scopes = []))", Superclass 34 (Brand [])) + ] + , decodeTests "Type" + [ ("(bool = void)", Type'bool) + , ("(int8 = void)", Type'int8) + , ("(int16 = void)", Type'int16) + , ("(int32 = void)", Type'int32) + , ("(int64 = void)", Type'int64) + , ("(uint8 = void)", Type'uint8) + , ("(uint16 = void)", Type'uint16) + , ("(uint32 = void)", Type'uint32) + , ("(uint64 = void)", Type'uint64) + , ("(float32 = void)", Type'float32) + , ("(float64 = void)", Type'float64) + , ("(text = void)", Type'text) + , ("(data = void)", Type'data_) + , ( "(list = (elementType = (list = (elementType = (text = void)))))" + , Type'list $ Type'list Type'text + ) + , ( "(enum = (typeId = 4, brand = (scopes = [])))" + , Type'enum 4 (Brand []) + ) + , ( "(struct = (typeId = 7, brand = (scopes = [])))" + , Type'struct 7 (Brand []) + ) + , ( "(interface = (typeId = 1, brand = (scopes = [])))" + , Type'interface 1 (Brand []) + ) + , ( "(anyPointer = (unconstrained = (anyKind = void)))" + , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'anyKind + ) + , ( "(anyPointer = (unconstrained = (struct = void)))" + , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'struct + ) + , ( "(anyPointer = (unconstrained = (list = void)))" + , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'list + ) + , ( "(anyPointer = (unconstrained = (capability = void)))" + , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'capability + ) + , ( "(anyPointer = (parameter = (scopeId = 4, parameterIndex = 2)))" + , Type'anyPointer $ Type'anyPointer'parameter 4 2 + ) + , ( "(anyPointer = (implicitMethodParameter = (parameterIndex = 7)))" + , Type'anyPointer $ Type'anyPointer'implicitMethodParameter 7 + ) + ] + , decodeTests "Brand" + [ ("(scopes = [])", Brand []) + , ( [here| + ( scopes = + [ (scopeId = 32, inherit = void) + , (scopeId = 23, bind = + [ (unbound = void) + , (type = (bool = void)) + ] + ) + ] + ) + |] + , Brand + [ Brand'Scope 32 Brand'Scope'inherit + , Brand'Scope 23 $ Brand'Scope'bind + [ Brand'Binding'unbound + , Brand'Binding'type_ Type'bool + ] + ] + ) + ] + ] + where + -- decodeTests :: Decerialize Struct a => String -> [(String, a)] -> IO () + decodeTests typename cases = + assertionsToTest ("Decode " ++ typename) $ map (testCase typename) cases + testCase typename (capnpText, expected) = do + msg <- encodeValue schemaText typename capnpText + actual <- evalLimitT 128 $ getRoot msg + ppAssertEqual actual expected + +decodeDefaultTests = assertionsToTest + "Check that the empty struct decodes to the default value" + [ decodeDefault "Type" (Proxy :: Proxy Type) + , decodeDefault "Value" (Proxy :: Proxy Value) + , decodeDefault "Node" (Proxy :: Proxy Node) + ] + +decodeDefault :: + ( Show a + , Eq a + , Default a + , FromStruct M.ConstMsg a + , Cerialize RealWorld a + , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) + ) => String -> Proxy a -> Assertion +decodeDefault typename proxy = do + actual <- evalLimitT defaultLimit (getRoot M.empty) + ppAssertEqual (actual `asProxyTypeOf` proxy) def + +ppAssertEqual :: (Show a, Eq a) => a -> a -> IO () +ppAssertEqual actual expected = + when (actual /= expected) $ error $ + "Expected:\n\n" ++ ppShow expected ++ "\n\nbut got:\n\n" ++ ppShow actual + +propTests = testGroup "Various quickcheck properties" + [ propCase "Node" (Proxy :: Proxy Node) + , propCase "Node.Parameter" (Proxy :: Proxy Node'Parameter) + , propCase "Node.NestedNode" (Proxy :: Proxy Node'NestedNode) + , propCase "Field" (Proxy :: Proxy Field) + , propCase "Enumerant" (Proxy :: Proxy Enumerant) + , propCase "Superclass" (Proxy :: Proxy Superclass) + , propCase "Method" (Proxy :: Proxy Method) + , propCase "Type" (Proxy :: Proxy Type) + , propCase "Brand" (Proxy :: Proxy Brand) + , propCase "Brand.Scope" (Proxy :: Proxy Brand'Scope) + , propCase "Brand.Binding" (Proxy :: Proxy Brand'Binding) + , propCase "Value" (Proxy :: Proxy Value) + , propCase "Annotation" (Proxy :: Proxy Annotation) + , propCase "CapnpVersion" (Proxy :: Proxy CapnpVersion) + , propCase "CodeGeneratorRequest" (Proxy :: Proxy CodeGeneratorRequest) + , propCase "CodeGeneratorRequest.RequestedFile" + (Proxy :: Proxy CodeGeneratorRequest'RequestedFile) + , propCase "CodeGeneratorRequest.RequestedFile.Import" + (Proxy :: Proxy CodeGeneratorRequest'RequestedFile'Import) + ] + +propCase name proxy = testGroup ("...for " ++ name) + [ testProperty "check that cerialize and decerialize are inverses." (prop_cerializeDecerializeInverses proxy) + , testProperty "check that hPutValue and hGetValue are inverses." (prop_hGetPutInverses proxy) + ] + +prop_hGetPutInverses :: + ( Show a + , Eq a + , FromStruct M.ConstMsg a + , Cerialize RealWorld a + , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) + ) => Proxy a -> a -> Property +prop_hGetPutInverses proxy expected = propertyIO $ do + -- This is a little more complicated than I'd like due to resource + -- management issues. We create a temporary file, then immediately + -- close the handle to it, and open it again in a separate call to + -- bracket. This allows us to decouple the lifetimes of the file and + -- the handle. + actual <- bracket + (do + (filename, handle) <- openBinaryTempFile "/tmp" "hPutValue-output" + hClose handle + pure filename) + removeFile + (\filename -> do + withBinaryFile filename WriteMode + (`hPutValue` expected) + withBinaryFile filename ReadMode $ \h -> + hGetValue h defaultLimit) + ppAssertEqual actual expected +prop_cerializeDecerializeInverses :: + ( Show a + , Eq a + , Cerialize RealWorld a + , FromStruct M.ConstMsg (Cerial M.ConstMsg a) + , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) + , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a) + ) => Proxy a -> a -> Property +prop_cerializeDecerializeInverses _proxy expected = propertyIO $ do + actual <- evalLimitT maxBound $ do + -- TODO: add some helpers for all this. + msg <- M.newMessage + cerialOut <- cerialize msg expected + setRoot cerialOut + constMsg :: M.ConstMsg <- freeze msg + root <- U.rootPtr constMsg + cerialIn <- fromStruct root + decerialize cerialIn + ppAssertEqual actual expected diff --git a/tests/Tests/Module/Data/Capnp/Bits.hs b/tests/Tests/Module/Data/Capnp/Bits.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Data/Capnp/Bits.hs @@ -0,0 +1,51 @@ +module Tests.Module.Data.Capnp.Bits (bitsTests) where + +import Data.Bits +import Data.Word + +import Test.Framework (testGroup) +import Test.HUnit (Assertion, assertEqual) +import Tests.Util (assertionsToTest) + +import Data.Capnp.Bits + + +bitsTests = testGroup "bits tests" [bitRangeExamples, replaceBitsExamples] + +bitRangeExamples = assertionsToTest "bitRange examples" $ + map bitRangeTest $ + ones ++ + [ (0x0000000200000000, 32, 48, 2) + ] + where + bitRangeTest (word, lo, hi, expected) = + assertEqual + (concat [ "bitRange ", show word, " ", show lo, " ", show hi + , " == " + , show expected + ]) + expected + (bitRange word lo hi) + ones = map (\bit -> (1 `shiftL` bit, bit, bit + 1, 1)) [0..63] + +replaceBitsExamples = assertionsToTest "replaceBits" + [ replaceTest 8 (0xf :: Word8) 0 0 0xf + , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1 + , replaceTest 8 (0x2 :: Word8) 0x1 0 0x2 + , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1 + , replaceTest 8 (0x2 :: Word8) 0x10 4 0x20 + , replaceTest 8 (0x1 :: Word8) 0x10 8 0x0110 + , replaceTest 8 (0xa :: Word8) 0xffff 8 0x0aff + , replaceTest 1 (0x0 :: Word1) 0xff 4 0xef + ] + where + replaceTest :: (Bounded a, Integral a, Show a) + => Int -> a -> Word64 -> Int -> Word64 -> Assertion + replaceTest len new orig shift expected = + assertEqual (concat [ "replaceBits (", show new, " :: Word", show len, ") " + , show orig, " ", show shift + , " == " + , show expected + ]) + expected + (replaceBits new orig shift) diff --git a/tests/Tests/Module/Data/Capnp/Pointer.hs b/tests/Tests/Module/Data/Capnp/Pointer.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Data/Capnp/Pointer.hs @@ -0,0 +1,83 @@ +module Tests.Module.Data.Capnp.Pointer (ptrTests) where + +import Data.Bits +import Data.Int +import Data.Word + +import Test.Framework (testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (assertEqual) +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Gen (Gen, oneof) + +import Data.Capnp.Pointer + +import Tests.Util (assertionsToTest) + +instance Arbitrary EltSpec where + arbitrary = oneof [ EltNormal <$> arbitrary <*> arbitraryU29 + , EltComposite <$> arbitraryI29 + ] + +instance Arbitrary ElementSize where + arbitrary = oneof $ map return [ Sz0 + , Sz1 + , Sz8 + , Sz16 + , Sz32 + , Sz64 + , SzPtr + ] + + +-- | arbitraryIN is an arbitrary N bit signed integer as an Int32. +arbitraryI32, arbitraryI30, arbitraryI29 :: Gen Int32 +arbitraryI32 = arbitrary +arbitraryI30 = (`shiftR` 2) <$> arbitraryI32 +arbitraryI29 = (`shiftR` 3) <$> arbitraryI32 +-- | arbitraryUN is an arbitrary N bit unsigned integer as a Word32. +arbitraryU32, arbitraryU30, arbitraryU29 :: Gen Word32 +arbitraryU32 = arbitrary +arbitraryU30 = (`shiftR` 2) <$> arbitraryU32 +arbitraryU29 = (`shiftR` 3) <$> arbitraryU32 + + +instance Arbitrary Ptr where + arbitrary = oneof [ StructPtr <$> arbitraryI30 + <*> arbitrary + <*> arbitrary + , ListPtr <$> arbitraryI30 + <*> arbitrary + , FarPtr <$> arbitrary + <*> arbitraryU29 + <*> arbitrary + , CapPtr <$> arbitrary + ] + +ptrTests = testGroup "Pointer Tests" [ptrProps, parsePtrExamples] + +ptrProps = testGroup "Pointer Properties" + [ testProperty "parseEltSpec . serializeEltSpec == id" + (\spec -> parseEltSpec (serializeEltSpec spec) == spec) + , testProperty "parsePtr . serializePtr == id" $ \ptr -> + case ptr of + (Just (StructPtr 0 0 0)) -> True -- we skip this one, since it's + -- the same bits as a null, so this + -- shouldn't hold. TODO: the name + -- of this test is a bit misleading + -- because of this case; should fix + -- that. + _ -> parsePtr (serializePtr ptr) == ptr + ] + + +parsePtrExamples = assertionsToTest "parsePtr Examples" $ + map parseExample + [ (0x0000000200000000, Just $ StructPtr 0 2 0) + ] + where + parseExample (word, expected) = + assertEqual + (concat ["parsePtr ", show word, " == ", show expected]) + expected + (parsePtr word) diff --git a/tests/Tests/Module/Data/Capnp/Untyped.hs b/tests/Tests/Module/Data/Capnp/Untyped.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Data/Capnp/Untyped.hs @@ -0,0 +1,343 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Tests.Module.Data.Capnp.Untyped (untypedTests) where + +import Prelude hiding (length) + +import Control.Monad (forM_, when) +import Control.Monad.Catch (MonadThrow(throwM)) +import Control.Monad.Primitive (RealWorld) +import Data.ReinterpretCast (doubleToWord, wordToDouble) +import Data.Text (Text) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit (assertEqual) +import Test.QuickCheck (Property) +import Test.QuickCheck.IO (propertyIO) +import Text.Heredoc (here, there) + +import qualified Data.ByteString as BS +import qualified Data.Vector as V + +import Data.Capnp.Untyped +import Tests.Util + +import Data.Capnp (cerialize, createPure, def, getRoot, newRoot) +import Data.Capnp.TraversalLimit (LimitT, evalLimitT, execLimitT) +import Data.Mutable (Thaw(..)) + +import Instances () + +import Capnp.Capnp.Schema.Pure (Brand, Method(..), Node'Parameter) + +import qualified Data.Capnp.Classes as C +import qualified Data.Capnp.Message as M + +import qualified Capnp.Capnp.Schema as Schema + +untypedTests = testGroup "Untyped Tests" + [ readTests + , modifyTests + , farPtrTest + , otherMessageTest + ] + +readTests :: Test +readTests = assertionsToTest "read tests" + [ do + msg <- encodeValue + [there|tests/data/aircraft.capnp|] + "Aircraft" + [here|(f16 = (base = ( + name = "bob", + homes = [], + rating = 7, + canFly = true, + capacity = 5173, + maxSpeed = 12.0 + )))|] + endQuota <- execLimitT 128 $ do + root <- rootPtr msg + let aircraftWords = dataSection root + -- Aircraft just has the union tag, nothing else in it's data + -- section. + let 1 = length aircraftWords + 3 <- index 0 aircraftWords -- tag for F16 + let 1 = length (ptrSection root) + Just (PtrStruct f16) <- getPtr 0 root + let 0 = length (dataSection f16) + let 1 = length (ptrSection f16) + Just (PtrStruct base) <- getPtr 0 f16 + let 4 = length (dataSection base) -- Except canFly, each field is 1 word, and + -- canFly is aligned such that it ends up + -- consuming a whole word. + let 2 = length (ptrSection base) -- name, homes + + -- Walk the data section: + 7 <- getData 0 base -- rating + 1 <- getData 1 base -- canFly + 5173 <- getData 2 base -- capacity + 12.0 <- wordToDouble <$> getData 3 base + + -- ...and the pointer section: + Just (PtrList (List8 name)) <- getPtr 0 base + -- Text values have a NUL terminator, which is included in the + -- length on the wire. The spec says that this shouldn't be + -- included in the length reported to the caller, but that needs + -- to be dealt with by schema-aware code, so this is the length of + -- "bob\0" + let 4 = length name + + forM_ (zip [0..3] (BS.unpack "bob\0")) $ \(i, c) -> do + c' <- index i name + when (c /= c') $ + error ("index " ++ show i ++ ": " ++ show c ++ " /= " ++ show c') + Just (PtrList (List16 homes)) <- getPtr 1 base + let 0 = length homes + return () + assertEqual "endQuota == 110" 110 endQuota + ] + +data ModTest s = ModTest + { testIn :: String + , testMod :: Struct (M.MutMsg RealWorld) -> LimitT IO () + , testOut :: String + , testType :: String + } + +modifyTests :: Test +modifyTests = testGroup "Test modification" $ map testCase + -- tests for setIndex + [ ModTest + { testIn = "(year = 2018, month = 6, day = 20)\n" + , testType = "Zdate" + , testOut = "(year = 0, month = 0, day = 0)\n" + , testMod = setIndex 0 0 . dataSection + } + , ModTest + { testIn = "(text = \"Hello, World!\")\n" + , testType = "Z" + , testOut = "(text = \"hEllo, world!\")\n" + , testMod = \struct -> do + Just (PtrList (List8 list)) <- index 0 (ptrSection struct) + setIndex (fromIntegral (fromEnum 'h')) 0 list + setIndex (fromIntegral (fromEnum 'E')) 1 list + setIndex (fromIntegral (fromEnum 'w')) 7 list + } + , ModTest + { testIn = "(boolvec = [true, true, false, true])\n" + , testType = "Z" + , testOut = "( boolvec = [false, true, true, false] )\n" + , testMod = \struct -> do + Just (PtrList (List1 list)) <- index 0 (ptrSection struct) + setIndex False 0 list + setIndex True 2 list + setIndex False 3 list + } + , ModTest + { testIn = "(f64 = 2.0)\n" + , testType = "Z" + , testOut = "(f64 = 7.2)\n" + , testMod = setIndex (doubleToWord 7.2) 1 . dataSection + } + , ModTest + { testIn = unlines + [ "( size = 4," + , " words = \"Hello, World!\"," + , " wordlist = [\"apples\", \"oranges\"] )" + ] + , testType = "Counter" + , testOut = unlines + [ "( size = 4," + , " words = \"oranges\"," + , " wordlist = [\"apples\", \"Hello, World!\"] )" + ] + , testMod = \struct -> do + Just (PtrList (ListPtr list)) <- index 1 (ptrSection struct) + helloWorld <- index 0 (ptrSection struct) + oranges <- index 1 list + setIndex oranges 0 (ptrSection struct) + setIndex helloWorld 1 list + } + , ModTest + { testIn = unlines + [ "( aircraftvec = [" + , " ( f16 = (" + , " base = (" + , " name = \"alice\"," + , " homes = []," + , " rating = 7," + , " canFly = true," + , " capacity = 4," + , " maxSpeed = 100 ) ) )," + , " ( b737 = (" + , " base = (" + , " name = \"bob\"," + , " homes = []," + , " rating = 2," + , " canFly = false," + , " capacity = 9," + , " maxSpeed = 50 ) ) ) ] )" + ] + , testType = "Z" + , testOut = unlines + [ "( aircraftvec = [" + , " ( f16 = (" + , " base = (" + , " name = \"alice\"," + , " homes = []," + , " rating = 7," + , " canFly = true," + , " capacity = 4," + , " maxSpeed = 100 ) ) )," + , " ( f16 = (" + , " base = (" + , " name = \"alice\"," + , " homes = []," + , " rating = 7," + , " canFly = true," + , " capacity = 4," + , " maxSpeed = 100 ) ) ) ] )" + ] + , testMod = \struct -> do + Just (PtrList (ListStruct list)) <- getPtr 0 struct + src <- index 0 list + setIndex src 1 list + } + -- tests for allocation functions + , ModTest + { testIn = "()" + , testType = "StackingRoot" + , testOut = "( aWithDefault = (num = 6400),\n a = (num = 65, b = (num = 90000)) )\n" + + , testMod = \struct -> do + when (length (ptrSection struct) /= 2) $ + error "struct's pointer section is unexpedly small" + + let msg = message struct + a <- allocStruct msg 1 1 + aWithDefault <- allocStruct msg 1 1 + b <- allocStruct msg 1 0 + setPtr (Just (PtrStruct b)) 0 a + setPtr (Just (PtrStruct aWithDefault)) 0 struct + setPtr (Just (PtrStruct a)) 1 struct + setData 65 0 a + setData 6400 0 aWithDefault + setData 90000 0 b + } + , ModTest + { testIn = "()" + , testType = "HoldsVerTwoTwoList" + , testOut = "( mylist = [(val = 0, duo = 70), (val = 0, duo = 71), (val = 0, duo = 72), (val = 0, duo = 73)] )\n" + , testMod = \struct -> do + mylist <- allocCompositeList (message struct) 2 2 4 + forM_ [0..3] $ \i -> + index i mylist >>= setData (70 + fromIntegral i) 1 + setPtr (Just $ PtrList $ ListStruct mylist) 0 struct + } + , allocNormalListTest "u64vec" 21 allocList64 List64 + , allocNormalListTest "u32vec" 22 allocList32 List32 + , allocNormalListTest "u16vec" 23 allocList16 List16 + , allocNormalListTest "u8vec" 24 allocList8 List8 + , ModTest + { testIn = "()" + , testType = "Z" + , testOut = "( boolvec = [true, false, true] )\n" + , testMod = \struct -> do + setData 39 0 struct -- Set the union tag. + boolvec <- allocList1 (message struct) 3 + forM_ [0..2] $ \i -> + setIndex (even i) i boolvec + setPtr (Just $ PtrList $ List1 boolvec) 0 struct + } + ] + where + -- generate a ModTest for a (normal) list allocation function. + -- + -- parameters: + -- + -- * tagname - the name of the union variant + -- * tagvalue - the numeric value of the tag for this variant + -- * allocList - the allocation function + -- * dataCon - the data constructor for 'List' to use. + allocNormalListTest tagname tagvalue allocList dataCon = + ModTest + { testIn = "()" + , testType = "Z" + , testOut = "(" ++ tagname ++ " = [0, 1, 2, 3, 4])\n" + , testMod = \struct -> do + setData tagvalue 0 struct + vec <- allocList (message struct) 5 + forM_ [0..4] $ \i -> setIndex (fromIntegral i) i vec + setPtr (Just $ PtrList $ dataCon vec) 0 struct + } + testCase ModTest{..} = assertionsToTest + (show testIn ++ " : " ++ testType ++ " == " ++ show testOut) $ + pure $ do + msg <- thaw =<< encodeValue schemaText testType testIn + evalLimitT 128 $ rootPtr msg >>= testMod + actualOut <- decodeValue schemaText testType =<< freeze msg + assertEqual ( actualOut ++ " == " ++ testOut) actualOut testOut + schemaText = [there|tests/data/aircraft.capnp|] + + +farPtrTest = assertionsToTest + "Setting cross-segment pointers should work." + [ do + msg <- M.newMessage + -- The allocator always allocates new objects in the last segment, so + -- if we create a new segment, the call to allocStruct below should + -- allocate there: + (1, _) <- M.newSegment msg 16 + struct <- allocStruct msg 3 4 + setRoot struct + , evalLimitT maxBound $ do + msg <- M.newMessage + srcStruct <- allocStruct msg 4 4 + (1, _) <- M.newSegment msg 10 + dstStruct <- allocStruct msg 2 2 + setPtr (C.toPtr dstStruct) 0 srcStruct + ] + +otherMessageTest :: Test +otherMessageTest = testProperty + "Setting pointers to values in other messages copies them if needed." + otherMessageTest' + +otherMessageTest' :: Text -> V.Vector Node'Parameter -> Brand -> Property +otherMessageTest' name params brand = propertyIO $ do + let expected = def + { name = name + , implicitParameters = params + , paramBrand = brand + } + let result = createPure maxBound $ do + methodMsg <- M.newMessage + nameMsg <- M.newMessage + paramsMsg <- M.newMessage + brandMsg <- M.newMessage + + methodCerial <- newRoot methodMsg + nameCerial <- cerialize nameMsg name + brandCerial <- cerialize brandMsg brand + + -- We don't implement Cerialize for Vector, so we can't just + -- inject params directly. TODO: implement Cerialize for Vector. + wrapper <- cerialize paramsMsg expected + paramsCerial <- Schema.get_Method'implicitParameters wrapper + + Schema.set_Method'name methodCerial nameCerial + Schema.set_Method'implicitParameters methodCerial paramsCerial + Schema.set_Method'paramBrand methodCerial brandCerial + + pure methodMsg + case result of + Left e -> + throwM e + Right (msg :: M.ConstMsg) -> do + actual <- evalLimitT maxBound $ getRoot msg >>= C.decerialize + assertEqual (show actual ++ " == " ++ show expected) actual expected diff --git a/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs b/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Tests.Module.Data.Capnp.Untyped.Pure (pureUntypedTests) where + +import Data.ReinterpretCast (doubleToWord) +import Test.Framework (Test) +import Test.HUnit (assertEqual) +import Text.Heredoc (here, there) + +import qualified Data.Vector as V + +import Data.Capnp.Untyped.Pure +import Tests.Util + +import Data.Capnp.Classes (decerialize) +import Data.Capnp.TraversalLimit (LimitT, runLimitT) + +import qualified Data.Capnp.Message as M +import qualified Data.Capnp.Untyped as U + +-- This is analogous to Tests.Module.Data.Capnp.Untyped.untypedTests, but +-- using the Pure module: +pureUntypedTests :: Test +pureUntypedTests = assertionsToTest "Untyped ADT Tests" + [ do + msg <- encodeValue + [there|tests/data/aircraft.capnp|] + "Aircraft" + [here|(f16 = (base = ( + name = "bob", + homes = [], + rating = 7, + canFly = true, + capacity = 5173, + maxSpeed = 12.0 + )))|] + (actual, 110) <- runLimitT 128 $ U.rootPtr msg >>= readStruct + assertEqual + "Untyped ADT test (assertEqual)" + (Struct + [3] + [ Just $ PtrStruct $ Struct + [] + [ Just $ PtrStruct $ Struct + [ 7 + , 1 + , 5173 + , doubleToWord 12.0 + ] + [ Just $ PtrList $ List8 $ V.fromList $ map (fromIntegral . fromEnum) "bob\0" + , Just $ PtrList $ List16 [] + ] + ] + ]) + actual + ] + where + readStruct :: U.Struct M.ConstMsg -> LimitT IO Struct + readStruct = decerialize diff --git a/tests/Tests/SchemaGeneration.hs b/tests/Tests/SchemaGeneration.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/SchemaGeneration.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Tests.SchemaGeneration + ( Schema (..), genSchema + ) where + +import Control.Monad.State.Strict + +import Control.Monad (replicateM) +import Data.List.NonEmpty (NonEmpty((:|))) + +import qualified Data.List.NonEmpty as NE +import qualified Test.QuickCheck as QC + +-- Definitions + +newtype FieldName + = FieldName String + +instance Show FieldName where + show (FieldName fn) = fn + +newtype StructName + = StructName String + +instance Show StructName where + show (StructName fn) = fn + +data Field + = FieldDef FieldName Int FieldType + | StructDef StructName [Field] + +data BuiltIn + = Void + | Bool + | Int8 + | Int16 + | Int32 + | Int64 + | UInt8 + | UInt16 + | UInt32 + | UInt64 + | Float32 + | Float64 + | Text + | Data + deriving (Show, Enum) + +data FieldType + = BasicType BuiltIn + | ListType FieldType + | StructType StructName + +instance Show FieldType where + show (BasicType bi) = show bi + show (ListType ft) = "List(" ++ show ft ++ ")" + show (StructType sn) = show sn + +instance Show Field where + show (FieldDef name order entryType) = concat + [ show name, " @", show order, " :" + , show entryType, ";\n" + ] + show (StructDef name content) = concat + [ "struct ", show name, " {\n" + , concatMap (('\t':) . show) content + , "}\n\n" + ] + +data Schema = Schema + { schemaId :: String + , schemaContent :: [Field] + } + +instance Show Schema where + show s = concat + [ "@0x", schemaId s, ";\n\n" + , concatMap show (schemaContent s) + ] + +-- Helper generators + +genSafeLCChar :: QC.Gen Char +genSafeLCChar = QC.elements ['a'..'z'] + +genSafeUCChar :: QC.Gen Char +genSafeUCChar = QC.elements ['A'..'Z'] + +genSafeHexChar :: QC.Gen Char +genSafeHexChar = QC.elements (['0'..'9'] ++ ['a'..'f']) + +newtype FieldGen a + = FieldGen (StateT (NonEmpty (Int, Int)) QC.Gen a) + deriving (Functor, Applicative, Monad) + +liftGen :: QC.Gen a -> FieldGen a +liftGen m = FieldGen (lift m) + +runFieldGen :: FieldGen a -> QC.Gen a +runFieldGen (FieldGen m) = fst <$> runStateT m ((0, 0) :| []) + +pushFieldGen :: FieldGen () +pushFieldGen = FieldGen $ modify (NE.cons (0, 0)) + +popFieldGen :: FieldGen () +popFieldGen = FieldGen $ do + original <- get + case original of + (x :| (y : rest)) -> put (y :| rest) + (x :| []) -> put (x :| []) + +getStructOrder :: FieldGen Int +getStructOrder = FieldGen $ do + current <- get + let (result, _) = NE.head current + case current of + ((x, y) :| rest) -> put ((x + 1, y) :| rest) + return result + +getOrder :: FieldGen Int +getOrder = FieldGen $ do + current <- get + let (_, result) = NE.head current + case current of + ((x, y) :| rest) -> put ((x + 1, y + 1) :| rest) + return result + +-- Field types + +-- need to enumerate each field; this will be performed during struct +-- generation where the number of fields is known (numberDefs) +genFieldDef :: [FieldType] -> FieldGen Field +genFieldDef structTypes = do + order <- getOrder + fieldName <- do + str <- liftGen $ QC.listOf1 genSafeLCChar + return $ FieldName (str ++ show order) + fieldType <- liftGen $ QC.elements (map BasicType [Bool ..] ++ structTypes) + return $ FieldDef fieldName order fieldType + +-- Struct type + +-- like fields, we enumerate each struct during generation for uniqueness +genStructDef :: Int -> FieldGen Field +genStructDef depth = do + order <- getStructOrder + + pushFieldGen + + -- generate the struct's name + structName <- do + fc <- liftGen genSafeUCChar + rest <- liftGen (QC.listOf genSafeLCChar) + return $ StructName ((fc:rest) ++ show order) + + -- generate the nested structs + structNum <- if depth <= 0 + then pure 0 + else liftGen (QC.choose (0, 3)) + structDefs <- replicateM structNum (genStructDef (depth - 1)) + + -- extract the available struct types + let structTypes = map (\(StructDef sn _) -> (StructType sn)) structDefs + + -- generate the fields using available struct types + fieldNum <- liftGen (QC.sized (\n -> QC.choose (1, 1 `max` n))) + fieldDefs <- replicateM fieldNum (genFieldDef structTypes) + + popFieldGen + + return $ StructDef structName (fieldDefs ++ structDefs) + + +-- Schema type +genSchema :: QC.Gen Schema +genSchema = do + id1st <- QC.elements ['a'..'f'] + idrest <- QC.vectorOf 15 genSafeHexChar + -- multiple structs make tests take too long + content <- runFieldGen (genStructDef 3) + return $ Schema (id1st:idrest) [content] diff --git a/tests/Tests/SchemaQuickCheck.hs b/tests/Tests/SchemaQuickCheck.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/SchemaQuickCheck.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Tests.SchemaQuickCheck + (schemaCGRQuickCheck) + where + +import qualified Data.ByteString as BS + +import Data.Capnp.Classes (fromStruct) +import Data.Capnp.Errors (Error) +import Data.Capnp.Message as M +import Data.Capnp.TraversalLimit (LimitT, runLimitT) + +import qualified Capnp.Capnp.Schema as Schema +import qualified Data.Capnp.Basics as Basics +import qualified Data.Capnp.Untyped as Untyped + +-- Testing framework imports +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck + +-- Schema generation imports +import Tests.SchemaGeneration +import Tests.Util + +-- Schema validation imports +import Control.Monad.Catch as C + +-- Functions to generate valid CGRs + +generateCGR :: Schema -> IO BS.ByteString +generateCGR schema = capnpCompile (show schema) "-" + +-- Functions to validate CGRs + +decodeCGR :: BS.ByteString -> IO (Int, Int) +decodeCGR bytes = do + let reader :: Untyped.Struct M.ConstMsg -> LimitT IO Int + reader struct = do + req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct struct + nodes <- Schema.get_CodeGeneratorRequest'nodes req + requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req + return (Basics.length nodes) + msg <- M.decode bytes + (numNodes, endQuota) <- runLimitT 1024 (Untyped.rootPtr msg >>= reader) + return (endQuota, numNodes) + +-- QuickCheck properties + +prop_schemaValid :: Schema -> Property +prop_schemaValid schema = ioProperty $ do + compiled <- generateCGR schema + decoded <- try $ decodeCGR compiled + return $ case (decoded :: Either Error (Int, Int)) of + Left _ -> False + Right _ -> True + +schemaCGRQuickCheck = testProperty "valid schema QuickCheck" + (prop_schemaValid <$> genSchema) diff --git a/tests/Tests/Util.hs b/tests/Tests/Util.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/Util.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Tests.Util + ( MsgMetaData(..) + , capnpEncode, capnpDecode, capnpCompile + , decodeValue + , encodeValue + , assertionsToTest + ) + where + +import System.Process hiding (readCreateProcessWithExitCode) + +import System.IO + +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Resource (ResourceT, allocate, runResourceT) +import System.Directory (removeFile) +import System.Exit (ExitCode(..)) +import System.Process.ByteString.Lazy (readCreateProcessWithExitCode) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (hUnitTestToTests) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSC8 +import qualified Test.HUnit as H + +import qualified Data.Capnp.Message as M + +-- | Information about the contents of a capnp message. This is enough +-- to encode/decode both textual and binary forms. +data MsgMetaData = MsgMetaData + { msgSchema :: String -- ^ The source of the schema + , msgType :: String -- ^ The name of the root struct's type + } deriving(Show) + +-- | @capnpEncode msg meta@ runs @capnp encode@ on the message, providing +-- the needed metadata and returning the output +capnpEncode :: String -> MsgMetaData -> IO BS.ByteString +capnpEncode msgValue meta = do + (exitStatus, stdOut, stdErr) <- runResourceT $ + interactCapnpWithSchema "encode" (msgSchema meta) (LBSC8.pack msgValue) [msgType meta] + case exitStatus of + ExitSuccess -> return (LBS.toStrict stdOut) + ExitFailure code -> fail ("`capnp encode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) + +-- | @capnpDecode msg meta@ runs @capnp decode@ on the message, providing +-- the needed metadata and returning the output +capnpDecode :: BS.ByteString -> MsgMetaData -> IO String +capnpDecode encodedMsg meta = do + (exitStatus, stdOut, stdErr) <- runResourceT $ + interactCapnpWithSchema "decode" (msgSchema meta) (LBS.fromStrict encodedMsg) [msgType meta] + case exitStatus of + ExitSuccess -> return (LBSC8.unpack stdOut) + ExitFailure code -> fail ("`capnp decode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) + +-- | @capnpCompile msg meta@ runs @capnp compile@ on the schema, providing +-- the needed metadata and returning the output +capnpCompile :: String -> String -> IO BS.ByteString +capnpCompile msgSchema outputArg = do + (exitStatus, stdOut, stdErr) <- runResourceT $ + interactCapnpWithSchema "compile" msgSchema LBSC8.empty ["-o", outputArg] + case exitStatus of + ExitSuccess -> return (LBS.toStrict stdOut) + ExitFailure code -> fail ("`capnp compile` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) + +-- | A helper for @capnpEncode@ and @capnpDecode@. Launches the capnp command +-- with the given subcommand (either "encode" or "decode") and metadata, +-- returning handles to its standard in and standard out. This runs inside +-- ResourceT, and sets the handles up to be closed and the process to be reaped +-- when the ResourceT exits. +interactCapnpWithSchema :: String -> String -> LBS.ByteString -> [String] -> ResourceT IO (ExitCode, LBS.ByteString, LBS.ByteString) +interactCapnpWithSchema subCommand msgSchema stdInBytes args = do + let writeTempFile = runResourceT $ do + (_, (path, hndl)) <- allocate + (openTempFile "/tmp" "schema.capnp") + (\(_, hndl) -> hClose hndl) + lift $ hPutStr hndl msgSchema + return path + let saveTmpSchema msgSchema = snd <$> allocate writeTempFile removeFile + schemaFile <- saveTmpSchema msgSchema + lift $ readCreateProcessWithExitCode (proc "capnp" ([subCommand, schemaFile] ++ args)) stdInBytes + +-- | Convert a list of 'Assertion's to a test group with the given name. +assertionsToTest :: String -> [H.Assertion] -> Test +assertionsToTest name = + testGroup name . hUnitTestToTests . H.TestList . map H.TestCase + +-- | @'decodeValue' schema typename message@ decodes the value at the root of +-- the message and converts it to text. This is a thin wrapper around +-- 'capnpDecode'. +decodeValue :: String -> String -> M.ConstMsg -> IO String +decodeValue schema typename msg = do + bytes <- M.encode msg + capnpDecode + (LBS.toStrict $ BB.toLazyByteString bytes) + (MsgMetaData schema typename) + +-- | @'encodeValue' schema typename value@ encodes the textual value @value@ +-- as a capnp message. This is a thin wrapper around 'capnpEncode'. +encodeValue :: String -> String -> String -> IO M.ConstMsg +encodeValue schema typename value = + let meta = MsgMetaData schema typename + in capnpEncode value meta >>= M.decode diff --git a/tests/Tests/WalkSchemaCodeGenRequest.hs b/tests/Tests/WalkSchemaCodeGenRequest.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/WalkSchemaCodeGenRequest.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | This module defines a test that tries to walk over the +-- CodeGeneratorRequest in `tests/data/schema-codegenreq`, +-- failing if any of the data is not as expected. +module Tests.WalkSchemaCodeGenRequest + (walkSchemaCodeGenRequestTest) + where + +import Prelude hiding (length) + +import Control.Monad (mapM_, when) +import Test.Framework (Test) +import Test.HUnit (Assertion, assertEqual) + +import qualified Data.ByteString as BS +import qualified Prelude + +import Data.Capnp.Untyped hiding (index, length) + +import Tests.Util + +import Data.Capnp.Basics (index, length, textBytes) +import Data.Capnp.Classes (fromStruct) +import Data.Capnp.TraversalLimit (LimitT, execLimitT) + +import qualified Capnp.Capnp.Schema as Schema +import qualified Data.Capnp.Message as M + + +-- | TODO: make this an array; we're doing random access to it below. +-- I(@zenhack) am waiting on this, since at the time of writing @taktoa +-- is working on some array utilities that will get merged soonish, so +-- it probably makes sense to just wait for that. +nodeNames :: [BS.ByteString] +nodeNames = + [ "Import" + , "annotation" + , "Value" + , "Type" + ] + +-- TODO: This contains a bit of copypasta from some of the untyped tests; should +-- factor that out. +theAssert :: Assertion +theAssert = do + bytes <- BS.readFile "tests/data/schema-codegenreq" + msg <- M.decode bytes + endQuota <- execLimitT 4096 (rootPtr msg >>= reader) + assertEqual "Correct remaining quota" 2036 endQuota + where + reader :: Struct M.ConstMsg -> LimitT IO () + reader root = do + req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct root + nodes <- Schema.get_CodeGeneratorRequest'nodes req + requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req + let 37 = length nodes + let 1 = length requestedFiles + mapM_ (walkNode nodes) [0,1..36] + walkNode nodes i = do + node <- index i nodes + -- None of the nodes in the schema have parameters: + False <- Schema.has_Node'parameters node + -- And none of them are generic: + False <- Schema.get_Node'isGeneric node + + nameList <- Schema.get_Node'displayName node + name <- textBytes nameList + prefixLen <- Schema.get_Node'displayNamePrefixLength node + let baseName = BS.drop (fromIntegral prefixLen) name + + when (i < Prelude.length nodeNames && baseName /= (nodeNames !! i)) $ + error "Incorrect name." + + has <- Schema.has_Node'annotations node + + -- there are two annotations in all of the nodes, at these indicies: + case (has, i `elem` [4, 9]) of + (False, False) -> return () + (True, True) -> do + 1 <- length <$> Schema.get_Node'annotations node + return () + (False, True) -> + error $ "Node at index " ++ show i ++ " should have had" ++ + "an annotation." + (True, False) -> + error $ "Node at index " ++ show i ++ " should not " ++ + "have had an annotation." + +walkSchemaCodeGenRequestTest :: Test +walkSchemaCodeGenRequestTest = + assertionsToTest "walk schema CodeGenerationRequest" [theAssert] diff --git a/tests/simple-tests/Main.hs b/tests/simple-tests/Main.hs deleted file mode 100644 --- a/tests/simple-tests/Main.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main (main) where - -import Test.Framework (defaultMain) - -import Tests.Module.Capnp.Capnp.Schema (schemaTests) -import Tests.Module.Capnp.Capnp.Schema.Pure (pureSchemaTests) -import Tests.Module.Data.Capnp.Bits (bitsTests) -import Tests.Module.Data.Capnp.Pointer (ptrTests) -import Tests.Module.Data.Capnp.Untyped (untypedTests) -import Tests.Module.Data.Capnp.Untyped.Pure (pureUntypedTests) -import Tests.SchemaQuickCheck (schemaCGRQuickCheck) -import Tests.WalkSchemaCodeGenRequest (walkSchemaCodeGenRequestTest) - -main :: IO () -main = defaultMain [ bitsTests - , ptrTests - , untypedTests - , pureUntypedTests - , walkSchemaCodeGenRequestTest - , schemaCGRQuickCheck - , schemaTests - , pureSchemaTests - ] diff --git a/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs b/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -module Tests.Module.Capnp.Capnp.Schema (schemaTests) where - -import Control.Monad (when) -import Control.Monad.Primitive (RealWorld) -import Text.Heredoc (there) - -import Capnp.Capnp.Schema - -import Data.Capnp (newRoot) -import Data.Capnp.TraversalLimit (LimitT, evalLimitT) -import Data.Mutable (Thaw(..)) -import Tests.Util (assertionsToTest, decodeValue) - -import qualified Data.Capnp.Message as M - -data BuildTest = BuildTest - { typeName :: String - , expected :: String - , builder :: M.MutMsg RealWorld -> LimitT IO () - } - -schemaTests = assertionsToTest "Test typed setters" $ map testCase - [ BuildTest - { typeName = "Field" - , expected = concat - [ "( codeOrder = 4,\n" - , " discriminantValue = 6,\n" - , " group = (typeId = 322),\n" - , " ordinal = (explicit = 22) )\n" - ] - , builder = \msg -> do - field <- newRoot msg - set_Field'codeOrder field 4 - set_Field'discriminantValue field 6 - union <- get_Field'union' field - group <- set_Field'group union - set_Field'group'typeId group 322 - ordinal <- get_Field'ordinal field - set_Field'ordinal'explicit ordinal 22 - } - ] - where - testCase BuildTest{..} = do - msg <- M.newMessage - evalLimitT maxBound $ builder msg - constMsg <- freeze msg - actual <- decodeValue schemaSchema typeName constMsg - when (actual /= expected) $ - error $ "Expected:\n\n" ++ show expected ++ "\n\n...but got:\n\n" ++ show actual - -schemaSchema = [there|core-schema/capnp/schema.capnp|] diff --git a/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs b/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs +++ /dev/null @@ -1,810 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Tests.Module.Capnp.Capnp.Schema.Pure (pureSchemaTests) where - -import Data.Proxy -import Data.Word - -import Control.Exception (bracket) -import Control.Monad (when) -import Control.Monad.Primitive (RealWorld) -import Data.Default (Default(..)) -import System.Directory (removeFile) -import System.IO - (IOMode(ReadMode, WriteMode), hClose, openBinaryTempFile, withBinaryFile) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit.Lang (Assertion, assertEqual) -import Test.QuickCheck - (Arbitrary(..), Gen, Property, genericShrink, oneof, resize, sized) -import Test.QuickCheck.Instances () -import Test.QuickCheck.IO (propertyIO) -import Text.Heredoc (here, there) -import Text.Show.Pretty (ppShow) - -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Vector as V - -import Capnp.Capnp.Schema.Pure -import Tests.Util - -import Data.Capnp (getRoot, setRoot) -import Data.Capnp.Classes - ( Allocate(..) - , Cerialize(..) - , Decerialize(..) - , FromStruct(..) - , ToStruct(..) - , cerialize - ) -import Data.Capnp.Pure (hGetValue, hPutValue) -import Data.Capnp.TraversalLimit (defaultLimit, evalLimitT) -import Data.Mutable (Thaw(..)) - -import qualified Data.Capnp.Message as M -import qualified Data.Capnp.Untyped as U -import qualified Data.Capnp.Untyped.Pure as PU - -schemaText = [there|tests/data/schema.capnp|] - -pureSchemaTests = testGroup "Tests for generated .Pure modules." - [ decodeTests - , decodeDefaultTests - , encodeTests - , propTests - ] - -encodeTests = testGroup "schema encode tests" - [ testCase - ( "Node.Parameter" - , Node'Parameter { name = "Bob" } - , "(name = \"Bob\")\n" - ) - ] - where - testCase :: - -- TODO: the size of this context is *stupid* - ( Show a - , Eq a - , Cerialize RealWorld a - , FromStruct M.ConstMsg (Cerial M.ConstMsg a) - , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) - , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a) - ) => (String, a, String) -> Test - testCase (name, expectedValue, expectedText) = - assertionsToTest ("Check cerialize against capnp decode (" ++ name ++ ")") $ pure $ do - msg <- evalLimitT maxBound $ do - -- TODO: add some helpers for all this. - msg <- M.newMessage - cerialOut <- cerialize msg expectedValue - setRoot cerialOut - freeze msg - builder <- M.encode msg - actualText <- capnpDecode - (LBS.toStrict $ BB.toLazyByteString builder) - (MsgMetaData schemaText name) - assertEqual ("Encode " ++ show expectedValue) - expectedText - actualText - actualValue <- evalLimitT maxBound $ do - root <- U.rootPtr msg - cerialIn <- fromStruct root - decerialize cerialIn - assertEqual - ("decerialize (cerialize " ++ show expectedValue ++ ") == " ++ show actualValue) - expectedValue - actualValue - -decodeTests = testGroup "schema decode tests" - [ decodeTests "CodeGeneratorRequest" - [ ( [here| - ( capnpVersion = (major = 0, minor = 6, micro = 1) - , nodes = [] - , requestedFiles = - [ ( id = 4 - , filename = "hello.capnp" - , imports = - [ (id = 2, name = "std") - ] - ) - ] - ) - |] - , CodeGeneratorRequest - { capnpVersion = CapnpVersion { major = 0, minor = 6, micro = 1 } - , nodes = [] - , requestedFiles = - [ CodeGeneratorRequest'RequestedFile - 4 - "hello.capnp" - [CodeGeneratorRequest'RequestedFile'Import 2 "std"] - ] - } - ) - ] - , decodeTests "Node" - [ ( [here| - ( id = 7 - , displayName = "foo:MyType" - , displayNamePrefixLength = 4 - , scopeId = 2 - , parameters = [ (name = "theName") ] - , isGeneric = true - , nestedNodes = [(name = "theName", id = 321)] - , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] - , |] ++ unionText ++ [here| - ) - |] - , Node - 7 - "foo:MyType" - 4 - 2 - [Node'NestedNode "theName" 321] - [Annotation 2 (Value'bool True) (Brand [])] - [Node'Parameter "theName" ] - True - unionVal - ) - | (unionText, unionVal) <- - [ ("file = void", Node'file) - , ( [here| struct = - ( dataWordCount = 3 - , pointerCount = 2 - , preferredListEncoding = inlineComposite - , isGroup = false - , discriminantCount = 4 - , discriminantOffset = 2 - , fields = - [ ( name = "fieldName" - , codeOrder = 3 - , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] - , discriminantValue = 7 - , group = (typeId = 4) - , ordinal = (implicit = void) - ) - ] - ) - |] - , Node'struct - { dataWordCount = 3 - , pointerCount = 2 - , preferredListEncoding = ElementSize'inlineComposite - , isGroup = False - , discriminantCount = 4 - , discriminantOffset = 2 - , fields = - [ Field - "fieldName" - 3 - [ Annotation - 2 - (Value'bool True) - (Brand []) - ] - 7 - Field'ordinal'implicit - (Field'group 4) - ] - } - ) - , ( "enum = (enumerants = [(name = \"blue\", codeOrder = 2, annotations = [])])" - , Node'enum [ Enumerant "blue" 2 [] ] - ) - , ( "interface = (methods = [], superclasses = [(id = 0, brand = (scopes = []))])" - , Node'interface [] [Superclass 0 (Brand [])] - ) - , ( "const = (type = (bool = void), value = (bool = false))" - , Node'const Type'bool (Value'bool False) - ) - , ( [here| annotation = - ( type = (bool = void) - , targetsFile = true - , targetsConst = false - , targetsEnum = false - , targetsEnumerant = true - , targetsStruct = true - , targetsField = true - , targetsUnion = false - , targetsGroup = false - , targetsInterface = true - , targetsMethod = false - , targetsParam = true - , targetsAnnotation = false - ) - |] - , Node'annotation - Type'bool - True - False - False - True - True - True - False - False - True - False - True - False - ) - ] - ] - , decodeTests "Node.Parameter" - [ ("(name = \"theName\")", Node'Parameter "theName" ) - ] - , decodeTests "Node.NestedNode" - [ ("(name = \"theName\", id = 321)", Node'NestedNode "theName" 321) - ] - , decodeTests "Value" - [ ("(bool = true)", Value'bool True) - , ("(bool = false)", Value'bool False) - , ("(int8 = -4)", Value'int8 (-4)) - , ("(int8 = -128)", Value'int8 (-128)) - , ("(int8 = 127)", Value'int8 127) - , ("(uint8 = 23)", Value'uint8 23) - , ("(uint8 = 255)", Value'uint8 255) - , ("(int16 = 1012)", Value'int16 1012) - , ("(uint16 = 40000)", Value'uint16 40000) - , ("(uint32 = 1000100)", Value'uint32 1000100) - , ("(int32 = 1000100)", Value'int32 1000100) - , ("(uint64 = 1234567890123456)", Value'uint64 1234567890123456) - , ("(int64 = 12345678901234567)", Value'int64 12345678901234567) - , ("(float32 = 17.32)", Value'float32 17.32) - , ("(float64 = 13.99)", Value'float64 13.99) - , ("(data = \"beep boop.\")", Value'data_ "beep boop.") - , ("(text = \"Hello, World!\")", Value'text "Hello, World!") - , ("(enum = 2313)", Value'enum 2313) - , ("(interface = void)", Value'interface) - -- TODO: It would be nice to test list, struct, and anyPointer - -- variants, but I(zenhack) haven't figured out how to specify - -- an AnyPointer in the input to capnp encode. Maybe capnp eval - -- can do something like this? will have to investigate. - ] - , decodeTests "Annotation" - [ ( "(id = 323, brand = (scopes = []), value = (bool = true))" - , Annotation 323 (Value'bool True) (Brand []) - ) - ] - , decodeTests "CapnpVersion" - [ ("(major = 0, minor = 5, micro = 3)", CapnpVersion 0 5 3) - , ("(major = 1, minor = 0, micro = 2)", CapnpVersion 1 0 2) - ] - , decodeTests "Field" - [ ( [here| - ( name = "fieldName" - , codeOrder = 3 - , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] - , discriminantValue = 3 - , group = (typeId = 4) - , ordinal = (implicit = void) - ) - |] - , Field - "fieldName" - 3 - [Annotation 2 (Value'bool True) (Brand [])] - 3 - Field'ordinal'implicit - (Field'group 4) - ) - , ( [here| - ( name = "fieldName" - , codeOrder = 3 - , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ] - , discriminantValue = 3 - , slot = - ( offset = 3 - , type = (bool = void) - , defaultValue = (bool = false) - , hadExplicitDefault = true - ) - , ordinal = (explicit = 7) - ) - |] - , Field - "fieldName" - 3 - [Annotation 2 (Value'bool True) (Brand [])] - 3 - (Field'ordinal'explicit 7) - (Field'slot - 3 - Type'bool - (Value'bool False) - True) - ) - ] - , decodeTests "Enumerant" - [ ( [here| - ( name = "red" - , codeOrder = 4 - , annotations = - [ (id = 23, brand = (scopes = []), value = (uint8 = 3)) - ] - ) - |] - , Enumerant "red" 4 [Annotation 23 (Value'uint8 3) (Brand [])] - ) - ] - , decodeTests "Superclass" - [ ("(id = 34, brand = (scopes = []))", Superclass 34 (Brand [])) - ] - , decodeTests "Type" - [ ("(bool = void)", Type'bool) - , ("(int8 = void)", Type'int8) - , ("(int16 = void)", Type'int16) - , ("(int32 = void)", Type'int32) - , ("(int64 = void)", Type'int64) - , ("(uint8 = void)", Type'uint8) - , ("(uint16 = void)", Type'uint16) - , ("(uint32 = void)", Type'uint32) - , ("(uint64 = void)", Type'uint64) - , ("(float32 = void)", Type'float32) - , ("(float64 = void)", Type'float64) - , ("(text = void)", Type'text) - , ("(data = void)", Type'data_) - , ( "(list = (elementType = (list = (elementType = (text = void)))))" - , Type'list $ Type'list Type'text - ) - , ( "(enum = (typeId = 4, brand = (scopes = [])))" - , Type'enum 4 (Brand []) - ) - , ( "(struct = (typeId = 7, brand = (scopes = [])))" - , Type'struct 7 (Brand []) - ) - , ( "(interface = (typeId = 1, brand = (scopes = [])))" - , Type'interface 1 (Brand []) - ) - , ( "(anyPointer = (unconstrained = (anyKind = void)))" - , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'anyKind - ) - , ( "(anyPointer = (unconstrained = (struct = void)))" - , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'struct - ) - , ( "(anyPointer = (unconstrained = (list = void)))" - , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'list - ) - , ( "(anyPointer = (unconstrained = (capability = void)))" - , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'capability - ) - , ( "(anyPointer = (parameter = (scopeId = 4, parameterIndex = 2)))" - , Type'anyPointer $ Type'anyPointer'parameter 4 2 - ) - , ( "(anyPointer = (implicitMethodParameter = (parameterIndex = 7)))" - , Type'anyPointer $ Type'anyPointer'implicitMethodParameter 7 - ) - ] - , decodeTests "Brand" - [ ("(scopes = [])", Brand []) - , ( [here| - ( scopes = - [ (scopeId = 32, inherit = void) - , (scopeId = 23, bind = - [ (unbound = void) - , (type = (bool = void)) - ] - ) - ] - ) - |] - , Brand - [ Brand'Scope 32 Brand'Scope'inherit - , Brand'Scope 23 $ Brand'Scope'bind - [ Brand'Binding'unbound - , Brand'Binding'type_ Type'bool - ] - ] - ) - ] - ] - where - -- decodeTests :: Decerialize Struct a => String -> [(String, a)] -> IO () - decodeTests typename cases = - assertionsToTest ("Decode " ++ typename) $ map (testCase typename) cases - testCase typename (capnpText, expected) = do - msg <- encodeValue schemaText typename capnpText - actual <- evalLimitT 128 $ getRoot msg - ppAssertEqual actual expected - -decodeDefaultTests = assertionsToTest - "Check that the empty struct decodes to the default value" - [ decodeDefault "Type" (Proxy :: Proxy Type) - , decodeDefault "Value" (Proxy :: Proxy Value) - , decodeDefault "Node" (Proxy :: Proxy Node) - ] - -decodeDefault :: - ( Show a - , Eq a - , Default a - , FromStruct M.ConstMsg a - , Cerialize RealWorld a - , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) - ) => String -> Proxy a -> Assertion -decodeDefault typename proxy = do - actual <- evalLimitT defaultLimit (getRoot M.empty) - ppAssertEqual (actual `asProxyTypeOf` proxy) def - -ppAssertEqual :: (Show a, Eq a) => a -> a -> IO () -ppAssertEqual actual expected = - when (actual /= expected) $ error $ - "Expected:\n\n" ++ ppShow expected ++ "\n\nbut got:\n\n" ++ ppShow actual - -propTests = testGroup "Various quickcheck properties" - [ propCase "Node" (Proxy :: Proxy Node) - , propCase "Node.Parameter" (Proxy :: Proxy Node'Parameter) - , propCase "Node.NestedNode" (Proxy :: Proxy Node'NestedNode) - , propCase "Field" (Proxy :: Proxy Field) - , propCase "Enumerant" (Proxy :: Proxy Enumerant) - , propCase "Superclass" (Proxy :: Proxy Superclass) - , propCase "Method" (Proxy :: Proxy Method) - , propCase "Type" (Proxy :: Proxy Type) - , propCase "Brand" (Proxy :: Proxy Brand) - , propCase "Brand.Scope" (Proxy :: Proxy Brand'Scope) - , propCase "Brand.Binding" (Proxy :: Proxy Brand'Binding) - , propCase "Value" (Proxy :: Proxy Value) - , propCase "Annotation" (Proxy :: Proxy Annotation) - , propCase "CapnpVersion" (Proxy :: Proxy CapnpVersion) - , propCase "CodeGeneratorRequest" (Proxy :: Proxy CodeGeneratorRequest) - , propCase "CodeGeneratorRequest.RequestedFile" - (Proxy :: Proxy CodeGeneratorRequest'RequestedFile) - , propCase "CodeGeneratorRequest.RequestedFile.Import" - (Proxy :: Proxy CodeGeneratorRequest'RequestedFile'Import) - ] - -propCase name proxy = testGroup ("...for " ++ name) - [ testProperty "check that cerialize and decerialize are inverses." (prop_cerializeDecerializeInverses proxy) - , testProperty "check that hPutValue and hGetValue are inverses." (prop_hGetPutInverses proxy) - ] - -prop_hGetPutInverses :: - ( Show a - , Eq a - , FromStruct M.ConstMsg a - , Cerialize RealWorld a - , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) - ) => Proxy a -> a -> Property -prop_hGetPutInverses proxy expected = propertyIO $ do - -- This is a little more complicated than I'd like due to resource - -- management issues. We create a temporary file, then immediately - -- close the handle to it, and open it again in a separate call to - -- bracket. This allows us to decouple the lifetimes of the file and - -- the handle. - actual <- bracket - (do - (filename, handle) <- openBinaryTempFile "/tmp" "hPutValue-output" - hClose handle - pure filename) - removeFile - (\filename -> do - withBinaryFile filename WriteMode - (`hPutValue` expected) - withBinaryFile filename ReadMode $ \h -> - hGetValue h defaultLimit) - ppAssertEqual actual expected - --- Generate an arbitrary "unknown" tag, i.e. one with a value unassigned --- by the schema. The parameter is the number of tags assigned by the schema. -arbitraryTag :: Word16 -> Gen Word16 -arbitraryTag numTags = max numTags <$> arbitrary - -instance Arbitrary Node where - shrink = genericShrink - arbitrary = do - id <- arbitrary - displayName <- arbitrary - displayNamePrefixLength <- arbitrary - scopeId <- arbitrary - parameters <- arbitrarySmallerVec - isGeneric <- arbitrary - nestedNodes <- arbitrarySmallerVec - annotations <- arbitrarySmallerVec - union' <- arbitrary - pure Node{..} - -instance Arbitrary Node' where - shrink = genericShrink - arbitrary = oneof - [ pure Node'file - , do - dataWordCount <- arbitrary - pointerCount <- arbitrary - preferredListEncoding <- arbitrary - isGroup <- arbitrary - discriminantCount <- arbitrary - discriminantOffset <- arbitrary - fields <- arbitrarySmallerVec - pure Node'struct{..} - , Node'enum <$> arbitrarySmallerVec - , Node'interface <$> arbitrarySmallerVec <*> arbitrarySmallerVec - , Node'const <$> arbitrary <*> arbitrary - , do - type_ <- arbitrary - targetsFile <- arbitrary - targetsConst <- arbitrary - targetsEnum <- arbitrary - targetsEnumerant <- arbitrary - targetsStruct <- arbitrary - targetsField <- arbitrary - targetsUnion <- arbitrary - targetsGroup <- arbitrary - targetsInterface <- arbitrary - targetsMethod <- arbitrary - targetsParam <- arbitrary - targetsAnnotation <- arbitrary - pure Node'annotation{..} - , Node'unknown' <$> arbitraryTag 6 - ] - -instance Arbitrary Node'NestedNode where - shrink = genericShrink - arbitrary = Node'NestedNode - <$> arbitrary - <*> arbitrary - -instance Arbitrary Field where - shrink = genericShrink - arbitrary = do - name <- arbitrary - codeOrder <- arbitrary - annotations <- arbitrary - discriminantValue <- arbitrary - union' <- arbitrary - ordinal <- arbitrary - pure Field{..} - -instance Arbitrary Field' where - shrink = genericShrink - arbitrary = oneof - [ do - offset <- arbitrary - type_ <- arbitrary - defaultValue <- arbitrary - hadExplicitDefault <- arbitrary - pure Field'slot{..} - , Field'group <$> arbitrary - ] - -instance Arbitrary Field'ordinal where - shrink = genericShrink - arbitrary = oneof - [ pure Field'ordinal'implicit - , Field'ordinal'explicit <$> arbitrary - ] - -instance Arbitrary Enumerant where - shrink = genericShrink - arbitrary = Enumerant - <$> arbitrary - <*> arbitrary - <*> arbitrarySmallerVec - -instance Arbitrary Superclass where - shrink = genericShrink - arbitrary = Superclass - <$> arbitrary - <*> arbitrary - -instance Arbitrary Method where - shrink = genericShrink - arbitrary = do - name <- arbitrary - codeOrder <- arbitrary - implicitParameters <- arbitrary - paramStructType <- arbitrary - paramBrand <- arbitrary - resultStructType <- arbitrary - resultBrand <- arbitrary - annotations <- arbitrary - pure Method{..} - -instance Arbitrary CapnpVersion where - shrink = genericShrink - arbitrary = CapnpVersion - <$> arbitrary - <*> arbitrary - <*> arbitrary - -instance Arbitrary Node'Parameter where - shrink = genericShrink - arbitrary = Node'Parameter <$> arbitrary - -instance Arbitrary Brand where - shrink = genericShrink - arbitrary = Brand <$> arbitrarySmallerVec - -instance Arbitrary Brand'Scope where - shrink = genericShrink - arbitrary = Brand'Scope - <$> arbitrary - <*> arbitrary - -instance Arbitrary Brand'Scope' where - shrink = genericShrink - arbitrary = oneof - [ Brand'Scope'bind <$> arbitrarySmallerVec - , pure Brand'Scope'inherit - , Brand'Scope'unknown' <$> arbitraryTag 2 - ] - -instance Arbitrary Brand'Binding where - shrink = genericShrink - arbitrary = oneof - [ pure Brand'Binding'unbound - , Brand'Binding'type_ <$> arbitrary - , Brand'Binding'unknown' <$> arbitraryTag 2 - ] - -instance Arbitrary Value where - shrink = genericShrink - arbitrary = oneof - [ pure Value'void - , Value'bool <$> arbitrary - , Value'int8 <$> arbitrary - , Value'int16 <$> arbitrary - , Value'int32 <$> arbitrary - , Value'int64 <$> arbitrary - , Value'uint8 <$> arbitrary - , Value'uint16 <$> arbitrary - , Value'uint32 <$> arbitrary - , Value'uint64 <$> arbitrary - , Value'float32 <$> arbitrary - , Value'float64 <$> arbitrary - , Value'text <$> arbitrary - , Value'data_ <$> arbitrary - , Value'list <$> arbitrary - , Value'enum <$> arbitrary - , Value'struct <$> arbitrary - , pure Value'interface - , Value'anyPointer <$> arbitrary - , Value'unknown' <$> arbitraryTag 19 - ] - -instance Arbitrary Annotation where - shrink = genericShrink - arbitrary = Annotation - <$> arbitrary - <*> arbitrary - <*> arbitrary - -instance Arbitrary ElementSize where - shrink = genericShrink - arbitrary = oneof - [ pure ElementSize'empty - , pure ElementSize'bit - , pure ElementSize'byte - , pure ElementSize'twoBytes - , pure ElementSize'fourBytes - , pure ElementSize'eightBytes - , pure ElementSize'pointer - , pure ElementSize'inlineComposite - , ElementSize'unknown' <$> arbitraryTag 8 - ] - -instance Arbitrary Type'anyPointer where - shrink = genericShrink - arbitrary = oneof - [ Type'anyPointer'unconstrained <$> arbitrary - , Type'anyPointer'parameter <$> arbitrary <*> arbitrary - , Type'anyPointer'implicitMethodParameter <$> arbitrary - ] - -instance Arbitrary Type'anyPointer'unconstrained where - shrink = genericShrink - arbitrary = oneof - [ pure Type'anyPointer'unconstrained'anyKind - , pure Type'anyPointer'unconstrained'struct - , pure Type'anyPointer'unconstrained'list - , pure Type'anyPointer'unconstrained'capability - ] - -instance Arbitrary Type where - shrink = genericShrink - arbitrary = oneof - [ pure Type'void - , pure Type'bool - , pure Type'int8 - , pure Type'int16 - , pure Type'int32 - , pure Type'int64 - , pure Type'uint8 - , pure Type'uint16 - , pure Type'uint32 - , pure Type'uint64 - , pure Type'float32 - , pure Type'float64 - , pure Type'text - , pure Type'data_ - , Type'list <$> arbitrary - , Type'enum <$> arbitrary <*> arbitrary - , Type'interface <$> arbitrary <*> arbitrary - , Type'anyPointer <$> arbitrary - , Type'unknown' <$> arbitraryTag 21 - ] - -instance Arbitrary CodeGeneratorRequest where - shrink = genericShrink - arbitrary = do - capnpVersion <- arbitrary - nodes <- arbitrarySmallerVec - requestedFiles <- arbitrarySmallerVec - pure CodeGeneratorRequest{..} - -instance Arbitrary CodeGeneratorRequest'RequestedFile where - shrink = genericShrink - arbitrary = CodeGeneratorRequest'RequestedFile - <$> arbitrary - <*> arbitrary - <*> arbitrary - -instance Arbitrary CodeGeneratorRequest'RequestedFile'Import where - shrink = genericShrink - arbitrary = CodeGeneratorRequest'RequestedFile'Import - <$> arbitrary - <*> arbitrary - -instance Arbitrary a => Arbitrary (PU.Slice a) where - shrink = genericShrink - arbitrary = PU.Slice <$> arbitrarySmallerVec - -arbitrarySmallerVec :: Arbitrary a => Gen (V.Vector a) -arbitrarySmallerVec = sized $ \size -> do - -- Make sure the elements are scaled down relative to - -- the size of the vector: - vec <- arbitrary :: Gen (V.Vector ()) - let gen = resize (size `div` V.length vec) arbitrary - traverse (const gen) vec - -instance Arbitrary PU.Struct where - shrink = genericShrink - arbitrary = sized $ \size -> PU.Struct - <$> arbitrary - <*> arbitrary - -instance Arbitrary PU.List where - shrink = genericShrink - arbitrary = oneof - [ PU.List0 <$> arbitrarySmallerVec - , PU.List1 <$> arbitrarySmallerVec - , PU.List8 <$> arbitrarySmallerVec - , PU.List16 <$> arbitrarySmallerVec - , PU.List32 <$> arbitrarySmallerVec - , PU.List64 <$> arbitrarySmallerVec - , PU.ListPtr <$> arbitrarySmallerVec - , PU.ListStruct <$> arbitrarySmallerVec - ] - -instance Arbitrary PU.PtrType where - shrink = genericShrink - arbitrary = oneof - [ PU.PtrStruct <$> arbitrary - , PU.PtrList <$> arbitrary - , PU.PtrCap <$> arbitrary - ] - -prop_cerializeDecerializeInverses :: - ( Show a - , Eq a - , Cerialize RealWorld a - , FromStruct M.ConstMsg (Cerial M.ConstMsg a) - , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a) - , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a) - ) => Proxy a -> a -> Property -prop_cerializeDecerializeInverses _proxy expected = propertyIO $ do - actual <- evalLimitT maxBound $ do - -- TODO: add some helpers for all this. - msg <- M.newMessage - cerialOut <- cerialize msg expected - setRoot cerialOut - constMsg :: M.ConstMsg <- freeze msg - root <- U.rootPtr constMsg - cerialIn <- fromStruct root - decerialize cerialIn - ppAssertEqual actual expected diff --git a/tests/simple-tests/Tests/Module/Data/Capnp/Bits.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Bits.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Data/Capnp/Bits.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Tests.Module.Data.Capnp.Bits (bitsTests) where - -import Data.Bits -import Data.Word - -import Test.Framework (testGroup) -import Test.HUnit (Assertion, assertEqual) -import Tests.Util (assertionsToTest) - -import Data.Capnp.Bits - - -bitsTests = testGroup "bits tests" [bitRangeExamples, replaceBitsExamples] - -bitRangeExamples = assertionsToTest "bitRange examples" $ - map bitRangeTest $ - ones ++ - [ (0x0000000200000000, 32, 48, 2) - ] - where - bitRangeTest (word, lo, hi, expected) = - assertEqual - (concat [ "bitRange ", show word, " ", show lo, " ", show hi - , " == " - , show expected - ]) - expected - (bitRange word lo hi) - ones = map (\bit -> (1 `shiftL` bit, bit, bit + 1, 1)) [0..63] - -replaceBitsExamples = assertionsToTest "replaceBits" - [ replaceTest 8 (0xf :: Word8) 0 0 0xf - , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1 - , replaceTest 8 (0x2 :: Word8) 0x1 0 0x2 - , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1 - , replaceTest 8 (0x2 :: Word8) 0x10 4 0x20 - , replaceTest 8 (0x1 :: Word8) 0x10 8 0x0110 - , replaceTest 8 (0xa :: Word8) 0xffff 8 0x0aff - , replaceTest 1 (0x0 :: Word1) 0xff 4 0xef - ] - where - replaceTest :: (Bounded a, Integral a, Show a) - => Int -> a -> Word64 -> Int -> Word64 -> Assertion - replaceTest len new orig shift expected = - assertEqual (concat [ "replaceBits (", show new, " :: Word", show len, ") " - , show orig, " ", show shift - , " == " - , show expected - ]) - expected - (replaceBits new orig shift) diff --git a/tests/simple-tests/Tests/Module/Data/Capnp/Pointer.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Pointer.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Data/Capnp/Pointer.hs +++ /dev/null @@ -1,83 +0,0 @@ -module Tests.Module.Data.Capnp.Pointer (ptrTests) where - -import Data.Bits -import Data.Int -import Data.Word - -import Test.Framework (testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit (assertEqual) -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import Test.QuickCheck.Gen (Gen, oneof) - -import Data.Capnp.Pointer - -import Tests.Util (assertionsToTest) - -instance Arbitrary EltSpec where - arbitrary = oneof [ EltNormal <$> arbitrary <*> arbitraryU29 - , EltComposite <$> arbitraryI29 - ] - -instance Arbitrary ElementSize where - arbitrary = oneof $ map return [ Sz0 - , Sz1 - , Sz8 - , Sz16 - , Sz32 - , Sz64 - , SzPtr - ] - - --- | arbitraryIN is an arbitrary N bit signed integer as an Int32. -arbitraryI32, arbitraryI30, arbitraryI29 :: Gen Int32 -arbitraryI32 = arbitrary -arbitraryI30 = (`shiftR` 2) <$> arbitraryI32 -arbitraryI29 = (`shiftR` 3) <$> arbitraryI32 --- | arbitraryUN is an arbitrary N bit unsigned integer as a Word32. -arbitraryU32, arbitraryU30, arbitraryU29 :: Gen Word32 -arbitraryU32 = arbitrary -arbitraryU30 = (`shiftR` 2) <$> arbitraryU32 -arbitraryU29 = (`shiftR` 3) <$> arbitraryU32 - - -instance Arbitrary Ptr where - arbitrary = oneof [ StructPtr <$> arbitraryI30 - <*> arbitrary - <*> arbitrary - , ListPtr <$> arbitraryI30 - <*> arbitrary - , FarPtr <$> arbitrary - <*> arbitraryU29 - <*> arbitrary - , CapPtr <$> arbitrary - ] - -ptrTests = testGroup "Pointer Tests" [ptrProps, parsePtrExamples] - -ptrProps = testGroup "Pointer Properties" - [ testProperty "parseEltSpec . serializeEltSpec == id" - (\spec -> parseEltSpec (serializeEltSpec spec) == spec) - , testProperty "parsePtr . serializePtr == id" $ \ptr -> - case ptr of - (Just (StructPtr 0 0 0)) -> True -- we skip this one, since it's - -- the same bits as a null, so this - -- shouldn't hold. TODO: the name - -- of this test is a bit misleading - -- because of this case; should fix - -- that. - _ -> parsePtr (serializePtr ptr) == ptr - ] - - -parsePtrExamples = assertionsToTest "parsePtr Examples" $ - map parseExample - [ (0x0000000200000000, Just $ StructPtr 0 2 0) - ] - where - parseExample (word, expected) = - assertEqual - (concat ["parsePtr ", show word, " == ", show expected]) - expected - (parsePtr word) diff --git a/tests/simple-tests/Tests/Module/Data/Capnp/Untyped.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Untyped.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Data/Capnp/Untyped.hs +++ /dev/null @@ -1,288 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -module Tests.Module.Data.Capnp.Untyped (untypedTests) where - -import Prelude hiding (length) - -import Control.Monad (forM_, when) -import Control.Monad.Primitive (RealWorld) -import Data.ReinterpretCast (doubleToWord, wordToDouble) -import Test.Framework (Test, testGroup) -import Test.HUnit (assertEqual) -import Text.Heredoc (here, there) - -import qualified Data.ByteString as BS - -import Data.Capnp.Untyped -import Tests.Util - -import Data.Capnp.TraversalLimit (LimitT, evalLimitT, execLimitT) -import Data.Mutable (Thaw(..)) - -import qualified Data.Capnp.Classes as C -import qualified Data.Capnp.Message as M - -untypedTests = testGroup "Untyped Tests" - [ readTests - , modifyTests - , farPtrTest - ] - -readTests :: Test -readTests = assertionsToTest "read tests" - [ do - msg <- encodeValue - [there|tests/data/aircraft.capnp|] - "Aircraft" - [here|(f16 = (base = ( - name = "bob", - homes = [], - rating = 7, - canFly = true, - capacity = 5173, - maxSpeed = 12.0 - )))|] - endQuota <- execLimitT 128 $ do - root <- rootPtr msg - let aircraftWords = dataSection root - -- Aircraft just has the union tag, nothing else in it's data - -- section. - let 1 = length aircraftWords - 3 <- index 0 aircraftWords -- tag for F16 - let 1 = length (ptrSection root) - Just (PtrStruct f16) <- getPtr 0 root - let 0 = length (dataSection f16) - let 1 = length (ptrSection f16) - Just (PtrStruct base) <- getPtr 0 f16 - let 4 = length (dataSection base) -- Except canFly, each field is 1 word, and - -- canFly is aligned such that it ends up - -- consuming a whole word. - let 2 = length (ptrSection base) -- name, homes - - -- Walk the data section: - 7 <- getData 0 base -- rating - 1 <- getData 1 base -- canFly - 5173 <- getData 2 base -- capacity - 12.0 <- wordToDouble <$> getData 3 base - - -- ...and the pointer section: - Just (PtrList (List8 name)) <- getPtr 0 base - -- Text values have a NUL terminator, which is included in the - -- length on the wire. The spec says that this shouldn't be - -- included in the length reported to the caller, but that needs - -- to be dealt with by schema-aware code, so this is the length of - -- "bob\0" - let 4 = length name - - forM_ (zip [0..3] (BS.unpack "bob\0")) $ \(i, c) -> do - c' <- index i name - when (c /= c') $ - error ("index " ++ show i ++ ": " ++ show c ++ " /= " ++ show c') - Just (PtrList (List16 homes)) <- getPtr 1 base - let 0 = length homes - return () - assertEqual "endQuota == 110" 110 endQuota - ] - -data ModTest s = ModTest - { testIn :: String - , testMod :: Struct (M.MutMsg RealWorld) -> LimitT IO () - , testOut :: String - , testType :: String - } - -modifyTests :: Test -modifyTests = testGroup "Test modification" $ map testCase - -- tests for setIndex - [ ModTest - { testIn = "(year = 2018, month = 6, day = 20)\n" - , testType = "Zdate" - , testOut = "(year = 0, month = 0, day = 0)\n" - , testMod = setIndex 0 0 . dataSection - } - , ModTest - { testIn = "(text = \"Hello, World!\")\n" - , testType = "Z" - , testOut = "(text = \"hEllo, world!\")\n" - , testMod = \struct -> do - Just (PtrList (List8 list)) <- index 0 (ptrSection struct) - setIndex (fromIntegral (fromEnum 'h')) 0 list - setIndex (fromIntegral (fromEnum 'E')) 1 list - setIndex (fromIntegral (fromEnum 'w')) 7 list - } - , ModTest - { testIn = "(boolvec = [true, true, false, true])\n" - , testType = "Z" - , testOut = "( boolvec = [false, true, true, false] )\n" - , testMod = \struct -> do - Just (PtrList (List1 list)) <- index 0 (ptrSection struct) - setIndex False 0 list - setIndex True 2 list - setIndex False 3 list - } - , ModTest - { testIn = "(f64 = 2.0)\n" - , testType = "Z" - , testOut = "(f64 = 7.2)\n" - , testMod = setIndex (doubleToWord 7.2) 1 . dataSection - } - , ModTest - { testIn = unlines - [ "( size = 4," - , " words = \"Hello, World!\"," - , " wordlist = [\"apples\", \"oranges\"] )" - ] - , testType = "Counter" - , testOut = unlines - [ "( size = 4," - , " words = \"oranges\"," - , " wordlist = [\"apples\", \"Hello, World!\"] )" - ] - , testMod = \struct -> do - Just (PtrList (ListPtr list)) <- index 1 (ptrSection struct) - helloWorld <- index 0 (ptrSection struct) - oranges <- index 1 list - setIndex oranges 0 (ptrSection struct) - setIndex helloWorld 1 list - } - , ModTest - { testIn = unlines - [ "( aircraftvec = [" - , " ( f16 = (" - , " base = (" - , " name = \"alice\"," - , " homes = []," - , " rating = 7," - , " canFly = true," - , " capacity = 4," - , " maxSpeed = 100 ) ) )," - , " ( b737 = (" - , " base = (" - , " name = \"bob\"," - , " homes = []," - , " rating = 2," - , " canFly = false," - , " capacity = 9," - , " maxSpeed = 50 ) ) ) ] )" - ] - , testType = "Z" - , testOut = unlines - [ "( aircraftvec = [" - , " ( f16 = (" - , " base = (" - , " name = \"alice\"," - , " homes = []," - , " rating = 7," - , " canFly = true," - , " capacity = 4," - , " maxSpeed = 100 ) ) )," - , " ( f16 = (" - , " base = (" - , " name = \"alice\"," - , " homes = []," - , " rating = 7," - , " canFly = true," - , " capacity = 4," - , " maxSpeed = 100 ) ) ) ] )" - ] - , testMod = \struct -> do - Just (PtrList (ListStruct list)) <- getPtr 0 struct - src <- index 0 list - setIndex src 1 list - } - -- tests for allocation functions - , ModTest - { testIn = "()" - , testType = "StackingRoot" - , testOut = "( aWithDefault = (num = 6400),\n a = (num = 65, b = (num = 90000)) )\n" - - , testMod = \struct -> do - when (length (ptrSection struct) /= 2) $ - error "struct's pointer section is unexpedly small" - - let msg = message struct - a <- allocStruct msg 1 1 - aWithDefault <- allocStruct msg 1 1 - b <- allocStruct msg 1 0 - setPtr (Just (PtrStruct b)) 0 a - setPtr (Just (PtrStruct aWithDefault)) 0 struct - setPtr (Just (PtrStruct a)) 1 struct - setData 65 0 a - setData 6400 0 aWithDefault - setData 90000 0 b - } - , ModTest - { testIn = "()" - , testType = "HoldsVerTwoTwoList" - , testOut = "( mylist = [(val = 0, duo = 70), (val = 0, duo = 71), (val = 0, duo = 72), (val = 0, duo = 73)] )\n" - , testMod = \struct -> do - mylist <- allocCompositeList (message struct) 2 2 4 - forM_ [0..3] $ \i -> - index i mylist >>= setData (70 + fromIntegral i) 1 - setPtr (Just $ PtrList $ ListStruct mylist) 0 struct - } - , allocNormalListTest "u64vec" 21 allocList64 List64 - , allocNormalListTest "u32vec" 22 allocList32 List32 - , allocNormalListTest "u16vec" 23 allocList16 List16 - , allocNormalListTest "u8vec" 24 allocList8 List8 - , ModTest - { testIn = "()" - , testType = "Z" - , testOut = "( boolvec = [true, false, true] )\n" - , testMod = \struct -> do - setData 39 0 struct -- Set the union tag. - boolvec <- allocList1 (message struct) 3 - forM_ [0..2] $ \i -> - setIndex (even i) i boolvec - setPtr (Just $ PtrList $ List1 boolvec) 0 struct - } - ] - where - -- generate a ModTest for a (normal) list allocation function. - -- - -- parameters: - -- - -- * tagname - the name of the union variant - -- * tagvalue - the numeric value of the tag for this variant - -- * allocList - the allocation function - -- * dataCon - the data constructor for 'List' to use. - allocNormalListTest tagname tagvalue allocList dataCon = - ModTest - { testIn = "()" - , testType = "Z" - , testOut = "(" ++ tagname ++ " = [0, 1, 2, 3, 4])\n" - , testMod = \struct -> do - setData tagvalue 0 struct - vec <- allocList (message struct) 5 - forM_ [0..4] $ \i -> setIndex (fromIntegral i) i vec - setPtr (Just $ PtrList $ dataCon vec) 0 struct - } - testCase ModTest{..} = assertionsToTest - (show testIn ++ " : " ++ testType ++ " == " ++ show testOut) $ - pure $ do - msg <- thaw =<< encodeValue schemaText testType testIn - evalLimitT 128 $ rootPtr msg >>= testMod - actualOut <- decodeValue schemaText testType =<< freeze msg - assertEqual ( actualOut ++ " == " ++ testOut) actualOut testOut - schemaText = [there|tests/data/aircraft.capnp|] - - -farPtrTest = assertionsToTest - "Setting cross-segment pointers should work." - [ do - msg <- M.newMessage - -- The allocator always allocates new objects in the last segment, so - -- if we create a new segment, the call to allocStruct below should - -- allocate there: - (1, _) <- M.newSegment msg 16 - struct <- allocStruct msg 3 4 - setRoot struct - , evalLimitT maxBound $ do - msg <- M.newMessage - srcStruct <- allocStruct msg 4 4 - (1, _) <- M.newSegment msg 10 - dstStruct <- allocStruct msg 2 2 - setPtr (C.toPtr dstStruct) 0 srcStruct - ] diff --git a/tests/simple-tests/Tests/Module/Data/Capnp/Untyped/Pure.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Untyped/Pure.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Module/Data/Capnp/Untyped/Pure.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -module Tests.Module.Data.Capnp.Untyped.Pure (pureUntypedTests) where - -import Data.ReinterpretCast (doubleToWord) -import Test.Framework (Test) -import Test.HUnit (assertEqual) -import Text.Heredoc (here, there) - -import qualified Data.Vector as V - -import Data.Capnp.Untyped.Pure -import Tests.Util - -import Data.Capnp.Classes (decerialize) -import Data.Capnp.TraversalLimit (LimitT, runLimitT) - -import qualified Data.Capnp.Message as M -import qualified Data.Capnp.Untyped as U - --- This is analogous to Tests.Module.Data.Capnp.Untyped.untypedTests, but --- using the Pure module: -pureUntypedTests :: Test -pureUntypedTests = assertionsToTest "Untyped ADT Tests" - [ do - msg <- encodeValue - [there|tests/data/aircraft.capnp|] - "Aircraft" - [here|(f16 = (base = ( - name = "bob", - homes = [], - rating = 7, - canFly = true, - capacity = 5173, - maxSpeed = 12.0 - )))|] - (actual, 110) <- runLimitT 128 $ U.rootPtr msg >>= readStruct - assertEqual - "Untyped ADT test (assertEqual)" - (Struct - [3] - [ Just $ PtrStruct $ Struct - [] - [ Just $ PtrStruct $ Struct - [ 7 - , 1 - , 5173 - , doubleToWord 12.0 - ] - [ Just $ PtrList $ List8 $ V.fromList $ map (fromIntegral . fromEnum) "bob\0" - , Just $ PtrList $ List16 [] - ] - ] - ]) - actual - ] - where - readStruct :: U.Struct M.ConstMsg -> LimitT IO Struct - readStruct = decerialize diff --git a/tests/simple-tests/Tests/SchemaGeneration.hs b/tests/simple-tests/Tests/SchemaGeneration.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/SchemaGeneration.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Tests.SchemaGeneration - ( Schema (..), genSchema - ) where - -import Control.Monad.State.Strict - -import Control.Monad (replicateM) -import Data.List.NonEmpty (NonEmpty((:|))) - -import qualified Data.List.NonEmpty as NE -import qualified Test.QuickCheck as QC - --- Definitions - -newtype FieldName - = FieldName String - -instance Show FieldName where - show (FieldName fn) = fn - -newtype StructName - = StructName String - -instance Show StructName where - show (StructName fn) = fn - -data Field - = FieldDef FieldName Int FieldType - | StructDef StructName [Field] - -data BuiltIn - = Void - | Bool - | Int8 - | Int16 - | Int32 - | Int64 - | UInt8 - | UInt16 - | UInt32 - | UInt64 - | Float32 - | Float64 - | Text - | Data - deriving (Show, Enum) - -data FieldType - = BasicType BuiltIn - | ListType FieldType - | StructType StructName - -instance Show FieldType where - show (BasicType bi) = show bi - show (ListType ft) = "List(" ++ show ft ++ ")" - show (StructType sn) = show sn - -instance Show Field where - show (FieldDef name order entryType) = concat - [ show name, " @", show order, " :" - , show entryType, ";\n" - ] - show (StructDef name content) = concat - [ "struct ", show name, " {\n" - , concatMap (('\t':) . show) content - , "}\n\n" - ] - -data Schema = Schema - { schemaId :: String - , schemaContent :: [Field] - } - -instance Show Schema where - show s = concat - [ "@0x", schemaId s, ";\n\n" - , concatMap show (schemaContent s) - ] - --- Helper generators - -genSafeLCChar :: QC.Gen Char -genSafeLCChar = QC.elements ['a'..'z'] - -genSafeUCChar :: QC.Gen Char -genSafeUCChar = QC.elements ['A'..'Z'] - -genSafeHexChar :: QC.Gen Char -genSafeHexChar = QC.elements (['0'..'9'] ++ ['a'..'f']) - -newtype FieldGen a - = FieldGen (StateT (NonEmpty (Int, Int)) QC.Gen a) - deriving (Functor, Applicative, Monad) - -liftGen :: QC.Gen a -> FieldGen a -liftGen m = FieldGen (lift m) - -runFieldGen :: FieldGen a -> QC.Gen a -runFieldGen (FieldGen m) = fst <$> runStateT m ((0, 0) :| []) - -pushFieldGen :: FieldGen () -pushFieldGen = FieldGen $ modify (NE.cons (0, 0)) - -popFieldGen :: FieldGen () -popFieldGen = FieldGen $ do - original <- get - case original of - (x :| (y : rest)) -> put (y :| rest) - (x :| []) -> put (x :| []) - -getStructOrder :: FieldGen Int -getStructOrder = FieldGen $ do - current <- get - let (result, _) = NE.head current - case current of - ((x, y) :| rest) -> put ((x + 1, y) :| rest) - return result - -getOrder :: FieldGen Int -getOrder = FieldGen $ do - current <- get - let (_, result) = NE.head current - case current of - ((x, y) :| rest) -> put ((x + 1, y + 1) :| rest) - return result - --- Field types - --- need to enumerate each field; this will be performed during struct --- generation where the number of fields is known (numberDefs) -genFieldDef :: [FieldType] -> FieldGen Field -genFieldDef structTypes = do - order <- getOrder - fieldName <- do - str <- liftGen $ QC.listOf1 genSafeLCChar - return $ FieldName (str ++ show order) - fieldType <- liftGen $ QC.elements (map BasicType [Bool ..] ++ structTypes) - return $ FieldDef fieldName order fieldType - --- Struct type - --- like fields, we enumerate each struct during generation for uniqueness -genStructDef :: Int -> FieldGen Field -genStructDef depth = do - order <- getStructOrder - - pushFieldGen - - -- generate the struct's name - structName <- do - fc <- liftGen genSafeUCChar - rest <- liftGen (QC.listOf genSafeLCChar) - return $ StructName ((fc:rest) ++ show order) - - -- generate the nested structs - structNum <- if depth <= 0 - then pure 0 - else liftGen (QC.choose (0, 3)) - structDefs <- replicateM structNum (genStructDef (depth - 1)) - - -- extract the available struct types - let structTypes = map (\(StructDef sn _) -> (StructType sn)) structDefs - - -- generate the fields using available struct types - fieldNum <- liftGen (QC.sized (\n -> QC.choose (1, 1 `max` n))) - fieldDefs <- replicateM fieldNum (genFieldDef structTypes) - - popFieldGen - - return $ StructDef structName (fieldDefs ++ structDefs) - - --- Schema type -genSchema :: QC.Gen Schema -genSchema = do - id1st <- QC.elements ['a'..'f'] - idrest <- QC.vectorOf 15 genSafeHexChar - -- multiple structs make tests take too long - content <- runFieldGen (genStructDef 3) - return $ Schema (id1st:idrest) [content] diff --git a/tests/simple-tests/Tests/SchemaQuickCheck.hs b/tests/simple-tests/Tests/SchemaQuickCheck.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/SchemaQuickCheck.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Tests.SchemaQuickCheck - (schemaCGRQuickCheck) - where - -import qualified Data.ByteString as BS - -import Data.Capnp.Classes (fromStruct) -import Data.Capnp.Errors (Error) -import Data.Capnp.Message as M -import Data.Capnp.TraversalLimit (LimitT, runLimitT) - -import qualified Capnp.Capnp.Schema as Schema -import qualified Data.Capnp.Basics as Basics -import qualified Data.Capnp.Untyped as Untyped - --- Testing framework imports -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck - --- Schema generation imports -import Tests.SchemaGeneration -import Tests.Util - --- Schema validation imports -import Control.Monad.Catch as C - --- Functions to generate valid CGRs - -generateCGR :: Schema -> IO BS.ByteString -generateCGR schema = capnpCompile (show schema) "-" - --- Functions to validate CGRs - -decodeCGR :: BS.ByteString -> IO (Int, Int) -decodeCGR bytes = do - let reader :: Untyped.Struct M.ConstMsg -> LimitT IO Int - reader struct = do - req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct struct - nodes <- Schema.get_CodeGeneratorRequest'nodes req - requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req - return (Basics.length nodes) - msg <- M.decode bytes - (numNodes, endQuota) <- runLimitT 1024 (Untyped.rootPtr msg >>= reader) - return (endQuota, numNodes) - --- QuickCheck properties - -prop_schemaValid :: Schema -> Property -prop_schemaValid schema = ioProperty $ do - compiled <- generateCGR schema - decoded <- try $ decodeCGR compiled - return $ case (decoded :: Either Error (Int, Int)) of - Left _ -> False - Right _ -> True - -schemaCGRQuickCheck = testProperty "valid schema QuickCheck" - (prop_schemaValid <$> genSchema) diff --git a/tests/simple-tests/Tests/Util.hs b/tests/simple-tests/Tests/Util.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/Util.hs +++ /dev/null @@ -1,106 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -module Tests.Util - ( MsgMetaData(..) - , capnpEncode, capnpDecode, capnpCompile - , decodeValue - , encodeValue - , assertionsToTest - ) - where - -import System.Process hiding (readCreateProcessWithExitCode) - -import System.IO - -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Resource (ResourceT, allocate, runResourceT) -import System.Directory (removeFile) -import System.Exit (ExitCode(..)) -import System.Process.ByteString.Lazy (readCreateProcessWithExitCode) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (hUnitTestToTests) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Lazy.Char8 as LBSC8 -import qualified Test.HUnit as H - -import qualified Data.Capnp.Message as M - --- | Information about the contents of a capnp message. This is enough --- to encode/decode both textual and binary forms. -data MsgMetaData = MsgMetaData - { msgSchema :: String -- ^ The source of the schema - , msgType :: String -- ^ The name of the root struct's type - } deriving(Show) - --- | @capnpEncode msg meta@ runs @capnp encode@ on the message, providing --- the needed metadata and returning the output -capnpEncode :: String -> MsgMetaData -> IO BS.ByteString -capnpEncode msgValue meta = do - (exitStatus, stdOut, stdErr) <- runResourceT $ - interactCapnpWithSchema "encode" (msgSchema meta) (LBSC8.pack msgValue) [msgType meta] - case exitStatus of - ExitSuccess -> return (LBS.toStrict stdOut) - ExitFailure code -> fail ("`capnp encode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) - --- | @capnpDecode msg meta@ runs @capnp decode@ on the message, providing --- the needed metadata and returning the output -capnpDecode :: BS.ByteString -> MsgMetaData -> IO String -capnpDecode encodedMsg meta = do - (exitStatus, stdOut, stdErr) <- runResourceT $ - interactCapnpWithSchema "decode" (msgSchema meta) (LBS.fromStrict encodedMsg) [msgType meta] - case exitStatus of - ExitSuccess -> return (LBSC8.unpack stdOut) - ExitFailure code -> fail ("`capnp decode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) - --- | @capnpCompile msg meta@ runs @capnp compile@ on the schema, providing --- the needed metadata and returning the output -capnpCompile :: String -> String -> IO BS.ByteString -capnpCompile msgSchema outputArg = do - (exitStatus, stdOut, stdErr) <- runResourceT $ - interactCapnpWithSchema "compile" msgSchema LBSC8.empty ["-o", outputArg] - case exitStatus of - ExitSuccess -> return (LBS.toStrict stdOut) - ExitFailure code -> fail ("`capnp compile` failed with exit code " ++ show code ++ ":\n" ++ show stdErr) - --- | A helper for @capnpEncode@ and @capnpDecode@. Launches the capnp command --- with the given subcommand (either "encode" or "decode") and metadata, --- returning handles to its standard in and standard out. This runs inside --- ResourceT, and sets the handles up to be closed and the process to be reaped --- when the ResourceT exits. -interactCapnpWithSchema :: String -> String -> LBS.ByteString -> [String] -> ResourceT IO (ExitCode, LBS.ByteString, LBS.ByteString) -interactCapnpWithSchema subCommand msgSchema stdInBytes args = do - let writeTempFile = runResourceT $ do - (_, (path, hndl)) <- allocate - (openTempFile "/tmp" "schema.capnp") - (\(_, hndl) -> hClose hndl) - lift $ hPutStr hndl msgSchema - return path - let saveTmpSchema msgSchema = snd <$> allocate writeTempFile removeFile - schemaFile <- saveTmpSchema msgSchema - lift $ readCreateProcessWithExitCode (proc "capnp" ([subCommand, schemaFile] ++ args)) stdInBytes - --- | Convert a list of 'Assertion's to a test group with the given name. -assertionsToTest :: String -> [H.Assertion] -> Test -assertionsToTest name = - testGroup name . hUnitTestToTests . H.TestList . map H.TestCase - --- | @'decodeValue' schema typename message@ decodes the value at the root of --- the message and converts it to text. This is a thin wrapper around --- 'capnpDecode'. -decodeValue :: String -> String -> M.ConstMsg -> IO String -decodeValue schema typename msg = do - bytes <- M.encode msg - capnpDecode - (LBS.toStrict $ BB.toLazyByteString bytes) - (MsgMetaData schema typename) - --- | @'encodeValue' schema typename value@ encodes the textual value @value@ --- as a capnp message. This is a thin wrapper around 'capnpEncode'. -encodeValue :: String -> String -> String -> IO M.ConstMsg -encodeValue schema typename value = - let meta = MsgMetaData schema typename - in capnpEncode value meta >>= M.decode diff --git a/tests/simple-tests/Tests/WalkSchemaCodeGenRequest.hs b/tests/simple-tests/Tests/WalkSchemaCodeGenRequest.hs deleted file mode 100644 --- a/tests/simple-tests/Tests/WalkSchemaCodeGenRequest.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} --- | This module defines a test that tries to walk over the --- CodeGeneratorRequest in `tests/data/schema-codegenreq`, --- failing if any of the data is not as expected. -module Tests.WalkSchemaCodeGenRequest - (walkSchemaCodeGenRequestTest) - where - -import Prelude hiding (length) - -import Control.Monad (mapM_, when) -import Test.Framework (Test) -import Test.HUnit (Assertion, assertEqual) - -import qualified Data.ByteString as BS -import qualified Prelude - -import Data.Capnp.Untyped hiding (index, length) - -import Tests.Util - -import Data.Capnp.Basics (index, length, textBytes) -import Data.Capnp.Classes (fromStruct) -import Data.Capnp.TraversalLimit (LimitT, execLimitT) - -import qualified Capnp.Capnp.Schema as Schema -import qualified Data.Capnp.Message as M - - --- | TODO: make this an array; we're doing random access to it below. --- I(@zenhack) am waiting on this, since at the time of writing @taktoa --- is working on some array utilities that will get merged soonish, so --- it probably makes sense to just wait for that. -nodeNames :: [BS.ByteString] -nodeNames = - [ "Import" - , "annotation" - , "Value" - , "Type" - ] - --- TODO: This contains a bit of copypasta from some of the untyped tests; should --- factor that out. -theAssert :: Assertion -theAssert = do - bytes <- BS.readFile "tests/data/schema-codegenreq" - msg <- M.decode bytes - endQuota <- execLimitT 4096 (rootPtr msg >>= reader) - assertEqual "Correct remaining quota" 2036 endQuota - where - reader :: Struct M.ConstMsg -> LimitT IO () - reader root = do - req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct root - nodes <- Schema.get_CodeGeneratorRequest'nodes req - requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req - let 37 = length nodes - let 1 = length requestedFiles - mapM_ (walkNode nodes) [0,1..36] - walkNode nodes i = do - node <- index i nodes - -- None of the nodes in the schema have parameters: - False <- Schema.has_Node'parameters node - -- And none of them are generic: - False <- Schema.get_Node'isGeneric node - - nameList <- Schema.get_Node'displayName node - name <- textBytes nameList - prefixLen <- Schema.get_Node'displayNamePrefixLength node - let baseName = BS.drop (fromIntegral prefixLen) name - - when (i < Prelude.length nodeNames && baseName /= (nodeNames !! i)) $ - error "Incorrect name." - - has <- Schema.has_Node'annotations node - - -- there are two annotations in all of the nodes, at these indicies: - case (has, i `elem` [4, 9]) of - (False, False) -> return () - (True, True) -> do - 1 <- length <$> Schema.get_Node'annotations node - return () - (False, True) -> - error $ "Node at index " ++ show i ++ " should have had" ++ - "an annotation." - (True, False) -> - error $ "Node at index " ++ show i ++ " should not " ++ - "have had an annotation." - -walkSchemaCodeGenRequestTest :: Test -walkSchemaCodeGenRequestTest = - assertionsToTest "walk schema CodeGenerationRequest" [theAssert]