diff --git a/.gitattributes b/.gitattributes
new file mode 100644
--- /dev/null
+++ b/.gitattributes
@@ -0,0 +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
diff --git a/.gitignore b/.gitignore
new file mode 100644
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,8 @@
+/dist
+/dist-newstyle
+*.swp
+/.cabal-sandbox
+/cabal.sandbox.config
+cabal.project.local
+.ghc.*
+result*
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,28 @@
+before_script:
+ # Report the versions of varioius software, to make diagnosing problems
+ # easier:
+ - ghc --version
+ - cabal --version
+ - capnp --version
+ - stylish-haskell --version
+ - hlint --version
+ # Update the hackage databse:
+ - cabal update
+test:alltests:
+ image: zenhack/haskell-capnp-ci
+ script:
+ - cabal new-build
+ - cabal new-test
+ # Linting:
+ - ./scripts/hlint.sh
+ # Run stylish-haskell, and fail if it changes anything:
+ - ./scripts/format.sh
+ - git diff --exit-code
+ # Regenerate the schema, and make sure they're in-sync
+ # with what was committed:
+ - ./scripts/regen.sh
+ - git diff --exit-code
+ # Regenerate our other generated modules, and make sure
+ # they're in-sync.
+ - runhaskell scripts/gen-basic-instances.hs
+ - git diff --exit-code
diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
new file mode 100644
--- /dev/null
+++ b/.stylish-haskell.yaml
@@ -0,0 +1,29 @@
+steps:
+ - simple_align:
+ cases: true
+ top_level_patterns: true
+ records: true
+ - imports:
+ align: group
+ list_align: after_alias
+ pad_module_names: true
+ long_list_align: new_line_multiline
+ empty_list_align: right_after
+ list_padding: 4
+ separate_lists: false
+ space_surround: false
+ - language_pragmas:
+ style: vertical
+ align: true
+ remove_redundant: true
+ spaces: 4
+ - trailing_whitespace: {}
+columns: 80
+newline: lf
+language_extensions:
+ # stylish-haskell's parser (really haskell-src-exts) and GHC disagree about
+ # when some of the following are needed, so some of our modules will build
+ # without these extensions, but stylish-haskell needs them for parsing:
+ - ExplicitForAll
+ - FlexibleContexts
+ - MultiParamTypeClasses
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,4 @@
+
+# 0.1.0.0
+
+First release; basic read & write support, serialization only.
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
new file mode 100644
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,134 @@
+Firstly, thanks!
+
+# Style
+
+Generally, do what the rest of the code does. Much of this section is
+bikeshed, but consistency is worth a bit of that.
+
+## Formatting/Layout
+
+* [stylish-haskell][1] takes care of most formatting issues. If it wants
+ to change your code, let it; this solves a lot of consistency issues
+ without us needing to remember anything, and it gets run as part of
+ our CI, so failing to use it will likely cause failures. Running
+ `./format.sh will apply it to the entire source tree, using this
+ project's rules, but we recommend you configure your editor to use it
+ automatically.
+* Use a tabstop of 4 spaces in Haskell source code, 2 spaces in the
+ cabal file.
+* Don't align things unless stylish-haskell wants to. It will get basic
+ things like:
+
+```haskell
+data MyRecord = MyRecord
+ { short :: Int
+ , longerName :: Bool
+ }
+```
+
+Where it doesn't contradict you, use more regular indentation.
+
+Bad:
+
+```haskell
+data MyVariant = Apples Int
+ | Oranges Bool
+```
+
+Good:
+
+```haskell
+data MyVariant
+ = Apples Int
+ | Oranges Bool
+```
+
+Bad:
+
+```haskell
+myAction val = do print val
+ c <- getChar
+ putChar (toUpper c)
+```
+
+Good:
+
+```haskell
+myAction Val = do
+ print val
+ c <- getChar
+ putChar (toUpper c)
+```
+
+This goes for cabal files as well. Bad:
+
+```haskell
+ build-depends: base >= 4.8 && < 5.0
+ , text >= 1.2 && < 2.0
+ , bytestring >= 0.10 && < 0.11
+ , array >= 0.5 && < 0.6
+ ...
+```
+
+Good:
+
+```haskell
+ build-depends:
+ base >= 4.8 && < 5.0
+ , text >= 1.2 && < 2.0
+ , bytestring >= 0.10 && < 0.11
+ , array >= 0.5 && < 0.6
+ ...
+```
+
+The same rule applies for other constructs.
+
+## Imports
+
+Some guidelines re: imports:
+
+* Favor qualified imports or importing specific items. Unqualified
+ imports are acceptable in a few cases, where you're using a ton of
+ stuff from a single module, but try to avoid them, especially with
+ libraries whose API is not very very stable.
+* Wildcard imports of all of a type's data constructors/type class's
+ methods (`MonadThrow(..)`) are more acceptable, though still prefer
+ specifying specific ones if you're only using a couple.
+* Separate imports of modules within our own codebase from ones from
+ outside of it.
+* Within each of those groups, group imports into four distinct
+ sections, separated by a single blank line (some of these may be
+ absent):
+
+```haskell
+-- "negative" imports:
+import Prelude hiding (length)
+
+-- unqualified imports; try to avoid these, but sometimes if you've got
+-- a module that's doing nothing but bitwhacking, it can make sense:
+import Data.Bits
+import Data.Word
+
+-- imports of specific values
+import Control.Monad(when, void)
+import Control.Monad.Catch(throwM)
+
+-- qualified module imports:
+import qualified Data.ByteString as BS
+
+-- same structure for modules within our library:
+
+import Data.Capnp.Untyped hiding (length)
+
+import Data.Capnp.Bits
+
+import Data.Capnp.TraversalLimit(defaultLimit, evalLimitT)
+
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Basics as B
+```
+
+The formatter will take care of formatting the sections correctly, as
+long as you keep the line-breaks right.
+
+[1]: https://github.com/jaspervdj/stylish-haskell
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,20 @@
+Copyright (c) 2016 Ian Denhardt
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,34 @@
+[![build status][ci-img]][ci]
+
+A Haskell library for the [Cap'N Proto][1] Cerialization protocol.
+
+Serialization (read & write) support is mostly finished, and already
+usable, with some limitations:
+
+* Generated schema currently ignore type parameters ([#29][issue29]).
+* Schema which define custom default values for fields of pointer type
+ are rejected ([#28][issue28]).
+* We currently do not correctly handle decoding lists of structs from
+ non-composite lists ([#27][issue27]). This means that, contrary to the
+ [protocol evolution rules][2], it is not safe to change a field from
+ type List(T) (where T is any non-struct type) to a list of a struct
+ type.
+
+There is a module `Data.Capnp.Tutorial` which contains an introduction
+to the library; users are *strongly* encouraged to read this first, as
+the reference documentation can be bewildering without that context.
+
+The API is considered unstable. It will likely see changes, for the
+sake of polish, consistency, etc. as well as to improve performance and
+accommodate more features as we add them (RPC in particular will
+probably require changing some interfaces).
+
+[1]: https://capnproto.org/
+[2]: https://capnproto.org/language.html#evolving-your-protocol
+
+[issue27]: https://github.com/zenhack/haskell-capnp/issues/27
+[issue28]: https://github.com/zenhack/haskell-capnp/issues/28
+[issue29]: https://github.com/zenhack/haskell-capnp/issues/29
+
+[ci-img]: https://gitlab.com/isd/haskell-capnp/badges/master/build.svg
+[ci]: https://gitlab.com/isd/haskell-capnp/pipelines
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/capnp.cabal b/capnp.cabal
new file mode 100644
--- /dev/null
+++ b/capnp.cabal
@@ -0,0 +1,200 @@
+cabal-version: 2.2
+name: capnp
+version: 0.1.0.0
+stability: Experimental
+category: Data, Serialization
+copyright: 2016-2018 haskell-capnp contributors (see CONTRIBUTORS file).
+author: Ian Denhardt
+maintainer: ian@zenhack.net
+license: MIT
+license-file: LICENSE.md
+homepage: https://github.com/zenhack/haskell-capnp
+bug-reports: https://github.com/zenhack/haskell-capnp/issues
+synopsis: Cap'n Proto for Haskell
+description:
+ A native Haskell implementation of the Cap'N Proto cerialization format.
+ .
+ This library is currently serialization-only. RPC support is planned but not
+ yet implemented. It works, but bear in mind that the API is considered
+ unstable, and is likely to change to accomodate RPC, facilitate improved
+ performance, etc.
+ .
+ The 'Data.Capnp.Tutorial' module is the best place to start reading; the
+ reference documentation can seem bewildering without that context.
+build-type: Simple
+extra-source-files:
+ README.md
+ , CHANGELOG.md
+ , CONTRIBUTING.md
+ , ci/README.md
+ , ci/Dockerfile
+ , core-schema/README.md
+ , core-schema/capnp/c++.capnp
+ , core-schema/capnp/json.capnp
+ , core-schema/capnp/persistent.capnp
+ , core-schema/capnp/rpc.capnp
+ , core-schema/capnp/rpc-twoparty.capnp
+ , core-schema/capnp/schema.capnp
+ , scripts/format.sh
+ , scripts/gen-basic-instances.hs
+ , scripts/hlint.sh
+ , scripts/README.md
+ , scripts/regen.sh
+ , .stylish-haskell.yaml
+ , .gitattributes
+ , .gitignore
+ , .gitlab-ci.yml
+ -- FIXME: add a CHANGELOG.md and add it to this list
+tested-with:
+ -- Our Gitlab CI uses this version:
+ GHC == 8.2.1
+ -- @zenhack currently uses this version:
+ , GHC == 8.4.3
+
+--------------------------------------------------------------------------------
+
+source-repository head
+ type: git
+ branch: master
+ location: https://github.com/zenhack/haskell-capnp.git
+
+--------------------------------------------------------------------------------
+
+common shared-opts
+ build-depends:
+ base >= 4.8 && < 5.0
+ , array >= 0.5 && < 0.6
+ , bytes >= 0.15.4 && < 0.16
+ , bytestring >= 0.10 && < 0.11
+ , exceptions >= 0.10.0 && < 0.11
+ , mtl >= 2.2.2 && < 2.3
+ , primitive >= 0.6.3 && < 0.7
+ , reinterpret-cast >= 0.1.0 && < 0.2
+ , text >= 1.2 && < 2.0
+ , transformers >= 0.5.2 && < 0.6
+ , vector >= 0.12.0 && < 0.13
+ ghc-options:
+ -Wnoncanonical-monad-instances
+ -Wincomplete-patterns
+ -Wunused-imports
+ default-language: Haskell2010
+
+--------------------------------------------------------------------------------
+
+library
+ import: shared-opts
+ 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.Errors
+ , Data.Capnp.GenHelpers
+ , Data.Capnp.GenHelpers.Pure
+ , Data.Capnp.IO
+ , Data.Capnp.Message
+ , Data.Capnp.Pointer
+ , Data.Capnp.Untyped
+ , Data.Capnp.Untyped.Pure
+ , Data.Capnp.TraversalLimit
+ , Data.Capnp.Tutorial
+ -- BEGIN GENERATED SCHEMA MODULES
+ , Capnp.Capnp.Cxx.Pure
+ , Capnp.Capnp.Json.Pure
+ , Capnp.Capnp.Persistent.Pure
+ , Capnp.Capnp.Rpc.Pure
+ , Capnp.Capnp.RpcTwoparty.Pure
+ , Capnp.Capnp.Schema.Pure
+ , Capnp.Capnp.Cxx
+ , Capnp.Capnp.Json
+ , Capnp.Capnp.Persistent
+ , Capnp.Capnp.Rpc
+ , Capnp.Capnp.RpcTwoparty
+ , Capnp.Capnp.Schema
+ , Capnp.ById.Xbdf87d7bb8304e81.Pure
+ , Capnp.ById.X8ef99297a43a5e34.Pure
+ , Capnp.ById.Xb8630836983feed7.Pure
+ , Capnp.ById.Xb312981b2552a250.Pure
+ , Capnp.ById.Xa184c7885cdaf2a1.Pure
+ , Capnp.ById.Xa93fc509624c72d9.Pure
+ , Capnp.ById.Xbdf87d7bb8304e81
+ , Capnp.ById.X8ef99297a43a5e34
+ , Capnp.ById.Xb8630836983feed7
+ , Capnp.ById.Xb312981b2552a250
+ , Capnp.ById.Xa184c7885cdaf2a1
+ , Capnp.ById.Xa93fc509624c72d9
+ -- END GENERATED SCHEMA MODULES
+ other-modules:
+ Internal.Util
+ , Internal.Gen.Instances
+ , Codec.Capnp
+ -- other-extensions:
+ build-depends:
+ cpu >= 0.1.2 && < 0.2
+ , data-default >= 0.7.1 && < 0.8
+ , data-default-instances-vector >= 0.0.1 && < 0.1
+
+--------------------------------------------------------------------------------
+
+executable capnpc-haskell
+ import: shared-opts
+ main-is: Main.hs
+ other-modules:
+ FrontEnd
+ , IR
+ , Backends.Common
+ , Backends.Pure
+ , Backends.Raw
+ , Util
+ hs-source-dirs: exe/capnpc-haskell
+ build-depends:
+ capnp
+ , binary >= 0.8.5 && < 0.9
+ , cereal >= 0.5.5 && < 0.6
+ , containers >= 0.5.10 && < 0.6
+ , directory >= 1.3.0 && < 1.4
+ , dlist >= 0.8.0 && < 0.9
+ , filepath >= 1.4.1 && < 1.5
+ , utf8-string >= 1.0.1 && < 1.1
+ , wl-pprint-text >= 1.2 && <1.3
+
+--------------------------------------------------------------------------------
+
+test-suite simple-tests
+ import: shared-opts
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ hs-source-dirs: tests/simple-tests
+ other-modules:
+ Tests.Module.Capnp.Capnp.Schema
+ , Tests.Module.Capnp.Capnp.Schema.Pure
+ , Tests.Module.Data.Capnp.Untyped
+ , Tests.Module.Data.Capnp.Untyped.Pure
+ , Tests.Module.Data.Capnp.Pointer
+ , Tests.Module.Data.Capnp.Bits
+ , Tests.WalkSchemaCodeGenRequest
+ , Tests.SchemaGeneration
+ , Tests.SchemaQuickCheck
+ , Tests.Util
+ build-depends:
+ capnp
+ , data-default
+ , process
+ , process-extras
+ , QuickCheck
+ , quickcheck-io
+ , quickcheck-instances
+ , HUnit
+ , test-framework
+ , test-framework-hunit
+ , test-framework-quickcheck2
+ , binary
+ , directory
+ , resourcet
+ , heredoc
+ , deepseq
+ , pretty-show
diff --git a/ci/Dockerfile b/ci/Dockerfile
new file mode 100644
--- /dev/null
+++ b/ci/Dockerfile
@@ -0,0 +1,18 @@
+FROM haskell
+WORKDIR /usr/src/
+
+# Install various system packages needed for building capnproto.
+RUN apt-get update
+RUN apt-get install -y wget file make
+
+# Build and install a recent version of capnproto. jessie-backports has 0.5.3,
+# which is missing some features used in our test suite.
+RUN wget "https://capnproto.org/capnproto-c++-0.6.1.tar.gz"
+RUN tar -xvf *.tar.gz
+RUN cd capnproto-*/ && ./configure --prefix=/usr/local && make && make install
+
+# Install the linters up front; this saves a lot of build time during the actual
+# CI run.
+RUN cabal update
+RUN cabal install happy alex
+RUN cabal install hlint stylish-haskell
diff --git a/ci/README.md b/ci/README.md
new file mode 100644
--- /dev/null
+++ b/ci/README.md
@@ -0,0 +1,8 @@
+This directory contains the Dockerfile used to build:
+
+
+
+...which is used by ../.gitlab-ci.yml.
+
+It's just the standard haskell docker image, plus capnproto 0.6.1 and
+some linters already installed.
diff --git a/core-schema/README.md b/core-schema/README.md
new file mode 100644
--- /dev/null
+++ b/core-schema/README.md
@@ -0,0 +1,3 @@
+This directory contains the unmodified schema shipped with the capnproto
+(C++) reference implementation. They are used to generate the modules
+under `../lib/Capnp/`.
diff --git a/core-schema/capnp/c++.capnp b/core-schema/capnp/c++.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/c++.capnp
@@ -0,0 +1,26 @@
+# Copyright (c) 2013-2014 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+@0xbdf87d7bb8304e81;
+$namespace("capnp::annotations");
+
+annotation namespace(file): Text;
+annotation name(field, enumerant, struct, enum, interface, method, param, group, union): Text;
diff --git a/core-schema/capnp/json.capnp b/core-schema/capnp/json.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/json.capnp
@@ -0,0 +1,58 @@
+# Copyright (c) 2015 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+@0x8ef99297a43a5e34;
+
+$import "/capnp/c++.capnp".namespace("capnp");
+
+struct JsonValue {
+ union {
+ null @0 :Void;
+ boolean @1 :Bool;
+ number @2 :Float64;
+ string @3 :Text;
+ array @4 :List(JsonValue);
+ object @5 :List(Field);
+ # Standard JSON values.
+
+ call @6 :Call;
+ # Non-standard: A "function call", applying a named function (named by a single identifier)
+ # to a parameter list. Examples:
+ #
+ # BinData(0, "Zm9vCg==")
+ # ISODate("2015-04-15T08:44:50.218Z")
+ #
+ # Mongo DB users will recognize the above as exactly the syntax Mongo uses to represent BSON
+ # "binary" and "date" types in text, since JSON has no analog of these. This is basically the
+ # reason this extension exists. We do NOT recommend using `call` unless you specifically need
+ # to be compatible with some silly format that uses this syntax.
+ }
+
+ struct Field {
+ name @0 :Text;
+ value @1 :JsonValue;
+ }
+
+ struct Call {
+ function @0 :Text;
+ params @1 :List(JsonValue);
+ }
+}
diff --git a/core-schema/capnp/persistent.capnp b/core-schema/capnp/persistent.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/persistent.capnp
@@ -0,0 +1,139 @@
+# Copyright (c) 2014 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+@0xb8630836983feed7;
+
+$import "/capnp/c++.capnp".namespace("capnp");
+
+interface Persistent@0xc8cb212fcd9f5691(SturdyRef, Owner) {
+ # Interface implemented by capabilities that outlive a single connection. A client may save()
+ # the capability, producing a SturdyRef. The SturdyRef can be stored to disk, then later used to
+ # obtain a new reference to the capability on a future connection.
+ #
+ # The exact format of SturdyRef depends on the "realm" in which the SturdyRef appears. A "realm"
+ # is an abstract space in which all SturdyRefs have the same format and refer to the same set of
+ # resources. Every vat is in exactly one realm. All capability clients within that vat must
+ # produce SturdyRefs of the format appropriate for the realm.
+ #
+ # Similarly, every VatNetwork also resides in a particular realm. Usually, a vat's "realm"
+ # corresponds to the realm of its main VatNetwork. However, a Vat can in fact communicate over
+ # a VatNetwork in a different realm -- in this case, all SturdyRefs need to be transformed when
+ # coming or going through said VatNetwork. The RPC system has hooks for registering
+ # transformation callbacks for this purpose.
+ #
+ # Since the format of SturdyRef is realm-dependent, it is not defined here. An application should
+ # choose an appropriate realm for itself as part of its design. Note that under Sandstorm, every
+ # application exists in its own realm and is therefore free to define its own SturdyRef format;
+ # the Sandstorm platform handles translating between realms.
+ #
+ # Note that whether a capability is persistent is often orthogonal to its type. In these cases,
+ # the capability's interface should NOT inherit `Persistent`; instead, just perform a cast at
+ # runtime. It's not type-safe, but trying to be type-safe in these cases will likely lead to
+ # tears. In cases where a particular interface only makes sense on persistent capabilities, it
+ # still should not explicitly inherit Persistent because the `SturdyRef` and `Owner` types will
+ # vary between realms (they may even be different at the call site than they are on the
+ # implementation). Instead, mark persistent interfaces with the $persistent annotation (defined
+ # below).
+ #
+ # Sealing
+ # -------
+ #
+ # As an added security measure, SturdyRefs may be "sealed" to a particular owner, such that
+ # if the SturdyRef itself leaks to a third party, that party cannot actually restore it because
+ # they are not the owner. To restore a sealed capability, you must first prove to its host that
+ # you are the rightful owner. The precise mechanism for this authentication is defined by the
+ # realm.
+ #
+ # Sealing is a defense-in-depth mechanism meant to mitigate damage in the case of catastrophic
+ # attacks. For example, say an attacker temporarily gains read access to a database full of
+ # SturdyRefs: it would be unfortunate if it were then necessary to revoke every single reference
+ # in the database to prevent the attacker from using them.
+ #
+ # In general, an "owner" is a course-grained identity. Because capability-based security is still
+ # the primary mechanism of security, it is not necessary nor desirable to have a separate "owner"
+ # identity for every single process or object; that is exactly what capabilities are supposed to
+ # avoid! Instead, it makes sense for an "owner" to literally identify the owner of the machines
+ # where the capability is stored. If untrusted third parties are able to run arbitrary code on
+ # said machines, then the sandbox for that code should be designed using Distributed Confinement
+ # such that the third-party code never sees the bits of the SturdyRefs and cannot directly
+ # exercise the owner's power to restore refs. See:
+ #
+ # http://www.erights.org/elib/capability/dist-confine.html
+ #
+ # Resist the urge to represent an Owner as a simple public key. The whole point of sealing is to
+ # defend against leaked-storage attacks. Such attacks can easily result in the owner's private
+ # key being stolen as well. A better solution is for `Owner` to contain a simple globally unique
+ # identifier for the owner, and for everyone to separately maintain a mapping of owner IDs to
+ # public keys. If an owner's private key is compromised, then humans will need to communicate
+ # and agree on a replacement public key, then update the mapping.
+ #
+ # As a concrete example, an `Owner` could simply contain a domain name, and restoring a SturdyRef
+ # would require signing a request using the domain's private key. Authenticating this key could
+ # be accomplished through certificate authorities or web-of-trust techniques.
+
+ save @0 SaveParams -> SaveResults;
+ # Save a capability persistently so that it can be restored by a future connection. Not all
+ # capabilities can be saved -- application interfaces should define which capabilities support
+ # this and which do not.
+
+ struct SaveParams {
+ sealFor @0 :Owner;
+ # Seal the SturdyRef so that it can only be restored by the specified Owner. This is meant
+ # to mitigate damage when a SturdyRef is leaked. See comments above.
+ #
+ # Leaving this value null may or may not be allowed; it is up to the realm to decide. If a
+ # realm does allow a null owner, this should indicate that anyone is allowed to restore the
+ # ref.
+ }
+ struct SaveResults {
+ sturdyRef @0 :SturdyRef;
+ }
+}
+
+interface RealmGateway(InternalRef, ExternalRef, InternalOwner, ExternalOwner) {
+ # Interface invoked when a SturdyRef is about to cross realms. The RPC system supports providing
+ # a RealmGateway as a callback hook when setting up RPC over some VatNetwork.
+
+ import @0 (cap :Persistent(ExternalRef, ExternalOwner),
+ params :Persistent(InternalRef, InternalOwner).SaveParams)
+ -> Persistent(InternalRef, InternalOwner).SaveResults;
+ # Given an external capability, save it and return an internal reference. Used when someone
+ # inside the realm tries to save a capability from outside the realm.
+
+ export @1 (cap :Persistent(InternalRef, InternalOwner),
+ params :Persistent(ExternalRef, ExternalOwner).SaveParams)
+ -> Persistent(ExternalRef, ExternalOwner).SaveResults;
+ # Given an internal capability, save it and return an external reference. Used when someone
+ # outside the realm tries to save a capability from inside the realm.
+}
+
+annotation persistent(interface, field) :Void;
+# Apply this annotation to interfaces for objects that will always be persistent, instead of
+# extending the Persistent capability, since the correct type parameters to Persistent depend on
+# the realm, which is orthogonal to the interface type and therefore should not be defined
+# along-side it.
+#
+# You may also apply this annotation to a capability-typed field which will always contain a
+# persistent capability, but where the capability's interface itself is not already marked
+# persistent.
+#
+# Note that absence of the $persistent annotation doesn't mean a capability of that type isn't
+# persistent; it just means not *all* such capabilities are persistent.
diff --git a/core-schema/capnp/rpc-twoparty.capnp b/core-schema/capnp/rpc-twoparty.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/rpc-twoparty.capnp
@@ -0,0 +1,169 @@
+# Copyright (c) 2013-2014 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+@0xa184c7885cdaf2a1;
+# This file defines the "network-specific parameters" in rpc.capnp to support a network consisting
+# of two vats. Each of these vats may in fact be in communication with other vats, but any
+# capabilities they forward must be proxied. Thus, to each end of the connection, all capabilities
+# received from the other end appear to live in a single vat.
+#
+# Two notable use cases for this model include:
+# - Regular client-server communications, where a remote client machine (perhaps living on an end
+# user's personal device) connects to a server. The server may be part of a cluster, and may
+# call on other servers in the cluster to help service the user's request. It may even obtain
+# capabilities from these other servers which it passes on to the user. To simplify network
+# common traversal problems (e.g. if the user is behind a firewall), it is probably desirable to
+# multiplex all communications between the server cluster and the client over the original
+# connection rather than form new ones. This connection should use the two-party protocol, as
+# the client has no interest in knowing about additional servers.
+# - Applications running in a sandbox. A supervisor process may execute a confined application
+# such that all of the confined app's communications with the outside world must pass through
+# the supervisor. In this case, the connection between the confined app and the supervisor might
+# as well use the two-party protocol, because the confined app is intentionally prevented from
+# talking to any other vat anyway. Any external resources will be proxied through the supervisor,
+# and so to the contained app will appear as if they were hosted by the supervisor itself.
+#
+# Since there are only two vats in this network, there is never a need for three-way introductions,
+# so level 3 is free. Moreover, because it is never necessary to form new connections, the
+# two-party protocol can be used easily anywhere where a two-way byte stream exists, without regard
+# to where that byte stream goes or how it was initiated. This makes the two-party runtime library
+# highly reusable.
+#
+# Joins (level 4) _could_ be needed in cases where one or both vats are participating in other
+# networks that use joins. For instance, if Alice and Bob are speaking through the two-party
+# protocol, and Bob is also participating on another network, Bob may send Alice two or more
+# proxied capabilities which, unbeknownst to Bob at the time, are in fact pointing at the same
+# remote object. Alice may then request to join these capabilities, at which point Bob will have
+# to forward the join to the other network. Note, however, that if Alice is _not_ participating on
+# any other network, then Alice will never need to _receive_ a Join, because Alice would always
+# know when two locally-hosted capabilities are the same and would never export a redundant alias
+# to Bob. So, Alice can respond to all incoming joins with an error, and only needs to implement
+# outgoing joins if she herself desires to use this feature. Also, outgoing joins are relatively
+# easy to implement in this scenario.
+#
+# What all this means is that a level 4 implementation of the confined network is barely more
+# complicated than a level 2 implementation. However, such an implementation allows the "client"
+# or "confined" app to access the server's/supervisor's network with equal functionality to any
+# native participant. In other words, an application which implements only the two-party protocol
+# can be paired with a proxy app in order to participate in any network.
+#
+# So, when implementing Cap'n Proto in a new language, it makes sense to implement only the
+# two-party protocol initially, and then pair applications with an appropriate proxy written in
+# C++, rather than implement other parameterizations of the RPC protocol directly.
+
+using Cxx = import "/capnp/c++.capnp";
+$Cxx.namespace("capnp::rpc::twoparty");
+
+# Note: SturdyRef is not specified here. It is up to the application to define semantics of
+# SturdyRefs if desired.
+
+enum Side {
+ server @0;
+ # The object lives on the "server" or "supervisor" end of the connection. Only the
+ # server/supervisor knows how to interpret the ref; to the client, it is opaque.
+ #
+ # Note that containers intending to implement strong confinement should rewrite SturdyRefs
+ # received from the external network before passing them on to the confined app. The confined
+ # app thus does not ever receive the raw bits of the SturdyRef (which it could perhaps
+ # maliciously leak), but instead receives only a thing that it can pass back to the container
+ # later to restore the ref. See:
+ # http://www.erights.org/elib/capability/dist-confine.html
+
+ client @1;
+ # The object lives on the "client" or "confined app" end of the connection. Only the client
+ # knows how to interpret the ref; to the server/supervisor, it is opaque. Most clients do not
+ # actually know how to persist capabilities at all, so use of this is unusual.
+}
+
+struct VatId {
+ side @0 :Side;
+}
+
+struct ProvisionId {
+ # Only used for joins, since three-way introductions never happen on a two-party network.
+
+ joinId @0 :UInt32;
+ # The ID from `JoinKeyPart`.
+}
+
+struct RecipientId {}
+# Never used, because there are only two parties.
+
+struct ThirdPartyCapId {}
+# Never used, because there is no third party.
+
+struct JoinKeyPart {
+ # Joins in the two-party case are simplified by a few observations.
+ #
+ # First, on a two-party network, a Join only ever makes sense if the receiving end is also
+ # connected to other networks. A vat which is not connected to any other network can safely
+ # reject all joins.
+ #
+ # Second, since a two-party connection bisects the network -- there can be no other connections
+ # between the networks at either end of the connection -- if one part of a join crosses the
+ # connection, then _all_ parts must cross it. Therefore, a vat which is receiving a Join request
+ # off some other network which needs to be forwarded across the two-party connection can
+ # collect all the parts on its end and only forward them across the two-party connection when all
+ # have been received.
+ #
+ # For example, imagine that Alice and Bob are vats connected over a two-party connection, and
+ # each is also connected to other networks. At some point, Alice receives one part of a Join
+ # request off her network. The request is addressed to a capability that Alice received from
+ # Bob and is proxying to her other network. Alice goes ahead and responds to the Join part as
+ # if she hosted the capability locally (this is important so that if not all the Join parts end
+ # up at Alice, the original sender can detect the failed Join without hanging). As other parts
+ # trickle in, Alice verifies that each part is addressed to a capability from Bob and continues
+ # to respond to each one. Once the complete set of join parts is received, Alice checks if they
+ # were all for the exact same capability. If so, she doesn't need to send anything to Bob at
+ # all. Otherwise, she collects the set of capabilities (from Bob) to which the join parts were
+ # addressed and essentially initiates a _new_ Join request on those capabilities to Bob. Alice
+ # does not forward the Join parts she received herself, but essentially forwards the Join as a
+ # whole.
+ #
+ # On Bob's end, since he knows that Alice will always send all parts of a Join together, he
+ # simply waits until he's received them all, then performs a join on the respective capabilities
+ # as if it had been requested locally.
+
+ joinId @0 :UInt32;
+ # A number identifying this join, chosen by the sender. May be reused once `Finish` messages are
+ # sent corresponding to all of the `Join` messages.
+
+ partCount @1 :UInt16;
+ # The number of capabilities to be joined.
+
+ partNum @2 :UInt16;
+ # Which part this request targets -- a number in the range [0, partCount).
+}
+
+struct JoinResult {
+ joinId @0 :UInt32;
+ # Matches `JoinKeyPart`.
+
+ succeeded @1 :Bool;
+ # All JoinResults in the set will have the same value for `succeeded`. The receiver actually
+ # implements the join by waiting for all the `JoinKeyParts` and then performing its own join on
+ # them, then going back and answering all the join requests afterwards.
+
+ cap @2 :AnyPointer;
+ # One of the JoinResults will have a non-null `cap` which is the joined capability.
+ #
+ # TODO(cleanup): Change `AnyPointer` to `Capability` when that is supported.
+}
diff --git a/core-schema/capnp/rpc.capnp b/core-schema/capnp/rpc.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/rpc.capnp
@@ -0,0 +1,1399 @@
+# Copyright (c) 2013-2014 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+@0xb312981b2552a250;
+# Recall that Cap'n Proto RPC allows messages to contain references to remote objects that
+# implement interfaces. These references are called "capabilities", because they both designate
+# the remote object to use and confer permission to use it.
+#
+# Recall also that Cap'n Proto RPC has the feature that when a method call itself returns a
+# capability, the caller can begin calling methods on that capability _before the first call has
+# returned_. The caller essentially sends a message saying "Hey server, as soon as you finish
+# that previous call, do this with the result!". Cap'n Proto's RPC protocol makes this possible.
+#
+# The protocol is significantly more complicated than most RPC protocols. However, this is
+# implementation complexity that underlies an easy-to-grasp higher-level model of object oriented
+# programming. That is, just like TCP is a surprisingly complicated protocol that implements a
+# conceptually-simple byte stream abstraction, Cap'n Proto is a surprisingly complicated protocol
+# that implements a conceptually-simple object abstraction.
+#
+# Cap'n Proto RPC is based heavily on CapTP, the object-capability protocol used by the E
+# programming language:
+# http://www.erights.org/elib/distrib/captp/index.html
+#
+# Cap'n Proto RPC takes place between "vats". A vat hosts some set of objects and talks to other
+# vats through direct bilateral connections. Typically, there is a 1:1 correspondence between vats
+# and processes (in the unix sense of the word), although this is not strictly always true (one
+# process could run multiple vats, or a distributed virtual vat might live across many processes).
+#
+# Cap'n Proto does not distinguish between "clients" and "servers" -- this is up to the application.
+# Either end of any connection can potentially hold capabilities pointing to the other end, and
+# can call methods on those capabilities. In the doc comments below, we use the words "sender"
+# and "receiver". These refer to the sender and receiver of an instance of the struct or field
+# being documented. Sometimes we refer to a "third-party" that is neither the sender nor the
+# receiver. Documentation is generally written from the point of view of the sender.
+#
+# It is generally up to the vat network implementation to securely verify that connections are made
+# to the intended vat as well as to encrypt transmitted data for privacy and integrity. See the
+# `VatNetwork` example interface near the end of this file.
+#
+# When a new connection is formed, the only interesting things that can be done are to send a
+# `Bootstrap` (level 0) or `Accept` (level 3) message.
+#
+# Unless otherwise specified, messages must be delivered to the receiving application in the same
+# order in which they were initiated by the sending application. The goal is to support "E-Order",
+# which states that two calls made on the same reference must be delivered in the order which they
+# were made:
+# http://erights.org/elib/concurrency/partial-order.html
+#
+# Since the full protocol is complicated, we define multiple levels of support that an
+# implementation may target. For many applications, level 1 support will be sufficient.
+# Comments in this file indicate which level requires the corresponding feature to be
+# implemented.
+#
+# * **Level 0:** The implementation does not support object references. Only the bootstrap interface
+# can be called. At this level, the implementation does not support object-oriented protocols and
+# is similar in complexity to JSON-RPC or Protobuf services. This level should be considered only
+# a temporary stepping-stone toward level 1 as the lack of object references drastically changes
+# how protocols are designed. Applications _should not_ attempt to design their protocols around
+# the limitations of level 0 implementations.
+#
+# * **Level 1:** The implementation supports simple bilateral interaction with object references
+# and promise pipelining, but interactions between three or more parties are supported only via
+# proxying of objects. E.g. if Alice (in Vat A) wants to send Bob (in Vat B) a capability
+# pointing to Carol (in Vat C), Alice must create a proxy of Carol within Vat A and send Bob a
+# reference to that; Bob cannot form a direct connection to Carol. Level 1 implementations do
+# not support checking if two capabilities received from different vats actually point to the
+# same object ("join"), although they should be able to do this check on capabilities received
+# from the same vat.
+#
+# * **Level 2:** The implementation supports saving persistent capabilities -- i.e. capabilities
+# that remain valid even after disconnect, and can be restored on a future connection. When a
+# capability is saved, the requester receives a `SturdyRef`, which is a token that can be used
+# to restore the capability later.
+#
+# * **Level 3:** The implementation supports three-way interactions. That is, if Alice (in Vat A)
+# sends Bob (in Vat B) a capability pointing to Carol (in Vat C), then Vat B will automatically
+# form a direct connection to Vat C rather than have requests be proxied through Vat A.
+#
+# * **Level 4:** The entire protocol is implemented, including joins (checking if two capabilities
+# are equivalent).
+#
+# Note that an implementation must also support specific networks (transports), as described in
+# the "Network-specific Parameters" section below. An implementation might have different levels
+# depending on the network used.
+#
+# New implementations of Cap'n Proto should start out targeting the simplistic two-party network
+# type as defined in `rpc-twoparty.capnp`. With this network type, level 3 is irrelevant and
+# levels 2 and 4 are much easier than usual to implement. When such an implementation is paired
+# with a container proxy, the contained app effectively gets to make full use of the proxy's
+# network at level 4. And since Cap'n Proto IPC is extremely fast, it may never make sense to
+# bother implementing any other vat network protocol -- just use the correct container type and get
+# it for free.
+
+using Cxx = import "/capnp/c++.capnp";
+$Cxx.namespace("capnp::rpc");
+
+# ========================================================================================
+# The Four Tables
+#
+# Cap'n Proto RPC connections are stateful (although an application built on Cap'n Proto could
+# export a stateless interface). As in CapTP, for each open connection, a vat maintains four state
+# tables: questions, answers, imports, and exports. See the diagram at:
+# http://www.erights.org/elib/distrib/captp/4tables.html
+#
+# The question table corresponds to the other end's answer table, and the imports table corresponds
+# to the other end's exports table.
+#
+# The entries in each table are identified by ID numbers (defined below as 32-bit integers). These
+# numbers are always specific to the connection; a newly-established connection starts with no
+# valid IDs. Since low-numbered IDs will pack better, it is suggested that IDs be assigned like
+# Unix file descriptors -- prefer the lowest-number ID that is currently available.
+#
+# IDs in the questions/answers tables are chosen by the questioner and generally represent method
+# calls that are in progress.
+#
+# IDs in the imports/exports tables are chosen by the exporter and generally represent objects on
+# which methods may be called. Exports may be "settled", meaning the exported object is an actual
+# object living in the exporter's vat, or they may be "promises", meaning the exported object is
+# the as-yet-unknown result of an ongoing operation and will eventually be resolved to some other
+# object once that operation completes. Calls made to a promise will be forwarded to the eventual
+# target once it is known. The eventual replacement object does *not* get the same ID as the
+# promise, as it may turn out to be an object that is already exported (so already has an ID) or
+# may even live in a completely different vat (and so won't get an ID on the same export table
+# at all).
+#
+# IDs can be reused over time. To make this safe, we carefully define the lifetime of IDs. Since
+# messages using the ID could be traveling in both directions simultaneously, we must define the
+# end of life of each ID _in each direction_. The ID is only safe to reuse once it has been
+# released by both sides.
+#
+# When a Cap'n Proto connection is lost, everything on the four tables is lost. All questions are
+# canceled and throw exceptions. All imports become broken (all future calls to them throw
+# exceptions). All exports and answers are implicitly released. The only things not lost are
+# persistent capabilities (`SturdyRef`s). The application must plan for this and should respond by
+# establishing a new connection and restoring from these persistent capabilities.
+
+using QuestionId = UInt32;
+# **(level 0)**
+#
+# Identifies a question in the sender's question table (which corresponds to the receiver's answer
+# table). The questioner (caller) chooses an ID when making a call. The ID remains valid in
+# caller -> callee messages until a Finish message is sent, and remains valid in callee -> caller
+# messages until a Return message is sent.
+
+using AnswerId = QuestionId;
+# **(level 0)**
+#
+# Identifies an answer in the sender's answer table (which corresponds to the receiver's question
+# table).
+#
+# AnswerId is physically equivalent to QuestionId, since the question and answer tables correspond,
+# but we define a separate type for documentation purposes: we always use the type representing
+# the sender's point of view.
+
+using ExportId = UInt32;
+# **(level 1)**
+#
+# Identifies an exported capability or promise in the sender's export table (which corresponds
+# to the receiver's import table). The exporter chooses an ID before sending a capability over the
+# wire. If the capability is already in the table, the exporter should reuse the same ID. If the
+# ID is a promise (as opposed to a settled capability), this must be indicated at the time the ID
+# is introduced (e.g. by using `senderPromise` instead of `senderHosted` in `CapDescriptor`); in
+# this case, the importer shall expect a later `Resolve` message that replaces the promise.
+#
+# ExportId/ImportIds are subject to reference counting. Whenever an `ExportId` is sent over the
+# wire (from the exporter to the importer), the export's reference count is incremented (unless
+# otherwise specified). The reference count is later decremented by a `Release` message. Since
+# the `Release` message can specify an arbitrary number by which to reduce the reference count, the
+# importer should usually batch reference decrements and only send a `Release` when it believes the
+# reference count has hit zero. Of course, it is possible that a new reference to the export is
+# in-flight at the time that the `Release` message is sent, so it is necessary for the exporter to
+# keep track of the reference count on its end as well to avoid race conditions.
+#
+# When a connection is lost, all exports are implicitly released. It is not possible to restore
+# a connection state after disconnect (although a transport layer could implement a concept of
+# persistent connections if it is transparent to the RPC layer).
+
+using ImportId = ExportId;
+# **(level 1)**
+#
+# Identifies an imported capability or promise in the sender's import table (which corresponds to
+# the receiver's export table).
+#
+# ImportId is physically equivalent to ExportId, since the export and import tables correspond,
+# but we define a separate type for documentation purposes: we always use the type representing
+# the sender's point of view.
+#
+# An `ImportId` remains valid in importer -> exporter messages until the importer has sent
+# `Release` messages that (it believes) have reduced the reference count to zero.
+
+# ========================================================================================
+# Messages
+
+struct Message {
+ # An RPC connection is a bi-directional stream of Messages.
+
+ union {
+ unimplemented @0 :Message;
+ # The sender previously received this message from the peer but didn't understand it or doesn't
+ # yet implement the functionality that was requested. So, the sender is echoing the message
+ # back. In some cases, the receiver may be able to recover from this by pretending the sender
+ # had taken some appropriate "null" action.
+ #
+ # For example, say `resolve` is received by a level 0 implementation (because a previous call
+ # or return happened to contain a promise). The level 0 implementation will echo it back as
+ # `unimplemented`. The original sender can then simply release the cap to which the promise
+ # had resolved, thus avoiding a leak.
+ #
+ # For any message type that introduces a question, if the message comes back unimplemented,
+ # the original sender may simply treat it as if the question failed with an exception.
+ #
+ # In cases where there is no sensible way to react to an `unimplemented` message (without
+ # resource leaks or other serious problems), the connection may need to be aborted. This is
+ # a gray area; different implementations may take different approaches.
+
+ abort @1 :Exception;
+ # Sent when a connection is being aborted due to an unrecoverable error. This could be e.g.
+ # because the sender received an invalid or nonsensical message (`isCallersFault` is true) or
+ # because the sender had an internal error (`isCallersFault` is false). The sender will shut
+ # down the outgoing half of the connection after `abort` and will completely close the
+ # connection shortly thereafter (it's up to the sender how much of a time buffer they want to
+ # offer for the client to receive the `abort` before the connection is reset).
+
+ # Level 0 features -----------------------------------------------
+
+ bootstrap @8 :Bootstrap; # Request the peer's bootstrap interface.
+ call @2 :Call; # Begin a method call.
+ return @3 :Return; # Complete a method call.
+ finish @4 :Finish; # Release a returned answer / cancel a call.
+
+ # Level 1 features -----------------------------------------------
+
+ resolve @5 :Resolve; # Resolve a previously-sent promise.
+ release @6 :Release; # Release a capability so that the remote object can be deallocated.
+ disembargo @13 :Disembargo; # Lift an embargo used to enforce E-order over promise resolution.
+
+ # Level 2 features -----------------------------------------------
+
+ obsoleteSave @7 :AnyPointer;
+ # Obsolete request to save a capability, resulting in a SturdyRef. This has been replaced
+ # by the `Persistent` interface defined in `persistent.capnp`. This operation was never
+ # implemented.
+
+ obsoleteDelete @9 :AnyPointer;
+ # Obsolete way to delete a SturdyRef. This operation was never implemented.
+
+ # Level 3 features -----------------------------------------------
+
+ provide @10 :Provide; # Provide a capability to a third party.
+ accept @11 :Accept; # Accept a capability provided by a third party.
+
+ # Level 4 features -----------------------------------------------
+
+ join @12 :Join; # Directly connect to the common root of two or more proxied caps.
+ }
+}
+
+# Level 0 message types ----------------------------------------------
+
+struct Bootstrap {
+ # **(level 0)**
+ #
+ # Get the "bootstrap" interface exported by the remote vat.
+ #
+ # For level 0, 1, and 2 implementations, the "bootstrap" interface is simply the main interface
+ # exported by a vat. If the vat acts as a server fielding connections from clients, then the
+ # bootstrap interface defines the basic functionality available to a client when it connects.
+ # The exact interface definition obviously depends on the application.
+ #
+ # We call this a "bootstrap" because in an ideal Cap'n Proto world, bootstrap interfaces would
+ # never be used. In such a world, any time you connect to a new vat, you do so because you
+ # received an introduction from some other vat (see `ThirdPartyCapId`). Thus, the first message
+ # you send is `Accept`, and further communications derive from there. `Bootstrap` is not used.
+ #
+ # In such an ideal world, DNS itself would support Cap'n Proto -- performing a DNS lookup would
+ # actually return a new Cap'n Proto capability, thus introducing you to the target system via
+ # level 3 RPC. Applications would receive the capability to talk to DNS in the first place as
+ # an initial endowment or part of a Powerbox interaction. Therefore, an app can form arbitrary
+ # connections without ever using `Bootstrap`.
+ #
+ # Of course, in the real world, DNS is not Cap'n-Proto-based, and we don't want Cap'n Proto to
+ # require a whole new internet infrastructure to be useful. Therefore, we offer bootstrap
+ # interfaces as a way to get up and running without a level 3 introduction. Thus, bootstrap
+ # interfaces are used to "bootstrap" from other, non-Cap'n-Proto-based means of service discovery,
+ # such as legacy DNS.
+ #
+ # Note that a vat need not provide a bootstrap interface, and in fact many vats (especially those
+ # acting as clients) do not. In this case, the vat should either reply to `Bootstrap` with a
+ # `Return` indicating an exception, or should return a dummy capability with no methods.
+
+ questionId @0 :QuestionId;
+ # A new question ID identifying this request, which will eventually receive a Return message
+ # containing the restored capability.
+
+ deprecatedObjectId @1 :AnyPointer;
+ # ** DEPRECATED **
+ #
+ # A Vat may export multiple bootstrap interfaces. In this case, `deprecatedObjectId` specifies
+ # which one to return. If this pointer is null, then the default bootstrap interface is returned.
+ #
+ # As of verison 0.5, use of this field is deprecated. If a service wants to export multiple
+ # bootstrap interfaces, it should instead define a single bootstarp interface that has methods
+ # that return each of the other interfaces.
+ #
+ # **History**
+ #
+ # In the first version of Cap'n Proto RPC (0.4.x) the `Bootstrap` message was called `Restore`.
+ # At the time, it was thought that this would eventually serve as the way to restore SturdyRefs
+ # (level 2). Meanwhile, an application could offer its "main" interface on a well-known
+ # (non-secret) SturdyRef.
+ #
+ # Since level 2 RPC was not implemented at the time, the `Restore` message was in practice only
+ # used to obtain the main interface. Since most applications had only one main interface that
+ # they wanted to restore, they tended to designate this with a null `objectId`.
+ #
+ # Unfortunately, the earliest version of the EZ RPC interfaces set a precedent of exporting
+ # multiple main interfaces by allowing them to be exported under string names. In this case,
+ # `objectId` was a Text value specifying the name.
+ #
+ # All of this proved problematic for several reasons:
+ #
+ # - The arrangement assumed that a client wishing to restore a SturdyRef would know exactly what
+ # machine to connect to and would be able to immediately restore a SturdyRef on connection.
+ # However, in practice, the ability to restore SturdyRefs is itself a capability that may
+ # require going through an authentication process to obtain. Thus, it makes more sense to
+ # define a "restorer service" as a full Cap'n Proto interface. If this restorer interface is
+ # offered as the vat's bootstrap interface, then this is equivalent to the old arrangement.
+ #
+ # - Overloading "Restore" for the purpose of obtaining well-known capabilities encouraged the
+ # practice of exporting singleton services with string names. If singleton services are desired,
+ # it is better to have one main interface that has methods that can be used to obtain each
+ # service, in order to get all the usual benefits of schemas and type checking.
+ #
+ # - Overloading "Restore" also had a security problem: Often, "main" or "well-known"
+ # capabilities exported by a vat are in fact not public: they are intended to be accessed only
+ # by clients who are capable of forming a connection to the vat. This can lead to trouble if
+ # the client itself has other clients and wishes to foward some `Restore` requests from those
+ # external clients -- it has to be very careful not to allow through `Restore` requests
+ # addressing the default capability.
+ #
+ # For example, consider the case of a sandboxed Sandstorm application and its supervisor. The
+ # application exports a default capability to its supervisor that provides access to
+ # functionality that only the supervisor is supposed to access. Meanwhile, though, applications
+ # may publish other capabilities that may be persistent, in which case the application needs
+ # to field `Restore` requests that could come from anywhere. These requests of course have to
+ # pass through the supervisor, as all communications with the outside world must. But, the
+ # supervisor has to be careful not to honor an external request addressing the application's
+ # default capability, since this capability is privileged. Unfortunately, the default
+ # capability cannot be given an unguessable name, because then the supervisor itself would not
+ # be able to address it!
+ #
+ # As of Cap'n Proto 0.5, `Restore` has been renamed to `Bootstrap` and is no longer planned for
+ # use in restoring SturdyRefs.
+ #
+ # Note that 0.4 also defined a message type called `Delete` that, like `Restore`, addressed a
+ # SturdyRef, but indicated that the client would not restore the ref again in the future. This
+ # operation was never implemented, so it was removed entirely. If a "delete" operation is desired,
+ # it should exist as a method on the same interface that handles restoring SturdyRefs. However,
+ # the utility of such an operation is questionable. You wouldn't be able to rely on it for
+ # garbage collection since a client could always disappear permanently without remembering to
+ # delete all its SturdyRefs, thus leaving them dangling forever. Therefore, it is advisable to
+ # design systems such that SturdyRefs never represent "owned" pointers.
+ #
+ # For example, say a SturdyRef points to an image file hosted on some server. That image file
+ # should also live inside a collection (a gallery, perhaps) hosted on the same server, owned by
+ # a user who can delete the image at any time. If the user deletes the image, the SturdyRef
+ # stops working. On the other hand, if the SturdyRef is discarded, this has no effect on the
+ # existence of the image in its collection.
+}
+
+struct Call {
+ # **(level 0)**
+ #
+ # Message type initiating a method call on a capability.
+
+ questionId @0 :QuestionId;
+ # A number, chosen by the caller, that identifies this call in future messages. This number
+ # must be different from all other calls originating from the same end of the connection (but
+ # may overlap with question IDs originating from the opposite end). A fine strategy is to use
+ # sequential question IDs, but the recipient should not assume this.
+ #
+ # A question ID can be reused once both:
+ # - A matching Return has been received from the callee.
+ # - A matching Finish has been sent from the caller.
+
+ target @1 :MessageTarget;
+ # The object that should receive this call.
+
+ interfaceId @2 :UInt64;
+ # The type ID of the interface being called. Each capability may implement multiple interfaces.
+
+ methodId @3 :UInt16;
+ # The ordinal number of the method to call within the requested interface.
+
+ allowThirdPartyTailCall @8 :Bool = false;
+ # Indicates whether or not the receiver is allowed to send a `Return` containing
+ # `acceptFromThirdParty`. Level 3 implementations should set this true. Otherwise, the callee
+ # will have to proxy the return in the case of a tail call to a third-party vat.
+
+ params @4 :Payload;
+ # The call parameters. `params.content` is a struct whose fields correspond to the parameters of
+ # the method.
+
+ sendResultsTo :union {
+ # Where should the return message be sent?
+
+ caller @5 :Void;
+ # Send the return message back to the caller (the usual).
+
+ yourself @6 :Void;
+ # **(level 1)**
+ #
+ # Don't actually return the results to the sender. Instead, hold on to them and await
+ # instructions from the sender regarding what to do with them. In particular, the sender
+ # may subsequently send a `Return` for some other call (which the receiver had previously made
+ # to the sender) with `takeFromOtherQuestion` set. The results from this call are then used
+ # as the results of the other call.
+ #
+ # When `yourself` is used, the receiver must still send a `Return` for the call, but sets the
+ # field `resultsSentElsewhere` in that `Return` rather than including the results.
+ #
+ # This feature can be used to implement tail calls in which a call from Vat A to Vat B ends up
+ # returning the result of a call from Vat B back to Vat A.
+ #
+ # In particular, the most common use case for this feature is when Vat A makes a call to a
+ # promise in Vat B, and then that promise ends up resolving to a capability back in Vat A.
+ # Vat B must forward all the queued calls on that promise back to Vat A, but can set `yourself`
+ # in the calls so that the results need not pass back through Vat B.
+ #
+ # For example:
+ # - Alice, in Vat A, call foo() on Bob in Vat B.
+ # - Alice makes a pipelined call bar() on the promise returned by foo().
+ # - Later on, Bob resolves the promise from foo() to point at Carol, who lives in Vat A (next
+ # to Alice).
+ # - Vat B dutifully forwards the bar() call to Carol. Let us call this forwarded call bar'().
+ # Notice that bar() and bar'() are travelling in opposite directions on the same network
+ # link.
+ # - The `Call` for bar'() has `sendResultsTo` set to `yourself`, with the value being the
+ # question ID originally assigned to the bar() call.
+ # - Vat A receives bar'() and delivers it to Carol.
+ # - When bar'() returns, Vat A immediately takes the results and returns them from bar().
+ # - Meanwhile, Vat A sends a `Return` for bar'() to Vat B, with `resultsSentElsewhere` set in
+ # place of results.
+ # - Vat A sends a `Finish` for that call to Vat B.
+ # - Vat B receives the `Return` for bar'() and sends a `Return` for bar(), with
+ # `receivedFromYourself` set in place of the results.
+ # - Vat B receives the `Finish` for bar() and sends a `Finish` to bar'().
+
+ thirdParty @7 :RecipientId;
+ # **(level 3)**
+ #
+ # The call's result should be returned to a different vat. The receiver (the callee) expects
+ # to receive an `Accept` message from the indicated vat, and should return the call's result
+ # to it, rather than to the sender of the `Call`.
+ #
+ # This operates much like `yourself`, above, except that Carol is in a separate Vat C. `Call`
+ # messages are sent from Vat A -> Vat B and Vat B -> Vat C. A `Return` message is sent from
+ # Vat B -> Vat A that contains `acceptFromThirdParty` in place of results. When Vat A sends
+ # an `Accept` to Vat C, it receives back a `Return` containing the call's actual result. Vat C
+ # also sends a `Return` to Vat B with `resultsSentElsewhere`.
+ }
+}
+
+struct Return {
+ # **(level 0)**
+ #
+ # Message type sent from callee to caller indicating that the call has completed.
+
+ answerId @0 :AnswerId;
+ # Equal to the QuestionId of the corresponding `Call` message.
+
+ releaseParamCaps @1 :Bool = true;
+ # If true, all capabilities that were in the params should be considered released. The sender
+ # must not send separate `Release` messages for them. Level 0 implementations in particular
+ # should always set this true. This defaults true because if level 0 implementations forget to
+ # set it they'll never notice (just silently leak caps), but if level >=1 implementations forget
+ # to set it to false they'll quickly get errors.
+
+ union {
+ results @2 :Payload;
+ # The result.
+ #
+ # For regular method calls, `results.content` points to the result struct.
+ #
+ # For a `Return` in response to an `Accept`, `results` contains a single capability (rather
+ # than a struct), and `results.content` is just a capability pointer with index 0. A `Finish`
+ # is still required in this case.
+
+ exception @3 :Exception;
+ # Indicates that the call failed and explains why.
+
+ canceled @4 :Void;
+ # Indicates that the call was canceled due to the caller sending a Finish message
+ # before the call had completed.
+
+ resultsSentElsewhere @5 :Void;
+ # This is set when returning from a `Call` that had `sendResultsTo` set to something other
+ # than `caller`.
+
+ takeFromOtherQuestion @6 :QuestionId;
+ # The sender has also sent (before this message) a `Call` with the given question ID and with
+ # `sendResultsTo.yourself` set, and the results of that other call should be used as the
+ # results here.
+
+ acceptFromThirdParty @7 :ThirdPartyCapId;
+ # **(level 3)**
+ #
+ # The caller should contact a third-party vat to pick up the results. An `Accept` message
+ # sent to the vat will return the result. This pairs with `Call.sendResultsTo.thirdParty`.
+ # It should only be used if the corresponding `Call` had `allowThirdPartyTailCall` set.
+ }
+}
+
+struct Finish {
+ # **(level 0)**
+ #
+ # Message type sent from the caller to the callee to indicate:
+ # 1) The questionId will no longer be used in any messages sent by the callee (no further
+ # pipelined requests).
+ # 2) If the call has not returned yet, the caller no longer cares about the result. If nothing
+ # else cares about the result either (e.g. there are no other outstanding calls pipelined on
+ # the result of this one) then the callee may wish to immediately cancel the operation and
+ # send back a Return message with "canceled" set. However, implementations are not required
+ # to support premature cancellation -- instead, the implementation may wait until the call
+ # actually completes and send a normal `Return` message.
+ #
+ # TODO(someday): Should we separate (1) and implicitly releasing result capabilities? It would be
+ # possible and useful to notify the server that it doesn't need to keep around the response to
+ # service pipeline requests even though the caller still wants to receive it / hasn't yet
+ # finished processing it. It could also be useful to notify the server that it need not marshal
+ # the results because the caller doesn't want them anyway, even if the caller is still sending
+ # pipelined calls, although this seems less useful (just saving some bytes on the wire).
+
+ questionId @0 :QuestionId;
+ # ID of the call whose result is to be released.
+
+ releaseResultCaps @1 :Bool = true;
+ # If true, all capabilities that were in the results should be considered released. The sender
+ # must not send separate `Release` messages for them. Level 0 implementations in particular
+ # should always set this true. This defaults true because if level 0 implementations forget to
+ # set it they'll never notice (just silently leak caps), but if level >=1 implementations forget
+ # set it false they'll quickly get errors.
+}
+
+# Level 1 message types ----------------------------------------------
+
+struct Resolve {
+ # **(level 1)**
+ #
+ # Message type sent to indicate that a previously-sent promise has now been resolved to some other
+ # object (possibly another promise) -- or broken, or canceled.
+ #
+ # Keep in mind that it's possible for a `Resolve` to be sent to a level 0 implementation that
+ # doesn't implement it. For example, a method call or return might contain a capability in the
+ # payload. Normally this is fine even if the receiver is level 0, because they will implicitly
+ # release all such capabilities on return / finish. But if the cap happens to be a promise, then
+ # a follow-up `Resolve` may be sent regardless of this release. The level 0 receiver will reply
+ # with an `unimplemented` message, and the sender (of the `Resolve`) can respond to this as if the
+ # receiver had immediately released any capability to which the promise resolved.
+ #
+ # When implementing promise resolution, it's important to understand how embargos work and the
+ # tricky case of the Tribble 4-way race condition. See the comments for the Disembargo message,
+ # below.
+
+ promiseId @0 :ExportId;
+ # The ID of the promise to be resolved.
+ #
+ # Unlike all other instances of `ExportId` sent from the exporter, the `Resolve` message does
+ # _not_ increase the reference count of `promiseId`. In fact, it is expected that the receiver
+ # will release the export soon after receiving `Resolve`, and the sender will not send this
+ # `ExportId` again until it has been released and recycled.
+ #
+ # When an export ID sent over the wire (e.g. in a `CapDescriptor`) is indicated to be a promise,
+ # this indicates that the sender will follow up at some point with a `Resolve` message. If the
+ # same `promiseId` is sent again before `Resolve`, still only one `Resolve` is sent. If the
+ # same ID is sent again later _after_ a `Resolve`, it can only be because the export's
+ # reference count hit zero in the meantime and the ID was re-assigned to a new export, therefore
+ # this later promise does _not_ correspond to the earlier `Resolve`.
+ #
+ # If a promise ID's reference count reaches zero before a `Resolve` is sent, the `Resolve`
+ # message may or may not still be sent (the `Resolve` may have already been in-flight when
+ # `Release` was sent, but if the `Release` is received before `Resolve` then there is no longer
+ # any reason to send a `Resolve`). Thus a `Resolve` may be received for a promise of which
+ # the receiver has no knowledge, because it already released it earlier. In this case, the
+ # receiver should simply release the capability to which the promise resolved.
+
+ union {
+ cap @1 :CapDescriptor;
+ # The object to which the promise resolved.
+ #
+ # The sender promises that from this point forth, until `promiseId` is released, it shall
+ # simply forward all messages to the capability designated by `cap`. This is true even if
+ # `cap` itself happens to desigate another promise, and that other promise later resolves --
+ # messages sent to `promiseId` shall still go to that other promise, not to its resolution.
+ # This is important in the case that the receiver of the `Resolve` ends up sending a
+ # `Disembargo` message towards `promiseId` in order to control message ordering -- that
+ # `Disembargo` really needs to reflect back to exactly the object designated by `cap` even
+ # if that object is itself a promise.
+
+ exception @2 :Exception;
+ # Indicates that the promise was broken.
+ }
+}
+
+struct Release {
+ # **(level 1)**
+ #
+ # Message type sent to indicate that the sender is done with the given capability and the receiver
+ # can free resources allocated to it.
+
+ id @0 :ImportId;
+ # What to release.
+
+ referenceCount @1 :UInt32;
+ # The amount by which to decrement the reference count. The export is only actually released
+ # when the reference count reaches zero.
+}
+
+struct Disembargo {
+ # **(level 1)**
+ #
+ # Message sent to indicate that an embargo on a recently-resolved promise may now be lifted.
+ #
+ # Embargos are used to enforce E-order in the presence of promise resolution. That is, if an
+ # application makes two calls foo() and bar() on the same capability reference, in that order,
+ # the calls should be delivered in the order in which they were made. But if foo() is called
+ # on a promise, and that promise happens to resolve before bar() is called, then the two calls
+ # may travel different paths over the network, and thus could arrive in the wrong order. In
+ # this case, the call to `bar()` must be embargoed, and a `Disembargo` message must be sent along
+ # the same path as `foo()` to ensure that the `Disembargo` arrives after `foo()`. Once the
+ # `Disembargo` arrives, `bar()` can then be delivered.
+ #
+ # There are two particular cases where embargos are important. Consider object Alice, in Vat A,
+ # who holds a promise P, pointing towards Vat B, that eventually resolves to Carol. The two
+ # cases are:
+ # - Carol lives in Vat A, i.e. next to Alice. In this case, Vat A needs to send a `Disembargo`
+ # message that echos through Vat B and back, to ensure that all pipelined calls on the promise
+ # have been delivered.
+ # - Carol lives in a different Vat C. When the promise resolves, a three-party handoff occurs
+ # (see `Provide` and `Accept`, which constitute level 3 of the protocol). In this case, we
+ # piggyback on the state that has already been set up to handle the handoff: the `Accept`
+ # message (from Vat A to Vat C) is embargoed, as are all pipelined messages sent to it, while
+ # a `Disembargo` message is sent from Vat A through Vat B to Vat C. See `Accept.embargo` for
+ # an example.
+ #
+ # Note that in the case where Carol actually lives in Vat B (i.e., the same vat that the promise
+ # already pointed at), no embargo is needed, because the pipelined calls are delivered over the
+ # same path as the later direct calls.
+ #
+ # Keep in mind that promise resolution happens both in the form of Resolve messages as well as
+ # Return messages (which resolve PromisedAnswers). Embargos apply in both cases.
+ #
+ # An alternative strategy for enforcing E-order over promise resolution could be for Vat A to
+ # implement the embargo internally. When Vat A is notified of promise resolution, it could
+ # send a dummy no-op call to promise P and wait for it to complete. Until that call completes,
+ # all calls to the capability are queued locally. This strategy works, but is pessimistic:
+ # in the three-party case, it requires an A -> B -> C -> B -> A round trip before calls can start
+ # being delivered directly to from Vat A to Vat C. The `Disembargo` message allows latency to be
+ # reduced. (In the two-party loopback case, the `Disembargo` message is just a more explicit way
+ # of accomplishing the same thing as a no-op call, but isn't any faster.)
+ #
+ # *The Tribble 4-way Race Condition*
+ #
+ # Any implementation of promise resolution and embargos must be aware of what we call the
+ # "Tribble 4-way race condition", after Dean Tribble, who explained the problem in a lively
+ # Friam meeting.
+ #
+ # Embargos are designed to work in the case where a two-hop path is being shortened to one hop.
+ # But sometimes there are more hops. Imagine that Alice has a reference to a remote promise P1
+ # that eventually resolves to _another_ remote promise P2 (in a third vat), which _at the same
+ # time_ happens to resolve to Bob (in a fourth vat). In this case, we're shortening from a 3-hop
+ # path (with four parties) to a 1-hop path (Alice -> Bob).
+ #
+ # Extending the embargo/disembargo protocol to be able to shorted multiple hops at once seems
+ # difficult. Instead, we make a rule that prevents this case from coming up:
+ #
+ # One a promise P has been resolved to a remove object reference R, then all further messages
+ # received addressed to P will be forwarded strictly to R. Even if it turns out later that R is
+ # itself a promise, and has resolved to some other object Q, messages sent to P will still be
+ # forwarded to R, not directly to Q (R will of course further forward the messages to Q).
+ #
+ # This rule does not cause a significant performance burden because once P has resolved to R, it
+ # is expected that people sending messages to P will shortly start sending them to R instead and
+ # drop P. P is at end-of-life anyway, so it doesn't matter if it ignores chances to further
+ # optimize its path.
+
+ target @0 :MessageTarget;
+ # What is to be disembargoed.
+
+ using EmbargoId = UInt32;
+ # Used in `senderLoopback` and `receiverLoopback`, below.
+
+ context :union {
+ senderLoopback @1 :EmbargoId;
+ # The sender is requesting a disembargo on a promise that is known to resolve back to a
+ # capability hosted by the sender. As soon as the receiver has echoed back all pipelined calls
+ # on this promise, it will deliver the Disembargo back to the sender with `receiverLoopback`
+ # set to the same value as `senderLoopback`. This value is chosen by the sender, and since
+ # it is also consumed be the sender, the sender can use whatever strategy it wants to make sure
+ # the value is unambiguous.
+ #
+ # The receiver must verify that the target capability actually resolves back to the sender's
+ # vat. Otherwise, the sender has committed a protocol error and should be disconnected.
+
+ receiverLoopback @2 :EmbargoId;
+ # The receiver previously sent a `senderLoopback` Disembargo towards a promise resolving to
+ # this capability, and that Disembargo is now being echoed back.
+
+ accept @3 :Void;
+ # **(level 3)**
+ #
+ # The sender is requesting a disembargo on a promise that is known to resolve to a third-party
+ # capability that the sender is currently in the process of accepting (using `Accept`).
+ # The receiver of this `Disembargo` has an outstanding `Provide` on said capability. The
+ # receiver should now send a `Disembargo` with `provide` set to the question ID of that
+ # `Provide` message.
+ #
+ # See `Accept.embargo` for an example.
+
+ provide @4 :QuestionId;
+ # **(level 3)**
+ #
+ # The sender is requesting a disembargo on a capability currently being provided to a third
+ # party. The question ID identifies the `Provide` message previously sent by the sender to
+ # this capability. On receipt, the receiver (the capability host) shall release the embargo
+ # on the `Accept` message that it has received from the third party. See `Accept.embargo` for
+ # an example.
+ }
+}
+
+# Level 2 message types ----------------------------------------------
+
+# See persistent.capnp.
+
+# Level 3 message types ----------------------------------------------
+
+struct Provide {
+ # **(level 3)**
+ #
+ # Message type sent to indicate that the sender wishes to make a particular capability implemented
+ # by the receiver available to a third party for direct access (without the need for the third
+ # party to proxy through the sender).
+ #
+ # (In CapTP, `Provide` and `Accept` are methods of the global `NonceLocator` object exported by
+ # every vat. In Cap'n Proto, we bake this into the core protocol.)
+
+ questionId @0 :QuestionId;
+ # Question ID to be held open until the recipient has received the capability. A result will be
+ # returned once the third party has successfully received the capability. The sender must at some
+ # point send a `Finish` message as with any other call, and that message can be used to cancel the
+ # whole operation.
+
+ target @1 :MessageTarget;
+ # What is to be provided to the third party.
+
+ recipient @2 :RecipientId;
+ # Identity of the third party that is expected to pick up the capability.
+}
+
+struct Accept {
+ # **(level 3)**
+ #
+ # Message type sent to pick up a capability hosted by the receiving vat and provided by a third
+ # party. The third party previously designated the capability using `Provide`.
+ #
+ # This message is also used to pick up a redirected return -- see `Return.redirect`.
+
+ questionId @0 :QuestionId;
+ # A new question ID identifying this accept message, which will eventually receive a Return
+ # message containing the provided capability (or the call result in the case of a redirected
+ # return).
+
+ provision @1 :ProvisionId;
+ # Identifies the provided object to be picked up.
+
+ embargo @2 :Bool;
+ # If true, this accept shall be temporarily embargoed. The resulting `Return` will not be sent,
+ # and any pipelined calls will not be delivered, until the embargo is released. The receiver
+ # (the capability host) will expect the provider (the vat that sent the `Provide` message) to
+ # eventually send a `Disembargo` message with the field `context.provide` set to the question ID
+ # of the original `Provide` message. At that point, the embargo is released and the queued
+ # messages are delivered.
+ #
+ # For example:
+ # - Alice, in Vat A, holds a promise P, which currently points toward Vat B.
+ # - Alice calls foo() on P. The `Call` message is sent to Vat B.
+ # - The promise P in Vat B ends up resolving to Carol, in Vat C.
+ # - Vat B sends a `Provide` message to Vat C, identifying Vat A as the recipient.
+ # - Vat B sends a `Resolve` message to Vat A, indicating that the promise has resolved to a
+ # `ThirdPartyCapId` identifying Carol in Vat C.
+ # - Vat A sends an `Accept` message to Vat C to pick up the capability. Since Vat A knows that
+ # it has an outstanding call to the promise, it sets `embargo` to `true` in the `Accept`
+ # message.
+ # - Vat A sends a `Disembargo` message to Vat B on promise P, with `context.accept` set.
+ # - Alice makes a call bar() to promise P, which is now pointing towards Vat C. Alice doesn't
+ # know anything about the mechanics of promise resolution happening under the hood, but she
+ # expects that bar() will be delivered after foo() because that is the order in which she
+ # initiated the calls.
+ # - Vat A sends the bar() call to Vat C, as a pipelined call on the result of the `Accept` (which
+ # hasn't returned yet, due to the embargo). Since calls to the newly-accepted capability
+ # are embargoed, Vat C does not deliver the call yet.
+ # - At some point, Vat B forwards the foo() call from the beginning of this example on to Vat C.
+ # - Vat B forwards the `Disembargo` from Vat A on to vat C. It sets `context.provide` to the
+ # question ID of the `Provide` message it had sent previously.
+ # - Vat C receives foo() before `Disembargo`, thus allowing it to correctly deliver foo()
+ # before delivering bar().
+ # - Vat C receives `Disembargo` from Vat B. It can now send a `Return` for the `Accept` from
+ # Vat A, as well as deliver bar().
+}
+
+# Level 4 message types ----------------------------------------------
+
+struct Join {
+ # **(level 4)**
+ #
+ # Message type sent to implement E.join(), which, given a number of capabilities that are
+ # expected to be equivalent, finds the underlying object upon which they all agree and forms a
+ # direct connection to it, skipping any proxies that may have been constructed by other vats
+ # while transmitting the capability. See:
+ # http://erights.org/elib/equality/index.html
+ #
+ # Note that this should only serve to bypass fully-transparent proxies -- proxies that were
+ # created merely for convenience, without any intention of hiding the underlying object.
+ #
+ # For example, say Bob holds two capabilities hosted by Alice and Carol, but he expects that both
+ # are simply proxies for a capability hosted elsewhere. He then issues a join request, which
+ # operates as follows:
+ # - Bob issues Join requests on both Alice and Carol. Each request contains a different piece
+ # of the JoinKey.
+ # - Alice is proxying a capability hosted by Dana, so forwards the request to Dana's cap.
+ # - Dana receives the first request and sees that the JoinKeyPart is one of two. She notes that
+ # she doesn't have the other part yet, so she records the request and responds with a
+ # JoinResult.
+ # - Alice relays the JoinAswer back to Bob.
+ # - Carol is also proxying a capability from Dana, and so forwards her Join request to Dana as
+ # well.
+ # - Dana receives Carol's request and notes that she now has both parts of a JoinKey. She
+ # combines them in order to form information needed to form a secure connection to Bob. She
+ # also responds with another JoinResult.
+ # - Bob receives the responses from Alice and Carol. He uses the returned JoinResults to
+ # determine how to connect to Dana and attempts to form the connection. Since Bob and Dana now
+ # agree on a secret key that neither Alice nor Carol ever saw, this connection can be made
+ # securely even if Alice or Carol is conspiring against the other. (If Alice and Carol are
+ # conspiring _together_, they can obviously reproduce the key, but this doesn't matter because
+ # the whole point of the join is to verify that Alice and Carol agree on what capability they
+ # are proxying.)
+ #
+ # If the two capabilities aren't actually proxies of the same object, then the join requests
+ # will come back with conflicting `hostId`s and the join will fail before attempting to form any
+ # connection.
+
+ questionId @0 :QuestionId;
+ # Question ID used to respond to this Join. (Note that this ID only identifies one part of the
+ # request for one hop; each part has a different ID and relayed copies of the request have
+ # (probably) different IDs still.)
+ #
+ # The receiver will reply with a `Return` whose `results` is a JoinResult. This `JoinResult`
+ # is relayed from the joined object's host, possibly with transformation applied as needed
+ # by the network.
+ #
+ # Like any return, the result must be released using a `Finish`. However, this release
+ # should not occur until the joiner has either successfully connected to the joined object.
+ # Vats relaying a `Join` message similarly must not release the result they receive until the
+ # return they relayed back towards the joiner has itself been released. This allows the
+ # joined object's host to detect when the Join operation is canceled before completing -- if
+ # it receives a `Finish` for one of the join results before the joiner successfully
+ # connects. It can then free any resources it had allocated as part of the join.
+
+ target @1 :MessageTarget;
+ # The capability to join.
+
+ keyPart @2 :JoinKeyPart;
+ # A part of the join key. These combine to form the complete join key, which is used to establish
+ # a direct connection.
+
+ # TODO(before implementing): Change this so that multiple parts can be sent in a single Join
+ # message, so that if multiple join parts are going to cross the same connection they can be sent
+ # together, so that the receive can potentially optimize its handling of them. In the case where
+ # all parts are bundled together, should the recipient be expected to simply return a cap, so
+ # that the caller can immediately start pipelining to it?
+}
+
+# ========================================================================================
+# Common structures used in messages
+
+struct MessageTarget {
+ # The target of a `Call` or other messages that target a capability.
+
+ union {
+ importedCap @0 :ImportId;
+ # This message is to a capability or promise previously imported by the caller (exported by
+ # the receiver).
+
+ promisedAnswer @1 :PromisedAnswer;
+ # This message is to a capability that is expected to be returned by another call that has not
+ # yet been completed.
+ #
+ # At level 0, this is supported only for addressing the result of a previous `Bootstrap`, so
+ # that initial startup doesn't require a round trip.
+ }
+}
+
+struct Payload {
+ # Represents some data structure that might contain capabilities.
+
+ content @0 :AnyPointer;
+ # Some Cap'n Proto data structure. Capability pointers embedded in this structure index into
+ # `capTable`.
+
+ capTable @1 :List(CapDescriptor);
+ # Descriptors corresponding to the cap pointers in `content`.
+}
+
+struct CapDescriptor {
+ # **(level 1)**
+ #
+ # When an application-defined type contains an interface pointer, that pointer contains an index
+ # into the message's capability table -- i.e. the `capTable` part of the `Payload`. Each
+ # capability in the table is represented as a `CapDescriptor`. The runtime API should not reveal
+ # the CapDescriptor directly to the application, but should instead wrap it in some kind of
+ # callable object with methods corresponding to the interface that the capability implements.
+ #
+ # Keep in mind that `ExportIds` in a `CapDescriptor` are subject to reference counting. See the
+ # description of `ExportId`.
+
+ union {
+ none @0 :Void;
+ # There is no capability here. This `CapDescriptor` should not appear in the payload content.
+ # A `none` CapDescriptor can be generated when an application inserts a capability into a
+ # message and then later changes its mind and removes it -- rewriting all of the other
+ # capability pointers may be hard, so instead a tombstone is left, similar to the way a removed
+ # struct or list instance is zeroed out of the message but the space is not reclaimed.
+ # Hopefully this is unusual.
+
+ senderHosted @1 :ExportId;
+ # A capability newly exported by the sender. This is the ID of the new capability in the
+ # sender's export table (receiver's import table).
+
+ senderPromise @2 :ExportId;
+ # A promise that the sender will resolve later. The sender will send exactly one Resolve
+ # message at a future point in time to replace this promise. Note that even if the same
+ # `senderPromise` is received multiple times, only one `Resolve` is sent to cover all of
+ # them. If `senderPromise` is released before the `Resolve` is sent, the sender (of this
+ # `CapDescriptor`) may choose not to send the `Resolve` at all.
+
+ receiverHosted @3 :ImportId;
+ # A capability (or promise) previously exported by the receiver (imported by the sender).
+
+ receiverAnswer @4 :PromisedAnswer;
+ # A capability expected to be returned in the results of a currently-outstanding call posed
+ # by the sender.
+
+ thirdPartyHosted @5 :ThirdPartyCapDescriptor;
+ # **(level 3)**
+ #
+ # A capability that lives in neither the sender's nor the receiver's vat. The sender needs
+ # to form a direct connection to a third party to pick up the capability.
+ #
+ # Level 1 and 2 implementations that receive a `thirdPartyHosted` may simply send calls to its
+ # `vine` instead.
+ }
+}
+
+struct PromisedAnswer {
+ # **(mostly level 1)**
+ #
+ # Specifies how to derive a promise from an unanswered question, by specifying the path of fields
+ # to follow from the root of the eventual result struct to get to the desired capability. Used
+ # to address method calls to a not-yet-returned capability or to pass such a capability as an
+ # input to some other method call.
+ #
+ # Level 0 implementations must support `PromisedAnswer` only for the case where the answer is
+ # to a `Bootstrap` message. In this case, `path` is always empty since `Bootstrap` always returns
+ # a raw capability.
+
+ questionId @0 :QuestionId;
+ # ID of the question (in the sender's question table / receiver's answer table) whose answer is
+ # expected to contain the capability.
+
+ transform @1 :List(Op);
+ # Operations / transformations to apply to the result in order to get the capability actually
+ # being addressed. E.g. if the result is a struct and you want to call a method on a capability
+ # pointed to by a field of the struct, you need a `getPointerField` op.
+
+ struct Op {
+ union {
+ noop @0 :Void;
+ # Does nothing. This member is mostly defined so that we can make `Op` a union even
+ # though (as of this writing) only one real operation is defined.
+
+ getPointerField @1 :UInt16;
+ # Get a pointer field within a struct. The number is an index into the pointer section, NOT
+ # a field ordinal, so that the receiver does not need to understand the schema.
+
+ # TODO(someday): We could add:
+ # - For lists, the ability to address every member of the list, or a slice of the list, the
+ # result of which would be another list. This is useful for implementing the equivalent of
+ # a SQL table join (not to be confused with the `Join` message type).
+ # - Maybe some ability to test a union.
+ # - Probably not a good idea: the ability to specify an arbitrary script to run on the
+ # result. We could define a little stack-based language where `Op` specifies one
+ # "instruction" or transformation to apply. Although this is not a good idea
+ # (over-engineered), any narrower additions to `Op` should be designed as if this
+ # were the eventual goal.
+ }
+ }
+}
+
+struct ThirdPartyCapDescriptor {
+ # **(level 3)**
+ #
+ # Identifies a capability in a third-party vat that the sender wants the receiver to pick up.
+
+ id @0 :ThirdPartyCapId;
+ # Identifies the third-party host and the specific capability to accept from it.
+
+ vineId @1 :ExportId;
+ # A proxy for the third-party object exported by the sender. In CapTP terminology this is called
+ # a "vine", because it is an indirect reference to the third-party object that snakes through the
+ # sender vat. This serves two purposes:
+ #
+ # * Level 1 and 2 implementations that don't understand how to connect to a third party may
+ # simply send calls to the vine. Such calls will be forwarded to the third-party by the
+ # sender.
+ #
+ # * Level 3 implementations must release the vine once they have successfully picked up the
+ # object from the third party. This ensures that the capability is not released by the sender
+ # prematurely.
+ #
+ # The sender will close the `Provide` request that it has sent to the third party as soon as
+ # it receives either a `Call` or a `Release` message directed at the vine.
+}
+
+struct Exception {
+ # **(level 0)**
+ #
+ # Describes an arbitrary error that prevented an operation (e.g. a call) from completing.
+ #
+ # Cap'n Proto exceptions always indicate that something went wrong. In other words, in a fantasy
+ # world where everything always works as expected, no exceptions would ever be thrown. Clients
+ # should only ever catch exceptions as a means to implement fault-tolerance, where "fault" can
+ # mean:
+ # - Bugs.
+ # - Invalid input.
+ # - Configuration errors.
+ # - Network problems.
+ # - Insufficient resources.
+ # - Version skew (unimplemented functionality).
+ # - Other logistical problems.
+ #
+ # Exceptions should NOT be used to flag application-specific conditions that a client is expected
+ # to handle in an application-specific way. Put another way, in the Cap'n Proto world,
+ # "checked exceptions" (where an interface explicitly defines the exceptions it throws and
+ # clients are forced by the type system to handle those exceptions) do NOT make sense.
+
+ reason @0 :Text;
+ # Human-readable failure description.
+
+ type @3 :Type;
+ # The type of the error. The purpose of this enum is not to describe the error itself, but
+ # rather to describe how the client might want to respond to the error.
+
+ enum Type {
+ failed @0;
+ # A generic problem occurred, and it is believed that if the operation were repeated without
+ # any change in the state of the world, the problem would occur again.
+ #
+ # A client might respond to this error by logging it for investigation by the developer and/or
+ # displaying it to the user.
+
+ overloaded @1;
+ # The request was rejected due to a temporary lack of resources.
+ #
+ # Examples include:
+ # - There's not enough CPU time to keep up with incoming requests, so some are rejected.
+ # - The server ran out of RAM or disk space during the request.
+ # - The operation timed out (took significantly longer than it should have).
+ #
+ # A client might respond to this error by scheduling to retry the operation much later. The
+ # client should NOT retry again immediately since this would likely exacerbate the problem.
+
+ disconnected @2;
+ # The method failed because a connection to some necessary capability was lost.
+ #
+ # Examples include:
+ # - The client introduced the server to a third-party capability, the connection to that third
+ # party was subsequently lost, and then the client requested that the server use the dead
+ # capability for something.
+ # - The client previously requested that the server obtain a capability from some third party.
+ # The server returned a capability to an object wrapping the third-party capability. Later,
+ # the server's connection to the third party was lost.
+ # - The capability has been revoked. Revocation does not necessarily mean that the client is
+ # no longer authorized to use the capability; it is often used simply as a way to force the
+ # client to repeat the setup process, perhaps to efficiently move them to a new back-end or
+ # get them to recognize some other change that has occurred.
+ #
+ # A client should normally respond to this error by releasing all capabilities it is currently
+ # holding related to the one it called and then re-creating them by restoring SturdyRefs and/or
+ # repeating the method calls used to create them originally. In other words, disconnect and
+ # start over. This should in turn cause the server to obtain a new copy of the capability that
+ # it lost, thus making everything work.
+ #
+ # If the client receives another `disconnencted` error in the process of rebuilding the
+ # capability and retrying the call, it should treat this as an `overloaded` error: the network
+ # is currently unreliable, possibly due to load or other temporary issues.
+
+ unimplemented @3;
+ # The server doesn't implement the requested method. If there is some other method that the
+ # client could call (perhaps an older and/or slower interface), it should try that instead.
+ # Otherwise, this should be treated like `failed`.
+ }
+
+ obsoleteIsCallersFault @1 :Bool;
+ # OBSOLETE. Ignore.
+
+ obsoleteDurability @2 :UInt16;
+ # OBSOLETE. See `type` instead.
+}
+
+# ========================================================================================
+# Network-specific Parameters
+#
+# Some parts of the Cap'n Proto RPC protocol are not specified here because different vat networks
+# may wish to use different approaches to solving them. For example, on the public internet, you
+# may want to authenticate vats using public-key cryptography, but on a local intranet with trusted
+# infrastructure, you may be happy to authenticate based on network address only, or some other
+# lightweight mechanism.
+#
+# To accommodate this, we specify several "parameter" types. Each type is defined here as an
+# alias for `AnyPointer`, but a specific network will want to define a specific set of types to use.
+# All vats in a vat network must agree on these parameters in order to be able to communicate.
+# Inter-network communication can be accomplished through "gateways" that perform translation
+# between the primitives used on each network; these gateways may need to be deeply stateful,
+# depending on the translations they perform.
+#
+# For interaction over the global internet between parties with no other prior arrangement, a
+# particular set of bindings for these types is defined elsewhere. (TODO(someday): Specify where
+# these common definitions live.)
+#
+# Another common network type is the two-party network, in which one of the parties typically
+# interacts with the outside world entirely through the other party. In such a connection between
+# Alice and Bob, all objects that exist on Bob's other networks appear to Alice as if they were
+# hosted by Bob himself, and similarly all objects on Alice's network (if she even has one) appear
+# to Bob as if they were hosted by Alice. This network type is interesting because from the point
+# of view of a simple application that communicates with only one other party via the two-party
+# protocol, there are no three-party interactions at all, and joins are unusually simple to
+# implement, so implementing at level 4 is barely more complicated than implementing at level 1.
+# Moreover, if you pair an app implementing the two-party network with a container that implements
+# some other network, the app can then participate on the container's network just as if it
+# implemented that network directly. The types used by the two-party network are defined in
+# `rpc-twoparty.capnp`.
+#
+# The things that we need to parameterize are:
+# - How to store capabilities long-term without holding a connection open (mostly level 2).
+# - How to authenticate vats in three-party introductions (level 3).
+# - How to implement `Join` (level 4).
+#
+# Persistent references
+# ---------------------
+#
+# **(mostly level 2)**
+#
+# We want to allow some capabilities to be stored long-term, even if a connection is lost and later
+# recreated. ExportId is a short-term identifier that is specific to a connection, so it doesn't
+# help here. We need a way to specify long-term identifiers, as well as a strategy for
+# reconnecting to a referenced capability later.
+#
+# Three-party interactions
+# ------------------------
+#
+# **(level 3)**
+#
+# In cases where more than two vats are interacting, we have situations where VatA holds a
+# capability hosted by VatB and wants to send that capability to VatC. This can be accomplished
+# by VatA proxying requests on the new capability, but doing so has two big problems:
+# - It's inefficient, requiring an extra network hop.
+# - If VatC receives another capability to the same object from VatD, it is difficult for VatC to
+# detect that the two capabilities are really the same and to implement the E "join" operation,
+# which is necessary for certain four-or-more-party interactions, such as the escrow pattern.
+# See: http://www.erights.org/elib/equality/grant-matcher/index.html
+#
+# Instead, we want a way for VatC to form a direct, authenticated connection to VatB.
+#
+# Join
+# ----
+#
+# **(level 4)**
+#
+# The `Join` message type and corresponding operation arranges for a direct connection to be formed
+# between the joiner and the host of the joined object, and this connection must be authenticated.
+# Thus, the details are network-dependent.
+
+using SturdyRef = AnyPointer;
+# **(level 2)**
+#
+# Identifies a persisted capability that can be restored in the future. How exactly a SturdyRef
+# is restored to a live object is specified along with the SturdyRef definition (i.e. not by
+# rpc.capnp).
+#
+# Generally a SturdyRef needs to specify three things:
+# - How to reach the vat that can restore the ref (e.g. a hostname or IP address).
+# - How to authenticate the vat after connecting (e.g. a public key fingerprint).
+# - The identity of a specific object hosted by the vat. Generally, this is an opaque pointer whose
+# format is defined by the specific vat -- the client has no need to inspect the object ID.
+# It is important that the objec ID be unguessable if the object is not public (and objects
+# should almost never be public).
+#
+# The above are only suggestions. Some networks might work differently. For example, a private
+# network might employ a special restorer service whose sole purpose is to restore SturdyRefs.
+# In this case, the entire contents of SturdyRef might be opaque, because they are intended only
+# to be forwarded to the restorer service.
+
+using ProvisionId = AnyPointer;
+# **(level 3)**
+#
+# The information that must be sent in an `Accept` message to identify the object being accepted.
+#
+# In a network where each vat has a public/private key pair, this could simply be the public key
+# fingerprint of the provider vat along with the question ID used in the `Provide` message sent from
+# that provider.
+
+using RecipientId = AnyPointer;
+# **(level 3)**
+#
+# The information that must be sent in a `Provide` message to identify the recipient of the
+# capability.
+#
+# In a network where each vat has a public/private key pair, this could simply be the public key
+# fingerprint of the recipient. (CapTP also calls for a nonce to identify the object. In our
+# case, the `Provide` message's `questionId` can serve as the nonce.)
+
+using ThirdPartyCapId = AnyPointer;
+# **(level 3)**
+#
+# The information needed to connect to a third party and accept a capability from it.
+#
+# In a network where each vat has a public/private key pair, this could be a combination of the
+# third party's public key fingerprint, hints on how to connect to the third party (e.g. an IP
+# address), and the question ID used in the corresponding `Provide` message sent to that third party
+# (used to identify which capability to pick up).
+
+using JoinKeyPart = AnyPointer;
+# **(level 4)**
+#
+# A piece of a secret key. One piece is sent along each path that is expected to lead to the same
+# place. Once the pieces are combined, a direct connection may be formed between the sender and
+# the receiver, bypassing any men-in-the-middle along the paths. See the `Join` message type.
+#
+# The motivation for Joins is discussed under "Supporting Equality" in the "Unibus" protocol
+# sketch: http://www.erights.org/elib/distrib/captp/unibus.html
+#
+# In a network where each vat has a public/private key pair and each vat forms no more than one
+# connection to each other vat, Joins will rarely -- perhaps never -- be needed, as objects never
+# need to be transparently proxied and references to the same object sent over the same connection
+# have the same export ID. Thus, a successful join requires only checking that the two objects
+# come from the same connection and have the same ID, and then completes immediately.
+#
+# However, in networks where two vats may form more than one connection between each other, or
+# where proxying of objects occurs, joins are necessary.
+#
+# Typically, each JoinKeyPart would include a fixed-length data value such that all value parts
+# XOR'd together forms a shared secret that can be used to form an encrypted connection between
+# the joiner and the joined object's host. Each JoinKeyPart should also include an indication of
+# how many parts to expect and a hash of the shared secret (used to match up parts).
+
+using JoinResult = AnyPointer;
+# **(level 4)**
+#
+# Information returned as the result to a `Join` message, needed by the joiner in order to form a
+# direct connection to a joined object. This might simply be the address of the joined object's
+# host vat, since the `JoinKey` has already been communicated so the two vats already have a shared
+# secret to use to authenticate each other.
+#
+# The `JoinResult` should also contain information that can be used to detect when the Join
+# requests ended up reaching different objects, so that this situation can be detected easily.
+# This could be a simple matter of including a sequence number -- if the joiner receives two
+# `JoinResult`s with sequence number 0, then they must have come from different objects and the
+# whole join is a failure.
+
+# ========================================================================================
+# Network interface sketch
+#
+# The interfaces below are meant to be pseudo-code to illustrate how the details of a particular
+# vat network might be abstracted away. They are written like Cap'n Proto interfaces, but in
+# practice you'd probably define these interfaces manually in the target programming language. A
+# Cap'n Proto RPC implementation should be able to use these interfaces without knowing the
+# definitions of the various network-specific parameters defined above.
+
+# interface VatNetwork {
+# # Represents a vat network, with the ability to connect to particular vats and receive
+# # connections from vats.
+# #
+# # Note that methods returning a `Connection` may return a pre-existing `Connection`, and the
+# # caller is expected to find and share state with existing users of the connection.
+#
+# # Level 0 features -----------------------------------------------
+#
+# connect(vatId :VatId) :Connection;
+# # Connect to the given vat. The transport should return a promise that does not
+# # resolve until authentication has completed, but allows messages to be pipelined in before
+# # that; the transport either queues these messages until authenticated, or sends them encrypted
+# # such that only the authentic vat would be able to decrypt them. The latter approach avoids a
+# # round trip for authentication.
+#
+# accept() :Connection;
+# # Wait for the next incoming connection and return it. Only connections formed by
+# # connect() are returned by this method.
+#
+# # Level 4 features -----------------------------------------------
+#
+# newJoiner(count :UInt32) :NewJoinerResponse;
+# # Prepare a new Join operation, which will eventually lead to forming a new direct connection
+# # to the host of the joined capability. `count` is the number of capabilities to join.
+#
+# struct NewJoinerResponse {
+# joinKeyParts :List(JoinKeyPart);
+# # Key parts to send in Join messages to each capability.
+#
+# joiner :Joiner;
+# # Used to establish the final connection.
+# }
+#
+# interface Joiner {
+# addJoinResult(result :JoinResult) :Void;
+# # Add a JoinResult received in response to one of the `Join` messages. All `JoinResult`s
+# # returned from all paths must be added before trying to connect.
+#
+# connect() :ConnectionAndProvisionId;
+# # Try to form a connection to the joined capability's host, verifying that it has received
+# # all of the JoinKeyParts. Once the connection is formed, the caller should send an `Accept`
+# # message on it with the specified `ProvisionId` in order to receive the final capability.
+# }
+#
+# acceptConnectionFromJoiner(parts :List(JoinKeyPart), paths :List(VatPath))
+# :ConnectionAndProvisionId;
+# # Called on a joined capability's host to receive the connection from the joiner, once all
+# # key parts have arrived. The caller should expect to receive an `Accept` message over the
+# # connection with the given ProvisionId.
+# }
+#
+# interface Connection {
+# # Level 0 features -----------------------------------------------
+#
+# send(message :Message) :Void;
+# # Send the message. Returns successfully when the message (and all preceding messages) has
+# # been acknowledged by the recipient.
+#
+# receive() :Message;
+# # Receive the next message, and acknowledges receipt to the sender. Messages are received in
+# # the order in which they are sent.
+#
+# # Level 3 features -----------------------------------------------
+#
+# introduceTo(recipient :Connection) :IntroductionInfo;
+# # Call before starting a three-way introduction, assuming a `Provide` message is to be sent on
+# # this connection and a `ThirdPartyCapId` is to be sent to `recipient`.
+#
+# struct IntroductionInfo {
+# sendToRecipient :ThirdPartyCapId;
+# sendToTarget :RecipientId;
+# }
+#
+# connectToIntroduced(capId :ThirdPartyCapId) :ConnectionAndProvisionId;
+# # Given a ThirdPartyCapId received over this connection, connect to the third party. The
+# # caller should then send an `Accept` message over the new connection.
+#
+# acceptIntroducedConnection(recipientId :RecipientId) :Connection;
+# # Given a RecipientId received in a `Provide` message on this `Connection`, wait for the
+# # recipient to connect, and return the connection formed. Usually, the first message received
+# # on the new connection will be an `Accept` message.
+# }
+#
+# struct ConnectionAndProvisionId {
+# # **(level 3)**
+#
+# connection :Connection;
+# # Connection on which to issue `Accept` message.
+#
+# provision :ProvisionId;
+# # `ProvisionId` to send in the `Accept` message.
+# }
diff --git a/core-schema/capnp/schema.capnp b/core-schema/capnp/schema.capnp
new file mode 100644
--- /dev/null
+++ b/core-schema/capnp/schema.capnp
@@ -0,0 +1,498 @@
+# Copyright (c) 2013-2014 Sandstorm Development Group, Inc. and contributors
+# Licensed under the MIT License:
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+using Cxx = import "/capnp/c++.capnp";
+
+@0xa93fc509624c72d9;
+$Cxx.namespace("capnp::schema");
+
+using Id = UInt64;
+# The globally-unique ID of a file, type, or annotation.
+
+struct Node {
+ id @0 :Id;
+
+ displayName @1 :Text;
+ # Name to present to humans to identify this Node. You should not attempt to parse this. Its
+ # format could change. It is not guaranteed to be unique.
+ #
+ # (On Zooko's triangle, this is the node's nickname.)
+
+ displayNamePrefixLength @2 :UInt32;
+ # If you want a shorter version of `displayName` (just naming this node, without its surrounding
+ # scope), chop off this many characters from the beginning of `displayName`.
+
+ scopeId @3 :Id;
+ # ID of the lexical parent node. Typically, the scope node will have a NestedNode pointing back
+ # at this node, but robust code should avoid relying on this (and, in fact, group nodes are not
+ # listed in the outer struct's nestedNodes, since they are listed in the fields). `scopeId` is
+ # zero if the node has no parent, which is normally only the case with files, but should be
+ # allowed for any kind of node (in order to make runtime type generation easier).
+
+ parameters @32 :List(Parameter);
+ # If this node is parameterized (generic), the list of parameters. Empty for non-generic types.
+
+ isGeneric @33 :Bool;
+ # True if this node is generic, meaning that it or one of its parent scopes has a non-empty
+ # `parameters`.
+
+ struct Parameter {
+ # Information about one of the node's parameters.
+
+ name @0 :Text;
+ }
+
+ nestedNodes @4 :List(NestedNode);
+ # List of nodes nested within this node, along with the names under which they were declared.
+
+ struct NestedNode {
+ name @0 :Text;
+ # Unqualified symbol name. Unlike Node.displayName, this *can* be used programmatically.
+ #
+ # (On Zooko's triangle, this is the node's petname according to its parent scope.)
+
+ id @1 :Id;
+ # ID of the nested node. Typically, the target node's scopeId points back to this node, but
+ # robust code should avoid relying on this.
+ }
+
+ annotations @5 :List(Annotation);
+ # Annotations applied to this node.
+
+ union {
+ # Info specific to each kind of node.
+
+ file @6 :Void;
+
+ struct :group {
+ dataWordCount @7 :UInt16;
+ # Size of the data section, in words.
+
+ pointerCount @8 :UInt16;
+ # Size of the pointer section, in pointers (which are one word each).
+
+ preferredListEncoding @9 :ElementSize;
+ # The preferred element size to use when encoding a list of this struct. If this is anything
+ # other than `inlineComposite` then the struct is one word or less in size and is a candidate
+ # for list packing optimization.
+
+ isGroup @10 :Bool;
+ # If true, then this "struct" node is actually not an independent node, but merely represents
+ # some named union or group within a particular parent struct. This node's scopeId refers
+ # to the parent struct, which may itself be a union/group in yet another struct.
+ #
+ # All group nodes share the same dataWordCount and pointerCount as the top-level
+ # struct, and their fields live in the same ordinal and offset spaces as all other fields in
+ # the struct.
+ #
+ # Note that a named union is considered a special kind of group -- in fact, a named union
+ # is exactly equivalent to a group that contains nothing but an unnamed union.
+
+ discriminantCount @11 :UInt16;
+ # Number of fields in this struct which are members of an anonymous union, and thus may
+ # overlap. If this is non-zero, then a 16-bit discriminant is present indicating which
+ # of the overlapping fields is active. This can never be 1 -- if it is non-zero, it must be
+ # two or more.
+ #
+ # Note that the fields of an unnamed union are considered fields of the scope containing the
+ # union -- an unnamed union is not its own group. So, a top-level struct may contain a
+ # non-zero discriminant count. Named unions, on the other hand, are equivalent to groups
+ # containing unnamed unions. So, a named union has its own independent schema node, with
+ # `isGroup` = true.
+
+ discriminantOffset @12 :UInt32;
+ # If `discriminantCount` is non-zero, this is the offset of the union discriminant, in
+ # multiples of 16 bits.
+
+ fields @13 :List(Field);
+ # Fields defined within this scope (either the struct's top-level fields, or the fields of
+ # a particular group; see `isGroup`).
+ #
+ # The fields are sorted by ordinal number, but note that because groups share the same
+ # ordinal space, the field's index in this list is not necessarily exactly its ordinal.
+ # On the other hand, the field's position in this list does remain the same even as the
+ # protocol evolves, since it is not possible to insert or remove an earlier ordinal.
+ # Therefore, for most use cases, if you want to identify a field by number, it may make the
+ # most sense to use the field's index in this list rather than its ordinal.
+ }
+
+ enum :group {
+ enumerants@14 :List(Enumerant);
+ # Enumerants ordered by numeric value (ordinal).
+ }
+
+ interface :group {
+ methods @15 :List(Method);
+ # Methods ordered by ordinal.
+
+ superclasses @31 :List(Superclass);
+ # Superclasses of this interface.
+ }
+
+ const :group {
+ type @16 :Type;
+ value @17 :Value;
+ }
+
+ annotation :group {
+ type @18 :Type;
+
+ targetsFile @19 :Bool;
+ targetsConst @20 :Bool;
+ targetsEnum @21 :Bool;
+ targetsEnumerant @22 :Bool;
+ targetsStruct @23 :Bool;
+ targetsField @24 :Bool;
+ targetsUnion @25 :Bool;
+ targetsGroup @26 :Bool;
+ targetsInterface @27 :Bool;
+ targetsMethod @28 :Bool;
+ targetsParam @29 :Bool;
+ targetsAnnotation @30 :Bool;
+ }
+ }
+}
+
+struct Field {
+ # Schema for a field of a struct.
+
+ name @0 :Text;
+
+ codeOrder @1 :UInt16;
+ # Indicates where this member appeared in the code, relative to other members.
+ # Code ordering may have semantic relevance -- programmers tend to place related fields
+ # together. So, using code ordering makes sense in human-readable formats where ordering is
+ # otherwise irrelevant, like JSON. The values of codeOrder are tightly-packed, so the maximum
+ # value is count(members) - 1. Fields that are members of a union are only ordered relative to
+ # the other members of that union, so the maximum value there is count(union.members).
+
+ annotations @2 :List(Annotation);
+
+ const noDiscriminant :UInt16 = 0xffff;
+
+ discriminantValue @3 :UInt16 = Field.noDiscriminant;
+ # If the field is in a union, this is the value which the union's discriminant should take when
+ # the field is active. If the field is not in a union, this is 0xffff.
+
+ union {
+ slot :group {
+ # A regular, non-group, non-fixed-list field.
+
+ offset @4 :UInt32;
+ # Offset, in units of the field's size, from the beginning of the section in which the field
+ # resides. E.g. for a UInt32 field, multiply this by 4 to get the byte offset from the
+ # beginning of the data section.
+
+ type @5 :Type;
+ defaultValue @6 :Value;
+
+ hadExplicitDefault @10 :Bool;
+ # Whether the default value was specified explicitly. Non-explicit default values are always
+ # zero or empty values. Usually, whether the default value was explicit shouldn't matter.
+ # The main use case for this flag is for structs representing method parameters:
+ # explicitly-defaulted parameters may be allowed to be omitted when calling the method.
+ }
+
+ group :group {
+ # A group.
+
+ typeId @7 :Id;
+ # The ID of the group's node.
+ }
+ }
+
+ ordinal :union {
+ implicit @8 :Void;
+ explicit @9 :UInt16;
+ # The original ordinal number given to the field. You probably should NOT use this; if you need
+ # a numeric identifier for a field, use its position within the field array for its scope.
+ # The ordinal is given here mainly just so that the original schema text can be reproduced given
+ # the compiled version -- i.e. so that `capnp compile -ocapnp` can do its job.
+ }
+}
+
+struct Enumerant {
+ # Schema for member of an enum.
+
+ name @0 :Text;
+
+ codeOrder @1 :UInt16;
+ # Specifies order in which the enumerants were declared in the code.
+ # Like Struct.Field.codeOrder.
+
+ annotations @2 :List(Annotation);
+}
+
+struct Superclass {
+ id @0 :Id;
+ brand @1 :Brand;
+}
+
+struct Method {
+ # Schema for method of an interface.
+
+ name @0 :Text;
+
+ codeOrder @1 :UInt16;
+ # Specifies order in which the methods were declared in the code.
+ # Like Struct.Field.codeOrder.
+
+ implicitParameters @7 :List(Node.Parameter);
+ # The parameters listed in [] (typically, type / generic parameters), whose bindings are intended
+ # to be inferred rather than specified explicitly, although not all languages support this.
+
+ paramStructType @2 :Id;
+ # ID of the parameter struct type. If a named parameter list was specified in the method
+ # declaration (rather than a single struct parameter type) then a corresponding struct type is
+ # auto-generated. Such an auto-generated type will not be listed in the interface's
+ # `nestedNodes` and its `scopeId` will be zero -- it is completely detached from the namespace.
+ # (Awkwardly, it does of course inherit generic parameters from the method's scope, which makes
+ # this a situation where you can't just climb the scope chain to find where a particular
+ # generic parameter was introduced. Making the `scopeId` zero was a mistake.)
+
+ paramBrand @5 :Brand;
+ # Brand of param struct type.
+
+ resultStructType @3 :Id;
+ # ID of the return struct type; similar to `paramStructType`.
+
+ resultBrand @6 :Brand;
+ # Brand of result struct type.
+
+ annotations @4 :List(Annotation);
+}
+
+struct Type {
+ # Represents a type expression.
+
+ union {
+ # The ordinals intentionally match those of Value.
+
+ void @0 :Void;
+ bool @1 :Void;
+ int8 @2 :Void;
+ int16 @3 :Void;
+ int32 @4 :Void;
+ int64 @5 :Void;
+ uint8 @6 :Void;
+ uint16 @7 :Void;
+ uint32 @8 :Void;
+ uint64 @9 :Void;
+ float32 @10 :Void;
+ float64 @11 :Void;
+ text @12 :Void;
+ data @13 :Void;
+
+ list :group {
+ elementType @14 :Type;
+ }
+
+ enum :group {
+ typeId @15 :Id;
+ brand @21 :Brand;
+ }
+ struct :group {
+ typeId @16 :Id;
+ brand @22 :Brand;
+ }
+ interface :group {
+ typeId @17 :Id;
+ brand @23 :Brand;
+ }
+
+ anyPointer :union {
+ unconstrained :union {
+ # A regular AnyPointer.
+ #
+ # The name "unconstrained" means as opposed to constraining it to match a type parameter.
+ # In retrospect this name is probably a poor choice given that it may still be constrained
+ # to be a struct, list, or capability.
+
+ anyKind @18 :Void; # truly AnyPointer
+ struct @25 :Void; # AnyStruct
+ list @26 :Void; # AnyList
+ capability @27 :Void; # Capability
+ }
+
+ parameter :group {
+ # This is actually a reference to a type parameter defined within this scope.
+
+ scopeId @19 :Id;
+ # ID of the generic type whose parameter we're referencing. This should be a parent of the
+ # current scope.
+
+ parameterIndex @20 :UInt16;
+ # Index of the parameter within the generic type's parameter list.
+ }
+
+ implicitMethodParameter :group {
+ # This is actually a reference to an implicit (generic) parameter of a method. The only
+ # legal context for this type to appear is inside Method.paramBrand or Method.resultBrand.
+
+ parameterIndex @24 :UInt16;
+ }
+ }
+ }
+}
+
+struct Brand {
+ # Specifies bindings for parameters of generics. Since these bindings turn a generic into a
+ # non-generic, we call it the "brand".
+
+ scopes @0 :List(Scope);
+ # For each of the target type and each of its parent scopes, a parameterization may be included
+ # in this list. If no parameterization is included for a particular relevant scope, then either
+ # that scope has no parameters or all parameters should be considered to be `AnyPointer`.
+
+ struct Scope {
+ scopeId @0 :Id;
+ # ID of the scope to which these params apply.
+
+ union {
+ bind @1 :List(Binding);
+ # List of parameter bindings.
+
+ inherit @2 :Void;
+ # The place where this Brand appears is actually within this scope or a sub-scope,
+ # and the bindings for this scope should be inherited from the reference point.
+ }
+ }
+
+ struct Binding {
+ union {
+ unbound @0 :Void;
+ type @1 :Type;
+
+ # TODO(someday): Allow non-type parameters? Unsure if useful.
+ }
+ }
+}
+
+struct Value {
+ # Represents a value, e.g. a field default value, constant value, or annotation value.
+
+ union {
+ # The ordinals intentionally match those of Type.
+
+ void @0 :Void;
+ bool @1 :Bool;
+ int8 @2 :Int8;
+ int16 @3 :Int16;
+ int32 @4 :Int32;
+ int64 @5 :Int64;
+ uint8 @6 :UInt8;
+ uint16 @7 :UInt16;
+ uint32 @8 :UInt32;
+ uint64 @9 :UInt64;
+ float32 @10 :Float32;
+ float64 @11 :Float64;
+ text @12 :Text;
+ data @13 :Data;
+
+ list @14 :AnyPointer;
+
+ enum @15 :UInt16;
+ struct @16 :AnyPointer;
+
+ interface @17 :Void;
+ # The only interface value that can be represented statically is "null", whose methods always
+ # throw exceptions.
+
+ anyPointer @18 :AnyPointer;
+ }
+}
+
+struct Annotation {
+ # Describes an annotation applied to a declaration. Note AnnotationNode describes the
+ # annotation's declaration, while this describes a use of the annotation.
+
+ id @0 :Id;
+ # ID of the annotation node.
+
+ brand @2 :Brand;
+ # Brand of the annotation.
+ #
+ # Note that the annotation itself is not allowed to be parameterized, but its scope might be.
+
+ value @1 :Value;
+}
+
+enum ElementSize {
+ # Possible element sizes for encoded lists. These correspond exactly to the possible values of
+ # the 3-bit element size component of a list pointer.
+
+ empty @0; # aka "void", but that's a keyword.
+ bit @1;
+ byte @2;
+ twoBytes @3;
+ fourBytes @4;
+ eightBytes @5;
+ pointer @6;
+ inlineComposite @7;
+}
+
+struct CapnpVersion {
+ major @0 :UInt16;
+ minor @1 :UInt8;
+ micro @2 :UInt8;
+}
+
+struct CodeGeneratorRequest {
+ capnpVersion @2 :CapnpVersion;
+ # Version of the `capnp` executable. Generally, code generators should ignore this, but the code
+ # generators that ship with `capnp` itself will print a warning if this mismatches since that
+ # probably indicates something is misconfigured.
+ #
+ # The first version of 'capnp' to set this was 0.6.0. So, if it's missing, the compiler version
+ # is older than that.
+
+ nodes @0 :List(Node);
+ # All nodes parsed by the compiler, including for the files on the command line and their
+ # imports.
+
+ requestedFiles @1 :List(RequestedFile);
+ # Files which were listed on the command line.
+
+ struct RequestedFile {
+ id @0 :Id;
+ # ID of the file.
+
+ filename @1 :Text;
+ # Name of the file as it appeared on the command-line (minus the src-prefix). You may use
+ # this to decide where to write the output.
+
+ imports @2 :List(Import);
+ # List of all imported paths seen in this file.
+
+ struct Import {
+ id @0 :Id;
+ # ID of the imported file.
+
+ name @1 :Text;
+ # Name which *this* file used to refer to the foreign file. This may be a relative name.
+ # This information is provided because it might be useful for code generation, e.g. to
+ # generate #include directives in C++. We don't put this in Node.file because this
+ # information is only meaningful at compile time anyway.
+ #
+ # (On Zooko's triangle, this is the import's petname according to the importing file.)
+ }
+ }
+}
diff --git a/exe/capnpc-haskell/Backends/Common.hs b/exe/capnpc-haskell/Backends/Common.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/Backends/Common.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module: Backends.Common
+Description: Bits of code generation common to both backends.
+-}
+module Backends.Common where
+
+import Data.Monoid ((<>))
+import Data.String (IsString(..))
+
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+import IR
+
+-- | Format a primitive word type.
+fmtPrimWord :: PrimWord -> PP.Doc
+fmtPrimWord PrimInt{isSigned=True,size} = "Int" <> fromString (show size)
+fmtPrimWord PrimInt{isSigned=False,size} = "Word" <> fromString (show size)
+fmtPrimWord PrimFloat32 = "Float"
+fmtPrimWord PrimFloat64 = "Double"
+fmtPrimWord PrimBool = "Bool"
+
+-- | Return the size in bits of a type that belongs in the data section of a struct.
+dataFieldSize :: WordType -> Int
+dataFieldSize fieldType = case fieldType of
+ EnumType _ -> 16
+ PrimWord PrimInt{..} -> size
+ PrimWord PrimFloat32 -> 32
+ PrimWord PrimFloat64 -> 64
+ PrimWord PrimBool -> 1
diff --git a/exe/capnpc-haskell/Backends/Pure.hs b/exe/capnpc-haskell/Backends/Pure.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/Backends/Pure.hs
@@ -0,0 +1,363 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+-- Generate idiomatic haskell data types from the types in IR.
+module Backends.Pure
+ ( fmtModule
+ ) where
+
+import Data.Monoid ((<>))
+import Data.String (IsString(..))
+import GHC.Exts (IsList(..))
+import Text.PrettyPrint.Leijen.Text (hcat, vcat)
+import Text.Printf (printf)
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+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)?
+data ModRefType = Pure | Raw
+ deriving(Show, Read, Eq)
+
+fmtName :: ModRefType -> Id -> Name -> PP.Doc
+fmtName refTy thisMod Name{..} = modPrefix <> localName
+ where
+ localName = mintercalate "'" $
+ map PP.textStrict $ fromList $ toList nameLocalNS ++ [nameUnqualified]
+ modPrefix
+ | null nsParts = ""
+ | refTy == Pure && modRefToNS refTy (ByCapnpId thisMod) == ns = ""
+ | otherwise = fmtModRef refTy nameModule <> "."
+ ns@(Namespace nsParts) = modRefToNS refTy nameModule
+
+modRefToNS :: ModRefType -> ModuleRef -> Namespace
+modRefToNS _ (FullyQualified ns) = ns
+modRefToNS ty (ByCapnpId id) = Namespace $ case ty of
+ Pure -> ["Capnp", "ById", T.pack (printf "X%x" id), "Pure"]
+ Raw -> ["Capnp", "ById", T.pack (printf "X%x" id)]
+
+
+fmtModule :: Module -> [(FilePath, PP.Doc)]
+fmtModule mod@Module{modName=Namespace modNameParts,..} =
+ [ ( T.unpack $ mintercalate "/" humanParts <> ".hs"
+ , mainContent
+ )
+ , ( printf "Capnp/ById/X%x/Pure.hs" modId
+ , vcat
+ [ "{-# OPTIONS_GHC -Wno-unused-imports #-}"
+ , "{- |"
+ , hcat [ "Module: ", machineMod ]
+ , hcat [ "Description: Machine-addressable alias for '", humanMod, "'." ]
+ , "-}"
+ , hcat [ "module ", machineMod, "(module ", humanMod, ") where" ]
+ , ""
+ , hcat [ "import ", humanMod ]
+ ]
+ )
+ ]
+ where
+ machineMod = fmtModRef Pure (ByCapnpId modId)
+ humanMod = fmtModRef Pure $ FullyQualified $ Namespace humanParts
+ humanParts = "Capnp":modNameParts ++ ["Pure"]
+ modFileText = PP.textStrict modFile
+ mainContent = vcat
+ [ "{-# LANGUAGE DuplicateRecordFields #-}"
+ , "{-# LANGUAGE RecordWildCards #-}"
+ , "{-# LANGUAGE FlexibleInstances #-}"
+ , "{-# LANGUAGE FlexibleContexts #-}"
+ , "{-# LANGUAGE MultiParamTypeClasses #-}"
+ , "{-# LANGUAGE ScopedTypeVariables #-}"
+ , "{-# LANGUAGE TypeFamilies #-}"
+ , "{-# LANGUAGE DeriveGeneric #-}"
+ , "{-# OPTIONS_GHC -Wno-unused-imports #-}"
+ , "{- |"
+ , "Module: " <> humanMod
+ , "Description: " <> "High-level generated module for " <> modFileText
+ , ""
+ , "This module is the generated code for " <> modFileText <> ","
+ , "for the high-level api."
+ , "-}"
+ , "module " <> humanMod <> " (" <> fmtExportList mod, ") where"
+ , ""
+ , "-- Code generated by capnpc-haskell. DO NOT EDIT."
+ , "-- Generated from schema file: " <> modFileText
+ , ""
+ , "import Data.Int"
+ , "import Data.Word"
+ , ""
+ , "import Data.Default (Default(def))"
+ , "import GHC.Generics (Generic)"
+ , ""
+ , "import Data.Capnp.Basics.Pure (Data, Text)"
+ , "import Control.Monad.Catch (MonadThrow)"
+ , "import Data.Capnp.TraversalLimit (MonadLimit)"
+ , ""
+ , "import Control.Monad (forM_)"
+ , ""
+ , "import qualified Data.Capnp.Message as M'"
+ , "import qualified Data.Capnp.Untyped as U'"
+ , "import qualified Data.Capnp.Untyped.Pure as PU'"
+ , "import qualified Data.Capnp.GenHelpers.Pure as PH'"
+ , "import qualified Data.Capnp.Classes as C'"
+ , ""
+ , "import qualified Data.Vector as V"
+ , "import qualified Data.ByteString as BS"
+ , ""
+ , fmtImport Raw $ Import (ByCapnpId modId)
+ , vcat $ map (fmtImport Pure) modImports
+ , vcat $ map (fmtImport Raw) modImports
+ , ""
+ , vcat $ map (fmtDecl modId) (M.toList modDecls)
+ ]
+
+fmtExportList :: Module -> PP.Doc
+fmtExportList Module{modId,modDecls} =
+ 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)
+
+fmtImport :: ModRefType -> Import -> PP.Doc
+fmtImport ty (Import ref) = "import qualified " <> fmtModRef ty ref
+
+fmtModRef :: ModRefType -> ModuleRef -> PP.Doc
+fmtModRef ty ref = mintercalate "." (map PP.textStrict $ toList $ modRefToNS ty ref)
+
+fmtType :: Id -> Type -> PP.Doc
+fmtType thisMod (CompositeType (StructType name params)) =
+ fmtName Pure thisMod name
+ <> hcat [" (" <> fmtType thisMod ty <> ")" | ty <- params]
+fmtType thisMod (WordType (EnumType name)) = fmtName Raw thisMod name
+fmtType thisMod (PtrType (ListOf eltType)) = "PU'.ListOf (" <> fmtType thisMod eltType <> ")"
+fmtType thisMod (PtrType (PtrComposite ty)) = fmtType thisMod (CompositeType ty)
+fmtType _ VoidType = "()"
+fmtType _ (WordType (PrimWord prim)) = fmtPrimWord prim
+fmtType _ (PtrType (PrimPtr PrimText)) = "Text"
+fmtType _ (PtrType (PrimPtr PrimData)) = "Data"
+fmtType _ (PtrType (PrimPtr (PrimAnyPtr ty))) = "Maybe (" <> fmtAnyPtr ty <> ")"
+
+fmtPrimWord :: PrimWord -> PP.Doc
+fmtPrimWord PrimInt{isSigned=True,size} = "Int" <> fromString (show size)
+fmtPrimWord PrimInt{isSigned=False,size} = "Word" <> fromString (show size)
+fmtPrimWord PrimFloat32 = "Float"
+fmtPrimWord PrimFloat64 = "Double"
+fmtPrimWord PrimBool = "Bool"
+
+fmtAnyPtr :: AnyPtr -> PP.Doc
+fmtAnyPtr Struct = "PU'.Struct"
+fmtAnyPtr List = "PU'.List"
+fmtAnyPtr Cap = "PU'.Cap"
+fmtAnyPtr Ptr = "PU'.PtrType"
+
+fmtVariant :: Id -> Variant -> PP.Doc
+fmtVariant thisMod Variant{variantName,variantParams} =
+ fmtName Pure thisMod variantName
+ <> case variantParams of
+ Unnamed VoidType _ -> ""
+ Unnamed ty _ -> " (" <> fmtType thisMod ty <> ")"
+ Record [] -> ""
+ Record fields -> PP.line <> indent
+ (PP.braces $ vcat $
+ PP.punctuate "," $ map (fmtField thisMod) fields)
+
+fmtField :: Id -> Field -> PP.Doc
+fmtField thisMod Field{fieldName,fieldLocType} =
+ PP.textStrict fieldName <> " :: " <> fmtType thisMod fieldType
+ where
+ fieldType = case fieldLocType of
+ VoidField -> VoidType
+ DataField _ ty -> WordType ty
+ PtrField _ ty -> PtrType ty
+ HereField ty -> CompositeType ty
+
+fmtDecl :: Id -> (Name, Decl) -> PP.Doc
+fmtDecl thisMod (name, DeclDef d) = fmtDataDef thisMod name d
+fmtDecl thisMod (name, DeclConst c) = fmtConst thisMod name c
+
+-- | Format a constant declaration.
+fmtConst :: Id -> Name -> Const -> PP.Doc
+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
+ ]
+ , hcat [ pureName, " = ", rawName ]
+ ]
+
+fmtDataDef :: Id -> Name -> DataDef -> PP.Doc
+fmtDataDef thisMod dataName DataDef{dataCerialType=CTyEnum} =
+ -- We end up re-exporting these, but doing nothing else.
+ ""
+fmtDataDef thisMod dataName DataDef{dataVariants} =
+ let rawName = fmtName Raw thisMod dataName
+ pureName = fmtName Pure thisMod dataName
+ 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)
+ ]
+ ]
+ , hcat [ "instance C'.FromStruct M'.ConstMsg ", pureName, " where" ]
+ , indent $ vcat
+ [ "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
+ [ "def = PH'.defaultStruct"
+ ]
+ ]
+ where
+ fmtDecerializeArgs variantName fields = vcat
+ [ hcat [ fmtName Pure thisMod variantName, " <$>" ]
+ , indent $ vcat $ PP.punctuate " <*>" $
+ flip map fields $ \Field{fieldName,fieldLocType} -> hcat
+ [ "(", fmtName Raw thisMod $ prefixName "get_" (subName variantName fieldName)
+ , " raw", case fieldLocType of
+ -- Data and void fields are always the same type in Raw and Pure forms,
+ -- so we don't need to convert them.
+ DataField _ _ -> ""
+ VoidField -> ""
+ _ -> " >>= C'.decerialize"
+ , ")"
+ ]
+ ]
+ fmtDecerializeVariant Variant{variantName,variantParams} =
+ fmtName Raw thisMod variantName <>
+ case variantParams of
+ Unnamed VoidType _ -> " -> pure " <> fmtName Pure thisMod variantName
+ Record fields ->
+ " raw -> " <> fmtDecerializeArgs variantName fields
+ Unnamed (WordType _) _ -> hcat
+ [ " val -> pure (", fmtName Pure thisMod variantName, " val)" ]
+ _ -> hcat
+ [ " val -> ", fmtName Pure thisMod variantName, " <$> C'.decerialize val" ]
+ fmtCerializeVariant isUnion Variant{variantName, variantParams} =
+ fmtName Pure thisMod variantName <>
+ let accessorName prefix = fmtName Raw thisMod (prefixName prefix variantName)
+ setterName = accessorName "set_"
+ in case variantParams of
+ Unnamed VoidType VoidField ->
+ hcat [ " -> ", setterName, " raw" ]
+ Unnamed _ (DataField _ _) ->
+ hcat [ " arg_ -> ", setterName, " raw arg_"]
+ Unnamed (WordType _) VoidField ->
+ -- TODO: this is the unknown variant. We should find a better
+ -- way to represent this; the structure of the IR here is sloppy
+ -- work.
+ hcat [ " arg_ -> ", setterName, " raw arg_" ]
+ Unnamed _ fieldLocType -> vcat
+ [ " arg_ -> do"
+ , indent (fmtUseAccessors accessorName "arg_" fieldLocType)
+ ]
+ Record fields -> vcat
+ [ "{..} -> do"
+ , indent $ vcat
+ [ if isUnion
+ then "raw <- " <> setterName <> " raw"
+ else ""
+ , vcat (map (fmtCerializeField variantName) fields)
+ ]
+ ]
+ fmtCerializeField variantName Field{fieldName,fieldLocType} =
+ let accessorName prefix = fmtName Raw thisMod $ prefixName prefix (subName variantName fieldName)
+ in fmtUseAccessors accessorName fieldName fieldLocType
+ fmtUseAccessors accessorName fieldVarName fieldLocType =
+ let setterName = accessorName "set_"
+ getterName = accessorName "get_"
+ newName = accessorName "new_"
+ fieldNameText = PP.textStrict fieldVarName
+ in case fieldLocType of
+ DataField _ _ -> hcat [ setterName, " raw ", fieldNameText ]
+ VoidField -> hcat [ setterName, " raw" ]
+ HereField _ -> vcat
+ [ hcat [ "field_ <- ", getterName, " raw" ]
+ , hcat [ "C'.marshalInto field_ ", fieldNameText ]
+ ]
+ PtrField _ ty -> case ty of
+ PrimPtr PrimData -> vcat
+ [ hcat [ "field_ <- ", newName, " (BS.length ", fieldNameText, ") raw" ]
+ , hcat [ "C'.marshalInto field_ ", fieldNameText ]
+ ]
+ PrimPtr PrimText -> vcat
+ [ hcat [ "field_ <- C'.cerialize (U'.message raw) ", fieldNameText ]
+ , hcat [ setterName, " raw field_" ]
+ ]
+ PrimPtr (PrimAnyPtr _) -> vcat
+ [ hcat [ "field_ <- C'.cerialize (U'.message raw) ", fieldNameText ]
+ , hcat [ setterName, " raw field_" ]
+ ]
+ ListOf eltType -> vcat
+ [ hcat [ "let len_ = V.length ", fieldNameText ]
+ , hcat [ "field_ <- ", newName, " len_ raw" ]
+ , case eltType of
+ VoidType ->
+ ""
+ CompositeType (StructType _ _) -> vcat
+ [ "forM_ [0..len_ - 1] $ \\i -> do"
+ , indent $ vcat
+ [ "elt <- C'.index i field_"
+ , hcat [ "C'.marshalInto elt (", fieldNameText, " V.! i)" ]
+ ]
+ ]
+ WordType _ -> vcat
+ [ "forM_ [0..len_ - 1] $ \\i -> do"
+ , indent $ vcat
+ [ hcat [ "C'.setIndex (", fieldNameText, " V.! i) i field_" ] ]
+ ]
+ PtrType _ ->
+ "pure ()" -- TODO
+ ]
+ PtrComposite _ -> vcat
+ [ hcat [ "field_ <- ", newName, " raw" ]
+ , hcat [ "C'.marshalInto field_ ", fieldNameText ]
+ ]
diff --git a/exe/capnpc-haskell/Backends/Raw.hs b/exe/capnpc-haskell/Backends/Raw.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/Backends/Raw.hs
@@ -0,0 +1,654 @@
+-- Generate low-level accessors from type types in IR.
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Backends.Raw
+ ( fmtModule
+ ) where
+
+import Data.Word
+
+import Data.List (sortOn)
+import Data.Monoid ((<>))
+import Data.Ord (Down(..))
+import Data.String (IsString(..))
+import Text.PrettyPrint.Leijen.Text (hcat, vcat)
+import Text.Printf (printf)
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+import IR
+import Util
+
+import Backends.Common (dataFieldSize, fmtPrimWord)
+
+indent = PP.indent 4
+
+-- | Sort varaints by their tag, in decending order (with no tag at all being last).
+sortVariants = sortOn (Down . variantTag)
+
+fmtModule :: Module -> [(FilePath, PP.Doc)]
+fmtModule thisMod@Module{modName=Namespace modNameParts,..} =
+ [ ( T.unpack $ mintercalate "/" humanParts <> ".hs"
+ , mainContent
+ )
+ , ( printf "Capnp/ById/X%x.hs" modId
+ , vcat
+ [ "{-# OPTIONS_GHC -Wno-unused-imports #-}"
+ , "{- |"
+ , hcat [ "Module: ", machineMod ]
+ , hcat [ "Description: machine-addressable alias for '", humanMod, "'." ]
+ , "-}"
+ , hcat [ "module ", machineMod, " (module ", humanMod, ") where" ]
+ , hcat [ "import ", humanMod ]
+ ]
+ )
+ ] where
+ machineMod = fromString (printf "Capnp.ById.X%x" modId)
+ humanMod = fmtModRef $ FullyQualified $ Namespace humanParts
+ humanParts = "Capnp":modNameParts
+ modFileText = PP.textStrict modFile
+ mainContent = vcat
+ [ "{-# OPTIONS_GHC -Wno-unused-imports #-}"
+ , "{-# LANGUAGE FlexibleContexts #-}"
+ , "{-# LANGUAGE FlexibleInstances #-}"
+ , "{-# LANGUAGE MultiParamTypeClasses #-}"
+ , "{-# LANGUAGE TypeFamilies #-}"
+ , "{-# LANGUAGE DeriveGeneric #-}"
+ , "{- |"
+ , "Module: " <> humanMod
+ , "Description: Low-level generated module for " <> modFileText
+ , ""
+ , "This module is the generated code for " <> modFileText <> ", for the"
+ , "low-level api."
+ , "-}"
+ , "module " <> humanMod <> " where"
+ , ""
+ , "-- Code generated by capnpc-haskell. DO NOT EDIT."
+ , "-- Generated from schema file: " <> modFileText
+ , ""
+ , "import Data.Int"
+ , "import Data.Word"
+ , ""
+ , "import GHC.Generics (Generic)"
+ , ""
+ , "import Data.Capnp.Bits (Word1)"
+ , ""
+ , "import qualified Data.Bits"
+ , "import qualified Data.Maybe"
+ -- The trailing ' is to avoid possible name collisions:
+ , "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'"
+ , ""
+ , vcat $ map fmtImport modImports
+ , ""
+ , vcat $ map (fmtDecl thisMod) (M.toList modDecls)
+ ]
+
+fmtModRef :: ModuleRef -> PP.Doc
+fmtModRef (ByCapnpId id) = fromString $ printf "Capnp.ById.X%x" id
+fmtModRef (FullyQualified (Namespace ns)) = mintercalate "." (map PP.textStrict ns)
+
+fmtImport :: Import -> PP.Doc
+fmtImport (Import ref) = "import qualified " <> fmtModRef ref
+
+-- | 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
+ [ 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'.
+--
+-- parameters:
+--
+-- * 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 =
+ 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
+ [ hcat [ "fromStruct = pure . ", dataCon ]
+ ]
+
+ , hcat [ "instance C'.ToStruct msg (", typeCon, " msg) where" ]
+ , indent $ vcat
+ [ 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" ]
+ ]
+
+ , hcat [ "instance U'.MessageDefault (", typeCon, " msg) msg where" ]
+ , indent $ vcat
+ [ 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)
+ ]
+ ]
+ , 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
+ [ 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 * -> *).
+fmtRestrictedFromStruct :: PP.Doc -> PP.Doc
+fmtRestrictedFromStruct nameText = hcat
+ [ "(let {"
+ , "go :: U'.ReadCtx m msg => U'.Struct msg -> m (", nameText, " msg); "
+ , "go = C'.fromStruct"
+ , "} in go)"
+ ]
+
+-- | Generate a call to 'H'.getWordField' based on a 'DataLoc'.
+-- The first argument is an expression for the struct.
+fmtGetWordField :: PP.Doc -> DataLoc -> PP.Doc
+fmtGetWordField struct DataLoc{..} = mintercalate " "
+ [ " H'.getWordField"
+ , struct
+ , fromString (show dataIdx)
+ , fromString (show dataOff)
+ , fromString (show dataDef)
+ ]
+
+-- | @'fmtSetWordField' struct value loc@ is like 'fmtGetWordField', except that
+-- it generates a call to 'H'.setWordField'. The extra value parameter corresponds
+-- to the extra parameter in 'H'.setWordField'.
+fmtSetWordField :: PP.Doc -> PP.Doc -> DataLoc -> PP.Doc
+fmtSetWordField struct value DataLoc{..} = mintercalate " "
+ [ "H'.setWordField"
+ , struct
+ , value
+ , fromString (show dataIdx)
+ , fromString (show dataOff)
+ , fromString (show dataDef)
+ ]
+
+-- | Format the various accessors @(set_*, get_*, has_*, new_*)@ for a field.
+-- .
+-- Parameters (in order):
+-- .
+-- * @thisMod@: the module we're generating.
+-- * @typeName@: the name of the type to which the field belongs.
+-- * @variantName@: the name of the variant of @typeName@.
+-- * @field@: the field to format.
+fmtFieldAccessor :: Module -> Name -> Name -> Field -> PP.Doc
+fmtFieldAccessor thisMod typeName variantName Field{..} = vcat
+ [ fmtGetter
+ , fmtHas
+ , fmtSetter
+ , fmtNew thisMod accessorName typeCon fieldLocType
+ ]
+ where
+ accessorName prefix = fmtName thisMod $ prefixName prefix (subName variantName fieldName)
+
+ getName = accessorName "get_"
+ hasName = accessorName "has_"
+ setName = accessorName "set_"
+ newName = accessorName "new_"
+
+ typeCon = fmtName thisMod typeName
+ dataCon = typeCon <> "_newtype_"
+
+ fmtGetter =
+ let getType fieldType = typeCon <> " msg -> m " <> fmtType thisMod "msg" fieldType
+ typeAnnotation fieldType =
+ hcat [ getName, " :: U'.ReadCtx m msg => ", getType fieldType ]
+ getDef def = hcat [ getName, " (", dataCon, " struct) =", def ]
+ in case fieldLocType of
+ DataField loc ty -> vcat
+ [ typeAnnotation (WordType ty)
+ , getDef $ fmtGetWordField "struct" loc
+ ]
+ PtrField idx ty -> vcat
+ [ typeAnnotation (PtrType ty)
+ , getDef $ PP.line <> indent (vcat
+ [ hcat [ "U'.getPtr ", fromString (show idx), " struct" ]
+ , hcat [ ">>= C'.fromPtr (U'.message struct)" ]
+ ])
+ ]
+ HereField ty -> vcat
+ [ typeAnnotation (CompositeType ty)
+ , getDef " C'.fromStruct struct"
+ ]
+ VoidField -> vcat
+ [ typeAnnotation VoidType
+ , 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"
+ ]
+ ]
+ fmtSetter =
+ let setType fieldType = typeCon <> " (M'.MutMsg s) -> " <> fmtType thisMod "(M'.MutMsg s)" fieldType <> " -> m ()"
+ typeAnnotation fieldType = setName <> " :: U'.RWCtx m s => " <> setType fieldType
+ in
+ case fieldLocType of
+ DataField loc@DataLoc{..} ty -> vcat
+ [ typeAnnotation (WordType ty)
+ , hcat
+ [ setName, " (", dataCon, " struct) value = "
+ , fmtSetWordField
+ "struct"
+ ("(fromIntegral (C'.toWord value) :: Word" <> fromString (show $ dataFieldSize ty) <> ")")
+ loc
+ ]
+ ]
+ VoidField -> vcat
+ [ typeAnnotation VoidType
+ , setName <> " _ = pure ()"
+ ]
+ PtrField idx ty -> vcat
+ [ typeAnnotation (PtrType ty)
+ , hcat
+ [ setName, " (", dataCon, " struct) value = "
+ , "U'.setPtr (C'.toPtr value) ", fromString (show idx), " struct"
+ ]
+ ]
+ HereField _ ->
+ -- We don't generate setters for these fields; instead, the
+ -- user should call the getter and then modify the child in-place.
+ ""
+
+-- | format a @new_*@ function for a field.
+-- .
+-- Parameters (in order):
+-- .
+-- * @thisMod@: The module we're generating.
+-- * @accessorName@: function getting the accessor for a specific prefix;
+-- takes an argument that is @"set_"@, @"get_"@, etc.
+-- * @typeCon@: The name of the type constructor for the type owning the
+-- field.
+-- * @fieldLocType@: the field location and type.
+fmtNew thisMod accessorName typeCon fieldLocType =
+ case fieldLocType of
+ PtrField _ fieldType ->
+ let newType = hcat
+ [ typeCon
+ , " (M'.MutMsg s) -> m ("
+ , fmtType thisMod "(M'.MutMsg s)" (PtrType fieldType)
+ , ")"
+ ]
+ in case fieldType of
+ ListOf _ ->
+ fmtNewListLike newType "C'.newList"
+ PrimPtr PrimText ->
+ fmtNewListLike newType "B'.newText"
+ PrimPtr PrimData ->
+ fmtNewListLike newType "B'.newData"
+ PrimPtr (PrimAnyPtr _) ->
+ ""
+ PtrComposite _ -> vcat
+ [ hcat [ newName, " :: U'.RWCtx m s => ", newType ]
+ , hcat [ newName, " struct = do" ]
+ , indent $ vcat
+ [ hcat [ "result <- C'.new (U'.message struct)" ]
+ , hcat [ setName, " struct result" ]
+ , "pure result"
+ ]
+ ]
+ _ ->
+ ""
+ where
+ newName = accessorName "new_"
+ setName = accessorName "set_"
+
+ fmtNewListLike newType allocFn = vcat
+ [ hcat [ newName, " :: U'.RWCtx m s => Int -> ", newType ]
+ , hcat [ newName, " len struct = do" ]
+ , indent $ vcat
+ [ hcat [ "result <- ", allocFn, " (U'.message struct) len" ]
+ , hcat [ setName, " struct result" ]
+ , "pure result"
+ ]
+ ]
+
+
+-- 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)
+ 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 _ ->
+ -- Variant is a group; we return a reference to the group so the user can
+ -- modify it.
+ let childTypeCon = fmtName thisMod (subName variantName "group'")
+ childDataCon = childTypeCon <> "_newtype_"
+ in vcat
+ [ hcat
+ [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> "
+ , "m (", childTypeCon, " (M'.MutMsg s))"
+ ]
+ , hcat [ setName, " (", parentDataCon, " struct) = do" ]
+ , indent $ vcat
+ [ fmtSetTag
+ , hcat [ "pure $ ", childDataCon, " struct" ]
+ ]
+ ]
+ Unnamed _ (DataField loc typ) -> vcat
+ [ hcat
+ [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> "
+ , fmtType thisMod "(M'.MutMsg s)" (WordType typ), " -> m ()"
+ ]
+ , hcat [ setName, " (", parentDataCon, " struct) value = do" ]
+ , indent $ vcat
+ [ fmtSetTag
+ , let size = dataFieldSize typ
+ in fmtSetWordField "struct"
+ ("(fromIntegral (C'.toWord value) :: Word" <> fromString (show size) <> ")")
+ loc
+ ]
+ ]
+ Unnamed _ fieldLocType@(PtrField index typ) -> vcat
+ [ hcat
+ [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> "
+ , fmtType thisMod "(M'.MutMsg s)" (PtrType typ), " -> m ()"
+ ]
+ , hcat [ setName, "(", parentDataCon, " struct) value = do" ]
+ , indent $ vcat
+ [ fmtSetTag
+ , hcat [ "U'.setPtr (C'.toPtr value) ", fromString (show index), " struct" ]
+ ]
+
+ -- Also generate a new_* function.
+ , fmtNew thisMod accessorName parentTypeCon fieldLocType
+ ]
+ Unnamed _ VoidField -> vcat
+ [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> m ()" ]
+ , hcat [ setName, " (", parentDataCon, " struct) = ", fmtSetTag ]
+ ]
+ Unnamed _ (HereField typ) -> vcat
+ [ hcat
+ [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> "
+ , "m (", fmtType thisMod " (M'.MutMsg s)" (CompositeType typ), ")"
+ ]
+ , hcat [ setName, "(", parentDataCon, " struct) value = do" ]
+ , indent $ vcat
+ [ fmtSetTag
+ , "fromStruct struct"
+ ]
+ ]
+
+fmtDecl :: Module -> (Name, Decl) -> PP.Doc
+fmtDecl thisMod (name, DeclDef d) = fmtDataDef thisMod name d
+fmtDecl thisMod (name, DeclConst c) = fmtConst thisMod name c
+
+-- | Format a constant declaration.
+fmtConst :: Module -> Name -> Const -> PP.Doc
+fmtConst thisMod name value =
+ let nameText = fmtName thisMod (valueName name)
+ in case value of
+ WordConst{wordType,wordValue} -> vcat
+ [ hcat
+ [ nameText, " :: "
+ , case wordType of
+ PrimWord ty -> fmtPrimWord ty
+ EnumType tyName -> fmtName thisMod tyName
+ ]
+ , hcat [ nameText, " = C'.fromWord ", fromString (show wordValue) ]
+ ]
+ VoidConst -> vcat
+ [ hcat [ nameText, " :: ()" ]
+ , hcat [ nameText, " = ()" ]
+ ]
+
+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} =
+ let unionName = subName dataName ""
+ unionNameText = fmtName thisMod unionName
+ in vcat
+ [ fmtNewtypeStruct thisMod dataName dataSz ptrSz
+ , hcat [ "data ", unionNameText, " msg =" ]
+ , indent $ vcat $ PP.punctuate " |" (map fmtDataVariant dataVariants)
+ , fmtFieldAccessor thisMod dataName dataName Field
+ { fieldName = ""
+ , fieldLocType = HereField $ StructType unionName []
+ }
+ , vcat $ map (fmtUnionSetter thisMod dataName tagLoc) dataVariants
+ -- 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
+ ]
+ ]
+ ]
+ where
+ fmtDataVariant Variant{..} = fmtName thisMod variantName <>
+ case variantParams of
+ Record _ -> " (" <> fmtName thisMod (subName variantName "group' msg)")
+ Unnamed VoidType _ -> ""
+ 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"
+ fmtVariantAuxNewtype Variant{variantName, variantParams=Record fields} =
+ let typeName = subName variantName "group'"
+ in vcat
+ [ fmtNewtypeStruct thisMod typeName dataSz ptrSz
+ , vcat $ map (fmtFieldAccessor thisMod typeName variantName) fields
+ ]
+ fmtVariantAuxNewtype _ = ""
+fmtDataDef thisMod dataName DataDef{dataCerialType=CTyEnum,..} =
+ let typeName = fmtName thisMod dataName
+ 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" ]
+ ]
+ ]
+ 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)"
+ -- | 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)
+
+-- | @'fmtType ident msg ty@ formats the type @ty@ from module @ident@,
+-- using @msg@ as the message parameter, if any.
+fmtType :: Module -> PP.Doc -> Type -> PP.Doc
+fmtType thisMod msg = \case
+ WordType (EnumType name) ->
+ fmtName thisMod name
+ WordType (PrimWord ty) ->
+ fmtPrimWord ty
+ VoidType ->
+ "()"
+ PtrType (ListOf eltType) ->
+ "(B'.List " <> msg <> " " <> fmtType thisMod msg eltType <> ")"
+ PtrType (PrimPtr PrimText) ->
+ "(B'.Text " <> msg <> ")"
+ PtrType (PrimPtr PrimData) ->
+ "(B'.Data " <> msg <> ")"
+ PtrType (PrimPtr (PrimAnyPtr anyPtr)) ->
+ "(Maybe " <> fmtAnyPtr msg anyPtr <> ")"
+ PtrType (PtrComposite ty) ->
+ fmtType thisMod msg (CompositeType ty)
+ CompositeType (StructType name params) -> hcat
+ [ "("
+ , fmtName thisMod name
+ , " "
+ , mintercalate " " $ msg : map (fmtType thisMod msg) params
+ , ")"
+ ]
+
+fmtAnyPtr :: PP.Doc -> AnyPtr -> PP.Doc
+fmtAnyPtr msg Struct = "(U'.Struct " <> msg <> ")"
+fmtAnyPtr msg List = "(U'.List " <> msg <> ")"
+fmtAnyPtr _ Cap = "Word32"
+fmtAnyPtr msg Ptr = "(U'.Ptr " <> msg <> ")"
+
+fmtName :: Module -> Name -> PP.Doc
+fmtName Module{modId=thisMod} Name{nameModule, nameLocalNS=Namespace parts, nameUnqualified=localName} =
+ modPrefix <> mintercalate "'" (map PP.textStrict $ parts <> [localName])
+ where
+ modPrefix = case nameModule of
+ ByCapnpId id | id == thisMod -> ""
+ FullyQualified (Namespace []) -> ""
+ _ -> fmtModRef nameModule <> "."
diff --git a/exe/capnpc-haskell/FrontEnd.hs b/exe/capnpc-haskell/FrontEnd.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/FrontEnd.hs
@@ -0,0 +1,497 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module FrontEnd
+ ( cgrToIR
+ ) where
+
+import Data.Word
+
+import Data.Char (toUpper)
+import Data.Function ((&))
+import Data.List (partition)
+import Data.Monoid ((<>))
+import Data.ReinterpretCast (doubleToWord, floatToWord)
+import Util (Id, splitOn)
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Vector as V
+
+import Capnp.Capnp.Schema.Pure
+
+import Backends.Common (dataFieldSize)
+
+import qualified IR
+
+type NodeMap = M.Map Id NodeMetaData
+
+-- | Some useful metadata about a node.
+data NodeMetaData = NodeMetaData
+ { moduleId :: Id
+ -- ^ The id of the module that this node belongs to.
+ , namespace :: [T.Text]
+ -- ^ The namespace within a file that the node is defined.
+ , node :: Node
+ -- ^ The node itself.
+ }
+ deriving(Show, Read, Eq)
+
+-- | @'identifierFromMetaData' thisModule meta@ return a haskell identifier
+-- for a node based on the metadata @meta@, and @thisModule@, the id for
+-- the module in which the name will be used.
+identifierFromMetaData :: Id -> NodeMetaData -> IR.Name
+identifierFromMetaData _ NodeMetaData{moduleId, namespace=(unqualified:localNS)} =
+ IR.Name
+ { nameModule = IR.ByCapnpId moduleId
+ , nameLocalNS = IR.Namespace $ reverse localNS
+ , nameUnqualified = unqualified
+ }
+identifierFromMetaData _ meta =
+ -- TODO: rule out this possibility statically; shouldn't be too hard.
+ error $ "Node metadata had an empty namespace field: " ++ show meta
+
+-- Helper for makeNodeMap; recursively collect metadata for a node and
+-- all of its descendants in the tree.
+collectMetaData :: M.Map Id Node -> NodeMetaData -> [(Id, NodeMetaData)]
+collectMetaData nodeMap meta@NodeMetaData{node=node@Node{..}, ..} = concat
+ [ [(id, meta)]
+ , concatMap collectNested $ V.toList nestedNodes
+ -- Child nodes can be in two places: most are in nestedNodes, but
+ -- group fields are not, and can only be found in the fields of
+ -- a struct union.
+ , case union' of
+ Node'struct{..} ->
+ concatMap collectField $ V.toList fields
+ _ ->
+ []
+ ]
+ where
+ -- Collect metadata for nodes under a Field.
+ collectField Field{..} = case union' of
+ Field'group{..} -> collectMetaData nodeMap
+ meta
+ { node = nodeMap M.! typeId
+ -- in this case, name comes from the field, so for a field bar in a
+ -- struct Foo, we'll end up with a type for the group named Foo'bar.
+ , namespace = makeLegalName name : namespace
+ }
+ _ ->
+ []
+ -- Collect metadata for nodes under a NestedNode.
+ collectNested nn@Node'NestedNode{..} = case M.lookup id nodeMap of
+ Just node -> collectMetaData nodeMap
+ meta
+ { node = node
+ , namespace = makeLegalName name : namespace
+ }
+ Nothing ->
+ -- Imperically, this can happen if e.g. the node isn't in a subtree
+ -- of a RequestedFile, and not actually used anywhere else. This
+ -- crops up with c++.capnp:name when processing schema.capnp, for
+ -- example. In this case, just leave it out of the map:
+ []
+
+-- | Convert the argument into a valid haskell identifier. This doesn't handle
+-- every possible violation, just ones that might occur in legal schema.
+makeLegalName :: T.Text -> T.Text
+makeLegalName txt
+ | txt `elem` keywords = txt <> "_"
+ | otherwise = txt
+ where
+ keywords =
+ [ "as", "case", "of", "class", "data", "family", "instance", "default"
+ , "deriving", "do", "forall", "foreign", "hiding", "if", "then", "else"
+ , "import", "infix", "infixl", "infixr", "let", "in", "mdo", "module"
+ , "newtype", "proc", "qualified", "rec", "type", "where"
+ ]
+
+-- | Build a NodeMap for all of the nodes in the CodeGeneratorRequest.
+makeNodeMap :: CodeGeneratorRequest -> NodeMap
+makeNodeMap CodeGeneratorRequest{..} =
+ V.map (\node@Node{..} -> collectMetaData baseMap NodeMetaData
+ { moduleId = id
+ , namespace = []
+ , node = node
+ })
+ rootNodes
+ & V.toList
+ & concat
+ & M.fromList
+ where
+ rootNodes = V.filter (\Node{..} -> scopeId == 0) nodes
+ baseMap =
+ V.toList nodes
+ & map (\node@Node{..} -> (id, node))
+ & M.fromList
+
+generateModule :: NodeMap -> CodeGeneratorRequest'RequestedFile -> IR.Module
+generateModule nodeMap CodeGeneratorRequest'RequestedFile{..} =
+ IR.Module
+ { modId = id
+ , modName = IR.Namespace
+ $ map (T.pack . mangleFileName)
+ $ filter (/= "")
+ $ splitOn '/' (T.unpack filename)
+ , modFile = filename
+ , modImports = map generateImport $ V.toList imports
+ , modDecls = M.fromList $ concatMap (generateDecls id nodeMap)
+ $ filter (\NodeMetaData{..} -> moduleId == id)
+ $ map snd
+ $ M.toList nodeMap
+ }
+ where
+ -- Transform the file name into a valid haskell module name.
+ -- TODO: this is a best-effort transformation; it gives good
+ -- results on the schema I've found in the wild, but may fail
+ -- to generate valid/non-overlapping module names in all cases.
+ mangleFileName "c++.capnp" = "Cxx"
+ mangleFileName "" = error "Unexpected empty file name"
+ mangleFileName (c:cs) = go (toUpper c : cs) where
+ go ('-':c:cs) = toUpper c : go cs
+ go ".capnp" = ""
+ go [] = ""
+ go (c:cs) = c : go cs
+
+-- | Check whether the node's parent scope actually needs a type definition for
+-- the node. This is true unless it is a group belonging to a union, which itself
+-- has no anonymous union. In that case we just inline the fields, like:
+--
+-- @@@
+-- data MyUnion =
+-- MyUnion'variant1
+-- { foo :: Bar
+-- , baz :: Quux
+-- }
+-- @@@
+--
+-- ...and thus don't need an intervening type definition.
+neededByParent :: NodeMap -> Node -> Bool
+neededByParent nodeMap Node{id,scopeId,union'=Node'struct{isGroup,discriminantCount}} | isGroup =
+ case nodeMap M.! scopeId of
+ NodeMetaData{node=Node{union'=Node'struct{fields}}} ->
+ let me = V.filter
+ (\case
+ Field{union'=Field'group{typeId}} -> typeId == id
+ _ -> False)
+ fields
+ in if V.length me /= 1
+ then error "Invalid schema; group matched multiple fields in its scopeId!"
+ else not (isUnionField (me V.! 0) && discriminantCount == 0)
+ _ -> error "Invalid schema; group's scopeId references something that is not a struct!"
+neededByParent _ _ = True
+
+generateDecls :: Id -> NodeMap -> NodeMetaData -> [(IR.Name, IR.Decl)]
+generateDecls thisModule nodeMap meta@NodeMetaData{..} =
+ let Node{..} = node
+ name = identifierFromMetaData moduleId meta
+ in case union' of
+ Node'struct{..} | neededByParent nodeMap node ->
+ 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
+ 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
+ }
+ unionName = IR.subName name ""
+ in case (unionFields, commonFields) of
+ ([], []) ->
+ -- I(zenhack) don't fully understand this case. It seems like
+ -- it should apply to struct Foo {}, but it also imperically
+ -- shows up for type aliases in the schema. In this case, the
+ -- schema should still build without them since our generated
+ -- code just uses the original type. Furthermore, right now
+ -- our ast output doesn't handle types with no variants, so
+ -- we just don't output any code.
+ []
+ ([], _:_) ->
+ -- There's no anonymous union; just declare the fields.
+ [ bodyFields ]
+ (_:_, []) ->
+ -- The struct is just one big anonymous union; expand the variants
+ -- in-line, rather than making a wrapper.
+ [ (typeName, bodyUnion) ]
+ (_:_, _:_) ->
+ -- There are both common fields and an anonymous union. Generate
+ -- an auxiliary type for the union.
+ [ 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
+ }
+ )
+ ]
+ Node'const{type_=Type'void,value=Value'void} ->
+ [(name, IR.DeclConst IR.VoidConst)]
+ Node'const{type_=Type'bool,value=Value'bool v} ->
+ [(name, primWordConst IR.PrimBool (fromEnum v))]
+ Node'const{type_=Type'int8,value=Value'int8 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = True, size = 8 } v)]
+ Node'const{type_=Type'int16,value=Value'int16 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = True, size = 16 } v)]
+ Node'const{type_=Type'int32,value=Value'int32 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = True, size = 32 } v)]
+ Node'const{type_=Type'int64,value=Value'int64 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = True, size = 64 } v)]
+ Node'const{type_=Type'uint8,value=Value'uint8 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = False, size = 8 } v)]
+ Node'const{type_=Type'uint16,value=Value'uint16 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = False, size = 16 } v)]
+ Node'const{type_=Type'uint32,value=Value'uint32 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = False, size = 32 } v)]
+ Node'const{type_=Type'uint64,value=Value'uint64 v} ->
+ [(name, primWordConst IR.PrimInt { isSigned = False, size = 64 } v)]
+ Node'const{type_=Type'float32,value=Value'float32 v} ->
+ [(name, primWordConst IR.PrimFloat32 (floatToWord v))]
+ Node'const{type_=Type'float64,value=Value'float64 v} ->
+ [(name, primWordConst IR.PrimFloat64 (doubleToWord v))]
+ -- TODO: other constants.
+ _ -> [] -- TODO
+
+primWordConst :: Integral a => IR.PrimWord -> a -> IR.Decl
+primWordConst ty val = IR.DeclConst IR.WordConst
+ { wordValue = fromIntegral val
+ , wordType = IR.PrimWord ty
+ }
+
+-- | Given the offset field from the capnp schema, a type, and a
+-- default value, return a DataLoc describing the location of a field.
+dataLoc :: Word32 -> IR.WordType -> Value -> IR.DataLoc
+dataLoc offset ty defaultVal =
+ let bitsOffset = fromIntegral offset * dataFieldSize ty
+ in IR.DataLoc
+ { dataIdx = bitsOffset `div` 64
+ , dataOff = bitsOffset `mod` 64
+ , 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 $
+ let (unionFields, commonFields) = partition isUnionField fields in
+ map (generateField thisModule nodeMap) commonFields
+ <> case unionFields of
+ [] -> [] -- no union
+ _ ->
+ [ IR.Field
+ { fieldName = "union'"
+ , fieldLocType =
+ -- This could use a bit of refactoring. Right now we call
+ -- formatSturctBody in two cases:
+ let fieldTypeName = case commonFields of
+ -- 1. A top-level struct, which also has non anonymous-union
+ -- fields. In this case, the anonymous union for a struct
+ -- named Foo will have a type named Foo'; we add an empty
+ -- segment to the union' field's type name.
+
+ _:_ -> IR.subName parentName ""
+
+ -- 2. An argument of a named union variant, which itself is
+ -- a union. In this case, parentName is the name of the outer
+ -- union's data constructor, and the *inner* union's type
+ -- constructor; we use parentName unchanged.
+
+ [] -> parentName
+
+ in IR.HereField $ IR.StructType fieldTypeName []
+ }
+ ]
+
+-- | Generate a variant of a type corresponding to an anonymous union in a
+-- struct.
+generateVariant :: Id -> NodeMap -> IR.Name -> Field -> IR.Variant
+generateVariant thisModule nodeMap parentName Field{..} = case union' of
+ Field'slot{..} -> IR.Variant
+ { variantName
+ , variantParams = IR.Unnamed
+ (formatType thisModule nodeMap type_)
+ (getFieldLoc thisModule nodeMap union')
+ , variantTag = Just discriminantValue
+ }
+ Field'group{..} ->
+ let NodeMetaData{node=node@Node{..},..} = nodeMap M.! typeId
+ in case union' of
+ Node'struct{..} -> IR.Variant
+ { variantName = variantName
+ , variantParams =
+ formatStructBody thisModule nodeMap variantName $ V.toList fields
+ , variantTag = Just discriminantValue
+ }
+ _ ->
+ error "A group field referenced a non-struct node."
+ Field'unknown' _ ->
+ -- Some sort of field we don't know about (newer version of capnp probably).
+ -- Generate the variant, but we don't know what the argument type should be,
+ -- so leave it out.
+ IR.Variant
+ { variantName
+ , variantParams = IR.Unnamed IR.VoidType IR.VoidField
+ , variantTag = Nothing
+ }
+ where
+ variantName = IR.subName parentName (makeLegalName name)
+
+
+generateField :: Id -> NodeMap -> Field -> IR.Field
+generateField thisModule nodeMap Field{..} =
+ IR.Field
+ { fieldName = makeLegalName name
+ , fieldLocType = getFieldLoc thisModule nodeMap union'
+ }
+
+getFieldLoc :: Id -> NodeMap -> Field' -> IR.FieldLocType
+getFieldLoc thisModule nodeMap = \case
+ Field'slot{..} ->
+ case formatType thisModule nodeMap type_ of
+ IR.VoidType ->
+ IR.VoidField
+ IR.PtrType ty
+ | hadExplicitDefault -> error $
+ "Error: capnpc-haskell does not support explicit default " ++
+ "field values for pointer types. See:\n" ++
+ "\n" ++
+ " https://github.com/zenhack/haskell-capnp/issues/28"
+ | otherwise ->
+ IR.PtrField (fromIntegral offset) ty
+ IR.WordType ty ->
+ IR.DataField
+ (dataLoc offset ty defaultValue)
+ ty
+ IR.CompositeType ty ->
+ IR.PtrField (fromIntegral offset) (IR.PtrComposite ty)
+ Field'group{..} ->
+ IR.HereField $ IR.StructType (identifierFromMetaData thisModule (nodeMap M.! typeId)) []
+ Field'unknown' _ ->
+ -- Don't know how to interpret this; we'll have to leave the argument
+ -- opaque.
+ IR.VoidField
+
+-- | Return the raw bit-level representation of a value that is stored
+-- in a struct's data section.
+--
+-- Returns 0 for any non-data values. TODO: would be nice to not have
+-- an arbitrary default here.
+valueBits :: Value -> Word64
+valueBits = \case
+ Value'bool b -> fromIntegral $ fromEnum b
+ Value'int8 n -> fromIntegral n
+ Value'int16 n -> fromIntegral n
+ Value'int32 n -> fromIntegral n
+ Value'int64 n -> fromIntegral n
+ Value'uint8 n -> fromIntegral n
+ Value'uint16 n -> fromIntegral n
+ Value'uint32 n -> fromIntegral n
+ Value'uint64 n -> n
+ Value'float32 n -> fromIntegral $ floatToWord n
+ Value'float64 n -> doubleToWord n
+ Value'enum n -> fromIntegral n
+ _ -> 0 -- some non-word type.
+
+formatType :: Id -> NodeMap -> Type -> IR.Type
+formatType thisModule nodeMap ty = case ty of
+ Type'void -> IR.VoidType
+ Type'bool -> IR.WordType $ IR.PrimWord IR.PrimBool
+ Type'int8 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = True, size = 8}
+ Type'int16 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = True, size = 16}
+ Type'int32 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = True, size = 32}
+ Type'int64 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = True, size = 64}
+ Type'uint8 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = False, size = 8}
+ Type'uint16 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = False, size = 16}
+ Type'uint32 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = False, size = 32}
+ Type'uint64 -> IR.WordType $ IR.PrimWord IR.PrimInt {isSigned = False, size = 64}
+ Type'float32 -> IR.WordType $ IR.PrimWord IR.PrimFloat32
+ Type'float64 -> IR.WordType $ IR.PrimWord IR.PrimFloat64
+ Type'text -> IR.PtrType $ IR.PrimPtr IR.PrimText
+ Type'data_ -> IR.PtrType $ IR.PrimPtr IR.PrimData
+ Type'list elt -> IR.PtrType $ IR.ListOf (formatType thisModule nodeMap elt)
+ -- TODO: use 'brand' to generate type parameters.
+ Type'enum{..} -> IR.WordType $ IR.EnumType (typeName typeId)
+ Type'struct{..} -> IR.CompositeType $ IR.StructType (typeName typeId) []
+ -- TODO: interfaces are not structs; handle them separately.
+ Type'interface{..} -> IR.CompositeType $ IR.StructType (typeName typeId) []
+ Type'anyPointer anyPtr -> IR.PtrType $ IR.PrimPtr $ IR.PrimAnyPtr $
+ case anyPtr of
+ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'anyKind ->
+ IR.Ptr
+ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'struct ->
+ IR.Struct
+ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'list ->
+ IR.List
+ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'capability ->
+ IR.Cap
+ _ ->
+ -- Something we don't know about; assume it could be anything.
+ IR.Ptr
+ _ -> IR.VoidType -- TODO: constrained anyPointers
+ where
+ typeName typeId =
+ identifierFromMetaData thisModule (nodeMap M.! typeId)
+
+generateImport :: CodeGeneratorRequest'RequestedFile'Import -> IR.Import
+generateImport CodeGeneratorRequest'RequestedFile'Import{..} =
+ IR.Import (IR.ByCapnpId id)
+
+cgrToIR :: CodeGeneratorRequest -> [IR.Module]
+cgrToIR cgr@CodeGeneratorRequest{requestedFiles} =
+ map (generateModule $ makeNodeMap cgr) $ V.toList requestedFiles
diff --git a/exe/capnpc-haskell/IR.hs b/exe/capnpc-haskell/IR.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/IR.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+-- This module defines datatypes that represent something between the capnp
+-- schema and Haskell code. The representation has the following
+-- chracteristics:
+--
+-- * Type definitions can map directly to idiomatic haskell types. Both the capnp
+-- schema format itself and the types defined for it in schema.capnp have some
+-- quirks that need to be ironed out to perform the mapping:
+-- * Unions and structs are not separate types; a union is just a (possibly
+-- anonymous) field within a struct.
+-- * Groups are only kindof their own type.
+-- * Schema can have nested, mutually recursive namespaces even within a
+-- single file. We want to generate a module with a flat namespace.
+-- * Even features that conceptually map simply have somewhat odd
+-- representations and irregularities schema.capnp
+-- Our intermediate representation just has data declarations, with
+-- enough information attached to access each variant and argument.
+-- * Names are fully-qualified; see the 'Name' type for more information
+-- (TODO).
+module IR
+ ( Name(..)
+ , Namespace(..)
+ , Module(..)
+ , ModuleRef(..)
+ , Import(..)
+ , Type(..)
+ , CompositeType(..)
+ , WordType(..)
+ , PtrType(..)
+ , PrimWord(..)
+ , PrimPtr(..)
+ , AnyPtr(..)
+ , Variant(..)
+ , VariantParams(..)
+ , Field(..)
+ , Decl(..)
+ , DataDef(..)
+ , CerialType(..)
+ , Const(..)
+ , FieldLocType(..)
+ , DataLoc(..)
+ , subName
+ , prefixName
+ , valueName
+ ) where
+
+import Data.Word
+
+import Data.Char (toLower)
+import Data.String (IsString(fromString))
+import Data.Text (Text)
+
+import Data.Monoid ((<>))
+import GHC.Exts (IsList(..))
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+
+import Util
+
+newtype Namespace = Namespace [Text]
+ deriving(Show, Read, Eq, Ord)
+
+instance IsList Namespace where
+ type Item Namespace = Text
+ fromList = Namespace
+ toList (Namespace parts) = parts
+
+data Module = Module
+ { modId :: Id
+ , modName :: Namespace
+ , modFile :: Text
+ , modImports :: [Import]
+ -- XXX TODO: 'Name' includes a 'ModuleRef', which means it is possible
+ -- for two different 'Name's to refer to the same actual variable; using
+ -- them as map keys is questionable. In practice, when building a module
+ -- all of the ModuleRefs are the same, though, so this won't *break*
+ -- anything -- but ideally we'd remove that information from the key.
+ , modDecls :: M.Map Name Decl
+ }
+ deriving(Show, Read, Eq)
+
+data Decl
+ = DeclDef DataDef
+ | DeclConst Const
+ deriving(Show, Read, Eq)
+
+newtype Import = Import ModuleRef
+ deriving(Show, Read, Eq)
+
+data ModuleRef
+ = FullyQualified Namespace
+ | ByCapnpId Id
+ deriving(Show, Read, Eq, Ord)
+
+data Name = Name
+ { nameModule :: ModuleRef
+ , nameLocalNS :: Namespace
+ , nameUnqualified :: Text
+ }
+ deriving(Show, Read, Eq, Ord)
+
+subName :: Name -> Text -> Name
+subName name@Name{..} nextPart = name
+ { nameLocalNS = fromList $ toList nameLocalNS ++ [nameUnqualified]
+ , nameUnqualified = nextPart
+ }
+
+prefixName :: Text -> Name -> Name
+prefixName prefix name@Name{nameLocalNS=(toList -> (x:xs))} =
+ name { nameLocalNS = fromList $ (prefix <> x):xs }
+prefixName prefix name = name { nameLocalNS = fromList [prefix] }
+
+-- | 'valueName' converts a name to one which starts with a lowercase
+-- letter, so that it is valid to use as a name for a value (as opposed
+-- to a type).
+valueName :: Name -> Name
+valueName name@Name{nameLocalNS=(toList -> (T.unpack -> (c:cs)):xs)} =
+ name { nameLocalNS = fromList $ T.pack (toLower c : cs) : xs }
+valueName name = name
+
+instance IsString Name where
+ fromString str = Name
+ { nameModule = FullyQualified []
+ , nameLocalNS = []
+ , nameUnqualified = T.pack str
+ }
+
+data Type
+ = CompositeType CompositeType
+ | VoidType
+ | WordType WordType
+ | PtrType PtrType
+ deriving(Show, Read, Eq)
+
+data CompositeType
+ = StructType Name [Type]
+ deriving(Show, Read, Eq)
+
+data WordType
+ = EnumType Name
+ | PrimWord PrimWord
+ deriving(Show, Read, Eq)
+
+data PtrType
+ = ListOf Type
+ | PrimPtr PrimPtr
+ | PtrComposite CompositeType
+ deriving(Show, Read, Eq)
+
+data PrimWord
+ = PrimInt { isSigned :: !Bool, size :: !Int }
+ | PrimFloat32
+ | PrimFloat64
+ | PrimBool
+ deriving(Show, Read, Eq)
+
+data PrimPtr
+ = PrimText
+ | PrimData
+ | PrimAnyPtr AnyPtr
+ deriving(Show, Read, Eq)
+
+data AnyPtr
+ = Struct
+ | List
+ | Cap
+ | Ptr
+ deriving(Show, Read, Eq)
+
+data Variant = Variant
+ { variantName :: Name
+ , variantParams :: VariantParams
+ , variantTag :: Maybe Word16
+ }
+ deriving(Show, Read, Eq)
+
+data VariantParams
+ = Unnamed Type FieldLocType
+ | Record [Field]
+ deriving(Show, Read, Eq)
+
+data Field = Field
+ { fieldName :: Text
+ , fieldLocType :: FieldLocType
+ }
+ deriving(Show, Read, Eq)
+
+data Const
+ = WordConst
+ { wordValue :: Word64
+ , wordType :: WordType
+ }
+ | VoidConst
+ -- TODO: support pointer types.
+ deriving(Show, Read, Eq)
+
+data DataDef = DataDef
+ { dataVariants :: [Variant]
+ -- | The location of the tag for the union, if any.
+ , dataTagLoc :: Maybe DataLoc
+ , dataCerialType :: CerialType
+ }
+ 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
+ deriving(Show, Read, Eq)
+
+-- | The type and location of a field.
+data FieldLocType
+ -- | The field is in the struct's data section.
+ = DataField DataLoc WordType
+ -- | The field is in the struct's pointer section (the argument is the
+ -- index).
+ | PtrField !Word16 PtrType
+ -- | The field is a group or union; it's "location" is the whole struct.
+ | HereField CompositeType
+ -- | The field is of type void (and thus is zero-size).
+ | VoidField
+ deriving(Show, Read, Eq)
+
+-- | The location of a field within a struct's data section.
+data DataLoc = DataLoc
+ { dataIdx :: !Int
+ -- ^ The index of the 64-bit word containing the field.
+ , dataOff :: !Int
+ , dataDef :: !Word64
+ -- ^ The value is stored xor-ed with this value. This is used
+ -- to allow for encoding default values. Note that this is xor-ed
+ -- with the bits representing the value, not the whole word.
+ }
+ deriving(Show, Read, Eq)
diff --git a/exe/capnpc-haskell/Main.hs b/exe/capnpc-haskell/Main.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/Main.hs
@@ -0,0 +1,31 @@
+{-| This is the capnp compiler plugin.
+-}
+module Main (main) where
+
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
+import System.IO (IOMode(WriteMode), withFile)
+
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+import Capnp.Capnp.Schema.Pure (CodeGeneratorRequest)
+import Data.Capnp.Pure (defaultLimit, getValue)
+
+import qualified Backends.Pure
+import qualified Backends.Raw
+import qualified FrontEnd
+
+main :: IO ()
+main = do
+ cgr <- getValue defaultLimit
+ mapM_ saveResult (handleCGR cgr)
+ where
+ saveResult (filename, contents) = do
+ createDirectoryIfMissing True (takeDirectory filename)
+ withFile filename WriteMode $ \h ->
+ PP.hPutDoc h contents
+
+handleCGR :: CodeGeneratorRequest -> [(FilePath, PP.Doc)]
+handleCGR = concatMap genFiles . FrontEnd.cgrToIR where
+ genFiles mod =
+ Backends.Pure.fmtModule mod ++ Backends.Raw.fmtModule mod
diff --git a/exe/capnpc-haskell/Util.hs b/exe/capnpc-haskell/Util.hs
new file mode 100644
--- /dev/null
+++ b/exe/capnpc-haskell/Util.hs
@@ -0,0 +1,28 @@
+-- | Misc. helpers.
+module Util (Id(..), mintercalate, splitOn) where
+
+import Data.Word
+
+import Data.List (intersperse)
+import Data.Monoid (Monoid, mconcat)
+
+-- | Generalization of 'Data.List.intercalate', analogous to concat/mconcat
+mintercalate :: Monoid w => w -> [w] -> w
+mintercalate sep = mconcat . intersperse sep
+
+-- | Type alias for the Ids used in the capnproto schema; this is defined
+-- in the source schema, but the schema compiler doesn't include information
+-- on type aliases in the message it sends to the plugin, so we have no way
+-- of automating the alias.
+type Id = Word64
+
+-- | @'splitOn' sep str@ splits the string @str@ on boundaries
+-- equal to @sep@. This is a misc. helper function that really should be
+-- in the stdlib, but it isn't.
+splitOn :: Char -> String -> [String]
+splitOn target = go [] where
+ go [] [] = []
+ go acc [] = [reverse acc]
+ go acc (c:cs)
+ | c == target = reverse acc : go [] cs
+ | otherwise = go (c:acc) cs
diff --git a/lib/Capnp/ById/X8ef99297a43a5e34.hs b/lib/Capnp/ById/X8ef99297a43a5e34.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/X8ef99297a43a5e34.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.X8ef99297a43a5e34
+Description: machine-addressable alias for 'Capnp.Capnp.Json'.
+-}
+module Capnp.ById.X8ef99297a43a5e34 (module Capnp.Capnp.Json) where
+import Capnp.Capnp.Json
diff --git a/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs b/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.X8ef99297a43a5e34.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.Json.Pure'.
+-}
+module Capnp.ById.X8ef99297a43a5e34.Pure(module Capnp.Capnp.Json.Pure) where
+import Capnp.Capnp.Json.Pure
diff --git a/lib/Capnp/ById/Xa184c7885cdaf2a1.hs b/lib/Capnp/ById/Xa184c7885cdaf2a1.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xa184c7885cdaf2a1.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xa184c7885cdaf2a1
+Description: machine-addressable alias for 'Capnp.Capnp.RpcTwoparty'.
+-}
+module Capnp.ById.Xa184c7885cdaf2a1 (module Capnp.Capnp.RpcTwoparty) where
+import Capnp.Capnp.RpcTwoparty
diff --git a/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs b/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xa184c7885cdaf2a1.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.RpcTwoparty.Pure'.
+-}
+module Capnp.ById.Xa184c7885cdaf2a1.Pure(module Capnp.Capnp.RpcTwoparty.Pure) where
+import Capnp.Capnp.RpcTwoparty.Pure
diff --git a/lib/Capnp/ById/Xa93fc509624c72d9.hs b/lib/Capnp/ById/Xa93fc509624c72d9.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xa93fc509624c72d9.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xa93fc509624c72d9
+Description: machine-addressable alias for 'Capnp.Capnp.Schema'.
+-}
+module Capnp.ById.Xa93fc509624c72d9 (module Capnp.Capnp.Schema) where
+import Capnp.Capnp.Schema
diff --git a/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs b/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xa93fc509624c72d9.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.Schema.Pure'.
+-}
+module Capnp.ById.Xa93fc509624c72d9.Pure(module Capnp.Capnp.Schema.Pure) where
+import Capnp.Capnp.Schema.Pure
diff --git a/lib/Capnp/ById/Xb312981b2552a250.hs b/lib/Capnp/ById/Xb312981b2552a250.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xb312981b2552a250.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xb312981b2552a250
+Description: machine-addressable alias for 'Capnp.Capnp.Rpc'.
+-}
+module Capnp.ById.Xb312981b2552a250 (module Capnp.Capnp.Rpc) where
+import Capnp.Capnp.Rpc
diff --git a/lib/Capnp/ById/Xb312981b2552a250/Pure.hs b/lib/Capnp/ById/Xb312981b2552a250/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xb312981b2552a250/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xb312981b2552a250.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.Rpc.Pure'.
+-}
+module Capnp.ById.Xb312981b2552a250.Pure(module Capnp.Capnp.Rpc.Pure) where
+import Capnp.Capnp.Rpc.Pure
diff --git a/lib/Capnp/ById/Xb8630836983feed7.hs b/lib/Capnp/ById/Xb8630836983feed7.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xb8630836983feed7.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xb8630836983feed7
+Description: machine-addressable alias for 'Capnp.Capnp.Persistent'.
+-}
+module Capnp.ById.Xb8630836983feed7 (module Capnp.Capnp.Persistent) where
+import Capnp.Capnp.Persistent
diff --git a/lib/Capnp/ById/Xb8630836983feed7/Pure.hs b/lib/Capnp/ById/Xb8630836983feed7/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xb8630836983feed7/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xb8630836983feed7.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.Persistent.Pure'.
+-}
+module Capnp.ById.Xb8630836983feed7.Pure(module Capnp.Capnp.Persistent.Pure) where
+import Capnp.Capnp.Persistent.Pure
diff --git a/lib/Capnp/ById/Xbdf87d7bb8304e81.hs b/lib/Capnp/ById/Xbdf87d7bb8304e81.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xbdf87d7bb8304e81.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xbdf87d7bb8304e81
+Description: machine-addressable alias for 'Capnp.Capnp.Cxx'.
+-}
+module Capnp.ById.Xbdf87d7bb8304e81 (module Capnp.Capnp.Cxx) where
+import Capnp.Capnp.Cxx
diff --git a/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs b/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.ById.Xbdf87d7bb8304e81.Pure
+Description: Machine-addressable alias for 'Capnp.Capnp.Cxx.Pure'.
+-}
+module Capnp.ById.Xbdf87d7bb8304e81.Pure(module Capnp.Capnp.Cxx.Pure) where
+import Capnp.Capnp.Cxx.Pure
diff --git a/lib/Capnp/Capnp/Cxx.hs b/lib/Capnp/Capnp/Cxx.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Cxx.hs
@@ -0,0 +1,27 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.Cxx
+Description: Low-level generated module for capnp/c++.capnp
+This module is the generated code for capnp/c++.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.Cxx where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/c++.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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'
diff --git a/lib/Capnp/Capnp/Cxx/Pure.hs b/lib/Capnp/Capnp/Cxx/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Cxx/Pure.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.Cxx.Pure
+Description: High-level generated module for capnp/c++.capnp
+This module is the generated code for capnp/c++.capnp,
+for the high-level api.
+-}
+module Capnp.Capnp.Cxx.Pure (
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/c++.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.Xbdf87d7bb8304e81
diff --git a/lib/Capnp/Capnp/Json.hs b/lib/Capnp/Capnp/Json.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Json.hs
@@ -0,0 +1,225 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.Json
+Description: Low-level generated module for capnp/json.capnp
+This module is the generated code for capnp/json.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.Json where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/json.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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 JsonValue msg = JsonValue_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (JsonValue msg) where
+ 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 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 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
+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 ()
+set_JsonValue'boolean (JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 16 0
+set_JsonValue'number :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> Double -> m ()
+set_JsonValue'number (JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (2 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
+set_JsonValue'string :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
+set_JsonValue'string(JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (3 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'string :: U'.RWCtx m s => Int -> JsonValue (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
+new_JsonValue'string len struct = do
+ result <- B'.newText (U'.message struct) len
+ set_JsonValue'string struct result
+ pure result
+set_JsonValue'array :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (JsonValue (M'.MutMsg s))) -> m ()
+set_JsonValue'array(JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (4 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'array :: U'.RWCtx m s => Int -> JsonValue (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (JsonValue (M'.MutMsg s))))
+new_JsonValue'array len struct = do
+ result <- C'.newList (U'.message struct) len
+ set_JsonValue'array struct result
+ pure result
+set_JsonValue'object :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (JsonValue'Field (M'.MutMsg s))) -> m ()
+set_JsonValue'object(JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (5 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'object :: U'.RWCtx m s => Int -> JsonValue (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (JsonValue'Field (M'.MutMsg s))))
+new_JsonValue'object len struct = do
+ result <- C'.newList (U'.message struct) len
+ set_JsonValue'object struct result
+ pure result
+set_JsonValue'call :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> (JsonValue'Call (M'.MutMsg s)) -> m ()
+set_JsonValue'call(JsonValue_newtype_ struct) value = do
+ H'.setWordField struct (6 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'call :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> m ((JsonValue'Call (M'.MutMsg s)))
+new_JsonValue'call struct = do
+ result <- C'.new (U'.message struct)
+ set_JsonValue'call struct result
+ pure result
+set_JsonValue'unknown' :: U'.RWCtx m s => JsonValue (M'.MutMsg s) -> Word16 -> m ()
+set_JsonValue'unknown'(JsonValue_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
+instance C'.FromStruct msg (JsonValue' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 0 0
+ case tag of
+ 6 -> JsonValue'call <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 5 -> JsonValue'object <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 4 -> JsonValue'array <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 3 -> JsonValue'string <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 2 -> JsonValue'number <$> H'.getWordField struct 1 0 0
+ 1 -> JsonValue'boolean <$> H'.getWordField struct 0 16 0
+ 0 -> pure JsonValue'null
+ _ -> pure $ JsonValue'unknown' tag
+newtype JsonValue'Call msg = JsonValue'Call_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (JsonValue'Call msg) where
+ 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 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 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
+ fromPtr msg ptr = List_JsonValue'Call <$> C'.fromPtr msg ptr
+ toPtr (List_JsonValue'Call l) = C'.toPtr l
+get_JsonValue'Call'function :: U'.ReadCtx m msg => JsonValue'Call msg -> m (B'.Text msg)
+get_JsonValue'Call'function (JsonValue'Call_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_JsonValue'Call'function :: U'.ReadCtx m msg => JsonValue'Call msg -> m Bool
+has_JsonValue'Call'function(JsonValue'Call_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_JsonValue'Call'function :: U'.RWCtx m s => JsonValue'Call (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
+set_JsonValue'Call'function (JsonValue'Call_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'Call'function :: U'.RWCtx m s => Int -> JsonValue'Call (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
+new_JsonValue'Call'function len struct = do
+ result <- B'.newText (U'.message struct) len
+ set_JsonValue'Call'function struct result
+ pure result
+get_JsonValue'Call'params :: U'.ReadCtx m msg => JsonValue'Call msg -> m (B'.List msg (JsonValue msg))
+get_JsonValue'Call'params (JsonValue'Call_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_JsonValue'Call'params :: U'.ReadCtx m msg => JsonValue'Call msg -> m Bool
+has_JsonValue'Call'params(JsonValue'Call_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_JsonValue'Call'params :: U'.RWCtx m s => JsonValue'Call (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (JsonValue (M'.MutMsg s))) -> m ()
+set_JsonValue'Call'params (JsonValue'Call_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+new_JsonValue'Call'params :: U'.RWCtx m s => Int -> JsonValue'Call (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (JsonValue (M'.MutMsg s))))
+new_JsonValue'Call'params len struct = do
+ result <- C'.newList (U'.message struct) len
+ set_JsonValue'Call'params struct result
+ pure result
+newtype JsonValue'Field msg = JsonValue'Field_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (JsonValue'Field msg) where
+ 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 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 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
+ fromPtr msg ptr = List_JsonValue'Field <$> C'.fromPtr msg ptr
+ toPtr (List_JsonValue'Field l) = C'.toPtr l
+get_JsonValue'Field'name :: U'.ReadCtx m msg => JsonValue'Field msg -> m (B'.Text msg)
+get_JsonValue'Field'name (JsonValue'Field_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_JsonValue'Field'name :: U'.ReadCtx m msg => JsonValue'Field msg -> m Bool
+has_JsonValue'Field'name(JsonValue'Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_JsonValue'Field'name :: U'.RWCtx m s => JsonValue'Field (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
+set_JsonValue'Field'name (JsonValue'Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_JsonValue'Field'name :: U'.RWCtx m s => Int -> JsonValue'Field (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
+new_JsonValue'Field'name len struct = do
+ result <- B'.newText (U'.message struct) len
+ set_JsonValue'Field'name struct result
+ pure result
+get_JsonValue'Field'value :: U'.ReadCtx m msg => JsonValue'Field msg -> m (JsonValue msg)
+get_JsonValue'Field'value (JsonValue'Field_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_JsonValue'Field'value :: U'.ReadCtx m msg => JsonValue'Field msg -> m Bool
+has_JsonValue'Field'value(JsonValue'Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_JsonValue'Field'value :: U'.RWCtx m s => JsonValue'Field (M'.MutMsg s) -> (JsonValue (M'.MutMsg s)) -> m ()
+set_JsonValue'Field'value (JsonValue'Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+new_JsonValue'Field'value :: U'.RWCtx m s => JsonValue'Field (M'.MutMsg s) -> m ((JsonValue (M'.MutMsg s)))
+new_JsonValue'Field'value struct = do
+ result <- C'.new (U'.message struct)
+ set_JsonValue'Field'value struct result
+ pure result
diff --git a/lib/Capnp/Capnp/Json/Pure.hs b/lib/Capnp/Capnp/Json/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Json/Pure.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.Json.Pure
+Description: High-level generated module for capnp/json.capnp
+This module is the generated code for capnp/json.capnp,
+for the high-level api.
+-}
+module Capnp.Capnp.Json.Pure (JsonValue(..), JsonValue'Call(..), JsonValue'Field(..)
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/json.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.X8ef99297a43a5e34
+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)
+instance C'.Decerialize JsonValue where
+ type Cerial msg JsonValue = Capnp.ById.X8ef99297a43a5e34.JsonValue msg
+ decerialize raw = do
+ raw <- Capnp.ById.X8ef99297a43a5e34.get_JsonValue' raw
+ case raw of
+ Capnp.ById.X8ef99297a43a5e34.JsonValue'null -> pure JsonValue'null
+ Capnp.ById.X8ef99297a43a5e34.JsonValue'boolean val -> pure (JsonValue'boolean val)
+ Capnp.ById.X8ef99297a43a5e34.JsonValue'number val -> pure (JsonValue'number val)
+ Capnp.ById.X8ef99297a43a5e34.JsonValue'string val -> JsonValue'string <$> C'.decerialize val
+ 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)
+instance C'.Marshal JsonValue where
+ marshalInto raw value = do
+ case value of
+ JsonValue'null -> Capnp.ById.X8ef99297a43a5e34.set_JsonValue'null raw
+ JsonValue'boolean arg_ -> Capnp.ById.X8ef99297a43a5e34.set_JsonValue'boolean raw arg_
+ JsonValue'number arg_ -> Capnp.ById.X8ef99297a43a5e34.set_JsonValue'number raw arg_
+ JsonValue'string arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.X8ef99297a43a5e34.set_JsonValue'string raw field_
+ JsonValue'array arg_ -> do
+ let len_ = V.length arg_
+ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'array len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (arg_ V.! i)
+ JsonValue'object arg_ -> do
+ let len_ = V.length arg_
+ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'object len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (arg_ V.! i)
+ JsonValue'call arg_ -> do
+ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'call raw
+ C'.marshalInto field_ arg_
+ JsonValue'unknown' arg_ -> Capnp.ById.X8ef99297a43a5e34.set_JsonValue'unknown' raw arg_
+instance C'.Cerialize s JsonValue
+instance Default JsonValue where
+ def = PH'.defaultStruct
+data JsonValue'Call
+ = JsonValue'Call
+ {function :: Text,
+ params :: PU'.ListOf (JsonValue)}
+ 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
+ JsonValue'Call{..} -> do
+ field_ <- C'.cerialize (U'.message raw) function
+ Capnp.ById.X8ef99297a43a5e34.set_JsonValue'Call'function raw field_
+ let len_ = V.length params
+ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'Call'params len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (params V.! i)
+instance C'.Cerialize s JsonValue'Call
+instance Default JsonValue'Call where
+ def = PH'.defaultStruct
+data JsonValue'Field
+ = JsonValue'Field
+ {name :: Text,
+ value :: JsonValue}
+ 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
+ JsonValue'Field{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ Capnp.ById.X8ef99297a43a5e34.set_JsonValue'Field'name raw field_
+ field_ <- Capnp.ById.X8ef99297a43a5e34.new_JsonValue'Field'value raw
+ C'.marshalInto field_ value
+instance C'.Cerialize s JsonValue'Field
+instance Default JsonValue'Field where
+ def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Persistent.hs b/lib/Capnp/Capnp/Persistent.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Persistent.hs
@@ -0,0 +1,92 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.Persistent
+Description: Low-level generated module for capnp/persistent.capnp
+This module is the generated code for capnp/persistent.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.Persistent where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/persistent.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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 Persistent'SaveParams msg = Persistent'SaveParams_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Persistent'SaveParams msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Persistent'SaveParams <$> C'.fromPtr msg ptr
+ toPtr (List_Persistent'SaveParams l) = C'.toPtr l
+get_Persistent'SaveParams'sealFor :: U'.ReadCtx m msg => Persistent'SaveParams msg -> m (Maybe (U'.Ptr msg))
+get_Persistent'SaveParams'sealFor (Persistent'SaveParams_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Persistent'SaveParams'sealFor :: U'.ReadCtx m msg => Persistent'SaveParams msg -> m Bool
+has_Persistent'SaveParams'sealFor(Persistent'SaveParams_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Persistent'SaveParams'sealFor :: U'.RWCtx m s => Persistent'SaveParams (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Persistent'SaveParams'sealFor (Persistent'SaveParams_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+newtype Persistent'SaveResults msg = Persistent'SaveResults_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Persistent'SaveResults msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Persistent'SaveResults <$> C'.fromPtr msg ptr
+ toPtr (List_Persistent'SaveResults l) = C'.toPtr l
+get_Persistent'SaveResults'sturdyRef :: U'.ReadCtx m msg => Persistent'SaveResults msg -> m (Maybe (U'.Ptr msg))
+get_Persistent'SaveResults'sturdyRef (Persistent'SaveResults_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Persistent'SaveResults'sturdyRef :: U'.ReadCtx m msg => Persistent'SaveResults msg -> m Bool
+has_Persistent'SaveResults'sturdyRef(Persistent'SaveResults_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Persistent'SaveResults'sturdyRef :: U'.RWCtx m s => Persistent'SaveResults (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Persistent'SaveResults'sturdyRef (Persistent'SaveResults_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
diff --git a/lib/Capnp/Capnp/Persistent/Pure.hs b/lib/Capnp/Capnp/Persistent/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Persistent/Pure.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.Persistent.Pure
+Description: High-level generated module for capnp/persistent.capnp
+This module is the generated code for capnp/persistent.capnp,
+for the high-level api.
+-}
+module Capnp.Capnp.Persistent.Pure (Persistent'SaveParams(..), Persistent'SaveResults(..)
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/persistent.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.Xb8630836983feed7
+import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure
+import qualified Capnp.ById.Xbdf87d7bb8304e81
+data Persistent'SaveParams
+ = Persistent'SaveParams
+ {sealFor :: Maybe (PU'.PtrType)}
+ 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
+ Persistent'SaveParams{..} -> do
+ field_ <- C'.cerialize (U'.message raw) sealFor
+ Capnp.ById.Xb8630836983feed7.set_Persistent'SaveParams'sealFor raw field_
+instance C'.Cerialize s Persistent'SaveParams
+instance Default Persistent'SaveParams where
+ def = PH'.defaultStruct
+data Persistent'SaveResults
+ = Persistent'SaveResults
+ {sturdyRef :: Maybe (PU'.PtrType)}
+ 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
+ Persistent'SaveResults{..} -> do
+ field_ <- C'.cerialize (U'.message raw) sturdyRef
+ Capnp.ById.Xb8630836983feed7.set_Persistent'SaveResults'sturdyRef raw field_
+instance C'.Cerialize s Persistent'SaveResults
+instance Default Persistent'SaveResults where
+ def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Rpc.hs b/lib/Capnp/Capnp/Rpc.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Rpc.hs
@@ -0,0 +1,1301 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.Rpc
+Description: Low-level generated module for capnp/rpc.capnp
+This module is the generated code for capnp/rpc.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.Rpc where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/rpc.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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 Accept msg = Accept_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Accept msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Accept <$> C'.fromPtr msg ptr
+ 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))
+get_Accept'provision (Accept_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Accept'provision :: U'.ReadCtx m msg => Accept msg -> m Bool
+has_Accept'provision(Accept_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Accept'provision :: U'.RWCtx m s => Accept (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+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)
+instance C'.FromStruct msg (Bootstrap msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Bootstrap <$> C'.fromPtr msg ptr
+ 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))
+get_Bootstrap'deprecatedObjectId (Bootstrap_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Bootstrap'deprecatedObjectId :: U'.ReadCtx m msg => Bootstrap msg -> m Bool
+has_Bootstrap'deprecatedObjectId(Bootstrap_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Bootstrap'deprecatedObjectId :: U'.RWCtx m s => Bootstrap (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Bootstrap'deprecatedObjectId (Bootstrap_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+newtype Call msg = Call_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Call msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Call <$> C'.fromPtr msg ptr
+ 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)
+get_Call'target (Call_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Call'target :: U'.ReadCtx m msg => Call msg -> m Bool
+has_Call'target(Call_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Call'target :: U'.RWCtx m s => Call (M'.MutMsg s) -> (MessageTarget (M'.MutMsg s)) -> m ()
+set_Call'target (Call_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_Call'target :: U'.RWCtx m s => Call (M'.MutMsg s) -> m ((MessageTarget (M'.MutMsg s)))
+new_Call'target struct = do
+ result <- C'.new (U'.message struct)
+ set_Call'target struct result
+ 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)
+get_Call'params (Call_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Call'params :: U'.ReadCtx m msg => Call msg -> m Bool
+has_Call'params(Call_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_Call'params :: U'.RWCtx m s => Call (M'.MutMsg s) -> (Payload (M'.MutMsg s)) -> m ()
+set_Call'params (Call_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+new_Call'params :: U'.RWCtx m s => Call (M'.MutMsg s) -> m ((Payload (M'.MutMsg s)))
+new_Call'params struct = do
+ result <- C'.new (U'.message struct)
+ set_Call'params struct result
+ 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)
+instance C'.FromStruct msg (CapDescriptor msg) where
+ 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 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 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
+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 ()
+set_CapDescriptor'senderHosted (CapDescriptor_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
+set_CapDescriptor'senderPromise :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> Word32 -> m ()
+set_CapDescriptor'senderPromise (CapDescriptor_newtype_ struct) value = do
+ H'.setWordField struct (2 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
+set_CapDescriptor'receiverHosted :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> Word32 -> m ()
+set_CapDescriptor'receiverHosted (CapDescriptor_newtype_ struct) value = do
+ H'.setWordField struct (3 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
+set_CapDescriptor'receiverAnswer :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> (PromisedAnswer (M'.MutMsg s)) -> m ()
+set_CapDescriptor'receiverAnswer(CapDescriptor_newtype_ struct) value = do
+ H'.setWordField struct (4 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_CapDescriptor'receiverAnswer :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> m ((PromisedAnswer (M'.MutMsg s)))
+new_CapDescriptor'receiverAnswer struct = do
+ result <- C'.new (U'.message struct)
+ set_CapDescriptor'receiverAnswer struct result
+ pure result
+set_CapDescriptor'thirdPartyHosted :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> (ThirdPartyCapDescriptor (M'.MutMsg s)) -> m ()
+set_CapDescriptor'thirdPartyHosted(CapDescriptor_newtype_ struct) value = do
+ H'.setWordField struct (5 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_CapDescriptor'thirdPartyHosted :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> m ((ThirdPartyCapDescriptor (M'.MutMsg s)))
+new_CapDescriptor'thirdPartyHosted struct = do
+ result <- C'.new (U'.message struct)
+ set_CapDescriptor'thirdPartyHosted struct result
+ pure result
+set_CapDescriptor'unknown' :: U'.RWCtx m s => CapDescriptor (M'.MutMsg s) -> Word16 -> m ()
+set_CapDescriptor'unknown'(CapDescriptor_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
+instance C'.FromStruct msg (CapDescriptor' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 0 0
+ case tag of
+ 5 -> CapDescriptor'thirdPartyHosted <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 4 -> CapDescriptor'receiverAnswer <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 3 -> CapDescriptor'receiverHosted <$> H'.getWordField struct 0 32 0
+ 2 -> CapDescriptor'senderPromise <$> H'.getWordField struct 0 32 0
+ 1 -> CapDescriptor'senderHosted <$> H'.getWordField struct 0 32 0
+ 0 -> pure CapDescriptor'none
+ _ -> pure $ CapDescriptor'unknown' tag
+newtype Disembargo msg = Disembargo_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Disembargo msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Disembargo <$> C'.fromPtr msg ptr
+ toPtr (List_Disembargo l) = C'.toPtr l
+get_Disembargo'target :: U'.ReadCtx m msg => Disembargo msg -> m (MessageTarget msg)
+get_Disembargo'target (Disembargo_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Disembargo'target :: U'.ReadCtx m msg => Disembargo msg -> m Bool
+has_Disembargo'target(Disembargo_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Disembargo'target :: U'.RWCtx m s => Disembargo (M'.MutMsg s) -> (MessageTarget (M'.MutMsg s)) -> m ()
+set_Disembargo'target (Disembargo_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_Disembargo'target :: U'.RWCtx m s => Disembargo (M'.MutMsg s) -> m ((MessageTarget (M'.MutMsg s)))
+new_Disembargo'target struct = do
+ result <- C'.new (U'.message struct)
+ set_Disembargo'target struct result
+ 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 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 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
+ fromPtr msg ptr = List_Exception <$> C'.fromPtr msg ptr
+ toPtr (List_Exception l) = C'.toPtr l
+get_Exception'reason :: U'.ReadCtx m msg => Exception msg -> m (B'.Text msg)
+get_Exception'reason (Exception_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Exception'reason :: U'.ReadCtx m msg => Exception msg -> m Bool
+has_Exception'reason(Exception_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Exception'reason :: U'.RWCtx m s => Exception (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
+set_Exception'reason (Exception_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_Exception'reason :: U'.RWCtx m s => Int -> Exception (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
+new_Exception'reason len struct = do
+ result <- B'.newText (U'.message struct) len
+ set_Exception'reason struct result
+ 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)
+instance C'.FromStruct msg (Finish msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Finish <$> C'.fromPtr msg ptr
+ 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)
+instance C'.FromStruct msg (Join msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Join <$> C'.fromPtr msg ptr
+ 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)
+get_Join'target (Join_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Join'target :: U'.ReadCtx m msg => Join msg -> m Bool
+has_Join'target(Join_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Join'target :: U'.RWCtx m s => Join (M'.MutMsg s) -> (MessageTarget (M'.MutMsg s)) -> m ()
+set_Join'target (Join_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_Join'target :: U'.RWCtx m s => Join (M'.MutMsg s) -> m ((MessageTarget (M'.MutMsg s)))
+new_Join'target struct = do
+ result <- C'.new (U'.message struct)
+ set_Join'target struct result
+ pure result
+get_Join'keyPart :: U'.ReadCtx m msg => Join msg -> m (Maybe (U'.Ptr msg))
+get_Join'keyPart (Join_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Join'keyPart :: U'.ReadCtx m msg => Join msg -> m Bool
+has_Join'keyPart(Join_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_Join'keyPart :: U'.RWCtx m s => Join (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Join'keyPart (Join_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+newtype Message msg = Message_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Message msg) where
+ 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 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 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
+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
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'unimplemented :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Message (M'.MutMsg s)))
+new_Message'unimplemented struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'unimplemented struct result
+ pure result
+set_Message'abort :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Exception (M'.MutMsg s)) -> m ()
+set_Message'abort(Message_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'abort :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Exception (M'.MutMsg s)))
+new_Message'abort struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'abort struct result
+ pure result
+set_Message'call :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Call (M'.MutMsg s)) -> m ()
+set_Message'call(Message_newtype_ struct) value = do
+ H'.setWordField struct (2 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'call :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Call (M'.MutMsg s)))
+new_Message'call struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'call struct result
+ pure result
+set_Message'return :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Return (M'.MutMsg s)) -> m ()
+set_Message'return(Message_newtype_ struct) value = do
+ H'.setWordField struct (3 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'return :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Return (M'.MutMsg s)))
+new_Message'return struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'return struct result
+ pure result
+set_Message'finish :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Finish (M'.MutMsg s)) -> m ()
+set_Message'finish(Message_newtype_ struct) value = do
+ H'.setWordField struct (4 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'finish :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Finish (M'.MutMsg s)))
+new_Message'finish struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'finish struct result
+ pure result
+set_Message'resolve :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Resolve (M'.MutMsg s)) -> m ()
+set_Message'resolve(Message_newtype_ struct) value = do
+ H'.setWordField struct (5 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'resolve :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Resolve (M'.MutMsg s)))
+new_Message'resolve struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'resolve struct result
+ pure result
+set_Message'release :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Release (M'.MutMsg s)) -> m ()
+set_Message'release(Message_newtype_ struct) value = do
+ H'.setWordField struct (6 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'release :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Release (M'.MutMsg s)))
+new_Message'release struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'release struct result
+ pure result
+set_Message'obsoleteSave :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Message'obsoleteSave(Message_newtype_ struct) value = do
+ H'.setWordField struct (7 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+set_Message'bootstrap :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Bootstrap (M'.MutMsg s)) -> m ()
+set_Message'bootstrap(Message_newtype_ struct) value = do
+ H'.setWordField struct (8 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'bootstrap :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Bootstrap (M'.MutMsg s)))
+new_Message'bootstrap struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'bootstrap struct result
+ pure result
+set_Message'obsoleteDelete :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Message'obsoleteDelete(Message_newtype_ struct) value = do
+ H'.setWordField struct (9 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+set_Message'provide :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Provide (M'.MutMsg s)) -> m ()
+set_Message'provide(Message_newtype_ struct) value = do
+ H'.setWordField struct (10 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'provide :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Provide (M'.MutMsg s)))
+new_Message'provide struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'provide struct result
+ pure result
+set_Message'accept :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Accept (M'.MutMsg s)) -> m ()
+set_Message'accept(Message_newtype_ struct) value = do
+ H'.setWordField struct (11 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'accept :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Accept (M'.MutMsg s)))
+new_Message'accept struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'accept struct result
+ pure result
+set_Message'join :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Join (M'.MutMsg s)) -> m ()
+set_Message'join(Message_newtype_ struct) value = do
+ H'.setWordField struct (12 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'join :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Join (M'.MutMsg s)))
+new_Message'join struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'join struct result
+ pure result
+set_Message'disembargo :: U'.RWCtx m s => Message (M'.MutMsg s) -> (Disembargo (M'.MutMsg s)) -> m ()
+set_Message'disembargo(Message_newtype_ struct) value = do
+ H'.setWordField struct (13 :: Word16) 0 0 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Message'disembargo :: U'.RWCtx m s => Message (M'.MutMsg s) -> m ((Disembargo (M'.MutMsg s)))
+new_Message'disembargo struct = do
+ result <- C'.new (U'.message struct)
+ set_Message'disembargo struct result
+ pure result
+set_Message'unknown' :: U'.RWCtx m s => Message (M'.MutMsg s) -> Word16 -> m ()
+set_Message'unknown'(Message_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
+instance C'.FromStruct msg (Message' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 0 0
+ case tag of
+ 13 -> Message'disembargo <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 12 -> Message'join <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 11 -> Message'accept <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 10 -> Message'provide <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 9 -> Message'obsoleteDelete <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 8 -> Message'bootstrap <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 7 -> Message'obsoleteSave <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 6 -> Message'release <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 5 -> Message'resolve <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 4 -> Message'finish <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 3 -> Message'return <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 2 -> Message'call <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 1 -> Message'abort <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 0 -> Message'unimplemented <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ _ -> pure $ Message'unknown' tag
+newtype MessageTarget msg = MessageTarget_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (MessageTarget msg) where
+ 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 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 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
+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
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0
+set_MessageTarget'promisedAnswer :: U'.RWCtx m s => MessageTarget (M'.MutMsg s) -> (PromisedAnswer (M'.MutMsg s)) -> m ()
+set_MessageTarget'promisedAnswer(MessageTarget_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 32 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_MessageTarget'promisedAnswer :: U'.RWCtx m s => MessageTarget (M'.MutMsg s) -> m ((PromisedAnswer (M'.MutMsg s)))
+new_MessageTarget'promisedAnswer struct = do
+ result <- C'.new (U'.message struct)
+ set_MessageTarget'promisedAnswer struct result
+ pure result
+set_MessageTarget'unknown' :: U'.RWCtx m s => MessageTarget (M'.MutMsg s) -> Word16 -> m ()
+set_MessageTarget'unknown'(MessageTarget_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 32 0
+instance C'.FromStruct msg (MessageTarget' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 32 0
+ case tag of
+ 1 -> MessageTarget'promisedAnswer <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 0 -> MessageTarget'importedCap <$> H'.getWordField struct 0 0 0
+ _ -> pure $ MessageTarget'unknown' tag
+newtype Payload msg = Payload_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Payload msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Payload <$> C'.fromPtr msg ptr
+ toPtr (List_Payload l) = C'.toPtr l
+get_Payload'content :: U'.ReadCtx m msg => Payload msg -> m (Maybe (U'.Ptr msg))
+get_Payload'content (Payload_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Payload'content :: U'.ReadCtx m msg => Payload msg -> m Bool
+has_Payload'content(Payload_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Payload'content :: U'.RWCtx m s => Payload (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Payload'content (Payload_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+get_Payload'capTable :: U'.ReadCtx m msg => Payload msg -> m (B'.List msg (CapDescriptor msg))
+get_Payload'capTable (Payload_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Payload'capTable :: U'.ReadCtx m msg => Payload msg -> m Bool
+has_Payload'capTable(Payload_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_Payload'capTable :: U'.RWCtx m s => Payload (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CapDescriptor (M'.MutMsg s))) -> m ()
+set_Payload'capTable (Payload_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+new_Payload'capTable :: U'.RWCtx m s => Int -> Payload (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CapDescriptor (M'.MutMsg s))))
+new_Payload'capTable len struct = do
+ result <- C'.newList (U'.message struct) len
+ set_Payload'capTable struct result
+ pure result
+newtype PromisedAnswer msg = PromisedAnswer_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (PromisedAnswer msg) where
+ 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 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 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
+ fromPtr msg ptr = List_PromisedAnswer <$> C'.fromPtr msg ptr
+ 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))
+get_PromisedAnswer'transform (PromisedAnswer_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_PromisedAnswer'transform :: U'.ReadCtx m msg => PromisedAnswer msg -> m Bool
+has_PromisedAnswer'transform(PromisedAnswer_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_PromisedAnswer'transform :: U'.RWCtx m s => PromisedAnswer (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (PromisedAnswer'Op (M'.MutMsg s))) -> m ()
+set_PromisedAnswer'transform (PromisedAnswer_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_PromisedAnswer'transform :: U'.RWCtx m s => Int -> PromisedAnswer (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (PromisedAnswer'Op (M'.MutMsg s))))
+new_PromisedAnswer'transform len struct = do
+ result <- C'.newList (U'.message struct) len
+ set_PromisedAnswer'transform struct result
+ pure result
+newtype Provide msg = Provide_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Provide msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Provide <$> C'.fromPtr msg ptr
+ 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)
+get_Provide'target (Provide_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Provide'target :: U'.ReadCtx m msg => Provide msg -> m Bool
+has_Provide'target(Provide_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_Provide'target :: U'.RWCtx m s => Provide (M'.MutMsg s) -> (MessageTarget (M'.MutMsg s)) -> m ()
+set_Provide'target (Provide_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+new_Provide'target :: U'.RWCtx m s => Provide (M'.MutMsg s) -> m ((MessageTarget (M'.MutMsg s)))
+new_Provide'target struct = do
+ result <- C'.new (U'.message struct)
+ set_Provide'target struct result
+ pure result
+get_Provide'recipient :: U'.ReadCtx m msg => Provide msg -> m (Maybe (U'.Ptr msg))
+get_Provide'recipient (Provide_newtype_ struct) =
+ U'.getPtr 1 struct
+ >>= C'.fromPtr (U'.message struct)
+has_Provide'recipient :: U'.ReadCtx m msg => Provide msg -> m Bool
+has_Provide'recipient(Provide_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
+set_Provide'recipient :: U'.RWCtx m s => Provide (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Provide'recipient (Provide_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
+newtype Release msg = Release_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Release msg) where
+ 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 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 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
+ fromPtr msg ptr = List_Release <$> C'.fromPtr msg ptr
+ 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)
+instance C'.FromStruct msg (Resolve msg) where
+ 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 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 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
+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 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 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
+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 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 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
+ fromPtr msg ptr = List_ThirdPartyCapDescriptor <$> C'.fromPtr msg ptr
+ toPtr (List_ThirdPartyCapDescriptor l) = C'.toPtr l
+get_ThirdPartyCapDescriptor'id :: U'.ReadCtx m msg => ThirdPartyCapDescriptor msg -> m (Maybe (U'.Ptr msg))
+get_ThirdPartyCapDescriptor'id (ThirdPartyCapDescriptor_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_ThirdPartyCapDescriptor'id :: U'.ReadCtx m msg => ThirdPartyCapDescriptor msg -> m Bool
+has_ThirdPartyCapDescriptor'id(ThirdPartyCapDescriptor_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_ThirdPartyCapDescriptor'id :: U'.RWCtx m s => ThirdPartyCapDescriptor (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+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)
+instance C'.FromStruct msg (Call'sendResultsTo msg) where
+ 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
+ message (Call'sendResultsTo_newtype_ struct) = U'.message struct
+instance U'.MessageDefault (Call'sendResultsTo msg) 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
+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 ()
+set_Call'sendResultsTo'yourself (Call'sendResultsTo_newtype_ struct) = H'.setWordField struct (1 :: Word16) 0 48 0
+set_Call'sendResultsTo'thirdParty :: U'.RWCtx m s => Call'sendResultsTo (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_Call'sendResultsTo'thirdParty(Call'sendResultsTo_newtype_ struct) value = do
+ H'.setWordField struct (2 :: Word16) 0 48 0
+ U'.setPtr (C'.toPtr value) 2 struct
+set_Call'sendResultsTo'unknown' :: U'.RWCtx m s => Call'sendResultsTo (M'.MutMsg s) -> Word16 -> m ()
+set_Call'sendResultsTo'unknown'(Call'sendResultsTo_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 48 0
+instance C'.FromStruct msg (Call'sendResultsTo' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 48 0
+ case tag of
+ 2 -> Call'sendResultsTo'thirdParty <$> (U'.getPtr 2 struct >>= C'.fromPtr (U'.message struct))
+ 1 -> pure Call'sendResultsTo'yourself
+ 0 -> pure Call'sendResultsTo'caller
+ _ -> pure $ Call'sendResultsTo'unknown' tag
+newtype Disembargo'context msg = Disembargo'context_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Disembargo'context msg) where
+ 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
+ message (Disembargo'context_newtype_ struct) = U'.message struct
+instance U'.MessageDefault (Disembargo'context msg) 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
+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
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0
+set_Disembargo'context'receiverLoopback :: U'.RWCtx m s => Disembargo'context (M'.MutMsg s) -> Word32 -> m ()
+set_Disembargo'context'receiverLoopback (Disembargo'context_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 32 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0
+set_Disembargo'context'accept :: U'.RWCtx m s => Disembargo'context (M'.MutMsg s) -> m ()
+set_Disembargo'context'accept (Disembargo'context_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 32 0
+set_Disembargo'context'provide :: U'.RWCtx m s => Disembargo'context (M'.MutMsg s) -> Word32 -> m ()
+set_Disembargo'context'provide (Disembargo'context_newtype_ struct) value = do
+ H'.setWordField struct (3 :: Word16) 0 32 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 0 0
+set_Disembargo'context'unknown' :: U'.RWCtx m s => Disembargo'context (M'.MutMsg s) -> Word16 -> m ()
+set_Disembargo'context'unknown'(Disembargo'context_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 32 0
+instance C'.FromStruct msg (Disembargo'context' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 32 0
+ case tag of
+ 3 -> Disembargo'context'provide <$> H'.getWordField struct 0 0 0
+ 2 -> pure Disembargo'context'accept
+ 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)
+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 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'unknown' tag) = fromIntegral tag
+instance B'.ListElem msg Exception'Type where
+ newtype List msg Exception'Type = List_Exception'Type (U'.ListOf msg Word16)
+ length (List_Exception'Type l) = U'.length l
+ index i (List_Exception'Type l) = (C'.fromWord . fromIntegral) <$> U'.index i l
+instance B'.MutListElem s Exception'Type where
+ setIndex elt i (List_Exception'Type l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l
+ newList msg size = List_Exception'Type <$> U'.allocList16 msg size
+instance C'.IsPtr msg (B'.List msg Exception'Type) where
+ fromPtr msg ptr = List_Exception'Type <$> C'.fromPtr msg ptr
+ toPtr (List_Exception'Type l) = C'.toPtr l
+newtype PromisedAnswer'Op msg = PromisedAnswer'Op_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (PromisedAnswer'Op msg) where
+ 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 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 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
+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 ()
+set_PromisedAnswer'Op'getPointerField (PromisedAnswer'Op_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 0 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
+set_PromisedAnswer'Op'unknown' :: U'.RWCtx m s => PromisedAnswer'Op (M'.MutMsg s) -> Word16 -> m ()
+set_PromisedAnswer'Op'unknown'(PromisedAnswer'Op_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
+instance C'.FromStruct msg (PromisedAnswer'Op' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 0 0
+ case tag of
+ 1 -> PromisedAnswer'Op'getPointerField <$> H'.getWordField struct 0 16 0
+ 0 -> pure PromisedAnswer'Op'noop
+ _ -> pure $ PromisedAnswer'Op'unknown' tag
+newtype Resolve' msg = Resolve'_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (Resolve' msg) where
+ 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 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 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
+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
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Resolve'cap :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> m ((CapDescriptor (M'.MutMsg s)))
+new_Resolve'cap struct = do
+ result <- C'.new (U'.message struct)
+ set_Resolve'cap struct result
+ pure result
+set_Resolve'exception :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> (Exception (M'.MutMsg s)) -> m ()
+set_Resolve'exception(Resolve'_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 32 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Resolve'exception :: U'.RWCtx m s => Resolve' (M'.MutMsg s) -> m ((Exception (M'.MutMsg s)))
+new_Resolve'exception struct = do
+ 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
+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
+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 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 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
+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
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Return'results :: U'.RWCtx m s => Return' (M'.MutMsg s) -> m ((Payload (M'.MutMsg s)))
+new_Return'results struct = do
+ result <- C'.new (U'.message struct)
+ set_Return'results struct result
+ pure result
+set_Return'exception :: U'.RWCtx m s => Return' (M'.MutMsg s) -> (Exception (M'.MutMsg s)) -> m ()
+set_Return'exception(Return'_newtype_ struct) value = do
+ H'.setWordField struct (1 :: Word16) 0 48 0
+ U'.setPtr (C'.toPtr value) 0 struct
+new_Return'exception :: U'.RWCtx m s => Return' (M'.MutMsg s) -> m ((Exception (M'.MutMsg s)))
+new_Return'exception struct = do
+ result <- C'.new (U'.message struct)
+ set_Return'exception struct result
+ pure result
+set_Return'canceled :: U'.RWCtx m s => Return' (M'.MutMsg s) -> m ()
+set_Return'canceled (Return'_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 48 0
+set_Return'resultsSentElsewhere :: U'.RWCtx m s => Return' (M'.MutMsg s) -> m ()
+set_Return'resultsSentElsewhere (Return'_newtype_ struct) = H'.setWordField struct (3 :: Word16) 0 48 0
+set_Return'takeFromOtherQuestion :: U'.RWCtx m s => Return' (M'.MutMsg s) -> Word32 -> m ()
+set_Return'takeFromOtherQuestion (Return'_newtype_ struct) value = do
+ H'.setWordField struct (4 :: Word16) 0 48 0
+ H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 1 0 0
+set_Return'acceptFromThirdParty :: U'.RWCtx m s => Return' (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+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
+instance C'.FromStruct msg (Return'' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 0 48 0
+ case tag of
+ 5 -> Return'acceptFromThirdParty <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
+ 4 -> Return'takeFromOtherQuestion <$> H'.getWordField struct 1 0 0
+ 3 -> pure Return'resultsSentElsewhere
+ 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
diff --git a/lib/Capnp/Capnp/Rpc/Pure.hs b/lib/Capnp/Capnp/Rpc/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Rpc/Pure.hs
@@ -0,0 +1,753 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.Rpc.Pure
+Description: High-level generated module for capnp/rpc.capnp
+This module is the generated code for capnp/rpc.capnp,
+for the high-level api.
+-}
+module Capnp.Capnp.Rpc.Pure (Accept(..), Bootstrap(..), Call(..), CapDescriptor(..), Disembargo(..), Exception(..), Finish(..), Join(..), Message(..), MessageTarget(..), Payload(..), PromisedAnswer(..), Provide(..), Release(..), Resolve(..), Return(..), ThirdPartyCapDescriptor(..), Call'sendResultsTo(..), Disembargo'context(..), Capnp.ById.Xb312981b2552a250.Exception'Type(..), PromisedAnswer'Op(..), Resolve'(..), Return'(..)
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/rpc.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.Xb312981b2552a250
+import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure
+import qualified Capnp.ById.Xbdf87d7bb8304e81
+data Accept
+ = Accept
+ {questionId :: Word32,
+ provision :: Maybe (PU'.PtrType),
+ embargo :: Bool}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Accept where
+ type Cerial msg Accept = Capnp.ById.Xb312981b2552a250.Accept msg
+ decerialize raw = do
+ Accept <$>
+ (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
+ Accept{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Accept'questionId raw questionId
+ field_ <- C'.cerialize (U'.message raw) provision
+ Capnp.ById.Xb312981b2552a250.set_Accept'provision raw field_
+ Capnp.ById.Xb312981b2552a250.set_Accept'embargo raw embargo
+instance C'.Cerialize s Accept
+instance Default Accept where
+ def = PH'.defaultStruct
+data Bootstrap
+ = Bootstrap
+ {questionId :: Word32,
+ deprecatedObjectId :: Maybe (PU'.PtrType)}
+ 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
+ Bootstrap{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Bootstrap'questionId raw questionId
+ field_ <- C'.cerialize (U'.message raw) deprecatedObjectId
+ Capnp.ById.Xb312981b2552a250.set_Bootstrap'deprecatedObjectId raw field_
+instance C'.Cerialize s Bootstrap
+instance Default Bootstrap where
+ def = PH'.defaultStruct
+data Call
+ = Call
+ {questionId :: Word32,
+ target :: MessageTarget,
+ interfaceId :: Word64,
+ methodId :: Word16,
+ params :: Payload,
+ sendResultsTo :: Call'sendResultsTo,
+ allowThirdPartyTailCall :: Bool}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Call where
+ type Cerial msg Call = Capnp.ById.Xb312981b2552a250.Call msg
+ decerialize raw = do
+ Call <$>
+ (Capnp.ById.Xb312981b2552a250.get_Call'questionId raw) <*>
+ (Capnp.ById.Xb312981b2552a250.get_Call'target raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xb312981b2552a250.get_Call'interfaceId raw) <*>
+ (Capnp.ById.Xb312981b2552a250.get_Call'methodId raw) <*>
+ (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
+ Call{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Call'questionId raw questionId
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Call'target raw
+ C'.marshalInto field_ target
+ Capnp.ById.Xb312981b2552a250.set_Call'interfaceId raw interfaceId
+ Capnp.ById.Xb312981b2552a250.set_Call'methodId raw methodId
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Call'params raw
+ C'.marshalInto field_ params
+ field_ <- Capnp.ById.Xb312981b2552a250.get_Call'sendResultsTo raw
+ C'.marshalInto field_ sendResultsTo
+ Capnp.ById.Xb312981b2552a250.set_Call'allowThirdPartyTailCall raw allowThirdPartyTailCall
+instance C'.Cerialize s Call
+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)
+instance C'.Decerialize CapDescriptor where
+ type Cerial msg CapDescriptor = Capnp.ById.Xb312981b2552a250.CapDescriptor msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_CapDescriptor' raw
+ case raw of
+ Capnp.ById.Xb312981b2552a250.CapDescriptor'none -> pure CapDescriptor'none
+ Capnp.ById.Xb312981b2552a250.CapDescriptor'senderHosted val -> pure (CapDescriptor'senderHosted val)
+ Capnp.ById.Xb312981b2552a250.CapDescriptor'senderPromise val -> pure (CapDescriptor'senderPromise val)
+ 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)
+instance C'.Marshal CapDescriptor where
+ marshalInto raw value = do
+ case value of
+ CapDescriptor'none -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'none raw
+ CapDescriptor'senderHosted arg_ -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'senderHosted raw arg_
+ CapDescriptor'senderPromise arg_ -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'senderPromise raw arg_
+ CapDescriptor'receiverHosted arg_ -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'receiverHosted raw arg_
+ CapDescriptor'receiverAnswer arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_CapDescriptor'receiverAnswer raw
+ C'.marshalInto field_ arg_
+ CapDescriptor'thirdPartyHosted arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_CapDescriptor'thirdPartyHosted raw
+ C'.marshalInto field_ arg_
+ CapDescriptor'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_CapDescriptor'unknown' raw arg_
+instance C'.Cerialize s CapDescriptor
+instance Default CapDescriptor where
+ def = PH'.defaultStruct
+data Disembargo
+ = Disembargo
+ {target :: MessageTarget,
+ context :: Disembargo'context}
+ 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
+ Disembargo{..} -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Disembargo'target raw
+ C'.marshalInto field_ target
+ field_ <- Capnp.ById.Xb312981b2552a250.get_Disembargo'context raw
+ C'.marshalInto field_ context
+instance C'.Cerialize s Disembargo
+instance Default Disembargo where
+ def = PH'.defaultStruct
+data Exception
+ = Exception
+ {reason :: Text,
+ obsoleteIsCallersFault :: Bool,
+ obsoleteDurability :: Word16,
+ type_ :: Capnp.ById.Xb312981b2552a250.Exception'Type}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Exception where
+ type Cerial msg Exception = Capnp.ById.Xb312981b2552a250.Exception msg
+ decerialize raw = do
+ Exception <$>
+ (Capnp.ById.Xb312981b2552a250.get_Exception'reason raw >>= C'.decerialize) <*>
+ (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
+ Exception{..} -> do
+ field_ <- C'.cerialize (U'.message raw) reason
+ Capnp.ById.Xb312981b2552a250.set_Exception'reason raw field_
+ Capnp.ById.Xb312981b2552a250.set_Exception'obsoleteIsCallersFault raw obsoleteIsCallersFault
+ Capnp.ById.Xb312981b2552a250.set_Exception'obsoleteDurability raw obsoleteDurability
+ Capnp.ById.Xb312981b2552a250.set_Exception'type_ raw type_
+instance C'.Cerialize s Exception
+instance Default Exception where
+ def = PH'.defaultStruct
+data Finish
+ = Finish
+ {questionId :: Word32,
+ releaseResultCaps :: Bool}
+ 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
+ Finish{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Finish'questionId raw questionId
+ Capnp.ById.Xb312981b2552a250.set_Finish'releaseResultCaps raw releaseResultCaps
+instance C'.Cerialize s Finish
+instance Default Finish where
+ def = PH'.defaultStruct
+data Join
+ = Join
+ {questionId :: Word32,
+ target :: MessageTarget,
+ keyPart :: Maybe (PU'.PtrType)}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Join where
+ type Cerial msg Join = Capnp.ById.Xb312981b2552a250.Join msg
+ decerialize raw = do
+ Join <$>
+ (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
+ Join{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Join'questionId raw questionId
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Join'target raw
+ C'.marshalInto field_ target
+ field_ <- C'.cerialize (U'.message raw) keyPart
+ Capnp.ById.Xb312981b2552a250.set_Join'keyPart raw field_
+instance C'.Cerialize s Join
+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)
+instance C'.Decerialize Message where
+ type Cerial msg Message = Capnp.ById.Xb312981b2552a250.Message msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_Message' raw
+ case raw of
+ Capnp.ById.Xb312981b2552a250.Message'unimplemented val -> Message'unimplemented <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'abort val -> Message'abort <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'call val -> Message'call <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'return val -> Message'return <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'finish val -> Message'finish <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'resolve val -> Message'resolve <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'release val -> Message'release <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'obsoleteSave val -> Message'obsoleteSave <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'bootstrap val -> Message'bootstrap <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'obsoleteDelete val -> Message'obsoleteDelete <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Message'provide val -> Message'provide <$> C'.decerialize val
+ 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)
+instance C'.Marshal Message where
+ marshalInto raw value = do
+ case value of
+ Message'unimplemented arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'unimplemented raw
+ C'.marshalInto field_ arg_
+ Message'abort arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'abort raw
+ C'.marshalInto field_ arg_
+ Message'call arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'call raw
+ C'.marshalInto field_ arg_
+ Message'return arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'return raw
+ C'.marshalInto field_ arg_
+ Message'finish arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'finish raw
+ C'.marshalInto field_ arg_
+ Message'resolve arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'resolve raw
+ C'.marshalInto field_ arg_
+ Message'release arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'release raw
+ C'.marshalInto field_ arg_
+ Message'obsoleteSave arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.Xb312981b2552a250.set_Message'obsoleteSave raw field_
+ Message'bootstrap arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'bootstrap raw
+ C'.marshalInto field_ arg_
+ Message'obsoleteDelete arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.Xb312981b2552a250.set_Message'obsoleteDelete raw field_
+ Message'provide arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'provide raw
+ C'.marshalInto field_ arg_
+ Message'accept arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'accept raw
+ C'.marshalInto field_ arg_
+ Message'join arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'join raw
+ C'.marshalInto field_ arg_
+ Message'disembargo arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Message'disembargo raw
+ C'.marshalInto field_ arg_
+ Message'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_Message'unknown' raw arg_
+instance C'.Cerialize s Message
+instance Default Message where
+ def = PH'.defaultStruct
+data MessageTarget
+ = 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
+ raw <- Capnp.ById.Xb312981b2552a250.get_MessageTarget' raw
+ 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)
+instance C'.Marshal MessageTarget where
+ marshalInto raw value = do
+ case value of
+ MessageTarget'importedCap arg_ -> Capnp.ById.Xb312981b2552a250.set_MessageTarget'importedCap raw arg_
+ MessageTarget'promisedAnswer arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_MessageTarget'promisedAnswer raw
+ C'.marshalInto field_ arg_
+ MessageTarget'unknown' arg_ -> Capnp.ById.Xb312981b2552a250.set_MessageTarget'unknown' raw arg_
+instance C'.Cerialize s MessageTarget
+instance Default MessageTarget where
+ def = PH'.defaultStruct
+data Payload
+ = Payload
+ {content :: Maybe (PU'.PtrType),
+ capTable :: PU'.ListOf (CapDescriptor)}
+ 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
+ Payload{..} -> do
+ field_ <- C'.cerialize (U'.message raw) content
+ Capnp.ById.Xb312981b2552a250.set_Payload'content raw field_
+ let len_ = V.length capTable
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Payload'capTable len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (capTable V.! i)
+instance C'.Cerialize s Payload
+instance Default Payload where
+ def = PH'.defaultStruct
+data PromisedAnswer
+ = PromisedAnswer
+ {questionId :: Word32,
+ transform :: PU'.ListOf (PromisedAnswer'Op)}
+ 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
+ PromisedAnswer{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_PromisedAnswer'questionId raw questionId
+ let len_ = V.length transform
+ field_ <- Capnp.ById.Xb312981b2552a250.new_PromisedAnswer'transform len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (transform V.! i)
+instance C'.Cerialize s PromisedAnswer
+instance Default PromisedAnswer where
+ def = PH'.defaultStruct
+data Provide
+ = Provide
+ {questionId :: Word32,
+ target :: MessageTarget,
+ recipient :: Maybe (PU'.PtrType)}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Provide where
+ type Cerial msg Provide = Capnp.ById.Xb312981b2552a250.Provide msg
+ decerialize raw = do
+ Provide <$>
+ (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
+ Provide{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Provide'questionId raw questionId
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Provide'target raw
+ C'.marshalInto field_ target
+ field_ <- C'.cerialize (U'.message raw) recipient
+ Capnp.ById.Xb312981b2552a250.set_Provide'recipient raw field_
+instance C'.Cerialize s Provide
+instance Default Provide where
+ def = PH'.defaultStruct
+data Release
+ = Release
+ {id :: Word32,
+ referenceCount :: Word32}
+ 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
+ Release{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Release'id raw id
+ Capnp.ById.Xb312981b2552a250.set_Release'referenceCount raw referenceCount
+instance C'.Cerialize s Release
+instance Default Release where
+ def = PH'.defaultStruct
+data Resolve
+ = Resolve
+ {promiseId :: Word32,
+ union' :: Resolve'}
+ 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
+ Resolve{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Resolve'promiseId raw promiseId
+ field_ <- Capnp.ById.Xb312981b2552a250.get_Resolve'union' raw
+ C'.marshalInto field_ union'
+instance C'.Cerialize s Resolve
+instance Default Resolve where
+ def = PH'.defaultStruct
+data Return
+ = Return
+ {answerId :: Word32,
+ releaseParamCaps :: Bool,
+ union' :: Return'}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Return where
+ type Cerial msg Return = Capnp.ById.Xb312981b2552a250.Return msg
+ decerialize raw = do
+ Return <$>
+ (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
+ Return{..} -> do
+ Capnp.ById.Xb312981b2552a250.set_Return'answerId raw answerId
+ Capnp.ById.Xb312981b2552a250.set_Return'releaseParamCaps raw releaseParamCaps
+ field_ <- Capnp.ById.Xb312981b2552a250.get_Return'union' raw
+ C'.marshalInto field_ union'
+instance C'.Cerialize s Return
+instance Default Return where
+ def = PH'.defaultStruct
+data ThirdPartyCapDescriptor
+ = ThirdPartyCapDescriptor
+ {id :: Maybe (PU'.PtrType),
+ vineId :: Word32}
+ 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
+ ThirdPartyCapDescriptor{..} -> do
+ field_ <- C'.cerialize (U'.message raw) id
+ Capnp.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'id raw field_
+ Capnp.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'vineId raw vineId
+instance C'.Cerialize s ThirdPartyCapDescriptor
+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)
+instance C'.Decerialize Call'sendResultsTo where
+ type Cerial msg Call'sendResultsTo = Capnp.ById.Xb312981b2552a250.Call'sendResultsTo msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_Call'sendResultsTo' raw
+ case raw of
+ 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)
+instance C'.Marshal Call'sendResultsTo where
+ marshalInto raw value = do
+ case value of
+ Call'sendResultsTo'caller -> Capnp.ById.Xb312981b2552a250.set_Call'sendResultsTo'caller raw
+ Call'sendResultsTo'yourself -> Capnp.ById.Xb312981b2552a250.set_Call'sendResultsTo'yourself raw
+ Call'sendResultsTo'thirdParty arg_ -> do
+ 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 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)
+instance C'.Decerialize Disembargo'context where
+ type Cerial msg Disembargo'context = Capnp.ById.Xb312981b2552a250.Disembargo'context msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_Disembargo'context' raw
+ case raw of
+ Capnp.ById.Xb312981b2552a250.Disembargo'context'senderLoopback val -> pure (Disembargo'context'senderLoopback val)
+ 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)
+instance C'.Marshal Disembargo'context where
+ marshalInto raw value = do
+ case value of
+ Disembargo'context'senderLoopback arg_ -> Capnp.ById.Xb312981b2552a250.set_Disembargo'context'senderLoopback raw arg_
+ Disembargo'context'receiverLoopback arg_ -> Capnp.ById.Xb312981b2552a250.set_Disembargo'context'receiverLoopback raw arg_
+ 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 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)
+instance C'.Decerialize PromisedAnswer'Op where
+ type Cerial msg PromisedAnswer'Op = Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_PromisedAnswer'Op' raw
+ 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)
+instance C'.Marshal PromisedAnswer'Op where
+ marshalInto raw value = do
+ case value of
+ PromisedAnswer'Op'noop -> Capnp.ById.Xb312981b2552a250.set_PromisedAnswer'Op'noop raw
+ 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 Default PromisedAnswer'Op where
+ def = PH'.defaultStruct
+data Resolve'
+ = 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
+ raw <- Capnp.ById.Xb312981b2552a250.get_Resolve'' raw
+ 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)
+instance C'.Marshal Resolve' where
+ marshalInto raw value = do
+ case value of
+ Resolve'cap arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Resolve'cap raw
+ C'.marshalInto field_ arg_
+ 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_
+instance C'.Cerialize s Resolve'
+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)
+instance C'.Decerialize Return' where
+ type Cerial msg Return' = Capnp.ById.Xb312981b2552a250.Return' msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xb312981b2552a250.get_Return'' raw
+ case raw of
+ Capnp.ById.Xb312981b2552a250.Return'results val -> Return'results <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Return'exception val -> Return'exception <$> C'.decerialize val
+ Capnp.ById.Xb312981b2552a250.Return'canceled -> pure Return'canceled
+ 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)
+instance C'.Marshal Return' where
+ marshalInto raw value = do
+ case value of
+ Return'results arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Return'results raw
+ C'.marshalInto field_ arg_
+ Return'exception arg_ -> do
+ field_ <- Capnp.ById.Xb312981b2552a250.new_Return'exception raw
+ C'.marshalInto field_ arg_
+ Return'canceled -> Capnp.ById.Xb312981b2552a250.set_Return'canceled raw
+ Return'resultsSentElsewhere -> Capnp.ById.Xb312981b2552a250.set_Return'resultsSentElsewhere raw
+ Return'takeFromOtherQuestion arg_ -> Capnp.ById.Xb312981b2552a250.set_Return'takeFromOtherQuestion raw arg_
+ 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_
+instance C'.Cerialize s Return'
+instance Default Return' where
+ def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/RpcTwoparty.hs b/lib/Capnp/Capnp/RpcTwoparty.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/RpcTwoparty.hs
@@ -0,0 +1,200 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.RpcTwoparty
+Description: Low-level generated module for capnp/rpc-twoparty.capnp
+This module is the generated code for capnp/rpc-twoparty.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.RpcTwoparty where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/rpc-twoparty.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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 JoinKeyPart msg = JoinKeyPart_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (JoinKeyPart msg) where
+ 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 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 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
+ fromPtr msg ptr = List_JoinKeyPart <$> C'.fromPtr msg ptr
+ 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)
+instance C'.FromStruct msg (JoinResult msg) where
+ 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 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 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
+ fromPtr msg ptr = List_JoinResult <$> C'.fromPtr msg ptr
+ 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))
+get_JoinResult'cap (JoinResult_newtype_ struct) =
+ U'.getPtr 0 struct
+ >>= C'.fromPtr (U'.message struct)
+has_JoinResult'cap :: U'.ReadCtx m msg => JoinResult msg -> m Bool
+has_JoinResult'cap(JoinResult_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
+set_JoinResult'cap :: U'.RWCtx m s => JoinResult (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
+set_JoinResult'cap (JoinResult_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
+newtype ProvisionId msg = ProvisionId_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (ProvisionId msg) where
+ 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 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 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
+ fromPtr msg ptr = List_ProvisionId <$> C'.fromPtr msg ptr
+ 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)
+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 tag = Side'unknown' (fromIntegral tag)
+ toWord Side'client = 1
+ toWord Side'server = 0
+ toWord (Side'unknown' tag) = fromIntegral tag
+instance B'.ListElem msg Side where
+ newtype List msg Side = List_Side (U'.ListOf msg Word16)
+ length (List_Side l) = U'.length l
+ index i (List_Side l) = (C'.fromWord . fromIntegral) <$> U'.index i l
+instance B'.MutListElem s Side where
+ setIndex elt i (List_Side l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l
+ newList msg size = List_Side <$> U'.allocList16 msg size
+instance C'.IsPtr msg (B'.List msg Side) where
+ fromPtr msg ptr = List_Side <$> C'.fromPtr msg ptr
+ toPtr (List_Side l) = C'.toPtr l
+newtype VatId msg = VatId_newtype_ (U'.Struct msg)
+instance C'.FromStruct msg (VatId msg) where
+ 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 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 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
+ fromPtr msg ptr = List_VatId <$> C'.fromPtr msg ptr
+ 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
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/RpcTwoparty/Pure.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.RpcTwoparty.Pure
+Description: High-level generated module for capnp/rpc-twoparty.capnp
+This module is the generated code for capnp/rpc-twoparty.capnp,
+for the high-level api.
+-}
+module Capnp.Capnp.RpcTwoparty.Pure (JoinKeyPart(..), JoinResult(..), ProvisionId(..), Capnp.ById.Xa184c7885cdaf2a1.Side(..), VatId(..)
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/rpc-twoparty.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.Xa184c7885cdaf2a1
+import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure
+import qualified Capnp.ById.Xbdf87d7bb8304e81
+data JoinKeyPart
+ = JoinKeyPart
+ {joinId :: Word32,
+ partCount :: Word16,
+ partNum :: Word16}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize JoinKeyPart where
+ type Cerial msg JoinKeyPart = Capnp.ById.Xa184c7885cdaf2a1.JoinKeyPart msg
+ decerialize raw = do
+ JoinKeyPart <$>
+ (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
+ JoinKeyPart{..} -> do
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'joinId raw joinId
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partCount raw partCount
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partNum raw partNum
+instance C'.Cerialize s JoinKeyPart
+instance Default JoinKeyPart where
+ def = PH'.defaultStruct
+data JoinResult
+ = JoinResult
+ {joinId :: Word32,
+ succeeded :: Bool,
+ cap :: Maybe (PU'.PtrType)}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize JoinResult where
+ type Cerial msg JoinResult = Capnp.ById.Xa184c7885cdaf2a1.JoinResult msg
+ decerialize raw = do
+ JoinResult <$>
+ (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
+ JoinResult{..} -> do
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinResult'joinId raw joinId
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinResult'succeeded raw succeeded
+ field_ <- C'.cerialize (U'.message raw) cap
+ Capnp.ById.Xa184c7885cdaf2a1.set_JoinResult'cap raw field_
+instance C'.Cerialize s JoinResult
+instance Default JoinResult where
+ def = PH'.defaultStruct
+data ProvisionId
+ = ProvisionId
+ {joinId :: Word32}
+ 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 Default ProvisionId where
+ def = PH'.defaultStruct
+data VatId
+ = VatId
+ {side :: Capnp.ById.Xa184c7885cdaf2a1.Side}
+ 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 Default VatId where
+ def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Schema.hs b/lib/Capnp/Capnp/Schema.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Schema.hs
@@ -0,0 +1,2223 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{- |
+Module: Capnp.Capnp.Schema
+Description: Low-level generated module for capnp/schema.capnp
+This module is the generated code for capnp/schema.capnp, for the
+low-level api.
+-}
+module Capnp.Capnp.Schema where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/schema.capnp
+import Data.Int
+import Data.Word
+import GHC.Generics (Generic)
+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
+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 ()
+set_Type'anyPointer'unconstrained'struct (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 16 0
+set_Type'anyPointer'unconstrained'list :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
+set_Type'anyPointer'unconstrained'list (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (2 :: Word16) 1 16 0
+set_Type'anyPointer'unconstrained'capability :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
+set_Type'anyPointer'unconstrained'capability (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (3 :: Word16) 1 16 0
+set_Type'anyPointer'unconstrained'unknown' :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> Word16 -> m ()
+set_Type'anyPointer'unconstrained'unknown'(Type'anyPointer'unconstrained_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0
+instance C'.FromStruct msg (Type'anyPointer'unconstrained' msg) where
+ fromStruct struct = do
+ tag <- H'.getWordField struct 1 16 0
+ case tag of
+ 3 -> pure Type'anyPointer'unconstrained'capability
+ 2 -> pure Type'anyPointer'unconstrained'list
+ 1 -> pure Type'anyPointer'unconstrained'struct
+ 0 -> pure Type'anyPointer'unconstrained'anyKind
+ _ -> pure $ Type'anyPointer'unconstrained'unknown' tag
diff --git a/lib/Capnp/Capnp/Schema/Pure.hs b/lib/Capnp/Capnp/Schema/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Capnp/Schema/Pure.hs
@@ -0,0 +1,1039 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{- |
+Module: Capnp.Capnp.Schema.Pure
+Description: High-level generated module for capnp/schema.capnp
+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(..)
+) where
+-- Code generated by capnpc-haskell. DO NOT EDIT.
+-- Generated from schema file: capnp/schema.capnp
+import Data.Int
+import Data.Word
+import Data.Default (Default(def))
+import GHC.Generics (Generic)
+import Data.Capnp.Basics.Pure (Data, Text)
+import Control.Monad.Catch (MonadThrow)
+import Data.Capnp.TraversalLimit (MonadLimit)
+import Control.Monad (forM_)
+import qualified Data.Capnp.Message as M'
+import qualified Data.Capnp.Untyped as U'
+import qualified Data.Capnp.Untyped.Pure as PU'
+import qualified Data.Capnp.GenHelpers.Pure as PH'
+import qualified Data.Capnp.Classes as C'
+import qualified Data.Vector as V
+import qualified Data.ByteString as BS
+import qualified Capnp.ById.Xa93fc509624c72d9
+import qualified Capnp.ById.Xbdf87d7bb8304e81.Pure
+import qualified Capnp.ById.Xbdf87d7bb8304e81
+data Annotation
+ = Annotation
+ {id :: Word64,
+ value :: Value,
+ brand :: Brand}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Annotation where
+ type Cerial msg Annotation = Capnp.ById.Xa93fc509624c72d9.Annotation msg
+ decerialize raw = do
+ Annotation <$>
+ (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
+ Annotation{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_Annotation'id raw id
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Annotation'value raw
+ C'.marshalInto field_ value
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Annotation'brand raw
+ C'.marshalInto field_ brand
+instance C'.Cerialize s Annotation
+instance Default Annotation where
+ def = PH'.defaultStruct
+data Brand
+ = Brand
+ {scopes :: PU'.ListOf (Brand'Scope)}
+ 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
+ Brand{..} -> do
+ let len_ = V.length scopes
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'scopes len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (scopes V.! i)
+instance C'.Cerialize s Brand
+instance Default Brand where
+ def = PH'.defaultStruct
+data CapnpVersion
+ = CapnpVersion
+ {major :: Word16,
+ minor :: Word8,
+ micro :: Word8}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize CapnpVersion where
+ type Cerial msg CapnpVersion = Capnp.ById.Xa93fc509624c72d9.CapnpVersion msg
+ decerialize raw = do
+ CapnpVersion <$>
+ (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
+ CapnpVersion{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'major raw major
+ Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'minor raw minor
+ Capnp.ById.Xa93fc509624c72d9.set_CapnpVersion'micro raw micro
+instance C'.Cerialize s CapnpVersion
+instance Default CapnpVersion where
+ def = PH'.defaultStruct
+data CodeGeneratorRequest
+ = CodeGeneratorRequest
+ {nodes :: PU'.ListOf (Node),
+ requestedFiles :: PU'.ListOf (CodeGeneratorRequest'RequestedFile),
+ capnpVersion :: CapnpVersion}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize CodeGeneratorRequest where
+ type Cerial msg CodeGeneratorRequest = Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg
+ decerialize raw = do
+ CodeGeneratorRequest <$>
+ (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
+ CodeGeneratorRequest{..} -> do
+ let len_ = V.length nodes
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'nodes len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (nodes V.! i)
+ let len_ = V.length requestedFiles
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'requestedFiles len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (requestedFiles V.! i)
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'capnpVersion raw
+ C'.marshalInto field_ capnpVersion
+instance C'.Cerialize s CodeGeneratorRequest
+instance Default CodeGeneratorRequest where
+ def = PH'.defaultStruct
+data Enumerant
+ = Enumerant
+ {name :: Text,
+ codeOrder :: Word16,
+ annotations :: PU'.ListOf (Annotation)}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Enumerant where
+ type Cerial msg Enumerant = Capnp.ById.Xa93fc509624c72d9.Enumerant msg
+ decerialize raw = do
+ Enumerant <$>
+ (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
+ Enumerant{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ Capnp.ById.Xa93fc509624c72d9.set_Enumerant'name raw field_
+ Capnp.ById.Xa93fc509624c72d9.set_Enumerant'codeOrder raw codeOrder
+ let len_ = V.length annotations
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Enumerant'annotations len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (annotations V.! i)
+instance C'.Cerialize s Enumerant
+instance Default Enumerant where
+ def = PH'.defaultStruct
+data Field
+ = Field
+ {name :: Text,
+ codeOrder :: Word16,
+ annotations :: PU'.ListOf (Annotation),
+ discriminantValue :: Word16,
+ ordinal :: Field'ordinal,
+ union' :: Field'}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Field where
+ type Cerial msg Field = Capnp.ById.Xa93fc509624c72d9.Field msg
+ decerialize raw = do
+ Field <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'name raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'codeOrder raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'annotations raw >>= C'.decerialize) <*>
+ (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
+ Field{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ Capnp.ById.Xa93fc509624c72d9.set_Field'name raw field_
+ Capnp.ById.Xa93fc509624c72d9.set_Field'codeOrder raw codeOrder
+ let len_ = V.length annotations
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'annotations len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (annotations V.! i)
+ Capnp.ById.Xa93fc509624c72d9.set_Field'discriminantValue raw discriminantValue
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal raw
+ C'.marshalInto field_ ordinal
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Field'union' raw
+ C'.marshalInto field_ union'
+instance C'.Cerialize s Field
+instance Default Field where
+ def = PH'.defaultStruct
+data Method
+ = Method
+ {name :: Text,
+ codeOrder :: Word16,
+ paramStructType :: Word64,
+ resultStructType :: Word64,
+ annotations :: PU'.ListOf (Annotation),
+ paramBrand :: Brand,
+ resultBrand :: Brand,
+ implicitParameters :: PU'.ListOf (Node'Parameter)}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Method where
+ type Cerial msg Method = Capnp.ById.Xa93fc509624c72d9.Method msg
+ decerialize raw = do
+ Method <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Method'name raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Method'codeOrder raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Method'paramStructType raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Method'resultStructType raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Method'annotations raw >>= C'.decerialize) <*>
+ (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
+ Method{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ Capnp.ById.Xa93fc509624c72d9.set_Method'name raw field_
+ Capnp.ById.Xa93fc509624c72d9.set_Method'codeOrder raw codeOrder
+ Capnp.ById.Xa93fc509624c72d9.set_Method'paramStructType raw paramStructType
+ Capnp.ById.Xa93fc509624c72d9.set_Method'resultStructType raw resultStructType
+ let len_ = V.length annotations
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'annotations len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (annotations V.! i)
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'paramBrand raw
+ C'.marshalInto field_ paramBrand
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'resultBrand raw
+ C'.marshalInto field_ resultBrand
+ let len_ = V.length implicitParameters
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Method'implicitParameters len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (implicitParameters V.! i)
+instance C'.Cerialize s Method
+instance Default Method where
+ def = PH'.defaultStruct
+data Node
+ = Node
+ {id :: Word64,
+ displayName :: Text,
+ displayNamePrefixLength :: Word32,
+ scopeId :: Word64,
+ nestedNodes :: PU'.ListOf (Node'NestedNode),
+ annotations :: PU'.ListOf (Annotation),
+ parameters :: PU'.ListOf (Node'Parameter),
+ isGeneric :: Bool,
+ union' :: Node'}
+ deriving(Show, Read, Eq, Generic)
+instance C'.Decerialize Node where
+ type Cerial msg Node = Capnp.ById.Xa93fc509624c72d9.Node msg
+ decerialize raw = do
+ Node <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'id raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'displayName raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'displayNamePrefixLength raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'scopeId raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'nestedNodes raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotations raw >>= C'.decerialize) <*>
+ (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
+ Node{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_Node'id raw id
+ field_ <- C'.cerialize (U'.message raw) displayName
+ Capnp.ById.Xa93fc509624c72d9.set_Node'displayName raw field_
+ Capnp.ById.Xa93fc509624c72d9.set_Node'displayNamePrefixLength raw displayNamePrefixLength
+ Capnp.ById.Xa93fc509624c72d9.set_Node'scopeId raw scopeId
+ let len_ = V.length nestedNodes
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'nestedNodes len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (nestedNodes V.! i)
+ let len_ = V.length annotations
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'annotations len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (annotations V.! i)
+ let len_ = V.length parameters
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'parameters len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (parameters V.! i)
+ Capnp.ById.Xa93fc509624c72d9.set_Node'isGeneric raw isGeneric
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Node'union' raw
+ C'.marshalInto field_ union'
+instance C'.Cerialize s Node
+instance Default Node where
+ def = PH'.defaultStruct
+data Superclass
+ = Superclass
+ {id :: Word64,
+ brand :: Brand}
+ 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
+ Superclass{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_Superclass'id raw id
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Superclass'brand raw
+ C'.marshalInto field_ brand
+instance C'.Cerialize s Superclass
+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
+ {typeId :: Word64,
+ brand :: Brand} |
+ Type'struct
+ {typeId :: Word64,
+ brand :: Brand} |
+ Type'interface
+ {typeId :: Word64,
+ 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
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Type' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Type'void -> pure Type'void
+ Capnp.ById.Xa93fc509624c72d9.Type'bool -> pure Type'bool
+ Capnp.ById.Xa93fc509624c72d9.Type'int8 -> pure Type'int8
+ Capnp.ById.Xa93fc509624c72d9.Type'int16 -> pure Type'int16
+ Capnp.ById.Xa93fc509624c72d9.Type'int32 -> pure Type'int32
+ Capnp.ById.Xa93fc509624c72d9.Type'int64 -> pure Type'int64
+ Capnp.ById.Xa93fc509624c72d9.Type'uint8 -> pure Type'uint8
+ Capnp.ById.Xa93fc509624c72d9.Type'uint16 -> pure Type'uint16
+ Capnp.ById.Xa93fc509624c72d9.Type'uint32 -> pure Type'uint32
+ Capnp.ById.Xa93fc509624c72d9.Type'uint64 -> pure Type'uint64
+ Capnp.ById.Xa93fc509624c72d9.Type'float32 -> pure Type'float32
+ Capnp.ById.Xa93fc509624c72d9.Type'float64 -> pure Type'float64
+ Capnp.ById.Xa93fc509624c72d9.Type'text -> pure Type'text
+ Capnp.ById.Xa93fc509624c72d9.Type'data_ -> pure Type'data_
+ Capnp.ById.Xa93fc509624c72d9.Type'list raw -> Type'list <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'list'elementType raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Type'enum raw -> Type'enum <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'enum'typeId raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'enum'brand raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Type'struct raw -> Type'struct <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'struct'typeId raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'struct'brand raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Type'interface raw -> Type'interface <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'interface'typeId raw) <*>
+ (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)
+instance C'.Marshal Type where
+ marshalInto raw value = do
+ case value of
+ Type'void -> Capnp.ById.Xa93fc509624c72d9.set_Type'void raw
+ Type'bool -> Capnp.ById.Xa93fc509624c72d9.set_Type'bool raw
+ Type'int8 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int8 raw
+ Type'int16 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int16 raw
+ Type'int32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int32 raw
+ Type'int64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'int64 raw
+ Type'uint8 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint8 raw
+ Type'uint16 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint16 raw
+ Type'uint32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint32 raw
+ Type'uint64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'uint64 raw
+ Type'float32 -> Capnp.ById.Xa93fc509624c72d9.set_Type'float32 raw
+ Type'float64 -> Capnp.ById.Xa93fc509624c72d9.set_Type'float64 raw
+ Type'text -> Capnp.ById.Xa93fc509624c72d9.set_Type'text raw
+ Type'data_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'data_ raw
+ Type'list{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'list raw
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'list'elementType raw
+ C'.marshalInto field_ elementType
+ Type'enum{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'enum raw
+ Capnp.ById.Xa93fc509624c72d9.set_Type'enum'typeId raw typeId
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'enum'brand raw
+ C'.marshalInto field_ brand
+ Type'struct{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'struct raw
+ Capnp.ById.Xa93fc509624c72d9.set_Type'struct'typeId raw typeId
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'struct'brand raw
+ C'.marshalInto field_ brand
+ Type'interface{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'interface raw
+ Capnp.ById.Xa93fc509624c72d9.set_Type'interface'typeId raw typeId
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Type'interface'brand raw
+ C'.marshalInto field_ brand
+ Type'anyPointer{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer raw
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'union' raw
+ C'.marshalInto field_ union'
+ Type'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Type'unknown' raw arg_
+instance C'.Cerialize s Type
+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)
+instance C'.Decerialize Value where
+ type Cerial msg Value = Capnp.ById.Xa93fc509624c72d9.Value msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Value' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Value'void -> pure Value'void
+ Capnp.ById.Xa93fc509624c72d9.Value'bool val -> pure (Value'bool val)
+ Capnp.ById.Xa93fc509624c72d9.Value'int8 val -> pure (Value'int8 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'int16 val -> pure (Value'int16 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'int32 val -> pure (Value'int32 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'int64 val -> pure (Value'int64 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'uint8 val -> pure (Value'uint8 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'uint16 val -> pure (Value'uint16 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'uint32 val -> pure (Value'uint32 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'uint64 val -> pure (Value'uint64 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'float32 val -> pure (Value'float32 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'float64 val -> pure (Value'float64 val)
+ Capnp.ById.Xa93fc509624c72d9.Value'text val -> Value'text <$> C'.decerialize val
+ Capnp.ById.Xa93fc509624c72d9.Value'data_ val -> Value'data_ <$> C'.decerialize val
+ Capnp.ById.Xa93fc509624c72d9.Value'list val -> Value'list <$> C'.decerialize val
+ Capnp.ById.Xa93fc509624c72d9.Value'enum val -> pure (Value'enum val)
+ 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)
+instance C'.Marshal Value where
+ marshalInto raw value = do
+ case value of
+ Value'void -> Capnp.ById.Xa93fc509624c72d9.set_Value'void raw
+ Value'bool arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'bool raw arg_
+ Value'int8 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int8 raw arg_
+ Value'int16 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int16 raw arg_
+ Value'int32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int32 raw arg_
+ Value'int64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'int64 raw arg_
+ Value'uint8 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint8 raw arg_
+ Value'uint16 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint16 raw arg_
+ Value'uint32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint32 raw arg_
+ Value'uint64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'uint64 raw arg_
+ Value'float32 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'float32 raw arg_
+ Value'float64 arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'float64 raw arg_
+ Value'text arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.Xa93fc509624c72d9.set_Value'text raw field_
+ Value'data_ arg_ -> do
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Value'data_ (BS.length arg_) raw
+ C'.marshalInto field_ arg_
+ Value'list arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.Xa93fc509624c72d9.set_Value'list raw field_
+ Value'enum arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Value'enum raw arg_
+ Value'struct arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ Capnp.ById.Xa93fc509624c72d9.set_Value'struct raw field_
+ Value'interface -> Capnp.ById.Xa93fc509624c72d9.set_Value'interface raw
+ Value'anyPointer arg_ -> do
+ field_ <- C'.cerialize (U'.message raw) arg_
+ 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 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)
+instance C'.Decerialize Brand'Binding where
+ type Cerial msg Brand'Binding = Capnp.ById.Xa93fc509624c72d9.Brand'Binding msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Binding' raw
+ 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)
+instance C'.Marshal Brand'Binding where
+ marshalInto raw value = do
+ case value of
+ Brand'Binding'unbound -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Binding'unbound raw
+ Brand'Binding'type_ arg_ -> do
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'Binding'type_ raw
+ C'.marshalInto field_ arg_
+ Brand'Binding'unknown' arg_ -> Capnp.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' raw arg_
+instance C'.Cerialize s Brand'Binding
+instance Default Brand'Binding where
+ def = PH'.defaultStruct
+data Brand'Scope
+ = Brand'Scope
+ {scopeId :: Word64,
+ union' :: Brand'Scope'}
+ 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
+ Brand'Scope{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_Brand'Scope'scopeId raw scopeId
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'union' raw
+ C'.marshalInto field_ union'
+instance C'.Cerialize s Brand'Scope
+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)
+instance C'.Decerialize Brand'Scope' where
+ type Cerial msg Brand'Scope' = Capnp.ById.Xa93fc509624c72d9.Brand'Scope' msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Brand'Scope'' raw
+ 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)
+instance C'.Marshal Brand'Scope' where
+ marshalInto raw value = do
+ case value of
+ Brand'Scope'bind arg_ -> do
+ let len_ = V.length arg_
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Brand'Scope'bind len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ 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_
+instance C'.Cerialize s Brand'Scope'
+instance Default Brand'Scope' where
+ def = PH'.defaultStruct
+data CodeGeneratorRequest'RequestedFile
+ = CodeGeneratorRequest'RequestedFile
+ {id :: Word64,
+ filename :: Text,
+ imports :: PU'.ListOf (CodeGeneratorRequest'RequestedFile'Import)}
+ 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
+ CodeGeneratorRequest'RequestedFile <$>
+ (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
+ CodeGeneratorRequest'RequestedFile{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'id raw id
+ field_ <- C'.cerialize (U'.message raw) filename
+ Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'filename raw field_
+ let len_ = V.length imports
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_CodeGeneratorRequest'RequestedFile'imports len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (imports V.! i)
+instance C'.Cerialize s CodeGeneratorRequest'RequestedFile
+instance Default CodeGeneratorRequest'RequestedFile where
+ def = PH'.defaultStruct
+data CodeGeneratorRequest'RequestedFile'Import
+ = CodeGeneratorRequest'RequestedFile'Import
+ {id :: Word64,
+ name :: Text}
+ 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
+ CodeGeneratorRequest'RequestedFile'Import{..} -> do
+ Capnp.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'id raw id
+ 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 Default CodeGeneratorRequest'RequestedFile'Import where
+ def = PH'.defaultStruct
+data Field'
+ = Field'slot
+ {offset :: Word32,
+ type_ :: Type,
+ defaultValue :: Value,
+ 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
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Field'' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Field'slot raw -> Field'slot <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'offset raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'type_ raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Field'slot'defaultValue raw >>= C'.decerialize) <*>
+ (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)
+instance C'.Marshal Field' where
+ marshalInto raw value = do
+ case value of
+ Field'slot{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Field'slot raw
+ Capnp.ById.Xa93fc509624c72d9.set_Field'slot'offset raw offset
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'slot'type_ raw
+ C'.marshalInto field_ type_
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Field'slot'defaultValue raw
+ C'.marshalInto field_ defaultValue
+ Capnp.ById.Xa93fc509624c72d9.set_Field'slot'hadExplicitDefault raw hadExplicitDefault
+ 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_
+instance C'.Cerialize s Field'
+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)
+instance C'.Decerialize Field'ordinal where
+ type Cerial msg Field'ordinal = Capnp.ById.Xa93fc509624c72d9.Field'ordinal msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Field'ordinal' raw
+ 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)
+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 Default Field'ordinal where
+ def = PH'.defaultStruct
+data Node'
+ = 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
+ {methods :: PU'.ListOf (Method),
+ superclasses :: PU'.ListOf (Superclass)} |
+ Node'const
+ {type_ :: Type,
+ value :: Value} |
+ Node'annotation
+ {type_ :: Type,
+ targetsFile :: Bool,
+ targetsConst :: Bool,
+ targetsEnum :: Bool,
+ targetsEnumerant :: Bool,
+ targetsStruct :: Bool,
+ targetsField :: Bool,
+ targetsUnion :: Bool,
+ targetsGroup :: Bool,
+ targetsInterface :: Bool,
+ targetsMethod :: Bool,
+ targetsParam :: Bool,
+ 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
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Node'' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Node'file -> pure Node'file
+ Capnp.ById.Xa93fc509624c72d9.Node'struct raw -> Node'struct <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'dataWordCount raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'pointerCount raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'preferredListEncoding raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'isGroup raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'discriminantCount raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'discriminantOffset raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'struct'fields raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Node'enum raw -> Node'enum <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'enum'enumerants raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Node'interface raw -> Node'interface <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'interface'methods raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'interface'superclasses raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Node'const raw -> Node'const <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'const'type_ raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'const'value raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Node'annotation raw -> Node'annotation <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'type_ raw >>= C'.decerialize) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsFile raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsConst raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnum raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnumerant raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsStruct raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsField raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsUnion raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsGroup raw) <*>
+ (Capnp.ById.Xa93fc509624c72d9.get_Node'annotation'targetsInterface raw) <*>
+ (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)
+instance C'.Marshal Node' where
+ marshalInto raw value = do
+ case value of
+ Node'file -> Capnp.ById.Xa93fc509624c72d9.set_Node'file raw
+ Node'struct{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'struct raw
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'dataWordCount raw dataWordCount
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'pointerCount raw pointerCount
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'preferredListEncoding raw preferredListEncoding
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'isGroup raw isGroup
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'discriminantCount raw discriminantCount
+ Capnp.ById.Xa93fc509624c72d9.set_Node'struct'discriminantOffset raw discriminantOffset
+ let len_ = V.length fields
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'struct'fields len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (fields V.! i)
+ Node'enum{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'enum raw
+ let len_ = V.length enumerants
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'enum'enumerants len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (enumerants V.! i)
+ Node'interface{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'interface raw
+ let len_ = V.length methods
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'interface'methods len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (methods V.! i)
+ let len_ = V.length superclasses
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'interface'superclasses len_ raw
+ forM_ [0..len_ - 1] $ \i -> do
+ elt <- C'.index i field_
+ C'.marshalInto elt (superclasses V.! i)
+ Node'const{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'const raw
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'const'type_ raw
+ C'.marshalInto field_ type_
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'const'value raw
+ C'.marshalInto field_ value
+ Node'annotation{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Node'annotation raw
+ field_ <- Capnp.ById.Xa93fc509624c72d9.new_Node'annotation'type_ raw
+ C'.marshalInto field_ type_
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsFile raw targetsFile
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsConst raw targetsConst
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnum raw targetsEnum
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnumerant raw targetsEnumerant
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsStruct raw targetsStruct
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsField raw targetsField
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsUnion raw targetsUnion
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsGroup raw targetsGroup
+ Capnp.ById.Xa93fc509624c72d9.set_Node'annotation'targetsInterface raw targetsInterface
+ 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_
+instance C'.Cerialize s Node'
+instance Default Node' where
+ def = PH'.defaultStruct
+data Node'NestedNode
+ = Node'NestedNode
+ {name :: Text,
+ id :: Word64}
+ 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
+ Node'NestedNode{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ 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 Default Node'NestedNode where
+ def = PH'.defaultStruct
+data Node'Parameter
+ = Node'Parameter
+ {name :: Text}
+ 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
+ Node'Parameter{..} -> do
+ field_ <- C'.cerialize (U'.message raw) name
+ Capnp.ById.Xa93fc509624c72d9.set_Node'Parameter'name raw field_
+instance C'.Cerialize s Node'Parameter
+instance Default Node'Parameter where
+ def = PH'.defaultStruct
+data Type'anyPointer
+ = 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)
+instance C'.Decerialize Type'anyPointer where
+ type Cerial msg Type'anyPointer = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained raw -> Type'anyPointer'unconstrained <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained'union' raw >>= C'.decerialize)
+ Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'parameter raw -> Type'anyPointer'parameter <$>
+ (Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'scopeId raw) <*>
+ (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)
+instance C'.Marshal Type'anyPointer where
+ marshalInto raw value = do
+ case value of
+ Type'anyPointer'unconstrained{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained raw
+ field_ <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained'union' raw
+ C'.marshalInto field_ union'
+ Type'anyPointer'parameter{..} -> do
+ raw <- Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter raw
+ Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'scopeId raw scopeId
+ Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'parameterIndex raw parameterIndex
+ Type'anyPointer'implicitMethodParameter{..} -> do
+ 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 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)
+instance C'.Decerialize Type'anyPointer'unconstrained where
+ type Cerial msg Type'anyPointer'unconstrained = Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained msg
+ decerialize raw = do
+ raw <- Capnp.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained' raw
+ case raw of
+ Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'anyKind -> pure Type'anyPointer'unconstrained'anyKind
+ 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)
+instance C'.Marshal Type'anyPointer'unconstrained where
+ marshalInto raw value = do
+ case value of
+ Type'anyPointer'unconstrained'anyKind -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'anyKind raw
+ Type'anyPointer'unconstrained'struct -> Capnp.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'struct raw
+ 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 Default Type'anyPointer'unconstrained where
+ def = PH'.defaultStruct
diff --git a/lib/Codec/Capnp.hs b/lib/Codec/Capnp.hs
new file mode 100644
--- /dev/null
+++ b/lib/Codec/Capnp.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Codec.Capnp
+ ( newRoot
+ , setRoot
+ , getRoot
+ ) where
+
+import Data.Capnp.Classes
+
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+
+-- | 'newRoot' allocates and returns a new value inside the message, setting
+-- it as the root object of the message.
+newRoot :: (ToStruct (M.MutMsg s) a, Allocate s a, M.WriteCtx m s)
+ => M.MutMsg s -> m a
+newRoot msg = do
+ ret <- new msg
+ setRoot ret
+ pure ret
+
+-- | 'setRoot' sets its argument to be the root object in its message.
+setRoot :: (ToStruct (M.MutMsg s) a, M.WriteCtx m s) => a -> m ()
+setRoot = U.setRoot . toStruct
+
+-- | 'getRoot' returns the root object of a message.
+getRoot :: (FromStruct msg a, U.ReadCtx m msg) => msg -> m a
+getRoot msg = U.rootPtr msg >>= fromStruct
diff --git a/lib/Data/Capnp.hs b/lib/Data/Capnp.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp.hs
@@ -0,0 +1,74 @@
+{- |
+Module: Data.Capnp
+Description: The most commonly used functionality from 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
+ (
+ -- * Working with capnproto lists
+ Classes.ListElem(..)
+ , Classes.MutListElem(..)
+
+ -- * Working with capnproto Text and Data values.
+ , Basics.Data
+ , Basics.dataBytes
+ , Basics.Text
+ , Basics.textBytes
+
+ -- * Working with messages
+ , Message.ConstMsg
+ , Message.Message(..)
+ , Message.Mutable(..)
+ , 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
+
+ -- * Type aliases for common contexts
+ , Message.WriteCtx
+ , Untyped.ReadCtx
+ , Untyped.RWCtx
+
+ -- * Managing resource limits
+ , module Data.Capnp.TraversalLimit
+ ) where
+
+import Control.Monad.Catch (MonadThrow)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BB
+
+import Data.Capnp.TraversalLimit
+
+import Data.Capnp.IO (getValue, hGetValue)
+
+import qualified Codec.Capnp as Codec
+import qualified Data.Capnp.Basics as Basics
+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/Address.hs b/lib/Data/Capnp/Address.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Address.hs
@@ -0,0 +1,97 @@
+{-|
+Module: Data.Capnp.Address
+Description: Utilities for manipulating addresses within capnproto messages.
+-}
+{-# LANGUAGE RecordWildCards #-}
+module Data.Capnp.Address
+ ( WordAddr(..)
+ , CapAddr(..)
+ , Addr(..)
+ , OffsetError(..)
+ , computeOffset
+ , pointerFrom
+ , resolvePtr
+ )
+ where
+
+import Data.Bits
+import Data.Word
+
+import Data.Capnp.Bits (WordCount)
+
+import qualified Data.Capnp.Pointer as P
+
+-- | The address of a word within a message
+data WordAddr = WordAt
+ { segIndex :: !Int -- ^ Segment number
+ , wordIndex :: !WordCount -- ^ offset in words from the start of the segment.
+ } deriving(Show, Eq)
+
+-- | The "address" of a capability
+newtype CapAddr = Cap Word32 deriving(Show, Eq)
+
+-- | An address, i.e. a location that a pointer may point at.
+data Addr
+ = WordAddr !WordAddr
+ | CapAddr !CapAddr
+ deriving(Show, Eq)
+
+-- | An error returned by 'computeOffset'; this describes the reason why a
+-- value cannot be directly addressed from a given location.
+data OffsetError
+ -- | The pointer and the value are in different segments.
+ = DifferentSegments
+ -- | The pointer is in the correct segment, but too far away to encode the
+ -- offset. (more than 30 bits would be required). This can only happen with
+ -- segments that are > 8 GiB, which this library refuses to either decode
+ -- or generate, so this should not come up in practice.
+ | OutOfRange
+
+-- | @'computeOffset' ptrAddr valueAddr@ computes the offset that should be
+-- stored in a struct or list pointer located at @ptrAddr@, in order to point
+-- at a value located at @valueAddr@. If the value cannot be directly addressed
+-- by a pointer at @ptrAddr@, then this returns 'Left', with the 'OffsetError'
+-- describing the problem.
+computeOffset :: WordAddr -> WordAddr -> Either OffsetError WordCount
+computeOffset ptrAddr valueAddr
+ | segIndex ptrAddr /= segIndex valueAddr = Left DifferentSegments
+ | otherwise =
+ let offset = wordIndex valueAddr - (wordIndex ptrAddr + 1)
+ in if offset >= 1 `shiftL` 30
+ then Left OutOfRange
+ else Right offset
+
+-- | @'pointerFrom' ptrAddr targetAddr ptr@ updates @ptr@, such that it is
+-- correct to target a value located at @targetAddr@ given that the pointer
+-- itself is located at @ptrAddr@. Returns 'Left' if this is not possible.
+--
+-- It is illegal to call this on a capability pointer.
+--
+-- For far pointers, @targetAddr@ is taken to be the address of the landing pad,
+-- rather than the final value.
+pointerFrom :: WordAddr -> WordAddr -> P.Ptr -> Either OffsetError P.Ptr
+pointerFrom _ _ (P.CapPtr _) = error "pointerFrom called on a capability pointer."
+pointerFrom _ WordAt{..} (P.FarPtr twoWords _ _) =
+ Right $ P.FarPtr twoWords (fromIntegral wordIndex) (fromIntegral segIndex)
+pointerFrom ptrAddr targetAddr (P.StructPtr _ dataSz ptrSz) =
+ flip fmap (computeOffset ptrAddr targetAddr) $
+ \off -> P.StructPtr (fromIntegral off) dataSz ptrSz
+pointerFrom ptrAddr targetAddr (P.ListPtr _ eltSpec) =
+ flip fmap (computeOffset ptrAddr targetAddr) $
+ \off -> P.ListPtr (fromIntegral off) eltSpec
+
+-- | @'resolvePtr' from ptr@ resolves the pointer @ptr@ to an address
+-- relative to @from@. Note that inter-segment pointers ('P.FarPtr')
+-- resolve to the address of the landing pad, *not* the the final
+-- address of the object pointed to, as the latter would reqiure access
+-- to the message.
+resolvePtr :: WordAddr -> P.Ptr -> Addr
+resolvePtr (WordAt seg word) (P.StructPtr off _dataSz _ptrSz) =
+ WordAddr $ WordAt seg (word + fromIntegral off + 1)
+resolvePtr (WordAt seg word) (P.ListPtr off _) =
+ WordAddr (WordAt seg (word + fromIntegral off + 1))
+resolvePtr _ (P.FarPtr _ word seg) =
+ WordAddr $ WordAt
+ (fromIntegral seg)
+ (fromIntegral word)
+resolvePtr _ (P.CapPtr cap) = CapAddr (Cap cap)
diff --git a/lib/Data/Capnp/Basics.hs b/lib/Data/Capnp/Basics.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Basics.hs
@@ -0,0 +1,119 @@
+{-|
+Module: Data.Capnp.Basics
+Description: Handling of "basic" capnp datatypes.
+
+In particular
+
+* Text and Data (which are primitive types in the schema language,
+ but are both the same as List(uint8) on the wire).
+* List of types other than those in Data.Capnp.Untyped.
+ Whereas 'U.ListOf' only deals with low-level encodings of lists,
+ this module's 'List' type can represent typed lists.
+-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Data.Capnp.Basics
+ ( Text
+ , Data(..)
+ , ListElem(..)
+ , MutListElem(..)
+ , getData
+ , getText
+ , newData
+ , newText
+ , dataBytes
+ , textBuffer
+ , textBytes
+ ) where
+
+import Data.Word
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadThrow(throwM))
+
+import qualified Data.ByteString as BS
+
+import Data.Capnp.Classes (IsPtr(..), ListElem(..), MutListElem(..))
+import Internal.Gen.Instances ()
+
+import qualified Data.Capnp.Errors as E
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+
+
+-- | A textual string (@Text@ in capnproto's schema language). On the wire,
+-- this is NUL-terminated. The encoding should be UTF-8, but the library
+-- /does not/ verify this; users of the library must do validation themselves, if
+-- they care about this.
+--
+-- Rationale: validation would require doing an up-front pass over the data,
+-- which runs counter to the overall design of capnproto.
+newtype Text msg = Text (U.ListOf msg Word8)
+-- The argument to the data constructor is the slice of the original message
+-- containing the text, including the NUL terminator.
+
+-- | A blob of bytes (@Data@ in capnproto's schema language). The argument
+-- to the data constructor is a slice into the message, containing the raw
+-- bytes.
+newtype Data msg = Data (U.ListOf msg Word8)
+
+-- | @'newData' msg len@ Allocates a new data blob of length @len@ bytes
+-- inside the message.
+newData :: M.WriteCtx m s => M.MutMsg s -> Int -> m (Data (M.MutMsg s))
+newData msg len = Data <$> U.allocList8 msg len
+
+-- | Interpret a list of 'Word8' as a capnproto 'Data' value.
+getData :: U.ReadCtx m msg => U.ListOf msg Word8 -> m (Data msg)
+getData = pure . Data
+
+-- | @'newText' msg len@ Allocates a new 'Text' inside the message. The
+-- value has space for @len@ *bytes* (not characters).
+newText :: M.WriteCtx m s => M.MutMsg s -> Int -> m (Text (M.MutMsg s))
+newText msg len =
+ Text <$> U.allocList8 msg (len+1)
+
+-- | Interpret a list of 'Word8' as a capnproto 'Text' value.
+--
+-- This vaildates that the list is NUL-terminated, but not that it is valid
+-- UTF-8. If it is not NUL-terminaed, a 'SchemaViolationError' is thrown.
+getText :: U.ReadCtx m msg => U.ListOf msg Word8 -> m (Text msg)
+getText list = do
+ let len = U.length list
+ when (len == 0) $ throwM $ E.SchemaViolationError
+ "Text is not NUL-terminated (list of bytes has length 0)"
+ lastByte <- U.index (len - 1) list
+ when (lastByte /= 0) $ throwM $ E.SchemaViolationError $
+ "Text is not NUL-terminated (last byte is " ++ show lastByte ++ ")"
+ Text <$> U.take (len - 1) list
+
+-- | Convert a 'Data' to a 'BS.ByteString'.
+dataBytes :: U.ReadCtx m msg => Data msg -> m BS.ByteString
+dataBytes (Data list) = U.rawBytes list
+
+-- | Return the underlying buffer containing the text. This does not include the
+-- null terminator.
+textBuffer :: U.ReadCtx m msg => Text msg -> m (U.ListOf msg Word8)
+textBuffer (Text list) = U.take (U.length list - 1) list
+
+-- | Convert a 'Text' to a 'BS.ByteString', comprising the raw bytes of the text
+-- (not counting the NUL terminator).
+textBytes :: U.ReadCtx m msg => Text msg -> m BS.ByteString
+textBytes (Text list) = U.rawBytes list
+
+-- IsPtr instances for Text and Data. These wrap lists of bytes.
+instance IsPtr msg (Data msg) where
+ fromPtr msg ptr = fromPtr msg ptr >>= getData
+ toPtr (Data l) = toPtr l
+instance IsPtr msg (Text msg) where
+ fromPtr msg ptr = case ptr of
+ Just _ ->
+ fromPtr msg ptr >>= getText
+ Nothing -> do
+ -- getText expects and strips off a NUL byte at the end of the
+ -- string. In the case of a null pointer we just want to return
+ -- the empty string, so we bypass it here.
+ Data bytes <- fromPtr msg ptr
+ pure $ Text bytes
+ toPtr (Text l) = toPtr l
diff --git a/lib/Data/Capnp/Basics/Pure.hs b/lib/Data/Capnp/Basics/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Basics/Pure.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{- |
+Module: Data.Capnp.Basics.Pure
+Description: Handling of "basic" capnp datatypes (high-level API).
+
+Analogous to 'Data.Capnp.Basics' in the low-level API, this module deals
+with capnproto's @Text@ and @Data@ types. These are simply aliases for
+'BS.ByteString' and the text package's 'T.Text'; mostly this module provides
+helper functions and type class instances.
+
+Unlike with the low-level API, typed lists do not require special
+treatment -- they're just Vectors.
+-}
+module Data.Capnp.Basics.Pure
+ ( Data(..)
+ , Text(..)
+ ) where
+
+import Control.Monad (forM_)
+import Control.Monad.Catch (MonadThrow(throwM))
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+import Data.Capnp.Classes hiding (ListElem(List))
+
+import Data.Capnp.Errors (Error(InvalidUtf8Error))
+import Data.Capnp.Untyped (rawBytes)
+
+import qualified Data.Capnp.Basics as Basics
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as Untyped
+
+-- | A capnproto @Data@ value. This is just an alias for 'BS.ByteString'.
+type Data = BS.ByteString
+
+-- | A capnproto @Text@. This is just an alias for the text package's 'T.Text'.
+type Text = T.Text
+
+instance Decerialize Data where
+ type Cerial msg Data = Basics.Data msg
+ decerialize (Basics.Data list) = rawBytes list
+
+instance Marshal Data where
+ marshalInto (Basics.Data list) bytes =
+ forM_ [0..BS.length bytes - 1] $ \i ->
+ Untyped.setIndex (BS.index bytes i) i list
+
+instance Decerialize Text where
+ type Cerial msg Text = Basics.Text msg
+ decerialize text = do
+ bytes <- Basics.textBytes text
+ case decodeUtf8' bytes of
+ Left e -> throwM $ InvalidUtf8Error e
+ Right txt -> pure txt
+
+instance Marshal Text where
+ marshalInto dest text = marshalTextBytes (encodeUtf8 text) dest
+
+instance Cerialize s Text where
+ cerialize msg text = do
+ let bytes = encodeUtf8 text
+ ret <- Basics.newText msg (BS.length bytes)
+ marshalTextBytes bytes ret
+ pure ret
+
+marshalTextBytes :: Untyped.RWCtx m s => BS.ByteString -> Basics.Text (M.MutMsg s) -> m ()
+marshalTextBytes bytes text = do
+ buffer <- Basics.textBuffer text
+ marshalInto (Basics.Data buffer) bytes
diff --git a/lib/Data/Capnp/Bits.hs b/lib/Data/Capnp/Bits.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Bits.hs
@@ -0,0 +1,124 @@
+{-|
+Module: Data.Capnp.Bits
+Description: Utilities for bitwhacking useful for capnproto.
+-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Capnp.Bits
+ ( BitCount(..)
+ , ByteCount(..)
+ , WordCount(..)
+ , Word1(..)
+ , bitsToBytesCeil
+ , bytesToWordsCeil
+ , bytesToWordsFloor
+ , wordsToBytes
+ , lo, hi
+ , i32, i30, i29
+ , fromLo, fromHi
+ , fromI32, fromI30, fromI29
+ , bitRange
+ , replaceBits
+ )
+ where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+
+-- | Wrapper type for a quantity of bits. This along with 'ByteCount' and
+-- 'WordCount' are helpful for avoiding mixing up units
+newtype BitCount = BitCount Int
+ deriving(Num, Real, Integral, Bits, Ord, Eq, Enum, Show)
+
+-- | A quantity of bytes
+newtype ByteCount = ByteCount Int
+ deriving(Num, Real, Integral, Bits, Ord, Eq, Enum, Show)
+
+-- | A quantity of 64-bit words
+newtype WordCount = WordCount Int
+ deriving(Num, Real, Integral, Bits, Ord, Eq, Enum, Show)
+
+-- | Convert bits to bytes. Rounds up.
+bitsToBytesCeil :: BitCount -> ByteCount
+bitsToBytesCeil (BitCount n) = ByteCount ((n + 7) `div` 8)
+
+-- | Convert bytes to words. Rounds up.
+bytesToWordsCeil :: ByteCount -> WordCount
+bytesToWordsCeil (ByteCount n) = WordCount ((n + 7) `div` 8)
+
+-- | Convert bytes to words. Rounds down.
+bytesToWordsFloor :: ByteCount -> WordCount
+bytesToWordsFloor (ByteCount n) = WordCount (n `div` 8)
+
+-- | Convert words to bytes.
+wordsToBytes :: WordCount -> ByteCount
+wordsToBytes (WordCount n) = ByteCount (n * 8)
+
+-- | lo and hi extract the low and high 32 bits of a 64-bit word, respectively.
+lo, hi :: Word64 -> Word32
+
+-- | iN (where N is 32, 30, or 29) extracts the high N bits of its argument,
+-- and treats them as a signed 32-bit integer.
+i32, i30, i29 :: Word32 -> Int32
+
+-- | fromLo and fromHi convert a 32-bit word to the low or high portion of
+-- a 64-bit word. In general, @fromHi (hi w) .|. fromLo (lo w) == w@.
+fromLo, fromHi :: Word32 -> Word64
+
+-- | fromIN (where N is 32, 30, or 29) treats its argument as the high N bits of
+-- a 32-bit word, returning the word. If @w < 2 ** N@ then @fromIN (iN w) == w@.
+fromI32, fromI30, fromI29 :: Int32 -> Word32
+
+lo w = fromIntegral (w `shiftR` 0)
+hi w = fromIntegral (w `shiftR` 32)
+i32 = fromIntegral
+i30 w = i32 w `shiftR` 2
+i29 w = i32 w `shiftR` 3
+
+fromLo w = fromIntegral w `shiftL` 0
+fromHi w = fromIntegral w `shiftL` 32
+fromI32 = fromIntegral
+fromI30 w = fromI32 (w `shiftL` 2)
+fromI29 w = fromI32 (w `shiftL` 3)
+
+-- | @bitRange word lo hi@ is the unsigned integer represented by the
+-- bits of @word@ in the range [lo, hi)
+bitRange :: (Integral a => Word64 -> Int -> Int -> a)
+bitRange word lo hi = fromIntegral $
+ (word .&. ((1 `shiftL` hi) - 1)) `shiftR` lo
+
+-- | @replaceBits new orig shift@ replaces the bits [shift, shift+N) in
+-- @orig@ with the N bit integer @new@.
+replaceBits :: (Bounded a, Integral a)
+ => a -> Word64 -> Int -> Word64
+replaceBits new orig shift =
+ (orig .&. mask) .|. (fromIntegral new `shiftL` shift)
+ where
+ mask = complement $ fromIntegral (maxBound `asTypeOf` new) `shiftL` shift
+
+-- | 1 bit datatype, in the tradition of Word8, Word16 et al.
+newtype Word1 = Word1 { word1ToBool :: Bool }
+ deriving(Ord, Eq, Enum, Bounded, Bits)
+
+instance Num Word1 where
+ (+) = w1ThruEnum (+)
+ (*) = w1ThruEnum (*)
+ abs = id
+ signum = id
+ negate = id
+ fromInteger x = toEnum (fromIntegral x `mod` 2)
+
+instance Real Word1 where
+ toRational = fromIntegral . fromEnum
+
+instance Integral Word1 where
+ toInteger = toInteger . fromEnum
+ quotRem x y = let (x', y') = quotRem (fromEnum x) (fromEnum y)
+ in (toEnum x', toEnum y')
+
+instance Show Word1 where
+ show = show . fromEnum
+ -- TODO: implement Read?
+
+w1ThruEnum :: (Int -> Int -> Int) -> Word1 -> Word1 -> Word1
+w1ThruEnum op l r = toEnum $ (fromEnum l `op` fromEnum r) `mod` 2
diff --git a/lib/Data/Capnp/Classes.hs b/lib/Data/Capnp/Classes.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Classes.hs
@@ -0,0 +1,252 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{- |
+Module: Data.Capnp.Classes
+Description: Misc. type classes
+
+This module defines several type classes concerning encoding and decoding
+values in the capnproto wire format (as well as instances for some basic
+types).
+
+Note that much of this is unlikely to be used directly by developers.
+Typically these are either used internally by generated code, or
+transitively via higher level functions in the API. It is recommended
+to look elsewhere in the library for what you need, and refer to this
+module only when trying to understand what the class constraints on a
+function mean.
+-}
+module Data.Capnp.Classes
+ ( IsWord(..)
+ , ListElem(..)
+ , MutListElem(..)
+ , IsPtr(..)
+ , FromStruct(..)
+ , ToStruct(..)
+ , Allocate(..)
+ , Marshal(..)
+ , Cerialize(..)
+ , Decerialize(..)
+ ) where
+
+import Data.Bits
+import Data.Int
+import Data.ReinterpretCast
+import Data.Word
+
+import Control.Monad.Catch (MonadThrow(throwM))
+
+import Data.Capnp.Bits (Word1(..))
+import Data.Capnp.Errors (Error(SchemaViolationError))
+import Data.Capnp.Untyped (ListOf, Ptr(..), ReadCtx, Struct, messageDefault)
+
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+
+-- | Types that can be converted to and from a 64-bit word.
+class IsWord a where
+ fromWord :: Word64 -> a
+ toWord :: a -> Word64
+
+-- | Types which may be stored as an element of a capnproto list.
+class ListElem msg e where
+ -- | The type of lists of @e@ stored in messages of type @msg@
+ data List msg e
+
+ -- | Get the length of a list.
+ length :: List msg e -> Int
+
+ -- | @'index' i list@ gets the @i@th element of a list.
+ index :: U.ReadCtx m msg => Int -> List msg e -> m e
+
+-- | Types which may be stored as an element of a *mutable* capnproto list.
+class (ListElem (M.MutMsg s) e) => MutListElem s e where
+ -- | @'setIndex' value i list@ sets the @i@th index in @list@ to @value
+ setIndex :: U.RWCtx m s => e -> Int -> List (M.MutMsg s) e -> m ()
+
+ -- | @'newList' msg size@ allocates and returns a new list of length
+ -- @size@ inside @msg@.
+ newList :: M.WriteCtx m s => M.MutMsg s -> Int -> m (List (M.MutMsg s) e)
+
+-- | Types which may be stored in a capnproto message, and have a fixed size.
+--
+-- This applies to typed structs, but not e.g. lists, because the length
+-- must be known to allocate a list.
+class Allocate s e where
+ -- @'new' msg@ allocates a new value of type @e@ inside @msg@.
+ new :: M.WriteCtx m s => M.MutMsg s -> m e
+
+-- | Types which may be extracted from a message.
+--
+-- typically, instances of 'Decerialize' will be the algebraic data types
+-- defined in generated code for the high-level API.
+class Decerialize a where
+ -- | A variation on @a@ which is encoded in the message.
+ --
+ -- For the case of instances in generated high-level API code, this will
+ -- be the low-level API analouge of the type.
+ type Cerial msg a
+
+ -- | Extract the value from the message.
+ decerialize :: U.ReadCtx m M.ConstMsg => Cerial M.ConstMsg a -> m a
+
+-- | Types which may be mashaled into a pre-allocated object in a message.
+class Decerialize a => Marshal a where
+
+ -- | Marshal a value into the pre-allocated object inside the message.
+ --
+ -- Note that caller must arrange for the object to of the correct size.
+ -- This is is not necessarily guaranteed; for example, list types must
+ -- coordinate the length of the list.
+ marshalInto :: U.RWCtx m s => Cerial (M.MutMsg s) a -> a -> m ()
+
+-- | Types which may be inserted into a message.
+class Decerialize a => Cerialize s a where
+
+ -- | Cerialize a value into the supplied message, returning the result.
+ cerialize :: U.RWCtx m s => M.MutMsg s -> a -> m (Cerial (M.MutMsg s) a)
+
+ default cerialize :: (U.RWCtx m s, Marshal a, Allocate s (Cerial (M.MutMsg s) a))
+ => M.MutMsg s -> a -> m (Cerial (M.MutMsg s) a)
+ cerialize msg value = do
+ raw <- new msg
+ marshalInto raw value
+ pure raw
+
+-- | Types that can be converted to and from an untyped pointer.
+--
+-- Note that this should not involve a marshalling step, and that decoding
+-- does not have to succeed, if the pointer is the wrong type.
+--
+-- TODO: split this into FromPtr and ToPtr, for symmetry with FromStruct
+-- and ToStruct?
+class IsPtr msg a where
+ -- | Convert an untyped pointer to an @a@.
+ fromPtr :: ReadCtx m msg => msg -> Maybe (Ptr msg) -> m a
+
+ -- | Convert an @a@ to an untyped pointer.
+ toPtr :: a -> Maybe (Ptr msg)
+
+-- | Types that can be extracted from a struct.
+class FromStruct msg a where
+ -- | Extract a value from a struct.
+ fromStruct :: ReadCtx m msg => Struct msg -> m a
+
+-- | Types that can be converted to a struct.
+class ToStruct msg a where
+ -- | Convert a value to a struct.
+ toStruct :: a -> Struct msg
+
+------- instances -------
+
+instance IsWord Bool where
+ fromWord n = (n .&. 1) == 1
+ toWord True = 1
+ toWord False = 0
+
+instance IsWord Word1 where
+ fromWord = Word1 . fromWord
+ toWord = toWord . word1ToBool
+
+-- IsWord instances for integral types; they're all the same.
+instance IsWord Int8 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Int16 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Int32 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Int64 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Word8 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Word16 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Word32 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+instance IsWord Word64 where
+ fromWord = fromIntegral
+ toWord = fromIntegral
+
+instance IsWord Float where
+ fromWord = wordToFloat . fromIntegral
+ toWord = fromIntegral . floatToWord
+instance IsWord Double where
+ fromWord = wordToDouble
+ toWord = doubleToWord
+
+-- helper function for throwing SchemaViolationError "expected ..."
+expected :: MonadThrow m => String -> m a
+expected msg = throwM $ SchemaViolationError $ "expected " ++ msg
+
+-- IsPtr instance for lists of Void/().
+instance IsPtr msg (ListOf msg ()) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List0 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 0"
+ toPtr = Just . PtrList . U.List0
+
+-- IsPtr instances for lists of unsigned integers.
+instance IsPtr msg (ListOf msg Word8) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List8 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 8"
+ toPtr = Just . PtrList . U.List8
+instance IsPtr msg (ListOf msg Word16) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List16 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 16"
+ toPtr = Just . PtrList . U.List16
+instance IsPtr msg (ListOf msg Word32) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List32 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 32"
+ toPtr = Just . PtrList . U.List32
+instance IsPtr msg (ListOf msg Word64) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List64 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 64"
+ toPtr = Just . PtrList . U.List64
+
+
+instance IsPtr msg (ListOf msg Bool) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.List1 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 1."
+ toPtr = Just . PtrList . U.List1
+
+-- | IsPtr instance for pointers -- this is just the identity.
+instance IsPtr msg (Maybe (Ptr msg)) where
+ fromPtr _ = pure
+ toPtr = id
+
+-- IsPtr instance for composite lists.
+instance IsPtr msg (ListOf msg (Struct msg)) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr msg (Just (PtrList (U.ListStruct list))) = pure list
+ fromPtr _ _ = expected "pointer to list of structs"
+ toPtr = Just . PtrList . U.ListStruct
+
+-- FromStruct instance for Struct; just the identity.
+instance FromStruct msg (Struct msg) where
+ fromStruct = pure
+
+instance ToStruct msg (Struct msg) where
+ toStruct = id
+
+instance IsPtr msg (Struct msg) where
+ fromPtr msg Nothing = fromStruct (go msg) where
+ -- the type checker needs a bit of help inferring the type here.
+ go :: msg -> Struct msg
+ go = messageDefault
+ fromPtr msg (Just (PtrStruct s)) = fromStruct s
+ fromPtr _ _ = expected "pointer to struct"
+ toPtr = Just . PtrStruct
diff --git a/lib/Data/Capnp/Errors.hs b/lib/Data/Capnp/Errors.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Errors.hs
@@ -0,0 +1,54 @@
+{-|
+Module: Data.Capnp.Errors
+Description: Error handling utilities
+-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Data.Capnp.Errors
+ ( Error(..)
+ )
+ where
+
+import Control.Monad.Catch (Exception)
+import Data.Text.Encoding.Error (UnicodeException)
+
+-- | An error that may occur when processing a capnproto message.
+data Error
+ -- | A 'BoundsError' indicates an attempt to access an illegal
+ -- index 'index' within a sequence of length 'maxIndex'.
+ = BoundsError
+ { index :: !Int
+ , maxIndex :: !Int
+ -- TODO: choose a better name than maxIndex; this is confusing
+ -- since it's supposed to be the length, rather than the maximum
+ -- legal index. The latter would make it impossible to represent
+ -- an error for an empty sequence. I(zenhack) also think there may
+ -- be places in the library where we are misusing this field.
+ }
+ -- | A 'RecursionLimitError' indicates that the recursion depth limit
+ -- was exceeded.
+ | RecursionLimitError
+ -- | A 'TraversalLimitError' indicates that the traversal limit was
+ -- exceeded.
+ | TraversalLimitError
+ -- | An 'InvalidDataError' indicates that a part of a message being
+ -- parsed was malformed. The argument to the data constructor is a
+ -- human-readable error message.
+ | InvalidDataError String
+ -- | A 'SizeError' indicates that an operation would have resulted in
+ -- a message that violated the library's limit on either segment size
+ -- or number of segments.
+ | SizeError
+ -- | A 'SchemaViolationError' indicates that part of the message does
+ -- not match the schema. The argument to the data construtor is a
+ -- human-readable error message.
+ | SchemaViolationError String
+ -- | An 'InvalidUtf8Error' indicates that a text value in the message
+ -- was invalid utf8.
+ --
+ -- Note well: Most parts of the library don't actually check for valid
+ -- utf8 -- don't assume the check is made unless an interface says it is.
+ | InvalidUtf8Error UnicodeException
+ deriving(Show, Eq)
+
+instance Exception Error
diff --git a/lib/Data/Capnp/GenHelpers.hs b/lib/Data/Capnp/GenHelpers.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/GenHelpers.hs
@@ -0,0 +1,48 @@
+{- |
+Module: Data.Capnp.GenHelpers
+Description: Misc. helpers for generated code.
+
+This module provides various helpers used by generated code; developers
+are not expected to invoke them directly.
+
+These helpers are used by the low-level api. 'Data.Capnp.GenHelpers.Pure'
+defines helpers used by high-level api.
+-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+module Data.Capnp.GenHelpers where
+
+import Data.Bits
+import Data.Word
+
+import Data.Capnp.Bits
+
+import qualified Data.Capnp.Classes as C
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+
+-- | @'getWordField' struct index offset def@ fetches a field from the
+-- struct's data section. @index@ is the index of the 64-bit word in the data
+-- section in which the field resides. @offset@ is the offset in bits from the
+-- start of that word to the field. @def@ is the default value for this field.
+getWordField :: (U.ReadCtx m msg, C.IsWord a) => U.Struct msg -> Int -> Int -> Word64 -> m a
+getWordField struct idx offset def = fmap
+ ( C.fromWord
+ . xor def
+ . (`shiftR` offset)
+ )
+ (U.getData idx struct)
+
+-- | @'setWordField' struct value index offset def@ sets a field in the
+-- struct's data section. The meaning of the parameters are as in
+-- 'getWordField', with @value@ being the value to set. The width of the
+-- value is inferred from its type.
+setWordField ::
+ ( U.RWCtx m s
+ , Bounded a, Integral a, C.IsWord a, Bits a
+ )
+ => U.Struct (M.MutMsg s) -> a -> Int -> Int -> a -> m ()
+setWordField struct value idx offset def = do
+ old <- U.getData idx struct
+ let new = replaceBits (value `xor` def) old offset
+ U.setData new idx struct
diff --git a/lib/Data/Capnp/GenHelpers/Pure.hs b/lib/Data/Capnp/GenHelpers/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/GenHelpers/Pure.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{- |
+Module: Data.Capnp.GenHelpers.Pure
+Description: Misc. helpers for generated code.
+
+This module provides various helpers used by generated code; developers
+are not expected to invoke them directly.
+
+These helpers are only used by the high-level api. 'Data.Capnp.GenHelpers'
+defines helpers used by the low-level api.
+-}
+module Data.Capnp.GenHelpers.Pure where
+
+import Control.Monad.Catch.Pure (runCatchT)
+import Data.Either (fromRight)
+import Data.Functor.Identity (runIdentity)
+
+import Data.Capnp.TraversalLimit (evalLimitT)
+
+import qualified Data.Capnp.Classes as C
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+
+-- | A valid implementation for 'Data.Default' for any type that meets
+-- the given constraints.
+defaultStruct :: (C.Decerialize a, C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg a)) => a
+defaultStruct =
+ fromRight (error "impossible") $
+ runIdentity $
+ runCatchT $
+ evalLimitT maxBound $
+ U.rootPtr M.empty >>= C.fromStruct >>= C.decerialize
diff --git a/lib/Data/Capnp/IO.hs b/lib/Data/Capnp/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/IO.hs
@@ -0,0 +1,49 @@
+{- |
+Module: Data.Capnp.IO
+Description: Utilities for reading and writing values to handles.
+-}
+{-# LANGUAGE FlexibleContexts #-}
+module Data.Capnp.IO
+ ( hGetValue
+ , getValue
+ , hPutValue
+ , putValue
+ ) where
+
+import Control.Monad.Primitive (RealWorld)
+import System.IO (Handle, stdin, stdout)
+
+import Codec.Capnp (getRoot, setRoot)
+import Data.Capnp.Classes
+ (Cerialize(..), Decerialize(..), FromStruct(..), ToStruct(..))
+import Data.Capnp.TraversalLimit (evalLimitT)
+
+import qualified Data.Capnp.Message as M
+
+-- | @'hGetValue' limit handle@ reads a message from @handle@, returning its root object.
+-- @limit@ is used as both a cap on the size of a message which may be read and, for types
+-- in the high-level API, the traversal limit when decoding the message.
+hGetValue :: FromStruct M.ConstMsg a => Handle -> Int -> IO a
+hGetValue handle limit = do
+ msg <- M.hGetMsg handle limit
+ evalLimitT limit (getRoot msg)
+
+-- | @'getValue'@ is equivalent to @'hGetValue' 'stdin'@.
+getValue :: FromStruct M.ConstMsg a => Int -> IO a
+getValue = hGetValue stdin
+
+-- | @'hPutValue' handle value@ writes @value@ to handle, as the root object of
+-- a message.
+hPutValue :: (Cerialize RealWorld a, ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a))
+ => Handle -> a -> IO ()
+hPutValue handle value = do
+ msg <- M.newMessage
+ root <- evalLimitT maxBound $ cerialize msg value
+ setRoot root
+ constMsg <- M.freeze msg
+ M.hPutMsg handle constMsg
+
+-- | 'putValue' is equivalent to @'hPutValue' 'stdin'@
+putValue :: (Cerialize RealWorld a, ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a))
+ => a -> IO ()
+putValue = hPutValue stdout
diff --git a/lib/Data/Capnp/Message.hs b/lib/Data/Capnp/Message.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Message.hs
@@ -0,0 +1,428 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: Data.Capnp.Message
+Description: Cap'N Proto messages
+
+-}
+module Data.Capnp.Message
+ ( Message(..)
+ , ConstMsg(..)
+ , MutMsg(..)
+ , WriteCtx(..)
+ , Mutable(..)
+ , getSegment
+ , getWord
+ , setSegment
+ , setWord
+ , encode
+ , decode
+ , alloc
+ , allocInSeg
+ , newMessage
+ , newSegment
+ , empty
+ , maxSegmentSize
+ , maxSegments
+ , hPutMsg
+ , hGetMsg
+ , putMsg
+ , getMsg
+ )
+ where
+
+import Prelude hiding (read)
+
+import Data.Bits (shiftL)
+
+import Control.Monad (void, when, (>=>))
+import Control.Monad.Catch (MonadThrow(..))
+import Control.Monad.Primitive (PrimMonad, PrimState)
+import Control.Monad.State (evalStateT, get, put)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Writer (execWriterT, tell)
+import Data.Bytes.Get (getWord32le, runGetS)
+import Data.ByteString.Internal (ByteString(..))
+import Data.Either (fromRight)
+import Data.Primitive (MutVar, newMutVar, readMutVar, writeMutVar)
+import Data.Word (Word32, Word64)
+import System.Endian (fromLE64, toLE64)
+import System.IO (Handle, stdin, stdout)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BB
+import qualified Data.Vector as V
+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 Internal.Util (checkIndex)
+
+
+-- | The maximum size of a segment supported by this libarary, in words.
+maxSegmentSize :: Int
+maxSegmentSize = 1 `shiftL` 28 -- 2 GiB.
+
+-- | The maximum number of segments allowed in a message by this library.
+maxSegments :: Int
+maxSegments = 1024
+
+-- | A 'Message' is a (possibly read-only) capnproto message. It is
+-- parameterized over a monad in which operations are performed.
+class Monad m => Message m msg where
+ -- | The type of segments in the message.
+ data Segment msg
+
+ -- | 'numSegs' gets the number of segments in a message.
+ numSegs :: msg -> m Int
+ -- | @'internalGetSeg' message index@ gets the segment at index 'index'
+ -- in 'message'. Most callers should use the 'getSegment' wrapper, instead
+ -- of calling this directly.
+ internalGetSeg :: msg -> Int -> m (Segment msg)
+ -- | Get the length of the segment, in units of 64-bit words.
+ numWords :: Segment msg -> m Int
+ -- | @'slice' start length segment@ extracts a sub-section of the segment,
+ -- starting at index @start@, of length @length@.
+ slice :: Int -> Int -> Segment msg -> m (Segment msg)
+ -- | @'read' segment index@ reads a 64-bit word from the segement at the
+ -- given index. Consider using 'getWord' on the message, instead of
+ -- calling this directly.
+ read :: Segment msg -> Int -> m Word64
+ -- | Convert a ByteString to a segment.
+ fromByteString :: ByteString -> m (Segment msg)
+ -- | Convert a segment to a byte string.
+ toByteString :: Segment msg -> m ByteString
+
+-- | The 'Mutable' type class relates mutable and immutable versions of a type.
+-- The instance is defined on the mutable variant; @'Frozen' a@ is the immutable
+-- version of a mutable type @a@.
+class Mutable a where
+ -- | The state token for a mutable value.
+ type Scope a
+
+ -- | The immutable version of @a@.
+ type Frozen a
+
+ -- | Convert an immutable value to a mutable one.
+ thaw :: (MonadThrow m, PrimMonad m, PrimState m ~ Scope a) => Frozen a -> m a
+
+ -- | Convert a mutable value to an immutable one.
+ freeze :: (MonadThrow m, PrimMonad m, PrimState m ~ Scope a) => a -> m (Frozen a)
+
+-- | @'getSegment' message index@ fetches the given segment in the message.
+-- It throws a @BoundsError@ if the address is out of bounds.
+getSegment :: (MonadThrow m, Message m msg) => msg -> Int -> m (Segment msg)
+getSegment msg i = do
+ checkIndex i =<< numSegs msg
+ internalGetSeg msg i
+
+-- | @'getWord' msg addr@ returns the word at @addr@ within @msg@. It throws a
+-- @BoundsError@ if the address is out of bounds.
+getWord :: (MonadThrow m, Message m msg) => msg -> WordAddr -> m Word64
+getWord msg WordAt{wordIndex=wordIndex@(WordCount i), segIndex} = do
+ seg <- getSegment msg segIndex
+ checkIndex i =<< numWords seg
+ seg `read` i
+
+-- | @'setSegment' message index segment@ sets the segment at the given index
+-- in the message. It throws a @BoundsError@ if the address is out of bounds.
+setSegment :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Segment (MutMsg s) -> m ()
+setSegment msg i seg = do
+ checkIndex i =<< numSegs msg
+ internalSetSeg msg i seg
+
+-- | @'setWord' message address value@ sets the word at @address@ in the
+-- message to @value@. If the address is not valid in the message, a
+-- @BoundsError@ will be thrown.
+setWord :: (WriteCtx m s, MonadThrow m) => MutMsg s -> WordAddr -> Word64 -> m ()
+setWord msg WordAt{wordIndex=WordCount i, segIndex} val = do
+ seg <- getSegment msg segIndex
+ checkIndex i =<< numWords seg
+ write seg i val
+
+-- | A read-only capnproto message.
+--
+-- 'ConstMsg' is an instance of the generic 'Message' type class. its
+-- implementations of 'toByteString' and 'fromByteString' are O(1);
+-- the underlying bytes are not copied.
+newtype ConstMsg = ConstMsg (V.Vector (Segment ConstMsg))
+
+instance MonadThrow m => Message m ConstMsg where
+ newtype Segment ConstMsg = ConstSegment { constSegToVec :: SV.Vector Word64 }
+
+ numSegs (ConstMsg vec) = pure $ V.length vec
+ internalGetSeg (ConstMsg vec) i = do
+ checkIndex i (V.length vec)
+ vec `V.indexM` i
+
+ numWords (ConstSegment vec) = pure $ SV.length vec
+ slice start len (ConstSegment vec) = pure $ ConstSegment (SV.slice start len vec)
+ read (ConstSegment vec) i = fromLE64 <$> vec `SV.indexM` i
+
+ -- FIXME: Verify that the pointer is actually 64-bit aligned before casting.
+ fromByteString (PS fptr offset len) =
+ pure $ ConstSegment (SV.unsafeCast $ SV.unsafeFromForeignPtr fptr offset len)
+ toByteString (ConstSegment vec) = pure $ PS fptr offset len where
+ (fptr, offset, len) = SV.unsafeToForeignPtr (SV.unsafeCast vec)
+
+-- | 'decode' decodes a message from a bytestring.
+--
+-- The segments will not be copied; the resulting message will be a view into
+-- the original bytestring. Runs in O(number of segments in the message).
+decode :: MonadThrow m => ByteString -> m ConstMsg
+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)
+
+-- | 'decodeSeg' decodes a message from a segment, treating the segment as if
+-- it were raw bytes.
+--
+-- this is mostly here as a helper for 'decode'.
+decodeSeg :: MonadThrow m => Segment ConstMsg -> m ConstMsg
+decodeSeg seg = do
+ len <- numWords seg
+ flip evalStateT (Nothing, 0) $ evalLimitT len $
+ -- Note: we use the quota to avoid needing to do bounds checking here;
+ -- since readMessage invoices the quota before reading, we can rely on it
+ -- not to read past the end of the blob.
+ readMessage read32 readSegment
+ where
+ read32 = do
+ (cur, idx) <- get
+ case cur of
+ Just n -> do
+ put (Nothing, idx)
+ return n
+ Nothing -> do
+ word <- lift $ lift $ read seg idx
+ put (Just $ hi word, idx + 1)
+ return (lo word)
+ readSegment (WordCount len) = do
+ (cur, idx) <- get
+ put (cur, idx + len)
+ lift $ lift $ slice idx len seg
+
+-- | @readMessage read32 readSegment@ reads in a message using the
+-- monadic context, which should manage the current read position,
+-- into a message. read32 should read a 32-bit little-endian integer,
+-- and @readSegment n@ should read a blob of @n@ 64-bit words.
+-- The size of the message (in 64-bit words) is deducted from the traversal,
+-- limit which can be used to set the maximum message size.
+readMessage :: (MonadThrow m, MonadLimit m) => m Word32 -> (WordCount -> m (Segment ConstMsg)) -> m ConstMsg
+readMessage read32 readSegment = do
+ invoice 1
+ numSegs' <- read32
+ let numSegs = numSegs' + 1
+ invoice (fromIntegral numSegs `div` 2)
+ segSizes <- V.replicateM (fromIntegral numSegs) read32
+ when (numSegs `mod` 2 == 0) $ void read32
+ V.mapM_ (invoice . fromIntegral) segSizes
+ ConstMsg <$> V.mapM (readSegment . fromIntegral) segSizes
+
+-- | @writeMesage write32 writeSegment@ writes out the message. @write32@
+-- should write a 32-bit word in little-endian format to the output stream.
+-- @writeSegment@ should write a blob.
+writeMessage :: MonadThrow m => ConstMsg -> (Word32 -> m ()) -> (Segment ConstMsg -> m ()) -> m ()
+writeMessage (ConstMsg segs) write32 writeSegment = do
+ let numSegs = V.length segs
+ write32 (fromIntegral numSegs - 1)
+ V.forM_ segs $ \seg -> write32 =<< fromIntegral <$> numWords seg
+ when (numSegs `mod` 2 == 0) $ write32 0
+ V.forM_ segs writeSegment
+
+
+-- | @'hPutMsg' handle msg@ writes @msg@ to @handle@.
+hPutMsg :: Handle -> ConstMsg -> IO ()
+hPutMsg handle msg = encode msg >>= BB.hPutBuilder handle
+
+-- | Equivalent to @'hPutMsg' 'stdout'@
+putMsg :: ConstMsg -> IO ()
+putMsg = hPutMsg stdout
+
+-- | @'hGetMsg' handle limit@ reads a message from @handle@ that is at most
+-- @limit@ 64-bit words in length.
+hGetMsg :: Handle -> Int -> IO ConstMsg
+hGetMsg handle size =
+ evalLimitT size $ readMessage read32 readSegment
+ where
+ read32 :: LimitT IO Word32
+ read32 = lift $ do
+ bytes <- BS.hGet handle 4
+ -- The only way we get a left is if we get less than 4 bytes, in which
+ -- case hGet should have thrown:
+ pure $ fromRight (error "impossible") (runGetS getWord32le bytes)
+ readSegment n = lift $ BS.hGet handle (fromIntegral n * 8) >>= fromByteString
+
+-- | Equivalent to @'hGetMsg' 'stdin'@
+getMsg :: Int -> IO ConstMsg
+getMsg = hGetMsg stdin
+
+-- | A 'MutMsg' is a mutable capnproto message. The type parameter 's' is the
+-- state token for the instance of 'PrimMonad' in which the message may be
+-- modified.
+--
+-- 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.
+ }
+
+-- | 'WriteCtx' is the context needed for most write operations.
+type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m)
+
+instance WriteCtx m s => 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.
+ }
+
+ 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
+ fromByteString bytes = do
+ vec <- constSegToVec <$> fromByteString bytes
+ mvec <- SV.thaw vec
+ pure MutSegment
+ { mutSegVec = mvec
+ , mutSegLen = SV.length vec
+ }
+ toByteString mseg = do
+ seg <- freeze mseg
+ toByteString (seg :: Segment ConstMsg)
+
+ numSegs = readMutVar . mutMsgLen
+ internalGetSeg MutMsg{mutMsgSegs} i = do
+ segs <- readMutVar mutMsgSegs
+ MV.read segs i
+
+
+-- | @'internalSetSeg' message index segment@ sets the segment at the given
+-- 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
+ 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)
+
+-- | @'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
+ }
+
+-- | @'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
+ 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
+ }
+ setSegment msg segIndex newSeg
+ pure (segIndex, newSeg)
+
+-- | Like 'alloc', but the second argument allows the caller to specify the
+-- 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 }
+ newSeg <- grow oldSeg size
+ setSegment msg segIndex newSeg
+ pure ret
+
+-- | @'alloc' size@ allocates 'size' words within a message. it returns the
+-- starting address of the allocated memory.
+alloc :: WriteCtx m s => MutMsg s -> WordCount -> m WordAddr
+alloc msg size = do
+ segIndex <- pred <$> numSegs msg
+ allocInSeg msg segIndex size
+
+-- | 'empty' is an empty message, i.e. a minimal message with a null pointer as
+-- its root object.
+empty :: ConstMsg
+empty = ConstMsg $ V.fromList [ ConstSegment $ SV.fromList [0] ]
+
+-- | Allocate a new empty message.
+newMessage :: WriteCtx m s => m (MutMsg s)
+newMessage = thaw empty
+
+instance Mutable (Segment (MutMsg s)) where
+ type Scope (Segment (MutMsg s)) = s
+ type Frozen (Segment (MutMsg s)) = Segment ConstMsg
+
+ thaw (ConstSegment vec) = do
+ mvec <- SV.thaw vec
+ pure MutSegment
+ { mutSegVec = mvec
+ , mutSegLen = SV.length vec
+ }
+ 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 <$> SV.freeze mutSegVec
+
+
+instance Mutable (MutMsg s) where
+ type Scope (MutMsg s) = s
+ type Frozen (MutMsg s) = ConstMsg
+
+ thaw (ConstMsg vec) = do
+ segments <- V.mapM thaw vec >>= V.thaw
+ MutMsg
+ <$> newMutVar segments
+ <*> newMutVar (MV.length segments)
+ freeze msg@MutMsg{mutMsgLen} = do
+ len <- readMutVar mutMsgLen
+ ConstMsg <$> V.generateM len (getSegment msg >=> freeze)
diff --git a/lib/Data/Capnp/Pointer.hs b/lib/Data/Capnp/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Pointer.hs
@@ -0,0 +1,142 @@
+{- |
+Module: Data.Capnp.Pointer
+Description: Support for parsing/serializing capnproto pointers
+
+This module provides support for parsing and serializing capnproto pointers.
+-}
+module Data.Capnp.Pointer
+ ( Ptr(..)
+ , ElementSize(..)
+ , EltSpec(..)
+ , parsePtr
+ , serializePtr
+ , parseEltSpec
+ , serializeEltSpec
+ )
+ where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+
+import Data.Capnp.Bits
+
+-- | A 'Ptr' represents the information in a capnproto pointer.
+data Ptr
+ = StructPtr !Int32 !Word16 !Word16
+ -- ^ @'StructPtr' off dataSz ptrSz@ is a pointer to a struct
+ -- at offset @off@ in words from the end of the pointer, with
+ -- a data section of size @dataSz@ words, and a pointer section
+ -- of size @ptrSz@ words.
+ --
+ -- Note that the value @'StructPtr' 0 0 0@ is illegal, since
+ -- its encoding is reserved for the "null" pointer.
+ | ListPtr !Int32 !EltSpec
+ -- ^ @'ListPtr' off eltSpec@ is a pointer to a list starting at
+ -- offset @off@ in words from the end of the pointer. @eltSpec@
+ -- encodes the C and D fields in the encoding spec; see 'EltSpec'
+ -- for details
+ | FarPtr !Bool !Word32 !Word32
+ -- ^ @'FarPtr' twoWords off segment@ is a far pointer, whose landing
+ -- pad is:
+ --
+ -- * two words iff @twoWords@,
+ -- * @off@ words from the start of the target segment, and
+ -- * in segment id @segment@.
+ | CapPtr !Word32
+ -- ^ @'CapPtr' id@ is a pointer to the capability with the id @id@.
+ deriving(Show, Eq)
+
+
+-- | The element size field in a list pointer.
+data ElementSize
+ = Sz0
+ | Sz1
+ | Sz8
+ | Sz16
+ | Sz32
+ | Sz64
+ | SzPtr
+ deriving(Show, Eq, Enum)
+
+-- | A combination of the C and D fields in a list pointer, i.e. the element
+-- size, and either the number of elements in the list, or the total number
+-- of /words/ in the list (if size is composite).
+data EltSpec
+ = EltNormal !ElementSize !Word32
+ -- ^ @'EltNormal' size len@ is a normal (non-composite) element type
+ -- (C /= 7). @size@ is the size of the elements, and @len@ is the
+ -- number of elements in the list.
+ | EltComposite !Int32
+ -- ^ @EltComposite len@ is a composite element (C == 7). @len@ is the
+ -- length of the list in words.
+ deriving(Show, Eq)
+
+
+-- | @'parsePtr' word@ parses word as a capnproto pointer. A null pointer is
+-- parsed as 'Nothing'.
+parsePtr :: Word64 -> Maybe Ptr
+parsePtr 0 = Nothing
+parsePtr word = Just $
+ case bitRange word 0 2 of
+ 0 -> StructPtr
+ (i30 (lo word))
+ (bitRange word 32 48)
+ (bitRange word 48 64)
+ 1 -> ListPtr
+ (i30 (lo word))
+ (parseEltSpec word)
+ 2 -> FarPtr
+ (toEnum (bitRange word 2 3))
+ (bitRange word 3 32)
+ (bitRange word 32 64)
+ 3 -> CapPtr (bitRange word 32 64)
+ _ -> error "unreachable"
+
+-- | @'serializePtr' ptr@ serializes the pointer as a 'Word64', translating
+-- 'Nothing' to a null pointer.
+serializePtr :: Maybe Ptr -> Word64
+serializePtr Nothing = 0
+serializePtr (Just p) = serializePtr' p
+
+serializePtr' :: Ptr -> Word64
+serializePtr' (StructPtr 0 0 0) =
+ -- We need to handle this specially, since the normal encoding
+ -- would be interpreted as null. We can get around this by changing
+ -- the offset.
+ serializePtr' (StructPtr (-1) 0 0)
+serializePtr' (StructPtr off dataSz ptrSz) =
+ -- 0 .|.
+ fromLo (fromI30 off) .|.
+ (fromIntegral dataSz `shiftL` 32) .|.
+ (fromIntegral ptrSz `shiftL` 48)
+serializePtr' (ListPtr off eltSpec) = -- eltSz numElts) =
+ 1 .|.
+ fromLo (fromI30 off) .|.
+ serializeEltSpec eltSpec
+serializePtr' (FarPtr twoWords off segId) =
+ 2 .|.
+ (fromIntegral (fromEnum twoWords) `shiftL` 2) .|.
+ (fromIntegral off `shiftL` 3) .|.
+ (fromIntegral segId `shiftL` 32)
+serializePtr' (CapPtr index) =
+ 3 .|.
+ -- (fromIntegral 0 `shiftL` 2) .|.
+ (fromIntegral index `shiftL` 32)
+
+-- | @'parseEltSpec' word@ reads the 'EltSpec' from @word@, which must be the
+-- encoding of a list pointer (this is not verified).
+parseEltSpec :: Word64 -> EltSpec
+parseEltSpec word = case bitRange word 32 35 of
+ 7 -> EltComposite (i29 (hi word))
+ sz -> EltNormal (toEnum sz) (bitRange word 35 64)
+
+-- | @'serializeEltSpec' eltSpec@ serializes @eltSpec@ as a 'Word64'. all bits
+-- which are not determined by the 'EltSpec' are zero.
+serializeEltSpec :: EltSpec -> Word64
+serializeEltSpec (EltNormal sz len) =
+ (fromIntegral (fromEnum sz) `shiftL` 32) .|.
+ (fromIntegral len `shiftL` 35)
+serializeEltSpec (EltComposite words) =
+ (7 `shiftL` 32) .|.
+ fromHi (fromI29 words)
diff --git a/lib/Data/Capnp/Pure.hs b/lib/Data/Capnp/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Pure.hs
@@ -0,0 +1,46 @@
+{- |
+Module: Data.Capnp.Pure
+Description: The most commonly used functionality from the high-level API.
+-}
+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/TraversalLimit.hs b/lib/Data/Capnp/TraversalLimit.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/TraversalLimit.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{- |
+Module: Data.Capnp.TraversalLimit
+Description: Support for managing message traversal limits.
+
+This module is used to mitigate several pitfalls with the capnproto format,
+which could potentially lead to denial of service vulnerabilities.
+
+In particular, while they are illegal according to the spec, it is possible to
+encode objects which have many pointers pointing the same place, or even
+cycles. A naive traversal therefore could involve quite a lot of computation
+for a message that is very small on the wire.
+
+Accordingly, most implementations of the format keep track of how many bytes
+of a message have been accessed, and start signaling errors after a certain
+value (the "traversal limit") has been reached. The Haskell implementation is
+no exception; this module implements that logic. We provide a monad
+transformer and mtl-style type class to track the limit; reading from the
+message happens inside of this monad.
+
+-}
+module Data.Capnp.TraversalLimit
+ ( MonadLimit(..)
+ , LimitT
+ , runLimitT
+ , evalLimitT
+ , execLimitT
+ , defaultLimit
+ ) where
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadThrow(throwM))
+import Control.Monad.Primitive (PrimMonad(primitive), PrimState)
+import Control.Monad.State.Strict
+ (MonadState, StateT, evalStateT, execStateT, get, put, runStateT)
+import Control.Monad.Trans.Class (MonadTrans(lift))
+
+-- Just to define 'MonadLimit' instances:
+import Control.Monad.Reader (ReaderT)
+import Control.Monad.RWS (RWST)
+import Control.Monad.Writer (WriterT)
+
+import qualified Control.Monad.State.Lazy as LazyState
+
+import Data.Capnp.Errors (Error(TraversalLimitError))
+
+-- | mtl-style type class to track the traversal limit. This is used
+-- by other parts of the library which actually do the reading.
+class Monad m => MonadLimit m where
+ -- | @'invoice' n@ deducts @n@ from the traversal limit, signaling
+ -- an error if the limit is exhausted.
+ invoice :: Int -> m ()
+
+-- | Monad transformer implementing 'MonadLimit'. The underlying monad
+-- must implement 'MonadThrow'. 'invoice' calls @'throwM' 'TraversalLimitError'@
+-- when the limit is exhausted.
+newtype LimitT m a = LimitT (StateT Int m a)
+ deriving(Functor, Applicative, Monad)
+
+-- | Run a 'LimitT', returning the value from the computation and the remaining
+-- traversal limit.
+runLimitT :: MonadThrow m => Int -> LimitT m a -> m (a, Int)
+runLimitT limit (LimitT stateT) = runStateT stateT limit
+
+-- | Run a 'LimitT', returning the value from the computation.
+evalLimitT :: MonadThrow m => Int -> LimitT m a -> m a
+evalLimitT limit (LimitT stateT) = evalStateT stateT limit
+
+-- | Run a 'LimitT', returning the remaining traversal limit.
+execLimitT :: MonadThrow m => Int -> LimitT m a -> m Int
+execLimitT limit (LimitT stateT) = execStateT stateT limit
+
+-- | A sensible default traversal limit. Currently 64 MiB.
+defaultLimit :: Int
+defaultLimit = 64 * 1024 * 1024
+
+------ Instances of mtl type classes for 'LimitT'.
+
+instance MonadThrow m => MonadThrow (LimitT m) where
+ throwM = lift . throwM
+
+instance MonadThrow m => MonadLimit (LimitT m) where
+ invoice deduct = LimitT $ do
+ limit <- get
+ when (limit < deduct) $ throwM TraversalLimitError
+ put (limit - deduct)
+
+instance MonadTrans LimitT where
+ lift = LimitT . lift
+
+instance MonadState s m => MonadState s (LimitT m) where
+ get = lift get
+ put = lift . put
+
+instance (PrimMonad m, s ~ PrimState m) => PrimMonad (LimitT m) where
+ type PrimState (LimitT m) = PrimState m
+ primitive = lift . primitive
+
+------ Instances of 'MonadLimit' for standard monad transformers
+
+instance MonadLimit m => MonadLimit (StateT s m) where
+ invoice = lift . invoice
+
+instance MonadLimit m => MonadLimit (LazyState.StateT s m) where
+ invoice = lift . invoice
+
+instance (Monoid w, MonadLimit m) => MonadLimit (WriterT w m) where
+ invoice = lift . invoice
+
+instance (MonadLimit m) => MonadLimit (ReaderT r m) where
+ invoice = lift . invoice
+
+instance (Monoid w, MonadLimit m) => MonadLimit (RWST r w s m) where
+ invoice = lift . invoice
diff --git a/lib/Data/Capnp/Tutorial.hs b/lib/Data/Capnp/Tutorial.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Tutorial.hs
@@ -0,0 +1,491 @@
+{- |
+Module: Data.Capnp.Tutorial
+Description: Tutorial for the Haskell Cap'N Proto library.
+
+This module provides a tutorial on the overall usage of the library. Note that
+it does not aim to provide a thorough introduction to capnproto itself; see
+ for general information.
+
+-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+module Data.Capnp.Tutorial (
+ -- * Overview
+ -- $overview
+
+ -- * High Level API
+ -- $highlevel
+
+ -- ** Example
+ -- $highlevel-example
+
+ -- ** Code Generation Rules
+ -- $highlevel-codegen-rules
+
+ -- * Low Level API
+ -- $lowlevel
+
+ -- ** Example
+ -- $lowlevel-example
+
+ -- ** Write Support
+ -- $lowlevel-write
+ ) where
+
+-- So haddock references work:
+import System.IO (stdin, 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)
+
+import qualified Data.Capnp.TraversalLimit
+
+{- $overview
+
+The API is roughly divided into two parts: a low level API and a high
+level API. The high level API eschews some of the benefits of the wire
+format in favor of a more convenient interface.
+-}
+
+{- $highlevel
+
+The high level API exposes capnproto values as regular algebraic data
+types.
+
+On the plus side:
+
+* This makes it easier to work with capnproto values using idiomatic
+ Haskell code
+* Because we have to parse the data up-front we can *validate* the data
+ up front, so (unlike the low level API), you will not have to deal with
+ errors while traversing the message.
+
+Both of these factors make the high level API generally more pleasant
+to work with and less error-prone than the low level API.
+
+The downside is that you can't take advantage of some of the novel
+properties of the wire format. In particular:
+
+* It is theoretically slower, as there is a marshalling step involved
+ (actual performance has not been measured).
+* You can't mmap a file and read in only part of it.
+* You can't modify a message in-place.
+
+-}
+
+{- $highlevel-example
+
+As a running example, we'll use the following schema (borrowed from the
+C++ implementation's documentation):
+
+> # addressbook.capnp
+> @0xcd6db6afb4a0cf5c;
+>
+> struct Person {
+> id @0 :UInt32;
+> name @1 :Text;
+> email @2 :Text;
+> phones @3 :List(PhoneNumber);
+>
+> struct PhoneNumber {
+> number @0 :Text;
+> type @1 :Type;
+>
+> enum Type {
+> mobile @0;
+> home @1;
+> work @2;
+> }
+> }
+>
+> employment :union {
+> unemployed @4 :Void;
+> employer @5 :Text;
+> school @6 :Text;
+> selfEmployed @7 :Void;
+> # We assume that a person is only one of these.
+> }
+> }
+>
+> struct AddressBook {
+> people @0 :List(Person);
+> }
+
+Once the @capnp@ and @capnpc-haskell@ executables are installed and in
+your @$PATH@, you can generate code for this schema by running:
+
+> capnp compile -ohaskell addressbook.capnp
+
+This will create the following files relative to the current directory:
+
+* Capnp\/Addressbook.hs
+* Capnp\/Addressbook\/Pure.hs
+* Capnp\/ById\/Xcd6db6afb4a0cf5c/Pure.hs
+* Capnp\/ById\/Xcd6db6afb4a0cf5c.hs
+
+The modules under @ById@ are an implementation detail.
+@Capnp/Addressbook.hs@ is generated code for use with the low level API.
+@Capnp/Addressbook/Pure.hs@ is generated code for use with the high
+level API. It will export the following data declarations (cleaned up
+for readability).
+
+> module Capnp.Addressbook where
+>
+> import Data.Int
+> import Data.Text (Text)
+> import Data.Vector (Vector)
+> import Data.Word
+>
+> data AddressBook = AddressBook
+> { people :: Vector Person
+> }
+>
+> data Person = Person
+> { id :: Word32
+> , name :: Text
+> , email :: Text
+> , phones :: Vector Person'PhoneNumber
+> , employment :: Person'employment
+> }
+>
+> data Person'PhoneNumber = Person'PhoneNumber
+> { number :: Text
+> , type_ :: Person'PhoneNumber'Type
+> }
+>
+> data Person'employment
+> = Person'employment'unemployed
+> | Person'employment'employer Text
+> | Person'employment'school Text
+> | Person'employment'selfEmployed
+> | Person'employment'unknown' Word16
+>
+> data Person'PhoneNumber'Type
+> = Person'PhoneNumber'Type'mobile
+> | Person'PhoneNumber'Type'home
+> | Person'PhoneNumber'Type'work
+> | Person'PhoneNumber'Type'unknown' Word16
+
+Note that we use the single quote character as a namespace separator for
+namespaces within a single capnproto schema.
+
+The module also exports instances of several type classes:
+
+* 'Show'
+* 'Read'
+* 'Eq'
+* 'Generic' from 'GHC.Generics'
+* 'Default' from the @data-default@ package.
+* A number of type classes defined by the @capnp@ package.
+* Capnproto enums additionally implement the 'Enum' type class.
+
+Using the @Default@ instance to construct values means that your
+existing code will continue to work if new fields are added in the
+schema, but it also makes it easier to forget to set a field if you had
+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:
+
+> {-# LANGUAGE OverloadedStrings #-}
+> -- Note that DuplicateRecordFields is usually needed, as the generated
+> -- code relys on it to resolve collisions in capnproto struct field
+> -- names:
+> {-# LANGUAGE DuplicateRecordFields #-}
+> import Capnp.Addressbook.Pure
+>
+> -- Note that Data.Capnp.Pure re-exports `def`, as a convienence
+> import Data.Capnp.Pure (putValue, def)
+>
+> import qualified Data.Vector as V
+>
+> main = putValue AddressBook
+> { people = V.fromList
+> [ Person
+> { id = 123
+> , name = "Alice"
+> , email = "alice@example.com"
+> , phones = V.fromList
+> [ def
+> { number = "555-1212"
+> , type_ = Person'PhoneNumber'Type'mobile
+> }
+> ]
+> , employment = Person'employment'school "MIT"
+> }
+> , Person
+> { id = 456
+> , name = "Bob"
+> , email = "bob@example.com"
+> , phones = V.fromList
+> [ def
+> { number = "555-4567"
+> , type_ = Person'PhoneNumber'Type'home
+> }
+> , def
+> { number = "555-7654"
+> , type_ = Person'PhoneNumber'Type'work
+> }
+> ]
+> , employment = Person'employment'selfEmployed
+> }
+> ]
+> }
+
+'putValue' is equivalent to @'hPutValue' 'stdout'@; 'hPutValue' may be used
+to write to an arbitrary handle.
+
+We can use 'getValue' (or alternately 'hGetValue') to read in a message:
+
+> -- ...
+>
+> import Data.Capnp.Pure (getValue, defaultLimit)
+>
+> -- ...
+>
+> main = do
+> value <- getValue defaultLimit
+> print (value :: AddressBook)
+
+Note the type annotation; there are a number of interfaces in the
+library which dispatch on return types, and depending on how they are
+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
+
+...and so it may be used to read in any struct type.
+
+'defaultLimit' is a default value for the traversal limit, which acts to
+prevent denial of service vulnerabilities; See the documentation in
+@Data.Capnp.TraversalLimit@ for more information. 'getValue' uses this
+argument both to catch values that would cause excessive resource usage,
+and to simply limit the overall size of the incoming message. The
+default is approximately 64 MiB.
+
+If an error occurs, an exception will be thrown of type 'Error' from the
+`Data.Capnp.Errors` module.
+
+-}
+
+{- $highlevel-codegen-rules
+
+The complete rules for how capnproto types map to Haskell are as follows:
+
+* Integer types and booleans map to the obvious corresponding Haskell
+ types.
+* @Float32@ and @Float64@ map to 'Float' and 'Double', respectively.
+* @Void@ maps to the unit type, @()@.
+* Lists map to 'Vector's from the Haskell vector package. Note that
+ right now we use boxed vectors for everything; at some point this will
+ likely change for performance reasons. Using the functions from
+ 'Data.Vector.Generic' will probably decrease the amount of code you
+ will need to modify when upgrading.
+* @Text@ maps to (strict) 'T.Text' from the Haskell `text` package.
+* @Data@ maps to (strict) 'BS.ByteString's
+* Type constructor names are the fully qualified (within the schema file)
+ capnproto name, using the single quote character as a namespace
+ separator.
+* Structs map to record types. The name of the data constructor is the
+ same as the name of the type constructor.
+* Field names map to record fields with the same names. Names that are
+ Haskell keywords have an underscore appended to them, e.g. @type_@ in
+ the above example. These names are not qualified; we use the
+ @DuplicateRecordFields@ extension to disambiguate them.
+* Union fields result in an auxiliary type definition named
+ @\'\@. For an example, see the
+ mapping of the `employment` field above.
+* Unions and enums map to sum types, each of which has a special
+ `unknown'` variant (note the trailing single quote). This variant will
+ be returned when parsing a message which contains a union tag greater
+ than what was defined in the schema. This is most likely to happen
+ when dealing with data generated by software using a newer version
+ of the same schema. The argument to the data constructor is the value
+ of the tag.
+* Union variants with arguments of type `Void` map to data constructors
+ with no arguments.
+* The type for an anonymous union has the same name as its containing
+ struct with an extra single quote on the end. You can think of this as
+ being like a field with the empty string as its name. The Haskell
+ record accessor for this field is named `union'` (note the trailing
+ single quote).
+* As a special case, if a struct consists entirely of one anonymous
+ union, the type for the struct itself is omitted, and the name of the
+ type for the union does not have the trailing single quote (so its
+ name is what the name of the struct type would be).
+* Fields of type `AnyPointer` map to the types defined in
+ @Data.Capnp.Untyped.Pure@.
+* No code is currently generated for interfaces; this will change once
+ we implement RPC.
+-}
+
+{- $lowlevel
+
+The low level API exposes a much more imperative interface than the
+high-level API. Instead of algebraic data types, types are exposed as
+opaque wrappers around references into a message, and accessors are
+generated for the fields. This API is much closer in spirit to that of
+the C++ reference implementation.
+
+Because the low level interfaces do not parse and validate the message
+up front, accesses to the message can result in errors. Furthermore, the
+traversal limit needs to be tracked to avoid denial of service attacks.
+
+Because of this, access to the message must occur inside of a monad
+which is an instance of `MonadThrow` from the exceptions package, and
+`MonadLimit`, which is defined in `Data.Capnp.TraversalLimit`. We define
+a monad transformer `LimitT` for the latter.
+
+-}
+
+{- $lowlevel-example
+
+We'll use the same schema as above for our example. Instead of standard
+algebraic data types, the module `Capnp.Addressbook` primarily defines
+newtype wrappers, which should be treated as opaque, and accessor
+functions for the various fields.
+
+@
+newtype AddressBook msg = ...
+
+get_Addressbook'people :: ReadCtx m msg => AddressBook msg -> m (List msg (Person msg))
+
+newtype Person msg = ...
+
+get_Person'id :: ReadCtx m msg => Person msg -> m Word32
+get_Person'name :: ReadCtx m msg => Person msg -> m (Text msg)
+@
+
+`ReadCtx` is a type synonym:
+
+@
+type ReadCtx m msg = (Message m msg, MonadThrow m, MonadLimit m)
+@
+
+Note the following:
+
+* The generated data types are parametrized over a `msg` type. This is
+ the type of the message in which the value is contained. This can be
+ either 'ConstMsg' in the case of an immutable message, or @'MutMsg' s@
+ for a mutable message (where `s` is the state token for the monad in
+ which the message may be mutated).
+* The `Text` and `List` types mentioned in the type signatures are types
+ defined within the capnp library, and are similarly views into the
+ underlying message.
+* Access to the message happens in a monad which affords throwing
+ exceptions, tracking the traversal limit, and of course reading the
+ message.
+
+The snippet below prints the names of each person in the address book:
+
+> {-# LANGUAGE ScopedTypeVariables #-}
+> import Prelude hiding (length)
+>
+> import Capnp.Addressbook
+> import Data.Capnp
+> (ConstMsg, defaultLimit, evalLimitT, getValue, index, length, textBytes)
+>
+> import Control.Monad (forM_)
+> import Control.Monad.Trans (lift)
+> import qualified Data.ByteString.Char8 as BS8
+>
+> main = do
+> addressbook :: AddressBook ConstMsg <- getValue defaultLimit
+> evalLimitT defaultLimit $ do
+> people <- get_AddressBook'people addressbook
+> forM_ [0..length people - 1] $ \i -> do
+> name <- index i people >>= get_Person'name >>= textBytes
+> lift $ BS8.putStrLn name
+
+Note that we use the same `getValue` function as in the high-level
+example above.
+-}
+
+{- $lowlevel-write
+
+Writing messages using the low-level API has a similarly imperative feel.
+The below constructs the same message as in our high-level example above:
+
+> {-# LANGUAGE DuplicateRecordFields #-}
+> import Capnp.Addressbook
+>
+> import Capnp.Addressbook.Pure (Person'PhoneNumber(..))
+>
+> import Data.Capnp
+> (defaultLimit, evalLimitT, freeze, index, newMessage, newRoot, putMsg)
+> import Data.Capnp.Pure (cerialize, def)
+>
+> import qualified Data.Text as T
+> import qualified Data.Vector as V
+>
+> main = evalLimitT defaultLimit buildMsg >>= putMsg
+>
+> buildMsg = do
+> -- newMessage allocates a new, initially empty, mutable message:
+> msg <- newMessage
+>
+> -- newRoot allocates a new struct as the root object of the message.
+> -- In this case the type of the struct can be inferred from our later
+> -- use of Addressbook's accessors:
+> addressbook <- newRoot msg
+>
+> -- new_* accessors allocate a new value of the correct type for a
+> -- given field. These functions accordingly only exist for types
+> -- which are encoded as pointers (structs, lists, bytes...). In
+> -- the case of lists, these take an extra argument specifying a
+> -- the length of the list:
+> people <- new_AddressBook'people 2 addressbook
+>
+> -- Index gets an object at a specified location in a list. Cap'N Proto
+> -- lists are flat arrays, and in the case of structs the structs are
+> -- unboxed, so there is no need to allocate each element:
+> alice <- index 0 people
+>
+> -- set_* functions set the value of a field. For fields of non-pointer
+> -- types (integers, bools...), We can just pass the value we want to set_*,
+> -- rather than allocating via new_* first:
+> set_Person'id alice 123
+>
+> -- 'cerialize' is used to marshal a value into a message. Below, we copy
+> -- the text for Alice's name and email address into the message, and then
+> -- use Person's set_* functions to attach the resulting objects to our
+> -- Person:
+> set_Person'name alice =<< cerialize msg (T.pack "Alice")
+> set_Person'email alice =<< cerialize msg (T.pack "alice@example.com")
+>
+> phones <- new_Person'phones 1 alice
+> mobilePhone <- index 0 phones
+> set_Person'PhoneNumber'number mobilePhone =<< cerialize msg (T.pack "555-1212")
+> set_Person'PhoneNumber'type_ mobilePhone Person'PhoneNumber'Type'mobile
+>
+> -- Setting union fields is slightly awkward; we have an auxiliary type
+> -- for the union field, which we must get_* first:
+> employment <- get_Person'employment alice
+>
+> -- Then, we can use set_* to set both the tag of the union and the
+> -- value:
+> set_Person'employment'school employment =<< cerialize msg (T.pack "MIT")
+>
+> bob <- index 1 people
+> set_Person'id bob 456
+> set_Person'name bob =<< cerialize msg (T.pack "Bob")
+> set_Person'email bob =<< cerialize msg (T.pack "bob@example.com")
+>
+> phones <- new_Person'phones 2 bob
+> homePhone <- index 0 phones
+> set_Person'PhoneNumber'number homePhone =<< cerialize msg (T.pack "555-4567")
+> set_Person'PhoneNumber'type_ homePhone Person'PhoneNumber'Type'home
+> workPhone <- index 1 phones
+> set_Person'PhoneNumber'number workPhone =<< cerialize msg (T.pack "555-7654")
+> set_Person'PhoneNumber'type_ workPhone Person'PhoneNumber'Type'work
+> employment <- get_Person'employment bob
+> set_Person'employment'selfEmployed employment
+>
+> freeze msg
+-}
diff --git a/lib/Data/Capnp/Untyped.hs b/lib/Data/Capnp/Untyped.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Untyped.hs
@@ -0,0 +1,716 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: Data.Capnp.Untyped
+Description: Utilities for reading capnproto messages with no schema.
+
+The types and functions in this module know about things like structs and
+lists, but are not schema aware.
+
+Each of the data types exported by this module is parametrized over a Message
+type (see 'Data.Capnp.Message'), used as the underlying storage.
+-}
+module Data.Capnp.Untyped
+ ( Ptr(..), List(..), Struct, ListOf
+ , dataSection, ptrSection
+ , getData, getPtr
+ , setData, setPtr
+ , copyStruct
+ , get, index, length
+ , setIndex
+ , take
+ , rootPtr
+ , setRoot
+ , rawBytes
+ , ReadCtx
+ , RWCtx
+ , HasMessage(..), MessageDefault(..)
+ , allocStruct
+ , allocCompositeList
+ , allocList0
+ , allocList1
+ , allocList8
+ , allocList16
+ , allocList32
+ , allocList64
+ , allocListPtr
+ )
+ where
+
+import Prelude hiding (length, take)
+
+import Data.Bits
+import Data.Word
+
+import Control.Monad (forM_)
+import Control.Monad.Catch (MonadThrow(throwM))
+
+import qualified Data.ByteString as BS
+
+import Data.Capnp.Address (OffsetError(..), WordAddr(..), pointerFrom)
+import Data.Capnp.Bits
+ ( BitCount(..)
+ , ByteCount(..)
+ , Word1(..)
+ , WordCount(..)
+ , bitsToBytesCeil
+ , bytesToWordsCeil
+ , replaceBits
+ , wordsToBytes
+ )
+import Data.Capnp.Pointer (ElementSize(..))
+import Data.Capnp.TraversalLimit (MonadLimit(invoice))
+
+import qualified Data.Capnp.Errors as E
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Pointer as P
+
+-- | Type (constraint) synonym for the constraints needed for most read
+-- operations.
+type ReadCtx m msg = (M.Message m msg, MonadThrow m, MonadLimit m)
+
+-- | Synonym for ReadCtx + WriteCtx
+type RWCtx m s = (ReadCtx m (M.MutMsg s), M.WriteCtx m s)
+
+-- | A an absolute pointer to a value (of arbitrary type) in a message.
+-- Note that there is no variant for far pointers, which don't make sense
+-- with absolute addressing.
+data Ptr msg
+ = PtrCap msg !Word32
+ | PtrList (List msg)
+ | PtrStruct (Struct msg)
+
+-- | A list of values (of arbitrary type) in a message.
+data List msg
+ = List0 (ListOf msg ())
+ | List1 (ListOf msg Bool)
+ | List8 (ListOf msg Word8)
+ | List16 (ListOf msg Word16)
+ | List32 (ListOf msg Word32)
+ | List64 (ListOf msg Word64)
+ | ListPtr (ListOf msg (Maybe (Ptr msg)))
+ | ListStruct (ListOf msg (Struct msg))
+
+-- | A "normal" (non-composite) list.
+data NormalList msg = NormalList
+ { nMsg :: msg
+ , nAddr :: WordAddr
+ , nLen :: Int
+ }
+
+-- | A list of values of type 'a' in a message.
+data ListOf msg a where
+ ListOfVoid
+ :: msg
+ -> !Int -- number of elements
+ -> ListOf msg ()
+ ListOfStruct
+ :: Struct msg -- First element. data/ptr sizes are the same for
+ -- all elements.
+ -> !Int -- Number of elements
+ -> ListOf msg (Struct msg)
+ ListOfBool :: !(NormalList msg) -> ListOf msg Bool
+ ListOfWord8 :: !(NormalList msg) -> ListOf msg Word8
+ ListOfWord16 :: !(NormalList msg) -> ListOf msg Word16
+ ListOfWord32 :: !(NormalList msg) -> ListOf msg Word32
+ ListOfWord64 :: !(NormalList msg) -> ListOf msg Word64
+ ListOfPtr :: !(NormalList msg) -> ListOf msg (Maybe (Ptr msg))
+
+-- | A struct value in a message.
+data Struct msg
+ = Struct
+ msg
+ !WordAddr -- Start of struct
+ !Word16 -- Data section size.
+ !Word16 -- Pointer section size.
+
+instance M.Mutable msg => M.Mutable (Ptr msg) where
+ type Scope (Ptr msg) = M.Scope msg
+ type Frozen (Ptr msg) = Ptr (M.Frozen msg)
+ thaw (PtrCap cmsg n) = do
+ mmsg <- M.thaw cmsg
+ pure $ PtrCap mmsg n
+ thaw (PtrList l) = PtrList <$> M.thaw l
+ thaw (PtrStruct s) = PtrStruct <$> M.thaw s
+ freeze (PtrCap mmsg n) = do
+ cmsg <- M.freeze mmsg
+ pure $ PtrCap cmsg n
+ freeze (PtrList l) = PtrList <$> M.freeze l
+ freeze (PtrStruct s) = PtrStruct <$> M.freeze s
+instance M.Mutable msg => M.Mutable (List msg) where
+ type Scope (List msg) = M.Scope msg
+ type Frozen (List msg) = List (M.Frozen msg)
+ thaw (List0 l) = List0 <$> M.thaw l
+ thaw (List1 l) = List1 <$> M.thaw l
+ thaw (List8 l) = List8 <$> M.thaw l
+ thaw (List16 l) = List16 <$> M.thaw l
+ thaw (List32 l) = List32 <$> M.thaw l
+ thaw (List64 l) = List64 <$> M.thaw l
+ thaw (ListPtr l) = ListPtr <$> M.thaw l
+ thaw (ListStruct l) = ListStruct <$> M.thaw l
+ freeze (List0 l) = List0 <$> M.freeze l
+ freeze (List1 l) = List1 <$> M.freeze l
+ freeze (List8 l) = List8 <$> M.freeze l
+ freeze (List16 l) = List16 <$> M.freeze l
+ freeze (List32 l) = List32 <$> M.freeze l
+ freeze (List64 l) = List64 <$> M.freeze l
+ freeze (ListPtr l) = ListPtr <$> M.freeze l
+ freeze (ListStruct l) = ListStruct <$> M.freeze l
+instance M.Mutable msg => M.Mutable (NormalList msg) where
+ type Scope (NormalList msg) = M.Scope msg
+ type Frozen (NormalList msg) = NormalList (M.Frozen msg)
+ thaw NormalList{..} = do
+ mmsg <- M.thaw nMsg
+ pure NormalList { nMsg = mmsg, .. }
+ freeze NormalList{..} = do
+ cmsg <- M.freeze nMsg
+ pure NormalList { nMsg = cmsg, .. }
+instance M.Mutable msg => M.Mutable (ListOf msg ()) where
+ type Scope (ListOf msg ()) = M.Scope msg
+ type Frozen (ListOf msg ()) = ListOf (M.Frozen msg) ()
+ thaw (ListOfVoid cmsg n) = do
+ mmsg <- M.thaw cmsg
+ pure $ ListOfVoid mmsg n
+ freeze (ListOfVoid mmsg n) = do
+ cmsg <- M.freeze mmsg
+ pure $ ListOfVoid cmsg n
+
+-- Annoyingly, we can't just have an instance @Mutable (ListOf msg a)@
+-- because that would require that the implementation to be valid for e.g.
+-- @Mutable m (ListOf mmsg (Struct mmsg)) (ListOf cmsg (Struct mmsg))@ (note that the type
+-- parameter for 'Struct' does not change). So, instead, we define a separate instance for
+-- each possible parameter type.
+--
+-- TODO: generate this automatically.
+instance M.Mutable msg => M.Mutable (ListOf msg Bool) where
+ type Scope (ListOf msg Bool) = M.Scope msg
+ type Frozen (ListOf msg Bool) = ListOf (M.Frozen msg) Bool
+ thaw (ListOfBool msg) = ListOfBool <$> M.thaw msg
+ freeze (ListOfBool msg) = ListOfBool <$> M.freeze msg
+instance M.Mutable msg => M.Mutable (ListOf msg Word8) where
+ type Scope (ListOf msg Word8) = M.Scope msg
+ type Frozen (ListOf msg Word8) = ListOf (M.Frozen msg) Word8
+ thaw (ListOfWord8 msg) = ListOfWord8 <$> M.thaw msg
+ freeze (ListOfWord8 msg) = ListOfWord8 <$> M.freeze msg
+instance M.Mutable msg => M.Mutable (ListOf msg Word16) where
+ type Scope (ListOf msg Word16) = M.Scope msg
+ type Frozen (ListOf msg Word16) = ListOf (M.Frozen msg) Word16
+ thaw (ListOfWord16 msg) = ListOfWord16 <$> M.thaw msg
+ freeze (ListOfWord16 msg) = ListOfWord16 <$> M.freeze msg
+instance M.Mutable msg => M.Mutable (ListOf msg Word32) where
+ type Scope (ListOf msg Word32) = M.Scope msg
+ type Frozen (ListOf msg Word32) = ListOf (M.Frozen msg) Word32
+ thaw (ListOfWord32 msg) = ListOfWord32 <$> M.thaw msg
+ freeze (ListOfWord32 msg) = ListOfWord32 <$> M.freeze msg
+instance M.Mutable msg => M.Mutable (ListOf msg Word64) where
+ type Scope (ListOf msg Word64) = M.Scope msg
+ type Frozen (ListOf msg Word64) = ListOf (M.Frozen msg) Word64
+ thaw (ListOfWord64 msg) = ListOfWord64 <$> M.thaw msg
+ freeze (ListOfWord64 msg) = ListOfWord64 <$> M.freeze msg
+instance M.Mutable msg => M.Mutable (ListOf msg (Struct msg)) where
+ type Scope (ListOf msg (Struct msg)) = M.Scope msg
+ type Frozen (ListOf msg (Struct msg)) = ListOf (M.Frozen msg) (Struct (M.Frozen msg))
+ thaw (ListOfStruct ctag size) = do
+ mtag <- M.thaw ctag
+ pure $ ListOfStruct mtag size
+ freeze (ListOfStruct mtag size) = do
+ ctag <- M.freeze mtag
+ pure $ ListOfStruct ctag size
+
+instance M.Mutable msg => M.Mutable (ListOf msg (Maybe (Ptr msg))) where
+ type Scope (ListOf msg (Maybe (Ptr msg))) = M.Scope msg
+ type Frozen (ListOf msg (Maybe (Ptr msg))) = ListOf (M.Frozen msg) (Maybe (Ptr (M.Frozen msg)))
+
+ thaw (ListOfPtr msg) = ListOfPtr <$> M.thaw msg
+ freeze (ListOfPtr msg) = ListOfPtr <$> M.freeze msg
+
+instance M.Mutable msg => M.Mutable (Struct msg) where
+ type Scope (Struct msg) = M.Scope msg
+ type Frozen (Struct msg) = Struct (M.Frozen msg)
+
+ thaw (Struct cmsg addr dataSz ptrSz) = do
+ mmsg <- M.thaw cmsg
+ pure $ Struct mmsg addr dataSz ptrSz
+ freeze (Struct mmsg addr dataSz ptrSz) = do
+ cmsg <- M.freeze mmsg
+ pure $ Struct cmsg addr dataSz ptrSz
+
+-- | Types @a@ whose storage is owned by a message with blob type @b@.
+class HasMessage a msg where
+ -- | Get the message in which the @a@ is stored.
+ message :: a -> msg
+
+-- | Types which have a "default" value, but require a message
+-- to construct it.
+--
+-- 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
+
+instance HasMessage (Ptr msg) msg where
+ message (PtrCap msg _) = msg
+ message (PtrList list) = message list
+ message (PtrStruct struct) = message struct
+
+instance HasMessage (Struct msg) msg where
+ message (Struct msg _ _ _) = msg
+
+instance MessageDefault (Struct msg) msg where
+ messageDefault msg = Struct msg (WordAt 0 0) 0 0
+
+instance HasMessage (List msg) msg where
+ message (List0 list) = message list
+ message (List1 list) = message list
+ message (List8 list) = message list
+ message (List16 list) = message list
+ message (List32 list) = message list
+ message (List64 list) = message list
+ message (ListPtr list) = message list
+ message (ListStruct list) = message list
+
+instance HasMessage (ListOf msg a) msg where
+ message (ListOfVoid msg _) = msg
+ message (ListOfStruct tag _) = message tag
+ message (ListOfBool list) = message list
+ message (ListOfWord8 list) = message list
+ message (ListOfWord16 list) = message list
+ message (ListOfWord32 list) = message list
+ message (ListOfWord64 list) = message list
+ message (ListOfPtr list) = message list
+
+instance MessageDefault (ListOf msg ()) msg where
+ messageDefault msg = ListOfVoid msg 0
+instance MessageDefault (ListOf msg (Struct msg)) msg where
+ messageDefault msg = ListOfStruct (messageDefault msg) 0
+instance MessageDefault (ListOf msg Bool) msg where
+ messageDefault msg = ListOfBool (messageDefault msg)
+instance MessageDefault (ListOf msg Word8) msg where
+ messageDefault msg = ListOfWord8 (messageDefault msg)
+instance MessageDefault (ListOf msg Word16) msg where
+ messageDefault msg = ListOfWord16 (messageDefault msg)
+instance MessageDefault (ListOf msg Word32) msg where
+ messageDefault msg = ListOfWord32 (messageDefault msg)
+instance MessageDefault (ListOf msg Word64) msg where
+ messageDefault msg = ListOfWord64 (messageDefault msg)
+instance MessageDefault (ListOf msg (Maybe (Ptr msg))) msg where
+ messageDefault msg = ListOfPtr (messageDefault msg)
+
+instance HasMessage (NormalList msg) msg where
+ message = nMsg
+
+instance MessageDefault (NormalList msg) msg where
+ messageDefault msg = NormalList msg (WordAt 0 0) 0
+
+-- | @get msg addr@ returns the Ptr stored at @addr@ in @msg@.
+-- Deducts 1 from the quota for each word read (which may be multiple in the
+-- case of far pointers).
+get :: ReadCtx m msg => msg -> WordAddr -> m (Maybe (Ptr msg))
+get msg addr = do
+ word <- getWord msg addr
+ case P.parsePtr word of
+ Nothing -> return Nothing
+ Just p -> case p of
+ P.CapPtr cap -> return $ Just $ PtrCap msg cap
+ P.StructPtr off dataSz ptrSz -> return $ Just $ PtrStruct $
+ Struct msg (resolveOffset addr off) dataSz ptrSz
+ P.ListPtr off eltSpec -> Just <$> getList (resolveOffset addr off) eltSpec
+ P.FarPtr twoWords offset segment -> do
+ let addr' = WordAt { wordIndex = fromIntegral offset
+ , segIndex = fromIntegral segment
+ }
+ if not twoWords
+ then get msg addr'
+ else do
+ landingPad <- getWord msg addr'
+ case P.parsePtr landingPad of
+ Just (P.FarPtr False off seg) -> do
+ tagWord <- getWord
+ msg
+ addr' { wordIndex = wordIndex addr' + 1 }
+ let finalAddr = WordAt { wordIndex = fromIntegral off
+ , segIndex = fromIntegral seg
+ }
+ case P.parsePtr tagWord of
+ Just (P.StructPtr 0 dataSz ptrSz) ->
+ return $ Just $ PtrStruct $
+ Struct msg finalAddr dataSz ptrSz
+ Just (P.ListPtr 0 eltSpec) ->
+ Just <$> getList finalAddr eltSpec
+ -- TODO: I'm not sure whether far pointers to caps are
+ -- legal; it's clear how they would work, but I don't
+ -- see a use, and the spec is unclear. Should check
+ -- how the reference implementation does this, copy
+ -- that, and submit a patch to the spec.
+ Just (P.CapPtr cap) ->
+ return $ Just $ PtrCap msg cap
+ ptr -> throwM $ E.InvalidDataError $
+ "The tag word of a far pointer's " ++
+ "2-word landing pad should be an intra " ++
+ "segment pointer with offset 0, but " ++
+ "we read " ++ show ptr
+ ptr -> throwM $ E.InvalidDataError $
+ "The first word of a far pointer's 2-word " ++
+ "landing pad should be another far pointer " ++
+ "(with a one-word landing pad), but we read " ++
+ show ptr
+
+ where
+ getWord msg addr = invoice 1 *> M.getWord msg addr
+ resolveOffset addr@WordAt{..} off =
+ addr { wordIndex = wordIndex + fromIntegral off + 1 }
+ getList addr@WordAt{..} eltSpec = PtrList <$>
+ case eltSpec of
+ P.EltNormal sz len -> pure $ case sz of
+ Sz0 -> List0 (ListOfVoid msg (fromIntegral len))
+ Sz1 -> List1 (ListOfBool nlist)
+ Sz8 -> List8 (ListOfWord8 nlist)
+ Sz16 -> List16 (ListOfWord16 nlist)
+ Sz32 -> List32 (ListOfWord32 nlist)
+ Sz64 -> List64 (ListOfWord64 nlist)
+ SzPtr -> ListPtr (ListOfPtr nlist)
+ where
+ nlist = NormalList msg addr (fromIntegral len)
+ P.EltComposite _ -> do
+ tagWord <- getWord msg addr
+ case P.parsePtr tagWord of
+ Just (P.StructPtr numElts dataSz ptrSz) ->
+ pure $ ListStruct $ ListOfStruct
+ (Struct msg
+ addr { wordIndex = wordIndex + 1 }
+ dataSz
+ ptrSz)
+ (fromIntegral numElts)
+ tag -> throwM $ E.InvalidDataError $
+ "Composite list tag was not a struct-" ++
+ "formatted word: " ++ show tag
+
+-- | Return the EltSpec needed for a pointer to the given list.
+listEltSpec :: List msg -> P.EltSpec
+listEltSpec (ListStruct list@(ListOfStruct (Struct msg _ dataSz ptrSz) _)) =
+ P.EltComposite $ fromIntegral (length list) * (fromIntegral dataSz + fromIntegral ptrSz)
+listEltSpec (List0 list) = P.EltNormal Sz0 $ fromIntegral (length list)
+listEltSpec (List1 list) = P.EltNormal Sz1 $ fromIntegral (length list)
+listEltSpec (List8 list) = P.EltNormal Sz8 $ fromIntegral (length list)
+listEltSpec (List16 list) = P.EltNormal Sz16 $ fromIntegral (length list)
+listEltSpec (List32 list) = P.EltNormal Sz32 $ fromIntegral (length list)
+listEltSpec (List64 list) = P.EltNormal Sz64 $ fromIntegral (length list)
+listEltSpec (ListPtr list) = P.EltNormal SzPtr $ fromIntegral (length list)
+
+-- | Return the starting address of the list.
+listAddr :: List msg -> WordAddr
+listAddr (ListStruct (ListOfStruct (Struct _ addr _ _) _)) =
+ -- addr is the address of the first element of the list, but
+ -- composite lists start with a tag word:
+ addr { wordIndex = wordIndex addr - 1 }
+listAddr (List0 _) = WordAt { segIndex = 0, wordIndex = 1 }
+listAddr (List1 (ListOfBool NormalList{nAddr})) = nAddr
+listAddr (List8 (ListOfWord8 NormalList{nAddr})) = nAddr
+listAddr (List16 (ListOfWord16 NormalList{nAddr})) = nAddr
+listAddr (List32 (ListOfWord32 NormalList{nAddr})) = nAddr
+listAddr (List64 (ListOfWord64 NormalList{nAddr})) = nAddr
+listAddr (ListPtr (ListOfPtr NormalList{nAddr})) = nAddr
+
+-- | Return the address of the pointer's target. It is illegal to call this on
+-- a pointer which targets a capability.
+ptrAddr :: Ptr msg -> WordAddr
+ptrAddr (PtrCap _ _) = error "ptrAddr called on a capability pointer."
+ptrAddr (PtrStruct (Struct _ addr _ _)) = addr
+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 value i list | length list <= i =
+ throwM E.BoundsError { E.index = i, E.maxIndex = length list }
+setIndex value i list = case list of
+ ListOfVoid _ _ -> pure ()
+ ListOfBool nlist -> setNIndex nlist 64 (Word1 value)
+ ListOfWord8 nlist -> setNIndex nlist 8 value
+ ListOfWord16 nlist -> setNIndex nlist 4 value
+ ListOfWord32 nlist -> setNIndex nlist 2 value
+ ListOfWord64 nlist -> setNIndex nlist 1 value
+ ListOfPtr nlist -> case value of
+ Nothing -> setNIndex nlist 1 (P.serializePtr Nothing)
+ Just (PtrCap _ cap) -> setNIndex nlist 1 (P.serializePtr (Just (P.CapPtr cap)))
+ Just p@(PtrList ptrList) ->
+ setPtrIndex nlist p $ P.ListPtr 0 (listEltSpec ptrList)
+ Just p@(PtrStruct (Struct _ addr dataSz ptrSz)) ->
+ setPtrIndex nlist p $ P.StructPtr 0 dataSz ptrSz
+ list@(ListOfStruct _ _) -> do
+ dest <- index i list
+ copyStruct dest value
+ where
+ setNIndex :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s, Bounded a, Integral a) => NormalList (M.MutMsg s) -> Int -> a -> m ()
+ setNIndex NormalList{nAddr=nAddr@WordAt{..},..} eltsPerWord value = do
+ let wordAddr = nAddr { wordIndex = wordIndex + WordCount (i `div` eltsPerWord) }
+ word <- M.getWord nMsg wordAddr
+ let shift = (i `mod` eltsPerWord) * (64 `div` eltsPerWord)
+ M.setWord nMsg wordAddr $ replaceBits value word shift
+ setPtrIndex :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) => NormalList (M.MutMsg s) -> Ptr (M.MutMsg s) -> P.Ptr -> m ()
+ setPtrIndex nlist@NormalList{..} absPtr relPtr =
+ let srcAddr = nAddr { wordIndex = wordIndex nAddr + WordCount i }
+ in setPointerTo nMsg srcAddr (ptrAddr absPtr) relPtr
+
+-- | @'setPointerTo' msg srcAddr dstAddr relPtr@ sets the word at @srcAddr@ in @msg@ to a
+-- pointer like @relPtr@, but pointing to @dstAddr@. @relPtr@ should not be a far pointer.
+-- If the two addresses are in different segments, a landing pad will be allocated and
+-- @dstAddr@ will contain a far pointer.
+setPointerTo :: M.WriteCtx m s => M.MutMsg s -> WordAddr -> WordAddr -> P.Ptr -> m ()
+setPointerTo msg srcAddr dstAddr relPtr =
+ case pointerFrom srcAddr dstAddr relPtr of
+ Right absPtr ->
+ M.setWord msg srcAddr (P.serializePtr $ Just absPtr)
+ Left OutOfRange ->
+ error "BUG: segment is too large to set the pointer."
+ Left DifferentSegments -> do
+ -- We need a far pointer; allocate a landing pad in the target segment,
+ -- set it to point to the final destination, an then set the source pointer
+ -- pointer to point to the landing pad.
+ let WordAt{segIndex} = dstAddr
+ landingPadAddr <- M.allocInSeg msg segIndex 1
+ case pointerFrom landingPadAddr dstAddr relPtr of
+ Right landingPad -> do
+ M.setWord msg landingPadAddr (P.serializePtr $ Just landingPad)
+ let WordAt{segIndex,wordIndex} = landingPadAddr
+ M.setWord msg srcAddr $
+ P.serializePtr $ Just $ P.FarPtr False (fromIntegral wordIndex) (fromIntegral segIndex)
+ Left DifferentSegments ->
+ error "BUG: allocated a landing pad in the wrong segment!"
+ Left OutOfRange ->
+ error "BUG: segment is too large to set the pointer."
+
+
+-- | @'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 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
+ -- pointers as necessary. If the destination section is
+ -- smaller than the source section, this will raise a BoundsError.
+ --
+ -- TODO: possible enhancement: allow the destination section to be
+ -- smaller than the source section if and only if the tail of the
+ -- source section is all zeros (default values).
+ copySection (dataSection dest) (dataSection src) 0
+ copySection (ptrSection dest) (ptrSection src) Nothing
+ 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
+ -- Pad the remainder with zeros/default values:
+ forM_ [length src..length dest - 1] $ \i ->
+ setIndex pad i dest
+
+
+-- | @index i list@ returns the ith element in @list@. Deducts 1 from the quota
+index :: ReadCtx m msg => Int -> ListOf msg a -> m a
+index i list = invoice 1 >> index' list
+ where
+ index' :: ReadCtx m msg => ListOf msg a -> m a
+ index' (ListOfVoid _ len)
+ | i < len = pure ()
+ | otherwise = throwM E.BoundsError { E.index = i, E.maxIndex = len - 1 }
+ index' (ListOfStruct (Struct msg addr@WordAt{..} dataSz ptrSz) len)
+ | i < len = do
+ let offset = WordCount $ i * (fromIntegral dataSz + fromIntegral ptrSz)
+ let addr' = addr { wordIndex = wordIndex + offset }
+ return $ Struct msg addr' dataSz ptrSz
+ | otherwise = throwM E.BoundsError { E.index = i, E.maxIndex = len - 1}
+ index' (ListOfBool nlist) = do
+ Word1 val <- indexNList nlist 64
+ pure val
+ index' (ListOfWord8 nlist) = indexNList nlist 8
+ index' (ListOfWord16 nlist) = indexNList nlist 4
+ index' (ListOfWord32 nlist) = indexNList nlist 2
+ index' (ListOfWord64 (NormalList msg addr@WordAt{..} len))
+ | i < len = M.getWord msg addr { wordIndex = wordIndex + WordCount i }
+ | otherwise = throwM E.BoundsError { E.index = i, E.maxIndex = len - 1}
+ index' (ListOfPtr (NormalList msg addr@WordAt{..} len))
+ | i < len = get msg addr { wordIndex = wordIndex + WordCount i }
+ | otherwise = throwM E.BoundsError { E.index = i, E.maxIndex = len - 1}
+ indexNList :: (ReadCtx m msg, Integral a) => NormalList msg -> Int -> m a
+ indexNList (NormalList msg addr@WordAt{..} len) eltsPerWord
+ | i < len = do
+ let wordIndex' = wordIndex + WordCount (i `div` eltsPerWord)
+ word <- M.getWord msg addr { wordIndex = wordIndex' }
+ let shift = (i `mod` eltsPerWord) * (64 `div` eltsPerWord)
+ pure $ fromIntegral $ word `shiftR` shift
+ | otherwise = throwM E.BoundsError { E.index = i, E.maxIndex = len - 1 }
+
+-- | Returns the length of a list
+length :: ListOf msg a -> Int
+length (ListOfVoid _ len) = len
+length (ListOfStruct _ len) = len
+length (ListOfBool nlist) = nLen nlist
+length (ListOfWord8 nlist) = nLen nlist
+length (ListOfWord16 nlist) = nLen nlist
+length (ListOfWord32 nlist) = nLen nlist
+length (ListOfWord64 nlist) = nLen nlist
+length (ListOfPtr nlist) = nLen nlist
+
+-- | Return a prefix of the list, of the given length.
+take :: MonadThrow m => Int -> ListOf msg a -> m (ListOf msg a)
+take count list
+ | length list < count =
+ throwM E.BoundsError { E.index = count, E.maxIndex = length list - 1 }
+ | otherwise = pure $ go list
+ where
+ go (ListOfVoid msg _) = ListOfVoid msg count
+ go (ListOfStruct tag _) = ListOfStruct tag count
+ go (ListOfBool nlist) = ListOfBool $ nTake nlist
+ go (ListOfWord8 nlist) = ListOfWord8 $ nTake nlist
+ go (ListOfWord16 nlist) = ListOfWord16 $ nTake nlist
+ go (ListOfWord32 nlist) = ListOfWord32 $ nTake nlist
+ go (ListOfWord64 nlist) = ListOfWord64 $ nTake nlist
+ go (ListOfPtr nlist) = ListOfPtr $ nTake nlist
+
+ nTake :: NormalList msg -> NormalList msg
+ nTake NormalList{..} = NormalList { nLen = count, .. }
+
+-- | The data section of a struct, as a list of Word64
+dataSection :: Struct msg -> ListOf msg Word64
+dataSection (Struct msg addr dataSz _) =
+ ListOfWord64 $ NormalList msg addr (fromIntegral dataSz)
+
+-- | The pointer section of a struct, as a list of Ptr
+ptrSection :: Struct msg -> ListOf msg (Maybe (Ptr msg))
+ptrSection (Struct msg addr@WordAt{..} dataSz ptrSz) =
+ ListOfPtr $ NormalList
+ msg
+ addr { wordIndex = wordIndex + fromIntegral dataSz }
+ (fromIntegral ptrSz)
+
+-- | @'getData' i struct@ gets the @i@th word from the struct's data section,
+-- returning 0 if it is absent.
+getData :: ReadCtx m msg => Int -> Struct msg -> m Word64
+getData i struct
+ | length (dataSection struct) <= i = 0 <$ invoice 1
+ | otherwise = index i (dataSection struct)
+
+-- | @'getPtr' i struct@ gets the @i@th word from the struct's pointer section,
+-- returning Nothing if it is absent.
+getPtr :: ReadCtx m msg => Int -> Struct msg -> m (Maybe (Ptr msg))
+getPtr i struct
+ | length (ptrSection struct) <= i = Nothing <$ invoice 1
+ | otherwise = index i (ptrSection struct)
+
+-- | @'setData' value i struct@ sets the @i@th word in the struct's data section
+-- to @value@.
+setData :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s)
+ => Word64 -> Int -> Struct (M.MutMsg s) -> m ()
+setData value i = setIndex value i . dataSection
+
+-- | @'setData' value i struct@ sets the @i@th pointer in the struct's pointer
+-- section to @value@.
+setPtr :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) => Maybe (Ptr (M.MutMsg s)) -> Int -> Struct (M.MutMsg s) -> m ()
+setPtr value i = setIndex value i . ptrSection
+
+-- | 'rawBytes' returns the raw bytes corresponding to the list.
+rawBytes :: ReadCtx m msg => ListOf msg Word8 -> m BS.ByteString
+rawBytes (ListOfWord8 (NormalList msg WordAt{..} len)) = do
+ invoice len
+ bytes <- M.getSegment msg segIndex >>= M.toByteString
+ let ByteCount byteOffset = wordsToBytes wordIndex
+ pure $ BS.take len $ BS.drop byteOffset bytes
+
+
+-- | Returns the root pointer of a message.
+rootPtr :: ReadCtx m msg => msg -> m (Struct msg)
+rootPtr msg = do
+ root <- get msg (WordAt 0 0)
+ case root of
+ Just (PtrStruct struct) -> pure struct
+ Nothing -> pure (messageDefault msg)
+ _ -> throwM $ E.SchemaViolationError
+ "Unexpected root type; expected struct."
+
+
+-- | Make the given struct the root object of its message.
+setRoot :: M.WriteCtx m s => Struct (M.MutMsg s) -> m ()
+setRoot (Struct msg addr dataSz ptrSz) =
+ setPointerTo msg (WordAt 0 0) addr (P.StructPtr 0 dataSz ptrSz)
+
+-- | Allocate a struct in the message.
+allocStruct :: M.WriteCtx m s => M.MutMsg s -> Word16 -> Word16 -> m (Struct (M.MutMsg s))
+allocStruct msg dataSz ptrSz = do
+ let totalSz = fromIntegral dataSz + fromIntegral ptrSz
+ addr <- M.alloc msg totalSz
+ pure $ Struct msg addr dataSz ptrSz
+
+-- | Allocate a composite list.
+allocCompositeList
+ :: M.WriteCtx m s
+ => M.MutMsg s -- ^ The message to allocate in.
+ -> Word16 -- ^ The size of the data sections
+ -> Word16 -- ^ The size of the pointer sections
+ -> Int -- ^ The length of the list in elements.
+ -> m (ListOf (M.MutMsg s) (Struct (M.MutMsg s)))
+allocCompositeList msg dataSz ptrSz len = do
+ let eltSize = fromIntegral dataSz + fromIntegral ptrSz
+ addr <- M.alloc msg (WordCount $ len * eltSize + 1) -- + 1 for the tag word.
+ M.setWord msg addr $ P.serializePtr $ Just $ P.StructPtr (fromIntegral len) dataSz ptrSz
+ let firstStruct = Struct
+ msg
+ addr { wordIndex = wordIndex addr + 1 }
+ dataSz
+ ptrSz
+ pure $ ListOfStruct firstStruct len
+
+-- | Allocate a list of capnproto @Void@ values.
+allocList0 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) ())
+
+-- | Allocate a list of booleans
+allocList1 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Bool)
+
+-- | Allocate a list of 8-bit values.
+allocList8 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word8)
+
+-- | Allocate a list of 16-bit values.
+allocList16 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word16)
+
+-- | Allocate a list of 32-bit values.
+allocList32 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word32)
+
+-- | Allocate a list of 64-bit words.
+allocList64 :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word64)
+
+-- | Allocate a list of pointers.
+allocListPtr :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) (Maybe (Ptr (M.MutMsg s))))
+
+allocList0 msg len = pure $ ListOfVoid msg len
+allocList1 msg len = ListOfBool <$> allocNormalList 1 msg len
+allocList8 msg len = ListOfWord8 <$> allocNormalList 8 msg len
+allocList16 msg len = ListOfWord16 <$> allocNormalList 16 msg len
+allocList32 msg len = ListOfWord32 <$> allocNormalList 32 msg len
+allocList64 msg len = ListOfWord64 <$> allocNormalList 64 msg len
+allocListPtr msg len = ListOfPtr <$> allocNormalList 64 msg len
+
+-- | Allocate a NormalList
+allocNormalList
+ :: M.WriteCtx m s
+ => Int -- ^ The number of elements per 64-bit word
+ -> M.MutMsg s -- ^ The message to allocate in
+ -> Int -- ^ The number of bits per element
+ -> m (NormalList (M.MutMsg s))
+allocNormalList bitsPerElt msg len = do
+ -- round 'len' up to the nearest word boundary.
+ let totalBits = BitCount (len * bitsPerElt)
+ totalWords = bytesToWordsCeil $ bitsToBytesCeil totalBits
+ addr <- M.alloc msg totalWords
+ pure NormalList
+ { nMsg = msg
+ , nAddr = addr
+ , nLen = len
+ }
diff --git a/lib/Data/Capnp/Untyped/Pure.hs b/lib/Data/Capnp/Untyped/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/Capnp/Untyped/Pure.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-| This module provides an idiomatic Haskell interface for untyped capnp
+ data, based on algebraic datatypes. It forgoes some of the benefits of
+ the capnp wire format in favor of a more convienient API.
+
+ In addition to the algebraic data types themselves, this module also
+ provides support for converting from the lower-level types in
+ Data.Capnp.Untyped.
+-}
+module Data.Capnp.Untyped.Pure
+ ( Cap(..)
+ , Slice(..)
+ , PtrType(..)
+ , Struct(..)
+ , List(..)
+ , ListOf(..)
+ , length
+ , sliceIndex
+ )
+ where
+
+import Prelude hiding (length)
+
+import Data.Word
+
+import Control.Monad (forM_)
+import Data.Default (Default(def))
+import Data.Default.Instances.Vector ()
+import GHC.Exts (IsList(..))
+import GHC.Generics (Generic)
+
+import Data.Capnp.Classes
+ (Cerialize(..), Decerialize(..), IsPtr(..), Marshal(..))
+import Internal.Gen.Instances ()
+
+import qualified Data.Capnp.Classes as C
+import qualified Data.Capnp.Message as M
+import qualified Data.Capnp.Untyped as U
+import qualified Data.Vector as V
+
+-- | A capability in the wire format.
+type Cap = Word32
+
+-- | A one of a struct's sections (data or pointer).
+--
+-- This is just a newtype wrapper around 'ListOf' (which is itself just
+-- 'V.Vector'), but critically the notion of equality is different. Two
+-- slices are considered equal if all of their elements are equal, but
+-- If the slices are different lengths, missing elements are treated as
+-- having default values. Accordingly, equality is only defined if the
+-- element type is an instance of 'Default'.
+newtype Slice a = Slice (ListOf a)
+ deriving(Generic, Show, Read, Ord, Functor, Default)
+
+-- | A capnproto pointer type.
+data PtrType
+ = PtrStruct !Struct
+ | PtrList !List
+ | PtrCap !Cap
+ deriving(Generic, Show, Read, Eq)
+
+-- | A capnproto struct.
+data Struct = Struct
+ { structData :: Slice Word64
+ -- ^ The struct's data section
+ , structPtrs :: Slice (Maybe PtrType)
+ -- ^ The struct's pointer section
+ }
+ deriving(Generic, Show, Read, Eq)
+instance Default Struct
+
+-- | An untyped list.
+data List
+ = List0 (ListOf ())
+ | List1 (ListOf Bool)
+ | List8 (ListOf Word8)
+ | List16 (ListOf Word16)
+ | List32 (ListOf Word32)
+ | List64 (ListOf Word64)
+ | ListPtr (ListOf (Maybe PtrType))
+ | ListStruct (ListOf Struct)
+ deriving(Generic, Show, Read, Eq)
+
+-- | Alias for 'V.Vector'. Using this alias may make upgrading to future
+-- versions of the library easier, as we will likely switch to a more
+-- efficient representation at some point.
+type ListOf a = V.Vector a
+
+-- Cookie-cutter IsList instance. This is derivable with
+-- GeneralizedNewtypeDeriving as of ghc >= 8.2.1, but not on
+-- 8.0.x, due to the associated type.
+instance IsList (Slice a) where
+ type Item (Slice a) = a
+ toList (Slice list) = toList list
+ fromList = Slice . fromList
+ fromListN n = Slice . fromListN n
+
+-- | Alias for vector's 'V.length'.
+length :: ListOf a -> Int
+length = V.length
+
+-- | Index into a slice, returning a default value if the the index is past
+-- the end of the array.
+sliceIndex :: Default a => Int -> Slice a -> a
+sliceIndex i (Slice vec)
+ | i < V.length vec = vec V.! i
+ | otherwise = def
+
+instance (Default a, Eq a) => Eq (Slice a) where
+ -- We define equality specially (rather than just deriving), such that
+ -- slices are padded out with the default values of their elements.
+ l@(Slice vl) == r@(Slice vr) = go (max (length vl) (length vr) - 1)
+ where
+ go (-1) = True -- can happen if both slices are empty.
+ go 0 = True
+ go i = sliceIndex i l == sliceIndex i r && go (i-1)
+
+instance Decerialize Struct where
+ type Cerial msg Struct = U.Struct msg
+
+ decerialize struct = Struct
+ <$> (Slice <$> decerializeListOfWord (U.dataSection struct))
+ <*> (Slice <$> decerializeListOf (U.ptrSection struct))
+
+instance Marshal Struct where
+ marshalInto raw (Struct (Slice dataSec) (Slice ptrSec)) = do
+ forM_ [0..V.length dataSec - 1] $ \i ->
+ U.setData (dataSec V.! i) i raw
+ forM_ [0..V.length ptrSec - 1] $ \i -> do
+ ptr <- cerialize (U.message raw) (ptrSec V.! i)
+ U.setPtr ptr i raw
+
+instance Cerialize s Struct where
+ cerialize msg struct@(Struct (Slice dataSec) (Slice ptrSec)) = do
+ raw <- U.allocStruct
+ msg
+ (fromIntegral $ V.length dataSec)
+ (fromIntegral $ V.length ptrSec)
+ marshalInto raw struct
+ pure raw
+
+instance Decerialize (Maybe PtrType) where
+ type Cerial msg (Maybe PtrType) = Maybe (U.Ptr msg)
+
+ decerialize Nothing = pure Nothing
+ decerialize (Just ptr) = Just <$> case ptr of
+ U.PtrCap _ cap -> return (PtrCap cap)
+ U.PtrStruct struct -> PtrStruct <$> decerialize struct
+ U.PtrList list -> PtrList <$> decerialize list
+
+instance Cerialize s (Maybe PtrType) where
+ cerialize _ Nothing = pure Nothing
+ cerialize msg (Just (PtrStruct struct)) = toPtr <$> cerialize msg struct
+ cerialize msg (Just (PtrList list)) = Just . U.PtrList <$> cerialize msg list
+ -- TODO: when we actually support it, we need to insert the cap into the message:
+ cerialize msg (Just (PtrCap cap)) = pure $ Just (U.PtrCap msg cap)
+
+-- Generic decerialize instances for lists. TODO: this doesn't really belong
+-- in Untyped, since this is mostly used for typed lists. maybe Basics.
+instance
+ ( C.ListElem M.ConstMsg (Cerial M.ConstMsg a)
+ , Decerialize a
+ ) => Decerialize (ListOf a)
+ where
+ type Cerial msg (ListOf a) = C.List msg (Cerial msg a)
+ decerialize raw = V.generateM (C.length raw) (\i -> C.index i raw >>= decerialize)
+
+-- | Decerialize an untyped list, whose elements are instances of Decerialize. This isn't
+-- an instance, since it would have to be an instance of (List a), which conflicts with
+-- the above.
+decerializeListOf :: (U.ReadCtx m M.ConstMsg, Decerialize a)
+ => U.ListOf M.ConstMsg (Cerial M.ConstMsg a) -> m (ListOf a)
+decerializeListOf raw = V.generateM (U.length raw) (\i -> U.index i raw >>= decerialize)
+
+-- | Decerialize an untyped list, leaving the elements of the list as-is. The is most
+-- interesting for types that go in the data section of a struct, hence the name.
+decerializeListOfWord :: (U.ReadCtx m M.ConstMsg)
+ => U.ListOf M.ConstMsg a -> m (ListOf a)
+decerializeListOfWord raw = V.generateM (U.length raw) (`U.index` raw)
+
+instance Decerialize List where
+ type Cerial msg List = U.List msg
+
+ decerialize (U.List0 l) = List0 <$> decerializeListOfWord l
+ decerialize (U.List1 l) = List1 <$> decerializeListOfWord l
+ decerialize (U.List8 l) = List8 <$> decerializeListOfWord l
+ decerialize (U.List16 l) = List16 <$> decerializeListOfWord l
+ decerialize (U.List32 l) = List32 <$> decerializeListOfWord l
+ decerialize (U.List64 l) = List64 <$> decerializeListOfWord l
+ decerialize (U.ListPtr l) = ListPtr <$> decerializeListOf l
+ decerialize (U.ListStruct l) = ListStruct <$> decerializeListOf l
+
+instance Cerialize s List where
+ cerialize msg (List0 l) = U.List0 <$> U.allocList0 msg (length l)
+ cerialize msg (List1 l) = U.List1 <$> cerializeListOfWord (U.allocList1 msg) l
+ cerialize msg (List8 l) = U.List8 <$> cerializeListOfWord (U.allocList8 msg) l
+ cerialize msg (List16 l) = U.List16 <$> cerializeListOfWord (U.allocList16 msg) l
+ cerialize msg (List32 l) = U.List32 <$> cerializeListOfWord (U.allocList32 msg) l
+ cerialize msg (List64 l) = U.List64 <$> cerializeListOfWord (U.allocList64 msg) l
+ cerialize msg (ListPtr l) = do
+ raw <- U.allocListPtr msg (length l)
+ forM_ [0..length l - 1] $ \i -> do
+ ptr <- cerialize msg (l V.! i)
+ U.setIndex ptr i raw
+ pure $ U.ListPtr raw
+ cerialize msg (ListStruct l) = do
+ let (maxData, maxPtrs) = measureStructSizes l
+ raw <- U.allocCompositeList msg maxData maxPtrs (length l)
+ forM_ [0..length l - 1] $ \i -> do
+ elt <- U.index i raw
+ marshalInto elt (l V.! i)
+ pure $ U.ListStruct raw
+ where
+ -- Find the maximum sizes of each section of any of the structs
+ -- in the list. This is the size we need to set in the tag word.
+ measureStructSizes :: ListOf Struct -> (Word16, Word16)
+ measureStructSizes = foldl
+ (\(!dataSz, !ptrSz) (Struct (Slice dataSec) (Slice ptrSec)) ->
+ ( max dataSz (fromIntegral $ length dataSec)
+ , max ptrSz (fromIntegral $ length ptrSec)
+ )
+ )
+ (0, 0)
+
+
+cerializeListOfWord :: U.RWCtx m s => (Int -> m (U.ListOf (M.MutMsg s) a)) -> ListOf a -> m (U.ListOf (M.MutMsg s) a)
+cerializeListOfWord alloc list = do
+ ret <- alloc (length list)
+ marshalListOfWord ret list
+ pure ret
+
+marshalListOfWord :: U.RWCtx m s => U.ListOf (M.MutMsg s) a -> ListOf a -> m ()
+marshalListOfWord raw l =
+ forM_ [0..length l - 1] $ \i ->
+ U.setIndex (l V.! i) i raw
diff --git a/lib/Internal/Gen/Instances.hs b/lib/Internal/Gen/Instances.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/Gen/Instances.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Internal.Gen.Instances where
+-- This module is auto-generated by gen-builtintypes-lists.hs; DO NOT EDIT.
+
+import Data.Int
+import Data.ReinterpretCast
+import Data.Word
+
+import Data.Capnp.Classes
+ ( ListElem(..)
+ , MutListElem(..)
+ , IsPtr(..)
+ )
+
+import qualified Data.Capnp.Untyped as U
+
+instance ListElem msg Int8 where
+ newtype List msg Int8 = ListInt8 (U.ListOf msg Word8)
+ length (ListInt8 l) = U.length l
+ index i (ListInt8 l) = fromIntegral <$> U.index i l
+instance MutListElem s Int8 where
+ setIndex elt i (ListInt8 l) = U.setIndex (fromIntegral elt) i l
+ newList msg size = ListInt8 <$> U.allocList8 msg size
+instance IsPtr msg (List msg Int8) where
+ fromPtr msg ptr = ListInt8 <$> fromPtr msg ptr
+ toPtr (ListInt8 list) = Just (U.PtrList (U.List8 list))
+instance ListElem msg Int16 where
+ newtype List msg Int16 = ListInt16 (U.ListOf msg Word16)
+ length (ListInt16 l) = U.length l
+ index i (ListInt16 l) = fromIntegral <$> U.index i l
+instance MutListElem s Int16 where
+ setIndex elt i (ListInt16 l) = U.setIndex (fromIntegral elt) i l
+ newList msg size = ListInt16 <$> U.allocList16 msg size
+instance IsPtr msg (List msg Int16) where
+ fromPtr msg ptr = ListInt16 <$> fromPtr msg ptr
+ toPtr (ListInt16 list) = Just (U.PtrList (U.List16 list))
+instance ListElem msg Int32 where
+ newtype List msg Int32 = ListInt32 (U.ListOf msg Word32)
+ length (ListInt32 l) = U.length l
+ index i (ListInt32 l) = fromIntegral <$> U.index i l
+instance MutListElem s Int32 where
+ setIndex elt i (ListInt32 l) = U.setIndex (fromIntegral elt) i l
+ newList msg size = ListInt32 <$> U.allocList32 msg size
+instance IsPtr msg (List msg Int32) where
+ fromPtr msg ptr = ListInt32 <$> fromPtr msg ptr
+ toPtr (ListInt32 list) = Just (U.PtrList (U.List32 list))
+instance ListElem msg Int64 where
+ newtype List msg Int64 = ListInt64 (U.ListOf msg Word64)
+ length (ListInt64 l) = U.length l
+ index i (ListInt64 l) = fromIntegral <$> U.index i l
+instance MutListElem s Int64 where
+ setIndex elt i (ListInt64 l) = U.setIndex (fromIntegral elt) i l
+ newList msg size = ListInt64 <$> U.allocList64 msg size
+instance IsPtr msg (List msg Int64) where
+ fromPtr msg ptr = ListInt64 <$> fromPtr msg ptr
+ toPtr (ListInt64 list) = Just (U.PtrList (U.List64 list))
+instance ListElem msg Word8 where
+ newtype List msg Word8 = ListWord8 (U.ListOf msg Word8)
+ length (ListWord8 l) = U.length l
+ index i (ListWord8 l) = id <$> U.index i l
+instance MutListElem s Word8 where
+ setIndex elt i (ListWord8 l) = U.setIndex (id elt) i l
+ newList msg size = ListWord8 <$> U.allocList8 msg size
+instance IsPtr msg (List msg Word8) where
+ fromPtr msg ptr = ListWord8 <$> fromPtr msg ptr
+ toPtr (ListWord8 list) = Just (U.PtrList (U.List8 list))
+instance ListElem msg Word16 where
+ newtype List msg Word16 = ListWord16 (U.ListOf msg Word16)
+ length (ListWord16 l) = U.length l
+ index i (ListWord16 l) = id <$> U.index i l
+instance MutListElem s Word16 where
+ setIndex elt i (ListWord16 l) = U.setIndex (id elt) i l
+ newList msg size = ListWord16 <$> U.allocList16 msg size
+instance IsPtr msg (List msg Word16) where
+ fromPtr msg ptr = ListWord16 <$> fromPtr msg ptr
+ toPtr (ListWord16 list) = Just (U.PtrList (U.List16 list))
+instance ListElem msg Word32 where
+ newtype List msg Word32 = ListWord32 (U.ListOf msg Word32)
+ length (ListWord32 l) = U.length l
+ index i (ListWord32 l) = id <$> U.index i l
+instance MutListElem s Word32 where
+ setIndex elt i (ListWord32 l) = U.setIndex (id elt) i l
+ newList msg size = ListWord32 <$> U.allocList32 msg size
+instance IsPtr msg (List msg Word32) where
+ fromPtr msg ptr = ListWord32 <$> fromPtr msg ptr
+ toPtr (ListWord32 list) = Just (U.PtrList (U.List32 list))
+instance ListElem msg Word64 where
+ newtype List msg Word64 = ListWord64 (U.ListOf msg Word64)
+ length (ListWord64 l) = U.length l
+ index i (ListWord64 l) = id <$> U.index i l
+instance MutListElem s Word64 where
+ setIndex elt i (ListWord64 l) = U.setIndex (id elt) i l
+ newList msg size = ListWord64 <$> U.allocList64 msg size
+instance IsPtr msg (List msg Word64) where
+ fromPtr msg ptr = ListWord64 <$> fromPtr msg ptr
+ toPtr (ListWord64 list) = Just (U.PtrList (U.List64 list))
+instance ListElem msg Float where
+ newtype List msg Float = ListFloat (U.ListOf msg Word32)
+ length (ListFloat l) = U.length l
+ index i (ListFloat l) = wordToFloat <$> U.index i l
+instance MutListElem s Float where
+ setIndex elt i (ListFloat l) = U.setIndex (floatToWord elt) i l
+ newList msg size = ListFloat <$> U.allocList32 msg size
+instance IsPtr msg (List msg Float) where
+ fromPtr msg ptr = ListFloat <$> fromPtr msg ptr
+ toPtr (ListFloat list) = Just (U.PtrList (U.List32 list))
+instance ListElem msg Double where
+ newtype List msg Double = ListDouble (U.ListOf msg Word64)
+ length (ListDouble l) = U.length l
+ index i (ListDouble l) = wordToDouble <$> U.index i l
+instance MutListElem s Double where
+ setIndex elt i (ListDouble l) = U.setIndex (doubleToWord elt) i l
+ newList msg size = ListDouble <$> U.allocList64 msg size
+instance IsPtr msg (List msg Double) where
+ fromPtr msg ptr = ListDouble <$> fromPtr msg ptr
+ toPtr (ListDouble list) = Just (U.PtrList (U.List64 list))
+instance ListElem msg Bool where
+ newtype List msg Bool = ListBool (U.ListOf msg Bool)
+ length (ListBool l) = U.length l
+ index i (ListBool l) = id <$> U.index i l
+instance MutListElem s Bool where
+ setIndex elt i (ListBool l) = U.setIndex (id elt) i l
+ newList msg size = ListBool <$> U.allocList1 msg size
+instance IsPtr msg (List msg Bool) where
+ fromPtr msg ptr = ListBool <$> fromPtr msg ptr
+ toPtr (ListBool list) = Just (U.PtrList (U.List1 list))
diff --git a/lib/Internal/Util.hs b/lib/Internal/Util.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/Util.hs
@@ -0,0 +1,17 @@
+{-|
+Module: Internal.Util
+Description: Misc. helpers.
+
+-}
+module Internal.Util where
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadThrow(..))
+import Data.Capnp.Errors (Error(..))
+
+-- | @'checkIndex' index length@ checkes that 'index' is in the range
+-- [0, length), throwing a 'BoundsError' if not.
+checkIndex :: MonadThrow m => Int -> Int -> m ()
+checkIndex i len =
+ when (i < 0 || i >= len) $
+ throwM BoundsError { index = i, maxIndex = len }
diff --git a/scripts/README.md b/scripts/README.md
new file mode 100644
--- /dev/null
+++ b/scripts/README.md
@@ -0,0 +1,10 @@
+This directory contains a few helper scripts for development.
+
+* `regen.sh` rebuilds the schema compiler plugin, and uses it to
+ re-generate modules for the core capnproto schema.
+* `format.sh` runs `stylish-haskell` on the source tree (except for
+ generated code).
+* `hlint.sh` runs `hlint` on the source tree (except for generated
+ code).
+* `gen-builtintypes-lists.hs` generates the module
+ `Data.Capnp.BuiltinTypes.Lists`, which contains a lot of boilerplate.
diff --git a/scripts/format.sh b/scripts/format.sh
new file mode 100644
--- /dev/null
+++ b/scripts/format.sh
@@ -0,0 +1,8 @@
+#!/usr/bin/env sh
+#
+# Format the whole source tree with stylish-haskell. Skip generated output.
+set -e
+cd "$(dirname $0)/.."
+stylish-haskell -i $(find * -name '*.hs' \
+ | grep -v lib/Capnp/ \
+ | grep -v lib/Internal/Gen)
diff --git a/scripts/gen-basic-instances.hs b/scripts/gen-basic-instances.hs
new file mode 100644
--- /dev/null
+++ b/scripts/gen-basic-instances.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE RecordWildCards #-}
+-- | Script that generates 'Internal.Gen.Instances', which is mostly a
+-- bunch of tedious instances for basic types for our various type classes.
+module Main where
+
+header = unlines
+ [ "{-# LANGUAGE TypeFamilies #-}"
+ , "{-# LANGUAGE FlexibleInstances #-}"
+ , "{-# LANGUAGE MultiParamTypeClasses #-}"
+ , "module Internal.Gen.Instances where"
+ , "-- This module is auto-generated by gen-builtintypes-lists.hs; DO NOT EDIT."
+ , ""
+ , "import Data.Int"
+ , "import Data.ReinterpretCast"
+ , "import Data.Word"
+ , ""
+ , "import Data.Capnp.Classes"
+ , " ( ListElem(..)"
+ , " , MutListElem(..)"
+ , " , IsPtr(..)"
+ , " )"
+ , ""
+ , "import qualified Data.Capnp.Untyped as U"
+ , ""
+ ]
+
+data InstanceParams = P
+ { to :: String
+ , from :: String
+ , typed :: String
+ , untyped :: String
+ , listSuffix :: String
+ }
+
+
+genInstance P{..} = concat
+ [ "instance ListElem msg ", typed, " where\n"
+ , " newtype List msg ", typed, " = List", typed, " (U.ListOf msg ", untyped, ")\n"
+ , " length (List", typed, " l) = U.length l\n"
+ , " index i (List", typed, " l) = ", from, " <$> U.index i l\n"
+ , "instance MutListElem s ", typed, " where\n"
+ , " setIndex elt i (", dataCon, " l) = U.setIndex (", to, " elt) i l\n"
+ , " newList msg size = List", typed, " <$> U.allocList", listSuffix, " msg size\n"
+ , "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"
+ ]
+ where
+ dataCon = "List" ++ typed
+
+sizes = [8, 16, 32, 64]
+
+intInstance size = P
+ { to = "fromIntegral"
+ , from = "fromIntegral"
+ , typed = "Int" ++ show size
+ , untyped = "Word" ++ show size
+ , listSuffix = show size
+ }
+
+wordInstance size = P
+ { to = "id"
+ , from = "id"
+ , typed = "Word" ++ show size
+ , untyped = "Word" ++ show size
+ , listSuffix = show size
+ }
+
+instances =
+ map intInstance sizes ++
+ map wordInstance sizes ++
+ [ P { to = "floatToWord"
+ , from = "wordToFloat"
+ , typed = "Float"
+ , untyped = "Word32"
+ , listSuffix = "32"
+ }
+ , P { to = "doubleToWord"
+ , from = "wordToDouble"
+ , typed = "Double"
+ , untyped = "Word64"
+ , listSuffix = "64"
+ }
+ , P { to = "id"
+ , from = "id"
+ , typed = "Bool"
+ , untyped = "Bool"
+ , listSuffix = "1"
+ }
+ ]
+
+main = writeFile "lib/Internal/Gen/Instances.hs" $
+ header ++ concatMap genInstance instances
diff --git a/scripts/hlint.sh b/scripts/hlint.sh
new file mode 100644
--- /dev/null
+++ b/scripts/hlint.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env sh
+#
+# Run hlint on most of the codebase.
+#
+# We skip generated files, since we somtimes deliberately use conventions
+# in the output that hlint will flag, to make codegen easier.
+cd "$(dirname $0)/.."
+exec hlint $(find lib exe tests -name '*.hs' \
+ | grep -v lib/Capnp/ \
+ | grep -v lib/Internal/Gen)
diff --git a/scripts/regen.sh b/scripts/regen.sh
new file mode 100644
--- /dev/null
+++ b/scripts/regen.sh
@@ -0,0 +1,46 @@
+#!/usr/bin/env sh
+#
+# Regenerate modules for the core capnproto schema.
+set -e
+
+# Some helpers for reporting info to the caller:
+log() {
+ printf '%s\n' "$@" >&2
+}
+
+err() {
+ log $@
+ exit 1
+}
+
+# First make sure the compiler plugin is up to date.
+log "Rebuilding schema compiler plugin..."
+cd "$(dirname $0)/.."
+cabal new-build capnpc-haskell
+
+# We run the code generator from inside lib/, so that it outputs
+# modules to the right locations:
+cd lib
+
+# Find the compiler plugin executable. It would be nice to just
+# use new-run here, but doing so from a subdirectory is a bit fiddly
+# and I(zenhack) haven't found a nice way to do it.
+exe="$(find ../dist-newstyle -type f -name capnpc-haskell)"
+
+# Make sure we only found one file:
+argslen() {
+ echo $#
+}
+case $(argslen $exe) in
+ 0) err "Error: capnpc-haskell executable not found in dist-newstyle." ;;
+ 1) : ;; # Just one file; we're okay.
+ *) err "Error: more than one capnpc-haskell executable found in dist-newstyle." ;;
+esac
+
+# Ok -- do the codegen. Add the compiler plugin to our path and invoke
+# capnp compile.
+log "Generating schema modules..."
+export PATH="$(dirname $exe):$PATH"
+capnp compile -I ../core-schema --src-prefix=../core-schema/ -ohaskell ../core-schema/capnp/*.capnp
+
+# vim: set ts=2 sw=2 noet :
diff --git a/tests/simple-tests/Main.hs b/tests/simple-tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs b/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema.hs
@@ -0,0 +1,52 @@
+{-# 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 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 <- M.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
new file mode 100644
--- /dev/null
+++ b/tests/simple-tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs
@@ -0,0 +1,808 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+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 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
+ M.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.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
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/Module/Data/Capnp/Pointer.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/Module/Data/Capnp/Untyped.hs b/tests/simple-tests/Tests/Module/Data/Capnp/Untyped.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-tests/Tests/Module/Data/Capnp/Untyped.hs
@@ -0,0 +1,287 @@
+{-# 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 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 <- M.thaw =<< encodeValue schemaText testType testIn
+ evalLimitT 128 $ rootPtr msg >>= testMod
+ actualOut <- decodeValue schemaText testType =<< M.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
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/SchemaGeneration.hs b/tests/simple-tests/Tests/SchemaGeneration.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/SchemaQuickCheck.hs b/tests/simple-tests/Tests/SchemaQuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/Util.hs b/tests/simple-tests/Tests/Util.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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/simple-tests/Tests/WalkSchemaCodeGenRequest.hs b/tests/simple-tests/Tests/WalkSchemaCodeGenRequest.hs
new file mode 100644
--- /dev/null
+++ b/tests/simple-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]