diff --git a/.gitattributes b/.gitattributes
--- a/.gitattributes
+++ b/.gitattributes
@@ -1,4 +1,3 @@
# Mark generated output as such for GitHub diffs:
-/lib/Capnp/ linguist-generated=true
-/lib/Capnp/ linguist-generated=true
-/lib/Internal/Gen/ linguist-generated=true
+/gen/ linguist-generated=true
+/examples/gen/ linguist-generated=true
diff --git a/.gitignore b/.gitignore
--- a/.gitignore
+++ b/.gitignore
@@ -1,8 +1,29 @@
-/dist
-/dist-newstyle
+dist
+dist-newstyle
*.swp
-/.cabal-sandbox
-/cabal.sandbox.config
+.cabal-sandbox
+cabal.sandbox.config
cabal.project.local
+cabal.project.local~
+
+# Profiler outputs (and formatted reports):
+*.prof
+*.hp
+*.aux
+*.ps
+
.ghc.*
result*
+
+.hspec
+.hspec-failures
+
+# Code coverage:
+.hpc
+*.tix
+
+# Generated code for examples & test suite. Note that we do *not*
+# ignore generated code for the main library, as there are cyclic
+# dependencies between it and the rest of the library.
+/examples/Capnp
+/tests/Capnp
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -10,19 +10,24 @@
- cabal update
test:alltests:
image: zenhack/haskell-capnp-ci
+ variables:
+ CXX_CALCULATOR_CLIENT: /usr/local/bin/c++-calculator-client
+ CXX_CALCULATOR_SERVER: /usr/local/bin/c++-calculator-server
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:
+ # First build the code generator plugin.
+ - cabal new-build capnpc-haskell
+ # Then, regenerate the schema modules, and make sure they're in-sync
+ # with what was committed. This is also necessary to generate the
+ # Schema modules used by the test suite, which are not 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
+ # Now build everything else (incl. examples):
+ - cabal new-build all
+ # ...run the tests. We use new-run so we can pass rts options
+ # to the test binary -- these tell it to parallelize the tests.
+ - cabal new-run test:tests -- +RTS -N
+ # Linting:
+ - ./scripts/hlint.sh
+ # Run stylish-haskell, and fail if it changes anything:
+ - ./scripts/format.sh
- git diff --exit-code
diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,33 @@
+# 0.4.0.0
+
+* RPC support! This should be considered alpha quality for now. The API
+ will likely change substantially.
+* Many bug fixes; users are strongly encouraged to upgrade.
+* Reorganization of the module hierarchy:
+ * Generated code is now placed under `Capnp.Gen`, rather than `Capnp`.
+ * The `Data` prefix has been removed from the `Data.Capnp` hierarchy.
+* The included generated modules for the core schema have been updated
+ to those shipped with version 0.7 of the reference implementation.
+* Other miscellaneous API Changes:
+ * `createPure` can now be used with any instance of `MonadThrow`, not
+ just `Either SomeException`.
+ * `LimitT m` is now an instance of `MonadIO`, provided that `m` is an
+ instance.
+ * More type class instances from elsewhere in the library are
+ re-exported via the `Capnp` module.
+ * The `IsPtr` type class has been split into `FromPtr` and `ToPtr`. Most
+ user code should not care about this.
+ * Generated high-level types no longer have Read instances; interfaces
+ make this problematic.
+ * Getters for anonymous unions are now `get_Foo'` instead of
+ `get_Foo'union'`.
+ * `newMessage` now accepts an optional size hint.
+ * Instances of `Cerialize` now exist/are generated for
+ `(Vector (Vector (Vector ...)))` up to a reasonable depth.
+* Other improvements not directly reflected in the API:
+ * The allocation strategy has changed to reduce unnecessary copying.
+ * It is now possible to create messages with a size > 2GiB. Note that
+ individual segments are still limited.
# 0.3.0.0
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,7 +1,36 @@
Firstly, thanks!
-# Style
+The easiest way to contribute is just feedback: use the library, let me
+know how the experience was. Tell me how you're using the library. Open
+issues if you find them.
+If you're looking to hack on the library, great! If you don't have
+something specific in mind and you're looking for a task to get your
+feet wet, there are a number of open issues labeled
+["good first issue"](https://github.com/zenhack/haskell-capnp/issues?q=is%3Aopen+is%3Aissue+label%3A%22good+first+issue%22);
+these are self-contained, well-defined tasks that touch a relatively
+small portion of the code, and so don't require deep understanding of
+the structure of the library as a whole; as such they're great for new
+contributors. If you want to work on an existing issue, leave a comment
+on the issue saying you're planning on tacking a whack at it. I'll
+probably reply before too long. Send a pull request when you've got
+something to review.
+
+# Comments
+
+A couple guidelines re comments:
+
+* For implementation notes inside the code, we adopt GHC's [Note
+ convention][2].
+* Each thing that is exported from a module must have a haddock comment
+ briefly describing what it does and how to use it. Most non-exported
+ top level identifiers should have these as well, but this is more
+ flexible.
+* Prefer end-of-line (`--`) comments over block comments; very large
+ block comments can confuse syntax highlighting in some editors.
+
+# Style Guide
+
Generally, do what the rest of the code does. Much of this section is
bikeshed, but consistency is worth a bit of that.
@@ -11,24 +40,14 @@
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
+ `./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:
+Where stylish-haskell doesn't contradict you, use more regular
+indentation. Bad:
```haskell
data MyVariant = Apples Int
@@ -118,17 +137,18 @@
-- same structure for modules within our library:
-import Data.Capnp.Untyped hiding (length)
+import Capnp.Untyped hiding (length)
-import Data.Capnp.Bits
+import Capnp.Bits
-import Data.Capnp.TraversalLimit(defaultLimit, evalLimitT)
+import Capnp.TraversalLimit(defaultLimit, evalLimitT)
-import qualified Data.Capnp.Message as M
-import qualified Data.Capnp.Basics as B
+import qualified Capnp.Message as M
+import qualified 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
+[2]: https://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Commentsinthesourcecode
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,28 +1,44 @@
[![build status][ci-img]][ci]
[![hackage][hackage-img]][hackage]
-A Haskell library for the [Cap'N Proto][1] Cerialization protocol.
+A Haskell library for the [Cap'N Proto][1] Cerialization and RPC
+protocol.
-Serialization (read & write) support is mostly finished, and already
-usable, with some limitations:
+# Getting Started
+There is a module `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.
+
+# Status
+
+Serialization support works, 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 do not support define custom default values for fields of pointer
+ type; see ([#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.
+Level 1 RPC support is implemented and usable, though there are a couple
+gaps in the API. It should be considered alpha quality for now. Specific
+things to be aware of:
+* The implementation is *not* robust against resource exhaustion
+ attacks; for now users are strongly discouraged from using it to do
+ RPC with untrusted peers.
+* While most of the machinery for it is in place, the API does not
+ currently expose a way to do field projection on remote promises.
+ As a consequence, actually pipelining method calls is not currently
+ possible, so the library is currently best suited to environments
+ which are already low-latency.
+
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).
+accommodate more features as we add them.
[1]: https://capnproto.org/
[2]: https://capnproto.org/language.html#evolving-your-protocol
diff --git a/capnp.cabal b/capnp.cabal
--- a/capnp.cabal
+++ b/capnp.cabal
@@ -1,8 +1,7 @@
cabal-version: 2.2
name: capnp
-version: 0.3.0.0
-stability: Experimental
-category: Data, Serialization
+version: 0.4.0.0
+category: Data, Serialization, Network, Rpc
copyright: 2016-2018 haskell-capnp contributors (see CONTRIBUTORS file).
author: Ian Denhardt
maintainer: ian@zenhack.net
@@ -12,14 +11,12 @@
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.
+ A native Haskell implementation of the Cap'N Proto cerialization format and
+ RPC protocol.
.
- 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 library implements serialization and level 1 RPC.
.
- The "Data.Capnp.Tutorial" module is the best place to start reading; the
+ The "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:
@@ -44,12 +41,11 @@
, .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
+ GHC == 8.4.3
-- @zenhack currently uses this version:
- , GHC == 8.4.3
+ , GHC == 8.6.3
--------------------------------------------------------------------------------
@@ -62,149 +58,231 @@
common shared-opts
build-depends:
- base >= 4.8 && < 5.0
- , array ^>= 0.5
+ base >= 4.11 && < 4.13
, bytes ^>= 0.15.4
, bytestring ^>= 0.10
+ , containers ^>= 0.5.9
+ , data-default ^>= 0.7.1
, exceptions ^>= 0.10.0
, mtl ^>= 2.2.2
, primitive ^>= 0.6.3
, reinterpret-cast ^>= 0.1.0
+ , safe-exceptions ^>= 0.1.7
, text >= 1.2 && < 2.0
, transformers ^>= 0.5.2
, vector ^>= 0.12.0
ghc-options:
- -Wnoncanonical-monad-instances
- -Wincomplete-patterns
- -Wunused-imports
+ -Wall
+
+ -- This warning is triggered by normal use of NamedFieldPuns, so it's a no-go
+ -- for us:
+ -Wno-name-shadowing
+
+ -- I(zenhack) find it rather odd that orphan instances are flagged when the
+ -- class and the type are in different modules but, the same *package*. We do
+ -- this in a number of places in the capnp package, so we disable this
+ -- warning. It's not super easy to write a package-level orphan by accident,
+ -- so we're not losing much.
+ -Wno-orphans
default-language: Haskell2010
--------------------------------------------------------------------------------
+-- main runtime library.
library
import: shared-opts
- hs-source-dirs: lib
+ hs-source-dirs:
+ lib
+ -- generated code:
+ gen/lib
exposed-modules:
- Data.Capnp
- , Data.Capnp.Address
- , Data.Capnp.Basics
- , Data.Capnp.Basics.Pure
- , Data.Capnp.Bits
- , Data.Capnp.Classes
- , Data.Capnp.Convert
- , Data.Capnp.Errors
- , Data.Capnp.GenHelpers
- , Data.Capnp.GenHelpers.Pure
- , Data.Capnp.IO
- , Data.Capnp.Message
- , Data.Capnp.Pointer
- , Data.Capnp.Untyped
- , Data.Capnp.Untyped.Pure
- , Data.Capnp.TraversalLimit
- , Data.Capnp.Tutorial
+ Capnp
+ , Capnp.Address
+ , Capnp.Basics
+ , Capnp.Basics.Pure
+ , Capnp.Bits
+ , Capnp.Classes
+ , Capnp.Convert
+ , Capnp.Errors
+ , Capnp.GenHelpers
+ , Capnp.GenHelpers.Pure
+ , Capnp.GenHelpers.Rpc
+ , Capnp.IO
+ , Capnp.Message
+ , Capnp.Pointer
+ , Capnp.Untyped
+ , Capnp.Untyped.Pure
+ , Capnp.TraversalLimit
+ , Capnp.Rpc
+ , Capnp.Rpc.Promise
+ , Capnp.Rpc.Invoke
+ , Capnp.Rpc.Untyped
+ , Capnp.Rpc.Errors
+ , Capnp.Rpc.Transport
+ , Capnp.Rpc.Server
+ , Capnp.Tutorial
+ , Capnp.GenHelpers.ReExports
+ , Capnp.GenHelpers.ReExports.Supervisors
+ , Capnp.GenHelpers.ReExports.Data.Default
+ , Capnp.GenHelpers.ReExports.Data.Text
+ , Capnp.GenHelpers.ReExports.Data.ByteString
+ , Capnp.GenHelpers.ReExports.Data.Vector
+ , Capnp.GenHelpers.ReExports.Control.Concurrent.STM
+
, Data.Mutable
- , Capnp
- , Capnp.Capnp
+ , Capnp.Gen
+ , Capnp.Gen.Capnp
-- 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
+ , Capnp.Gen.Capnp.Cxx.Pure
+ , Capnp.Gen.Capnp.Json.Pure
+ , Capnp.Gen.Capnp.Persistent.Pure
+ , Capnp.Gen.Capnp.Rpc.Pure
+ , Capnp.Gen.Capnp.RpcTwoparty.Pure
+ , Capnp.Gen.Capnp.Schema.Pure
+ , Capnp.Gen.Capnp.Cxx
+ , Capnp.Gen.Capnp.Json
+ , Capnp.Gen.Capnp.Persistent
+ , Capnp.Gen.Capnp.Rpc
+ , Capnp.Gen.Capnp.RpcTwoparty
+ , Capnp.Gen.Capnp.Schema
+ , Capnp.Gen.ById.Xbdf87d7bb8304e81.Pure
+ , Capnp.Gen.ById.X8ef99297a43a5e34.Pure
+ , Capnp.Gen.ById.Xb8630836983feed7.Pure
+ , Capnp.Gen.ById.Xb312981b2552a250.Pure
+ , Capnp.Gen.ById.Xa184c7885cdaf2a1.Pure
+ , Capnp.Gen.ById.Xa93fc509624c72d9.Pure
+ , Capnp.Gen.ById.Xbdf87d7bb8304e81
+ , Capnp.Gen.ById.X8ef99297a43a5e34
+ , Capnp.Gen.ById.Xb8630836983feed7
+ , Capnp.Gen.ById.Xb312981b2552a250
+ , Capnp.Gen.ById.Xa184c7885cdaf2a1
+ , Capnp.Gen.ById.Xa93fc509624c72d9
-- END GENERATED SCHEMA MODULES
other-modules:
- Internal.Util
- , Internal.AppendVec
+ Internal.AppendVec
+ , Internal.Finalizer
+ , Internal.SnocList
+ , Internal.Rc
+ , Internal.TCloseQ
, Internal.Gen.Instances
, Internal.BuildPure
, Codec.Capnp
-- other-extensions:
build-depends:
cpu ^>= 0.1.2
- , data-default ^>= 0.7.1
+ , hashable ^>= 1.2.7
, data-default-instances-vector ^>= 0.0.1
+ , stm ^>= 2.5.0
+ , stm-containers ^>= 1.1.0
+ , list-t ^>= 1.0.2
+ , focus ^>= 1.0.1
+ , async ^>= 2.2.1
+ , network-simple ^>= 0.4
+ , network ^>= 2.8.0
+ , supervisors ^>= 0.2.0
+ , pretty-show ^>= 1.9.5
--------------------------------------------------------------------------------
+-- code generator plugin
executable capnpc-haskell
- import: shared-opts
- main-is: Main.hs
- other-modules:
- FrontEnd
- , Fmt
- , IR
- , Backends.Common
- , Backends.Pure
- , Backends.Raw
- , Util
- hs-source-dirs: exe/capnpc-haskell
- build-depends:
- capnp
- , binary ^>= 0.8.5
- , cereal ^>= 0.5.5
- , containers ^>= 0.5.10
- , directory ^>= 1.3.0
- , dlist ^>= 0.8.0
- , filepath ^>= 1.4.1
- , utf8-string ^>= 1.0.1
- , wl-pprint-text ^>= 1.2
+ import: shared-opts
+ hs-source-dirs: cmd/capnpc-haskell
+ main-is: Main.hs
+ other-modules:
+ IR.Name
+ , IR.Common
+ , IR.Stage1
+ , IR.Flat
+ , IR.Pure
+ , IR.Raw
+ , IR.Haskell
+ , Trans.CgrToStage1
+ , Trans.Stage1ToFlat
+ , Trans.FlatToRaw
+ , Trans.FlatToPure
+ , Trans.ToHaskellCommon
+ , Trans.PureToHaskell
+ , Trans.RawToHaskell
+ , Trans.HaskellToText
+ , Check
+ build-depends:
+ capnp
+ , wl-pprint-text ^>= 1.2
+ , filepath ^>= 1.4.2
+ , directory ^>= 1.3.0
--------------------------------------------------------------------------------
-test-suite simple-tests
+test-suite tests
import: shared-opts
type: exitcode-stdio-1.0
main-is: Main.hs
- hs-source-dirs: tests
+ hs-source-dirs:
+ tests
+ gen/tests
+ examples/lib
+ examples/gen/lib
+ ghc-options:
+ -threaded
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
+ -- Utilities
+ Util
, Instances
+ , SchemaGeneration
+
+ , Examples.Rpc.CalculatorClient
+ , Examples.Rpc.CalculatorServer
+
+ -- Generated code for examples/calculator.capnp
+ , Capnp.Gen.ById.X85150b117366d14b
+ , Capnp.Gen.ById.X85150b117366d14b.Pure
+ , Capnp.Gen.Calculator
+ , Capnp.Gen.Calculator.Pure
+
+ -- Generated code for examples/echo.capnp
+ , Capnp.Gen.Echo
+ , Capnp.Gen.Echo.Pure
+ , Capnp.Gen.ById.Xd0a87f36fa0182f5
+ , Capnp.Gen.ById.Xd0a87f36fa0182f5.Pure
+
+ -- generated from tests/data/aircraft.capnp
+ , Capnp.Gen.Aircraft
+ , Capnp.Gen.Aircraft.Pure
+ , Capnp.Gen.ById.X832bcc6686a26d56
+ , Capnp.Gen.ById.X832bcc6686a26d56.Pure
+
+ -- Actual tests:
+ , Module.Capnp.Gen.Capnp.Schema
+ , Module.Capnp.Gen.Capnp.Schema.Pure
+ , Module.Capnp.Rpc
+ , Module.Capnp.Untyped
+ , Module.Capnp.Untyped.Pure
+ , Module.Capnp.Pointer
+ , Module.Capnp.Bits
+ , Module.Capnp.Basics
+ , Regression
+ , WalkSchemaCodeGenRequest
+ , SchemaQuickCheck
+ , CalculatorExample
build-depends:
capnp
- , data-default
+ , network
+ , network-simple
+ , stm
+ , async
, process
, process-extras
, QuickCheck
, quickcheck-io
, quickcheck-instances
- , HUnit
- , test-framework
- , test-framework-hunit
- , test-framework-quickcheck2
- , binary
+ , hspec
, directory
, resourcet
, heredoc
, deepseq
, pretty-show
+ , supervisors
diff --git a/ci/Dockerfile b/ci/Dockerfile
--- a/ci/Dockerfile
+++ b/ci/Dockerfile
@@ -1,18 +1,65 @@
-FROM haskell
+FROM alpine:3.8
WORKDIR /usr/src/
-# Install various system packages needed for building capnproto.
-RUN apt-get update
-RUN apt-get install -y wget file make
+# Cabal does not like busybox's wget:
+RUN apk add \
+ wget
-# 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 Haskell tooling.
+RUN apk add \
+ build-base \
+ ghc \
+ cabal
# 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
+
+# We're getting an error from cabal re: creating these symlinks automatically,
+# so we just do it ourselves. TODO: figure out why this is happening
+
+RUN ln -s /root/.cabal/bin/hlint /usr/local/bin/hlint
+RUN ln -s /root/.cabal/bin/stylish-haskell /usr/local/bin/stylish-haskell
+
+# Install stuff needed to build capnproto:
+RUN apk add \
+ autoconf \
+ automake \
+ libtool \
+ linux-headers
+
+# Build and install a recent version of capnproto; it isn't in the alpine
+# repos. Furthermore, we use the calculator-client & server examples as
+# part of our test suite, so we need to build that anyway:
+RUN wget "https://github.com/capnproto/capnproto/archive/v0.6.1.tar.gz"
+RUN tar -xvf *.tar.gz
+RUN cd capnproto-*/c++ && \
+ autoreconf -i && \
+ ./configure --prefix=/usr/local && \
+ make -j && \
+ make install
+
+# Build and install the C++ calculator example client & server, which
+# we'll use to validate our own implementations:
+RUN cd capnproto-*/c++/samples && \
+ capnpc -oc++ calculator.capnp && \
+ c++ \
+ calculator-client.c++ \
+ -std=c++14 \
+ calculator.capnp.c++ \
+ $(pkg-config --cflags --libs capnp-rpc) \
+ -o calculator-client && \
+ c++ \
+ calculator-server.c++ \
+ -std=c++14 \
+ calculator.capnp.c++ \
+ $(pkg-config --cflags --libs capnp-rpc) \
+ -o calculator-server && \
+ install -Dm755 calculator-client /usr/local/bin/c++-calculator-client && \
+ install -Dm755 calculator-server /usr/local/bin/c++-calculator-server
+
+# Add other tools we use during the run:
+RUN apk add \
+ git
diff --git a/ci/README.md b/ci/README.md
--- a/ci/README.md
+++ b/ci/README.md
@@ -3,6 +3,3 @@
...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/cmd/capnpc-haskell/Check.hs b/cmd/capnpc-haskell/Check.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Check.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Check (reportIssues) where
+
+import Data.Foldable (for_)
+import System.IO (hPutStrLn, stderr)
+
+import qualified Data.Vector as V
+
+import Capnp.Gen.Capnp.Schema.Pure
+
+-- | Scan the code generator request for certain issues, and warn the user
+-- if found.
+--
+-- We still assume the input is *valid*, so these are issues regarding things
+-- that our implementation can't handle.
+reportIssues :: CodeGeneratorRequest -> IO ()
+reportIssues CodeGeneratorRequest{nodes} =
+ let problemFields =
+ [ (displayName, name)
+ | Node{displayName, union'=Node'struct Node'struct'{fields}} <- V.toList nodes
+ , Field
+ { name
+ , union'=Field'slot Field'slot'{hadExplicitDefault, defaultValue}
+ } <- V.toList fields
+ , hadExplicitDefault && isPtrValue defaultValue
+ ]
+ in
+ for_ problemFields $ \(displayName, name) ->
+ hPutStrLn stderr $ concat
+ [ "WARNING: the field ", show name, " in ", show displayName, "\n"
+ , " has a custom default value, but haskell-capnp does not\n"
+ , " support this for pointer-valued fields. The custom\n"
+ , " default will be ignored; please be careful. See:\n"
+ , "\n"
+ , "https://github.com/zenhack/haskell-capnp/issues/28\n"
+ , "\n"
+ , "for more information.\n"
+ ]
+
+isPtrValue :: Value -> Bool
+isPtrValue = \case
+ Value'void -> False
+ Value'bool _ -> False
+ Value'int8 _ -> False
+ Value'int16 _ -> False
+ Value'int32 _ -> False
+ Value'int64 _ -> False
+ Value'uint8 _ -> False
+ Value'uint16 _ -> False
+ Value'uint32 _ -> False
+ Value'uint64 _ -> False
+ Value'float32 _ -> False
+ Value'float64 _ -> False
+ Value'enum _ -> False
+ _ -> True
diff --git a/cmd/capnpc-haskell/IR/Common.hs b/cmd/capnpc-haskell/IR/Common.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Common.hs
@@ -0,0 +1,128 @@
+-- Data types that are used by more than one intermediate form.
+-- See also IR.Name, which defines identifiers, which are also
+-- used in more than one IR.
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE LambdaCase #-}
+module IR.Common where
+
+import Data.Word
+
+import qualified Capnp.Untyped.Pure as U
+
+newtype TypeId = TypeId Word64
+ deriving(Show, Read, Eq, Ord)
+
+data IntType = IntType !Sign !IntSize
+ deriving(Show, Read, Eq)
+
+data Sign
+ = Signed
+ | Unsigned
+ deriving(Show, Read, Eq)
+
+data IntSize
+ = Sz8
+ | Sz16
+ | Sz32
+ | Sz64
+ deriving(Show, Read, Eq)
+
+sizeBits :: IntSize -> Int
+sizeBits Sz8 = 8
+sizeBits Sz16 = 16
+sizeBits Sz32 = 32
+sizeBits Sz64 = 64
+
+-- | Return the size in bits of a type that belongs in the data section of a struct.
+dataFieldSize :: WordType r -> Int
+dataFieldSize = \case
+ EnumType _ -> 16
+ PrimWord (PrimInt (IntType _ size)) -> sizeBits size
+ PrimWord PrimFloat32 -> 32
+ PrimWord PrimFloat64 -> 64
+ PrimWord PrimBool -> 1
+
+-- Capnproto types. The 'r' type parameter is the type of references to other nodes,
+-- which may be different in different stages of the pipeline.
+
+data Type r
+ = CompositeType (CompositeType r)
+ | VoidType
+ | WordType (WordType r)
+ | PtrType (PtrType r)
+ deriving(Show, Read, Eq, Functor)
+
+newtype CompositeType r
+ = StructType r
+ deriving(Show, Read, Eq, Functor)
+
+data WordType r
+ = EnumType r
+ | PrimWord PrimWord
+ deriving(Show, Read, Eq, Functor)
+
+data PtrType r
+ = ListOf (Type r)
+ | PrimPtr PrimPtr
+ | PtrComposite (CompositeType r)
+ | PtrInterface r
+ deriving(Show, Read, Eq, Functor)
+
+data PrimWord
+ = PrimInt IntType
+ | 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)
+
+-- | The type and location of a field.
+data FieldLocType r
+ -- | The field is in the struct's data section.
+ = DataField DataLoc (WordType r)
+ -- | The field is in the struct's pointer section (the argument is the
+ -- index).
+ | PtrField !Word16 (PtrType r)
+ -- | The field is a group or union; it's "location" is the whole struct.
+ | HereField (CompositeType r)
+ -- | The field is of type void (and thus is zero-size).
+ | VoidField
+ deriving(Show, Read, Eq, Functor)
+
+-- | 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
+ -- ^ The bit offset inside the 64-bit word.
+ , 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)
+
+data Value r
+ = VoidValue
+ | WordValue (WordType r) !Word64
+ | PtrValue (PtrType r) (Maybe U.Ptr)
+ deriving(Show, Eq, Functor)
+
+-- | Extract the type from a 'FildLocType'.
+fieldType :: FieldLocType r -> Type r
+fieldType (DataField _ ty) = WordType ty
+fieldType (PtrField _ ty) = PtrType ty
+fieldType (HereField ty) = CompositeType ty
+fieldType VoidField = VoidType
diff --git a/cmd/capnpc-haskell/IR/Flat.hs b/cmd/capnpc-haskell/IR/Flat.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Flat.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module IR.Flat
+ ( File(..)
+ , CodeGenReq(..)
+ , Node(..)
+ , Node'(..)
+ , Field(..)
+ , Method(..)
+ , Variant(..)
+ , Union(..)
+ ) where
+
+import Data.Word
+
+import qualified IR.Common as Common
+import qualified IR.Name as Name
+
+data CodeGenReq = CodeGenReq
+ { allNodes :: [Node]
+ , reqFiles :: [File]
+ }
+ deriving(Show, Eq)
+
+data File = File
+ { nodes :: [Node]
+ , fileId :: !Word64
+ , fileName :: FilePath
+ }
+ deriving(Show, Eq)
+
+data Node = Node
+ { name :: Name.CapnpQ
+ , nodeId :: !Word64
+ , union_ :: Node'
+ }
+ deriving(Show, Eq)
+
+data Node'
+ = Enum [Name.UnQ]
+ | Struct
+ { fields :: [Field]
+ -- ^ The struct's fields, excluding an anonymous union, if any.
+ , isGroup :: !Bool
+ , dataWordCount :: !Word16
+ , pointerCount :: !Word16
+ , union :: Maybe Union
+ -- ^ The struct's anonymous union, if any.
+ }
+ | Interface
+ { methods :: [Method]
+ , supers :: [Node]
+ -- ^ Immediate superclasses
+ , ancestors :: [Node]
+ -- ^ All ancestors, including 'supers'.
+ }
+ | Constant
+ { value :: Common.Value Node
+ }
+ | Other
+ deriving(Show, Eq)
+
+
+data Method = Method
+ { name :: Name.UnQ
+ , paramType :: Name.CapnpQ
+ , resultType :: Name.CapnpQ
+ }
+ deriving(Show, Eq)
+
+
+data Union = Union
+ { tagOffset :: !Word32
+ , variants :: [Variant]
+ }
+ deriving(Show, Eq)
+
+data Field = Field
+ { fieldName :: Name.CapnpQ
+ , fieldLocType :: Common.FieldLocType Node
+ }
+ deriving(Show, Eq)
+
+data Variant = Variant
+ { tagValue :: !Word16
+ , field :: Field
+ -- ^ The field's name is really the name of the variant.
+ }
+ deriving(Show, Eq)
diff --git a/cmd/capnpc-haskell/IR/Haskell.hs b/cmd/capnpc-haskell/IR/Haskell.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Haskell.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- A last-leg intermediate form, before emitting actually Haskell source code.
+--
+-- This module contains a *simplified* Haskell AST; it only includes the
+-- features we actually need. We roll our own for two reasons:
+--
+-- 1. Full Haskell ASTs are actually quite complex, and the data types exposed
+-- by libraries for working with Haskell source reflect this. What we need
+-- is much simpler.
+-- 2. At some point we'll want to inject Haddock comments into the source (see
+-- #32), and I(zenhack) don't see a good way to do that with the libraries
+-- I looked at.
+module IR.Haskell
+ ( modFilePath
+
+ , DataArgs(..)
+ , DataDecl(..)
+ , DataVariant(..)
+ , ClassDecl(..)
+ , Decl(..)
+ , Do(..)
+ , Exp(..)
+ , Export(..)
+ , Import(..)
+ , InstanceDef(..)
+ , Module(..)
+ , Pattern(..)
+ , Type(..)
+ , TypeAlias(..)
+ , ValueDef(..)
+ ) where
+
+import Data.List (intercalate)
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as T
+
+import qualified IR.Common as Common
+import qualified IR.Name as Name
+
+-- | A Haskell module
+data Module = Module
+ { modName :: [Name.UnQ]
+ -- ^ The parts of the module path
+ , modLangPragmas :: [T.Text]
+ -- ^ The language extensions enabled in this module.
+ , modExports :: Maybe [Export]
+ -- ^ The export list. If it is 'Nothing' that means there is no export
+ -- list (and therefore everything is exported).
+ , modDecls :: [Decl]
+ -- ^ The declarations in the module.
+ , modImports :: [Import]
+ -- ^ Modules to import.
+ }
+ deriving(Show, Read, Eq)
+
+data Export
+ = ExportMod [Name.UnQ] -- module Foo.Bar
+ | ExportGCtors Name.GlobalQ -- Foo.Bar.Baz(..)
+ | ExportLCtors Name.LocalQ -- Baz(..)
+ | ExportGName Name.GlobalQ -- Foo.Bar.Baz
+ | ExportLName Name.LocalQ -- Baz
+ deriving(Show, Read, Eq)
+
+data Import
+ = ImportAs -- import qualified Foo.Bar as Bar
+ { importAs :: Name.UnQ
+ , parts :: [Name.UnQ]
+ }
+ | ImportQual -- import qualified Foo.Bar
+ { parts :: [Name.UnQ]
+ }
+ | ImportAll -- import Foo.Bar
+ { parts :: [Name.UnQ]
+ }
+ deriving(Show, Read, Eq)
+
+-- | A declaration.
+data Decl
+ = DcData DataDecl
+ | DcValue
+ { typ :: Type
+ , def :: ValueDef
+ }
+ | DcInstance
+ { ctx :: [Type]
+ , typ :: Type
+ , defs :: [InstanceDef]
+ }
+ | DcClass
+ { ctx :: [Type]
+ , name :: Name.LocalQ
+ , params :: [Name.UnQ]
+ , decls :: [ClassDecl]
+ }
+ deriving(Show, Read, Eq)
+
+data DataDecl = Data
+ { dataName :: Name.UnQ
+ -- ^ The name of the declared type.
+ , typeArgs :: [Type]
+ , dataVariants :: [DataVariant]
+ -- ^ The variants/data constructors for the type.
+ , derives :: [Name.UnQ]
+ -- ^ A list of type classes to include in the deriving clause.
+ , dataNewtype :: !Bool
+ -- ^ Whether the declarationis a "newtype" or "data" declaration.
+ }
+ deriving(Show, Read, Eq)
+
+data ClassDecl
+ = CdValueDecl Name.UnQ Type
+ | CdValueDef ValueDef
+ | CdMinimal [Name.UnQ]
+ -- ^ A MINIMAL pragma.
+ deriving(Show, Read, Eq)
+
+data InstanceDef
+ = IdValue ValueDef
+ | IdData DataDecl
+ | IdType TypeAlias
+ deriving(Show, Read, Eq)
+
+data TypeAlias = TypeAlias Name.UnQ [Type] Type
+ deriving(Show, Read, Eq)
+
+data ValueDef = DfValue
+ { name :: Name.UnQ
+ , value :: Exp
+ , params :: [Pattern]
+ }
+ deriving(Show, Read, Eq)
+
+-- | A data constructor
+data DataVariant = DataVariant
+ { dvCtorName :: Name.UnQ
+ -- ^ The name of the constructor.
+ , dvArgs :: DataArgs
+ }
+ deriving(Show, Read, Eq)
+
+-- | Arguments to a data constructor
+data DataArgs
+ = APos [Type]
+ | ARec [(Name.UnQ, Type)]
+ deriving(Show, Read, Eq)
+
+data Type
+ = TGName Name.GlobalQ
+ | TLName Name.LocalQ
+ | TVar T.Text
+ | TApp Type [Type]
+ | TFn [Type]
+ | TCtx [Type] Type
+ | TPrim Common.PrimWord
+ | TUnit
+ deriving(Show, Read, Eq)
+
+data Exp
+ = EApp Exp [Exp]
+ | EFApp Exp [Exp]
+ -- ^ "Functorial" application, i.e. f <$> x <*> y <*> z.
+ | EGName Name.GlobalQ
+ | ELName Name.LocalQ
+ | EInt Integer
+ | EDo [Do] Exp
+ | EBind Exp Exp
+ -- ^ A call to (>>=)
+ | ETup [Exp]
+ | EBytes LBS.ByteString
+ | ECase Exp [(Pattern, Exp)]
+ | ETypeAnno Exp Type
+ | ELambda [Pattern] Exp
+ | ERecord Exp [(Name.UnQ, Exp)]
+ deriving(Show, Read, Eq)
+
+data Do
+ = DoBind Name.UnQ Exp
+ | DoE Exp
+ deriving(Show, Read, Eq)
+
+data Pattern
+ = PVar T.Text
+ | PLCtor Name.LocalQ [Pattern]
+ | PGCtor Name.GlobalQ [Pattern]
+ | PInt Integer
+ -- | Name{..}
+ | PLRecordWildCard Name.LocalQ
+ deriving(Show, Read, Eq)
+
+-- | Get the file path for a module. For example, the module @Foo.Bar.Baz@ will
+-- have a file path of @Foo/Bar/Baz.hs@.
+modFilePath :: Module -> FilePath
+modFilePath Module{modName} =
+ intercalate "/" (map (T.unpack . Name.renderUnQ) modName) ++ ".hs"
diff --git a/cmd/capnpc-haskell/IR/Name.hs b/cmd/capnpc-haskell/IR/Name.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Name.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module IR.Name where
+
+import Data.Word
+
+import Data.Char (toLower)
+import Data.List (intersperse)
+import Data.String (IsString(fromString))
+
+import qualified Data.Set as S
+import qualified Data.Text as T
+
+class HasUnQ a where
+ getUnQ :: a -> UnQ
+class MkSub a where
+ mkSub :: a -> UnQ -> a
+
+instance HasUnQ UnQ where
+ getUnQ = id
+instance HasUnQ LocalQ where
+ getUnQ = localUnQ
+instance HasUnQ CapnpQ where
+ getUnQ CapnpQ{local} = getUnQ local
+instance HasUnQ GlobalQ where
+ getUnQ GlobalQ{local} = getUnQ local
+
+newtype UnQ = UnQ T.Text
+ deriving(Show, Read, Eq, Ord, IsString)
+
+newtype NS = NS [T.Text]
+ deriving(Show, Read, Eq, Ord)
+
+data LocalQ = LocalQ
+ { localUnQ :: UnQ
+ , localNS :: NS
+ }
+ deriving(Show, Read, Eq, Ord)
+
+instance IsString LocalQ where
+ fromString s = LocalQ
+ { localUnQ = fromString s
+ , localNS = emptyNS
+ }
+
+-- | A fully qualified name for something defined in a capnproto schema.
+-- this includes a local name within a file, and the file's capnp id.
+data CapnpQ = CapnpQ
+ { local :: LocalQ
+ , fileId :: !Word64
+ }
+ deriving(Show, Read, Eq, Ord)
+
+data GlobalQ = GlobalQ
+ { local :: LocalQ
+ , globalNS :: NS
+ }
+ deriving(Show, Read, Eq, Ord)
+
+emptyNS :: NS
+emptyNS = NS []
+
+mkLocal :: NS -> UnQ -> LocalQ
+mkLocal localNS localUnQ = LocalQ{localNS, localUnQ}
+
+unQToLocal :: UnQ -> LocalQ
+unQToLocal = mkLocal emptyNS
+
+instance MkSub LocalQ where
+ mkSub q = mkLocal (localQToNS q)
+
+instance MkSub GlobalQ where
+ mkSub q@GlobalQ{local} unQ = q { local = mkSub local unQ }
+
+instance MkSub CapnpQ where
+ mkSub q@CapnpQ{local} unQ = q { local = mkSub local unQ }
+
+localQToNS :: LocalQ -> NS
+localQToNS LocalQ{localUnQ=UnQ part, localNS=NS parts} = NS (part:parts)
+
+localToUnQ :: LocalQ -> UnQ
+localToUnQ LocalQ{localUnQ, localNS}
+ | localNS == emptyNS = localUnQ
+ | otherwise = UnQ (renderLocalNS localNS <> "'" <> renderUnQ localUnQ)
+
+renderUnQ :: UnQ -> T.Text
+renderUnQ (UnQ name)
+ | name `S.member` keywords = name <> "_"
+ | otherwise = name
+ where
+ keywords = S.fromList
+ [ "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"
+ ]
+
+renderLocalQ :: LocalQ -> T.Text
+renderLocalQ = renderUnQ . localToUnQ
+
+renderLocalNS :: NS -> T.Text
+renderLocalNS (NS parts) = mconcat $ intersperse "'" $ reverse parts
+
+getterName, setterName, hasFnName, newFnName :: LocalQ -> UnQ
+getterName = accessorName "get_"
+setterName = accessorName "set_"
+hasFnName = accessorName "has_"
+newFnName = accessorName "new_"
+
+accessorName :: T.Text -> LocalQ -> UnQ
+accessorName prefix = UnQ . (prefix <>) . renderLocalQ
+
+-- | Lower-case the first letter of a name, making it legal as the name of a
+-- variable (as opposed to a type or data constructor).
+valueName :: LocalQ -> UnQ
+valueName name =
+ case T.unpack (renderLocalQ name) of
+ [] -> ""
+ (c:cs) -> UnQ $ T.pack $ toLower c : cs
diff --git a/cmd/capnpc-haskell/IR/Pure.hs b/cmd/capnpc-haskell/IR/Pure.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Pure.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+module IR.Pure where
+
+import Data.Word
+
+import qualified IR.Common as C
+import qualified IR.Name as Name
+
+data File = File
+ { fileId :: !Word64
+ , fileName :: FilePath
+ , decls :: [Decl]
+ , reExportEnums :: [Name.LocalQ]
+ -- ^ A list of enums that we should re-export from this module.
+ , usesRpc :: !Bool
+ -- ^ Whether or not the module uses rpc features. If not, we skip
+ -- the rpc related imports. This is mainly important to avoid a
+ -- cyclic dependency with rpc.capnp.
+ }
+
+data Decl
+ = DataDecl Data
+ | ConstDecl Constant
+ | IFaceDecl Interface
+
+data Data = Data
+ { typeName :: Name.LocalQ
+ , firstClass :: !Bool
+ -- ^ Whether this is a "first class" type, i.e. it is a type in the
+ -- capnproto sense, rather than an auxiliary type defined for a group
+ -- or an anonymous union.
+ --
+ -- Note that this *can* be set for unions, if they subsume the whole
+ -- struct, since in that case we collapse the two types in the
+ -- high-level API.
+ , cerialName :: Name.LocalQ
+ -- ^ The name of the type our 'Cerial' should be. This will only be
+ -- different from typeName if we're an anonymous union in a struct
+ -- that also has other fields; in this case our Cerial should be
+ -- the same as our parent struct.
+ , def :: DataDef
+ }
+
+data DataDef
+ = Sum [Variant]
+ | Product [Field]
+
+data Constant = Constant
+ { name :: Name.LocalQ
+ , value :: C.Value Name.CapnpQ
+ }
+
+data Interface = IFace
+ { name :: Name.CapnpQ
+ , interfaceId :: !Word64
+ , methods :: [Method]
+ , supers :: [Interface]
+ , ancestors :: [Interface]
+ }
+
+-- TODO(cleanup): this same type exists in IR.Flat; it doesn't make sense for
+-- IR.Common, but we should factor this out.
+data Method = Method
+ { name :: Name.UnQ
+ , paramType :: Name.CapnpQ
+ , resultType :: Name.CapnpQ
+ }
+
+data Field = Field
+ { name :: Name.UnQ
+ -- ^ The name of the field.
+
+ , type_ :: C.Type Name.CapnpQ
+ -- ^ The type of the field.
+ }
+
+data Variant = Variant
+ { name :: Name.LocalQ
+ , arg :: Maybe (C.Type Name.CapnpQ)
+ }
diff --git a/cmd/capnpc-haskell/IR/Raw.hs b/cmd/capnpc-haskell/IR/Raw.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Raw.hs
@@ -0,0 +1,112 @@
+-- IR for a high-level representation of the low-level API modules.
+--
+-- This talks about things like getters, setters, wrapper types for structs,
+-- etc. It's still not at the level of detail of actual Haskell, but encodes
+-- the constructs to be generated, as opposed to the declarative description
+-- of the schema.
+{-# LANGUAGE DuplicateRecordFields #-}
+module IR.Raw (File(..), Decl(..), Variant(..), TagSetter(..), NewFnType(..), tagOffsetToDataLoc) where
+
+import Data.Word
+
+import qualified IR.Common as Common
+import qualified IR.Name as Name
+
+data File = File
+ { fileId :: !Word64
+ , fileName :: FilePath
+ , decls :: [Decl]
+ }
+ deriving(Show, Eq)
+
+data Decl
+ -- | Define a newtype wrapper around a struct. This also defines
+ -- some instances of type classes that exist for all such wrappers.
+ = StructWrapper
+ { typeCtor :: Name.LocalQ
+ }
+ -- | Define instances of several type classes which should only
+ -- exist for "real" structs, i.e. not groups.
+ | StructInstances
+ { typeCtor :: Name.LocalQ
+ -- ^ The type constructor for the type to generate instances for.
+
+ -- Needed for some instances:
+ , dataWordCount :: !Word16
+ , pointerCount :: !Word16
+ }
+ | InterfaceWrapper
+ { typeCtor :: Name.LocalQ
+ }
+ | UnionVariant
+ { parentTypeCtor :: Name.LocalQ
+ -- ^ The type constructor of the parent, i.e. the enclosing struct.
+ -- we can derive the type constructor for the union proper from this,
+ -- and it is useful to have for other things (like unknown' variants).
+ , tagOffset :: !Word32
+ , unionDataCtors :: [Variant]
+ }
+ | Enum
+ { typeCtor :: Name.LocalQ
+ , dataCtors :: [Name.LocalQ]
+ }
+ | Getter -- get_* function
+ { fieldName :: Name.LocalQ
+ , containerType :: Name.LocalQ
+ , fieldLocType :: Common.FieldLocType Name.CapnpQ
+ }
+ | Setter -- set_* function
+ { fieldName :: Name.LocalQ
+ , containerType :: Name.LocalQ
+ , fieldLocType :: Common.FieldLocType Name.CapnpQ
+
+ , tag :: Maybe TagSetter
+ -- ^ Info for setting the tag, if this is a union.
+ }
+ | HasFn -- has_* function
+ { fieldName :: Name.LocalQ
+ , containerType :: Name.LocalQ
+ , ptrIndex :: !Word16
+ }
+ | NewFn -- new_* function
+ { fieldName :: Name.LocalQ
+ , containerType :: Name.LocalQ
+ , fieldLocType :: Common.FieldLocType Name.CapnpQ
+
+ , newFnType :: NewFnType
+ }
+ | Constant
+ { name :: Name.LocalQ
+ , value :: Common.Value Name.CapnpQ
+ }
+ deriving(Show, Eq)
+
+data NewFnType
+ = NewList
+ | NewText
+ | NewData
+ | NewStruct
+ deriving(Show, Eq)
+
+data TagSetter = TagSetter
+ { tagOffset :: !Word32
+ , tagValue :: !Word16
+ }
+ deriving(Show, Eq)
+
+-- | Convert a tag offset (as in the 'tagOffset' field of 'TagSetter') to a
+-- corresponding 'Common.DataLoc', with the default value set to zero.
+tagOffsetToDataLoc :: Word32 -> Common.DataLoc
+tagOffsetToDataLoc tagOffset =
+ Common.DataLoc
+ { dataIdx = fromIntegral tagOffset `div` 4
+ , dataOff = (fromIntegral tagOffset `mod` 4) * 16
+ , dataDef = 0
+ }
+
+data Variant = Variant
+ { name :: Name.LocalQ
+ , tagValue :: !Word16
+ , locType :: Common.FieldLocType Name.CapnpQ
+ }
+ deriving(Show, Eq)
diff --git a/cmd/capnpc-haskell/IR/Stage1.hs b/cmd/capnpc-haskell/IR/Stage1.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/IR/Stage1.hs
@@ -0,0 +1,92 @@
+-- First stage IR. This models the data structures in schema.capnp more closely
+-- than the other intermediate forms. Differences:
+--
+-- * Lots of information which we won't use is discarded.
+-- * Nodes no longer reference eachother by ID; instead we include direct
+-- references to the objects.
+-- * The details of some structures are tweaked to make them more ergonomic
+-- to use and/or more idiomatic Haskell.
+{-# LANGUAGE DuplicateRecordFields #-}
+module IR.Stage1
+ ( File(..)
+ , ReqFile(..)
+ , Interface(..)
+ , Method(..)
+ , Node(..)
+ , NodeCommon(..)
+ , NodeUnion(..)
+ , Struct(..)
+ , Field(..)
+ , CodeGenReq(..)
+ ) where
+
+import Data.Word
+
+import qualified IR.Common as Common
+import qualified IR.Name as Name
+
+data CodeGenReq = CodeGenReq
+ { reqFiles :: [ReqFile]
+ , allFiles :: [File]
+ }
+
+data ReqFile = ReqFile
+ { file :: File
+ , fileName :: FilePath
+ }
+
+data File = File
+ { fileNodes :: [(Name.UnQ, Node)]
+ , fileId :: !Word64
+ }
+ deriving(Show, Eq)
+
+data Node = Node
+ { nodeCommon :: NodeCommon
+ , nodeUnion :: NodeUnion
+ }
+ deriving(Show, Eq)
+
+data NodeCommon = NodeCommon
+ { nodeNested :: [(Name.UnQ, Node)]
+ , nodeParent :: Maybe Node
+ , nodeId :: !Word64
+ }
+ deriving(Show, Eq)
+
+data NodeUnion
+ = NodeEnum [Name.UnQ]
+ | NodeStruct Struct
+ | NodeInterface Interface
+ | NodeConstant (Common.Value Node)
+ | NodeOther
+ deriving(Show, Eq)
+
+data Interface = Interface
+ { methods :: [Method]
+ , supers :: [Node]
+ }
+ deriving(Show, Eq)
+
+data Method = Method
+ { name :: Name.UnQ
+ , paramType :: Node
+ , resultType :: Node
+ }
+ deriving(Show, Eq)
+
+data Struct = Struct
+ { dataWordCount :: !Word16
+ , pointerCount :: !Word16
+ , isGroup :: !Bool
+ , tagOffset :: !Word32
+ , fields :: [Field]
+ }
+ deriving(Show, Eq)
+
+data Field = Field
+ { name :: Name.UnQ
+ , tag :: Maybe Word16
+ , locType :: Common.FieldLocType Node
+ }
+ deriving(Show, Eq)
diff --git a/cmd/capnpc-haskell/Main.hs b/cmd/capnpc-haskell/Main.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Main.hs
@@ -0,0 +1,61 @@
+-- This module is the main entry point for the capnpc-haskell code
+-- generator plugin.
+module Main (main) where
+
+import Data.Foldable (for_)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
+import System.IO (IOMode(WriteMode), withFile)
+
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Lazy.IO as TIO
+
+import Capnp (defaultLimit, getValue)
+import Capnp.Gen.Capnp.Schema.Pure (CodeGeneratorRequest)
+
+import qualified Check
+import qualified IR.Flat as Flat
+import qualified IR.Haskell as Haskell
+import qualified Trans.CgrToStage1
+import qualified Trans.FlatToPure
+import qualified Trans.FlatToRaw
+import qualified Trans.HaskellToText
+import qualified Trans.PureToHaskell
+import qualified Trans.RawToHaskell
+import qualified Trans.Stage1ToFlat
+
+main :: IO ()
+main = do
+ cgr <- getValue defaultLimit
+ Check.reportIssues cgr
+ for_ (handleCGR cgr) $ \(path, contents) -> do
+ createDirectoryIfMissing True (takeDirectory path)
+ withFile path WriteMode $ \h ->
+ TIO.hPutStr h contents
+
+-- | Convert a 'CodeGeneratorRequest' to a list of files to create.
+handleCGR :: CodeGeneratorRequest -> [(FilePath, LT.Text)]
+handleCGR cgr =
+ let flat =
+ Trans.Stage1ToFlat.cgrToCgr $
+ Trans.CgrToStage1.cgrToCgr cgr
+ modules =
+ handleFlatRaw flat ++ handleFlatPure flat
+ in
+ map
+ (\mod ->
+ ( Haskell.modFilePath mod
+ , Trans.HaskellToText.moduleToText mod
+ )
+ )
+ modules
+
+handleFlatPure, handleFlatRaw :: Flat.CodeGenReq -> [Haskell.Module]
+
+handleFlatPure =
+ concatMap Trans.PureToHaskell.fileToModules
+ . Trans.FlatToPure.cgrToFiles
+
+handleFlatRaw =
+ concatMap Trans.RawToHaskell.fileToModules
+ . Trans.FlatToRaw.cgrToFiles
diff --git a/cmd/capnpc-haskell/Trans/CgrToStage1.hs b/cmd/capnpc-haskell/Trans/CgrToStage1.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/CgrToStage1.hs
@@ -0,0 +1,306 @@
+-- | Module: Trans.CgrToStage1
+-- Description: Translate from schema.capnp's codegenerator request to IR.Stage1.
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Trans.CgrToStage1 (cgrToCgr) where
+
+import Data.Word
+
+import Data.Function ((&))
+import Data.ReinterpretCast (doubleToWord, floatToWord)
+import Data.Text.Encoding (encodeUtf8)
+
+import qualified Data.ByteString as BS
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Vector as V
+
+import Capnp.Classes (toWord)
+
+import qualified Capnp.Gen.Capnp.Schema.Pure as Schema
+import qualified Capnp.Untyped.Pure as U
+import qualified IR.Common as C
+import qualified IR.Name as Name
+import qualified IR.Stage1 as Stage1
+
+type NodeMap v = M.Map Word64 v
+
+nodesToNodes :: NodeMap Schema.Node -> NodeMap Stage1.Node
+nodesToNodes inMap = outMap
+ where
+ outMap = M.map translate inMap
+
+ translate Schema.Node{scopeId, id, nestedNodes, union'} = Stage1.Node
+ { nodeCommon = Stage1.NodeCommon
+ { nodeId = id
+ , nodeNested =
+ [ (Name.UnQ name, outMap M.! id)
+ | Schema.Node'NestedNode{name, id} <- V.toList nestedNodes
+ ]
+ , nodeParent =
+ if scopeId == 0 then
+ Nothing
+ else
+ Just (outMap M.! id)
+ }
+ , nodeUnion = case union' of
+ Schema.Node'enum Schema.Node'enum'{enumerants} ->
+ Stage1.NodeEnum $ map enumerantToName $ V.toList enumerants
+ Schema.Node'struct Schema.Node'struct'
+ { dataWordCount
+ , pointerCount
+ , isGroup
+ , discriminantOffset
+ , fields
+ } ->
+ Stage1.NodeStruct Stage1.Struct
+ { dataWordCount
+ , pointerCount
+ , isGroup
+ , tagOffset = discriminantOffset
+ , fields = map (fieldToField outMap) (V.toList fields)
+ }
+ Schema.Node'interface Schema.Node'interface'{ methods, superclasses } ->
+ Stage1.NodeInterface Stage1.Interface
+ { methods = map (methodToMethod outMap) (V.toList methods)
+ , supers = [ outMap M.! id | Schema.Superclass{id} <- V.toList superclasses ]
+ }
+ Schema.Node'const Schema.Node'const'{ type_, value } -> Stage1.NodeConstant $
+ let mismatch = error "ERROR: Constant's type and value do not agree"
+ in case value of
+ Schema.Value'void ->
+ C.VoidValue
+
+ Schema.Value'bool v ->
+ C.WordValue (C.PrimWord C.PrimBool) (toWord v)
+
+ Schema.Value'int8 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz8) (toWord v)
+ Schema.Value'int16 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz16) (toWord v)
+ Schema.Value'int32 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz32) (toWord v)
+ Schema.Value'int64 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz64) (toWord v)
+
+ Schema.Value'uint8 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz8) (toWord v)
+ Schema.Value'uint16 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz16) (toWord v)
+ Schema.Value'uint32 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz32) (toWord v)
+ Schema.Value'uint64 v ->
+ C.WordValue (C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz64) (toWord v)
+
+ Schema.Value'float32 v ->
+ C.WordValue (C.PrimWord C.PrimFloat32) (toWord v)
+ Schema.Value'float64 v ->
+ C.WordValue (C.PrimWord C.PrimFloat64) (toWord v)
+
+ Schema.Value'text v ->
+ C.PtrValue (C.PrimPtr C.PrimText) $ Just $ U.PtrList $ U.List8 $
+ encodeUtf8 v
+ & BS.unpack
+ & (++ [0])
+ & V.fromList
+ Schema.Value'data_ v ->
+ C.PtrValue (C.PrimPtr C.PrimText) $ Just $ U.PtrList $ U.List8 $
+ BS.unpack v
+ & V.fromList
+
+ Schema.Value'list v ->
+ case type_ of
+ Schema.Type'list Schema.Type'list'{ elementType } ->
+ C.PtrValue
+ (C.ListOf (typeToType outMap elementType))
+ v
+ _ ->
+ mismatch
+
+ Schema.Value'enum v ->
+ case type_ of
+ -- TODO: brand
+ Schema.Type'enum Schema.Type'enum'{ typeId } ->
+ C.WordValue (C.EnumType (outMap M.! typeId)) (toWord v)
+ _ ->
+ mismatch
+
+ Schema.Value'struct v ->
+ case type_ of
+ -- TODO: brand
+ Schema.Type'struct Schema.Type'struct'{ typeId } -> C.PtrValue
+ (C.PtrComposite (C.StructType (outMap M.! typeId)))
+ v
+ _ ->
+ mismatch
+
+ Schema.Value'interface ->
+ case type_ of
+ Schema.Type'interface Schema.Type'interface'{ typeId } ->
+ C.PtrValue (C.PtrInterface (outMap M.! typeId)) Nothing
+ _ ->
+ mismatch
+
+ Schema.Value'anyPointer v ->
+ C.PtrValue (C.PrimPtr (C.PrimAnyPtr C.Ptr)) v
+
+ Schema.Value'unknown' tag ->
+ error $ "Unknown variant for Value #" ++ show tag
+ _ ->
+ Stage1.NodeOther
+ }
+
+
+methodToMethod :: NodeMap Stage1.Node -> Schema.Method -> Stage1.Method
+methodToMethod nodeMap Schema.Method{ name, paramStructType, resultStructType } =
+ Stage1.Method
+ { name = Name.UnQ name
+ , paramType = nodeMap M.! paramStructType
+ , resultType = nodeMap M.! resultStructType
+ }
+
+enumerantToName :: Schema.Enumerant -> Name.UnQ
+enumerantToName Schema.Enumerant{name} = Name.UnQ name
+
+fieldToField :: NodeMap Stage1.Node -> Schema.Field -> Stage1.Field
+fieldToField nodeMap Schema.Field{name, discriminantValue, union'} =
+ Stage1.Field
+ { name = Name.UnQ name
+ , tag =
+ if discriminantValue == Schema.field'noDiscriminant then
+ Nothing
+ else
+ Just discriminantValue
+ , locType = getFieldLocType nodeMap union'
+ }
+
+getFieldLocType :: NodeMap Stage1.Node -> Schema.Field' -> C.FieldLocType Stage1.Node
+getFieldLocType nodeMap = \case
+ Schema.Field'slot Schema.Field'slot'{type_, defaultValue, offset} ->
+ case typeToType nodeMap type_ of
+ C.VoidType ->
+ C.VoidField
+ C.PtrType ty ->
+ C.PtrField (fromIntegral offset) ty
+ C.WordType ty ->
+ case valueBits defaultValue of
+ Nothing -> error $
+ "Invlaid schema: a field in a struct's data section " ++
+ "had an illegal (non-data) default value."
+ Just defaultVal ->
+ C.DataField
+ (dataLoc offset ty defaultVal)
+ ty
+ C.CompositeType ty ->
+ C.PtrField (fromIntegral offset) (C.PtrComposite ty)
+ Schema.Field'group Schema.Field'group'{typeId} ->
+ C.HereField $ C.StructType $ nodeMap M.! typeId
+ Schema.Field'unknown' _ ->
+ -- Don't know how to interpret this; we'll have to leave the argument
+ -- opaque.
+ C.VoidField
+
+-- | 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 -> C.WordType Stage1.Node -> Word64 -> C.DataLoc
+dataLoc offset ty defaultVal =
+ let bitsOffset = fromIntegral offset * C.dataFieldSize ty
+ in C.DataLoc
+ { dataIdx = bitsOffset `div` 64
+ , dataOff = bitsOffset `mod` 64
+ , dataDef = defaultVal
+ }
+
+-- | Return the raw bit-level representation of a value that is stored
+-- in a struct's data section.
+--
+-- returns Nothing if the value is a non-word type.
+valueBits :: Schema.Value -> Maybe Word64
+valueBits = \case
+ Schema.Value'bool b -> Just $ fromIntegral $ fromEnum b
+ Schema.Value'int8 n -> Just $ fromIntegral n
+ Schema.Value'int16 n -> Just $ fromIntegral n
+ Schema.Value'int32 n -> Just $ fromIntegral n
+ Schema.Value'int64 n -> Just $ fromIntegral n
+ Schema.Value'uint8 n -> Just $ fromIntegral n
+ Schema.Value'uint16 n -> Just $ fromIntegral n
+ Schema.Value'uint32 n -> Just $ fromIntegral n
+ Schema.Value'uint64 n -> Just n
+ Schema.Value'float32 n -> Just $ fromIntegral $ floatToWord n
+ Schema.Value'float64 n -> Just $ doubleToWord n
+ Schema.Value'enum n -> Just $ fromIntegral n
+ _ -> Nothing -- some non-word type.
+
+reqFileToReqFile :: NodeMap Stage1.Node -> Schema.CodeGeneratorRequest'RequestedFile -> Stage1.ReqFile
+reqFileToReqFile nodeMap Schema.CodeGeneratorRequest'RequestedFile{id, filename} =
+ let Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeNested}} = nodeMap M.! id
+ in Stage1.ReqFile
+ { fileName = T.unpack filename
+ , file = Stage1.File
+ { fileNodes = nodeNested
+ , fileId = id
+ }
+ }
+
+cgrToCgr :: Schema.CodeGeneratorRequest -> Stage1.CodeGenReq
+cgrToCgr Schema.CodeGeneratorRequest{nodes, requestedFiles} =
+ Stage1.CodeGenReq{allFiles, reqFiles}
+ where
+ nodeMap = nodesToNodes $ M.fromList [(id, node) | node@Schema.Node{id} <- V.toList nodes]
+ reqFiles = map (reqFileToReqFile nodeMap) $ V.toList requestedFiles
+ allFiles =
+ [ let fileNodes =
+ [ (Name.UnQ name, nodeMap M.! id)
+ | Schema.Node'NestedNode{name, id} <- V.toList nestedNodes
+
+ -- If the file is an import (i.e. not part of requestedFiles), then
+ -- the code generator will sometimes omit parts of it that are not
+ -- used. We need to check that the nestedNodes are actually included;
+ -- if not, we omit them from the otuput as well.
+ , M.member id nodeMap
+ ]
+ in
+ Stage1.File{fileId, fileNodes}
+ | Schema.Node{union'=Schema.Node'file, id=fileId, nestedNodes} <- V.toList nodes
+ ]
+
+typeToType :: NodeMap Stage1.Node -> Schema.Type -> C.Type Stage1.Node
+typeToType nodeMap = \case
+ Schema.Type'void -> C.VoidType
+ Schema.Type'bool -> C.WordType $ C.PrimWord C.PrimBool
+ Schema.Type'int8 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz8
+ Schema.Type'int16 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz16
+ Schema.Type'int32 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz32
+ Schema.Type'int64 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Signed C.Sz64
+ Schema.Type'uint8 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz8
+ Schema.Type'uint16 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz16
+ Schema.Type'uint32 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz32
+ Schema.Type'uint64 -> C.WordType $ C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz64
+ Schema.Type'float32 -> C.WordType $ C.PrimWord C.PrimFloat32
+ Schema.Type'float64 -> C.WordType $ C.PrimWord C.PrimFloat64
+ Schema.Type'text -> C.PtrType $ C.PrimPtr C.PrimText
+ Schema.Type'data_ -> C.PtrType $ C.PrimPtr C.PrimData
+ Schema.Type'list Schema.Type'list'{elementType} ->
+ C.PtrType $ C.ListOf (typeToType nodeMap elementType)
+ -- TODO: use 'brand' to generate type parameters.
+ Schema.Type'enum Schema.Type'enum'{typeId} ->
+ C.WordType $ C.EnumType $ nodeMap M.! typeId
+ Schema.Type'struct Schema.Type'struct'{typeId} ->
+ C.CompositeType $ C.StructType $ nodeMap M.! typeId
+ Schema.Type'interface Schema.Type'interface'{typeId} ->
+ C.PtrType $ C.PtrInterface $ nodeMap M.! typeId
+ Schema.Type'anyPointer anyPtr -> C.PtrType $ C.PrimPtr $ C.PrimAnyPtr $
+ case anyPtr of
+ Schema.Type'anyPointer'unconstrained Schema.Type'anyPointer'unconstrained'anyKind ->
+ C.Ptr
+ Schema.Type'anyPointer'unconstrained Schema.Type'anyPointer'unconstrained'struct ->
+ C.Struct
+ Schema.Type'anyPointer'unconstrained Schema.Type'anyPointer'unconstrained'list ->
+ C.List
+ Schema.Type'anyPointer'unconstrained Schema.Type'anyPointer'unconstrained'capability ->
+ C.Cap
+ _ ->
+ -- Something we don't know about; assume it could be anything.
+ C.Ptr
+ _ -> C.VoidType -- TODO: constrained anyPointers
diff --git a/cmd/capnpc-haskell/Trans/FlatToPure.hs b/cmd/capnpc-haskell/Trans/FlatToPure.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/FlatToPure.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Trans.FlatToPure (cgrToFiles) where
+
+import Data.Word
+
+import qualified Data.Map.Strict as M
+
+import qualified IR.Common as C
+import qualified IR.Flat as Flat
+import qualified IR.Name as Name
+import qualified IR.Pure as Pure
+
+type IFaceMap = M.Map Word64 Pure.Interface
+
+cgrToFiles :: Flat.CodeGenReq -> [Pure.File]
+cgrToFiles Flat.CodeGenReq{allNodes, reqFiles} =
+ map oneFile reqFiles
+ where
+ allInterfaces = concatMap (convertInterface ifaceMap) allNodes
+ ifaceMap = M.fromList
+ [ (interfaceId, iface)
+ | iface@Pure.IFace{interfaceId} <- allInterfaces
+ ]
+ oneFile Flat.File{nodes, fileId, fileName} =
+ Pure.File
+ { fileId
+ , fileName
+ , decls = concatMap (nodeToDecls ifaceMap) nodes
+ , reExportEnums = concatMap nodeToReExports nodes
+ , usesRpc = not $ null [ () | Flat.Node{ union_ = Flat.Interface{} } <- nodes ]
+ }
+
+convertInterface :: IFaceMap -> Flat.Node -> [Pure.Interface]
+convertInterface
+ ifaceMap
+ Flat.Node
+ { name
+ , nodeId
+ , union_ = Flat.Interface{ methods, supers, ancestors }
+ }
+ =
+ [ Pure.IFace
+ { name
+ , interfaceId = nodeId
+ , methods = [ Pure.Method{..} | Flat.Method{..} <- methods ]
+ , supers = [ ifaceMap M.! nodeId | Flat.Node{nodeId} <- supers ]
+ , ancestors = [ ifaceMap M.! nodeId | Flat.Node{nodeId} <- ancestors ]
+ }
+ ]
+convertInterface _ _ = []
+
+nodeToReExports :: Flat.Node -> [Name.LocalQ]
+nodeToReExports Flat.Node{name=Name.CapnpQ{local}, union_=Flat.Enum _} = [ local ]
+nodeToReExports _ = []
+
+unionToDecl :: Bool -> Name.LocalQ -> Name.LocalQ -> [Flat.Variant] -> Pure.Decl
+unionToDecl firstClass cerialName local variants =
+ Pure.DataDecl Pure.Data
+ { typeName = local
+ , cerialName
+ , def = Pure.Sum
+ [ Pure.Variant
+ { name = variantName
+ , arg = case fieldLocType of
+ C.VoidField ->
+ -- If the argument is void, just have no argument.
+ Nothing
+ _ ->
+ Just (Pure.type_ (fieldToField field))
+ }
+ | Flat.Variant
+ { field=field@Flat.Field
+ { fieldName=Name.CapnpQ{local=variantName}
+ , fieldLocType
+ }
+ } <- variants
+ ]
+ , firstClass
+ }
+
+nodeToDecls :: IFaceMap -> Flat.Node -> [Pure.Decl]
+nodeToDecls ifaceMap Flat.Node{name=name@Name.CapnpQ{local}, nodeId, union_} = case union_ of
+ Flat.Enum _ ->
+ -- Don't need to do anything here, since we're just re-exporting the
+ -- stuff from the raw module.
+ []
+ Flat.Interface{} ->
+ [ Pure.IFaceDecl (ifaceMap M.! nodeId) ]
+ Flat.Struct{ isGroup, fields=[], union=Just Flat.Union{variants}} ->
+ -- It's just one big union; skip the outer struct wrapper and make it
+ -- a top-level sum type.
+ [ unionToDecl (not isGroup) local local variants ]
+ -- Flat.Struct{ isGroup=True, union=Nothing } -> [] -- See Note [Collapsing Groups]
+ Flat.Struct{ isGroup, fields, union } ->
+ Pure.DataDecl Pure.Data
+ { typeName = local
+ , cerialName = local
+ , def = Pure.Product $
+ map fieldToField fields
+ ++ case union of
+ Nothing ->
+ []
+ Just _ ->
+ [ Pure.Field
+ { name = "union'"
+ , type_ = C.CompositeType $ C.StructType $ Name.mkSub name ""
+ }
+ ]
+ , firstClass = not isGroup
+ }
+ : case union of
+ Just Flat.Union{variants} ->
+ -- Also make a type that's just the union, but give it the
+ -- same cerialName:
+ [ unionToDecl False local (Name.mkSub local "") variants ]
+ Nothing ->
+ []
+ Flat.Constant { value } ->
+ [ Pure.ConstDecl Pure.Constant
+ { name = local
+ , value = fmap (\Flat.Node{name} -> name) value
+ }
+ ]
+ Flat.Other -> []
+
+fieldToField :: Flat.Field -> Pure.Field
+fieldToField Flat.Field{fieldName, fieldLocType} = Pure.Field
+ { name = Name.getUnQ fieldName
+ , type_ = fmap
+ (\Flat.Node{name} -> name)
+ (C.fieldType fieldLocType)
+ }
+
+-- Note [Collapsing Groups]
+-- ========================
+--
+-- If the argument to a union data constructor is a group, then the fields
+-- never exist on their own, so it makes for a nicer API to just collapse
+-- the fields directly into the variant, rather than creating an auxiliary
+-- struct type.
+--
+-- However, this is only safe to do if the group does not itself have an
+-- anonymous union. The reason for this is that otherwise we could end up
+-- with two variants with a field "union'" but different types, which the
+-- compiler will reject.
+--
+-- So the rule is, if a Field.Struct node is a group, and it does not itself
+-- have an anonymous union:
+--
+-- 1. Don't generate a type for it.
+-- 2. Collapse its fields into the data constructor for the union.
+--
+-- Note that we actually depend on (1) to avoid name collisions, since
+-- otherwise both the data constructor for the anonymous union and the
+-- data constructor for the group will be the same.
diff --git a/cmd/capnpc-haskell/Trans/FlatToRaw.hs b/cmd/capnpc-haskell/Trans/FlatToRaw.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/FlatToRaw.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Trans.FlatToRaw (cgrToFiles) where
+
+import qualified IR.Common as C
+import qualified IR.Flat as Flat
+import qualified IR.Name as Name
+import qualified IR.Raw as Raw
+
+cgrToFiles :: Flat.CodeGenReq -> [Raw.File]
+cgrToFiles Flat.CodeGenReq{reqFiles} = map fileToFile reqFiles
+
+fileToFile :: Flat.File -> Raw.File
+fileToFile Flat.File{nodes, fileId, fileName} =
+ Raw.File
+ { fileName
+ , fileId
+ , decls = concatMap nodeToDecls nodes
+ }
+
+nodeToDecls :: Flat.Node -> [Raw.Decl]
+nodeToDecls Flat.Node{name=Name.CapnpQ{fileId, local}, union_} = case union_ of
+ Flat.Enum variants ->
+ [ Raw.Enum
+ { typeCtor = local
+ , dataCtors = map (Name.mkSub local) variants
+ }
+ ]
+ Flat.Struct{fields, isGroup, dataWordCount, pointerCount, union} ->
+ concat
+ [ [ Raw.StructWrapper { typeCtor = local } ]
+ , if isGroup
+ then
+ []
+ else
+ [ Raw.StructInstances
+ { typeCtor = local
+ , dataWordCount
+ , pointerCount
+ }
+ ]
+ , concatMap (fieldToDecls local) fields
+ , case union of
+ Nothing -> []
+ Just Flat.Union{variants, tagOffset} ->
+ let local' = Name.mkSub local "" in
+ [ Raw.UnionVariant
+ { parentTypeCtor = local
+ , tagOffset
+ , unionDataCtors =
+ [ Raw.Variant
+ { name = local
+ , tagValue
+ , locType = fmap (\Flat.Node{name} -> name) fieldLocType
+ }
+ | Flat.Variant
+ { field = Flat.Field
+ { fieldName = Name.CapnpQ{local}
+ , fieldLocType
+ }
+ , tagValue
+ } <- variants
+ ]
+ }
+ , Raw.Getter
+ { fieldName = local'
+ , containerType = local
+ , fieldLocType = C.HereField $ C.StructType Name.CapnpQ
+ { fileId
+ , local = local'
+ }
+ }
+ ] ++
+ [ Raw.Setter
+ { fieldName
+ , containerType = local
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , tag = Just Raw.TagSetter
+ { tagOffset
+ , tagValue
+ }
+ }
+ | Flat.Variant
+ { field = Flat.Field
+ { fieldName = Name.CapnpQ { local = fieldName }
+ , fieldLocType
+ }
+ , tagValue
+ } <- variants
+ ] ++
+ -- This is kindof another tag setter, but it has to work a bit
+ -- differently for the unknown' variant, because it takes an
+ -- argument for what the tag should be, but also doesn't need to
+ -- set any other values. We can treat is as just a setter for a
+ -- uint16 field in the same spot:
+ [ Raw.Setter
+ { fieldName = Name.mkSub local "unknown'"
+ , containerType = local
+ , fieldLocType = C.DataField
+ (Raw.tagOffsetToDataLoc tagOffset)
+ (C.PrimWord $ C.PrimInt $ C.IntType C.Unsigned C.Sz16)
+ , tag = Nothing
+ }
+ ]
+ ]
+ Flat.Interface{} ->
+ [ Raw.InterfaceWrapper
+ { typeCtor = local
+ }
+ ]
+ Flat.Constant{ value } ->
+ [ Raw.Constant
+ { name = local
+ , value = fmap (\Flat.Node{name} -> name) value
+ }
+ ]
+ Flat.Other -> []
+
+fieldToDecls :: Name.LocalQ -> Flat.Field -> [Raw.Decl]
+fieldToDecls containerType Flat.Field{fieldName=Name.CapnpQ{local=fieldName}, fieldLocType} =
+ [ Raw.Getter
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ }
+ ]
+ ++
+ case fieldLocType of
+ C.HereField _ -> []
+ _ ->
+ [ Raw.Setter
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , tag = Nothing
+ }
+ ]
+ ++
+ case fieldLocType of
+ C.PtrField ptrIndex _ ->
+ [ Raw.HasFn
+ { fieldName
+ , containerType
+ , ptrIndex
+ }
+ ]
+ _ ->
+ []
+ ++
+ case fieldLocType of
+ C.PtrField _ (C.ListOf _) ->
+ [ Raw.NewFn
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , newFnType = Raw.NewList
+ }
+ ]
+ C.PtrField _ (C.PrimPtr C.PrimText) ->
+ [ Raw.NewFn
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , newFnType = Raw.NewText
+ }
+ ]
+ C.PtrField _ (C.PrimPtr C.PrimData) ->
+ [ Raw.NewFn
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , newFnType = Raw.NewData
+ }
+ ]
+ C.PtrField _ (C.PtrComposite _) ->
+ [ Raw.NewFn
+ { fieldName
+ , containerType
+ , fieldLocType = fmap (\Flat.Node{name} -> name) fieldLocType
+ , newFnType = Raw.NewStruct
+ }
+ ]
+ _ ->
+ []
diff --git a/cmd/capnpc-haskell/Trans/HaskellToText.hs b/cmd/capnpc-haskell/Trans/HaskellToText.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/HaskellToText.hs
@@ -0,0 +1,298 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Trans.HaskellToText (moduleToText) where
+
+import Data.List (intersperse)
+import Data.String (fromString)
+import Text.PrettyPrint.Leijen.Text (hcat, vcat)
+
+import qualified Data.Text.Lazy as LT
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+import IR.Haskell
+
+import qualified IR.Common as C
+import qualified IR.Name as Name
+
+moduleToText :: Module -> LT.Text
+moduleToText mod = PP.displayT $ PP.renderPretty 0.4 80 (format mod)
+
+-- | Types which can be rendered as haskell source code.
+--
+-- Note well: while format returns a Doc, it is not safe to render it using
+-- wl-pprint's "compact" output; we rely on newline significance in some ways
+-- without enforcing it.
+--
+-- It would be nice to fix this, but given that we don't currently expose this
+-- via the library and only ever render it in the one place (in main), it isn't
+-- a huge priority.
+class Format a where
+ format :: a -> PP.Doc
+
+instance Format Module where
+ format Module{modName, modLangPragmas, modDecls, modExports, modImports} = vcat
+ [ vcat [ "{-# LANGUAGE " <> PP.textStrict ext <> " #-}" | ext <- modLangPragmas ]
+ -- The generated code sometimes triggers these warnings, but they're nothing to
+ -- worry about.
+ --
+ -- Dodgy-exports comes up when we don't actaully generate any definitions to
+ -- export, in which case GHC complains in the machine readable module alias that
+ -- we're trying to re-export everything from a module with no-exports. This
+ -- happens with e.g. c++.capnp, which only defines annotations.
+ , "{-# OPTIONS_GHC -Wno-unused-imports #-}"
+ , "{-# OPTIONS_GHC -Wno-dodgy-exports #-}"
+ , "{-# OPTIONS_GHC -Wno-unused-matches #-}"
+ , "{-# OPTIONS_GHC -Wno-orphans #-}"
+ , hcat
+ [ "module "
+ , PP.textStrict $ mconcat $ intersperse "." $ map Name.renderUnQ modName
+ , case modExports of
+ Nothing -> ""
+ Just exports ->
+ PP.tupled (map format exports)
+ , " where"
+ ]
+ , vcat $ map format modImports
+ -- We import many things, including the prelude, qualified under the
+ -- "Std_" namespace, so that they don't collide with names in the
+ -- generated code; see issue #58.
+ , vcat $ map format
+ [ ImportAs { importAs = "Std_", parts = ["Prelude"] }
+ , ImportAs { importAs = "Std_", parts = ["Data", "Word"] }
+ , ImportAs { importAs = "Std_", parts = ["Data", "Int"] }
+ ]
+ -- ...but there are a couple operators we still want unqaulified:
+ , "import Prelude ((<$>), (<*>), (>>=))"
+ , vcat $ map format modDecls
+ ]
+
+instance Format Export where
+ format (ExportMod parts) =
+ "module " <> PP.textStrict (mconcat $ intersperse "." $ map Name.renderUnQ parts)
+ format (ExportLCtors name) = format name <> "(..)"
+ format (ExportGCtors name) = format name <> "(..)"
+ format (ExportGName name) = format name
+ format (ExportLName name) = format name
+
+instance Format Decl where
+ format (DcData d) = format d
+ format DcValue{typ, def=def@DfValue{name}} = vcat
+ [ hcat [ format name, " :: ", format typ ]
+ , format def
+ ]
+ format DcInstance{ctx, typ, defs} = hcat
+ [ "instance "
+ , format (TCtx ctx typ)
+ , whereBlock defs
+ ]
+ format DcClass{ctx, name, params, decls} = hcat
+ [ "class "
+ , format $
+ TCtx ctx $
+ TApp
+ (TLName name)
+ [TLName (Name.unQToLocal p) | p <- params]
+ , whereBlock decls
+ ]
+
+whereBlock :: Format a => [a] -> PP.Doc
+whereBlock [] = ""
+whereBlock xs = vcat
+ [ " where"
+ , indent $ vcat $ map format xs
+ ]
+
+instance Format ClassDecl where
+ format (CdValueDecl name typ) = hcat [ format name, " :: ", format typ ]
+ format (CdValueDef def) = format def
+ format (CdMinimal names) = hcat
+ [ "{-# MINIMAL "
+ , hcat $ PP.punctuate PP.comma (map format names)
+ , " #-}"
+ ]
+
+instance Format InstanceDef where
+ format (IdData d) = format d
+ format (IdValue d) = format d
+ format (IdType d) = format d
+
+instance Format TypeAlias where
+ format (TypeAlias name params value) = hcat
+ [ "type "
+ , format name
+ , " "
+ , mconcat $ intersperse " " (map format params)
+ , " = "
+ , format value
+ ]
+
+instance Format DataDecl where
+ format Data{dataName, typeArgs, dataVariants, dataNewtype, derives} = vcat
+ [ hcat
+ [ if dataNewtype
+ then "newtype "
+ else "data "
+ , format dataName
+ , " "
+ , mconcat $ intersperse " " $ map format typeArgs
+ ]
+ , indent $ vcat
+ [ case dataVariants of
+ (d:ds) -> vcat $ ("= " <> format d) : map (("| " <>) . format) ds
+ [] -> ""
+ , formatDerives derives
+ ]
+ ]
+
+instance Format ValueDef where
+ format DfValue{name, value, params} = hcat
+ [ format name
+ , " "
+ , hcat $ intersperse " " $ map format params
+ , " = "
+ , format value
+ ]
+
+instance Format Exp where
+ format (EApp e es) = hcat
+ [ "("
+ , hcat $ intersperse " " $ map format (e:es)
+ , ")"
+ ]
+ format (EFApp e []) = format e
+ format (EFApp e es) = hcat
+ [ "("
+ , format e
+ , PP.encloseSep " <$> " ")" " <*> " $ map format es
+ ]
+ format (EGName e) = format e
+ format (ELName e) = format e
+ format (EInt n) = fromString (show n)
+ format (EDo ds ex) = vcat
+ [ "(do"
+ , indent $ vcat (map format ds ++ [format ex, ")"])
+ ]
+ format (EBind x f) = PP.parens (format x <> " >>= " <> format f)
+ format (ETup es) = PP.tupled (map format es)
+ format (ECase ex arms) = vcat
+ [ hcat [ "case ", format ex, " of"]
+ , indent $ vcat
+ [ vcat
+ [ hcat [ format p, " ->" ]
+ , indent (format e)
+ ]
+ | (p, e) <- arms
+ ]
+ ]
+ format (ETypeAnno e ty) = PP.parens $ hcat
+ [ format e
+ , " :: "
+ , format ty
+ ]
+ format (EBytes bytes) = fromString (show bytes)
+ format (ELambda params body) = PP.parens $ hcat
+ [ "\\"
+ , hcat (PP.punctuate " " (map format params))
+ , " -> "
+ , format body
+ ]
+ format (ERecord old updates) =
+ format old <> PP.encloseSep "{" "}" ","
+ [ hcat [ format name, " = ", format value ]
+ | (name, value) <- updates
+ ]
+
+instance Format Do where
+ format (DoBind var ex) = format var <> " <- " <> format ex
+ format (DoE ex) = format ex
+
+instance Format Pattern where
+ format (PVar v) = PP.textStrict v
+ format (PLCtor c ps) = hcat
+ [ "("
+ , mconcat $ intersperse " " (format c : map format ps)
+ , ")"
+ ]
+ format (PGCtor c ps) = hcat
+ [ "("
+ , mconcat $ intersperse " " (format c : map format ps)
+ , ")"
+ ]
+ format (PInt n) = fromString (show n)
+ format (PLRecordWildCard name) = format name <> "{..}"
+
+formatDerives :: [Name.UnQ] -> PP.Doc
+formatDerives [] = ""
+formatDerives ds = "deriving" <> PP.tupled (map format ds)
+
+instance Format DataVariant where
+ format DataVariant{dvCtorName, dvArgs} =
+ hcat [ format dvCtorName, " ", format dvArgs ]
+
+instance Format DataArgs where
+ format (APos types) =
+ mconcat $ intersperse " " (map format types)
+ format (ARec fields) = PP.line <> indent
+ (PP.encloseSep
+ "{" "}" ","
+ [ format name <> " :: " <> format ty | (name, ty) <- fields ]
+ )
+
+instance Format Type where
+ format (TGName ty) = format ty
+ format (TLName ty) = format ty
+ format (TVar txt) = PP.textStrict txt
+ format (TApp f xs) =
+ "(" <> mconcat (intersperse " " $ map format (f:xs)) <> ")"
+ format (TFn types) =
+ mconcat $ intersperse " -> " $ map format types
+ format (TCtx[] ty) = format ty
+ format (TCtx constraints ty) =
+ PP.tupled (map format constraints) <> " => " <> format ty
+ format (TPrim ty) = format ty
+ format TUnit = "()"
+
+instance Format Name.GlobalQ where
+ format Name.GlobalQ{local, globalNS=Name.NS parts} =
+ mconcat
+ [ mconcat $ intersperse "." (map PP.textStrict parts)
+ , "."
+ , format local
+ ]
+
+instance Format Name.LocalQ where
+ format = PP.textStrict . Name.renderLocalQ
+
+instance Format Name.UnQ where
+ format = PP.textStrict . Name.renderUnQ
+
+
+instance Format Import where
+ format ImportAs{importAs, parts} = hcat
+ [ "import qualified "
+ , implodeNS parts
+ , " as "
+ , format importAs
+ ]
+ format ImportQual{ parts } = hcat [ "import qualified ", implodeNS parts ]
+ format ImportAll { parts } = hcat [ "import ", implodeNS parts ]
+
+implodeNS :: Format a => [a] -> PP.Doc
+implodeNS parts = mconcat $ intersperse "." (map format parts)
+
+instance Format C.PrimWord where
+ format C.PrimBool = "Std_.Bool"
+ format (C.PrimInt (C.IntType sign sz)) =
+ let szDoc = fromString $ show $ C.sizeBits sz
+ typePrefix = case sign of
+ C.Signed -> "Int"
+ C.Unsigned -> "Word"
+ in
+ "Std_." <> typePrefix <> szDoc
+ format C.PrimFloat32 = "Std_.Float"
+ format C.PrimFloat64 = "Std_.Double"
+
+-- | Indent the argument by four spaces.
+indent :: PP.Doc -> PP.Doc
+indent = PP.indent 4
diff --git a/cmd/capnpc-haskell/Trans/PureToHaskell.hs b/cmd/capnpc-haskell/Trans/PureToHaskell.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/PureToHaskell.hs
@@ -0,0 +1,730 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Trans.PureToHaskell (fileToModules) where
+
+import Data.Word
+
+import Control.Monad (guard)
+import Text.Printf (printf)
+
+import qualified Data.Text as T
+
+import IR.Haskell
+import Trans.ToHaskellCommon
+
+import qualified IR.Common as C
+import qualified IR.Name as Name
+import qualified IR.Pure as P
+
+
+-- | Modules imported by all generated modules.
+commonImports :: [Import]
+commonImports =
+ [ ImportAs { importAs = "V", parts = reExp ["Data", "Vector"] }
+ , ImportAs { importAs = "T", parts = reExp ["Data", "Text"] }
+ , ImportAs { importAs = "BS", parts = reExp ["Data", "ByteString"] }
+ , ImportAs { importAs = "Default", parts = reExp ["Data", "Default"] }
+ , ImportAs { importAs = "Generics", parts = ["GHC", "Generics"] }
+ , ImportAs { importAs = "MonadIO", parts = ["Control", "Monad", "IO", "Class"] }
+ , ImportAs { importAs = "UntypedPure", parts = ["Capnp", "Untyped", "Pure"] }
+ , ImportAs { importAs = "Untyped", parts = ["Capnp", "Untyped"] }
+ , ImportAs { importAs = "Message", parts = ["Capnp", "Message"] }
+ , ImportAs { importAs = "Classes", parts = ["Capnp", "Classes"] }
+ , ImportAs { importAs = "BasicsPure", parts = ["Capnp", "Basics", "Pure" ] }
+ , ImportAs { importAs = "GenHelpersPure", parts = ["Capnp", "GenHelpers", "Pure"] }
+ ]
+
+
+-- | Modules imported by generated modules that use rpc.
+rpcImports :: [Import]
+rpcImports =
+ [ ImportAs { importAs = "Rpc", parts = ["Capnp", "Rpc", "Untyped"] }
+ , ImportAs { importAs = "Server", parts = ["Capnp", "Rpc", "Server"] }
+ , ImportAs { importAs = "RpcHelpers", parts = ["Capnp", "GenHelpers", "Rpc"] }
+ , ImportAs { importAs = "STM", parts = reExp ["Control", "Concurrent", "STM"] }
+ , ImportAs { importAs = "Supervisors", parts = reExp ["Supervisors"] }
+ ]
+
+reExp parts = ["Capnp", "GenHelpers", "ReExports"] ++ parts
+
+-- | Whether the serialized and unserialized forms of this type
+-- are the same. If not, there is a marshalling step, if so, the
+-- accessors work with the decerialized form directly.
+--
+-- For example, this is True for Enums, basic integers, etc. but
+-- False for structs, interfaces, etc.
+cerialEq :: C.Type r -> Bool
+cerialEq C.VoidType = True
+cerialEq (C.WordType _) = True
+cerialEq (C.CompositeType _) = False
+cerialEq (C.PtrType _) = False
+
+fileToModules :: P.File -> [Module]
+fileToModules file =
+ [ fileToMainModule file
+ , fileToModuleAlias file
+ ]
+
+fileToModuleAlias :: P.File -> Module
+fileToModuleAlias P.File{fileName, fileId} =
+ let reExport = ["Capnp", "Gen"] ++ makeModName fileName ++ ["Pure"]
+ in Module
+ { modName = idToModule fileId ++ ["Pure"]
+ , modLangPragmas = []
+ , modExports = Just [ExportMod reExport]
+ , modImports = [ ImportAll { parts = reExport } ]
+ , modDecls = []
+ }
+
+fileToMainModule :: P.File -> Module
+fileToMainModule P.File{fileName, fileId, decls, reExportEnums, usesRpc} =
+ fixImports $ Module
+ { modName = ["Capnp", "Gen"] ++ makeModName fileName ++ ["Pure"]
+ , modLangPragmas =
+ [ "DeriveGeneric"
+ , "DuplicateRecordFields"
+ , "FlexibleContexts"
+ , "FlexibleInstances"
+ , "RecordWildCards"
+ , "MultiParamTypeClasses"
+ , "TypeFamilies"
+ ]
+ , modExports = Just $
+ [ExportGCtors (gName (rawModule fileId) name) | name <- reExportEnums]
+ ++ concatMap (declToExport fileId) decls
+ , modImports =
+ commonImports ++ (guard usesRpc >> rpcImports)
+ , modDecls =
+ concatMap (declToDecls fileId) decls
+ ++ concatMap (enumInstances fileId) reExportEnums
+ }
+
+
+-- | Convert a declaration into the list of related exports we need.
+-- The first argument is the id for this module.
+declToExport :: Word64 -> P.Decl -> [Export]
+declToExport fileId = \case
+ P.DataDecl P.Data{typeName} ->
+ [ ExportLCtors typeName ]
+ P.ConstDecl P.Constant { name, value=C.WordValue _ _ } ->
+ [ ExportGName $ gName (rawModule fileId) name ]
+ P.ConstDecl P.Constant { name, value=C.VoidValue } ->
+ [ ExportGName $ gName (rawModule fileId) name ]
+ P.ConstDecl P.Constant { name, value=C.PtrValue _ _ } ->
+ [ ExportLName name ]
+ P.IFaceDecl P.IFace{ name=Name.CapnpQ{local} } ->
+ [ ExportLCtors local
+ , ExportLCtors (Name.mkSub local "server_")
+ , ExportLName (Name.unQToLocal $ Name.UnQ $ "export_" <> Name.renderLocalQ local)
+ ]
+
+-- | enumInstances' generates some type class instances an enum data type.
+enumInstances :: Word64 -> Name.LocalQ -> [Decl]
+enumInstances thisMod name =
+ let rawName = gName (rawModule thisMod) name in
+ instance_ [] ["Classes"] "Decerialize" [TGName rawName]
+ [ iType "Cerial" [tuName "msg", TGName rawName] (TGName rawName)
+ , iValue "decerialize" [] (eStd_ "pure")
+ ]
+ : instance_ [] ["Classes"] "Cerialize" [TGName rawName]
+ [ iValue "cerialize" [PVar "_"] (eStd_ "pure")
+ ]
+ : [ instance_ [] ["Classes"] "Cerialize" [t]
+ [ iValue "cerialize" [] (egName ["Classes"] "cerializeBasicVec")
+ ]
+ | t <- take 6 $ drop 1 $ iterate
+ (\t -> TApp (tgName ["V"] "Vector") [t])
+ (TGName rawName)
+ ]
+
+-- | Convert an 'IR.Pure.Decl' into a series of Haskell declarations.
+declToDecls :: Word64 -> P.Decl -> [Decl]
+declToDecls thisMod (P.DataDecl data_) = dataToDecls thisMod data_
+declToDecls thisMod (P.ConstDecl constant) = constToDecls thisMod constant
+declToDecls thisMod (P.IFaceDecl iface) = ifaceToDecls thisMod iface
+
+dataToDecls :: Word64 -> P.Data -> [Decl]
+dataToDecls thisMod data_@P.Data{firstClass} = concat $
+ [ dataToDataDecl thisMod data_
+ , dataToSimpleInstances thisMod data_
+ , dataToDecerialize thisMod data_
+ , dataToMarshal thisMod data_
+ ]
+ ++
+ [ firstClassInstances thisMod data_ | firstClass ]
+
+-- | Get the name of a data constructor for a product type. Arguments are the
+-- name of the type constructor and whether or not the type is "first class".
+productVariantName :: Name.LocalQ -> Bool -> Name.LocalQ
+productVariantName typeName firstClass
+ | firstClass = typeName
+ | otherwise = Name.mkSub typeName ""
+ -- ^ This is a group. If it's part of a union, then the union
+ -- will have a data constructor that is the same as typeName,
+ -- so we appent a ' to avoid a colision.
+
+dataToDataDecl :: Word64 -> P.Data -> [Decl]
+dataToDataDecl thisMod P.Data
+ { typeName
+ , cerialName
+ , firstClass
+ , def
+ } =
+ let unknownCtor = Name.mkSub cerialName "unknown'" in
+ [ DcData Data
+ { dataName = Name.localToUnQ typeName
+ , typeArgs = []
+ , derives =
+ ["Std_.Show", "Std_.Eq", "Generics.Generic"]
+ , dataNewtype = False
+ , dataVariants =
+ case def of
+ P.Product fields ->
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ $ productVariantName typeName firstClass
+ , dvArgs = ARec (map (fieldToField thisMod) fields)
+ }
+ ]
+ P.Sum variants ->
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ name
+ , dvArgs = case arg of
+ Nothing -> APos []
+ Just ty -> APos [typeToType thisMod ty]
+ }
+ | P.Variant{name, arg} <- variants
+ ]
+ ++
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ unknownCtor
+ , dvArgs = APos [TPrim $ C.PrimInt $ C.IntType C.Unsigned C.Sz16]
+ }
+ ]
+ }
+ ]
+
+dataToSimpleInstances :: Word64 -> P.Data -> [Decl]
+dataToSimpleInstances _thisMod P.Data{ typeName } =
+ [ instance_ [] ["Default"] "Default" [TLName typeName]
+ [ iValue "def" [] (egName ["GenHelpersPure"] "defaultStruct")
+ ]
+ , instance_ [] ["Classes"] "FromStruct" [tgName ["Message"] "ConstMsg", TLName typeName]
+ [ iValue "fromStruct" [PVar "struct"] $ EBind
+ (EApp (egName ["Classes"] "fromStruct") [euName "struct"])
+ (egName ["Classes"] "decerialize")
+ ]
+ ]
+
+dataToDecerialize :: Word64 -> P.Data -> [Decl]
+dataToDecerialize thisMod P.Data
+ { typeName
+ , cerialName
+ , firstClass
+ , def
+ } =
+ [ instance_ [] ["Classes"] "Decerialize" [TLName typeName]
+ [ iType "Cerial" [tuName "msg", TLName typeName] $
+ TApp (tgName (rawModule thisMod) cerialName) [tuName "msg"]
+ , iValue "decerialize" [PVar "raw"] $
+ case def of
+ P.Sum variants ->
+ variantsToDecerialize thisMod cerialName variants
+ P.Product fields ->
+ fieldsToDecerialize thisMod typeName firstClass fields
+ ]
+ ]
+
+variantsToDecerialize :: Word64 -> Name.LocalQ -> [P.Variant] -> Exp
+variantsToDecerialize thisMod cerialName variants =
+ let unknownCtor = Name.mkSub cerialName "unknown'"
+ fieldGetter parentName name = egName
+ (rawModule thisMod)
+ (Name.unQToLocal $ Name.getterName $ Name.mkSub parentName name)
+ in
+ EDo
+ [DoBind "raw" $ EApp (fieldGetter cerialName "") [euName "raw"]
+ ]
+ (ECase (ELName "raw") $
+ [ case arg of
+ Nothing ->
+ ( pgName (rawModule thisMod) name []
+ , EApp (eStd_ "pure") [ELName name]
+ )
+ Just type_ | cerialEq type_ ->
+ ( pgName (rawModule thisMod) name [PVar "raw"]
+ , EApp (eStd_ "pure") [EApp (ELName name) [euName "raw"]]
+ )
+ Just _ ->
+ ( pgName (rawModule thisMod) name [PVar "raw"]
+ , EFApp
+ (ELName name)
+ [EApp (egName ["Classes"] "decerialize") [euName "raw"]]
+ )
+ | P.Variant{name, arg} <- variants
+ ]
+ ++
+ [ ( pgName (rawModule thisMod) unknownCtor [PVar "tag"]
+ , EApp
+ (eStd_ "pure")
+ [EApp (ELName unknownCtor) [euName "tag"]]
+ )
+ ]
+ )
+
+fieldsToDecerialize :: Word64 -> Name.LocalQ -> Bool -> [P.Field] -> Exp
+fieldsToDecerialize thisMod typeName firstClass fields =
+ let fieldGetter parentName name = egName
+ (rawModule thisMod)
+ (Name.unQToLocal $ Name.getterName $ Name.mkSub parentName name)
+ variantName = productVariantName typeName firstClass
+ in
+ case fields of
+ [] ->
+ EApp (eStd_ "pure") [ELName variantName]
+ _ ->
+ EFApp
+ (ELName variantName)
+ [
+ let getter = EApp (fieldGetter typeName name) [euName "raw"] in
+ if name == "union'" then
+ -- unions decerialize from the same type as their parents. Don't
+ -- do anything but pass it off.
+ EApp (egName ["Classes"] "decerialize") [euName "raw"]
+ else if cerialEq type_ then
+ getter
+ else
+ EBind getter (egName ["Classes"] "decerialize")
+ | P.Field{name, type_} <- fields
+ ]
+
+
+dataToMarshal :: Word64 -> P.Data -> [Decl]
+dataToMarshal thisMod P.Data
+ { typeName
+ , cerialName
+ , firstClass
+ , def
+ } =
+ [ instance_ [] ["Classes"] "Marshal" [TLName typeName]
+ [ iValue "marshalInto" [PVar "raw_", PVar "value_"] $
+ case def of
+ P.Sum variants ->
+ variantsToMarshal thisMod cerialName variants
+ P.Product fields ->
+ fieldsToMarshal thisMod typeName firstClass fields
+ ]
+ ]
+
+variantsToMarshal :: Word64 -> Name.LocalQ -> [P.Variant] -> Exp
+variantsToMarshal thisMod cerialName variants =
+ let unknownCtor = Name.mkSub cerialName "unknown'" in
+ ECase (euName "value_") $
+ [ let setter = Name.unQToLocal $ Name.setterName variantName
+ setExp = EApp (egName (rawModule thisMod) setter) [euName "raw_"]
+ in case arg of
+ Nothing ->
+ ( PLCtor variantName []
+ , setExp
+ )
+ Just type_ ->
+ ( PLCtor variantName [PVar "arg_"]
+ , marshalField MarshalField
+ { thisMod
+ , into = "raw_"
+ , localQField = variantName
+ , from = "arg_"
+ , type_
+ , inUnion = True
+ }
+ )
+ | P.Variant{name=variantName, arg} <- variants
+ ]
+ ++
+ let setter = Name.unQToLocal $ Name.setterName unknownCtor in
+ [ ( PLCtor unknownCtor [PVar "tag"]
+ , EApp (egName (rawModule thisMod) setter) [euName "raw_", euName "tag"]
+ )
+ ]
+
+fieldsToMarshal :: Word64 -> Name.LocalQ -> Bool -> [P.Field] -> Exp
+fieldsToMarshal thisMod typeName firstClass fields =
+ let variantName = productVariantName typeName firstClass in
+ ECase (euName "value_")
+ [ ( case fields of
+ -- If there are no fields, use of RecordWildCards will
+ -- cause an error:
+ [] -> PLCtor variantName []
+ _ -> PLRecordWildCard variantName
+ , EDo
+ [ DoE $ marshalField MarshalField
+ { thisMod
+ , into = "raw_"
+ , localQField = Name.mkSub typeName fieldName
+ , from = fieldName
+ , type_
+ , inUnion = False
+ }
+ | P.Field{name=fieldName, type_} <- fields
+ ]
+ ePureUnit
+ )
+ ]
+
+firstClassInstances :: Word64 -> P.Data -> [Decl]
+firstClassInstances _thisMod P.Data{ typeName } =
+ [ instance_ [] ["Classes"] "Cerialize" [TLName typeName] []
+ , instance_ [] ["Classes"] "Cerialize" [TApp (tgName ["V"] "Vector") [TLName typeName]]
+ [ iValue "cerialize" [] (egName ["GenHelpersPure"] "cerializeCompositeVec")
+ ]
+ ] ++
+ -- Generate instances of Cerialize (Vector (Vector ... t)) up to some reasonable
+ -- nesting level. I(zenhack) can't figure out how to get a general case
+ -- Cerialize (Vector a) => Cerialize (Vector (Vector a)) to type check, so this
+ -- will have to do for now.
+ [ instance_ [] ["Classes"] "Cerialize" [t]
+ [ iValue "cerialize" [] (egName ["GenHelpersPure"] "cerializeBasicVec")
+ ]
+ | t <- take 6 $ drop 2 $ iterate
+ (\t -> TApp (tgName ["V"] "Vector") [t])
+ (TLName typeName)
+ ]
+
+ifaceToDecls :: Word64 -> P.Interface -> [Decl]
+ifaceToDecls thisMod iface =
+ [ ifaceClientDecl thisMod iface
+ , ifaceClassDecl thisMod iface
+ , ifaceExportFn thisMod iface
+ ]
+ ++
+ ifaceInstances thisMod iface
+
+-- | Declare the newtype wrapper for clients of this interface.
+ifaceClientDecl :: Word64 -> P.Interface -> Decl
+ifaceClientDecl _thisMod P.IFace{ name=Name.CapnpQ{local=name} } =
+ DcData Data
+ { dataName = Name.localToUnQ name
+ , dataNewtype = True
+ , dataVariants =
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ name
+ , dvArgs = APos [tgName ["Message"] "Client"]
+ }
+ ]
+ , typeArgs = []
+ , derives =
+ [ "Std_.Show"
+ , "Std_.Eq"
+ , "Generics.Generic"
+ ]
+ }
+
+-- | define the *'server_ class for the interface.
+ifaceClassDecl :: Word64 -> P.Interface -> Decl
+ifaceClassDecl thisMod P.IFace { name=Name.CapnpQ{local=name}, methods, supers } =
+ DcClass
+ { ctx =
+ TApp (tgName ["MonadIO"] "MonadIO") [tuName "m"]
+ :
+ -- Add class constraints for superclasses:
+ [ let superClass = pureTName thisMod fileId (Name.mkSub local "server_")
+ in TApp superClass [tuName "m", tuName "cap"]
+ | P.IFace{name=Name.CapnpQ{local, fileId}} <- supers
+ ]
+ , name = Name.mkSub name "server_"
+ , params = ["m", "cap"]
+ , decls =
+ let mkName = mkMethodName name in
+ CdMinimal [ mkName name | P.Method{name} <- methods ]
+ : concat
+ [ [ CdValueDecl
+ (mkName methodName)
+ (TFn
+ [ tuName "cap"
+ , TApp
+ (tgName ["Server"] "MethodHandler")
+ [ tuName "m"
+ , typeToType thisMod $ C.CompositeType $ C.StructType paramType
+ , typeToType thisMod $ C.CompositeType $ C.StructType resultType
+ ]
+ ]
+ )
+ , CdValueDef DfValue
+ { name = mkName methodName
+ , params = [PVar "_"]
+ , value = egName ["Server"] "methodUnimplemented"
+ }
+ ]
+ | P.Method
+ { name=methodName
+ , paramType
+ , resultType
+ }
+ <- methods
+ ]
+ }
+
+
+-- | Define the export_Foo function for the interface.
+ifaceExportFn :: Word64 -> P.Interface -> Decl
+ifaceExportFn thisMod iface@P.IFace { name=Name.CapnpQ{ local }, ancestors } =
+ DcValue
+ { typ = TCtx
+ [TApp (TLName (Name.mkSub local "server_")) [tStd_ "IO", tuName "a"]]
+ (TFn
+ [ tgName ["Supervisors"] "Supervisor"
+ , tuName "a"
+ , TApp (tgName ["STM"] "STM") [TLName local]
+ ]
+ )
+ , def = DfValue
+ { name = Name.UnQ $ "export_" <> Name.renderLocalQ local
+ , params = [PVar "sup_", PVar "server_"]
+ , value = EFApp (ELName local)
+ [ EApp (egName ["Rpc"] "export")
+ [ euName "sup_"
+ , ERecord (egName ["Server"] "ServerOps")
+ [ ( "handleStop"
+ , ePureUnit
+ ) -- TODO
+ , ( "handleCall"
+ , ELambda [PVar "interfaceId_", PVar "methodId_"] $
+ ECase (euName "interfaceId_") $
+ [ ( PInt (fromIntegral interfaceId)
+ , ECase (euName "methodId_") $
+ [ ( PInt i
+ , EApp
+ (egName ["Server"] "toUntypedHandler")
+ [ let methodName = mkMethodName ifaceName mname in
+ EApp
+ (if thisMod == ifaceMod
+ then euName methodName
+ else egName (pureModule ifaceMod) (Name.unQToLocal methodName)
+ )
+ [euName "server_"]
+ ]
+ )
+ | (i, P.Method{name=mname}) <- zip [0..] methods
+ ]
+ ++
+ [ ( PVar "_"
+ , egName ["Server"] "methodUnimplemented"
+ )
+ ]
+ )
+ | P.IFace
+ { name = Name.CapnpQ{local=ifaceName, fileId=ifaceMod}
+ , interfaceId
+ , methods
+ }
+ <- iface:ancestors
+ ]
+ ++
+ [ ( PVar "_"
+ , egName ["Server"] "methodUnimplemented"
+ )
+ ]
+ )
+ ]
+ ]
+ ]
+ }
+ }
+
+-- | Declare instances for clients for this interface.
+ifaceInstances :: Word64 -> P.Interface -> [Decl]
+ifaceInstances thisMod iface@P.IFace{ name=Name.CapnpQ{local=name} } =
+ [ instance_ [] ["Rpc"] "IsClient" [TLName name]
+ [ iValue "fromClient" [] (ELName name)
+ , iValue "toClient" [PLCtor name [PVar "client"]] (euName "client")
+ ]
+ , instance_ [] ["Classes"] "FromPtr" [tuName "msg", TLName name]
+ [ iValue "fromPtr" [] (egName ["RpcHelpers"] "isClientFromPtr")
+ ]
+ , instance_ [] ["Classes"] "ToPtr" [tuName "s", TLName name]
+ [ iValue "toPtr" [] (egName ["RpcHelpers"] "isClientToPtr")
+ ]
+ , instance_ [] ["Classes"] "Decerialize" [TLName name]
+ [ iType "Cerial" [tuName "msg", TLName name] $
+ TApp (tgName (rawModule thisMod) name) [tuName "msg"]
+ , iValue "decerialize"
+ [ pgName (rawModule thisMod) (Name.mkSub name "newtype_") [PVar "maybeCap"]
+ ]
+ (ECase (euName "maybeCap")
+ [ (PGCtor (std_ "Nothing") []
+ , EApp
+ (eStd_ "pure")
+ [ EApp (ELName name) [egName ["Message"] "nullClient"]
+ ]
+ )
+ , (PGCtor (std_ "Just") [PVar "cap"]
+ , EFApp
+ (ELName name)
+ [ EApp (egName ["Untyped"] "getClient") [euName "cap"]]
+ )
+ ]
+ )
+ ]
+ , instance_ [] ["Classes"] "Cerialize" [TLName name]
+ [ iValue "cerialize" [PVar "msg", PLCtor name [PVar "client"]] $
+ EFApp
+ (egName (rawModule thisMod) (Name.mkSub name "newtype_"))
+ [ EFApp
+ (eStd_ "Just")
+ [EApp (egName ["Untyped"] "appendCap") [euName "msg", euName "client"]]
+ ]
+ ]
+ ]
+ ++
+ ifaceServerInstances thisMod iface
+
+-- | Generate a reference to a type defined in a pure module given:
+--
+-- * The id of the module we're in (thisMod)
+-- * The id of the module in which the type is defined (targetMod)
+-- * The local name of the type.
+pureTName :: Word64 -> Word64 -> Name.LocalQ -> Type
+pureTName thisMod targetMod local
+ | thisMod == targetMod = TLName local
+ | otherwise = tgName (pureModule targetMod) local
+
+-- | Instance declarations for this interface's client for its *'server_ class
+-- and those of its ancestors.
+ifaceServerInstances :: Word64 -> P.Interface -> [Decl]
+ifaceServerInstances thisMod iface@P.IFace{ name=Name.CapnpQ{local=name}, ancestors } =
+ map go (iface:ancestors)
+ where
+ go P.IFace { name=Name.CapnpQ{local, fileId}, interfaceId, methods } =
+ let className = Name.mkSub local "server_"
+ classType = pureTName thisMod fileId className
+ in
+ -- Can't use 'instance_' here, because we don't know ahead of time what
+ -- module the class is in.
+ DcInstance
+ { ctx = []
+ , typ =
+ TApp classType [tStd_ "IO", TLName name]
+ , defs =
+ [ let methodName = mkMethodName local mname in
+ iValue methodName [PLCtor name [PVar "client"]] $
+ EApp
+ (egName ["Rpc"] "clientMethodHandler")
+ [ EInt $ fromIntegral interfaceId
+ , EInt i
+ , euName "client"
+ ]
+ | (i, P.Method{name=mname}) <- zip [0..] methods
+ ]
+ }
+
+-- | Generate declarations for a constant.
+constToDecls :: Word64 -> P.Constant -> [Decl]
+constToDecls thisMod P.Constant { name, value } = case value of
+ C.PtrValue ty _ ->
+ -- Generated code parses the corresponding constant from the raw
+ -- module.
+ [ DcValue
+ { typ = typeToType thisMod (C.PtrType ty)
+ , def = DfValue
+ { name = Name.localToUnQ name
+ , params = []
+ , value = EApp
+ (egName ["GenHelpersPure"] "toPurePtrConst")
+ [egName (rawModule thisMod) name]
+ }
+ }
+ ]
+ -- For these two we just re-export the constant from the raw module, so no
+ -- need to do anything here:
+ C.WordValue _ _ -> []
+ C.VoidValue -> []
+
+mkMethodName :: Name.LocalQ -> Name.UnQ -> Name.UnQ
+mkMethodName typeName methodName = Name.valueName $ Name.mkSub typeName methodName
+
+-- | Arguments to 'marshalField'
+data MarshalField = MarshalField
+ { thisMod :: !Word64
+ -- ^ The id for the module we're generating
+ , into :: Name.UnQ
+ -- ^ An variable holding the destination for the marshalled data.
+ , localQField :: Name.LocalQ
+ -- ^ The name of the field to marshal, qualified within the current module.
+ , from :: Name.UnQ
+ -- ^ A variable holding the value to marshal
+ , type_ :: C.Type Name.CapnpQ
+ , inUnion :: !Bool
+ -- ^ whether the parent of this field is a union
+ }
+
+marshalField :: MarshalField -> Exp
+marshalField MarshalField{thisMod, into, localQField, from, type_, inUnion} =
+ let setter = egName (rawModule thisMod) $ Name.unQToLocal (Name.setterName localQField)
+ getter = egName (rawModule thisMod) $ Name.unQToLocal (Name.getterName localQField)
+ in case type_ of
+ C.PtrType _ ->
+ EBind
+ (EApp
+ (egName ["Classes"] "cerialize")
+ [ EApp (egName ["Untyped"] "message") [euName "raw_"]
+ , euName from
+ ]
+ )
+ (EApp setter [euName into])
+ C.VoidType ->
+ ePureUnit
+ C.WordType _ ->
+ EApp setter [euName into, euName from]
+ C.CompositeType _ -> EDo
+ (if Name.getUnQ localQField == "union'" then
+ -- Anonymous union; has the same Cerial as us. Just delegate.
+ []
+ else if inUnion then
+ [ DoBind into $ EApp setter [euName into] ]
+ else
+ [ DoBind into $ EApp getter [euName into] ]
+ )
+ (EApp (egName ["Classes"] "marshalInto") [euName into, euName from])
+
+fieldToField :: Word64 -> P.Field -> (Name.UnQ, Type)
+fieldToField thisMod P.Field{name, type_} = (name, typeToType thisMod type_)
+
+typeToType :: Word64 -> C.Type Name.CapnpQ -> Type
+typeToType _thisMod C.VoidType =
+ TUnit
+typeToType _thisMod (C.WordType (C.PrimWord ty)) =
+ TPrim ty
+typeToType _thisMod (C.WordType (C.EnumType Name.CapnpQ{local, fileId})) =
+ -- Enums are just re-exported from the raw module, we should still
+ -- refer to them qualified even if they're in the file we're generated
+ -- from:
+ tgName (rawModule fileId) local
+typeToType thisMod (C.CompositeType (C.StructType n)) =
+ nameToType thisMod n
+typeToType thisMod (C.PtrType (C.PtrComposite (C.StructType n))) =
+ nameToType thisMod n
+typeToType thisMod (C.PtrType (C.ListOf ty)) =
+ TApp (tgName ["V"] "Vector") [typeToType thisMod ty]
+typeToType _thisMod (C.PtrType (C.PrimPtr C.PrimText)) =
+ tgName ["T"] "Text"
+typeToType _thisMod (C.PtrType (C.PrimPtr C.PrimData)) =
+ tgName ["BS"] "ByteString"
+typeToType _thisMod (C.PtrType (C.PrimPtr (C.PrimAnyPtr _))) =
+ -- TODO: distinguish different pointer types.
+ TApp (tStd_ "Maybe") [tgName ["UntypedPure"] "Ptr"]
+typeToType thisMod (C.PtrType (C.PtrInterface n)) =
+ nameToType thisMod n
+
+nameToType :: Word64 -> Name.CapnpQ -> Type
+nameToType thisMod Name.CapnpQ{local, fileId}
+ | thisMod == fileId = TLName local
+ | otherwise = tgName (pureModule fileId) local
+
+rawModule :: Word64 -> [T.Text]
+rawModule modId =
+ ["Capnp", "Gen", "ById", T.pack $ printf "X%x" modId]
+
+pureModule :: Word64 -> [T.Text]
+pureModule modId =
+ rawModule modId ++ ["Pure"]
diff --git a/cmd/capnpc-haskell/Trans/RawToHaskell.hs b/cmd/capnpc-haskell/Trans/RawToHaskell.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/RawToHaskell.hs
@@ -0,0 +1,866 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Trans.RawToHaskell (fileToModules) where
+
+import Data.Word
+
+import Data.Maybe (fromJust)
+import Data.String (fromString)
+import GHC.Exts (fromList)
+
+import qualified Data.Text as T
+
+import IR.Haskell
+import Trans.ToHaskellCommon
+
+import qualified Capnp
+import qualified Capnp.Untyped.Pure as Untyped
+
+import qualified IR.Common as C
+import qualified IR.Name as Name
+import qualified IR.Raw as Raw
+
+tMutMsg :: Type
+tMutMsg = TApp (tgName ["Message"] "MutMsg" ) [TVar "s"]
+
+tConstMsg :: Type
+tConstMsg = tgName ["Message"] "ConstMsg"
+
+fileToModules :: Raw.File -> [Module]
+fileToModules file =
+ [ fileToMainModule file
+ , fileToModuleAlias file
+ ]
+
+fileToModuleAlias :: Raw.File -> Module
+fileToModuleAlias Raw.File{fileName, fileId} =
+ let reExport = ["Capnp", "Gen"] ++ makeModName fileName
+ in Module
+ { modName = idToModule fileId
+ , modLangPragmas = []
+ , modExports = Just [ExportMod reExport]
+ , modImports = [ ImportAll { parts = reExport } ]
+ , modDecls = []
+ }
+
+fileToMainModule :: Raw.File -> Module
+fileToMainModule Raw.File{fileName, fileId, decls} =
+ fixImports $ Module
+ { modName = ["Capnp", "Gen"] ++ makeModName fileName
+ , modLangPragmas =
+ [ "FlexibleContexts"
+ , "FlexibleInstances"
+ , "MultiParamTypeClasses"
+ , "TypeFamilies"
+ , "DeriveGeneric"
+ , "OverloadedStrings"
+ ]
+ , modExports = Nothing
+ , modImports =
+ [ imp ["Capnp", "Message"] "Message"
+ , imp ["Capnp", "Untyped"] "Untyped"
+ , imp ["Capnp", "Basics"] "Basics"
+ , imp ["Capnp", "GenHelpers"] "GenHelpers"
+ , imp ["Capnp", "Classes"] "Classes"
+ , imp ["GHC", "Generics"] "Generics"
+
+ -- So we can treat 'Word1' the same as 'Word16' etc.
+ , imp ["Capnp", "Bits"] "Std_"
+
+ , imp ["Data", "Maybe"] "Std_"
+ , imp ["Capnp", "GenHelpers", "ReExports", "Data", "ByteString"] "BS"
+ ]
+ , modDecls = concatMap (declToDecls fileId) decls
+ }
+ where
+ imp parts importAs = ImportAs {parts, importAs}
+
+declToDecls :: Word64 -> Raw.Decl -> [Decl]
+declToDecls thisMod Raw.UnionVariant{parentTypeCtor, tagOffset, unionDataCtors} =
+ let unknownCtor = Name.mkSub parentTypeCtor "unknown'"
+ typeCtor = Name.mkSub parentTypeCtor ""
+ in
+ [ DcData Data
+ { dataName = Name.localToUnQ typeCtor
+ , dataNewtype = False
+ , typeArgs = [TVar "msg"]
+ , dataVariants =
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ dataCtor
+ , dvArgs = APos $
+ case locType of
+ C.VoidField ->
+ []
+ _ ->
+ [ typeToType thisMod (C.fieldType locType) (TVar "msg") ]
+ }
+ | Raw.Variant{name=dataCtor, locType} <- unionDataCtors
+ ]
+ ++
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ unknownCtor
+ , dvArgs = APos [ TPrim $ C.PrimInt $ C.IntType C.Unsigned C.Sz16 ]
+ }
+ ]
+ , derives = []
+ }
+ , instance_ [] ["Classes"] "FromStruct" [TVar "msg", TApp (TLName typeCtor) [TVar "msg"]]
+ [ iValue "fromStruct" [PVar "struct"] $ EDo
+ [ DoBind "tag"
+ (EApp
+ (egName ["GenHelpers"] "getTag")
+ [ ELName "struct"
+ , EInt (fromIntegral tagOffset)
+ ]
+ )
+ ]
+ (ECase (ELName "tag") $
+ [ ( PInt $ fromIntegral tagValue
+ , case locType of
+ C.VoidField ->
+ EApp (eStd_ "pure") [ELName name]
+ C.HereField _ ->
+ EFApp
+ (ELName name)
+ [ EApp
+ (egName ["Classes"] "fromStruct")
+ [ELName "struct"]
+ ]
+ C.DataField loc _ ->
+ EFApp
+ (ELName name)
+ [eGetWordField (ELName "struct") loc]
+ C.PtrField idx _ ->
+ EFApp
+ (ELName name)
+ [ EDo
+ [DoBind "ptr" $ EApp
+ (egName ["Untyped"] "getPtr")
+ [ EInt $ fromIntegral idx
+ , ELName "struct"
+ ]
+ ]
+ (EApp
+ (egName ["Classes"] "fromPtr")
+ [ EApp
+ (egName ["Untyped"] "message")
+ [ELName "struct"]
+ , ELName "ptr"
+ ]
+ )
+ ]
+ )
+ | Raw.Variant{name, tagValue, locType} <- unionDataCtors
+ ] ++
+ [ ( PVar "_"
+ , EApp
+ (eStd_ "pure")
+ [ EApp
+ (ELName unknownCtor)
+ [ EApp
+ (eStd_ "fromIntegral")
+ [ELName "tag"]
+ ]
+ ]
+ )
+ ]
+ )
+ ]
+ ]
+declToDecls _thisMod Raw.Enum{typeCtor, dataCtors} =
+ let listCtor = Name.mkSub typeCtor "List_"
+ unknownCtor = Name.mkSub typeCtor "unknown'"
+ in
+ [ DcData Data
+ { dataName = Name.localToUnQ typeCtor
+ , dataNewtype = False
+ , typeArgs = []
+ , dataVariants =
+ map enumerantToVariant dataCtors
+ ++
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ unknownCtor
+ , dvArgs = APos
+ [ TPrim $ C.PrimInt $ C.IntType C.Unsigned C.Sz16 ]
+ }
+ ]
+ , derives =
+ [ "Std_.Show"
+ , "Std_.Read"
+ , "Std_.Eq"
+ , "Generics.Generic"
+ ]
+ }
+ , mkIsWordInstance typeCtor dataCtors unknownCtor
+ -- An Enum instance that just wraps the IsWord instance:
+ , instance_ [] ["Std_"] "Enum" [TLName typeCtor]
+ [ iValue "fromEnum" [PVar "x"] $
+ EApp
+ (eStd_ "fromIntegral")
+ [ EApp
+ (egName ["Classes"] "toWord")
+ [ELName "x"]
+ ]
+ , iValue "toEnum" [PVar "x"] $
+ EApp
+ (egName ["Classes"] "fromWord")
+ [ EApp
+ (eStd_ "fromIntegral")
+ [ELName "x"]
+ ]
+ ]
+ -- lists:
+ , instance_ [] ["Basics"] "ListElem" [TVar "msg", TLName typeCtor]
+ [ IdData Data
+ { dataName = "List"
+ , typeArgs =
+ [ TVar "msg"
+ , TLName typeCtor
+ ]
+ , dataVariants =
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ listCtor
+ , dvArgs = APos
+ [ TApp
+ (tgName ["Untyped"] "ListOf")
+ [ TVar "msg"
+ , tStd_ "Word16"
+ ]
+ ]
+ }
+ ]
+ , derives = []
+ , dataNewtype = True
+ }
+ , iValue "index" [PVar "i", PLCtor listCtor [PVar "l"]] $ EFApp
+ (egName ["Classes"] "fromWord")
+ [ EFApp
+ (eStd_ "fromIntegral")
+ [ EApp
+ (egName ["Untyped"] "index")
+ [ ELName "i"
+ , ELName "l"
+ ]
+ ]
+ ]
+ , iValue "listFromPtr" [PVar "msg", PVar "ptr"] $ EFApp
+ (ELName listCtor)
+ [ EApp
+ (egName ["Classes"] "fromPtr")
+ [ ELName "msg"
+ , ELName "ptr"
+ ]
+ ]
+ , iValue "toUntypedList" [PLCtor listCtor [PVar "l"]] $ EApp
+ (egName ["Untyped"] "List16")
+ [ELName "l"]
+ , iValue "length" [PLCtor listCtor [PVar "l"]] $ EApp
+ (egName ["Untyped"] "length")
+ [ELName "l"]
+ ]
+ , instance_ [] ["Classes"] "MutListElem" [TVar "s", TLName typeCtor]
+ [ iValue
+ "setIndex"
+ [PVar "elt", PVar "i", PLCtor listCtor [PVar "l"]] $
+ EApp
+ (egName ["Untyped"] "setIndex")
+ [ EApp
+ (eStd_ "fromIntegral")
+ [ EApp (egName ["Classes"] "toWord") [ELName "elt"]
+ ]
+ , ELName "i"
+ , ELName "l"
+ ]
+ , iValue "newList" [PVar "msg", PVar "size"] $ EFApp
+ (ELName listCtor)
+ [ EApp
+ (egName ["Untyped"] "allocList16")
+ [ ELName "msg"
+ , ELName "size"
+ ]
+ ]
+ ]
+ ]
+ where
+ enumerantToVariant variantName =
+ DataVariant
+ { dvCtorName =
+ Name.localToUnQ variantName
+ , dvArgs = APos []
+ }
+declToDecls _thisMod Raw.InterfaceWrapper{typeCtor} =
+ let dataCtor = Name.mkSub typeCtor "newtype_" in
+ [ newtypeWrapper typeCtor ["msg"] $ TApp
+ (tStd_ "Maybe")
+ [ TApp
+ (tgName ["Untyped"] "Cap")
+ [TVar "msg"]
+ ]
+ , wrapperFromPtr typeCtor dataCtor
+ , instance_ [] ["Classes"] "ToPtr"
+ [ TVar "s"
+ , TApp (TLName typeCtor) [TApp (tgName ["Message"] "MutMsg") [TVar "s"]]
+ ]
+ [ iValue "toPtr" [PVar "msg", PLCtor dataCtor [PGCtor (std_ "Nothing") []]]
+ (EApp (eStd_ "pure") [eStd_ "Nothing"])
+ , iValue "toPtr" [PVar "msg", PLCtor dataCtor [PGCtor (std_ "Just") [PVar "cap"]]]
+ (EApp
+ (eStd_ "pure")
+ [ EApp
+ (eStd_ "Just")
+ [ EApp
+ (egName ["Untyped"] "PtrCap")
+ [ELName "cap"]
+ ]
+ ]
+ )
+ ]
+ ]
+declToDecls _thisMod Raw.StructWrapper{typeCtor} =
+ let dataCtor = Name.mkSub typeCtor "newtype_" in
+ [ newtypeWrapper typeCtor ["msg"] $ TApp
+ (tgName ["Untyped"] "Struct")
+ [TVar "msg"]
+
+ -- There are several type classes that are defined for all structs:
+ , instance_ [] ["Untyped"] "TraverseMsg" [TLName typeCtor]
+ [ iValue "tMsg" [PVar "f", PLCtor dataCtor [PVar "s"]] $ EFApp
+ (ELName dataCtor)
+ [EApp (egName ["Untyped"] "tMsg") [ELName "f", ELName "s"]]
+ ]
+ , instance_ [] ["Classes"] "FromStruct"
+ [ TVar "msg", TApp (TLName typeCtor) [TVar "msg"]
+ ]
+ [ iValue "fromStruct" [PVar "struct"] $ EApp
+ (eStd_ "pure")
+ [EApp (ELName dataCtor) [ELName "struct"]]
+ ]
+ , instance_ [] ["Classes"] "ToStruct"
+ [TVar "msg", TApp (TLName typeCtor) [TVar "msg"]]
+ [ iValue "toStruct" [PLCtor dataCtor [PVar "struct"]]
+ (ELName "struct")
+ ]
+ , instance_ [] ["Untyped"] "HasMessage" [TApp (TLName typeCtor) [TVar "msg"]]
+ [ IdType $ TypeAlias
+ "InMessage"
+ [ TApp (TLName typeCtor) [TVar "msg"] ]
+ (TVar "msg")
+ , iValue "message" [PLCtor dataCtor [PVar "struct"]]
+ (EApp (egName ["Untyped"] "message") [ELName "struct"])
+ ]
+ , instance_ [] ["Untyped"] "MessageDefault" [TApp (TLName typeCtor) [TVar "msg"]]
+ [ iValue "messageDefault" [PVar "msg"] $ EApp
+ (ELName dataCtor)
+ [ EApp
+ (egName ["Untyped"] "messageDefault")
+ [ELName "msg"]
+ ]
+ ]
+ ]
+declToDecls _thisMod Raw.StructInstances{typeCtor, dataWordCount, pointerCount} =
+ let listCtor = Name.mkSub typeCtor "List_"
+ dataCtor = Name.mkSub typeCtor "newtype_"
+ in
+ [ wrapperFromPtr typeCtor dataCtor
+ , instance_ [] ["Classes"] "ToPtr"
+ [ TVar "s"
+ , TApp
+ (TLName typeCtor)
+ [TApp (tgName ["Message"] "MutMsg") [TVar "s"]]
+ ]
+ [ iValue
+ "toPtr"
+ [PVar "msg", PLCtor dataCtor [PVar "struct"]]
+ (EApp
+ (egName ["Classes"] "toPtr")
+ [ ELName "msg"
+ , ELName "struct"
+ ]
+ )
+ ]
+ , instance_ [] ["Classes"] "Allocate"
+ [ TVar "s"
+ , TApp
+ (TLName typeCtor)
+ [TApp (tgName ["Message"] "MutMsg") [TVar "s"]]
+ ]
+ [ iValue "new" [PVar "msg"] $ EFApp
+ (ELName dataCtor)
+ [ EApp
+ (egName ["Untyped"] "allocStruct")
+ [ ELName "msg"
+ , EInt $ fromIntegral dataWordCount
+ , EInt $ fromIntegral pointerCount
+ ]
+ ]
+ ]
+ , instance_ [] ["Basics"] "ListElem"
+ [ TVar "msg"
+ , TApp
+ (TLName typeCtor)
+ [TVar "msg"]
+ ]
+ [ IdData Data
+ { dataName = "List"
+ , typeArgs =
+ [ TVar "msg"
+ , TApp
+ (TLName typeCtor)
+ [TVar "msg"]
+ ]
+ , dataVariants =
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ listCtor
+ , dvArgs = APos
+ [ TApp
+ (tgName ["Untyped"] "ListOf")
+ [ TVar "msg"
+ , TApp
+ (tgName ["Untyped"] "Struct")
+ [TVar "msg"]
+ ]
+ ]
+ }
+ ]
+ , derives = []
+ , dataNewtype = True
+ }
+ , iValue "listFromPtr" [PVar "msg", PVar "ptr"] $ EFApp
+ (ELName listCtor)
+ [ EApp
+ (egName ["Classes"] "fromPtr")
+ [ELName "msg", ELName "ptr"]
+ ]
+ , iValue "toUntypedList" [PLCtor listCtor [PVar "l"]] $ EApp
+ (egName ["Untyped"] "ListStruct")
+ [ELName "l"]
+ , iValue "length" [PLCtor listCtor [PVar "l"]] $ EApp
+ (egName ["Untyped"] "length")
+ [ELName "l"]
+ , iValue "index" [PVar "i", PLCtor listCtor [PVar "l"]] $ EDo
+ [ DoBind "elt" $ EApp
+ (egName ["Untyped"] "index")
+ [ ELName "i"
+ , ELName "l"
+ ]
+ ]
+ ( EApp
+ (egName ["Classes"] "fromStruct")
+ [ELName "elt"]
+ )
+ ]
+ , instance_ [] ["Basics"] "MutListElem"
+ [ TVar "s"
+ , TApp
+ (TLName typeCtor)
+ [ TApp (tgName ["Message"] "MutMsg") [TVar "s"] ]
+ ]
+ [ iValue "setIndex"
+ [ PLCtor dataCtor [PVar "elt"]
+ , PVar "i"
+ , PLCtor listCtor [PVar "l"]
+ ]
+ (EApp
+ (egName ["Untyped"] "setIndex")
+ [ ELName "elt"
+ , ELName "i"
+ , ELName "l"
+ ]
+ )
+ , iValue "newList" [PVar "msg", PVar "len"] $ EFApp
+ (ELName listCtor)
+ [ EApp
+ (egName ["Untyped"] "allocCompositeList")
+ [ ELName "msg"
+ , EInt $ fromIntegral dataWordCount
+ , EInt $ fromIntegral pointerCount
+ , ELName "len"
+ ]
+ ]
+ ]
+ ]
+declToDecls thisMod Raw.Getter{fieldName, fieldLocType, containerType} =
+ let containerDataCtor = Name.mkSub containerType "newtype_" in
+ [ DcValue
+ { typ = TCtx
+ [readCtx "m" "msg"]
+ (TFn
+ [ TApp
+ (TLName containerType)
+ [ TVar "msg" ]
+ , TApp
+ (TVar "m")
+ [ typeToType thisMod (C.fieldType fieldLocType) (TVar "msg")
+ ]
+ ]
+ )
+ , def = DfValue
+ { name = Name.getterName fieldName
+ , params = [PLCtor containerDataCtor [PVar "struct"]]
+ , value = case fieldLocType of
+ C.DataField dataLoc _ ->
+ eGetWordField (ELName "struct") dataLoc
+ C.PtrField idx _ -> EDo
+ [ DoBind "ptr" $ EApp
+ (egName ["Untyped"] "getPtr")
+ [ EInt (fromIntegral idx)
+ , ELName "struct"
+ ]
+ ]
+ (EApp
+ (egName ["Classes"] "fromPtr")
+ [ EApp
+ (egName ["Untyped"] "message")
+ [ELName "struct"]
+ , ELName "ptr"
+ ]
+ )
+ C.HereField _ ->
+ EApp
+ (egName ["Classes"] "fromStruct")
+ [ELName "struct"]
+ C.VoidField ->
+ EApp
+ (eStd_ "pure")
+ [ETup []]
+ }
+ }
+ ]
+declToDecls thisMod Raw.Setter{fieldName, fieldLocType, containerType, tag} =
+ -- XXX: the way this is organized is a little gross; conceptually we have
+ -- two kinds of setters:
+ --
+ -- * Those that actually take an argument, and return unit.
+ -- * Those that are groups, in which case they don't take an argument,
+ -- and return the value.
+ --
+ -- The latter are only actually useful if the group is a union member,
+ -- but we generate them regardless.
+ --
+ -- The below is a little ugly in that there's a bit to much conditional
+ -- logic strewn about because of the above.
+ let containerDataCtor = Name.mkSub containerType "newtype_"
+ fieldType = typeToType
+ thisMod
+ (C.fieldType fieldLocType)
+ tMutMsg
+ in
+ [ DcValue
+ { typ = TCtx
+ [rwCtx "m" "s"]
+ (case fieldLocType of
+ C.HereField _ -> TFn
+ [ TApp
+ (TLName containerType)
+ [tMutMsg]
+ , TApp (TVar "m") [fieldType]
+ ]
+ C.VoidField -> TFn
+ -- We don't need to pass in the redundant () value.
+ [ TApp
+ (TLName containerType)
+ [tMutMsg]
+ , TApp (TVar "m") [fieldType]
+ ]
+ _ -> TFn
+ [ TApp
+ (TLName containerType)
+ [tMutMsg]
+ , fieldType
+ , TApp (TVar "m") [TUnit]
+ ]
+ )
+ , def = DfValue
+ { name = Name.setterName fieldName
+ , params =
+ case fieldLocType of
+ C.HereField _ ->
+ [ PLCtor containerDataCtor [PVar "struct"] ]
+ C.VoidField ->
+ [ PLCtor containerDataCtor [PVar "struct"] ]
+ _ ->
+ [ PLCtor containerDataCtor [PVar "struct"]
+ , PVar "value"
+ ]
+ , value =
+ case tag of
+ Just tagSetter ->
+ EDo
+ [DoE $ eSetTag tagSetter]
+ (eSetValue fieldLocType)
+ Nothing ->
+ eSetValue fieldLocType
+ }
+ }
+ ]
+declToDecls _thisMod Raw.HasFn{fieldName, containerType, ptrIndex} =
+ let containerDataCtor = Name.mkSub containerType "newtype_" in
+ [ DcValue
+ { typ = TCtx
+ [readCtx "m" "msg"]
+ (TFn
+ [ TApp (TLName containerType) [ TVar "msg" ]
+ , TApp (TVar "m") [tStd_ "Bool"]
+ ]
+ )
+ , def = DfValue
+ { name = Name.hasFnName fieldName
+ , params = [PLCtor containerDataCtor [PVar "struct"]]
+ , value = EFApp (eStd_ "isJust")
+ [ EApp
+ (egName ["Untyped"] "getPtr")
+ [ EInt $ fromIntegral ptrIndex
+ , ELName "struct"
+ ]
+ ]
+ }
+ }
+ ]
+declToDecls thisMod Raw.NewFn{fieldName, containerType, fieldLocType, newFnType} =
+ -- TODO(cleanup): I(zenhack) am a little unhappy with having several case
+ -- expressions to distinguish struct vs non-struct; we should refactor.
+ let fieldType = typeToType
+ thisMod
+ (C.fieldType fieldLocType)
+ tMutMsg
+ in
+ [ DcValue
+ { typ = TCtx
+ [rwCtx "m" "s"]
+ (TFn $ concat
+ [ case newFnType of
+ -- length
+ Raw.NewStruct -> []
+ _ -> [tStd_ "Int"]
+ , [TApp (TLName containerType) [tMutMsg]]
+ , [TApp (TVar "m") [fieldType]]
+ ]
+ )
+ , def = DfValue
+ { name = Name.newFnName fieldName
+ , params =
+ case newFnType of
+ Raw.NewStruct -> [PVar "struct"]
+ _ -> [PVar "len", PVar "struct"]
+ , value = EDo
+ [ DoBind "result" $
+ let message = EApp (egName ["Untyped"] "message") [ELName "struct"]
+ in case newFnType of
+ Raw.NewStruct -> EApp (egName ["Classes"] "new") [message]
+ Raw.NewList -> EApp (egName ["Classes"] "newList") [message, ELName "len"]
+ Raw.NewText -> EApp (egName ["Basics"] "newText") [message, ELName "len"]
+ Raw.NewData -> EApp (egName ["Basics"] "newData") [message, ELName "len"]
+ , DoE $ EApp
+ (ELName $ Name.mkLocal Name.emptyNS (Name.setterName fieldName))
+ [ ELName "struct"
+ , ELName "result"
+ ]
+ ]
+ (EApp (eStd_ "pure") [ELName "result"])
+ }
+ }
+ ]
+declToDecls _thisMod Raw.Constant{ name, value=C.VoidValue } =
+ [ DcValue
+ { typ = TUnit
+ , def = DfValue
+ { name = Name.localToUnQ name
+ , params = []
+ , value = ETup []
+ }
+ }
+ ]
+declToDecls thisMod Raw.Constant{ name, value=C.WordValue ty val } =
+ [ DcValue
+ { typ = typeToType thisMod (C.WordType ty) tConstMsg
+ , def = DfValue
+ { name = Name.localToUnQ name
+ , params = []
+ , value = EApp
+ (egName ["Classes"] "fromWord")
+ [EInt $ fromIntegral val]
+ }
+ }
+ ]
+declToDecls thisMod Raw.Constant{ name, value=C.PtrValue ty val } =
+ [ DcValue
+ { typ = typeToType thisMod (C.PtrType ty) tConstMsg
+ , def = DfValue
+ { name = Name.localToUnQ name
+ , params = []
+ , value = EApp
+ (egName ["GenHelpers"] "getPtrConst")
+ [ETypeAnno (EBytes (makePtrBytes val)) (tgName ["BS"] "ByteString")]
+ }
+ }
+ ]
+ where
+ makePtrBytes ptr =
+ Capnp.msgToLBS $ fromJust $ Capnp.createPure Capnp.defaultLimit $ do
+ msg <- Capnp.newMessage Nothing
+ rootPtr <- Capnp.cerialize msg $ Untyped.Struct
+ (fromList [])
+ (fromList [ptr])
+ Capnp.setRoot rootPtr
+ pure msg
+
+
+eSetValue :: C.FieldLocType Name.CapnpQ -> Exp
+eSetValue = \case
+ C.DataField dataLoc ty ->
+ eSetWordField
+ (ELName "struct")
+ (ETypeAnno
+ (EApp
+ (eStd_ "fromIntegral")
+ [EApp
+ (egName ["Classes"] "toWord")
+ [ELName "value"]
+ ]
+ )
+ (tStd_ $ fromString $ "Word" <> show (C.dataFieldSize ty))
+ )
+ dataLoc
+ C.PtrField idx _ -> EDo
+ [ DoBind "ptr" $ EApp
+ (egName ["Classes"] "toPtr")
+ [ EApp
+ (egName ["Untyped"] "message")
+ [ELName "struct"]
+ , ELName "value"
+ ]
+ ]
+ (EApp
+ (egName ["Untyped"] "setPtr")
+ [ ELName "ptr"
+ , EInt (fromIntegral idx)
+ , ELName "struct"
+ ]
+ )
+ C.HereField _ ->
+ -- We actually just fetch the field in this case; this only happens for
+ -- groups (and unions, but the tag is handled separately in that case).
+ EApp
+ (egName ["Classes"] "fromStruct")
+ [ELName "struct"]
+ C.VoidField ->
+ EApp
+ (eStd_ "pure")
+ [ETup []]
+
+eSetTag :: Raw.TagSetter -> Exp
+eSetTag Raw.TagSetter{tagOffset, tagValue} =
+ eSetWordField
+ (ELName "struct")
+ (ETypeAnno
+ (EInt $ fromIntegral tagValue)
+ (TPrim $ C.PrimInt $ C.IntType C.Unsigned C.Sz16)
+ )
+ (Raw.tagOffsetToDataLoc tagOffset)
+
+eSetWordField :: Exp -> Exp -> C.DataLoc -> Exp
+eSetWordField struct value C.DataLoc{dataIdx, dataOff, dataDef} =
+ EApp
+ (egName ["GenHelpers"] "setWordField")
+ [ struct
+ , value
+ , EInt $ fromIntegral dataIdx
+ , EInt $ fromIntegral dataOff
+ , EInt $ fromIntegral dataDef
+ ]
+
+-- | Make an instance of the IsWord type class for an enum.
+mkIsWordInstance :: Name.LocalQ -> [Name.LocalQ] -> Name.LocalQ -> Decl
+mkIsWordInstance typeCtor dataCtors unknownCtor =
+ instance_ [] ["Classes"] "IsWord" [TLName typeCtor] $
+ [ iValue "fromWord" [PVar "n"] $
+ ECase
+ (ETypeAnno
+ (EApp (eStd_ "fromIntegral") [euName "n"])
+ (TPrim $ C.PrimInt $ C.IntType C.Unsigned C.Sz16)
+ ) $
+ [ (PInt i, ELName ctor) | (i, ctor) <- zip [0..] dataCtors]
+ ++
+ [ (PVar "tag", EApp (ELName unknownCtor) [euName "tag"]) ]
+ ] ++
+ [ IdValue $ DfValue
+ { name = "toWord"
+ , params = [PLCtor ctor []]
+ , value = EInt i
+ }
+ | (i, ctor) <- zip [0..] dataCtors
+ ] ++
+ [ IdValue $ DfValue
+ { name = "toWord"
+ , params =
+ [ PLCtor unknownCtor [PVar "tag"] ]
+ , value =
+ EApp
+ (eStd_ "fromIntegral")
+ [ELName "tag"]
+ }
+ ]
+
+newtypeWrapper :: Name.LocalQ -> [T.Text] -> Type -> Decl
+newtypeWrapper typeCtor typeArgs wrappedType =
+ DcData Data
+ { dataName = Name.localToUnQ typeCtor
+ , dataNewtype = True
+ , typeArgs = map TVar typeArgs
+ , dataVariants =
+ [ DataVariant
+ { dvCtorName = Name.localToUnQ $ Name.mkSub typeCtor "newtype_"
+ , dvArgs = APos [ wrappedType ]
+ }
+ ]
+ , derives = []
+ }
+
+wrapperFromPtr :: Name.LocalQ -> Name.LocalQ -> Decl
+wrapperFromPtr typeCtor dataCtor =
+ instance_ [] ["Classes"] "FromPtr"
+ [ TVar "msg", TApp (TLName typeCtor) [TVar "msg"] ]
+ [ iValue "fromPtr" [PVar "msg", PVar "ptr"] $ EFApp
+ (ELName dataCtor)
+ [ EApp
+ (egName ["Classes"] "fromPtr")
+ [ ELName "msg"
+ , ELName "ptr"
+ ]
+ ]
+ ]
+
+nameToType :: Word64 -> Name.CapnpQ -> Type
+nameToType thisMod Name.CapnpQ{local, fileId} =
+ if fileId == thisMod
+ then TLName local
+ else tgName
+ (map Name.renderUnQ $ idToModule fileId)
+ local
+
+typeToType :: Word64 -> C.Type Name.CapnpQ -> Type -> Type
+typeToType thisMod ty msgTy = case ty of
+ C.VoidType -> TUnit
+ C.WordType (C.PrimWord ty) -> TPrim ty
+ C.WordType (C.EnumType typeId) -> nameToType thisMod typeId
+ C.PtrType (C.ListOf elt) ->
+ TApp (tgName ["Basics"] "List")
+ [ msgTy
+ , typeToType thisMod elt msgTy
+ ]
+ C.PtrType (C.PrimPtr C.PrimText) ->
+ appV $ tgName ["Basics"] "Text"
+ C.PtrType (C.PrimPtr C.PrimData) ->
+ appV $ tgName ["Basics"] "Data"
+ C.PtrType (C.PtrComposite (C.StructType typeId)) ->
+ appV $ nameToType thisMod typeId
+ C.PtrType (C.PtrInterface typeId) ->
+ appV $ nameToType thisMod typeId
+ C.PtrType (C.PrimPtr (C.PrimAnyPtr _)) ->
+ TApp (tStd_ "Maybe") [appV $ tgName ["Untyped"] "Ptr"]
+ C.CompositeType (C.StructType typeId) ->
+ appV $ nameToType thisMod typeId
+ where
+ appV t = TApp t [msgTy]
diff --git a/cmd/capnpc-haskell/Trans/Stage1ToFlat.hs b/cmd/capnpc-haskell/Trans/Stage1ToFlat.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/Stage1ToFlat.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- Translate from the 'Stage1' IR to the 'Flat' IR.
+--
+-- As the name of the latter suggests, this involves flattening the namepace.
+module Trans.Stage1ToFlat (cgrToCgr) where
+
+import Data.Word
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import qualified IR.Common as C
+import qualified IR.Flat as Flat
+import qualified IR.Name as Name
+import qualified IR.Stage1 as Stage1
+
+type NodeMap = M.Map Word64 Flat.Node
+
+cgrToCgr :: Stage1.CodeGenReq -> Flat.CodeGenReq
+cgrToCgr Stage1.CodeGenReq{allFiles, reqFiles=inFiles} = Flat.CodeGenReq
+ { reqFiles = outFiles
+ , allNodes
+ }
+ where
+ outFiles = map (reqFileToFile fileMap) inFiles
+ fileMap = M.fromList
+ [ (fileId, fileToNodes nodeMap file)
+ | file@Stage1.File{fileId} <- allFiles
+ ]
+ allNodes = concatMap snd (M.toList fileMap)
+ nodeMap = M.fromList [(nodeId, node) | node@Flat.Node{nodeId} <- allNodes]
+
+fileToNodes :: NodeMap -> Stage1.File -> [Flat.Node]
+fileToNodes nodeMap Stage1.File{fileNodes, fileId} =
+ concatMap
+ (\(unQ, node) ->
+ nestedToNodes nodeMap fileId (Name.unQToLocal unQ) node
+ )
+ fileNodes
+
+reqFileToFile :: M.Map Word64 [Flat.Node] -> Stage1.ReqFile -> Flat.File
+reqFileToFile fileMap Stage1.ReqFile{fileName, file=Stage1.File{fileId}} =
+ Flat.File
+ { nodes = fileMap M.! fileId
+ , fileName
+ , fileId
+ }
+
+-- | Generate @'Flat.Node'@s from a 'Stage1.Node' and its local name.
+nestedToNodes :: NodeMap -> Word64 -> Name.LocalQ -> Stage1.Node -> [Flat.Node]
+nestedToNodes
+ nodeMap
+ thisMod
+ localName
+ Stage1.Node
+ { nodeCommon = Stage1.NodeCommon{nodeId, nodeNested}
+ , nodeUnion
+ }
+ =
+ mine ++ kids
+ where
+ kidsNS = Name.localQToNS localName
+ kids = concatMap
+ (\(unQ, node) ->
+ nestedToNodes nodeMap thisMod (Name.mkLocal kidsNS unQ) node
+ )
+ nodeNested
+ name = Name.CapnpQ
+ { local = localName
+ , fileId = thisMod
+ }
+ mine = case nodeUnion of
+ Stage1.NodeEnum enumerants ->
+ [ Flat.Node
+ { name
+ , nodeId
+ , union_ = Flat.Enum enumerants
+ }
+ ]
+ Stage1.NodeStruct struct ->
+ structToNodes nodeMap thisMod nodeId name kidsNS struct
+ Stage1.NodeInterface iface ->
+ interfaceToNodes nodeMap thisMod nodeId name kidsNS iface
+ Stage1.NodeConstant value ->
+ [ Flat.Node
+ { name = Name.CapnpQ
+ { local = Name.unQToLocal $ Name.valueName localName
+ , fileId = thisMod
+ }
+ , nodeId
+ , union_ = Flat.Constant
+ { value = fmap
+ (\Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId}} -> nodeMap M.! nodeId)
+ value
+ }
+ }
+ ]
+ Stage1.NodeOther ->
+ [ Flat.Node
+ { name
+ , nodeId
+ , union_ = Flat.Other
+ }
+ ]
+
+interfaceToNodes :: NodeMap -> Word64 -> Word64 -> Name.CapnpQ -> Name.NS -> Stage1.Interface -> [Flat.Node]
+interfaceToNodes nodeMap thisMod nodeId name kidsNS iface@Stage1.Interface{ methods, supers } =
+ Flat.Node
+ { name
+ , nodeId
+ , union_ = Flat.Interface
+ { methods =
+ [ let Flat.Node{name=paramName} = nodeMap M.! paramId
+ Flat.Node{name=resultName} = nodeMap M.! resultId
+ in Flat.Method
+ { name
+ , paramType = paramName
+ , resultType = resultName
+ }
+ | Stage1.Method
+ { name
+ , paramType=Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId=paramId}}
+ , resultType=Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId=resultId}}
+ }
+ <- methods
+ ]
+ , supers =
+ [ nodeMap M.! nodeId | Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId}} <- supers ]
+ , ancestors =
+ [ nodeMap M.! supId
+ | supId <- S.toList (collectAncestors iface)
+ ]
+ }
+ }
+ : concatMap (methodToNodes nodeMap thisMod kidsNS) methods
+
+structToNodes :: NodeMap -> Word64 -> Word64 -> Name.CapnpQ -> Name.NS -> Stage1.Struct -> [Flat.Node]
+structToNodes
+ nodeMap
+ thisMod
+ nodeId
+ name
+ kidsNS
+ Stage1.Struct
+ { fields
+ , isGroup
+ , dataWordCount
+ , pointerCount
+ , tagOffset
+ } =
+ let
+ mkField fieldUnQ locType =
+ Flat.Field
+ { fieldName = Name.mkSub name fieldUnQ
+ , fieldLocType = fmap
+ (\Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId}} -> nodeMap M.! nodeId)
+ locType
+ }
+ variants =
+ [ Flat.Variant
+ { field = mkField fieldUnQ locType
+ , tagValue
+ }
+ | Stage1.Field{name=fieldUnQ, locType, tag=Just tagValue} <- fields
+ ]
+ commonFields =
+ [ mkField fieldUnQ locType
+ | Stage1.Field{name=fieldUnQ, locType, tag=Nothing} <- fields
+ ]
+ fieldNodes =
+ concatMap (fieldToNodes nodeMap thisMod kidsNS) fields
+
+ commonNode =
+ Flat.Node
+ { name
+ , nodeId
+ , union_ = Flat.Struct
+ { fields = commonFields
+ , union =
+ if null variants then
+ Nothing
+ else
+ Just Flat.Union
+ { variants
+ , tagOffset
+ }
+ , isGroup
+ , dataWordCount
+ , pointerCount
+ }
+ }
+ in
+ commonNode : fieldNodes
+
+fieldToNodes :: NodeMap -> Word64 -> Name.NS -> Stage1.Field -> [Flat.Node]
+fieldToNodes nodeMap thisMod ns Stage1.Field{name, locType} = case locType of
+ C.HereField
+ (C.StructType
+ struct@Stage1.Node
+ { nodeUnion = Stage1.NodeStruct Stage1.Struct{isGroup=True}
+ }
+ ) -> nestedToNodes nodeMap thisMod (Name.mkLocal ns name) struct
+ _ ->
+ []
+
+methodToNodes :: NodeMap -> Word64 -> Name.NS -> Stage1.Method -> [Flat.Node]
+methodToNodes nodeMap thisMod ns Stage1.Method{ name, paramType, resultType } =
+ -- If the parameter and result types are anonymous, we need to generate
+ -- structs for them.
+ let maybeAnon ty suffix =
+ case ty of
+ Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeParent=Nothing}} ->
+ let localName = Name.mkLocal ns name
+ kidsNS = Name.localQToNS localName
+ in
+ nestedToNodes nodeMap thisMod (Name.mkLocal kidsNS suffix) ty
+ _ ->
+ []
+ in
+ maybeAnon paramType "params" ++ maybeAnon resultType "results"
+
+
+-- | Collect the ids of of the ancestors of an interface, not including itself.
+collectAncestors :: Stage1.Interface -> S.Set Word64
+collectAncestors Stage1.Interface{supers} =
+ -- This could be made faster, in that if there are shared ancestors
+ -- (diamonds) we'll traverse them twice, but this is more
+ -- straightforward, and with typical interface hierarchies it shouldn't
+ -- be a huge problem.
+ S.unions $
+ S.fromList [ nodeId | Stage1.Node{nodeCommon=Stage1.NodeCommon{nodeId}} <- supers ]
+ :
+ [ collectAncestors iface | Stage1.Node{nodeUnion=Stage1.NodeInterface iface} <- supers ]
diff --git a/cmd/capnpc-haskell/Trans/ToHaskellCommon.hs b/cmd/capnpc-haskell/Trans/ToHaskellCommon.hs
new file mode 100644
--- /dev/null
+++ b/cmd/capnpc-haskell/Trans/ToHaskellCommon.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+-- Things used by both RawToHaskell and PureToHaskell.
+module Trans.ToHaskellCommon where
+
+import Data.Word
+
+import Data.Char (toUpper)
+import System.FilePath (splitDirectories)
+import Text.Printf (printf)
+
+import qualified Data.Set as S
+import qualified Data.Text as T
+
+import qualified IR.Common as C
+import qualified IR.Name as Name
+
+import IR.Haskell
+
+-- Misc shortcuts for common constructs:
+
+std_ :: Name.UnQ -> Name.GlobalQ
+std_ name = gName ["Std_"] (Name.mkLocal Name.emptyNS name)
+
+eStd_ :: Name.UnQ -> Exp
+eStd_ = EGName . std_
+
+ePureUnit :: Exp
+ePureUnit = EApp (eStd_ "pure") [ETup []]
+
+tStd_ :: Name.UnQ -> Type
+tStd_ = TGName . std_
+
+gName :: [T.Text] -> Name.LocalQ -> Name.GlobalQ
+gName parts local = Name.GlobalQ
+ { globalNS = Name.NS parts
+ , local
+ }
+
+egName :: [T.Text] -> Name.LocalQ -> Exp
+egName parts local = EGName $ gName parts local
+
+euName :: Name.UnQ -> Exp
+euName = ELName . Name.mkLocal Name.emptyNS
+
+tgName :: [T.Text] -> Name.LocalQ -> Type
+tgName parts local = TGName $ gName parts local
+
+pgName :: [T.Text] -> Name.LocalQ -> [Pattern] -> Pattern
+pgName parts local = PGCtor (gName parts local)
+
+tuName :: Name.UnQ -> Type
+tuName = TLName . Name.unQToLocal
+
+iValue :: Name.UnQ -> [Pattern] -> Exp -> InstanceDef
+iValue name params value = IdValue DfValue {name, params, value}
+
+iType :: Name.UnQ -> [Type] -> Type -> InstanceDef
+iType name params value = IdType $ TypeAlias name params value
+
+readCtx :: T.Text -> T.Text -> Type
+readCtx m msg = TApp
+ (tgName ["Untyped"] "ReadCtx")
+ [ TVar m
+ , TVar msg
+ ]
+
+rwCtx :: T.Text -> T.Text -> Type
+rwCtx m s = TApp
+ (tgName ["Untyped"] "RWCtx")
+ [ TVar m
+ , TVar s
+ ]
+
+eGetWordField :: Exp -> C.DataLoc -> Exp
+eGetWordField struct C.DataLoc{dataIdx, dataOff, dataDef} =
+ EApp
+ (egName ["GenHelpers"] "getWordField")
+ [ struct
+ , EInt $ fromIntegral dataIdx
+ , EInt $ fromIntegral dataOff
+ , EInt $ fromIntegral dataDef
+ ]
+
+idToModule :: Word64 -> [Name.UnQ]
+idToModule fileId =
+ ["Capnp", "Gen", "ById", Name.UnQ $ T.pack $ printf "X%x" fileId]
+
+instance_ :: [Type] -> [T.Text] -> Name.LocalQ -> [Type] -> [InstanceDef] -> Decl
+instance_ ctx [] className tys defs = DcInstance
+ { ctx
+ , typ = TApp (TLName className) tys
+ , defs
+ }
+instance_ ctx classNS className tys defs = DcInstance
+ { ctx
+ , typ = TApp (tgName classNS className) tys
+ , defs
+ }
+
+-- | Transform the file path into a valid haskell module name.
+-- TODO: this is a best-effort transformation; it gives good
+-- results on the schema I(zenhack) have found in the wild, but
+-- may fail to generate valid/non-overlapping module names in
+-- all cases.
+--
+-- This generates the bit that is unique to the specific file
+-- name and common to both raw and pure backends, so e.g. for
+-- @myorg/example.capnp@ it generates @["Myorg", "Example"]@.
+makeModName :: FilePath -> [Name.UnQ]
+makeModName fileName =
+ [ Name.UnQ (T.pack (mangleSegment seg)) | seg <- splitDirectories fileName ]
+ where
+ mangleSegment "c++.capnp" = "Cxx"
+ mangleSegment "" = error "Unexpected empty file name"
+ mangleSegment (c:cs) = go (toUpper c : cs) where
+ go ('-':c:cs) = toUpper c : go cs
+ go ".capnp" = ""
+ go [] = ""
+ go (c:cs) = c : go cs
+
+
+-- | Fix the capnp imports of a module, so that they correspond to the
+-- imports actually used in the body of the module and/or export list.
+--
+-- Note that this only looks at imports of the form Capnp.Gen....; other
+-- imports are not touched.
+fixImports :: Module -> Module
+fixImports m@Module{modImports} =
+ let namespaces = S.toList $ S.fromList -- deduplicate
+ [ nsParts
+ | Name.GlobalQ
+ { globalNS = Name.NS nsParts@(map T.unpack -> "Capnp":"Gen":_)
+ }
+ <- S.toList (findGNames m)
+ ]
+ neededImports =
+ [ ImportQual { parts = map Name.UnQ nsParts }
+ | nsParts <- namespaces
+ ]
+ in
+ m { modImports = modImports ++ neededImports }
+
+class HasGNames a where
+ -- | Collect all of the 'Name.GlobalQ's used in the module.
+ --
+ -- This seems like it would be the perfect use case for something
+ -- like syb or similar libraries, but I(zenhack) haven't taken the
+ -- time to fully wrap my head around how to use those yet, so we do
+ -- it the boilerplate-heavy way.
+ findGNames :: a -> S.Set Name.GlobalQ
+
+instance HasGNames Module where
+ findGNames Module{modExports=Just exports, modDecls} =
+ S.unions $ map findGNames exports ++ map findGNames modDecls
+ findGNames Module{modExports=Nothing, modDecls} =
+ S.unions $ map findGNames modDecls
+
+instance HasGNames Export where
+ findGNames (ExportGCtors name) = S.singleton name
+ findGNames (ExportGName name) = S.singleton name
+ findGNames _ = S.empty
+
+instance HasGNames Decl where
+ findGNames (DcData d) = findGNames d
+ findGNames DcValue{typ, def} = findGNames typ `S.union` findGNames def
+ findGNames DcInstance{ctx, typ, defs} = S.unions
+ [ S.unions $ map findGNames ctx
+ , findGNames typ
+ , S.unions $ map findGNames defs
+ ]
+ findGNames DcClass{ctx, decls} =
+ S.unions $ map findGNames ctx ++ map findGNames decls
+
+instance HasGNames DataDecl where
+ findGNames Data{typeArgs, dataVariants} =
+ S.unions $ map findGNames typeArgs ++ map findGNames dataVariants
+
+instance HasGNames ClassDecl where
+ findGNames (CdValueDecl _ ty) = findGNames ty
+ findGNames (CdValueDef d) = findGNames d
+ findGNames (CdMinimal _) = S.empty
+
+instance HasGNames InstanceDef where
+ findGNames (IdValue d) = findGNames d
+ findGNames (IdData d) = findGNames d
+ findGNames (IdType t) = findGNames t
+
+instance HasGNames TypeAlias where
+ findGNames (TypeAlias _ ts t) = S.unions $ map findGNames (t:ts)
+
+instance HasGNames ValueDef where
+ findGNames DfValue{value, params} =
+ S.unions $ findGNames value : map findGNames params
+
+instance HasGNames DataVariant where
+ findGNames DataVariant{dvArgs} = findGNames dvArgs
+
+instance HasGNames DataArgs where
+ findGNames (APos tys) = S.unions $ map findGNames tys
+ findGNames (ARec fields) = S.unions $ map (findGNames . snd) fields
+
+instance HasGNames Type where
+ findGNames (TGName n) = S.singleton n
+ findGNames (TApp t ts) = S.unions $ map findGNames (t:ts)
+ findGNames (TFn ts) = S.unions $ map findGNames ts
+ findGNames (TCtx ts t) = S.unions $ map findGNames (t:ts)
+ findGNames _ = S.empty
+
+instance HasGNames Exp where
+ findGNames (EApp e es) = S.unions $ map findGNames (e:es)
+ findGNames (EFApp e es) = S.unions $ map findGNames (e:es)
+ findGNames (EDo ds e) = S.unions $ findGNames e : map findGNames ds
+ findGNames (EBind x y) = findGNames x `S.union` findGNames y
+ findGNames (ETup es) = S.unions $ map findGNames es
+ findGNames (ECase e arms) = S.unions
+ [ findGNames e
+ , S.unions $ map (findGNames . fst) arms
+ , S.unions $ map (findGNames . snd) arms
+ ]
+ findGNames (ETypeAnno e t) = findGNames e `S.union` findGNames t
+ findGNames (ELambda ps e) = S.unions $ findGNames e : map findGNames ps
+ findGNames (ERecord e fields) = S.unions $ findGNames e : map (findGNames . snd) fields
+ findGNames _ = S.empty
+
+instance HasGNames Do where
+ findGNames (DoBind _ e) = findGNames e
+ findGNames (DoE e) = findGNames e
+
+instance HasGNames Pattern where
+ findGNames (PLCtor _ ps) = S.unions $ map findGNames ps
+ findGNames (PGCtor n ps) = S.unions $ S.singleton n : map findGNames ps
+ findGNames _ = S.empty
diff --git a/core-schema/README.md b/core-schema/README.md
--- a/core-schema/README.md
+++ b/core-schema/README.md
@@ -1,3 +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/`.
+under `../lib/Capnp/Gen`.
diff --git a/core-schema/capnp/json.capnp b/core-schema/capnp/json.capnp
--- a/core-schema/capnp/json.capnp
+++ b/core-schema/capnp/json.capnp
@@ -21,15 +21,15 @@
@0x8ef99297a43a5e34;
-$import "/capnp/c++.capnp".namespace("capnp");
+$import "/capnp/c++.capnp".namespace("capnp::json");
-struct JsonValue {
+struct Value {
union {
null @0 :Void;
boolean @1 :Bool;
number @2 :Float64;
string @3 :Text;
- array @4 :List(JsonValue);
+ array @4 :List(Value);
object @5 :List(Field);
# Standard JSON values.
@@ -48,11 +48,65 @@
struct Field {
name @0 :Text;
- value @1 :JsonValue;
+ value @1 :Value;
}
struct Call {
function @0 :Text;
- params @1 :List(JsonValue);
+ params @1 :List(Value);
}
}
+
+# ========================================================================================
+# Annotations to control parsing. Typical usage:
+#
+# using Json = import "/capnp/compat/json.capnp";
+#
+# And then later on:
+#
+# myField @0 :Text $Json.name("my_field");
+
+annotation name @0xfa5b1fd61c2e7c3d (field, enumerant, method, group, union): Text;
+# Define an alternative name to use when encoding the given item in JSON. This can be used, for
+# example, to use snake_case names where needed, even though Cap'n Proto uses strictly camelCase.
+#
+# (However, because JSON is derived from JavaScript, you *should* use camelCase names when
+# defining JSON-based APIs. But, when supporting a pre-existing API you may not have a choice.)
+
+annotation flatten @0x82d3e852af0336bf (field, group, union): FlattenOptions;
+# Specifies that an aggregate field should be flattened into its parent.
+#
+# In order to flatten a member of a union, the union (or, for an anonymous union, the parent
+# struct type) must have the $jsonDiscriminator annotation.
+#
+# TODO(someday): Maybe support "flattening" a List(Value.Field) as a way to support unknown JSON
+# fields?
+
+struct FlattenOptions {
+ prefix @0 :Text = "";
+ # Optional: Adds the given prefix to flattened field names.
+}
+
+annotation discriminator @0xcfa794e8d19a0162 (struct, union): DiscriminatorOptions;
+# Specifies that a union's variant will be decided not by which fields are present, but instead
+# by a special discriminator field. The value of the discriminator field is a string naming which
+# variant is active. This allows the members of the union to have the $jsonFlatten annotation, or
+# to all have the same name.
+
+struct DiscriminatorOptions {
+ name @0 :Text;
+ # The name of the discriminator field. Defaults to matching the name of the union.
+
+ valueName @1 :Text;
+ # If non-null, specifies that the union's value shall have the given field name, rather than the
+ # value's name. In this case the union's variant can only be determined by looking at the
+ # discriminant field, not by inspecting which value field is present.
+ #
+ # It is an error to use `valueName` while also declaring some variants as $flatten.
+}
+
+annotation base64 @0xd7d879450a253e4b (field): Void;
+# Place on a field of type `Data` to indicate that its JSON representation is a Base64 string.
+
+annotation hex @0xf061e22f0ae5c7b5 (field): Void;
+# Place on a field of type `Data` to indicate that its JSON representation is a hex string.
diff --git a/core-schema/capnp/rpc.capnp b/core-schema/capnp/rpc.capnp
--- a/core-schema/capnp/rpc.capnp
+++ b/core-schema/capnp/rpc.capnp
@@ -233,11 +233,11 @@
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).
+ # because the sender received an invalid or nonsensical message or because the sender had an
+ # internal error. 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 -----------------------------------------------
@@ -317,7 +317,7 @@
# 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
+ # bootstrap interfaces, it should instead define a single bootstrap interface that has methods
# that return each of the other interfaces.
#
# **History**
@@ -446,23 +446,22 @@
# 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, in Vat A, calls 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.
+ # - The `Call` for bar'() has `sendResultsTo` set to `yourself`.
+ # - Vat B sends a `Return` for bar() with `takeFromOtherQuestion` set in place of the results,
+ # with the value set to the question ID of bar'(). Vat B does not wait for bar'() to return,
+ # as doing so would introduce unnecessary round trip latency.
# - 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'().
+ # - When bar'() returns, Vat A sends a `Return` for bar'() to Vat B, with `resultsSentElsewhere`
+ # set in place of results.
+ # - Vat A sends a `Finish` for the bar() call to Vat B.
+ # - Vat B receives the `Finish` for bar() and sends a `Finish` for bar'().
thirdParty @7 :RecipientId;
# **(level 3)**
@@ -493,6 +492,9 @@
# 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.
+ #
+ # The receiver should act as if the sender had sent a release message with count=1 for each
+ # CapDescriptor in the original Call message.
union {
results @2 :Payload;
@@ -500,9 +502,9 @@
#
# 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.
+ # For a `Return` in response to an `Accept` or `Bootstrap`, `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.
@@ -514,11 +516,15 @@
resultsSentElsewhere @5 :Void;
# This is set when returning from a `Call` that had `sendResultsTo` set to something other
# than `caller`.
+ #
+ # It doesn't matter too much when this is sent, as the receiver doesn't need to do anything
+ # with it, but the C++ implementation appears to wait for the call to finish before sending
+ # this.
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.
+ # results here. `takeFromOtherQuestion` can only used once per question.
acceptFromThirdParty @7 :ThirdPartyCapId;
# **(level 3)**
@@ -692,7 +698,7 @@
# 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
+ # One a promise P has been resolved to a remote 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).
@@ -781,7 +787,7 @@
# 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`.
+ # This message is also used to pick up a redirected return -- see `Return.acceptFromThirdParty`.
questionId @0 :QuestionId;
# A new question ID identifying this accept message, which will eventually receive a Return
@@ -940,6 +946,11 @@
#
# Keep in mind that `ExportIds` in a `CapDescriptor` are subject to reference counting. See the
# description of `ExportId`.
+ #
+ # Note that it is currently not possible to include a broken capability in the CapDescriptor
+ # table. Instead, create a new export (`senderPromise`) for each broken capability and then
+ # immediately follow the payload-bearing Call or Return message with one Resolve message for each
+ # broken capability, resolving it to an exception.
union {
none @0 :Void;
@@ -951,8 +962,8 @@
# 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).
+ # The ID of a capability in the sender's export table (receiver's import table). It may be a
+ # newly allocated table entry, or an existing entry (increments the reference count).
senderPromise @2 :ExportId;
# A promise that the sender will resolve later. The sender will send exactly one Resolve
@@ -1041,7 +1052,7 @@
# 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
+ # * Level 3 implementations must release the vine only once they have successfully picked up the
# object from the third party. This ensures that the capability is not released by the sender
# prematurely.
#
@@ -1234,8 +1245,8 @@
# 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.
+# fingerprint of the provider vat along with a nonce matching the one in the `RecipientId` used
+# in the `Provide` message sent from that provider.
using RecipientId = AnyPointer;
# **(level 3)**
@@ -1244,8 +1255,7 @@
# 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.)
+# fingerprint of the recipient along with a nonce matching the one in the `ProvisionId`.
using ThirdPartyCapId = AnyPointer;
# **(level 3)**
@@ -1254,8 +1264,8 @@
#
# 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).
+# address), and the nonce used in the corresponding `Provide` message's `RecipientId` as sent
+# to that third party (used to identify which capability to pick up).
using JoinKeyPart = AnyPointer;
# **(level 4)**
diff --git a/core-schema/capnp/schema.capnp b/core-schema/capnp/schema.capnp
--- a/core-schema/capnp/schema.capnp
+++ b/core-schema/capnp/schema.capnp
@@ -169,6 +169,33 @@
targetsAnnotation @30 :Bool;
}
}
+
+ struct SourceInfo {
+ # Additional information about a node which is not needed at runtime, but may be useful for
+ # documentation or debugging purposes. This is kept in a separate struct to make sure it
+ # doesn't accidentally get included in contexts where it is not needed. The
+ # `CodeGeneratorRequest` includes this information in a separate array.
+
+ id @0 :Id;
+ # ID of the Node which this info describes.
+
+ docComment @1 :Text;
+ # The top-level doc comment for the Node.
+
+ members @2 :List(Member);
+ # Information about each member -- i.e. fields (for structs), enumerants (for enums), or
+ # methods (for interfaces).
+ #
+ # This list is the same length and order as the corresponding list in the Node, i.e.
+ # Node.struct.fields, Node.enum.enumerants, or Node.interface.methods.
+
+ struct Member {
+ docComment @0 :Text;
+ # Doc comment on the member.
+ }
+
+ # TODO(someday): Record location of the declaration in the original source code.
+ }
}
struct Field {
@@ -467,6 +494,10 @@
nodes @0 :List(Node);
# All nodes parsed by the compiler, including for the files on the command line and their
# imports.
+
+ sourceInfo @3 :List(Node.SourceInfo);
+ # Information about the original source code for each node, where available. This array may be
+ # omitted or may be missing some nodes if no info is available for them.
requestedFiles @1 :List(RequestedFile);
# Files which were listed on the command line.
diff --git a/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b.hs b/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X85150b117366d14b(module Capnp.Gen.Calculator) where
+import Capnp.Gen.Calculator
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b/Pure.hs b/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b/Pure.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X85150b117366d14b.Pure(module Capnp.Gen.Calculator.Pure) where
+import Capnp.Gen.Calculator.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5.hs b/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xd0a87f36fa0182f5(module Capnp.Gen.Echo) where
+import Capnp.Gen.Echo
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5/Pure.hs b/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5/Pure.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xd0a87f36fa0182f5.Pure(module Capnp.Gen.Echo.Pure) where
+import Capnp.Gen.Echo.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/examples/gen/lib/Capnp/Gen/Calculator.hs b/examples/gen/lib/Capnp/Gen/Calculator.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/Calculator.hs
@@ -0,0 +1,637 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Calculator where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Calculator msg
+ = Calculator'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Calculator msg)) where
+ fromPtr msg ptr = (Calculator'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator (Message.MutMsg s))) where
+ toPtr msg (Calculator'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Calculator'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Calculator'evaluate'params msg
+ = Calculator'evaluate'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'evaluate'params) where
+ tMsg f (Calculator'evaluate'params'newtype_ s) = (Calculator'evaluate'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'evaluate'params msg)) where
+ fromStruct struct = (Std_.pure (Calculator'evaluate'params'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'evaluate'params msg)) where
+ toStruct (Calculator'evaluate'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'evaluate'params msg)) where
+ type InMessage (Calculator'evaluate'params msg) = msg
+ message (Calculator'evaluate'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'evaluate'params msg)) where
+ messageDefault msg = (Calculator'evaluate'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'evaluate'params msg)) where
+ fromPtr msg ptr = (Calculator'evaluate'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'evaluate'params (Message.MutMsg s))) where
+ toPtr msg (Calculator'evaluate'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'evaluate'params (Message.MutMsg s))) where
+ new msg = (Calculator'evaluate'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Calculator'evaluate'params msg)) where
+ newtype List msg (Calculator'evaluate'params msg)
+ = Calculator'evaluate'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'evaluate'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'evaluate'params'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'evaluate'params'List_ l) = (Untyped.length l)
+ index i (Calculator'evaluate'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'evaluate'params (Message.MutMsg s))) where
+ setIndex (Calculator'evaluate'params'newtype_ elt) i (Calculator'evaluate'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'evaluate'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Calculator'evaluate'params'expression :: ((Untyped.ReadCtx m msg)) => (Calculator'evaluate'params msg) -> (m (Expression msg))
+get_Calculator'evaluate'params'expression (Calculator'evaluate'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Calculator'evaluate'params'expression :: ((Untyped.RWCtx m s)) => (Calculator'evaluate'params (Message.MutMsg s)) -> (Expression (Message.MutMsg s)) -> (m ())
+set_Calculator'evaluate'params'expression (Calculator'evaluate'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Calculator'evaluate'params'expression :: ((Untyped.ReadCtx m msg)) => (Calculator'evaluate'params msg) -> (m Std_.Bool)
+has_Calculator'evaluate'params'expression (Calculator'evaluate'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Calculator'evaluate'params'expression :: ((Untyped.RWCtx m s)) => (Calculator'evaluate'params (Message.MutMsg s)) -> (m (Expression (Message.MutMsg s)))
+new_Calculator'evaluate'params'expression struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Calculator'evaluate'params'expression struct result)
+ (Std_.pure result)
+ )
+newtype Calculator'evaluate'results msg
+ = Calculator'evaluate'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'evaluate'results) where
+ tMsg f (Calculator'evaluate'results'newtype_ s) = (Calculator'evaluate'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'evaluate'results msg)) where
+ fromStruct struct = (Std_.pure (Calculator'evaluate'results'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'evaluate'results msg)) where
+ toStruct (Calculator'evaluate'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'evaluate'results msg)) where
+ type InMessage (Calculator'evaluate'results msg) = msg
+ message (Calculator'evaluate'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'evaluate'results msg)) where
+ messageDefault msg = (Calculator'evaluate'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'evaluate'results msg)) where
+ fromPtr msg ptr = (Calculator'evaluate'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'evaluate'results (Message.MutMsg s))) where
+ toPtr msg (Calculator'evaluate'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'evaluate'results (Message.MutMsg s))) where
+ new msg = (Calculator'evaluate'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Calculator'evaluate'results msg)) where
+ newtype List msg (Calculator'evaluate'results msg)
+ = Calculator'evaluate'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'evaluate'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'evaluate'results'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'evaluate'results'List_ l) = (Untyped.length l)
+ index i (Calculator'evaluate'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'evaluate'results (Message.MutMsg s))) where
+ setIndex (Calculator'evaluate'results'newtype_ elt) i (Calculator'evaluate'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'evaluate'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Calculator'evaluate'results'value :: ((Untyped.ReadCtx m msg)) => (Calculator'evaluate'results msg) -> (m (Value msg))
+get_Calculator'evaluate'results'value (Calculator'evaluate'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Calculator'evaluate'results'value :: ((Untyped.RWCtx m s)) => (Calculator'evaluate'results (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Calculator'evaluate'results'value (Calculator'evaluate'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Calculator'evaluate'results'value :: ((Untyped.ReadCtx m msg)) => (Calculator'evaluate'results msg) -> (m Std_.Bool)
+has_Calculator'evaluate'results'value (Calculator'evaluate'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype Calculator'defFunction'params msg
+ = Calculator'defFunction'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'defFunction'params) where
+ tMsg f (Calculator'defFunction'params'newtype_ s) = (Calculator'defFunction'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'defFunction'params msg)) where
+ fromStruct struct = (Std_.pure (Calculator'defFunction'params'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'defFunction'params msg)) where
+ toStruct (Calculator'defFunction'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'defFunction'params msg)) where
+ type InMessage (Calculator'defFunction'params msg) = msg
+ message (Calculator'defFunction'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'defFunction'params msg)) where
+ messageDefault msg = (Calculator'defFunction'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'defFunction'params msg)) where
+ fromPtr msg ptr = (Calculator'defFunction'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'defFunction'params (Message.MutMsg s))) where
+ toPtr msg (Calculator'defFunction'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'defFunction'params (Message.MutMsg s))) where
+ new msg = (Calculator'defFunction'params'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Calculator'defFunction'params msg)) where
+ newtype List msg (Calculator'defFunction'params msg)
+ = Calculator'defFunction'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'defFunction'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'defFunction'params'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'defFunction'params'List_ l) = (Untyped.length l)
+ index i (Calculator'defFunction'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'defFunction'params (Message.MutMsg s))) where
+ setIndex (Calculator'defFunction'params'newtype_ elt) i (Calculator'defFunction'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'defFunction'params'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Calculator'defFunction'params'paramCount :: ((Untyped.ReadCtx m msg)) => (Calculator'defFunction'params msg) -> (m Std_.Int32)
+get_Calculator'defFunction'params'paramCount (Calculator'defFunction'params'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Calculator'defFunction'params'paramCount :: ((Untyped.RWCtx m s)) => (Calculator'defFunction'params (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_Calculator'defFunction'params'paramCount (Calculator'defFunction'params'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Calculator'defFunction'params'body :: ((Untyped.ReadCtx m msg)) => (Calculator'defFunction'params msg) -> (m (Expression msg))
+get_Calculator'defFunction'params'body (Calculator'defFunction'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Calculator'defFunction'params'body :: ((Untyped.RWCtx m s)) => (Calculator'defFunction'params (Message.MutMsg s)) -> (Expression (Message.MutMsg s)) -> (m ())
+set_Calculator'defFunction'params'body (Calculator'defFunction'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Calculator'defFunction'params'body :: ((Untyped.ReadCtx m msg)) => (Calculator'defFunction'params msg) -> (m Std_.Bool)
+has_Calculator'defFunction'params'body (Calculator'defFunction'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Calculator'defFunction'params'body :: ((Untyped.RWCtx m s)) => (Calculator'defFunction'params (Message.MutMsg s)) -> (m (Expression (Message.MutMsg s)))
+new_Calculator'defFunction'params'body struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Calculator'defFunction'params'body struct result)
+ (Std_.pure result)
+ )
+newtype Calculator'defFunction'results msg
+ = Calculator'defFunction'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'defFunction'results) where
+ tMsg f (Calculator'defFunction'results'newtype_ s) = (Calculator'defFunction'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'defFunction'results msg)) where
+ fromStruct struct = (Std_.pure (Calculator'defFunction'results'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'defFunction'results msg)) where
+ toStruct (Calculator'defFunction'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'defFunction'results msg)) where
+ type InMessage (Calculator'defFunction'results msg) = msg
+ message (Calculator'defFunction'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'defFunction'results msg)) where
+ messageDefault msg = (Calculator'defFunction'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'defFunction'results msg)) where
+ fromPtr msg ptr = (Calculator'defFunction'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'defFunction'results (Message.MutMsg s))) where
+ toPtr msg (Calculator'defFunction'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'defFunction'results (Message.MutMsg s))) where
+ new msg = (Calculator'defFunction'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Calculator'defFunction'results msg)) where
+ newtype List msg (Calculator'defFunction'results msg)
+ = Calculator'defFunction'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'defFunction'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'defFunction'results'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'defFunction'results'List_ l) = (Untyped.length l)
+ index i (Calculator'defFunction'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'defFunction'results (Message.MutMsg s))) where
+ setIndex (Calculator'defFunction'results'newtype_ elt) i (Calculator'defFunction'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'defFunction'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Calculator'defFunction'results'func :: ((Untyped.ReadCtx m msg)) => (Calculator'defFunction'results msg) -> (m (Function msg))
+get_Calculator'defFunction'results'func (Calculator'defFunction'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Calculator'defFunction'results'func :: ((Untyped.RWCtx m s)) => (Calculator'defFunction'results (Message.MutMsg s)) -> (Function (Message.MutMsg s)) -> (m ())
+set_Calculator'defFunction'results'func (Calculator'defFunction'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Calculator'defFunction'results'func :: ((Untyped.ReadCtx m msg)) => (Calculator'defFunction'results msg) -> (m Std_.Bool)
+has_Calculator'defFunction'results'func (Calculator'defFunction'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype Calculator'getOperator'params msg
+ = Calculator'getOperator'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'getOperator'params) where
+ tMsg f (Calculator'getOperator'params'newtype_ s) = (Calculator'getOperator'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'getOperator'params msg)) where
+ fromStruct struct = (Std_.pure (Calculator'getOperator'params'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'getOperator'params msg)) where
+ toStruct (Calculator'getOperator'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'getOperator'params msg)) where
+ type InMessage (Calculator'getOperator'params msg) = msg
+ message (Calculator'getOperator'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'getOperator'params msg)) where
+ messageDefault msg = (Calculator'getOperator'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'getOperator'params msg)) where
+ fromPtr msg ptr = (Calculator'getOperator'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'getOperator'params (Message.MutMsg s))) where
+ toPtr msg (Calculator'getOperator'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'getOperator'params (Message.MutMsg s))) where
+ new msg = (Calculator'getOperator'params'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Calculator'getOperator'params msg)) where
+ newtype List msg (Calculator'getOperator'params msg)
+ = Calculator'getOperator'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'getOperator'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'getOperator'params'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'getOperator'params'List_ l) = (Untyped.length l)
+ index i (Calculator'getOperator'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'getOperator'params (Message.MutMsg s))) where
+ setIndex (Calculator'getOperator'params'newtype_ elt) i (Calculator'getOperator'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'getOperator'params'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Calculator'getOperator'params'op :: ((Untyped.ReadCtx m msg)) => (Calculator'getOperator'params msg) -> (m Operator)
+get_Calculator'getOperator'params'op (Calculator'getOperator'params'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Calculator'getOperator'params'op :: ((Untyped.RWCtx m s)) => (Calculator'getOperator'params (Message.MutMsg s)) -> Operator -> (m ())
+set_Calculator'getOperator'params'op (Calculator'getOperator'params'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Calculator'getOperator'results msg
+ = Calculator'getOperator'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Calculator'getOperator'results) where
+ tMsg f (Calculator'getOperator'results'newtype_ s) = (Calculator'getOperator'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Calculator'getOperator'results msg)) where
+ fromStruct struct = (Std_.pure (Calculator'getOperator'results'newtype_ struct))
+instance (Classes.ToStruct msg (Calculator'getOperator'results msg)) where
+ toStruct (Calculator'getOperator'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Calculator'getOperator'results msg)) where
+ type InMessage (Calculator'getOperator'results msg) = msg
+ message (Calculator'getOperator'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Calculator'getOperator'results msg)) where
+ messageDefault msg = (Calculator'getOperator'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Calculator'getOperator'results msg)) where
+ fromPtr msg ptr = (Calculator'getOperator'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Calculator'getOperator'results (Message.MutMsg s))) where
+ toPtr msg (Calculator'getOperator'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Calculator'getOperator'results (Message.MutMsg s))) where
+ new msg = (Calculator'getOperator'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Calculator'getOperator'results msg)) where
+ newtype List msg (Calculator'getOperator'results msg)
+ = Calculator'getOperator'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Calculator'getOperator'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Calculator'getOperator'results'List_ l) = (Untyped.ListStruct l)
+ length (Calculator'getOperator'results'List_ l) = (Untyped.length l)
+ index i (Calculator'getOperator'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Calculator'getOperator'results (Message.MutMsg s))) where
+ setIndex (Calculator'getOperator'results'newtype_ elt) i (Calculator'getOperator'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Calculator'getOperator'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Calculator'getOperator'results'func :: ((Untyped.ReadCtx m msg)) => (Calculator'getOperator'results msg) -> (m (Function msg))
+get_Calculator'getOperator'results'func (Calculator'getOperator'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Calculator'getOperator'results'func :: ((Untyped.RWCtx m s)) => (Calculator'getOperator'results (Message.MutMsg s)) -> (Function (Message.MutMsg s)) -> (m ())
+set_Calculator'getOperator'results'func (Calculator'getOperator'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Calculator'getOperator'results'func :: ((Untyped.ReadCtx m msg)) => (Calculator'getOperator'results msg) -> (m Std_.Bool)
+has_Calculator'getOperator'results'func (Calculator'getOperator'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype Expression msg
+ = Expression'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Expression) where
+ tMsg f (Expression'newtype_ s) = (Expression'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Expression msg)) where
+ fromStruct struct = (Std_.pure (Expression'newtype_ struct))
+instance (Classes.ToStruct msg (Expression msg)) where
+ toStruct (Expression'newtype_ struct) = struct
+instance (Untyped.HasMessage (Expression msg)) where
+ type InMessage (Expression msg) = msg
+ message (Expression'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Expression msg)) where
+ messageDefault msg = (Expression'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Expression msg)) where
+ fromPtr msg ptr = (Expression'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Expression (Message.MutMsg s))) where
+ toPtr msg (Expression'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Expression (Message.MutMsg s))) where
+ new msg = (Expression'newtype_ <$> (Untyped.allocStruct msg 2 2))
+instance (Basics.ListElem msg (Expression msg)) where
+ newtype List msg (Expression msg)
+ = Expression'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Expression'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Expression'List_ l) = (Untyped.ListStruct l)
+ length (Expression'List_ l) = (Untyped.length l)
+ index i (Expression'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Expression (Message.MutMsg s))) where
+ setIndex (Expression'newtype_ elt) i (Expression'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Expression'List_ <$> (Untyped.allocCompositeList msg 2 2 len))
+data Expression' msg
+ = Expression'literal Std_.Double
+ | Expression'previousResult (Value msg)
+ | Expression'parameter Std_.Word32
+ | Expression'call (Expression'call msg)
+ | Expression'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Expression' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 4)
+ case tag of
+ 0 ->
+ (Expression'literal <$> (GenHelpers.getWordField struct 0 0 0))
+ 1 ->
+ (Expression'previousResult <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 2 ->
+ (Expression'parameter <$> (GenHelpers.getWordField struct 0 0 0))
+ 3 ->
+ (Expression'call <$> (Classes.fromStruct struct))
+ _ ->
+ (Std_.pure (Expression'unknown' (Std_.fromIntegral tag)))
+ )
+get_Expression' :: ((Untyped.ReadCtx m msg)) => (Expression msg) -> (m (Expression' msg))
+get_Expression' (Expression'newtype_ struct) = (Classes.fromStruct struct)
+set_Expression'literal :: ((Untyped.RWCtx m s)) => (Expression (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Expression'literal (Expression'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+ )
+set_Expression'previousResult :: ((Untyped.RWCtx m s)) => (Expression (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Expression'previousResult (Expression'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Expression'parameter :: ((Untyped.RWCtx m s)) => (Expression (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Expression'parameter (Expression'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 1 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+ )
+set_Expression'call :: ((Untyped.RWCtx m s)) => (Expression (Message.MutMsg s)) -> (m (Expression'call (Message.MutMsg s)))
+set_Expression'call (Expression'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Expression'unknown' :: ((Untyped.RWCtx m s)) => (Expression (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Expression'unknown' (Expression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+newtype Expression'call msg
+ = Expression'call'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Expression'call) where
+ tMsg f (Expression'call'newtype_ s) = (Expression'call'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Expression'call msg)) where
+ fromStruct struct = (Std_.pure (Expression'call'newtype_ struct))
+instance (Classes.ToStruct msg (Expression'call msg)) where
+ toStruct (Expression'call'newtype_ struct) = struct
+instance (Untyped.HasMessage (Expression'call msg)) where
+ type InMessage (Expression'call msg) = msg
+ message (Expression'call'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Expression'call msg)) where
+ messageDefault msg = (Expression'call'newtype_ (Untyped.messageDefault msg))
+get_Expression'call'function :: ((Untyped.ReadCtx m msg)) => (Expression'call msg) -> (m (Function msg))
+get_Expression'call'function (Expression'call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Expression'call'function :: ((Untyped.RWCtx m s)) => (Expression'call (Message.MutMsg s)) -> (Function (Message.MutMsg s)) -> (m ())
+set_Expression'call'function (Expression'call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Expression'call'function :: ((Untyped.ReadCtx m msg)) => (Expression'call msg) -> (m Std_.Bool)
+has_Expression'call'function (Expression'call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_Expression'call'params :: ((Untyped.ReadCtx m msg)) => (Expression'call msg) -> (m (Basics.List msg (Expression msg)))
+get_Expression'call'params (Expression'call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Expression'call'params :: ((Untyped.RWCtx m s)) => (Expression'call (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Expression (Message.MutMsg s))) -> (m ())
+set_Expression'call'params (Expression'call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Expression'call'params :: ((Untyped.ReadCtx m msg)) => (Expression'call msg) -> (m Std_.Bool)
+has_Expression'call'params (Expression'call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Expression'call'params :: ((Untyped.RWCtx m s)) => Std_.Int -> (Expression'call (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Expression (Message.MutMsg s))))
+new_Expression'call'params len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Expression'call'params struct result)
+ (Std_.pure result)
+ )
+newtype Value msg
+ = Value'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Value msg)) where
+ fromPtr msg ptr = (Value'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value (Message.MutMsg s))) where
+ toPtr msg (Value'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Value'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Value'read'params msg
+ = Value'read'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value'read'params) where
+ tMsg f (Value'read'params'newtype_ s) = (Value'read'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value'read'params msg)) where
+ fromStruct struct = (Std_.pure (Value'read'params'newtype_ struct))
+instance (Classes.ToStruct msg (Value'read'params msg)) where
+ toStruct (Value'read'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value'read'params msg)) where
+ type InMessage (Value'read'params msg) = msg
+ message (Value'read'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value'read'params msg)) where
+ messageDefault msg = (Value'read'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value'read'params msg)) where
+ fromPtr msg ptr = (Value'read'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value'read'params (Message.MutMsg s))) where
+ toPtr msg (Value'read'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value'read'params (Message.MutMsg s))) where
+ new msg = (Value'read'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Value'read'params msg)) where
+ newtype List msg (Value'read'params msg)
+ = Value'read'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'read'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'read'params'List_ l) = (Untyped.ListStruct l)
+ length (Value'read'params'List_ l) = (Untyped.length l)
+ index i (Value'read'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value'read'params (Message.MutMsg s))) where
+ setIndex (Value'read'params'newtype_ elt) i (Value'read'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'read'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Value'read'results msg
+ = Value'read'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value'read'results) where
+ tMsg f (Value'read'results'newtype_ s) = (Value'read'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value'read'results msg)) where
+ fromStruct struct = (Std_.pure (Value'read'results'newtype_ struct))
+instance (Classes.ToStruct msg (Value'read'results msg)) where
+ toStruct (Value'read'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value'read'results msg)) where
+ type InMessage (Value'read'results msg) = msg
+ message (Value'read'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value'read'results msg)) where
+ messageDefault msg = (Value'read'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value'read'results msg)) where
+ fromPtr msg ptr = (Value'read'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value'read'results (Message.MutMsg s))) where
+ toPtr msg (Value'read'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value'read'results (Message.MutMsg s))) where
+ new msg = (Value'read'results'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Value'read'results msg)) where
+ newtype List msg (Value'read'results msg)
+ = Value'read'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'read'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'read'results'List_ l) = (Untyped.ListStruct l)
+ length (Value'read'results'List_ l) = (Untyped.length l)
+ index i (Value'read'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value'read'results (Message.MutMsg s))) where
+ setIndex (Value'read'results'newtype_ elt) i (Value'read'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'read'results'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Value'read'results'value :: ((Untyped.ReadCtx m msg)) => (Value'read'results msg) -> (m Std_.Double)
+get_Value'read'results'value (Value'read'results'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Value'read'results'value :: ((Untyped.RWCtx m s)) => (Value'read'results (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Value'read'results'value (Value'read'results'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+newtype Function msg
+ = Function'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Function msg)) where
+ fromPtr msg ptr = (Function'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Function (Message.MutMsg s))) where
+ toPtr msg (Function'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Function'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Function'call'params msg
+ = Function'call'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Function'call'params) where
+ tMsg f (Function'call'params'newtype_ s) = (Function'call'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Function'call'params msg)) where
+ fromStruct struct = (Std_.pure (Function'call'params'newtype_ struct))
+instance (Classes.ToStruct msg (Function'call'params msg)) where
+ toStruct (Function'call'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Function'call'params msg)) where
+ type InMessage (Function'call'params msg) = msg
+ message (Function'call'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Function'call'params msg)) where
+ messageDefault msg = (Function'call'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Function'call'params msg)) where
+ fromPtr msg ptr = (Function'call'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Function'call'params (Message.MutMsg s))) where
+ toPtr msg (Function'call'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Function'call'params (Message.MutMsg s))) where
+ new msg = (Function'call'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Function'call'params msg)) where
+ newtype List msg (Function'call'params msg)
+ = Function'call'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Function'call'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Function'call'params'List_ l) = (Untyped.ListStruct l)
+ length (Function'call'params'List_ l) = (Untyped.length l)
+ index i (Function'call'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Function'call'params (Message.MutMsg s))) where
+ setIndex (Function'call'params'newtype_ elt) i (Function'call'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Function'call'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Function'call'params'params :: ((Untyped.ReadCtx m msg)) => (Function'call'params msg) -> (m (Basics.List msg Std_.Double))
+get_Function'call'params'params (Function'call'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Function'call'params'params :: ((Untyped.RWCtx m s)) => (Function'call'params (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Double) -> (m ())
+set_Function'call'params'params (Function'call'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Function'call'params'params :: ((Untyped.ReadCtx m msg)) => (Function'call'params msg) -> (m Std_.Bool)
+has_Function'call'params'params (Function'call'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Function'call'params'params :: ((Untyped.RWCtx m s)) => Std_.Int -> (Function'call'params (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Std_.Double))
+new_Function'call'params'params len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Function'call'params'params struct result)
+ (Std_.pure result)
+ )
+newtype Function'call'results msg
+ = Function'call'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Function'call'results) where
+ tMsg f (Function'call'results'newtype_ s) = (Function'call'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Function'call'results msg)) where
+ fromStruct struct = (Std_.pure (Function'call'results'newtype_ struct))
+instance (Classes.ToStruct msg (Function'call'results msg)) where
+ toStruct (Function'call'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Function'call'results msg)) where
+ type InMessage (Function'call'results msg) = msg
+ message (Function'call'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Function'call'results msg)) where
+ messageDefault msg = (Function'call'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Function'call'results msg)) where
+ fromPtr msg ptr = (Function'call'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Function'call'results (Message.MutMsg s))) where
+ toPtr msg (Function'call'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Function'call'results (Message.MutMsg s))) where
+ new msg = (Function'call'results'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Function'call'results msg)) where
+ newtype List msg (Function'call'results msg)
+ = Function'call'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Function'call'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Function'call'results'List_ l) = (Untyped.ListStruct l)
+ length (Function'call'results'List_ l) = (Untyped.length l)
+ index i (Function'call'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Function'call'results (Message.MutMsg s))) where
+ setIndex (Function'call'results'newtype_ elt) i (Function'call'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Function'call'results'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Function'call'results'value :: ((Untyped.ReadCtx m msg)) => (Function'call'results msg) -> (m Std_.Double)
+get_Function'call'results'value (Function'call'results'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Function'call'results'value :: ((Untyped.RWCtx m s)) => (Function'call'results (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Function'call'results'value (Function'call'results'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+data Operator
+ = Operator'add
+ | Operator'subtract
+ | Operator'multiply
+ | Operator'divide
+ | Operator'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Read
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Classes.IsWord Operator) where
+ fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
+ 0 ->
+ Operator'add
+ 1 ->
+ Operator'subtract
+ 2 ->
+ Operator'multiply
+ 3 ->
+ Operator'divide
+ tag ->
+ (Operator'unknown' tag)
+ toWord (Operator'add) = 0
+ toWord (Operator'subtract) = 1
+ toWord (Operator'multiply) = 2
+ toWord (Operator'divide) = 3
+ toWord (Operator'unknown' tag) = (Std_.fromIntegral tag)
+instance (Std_.Enum Operator) where
+ fromEnum x = (Std_.fromIntegral (Classes.toWord x))
+ toEnum x = (Classes.fromWord (Std_.fromIntegral x))
+instance (Basics.ListElem msg Operator) where
+ newtype List msg Operator
+ = Operator'List_ (Untyped.ListOf msg Std_.Word16)
+ index i (Operator'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
+ listFromPtr msg ptr = (Operator'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Operator'List_ l) = (Untyped.List16 l)
+ length (Operator'List_ l) = (Untyped.length l)
+instance (Classes.MutListElem s Operator) where
+ setIndex elt i (Operator'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
+ newList msg size = (Operator'List_ <$> (Untyped.allocList16 msg size))
diff --git a/examples/gen/lib/Capnp/Gen/Calculator/Pure.hs b/examples/gen/lib/Capnp/Gen/Calculator/Pure.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/Calculator/Pure.hs
@@ -0,0 +1,630 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Calculator.Pure(Capnp.Gen.ById.X85150b117366d14b.Operator(..)
+ ,Calculator(..)
+ ,Calculator'server_(..)
+ ,export_Calculator
+ ,Calculator'evaluate'params(..)
+ ,Calculator'evaluate'results(..)
+ ,Calculator'defFunction'params(..)
+ ,Calculator'defFunction'results(..)
+ ,Calculator'getOperator'params(..)
+ ,Calculator'getOperator'results(..)
+ ,Expression(..)
+ ,Expression'call(..)
+ ,Value(..)
+ ,Value'server_(..)
+ ,export_Value
+ ,Value'read'params(..)
+ ,Value'read'results(..)
+ ,Function(..)
+ ,Function'server_(..)
+ ,export_Function
+ ,Function'call'params(..)
+ ,Function'call'results(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Rpc.Untyped as Rpc
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.GenHelpers.Rpc as RpcHelpers
+import qualified Capnp.GenHelpers.ReExports.Control.Concurrent.STM as STM
+import qualified Capnp.GenHelpers.ReExports.Supervisors as Supervisors
+import qualified Capnp.Gen.ById.X85150b117366d14b
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Calculator
+ = Calculator Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Calculator'server_ m cap) where
+ {-# MINIMAL calculator'evaluate,calculator'defFunction,calculator'getOperator #-}
+ calculator'evaluate :: cap -> (Server.MethodHandler m Calculator'evaluate'params Calculator'evaluate'results)
+ calculator'evaluate _ = Server.methodUnimplemented
+ calculator'defFunction :: cap -> (Server.MethodHandler m Calculator'defFunction'params Calculator'defFunction'results)
+ calculator'defFunction _ = Server.methodUnimplemented
+ calculator'getOperator :: cap -> (Server.MethodHandler m Calculator'getOperator'params Calculator'getOperator'results)
+ calculator'getOperator _ = Server.methodUnimplemented
+export_Calculator :: ((Calculator'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Calculator)
+export_Calculator sup_ server_ = (Calculator <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 10923537602090224694 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (calculator'evaluate server_))
+ 1 ->
+ (Server.toUntypedHandler (calculator'defFunction server_))
+ 2 ->
+ (Server.toUntypedHandler (calculator'getOperator server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Calculator) where
+ fromClient = Calculator
+ toClient (Calculator client) = client
+instance (Classes.FromPtr msg Calculator) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Calculator) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Calculator) where
+ type Cerial msg Calculator = (Capnp.Gen.ById.X85150b117366d14b.Calculator msg)
+ decerialize (Capnp.Gen.ById.X85150b117366d14b.Calculator'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Calculator Message.nullClient))
+ (Std_.Just cap) ->
+ (Calculator <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Calculator) where
+ cerialize msg (Calculator client) = (Capnp.Gen.ById.X85150b117366d14b.Calculator'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Calculator'server_ Std_.IO Calculator) where
+ calculator'evaluate (Calculator client) = (Rpc.clientMethodHandler 10923537602090224694 0 client)
+ calculator'defFunction (Calculator client) = (Rpc.clientMethodHandler 10923537602090224694 1 client)
+ calculator'getOperator (Calculator client) = (Rpc.clientMethodHandler 10923537602090224694 2 client)
+data Calculator'evaluate'params
+ = Calculator'evaluate'params
+ {expression :: Expression}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'evaluate'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'evaluate'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'evaluate'params) where
+ type Cerial msg Calculator'evaluate'params = (Capnp.Gen.ById.X85150b117366d14b.Calculator'evaluate'params msg)
+ decerialize raw = (Calculator'evaluate'params <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Calculator'evaluate'params'expression raw) >>= Classes.decerialize))
+instance (Classes.Marshal Calculator'evaluate'params) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'evaluate'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) expression) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'evaluate'params'expression raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'evaluate'params)
+instance (Classes.Cerialize (V.Vector Calculator'evaluate'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'evaluate'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'evaluate'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Calculator'evaluate'results
+ = Calculator'evaluate'results
+ {value :: Value}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'evaluate'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'evaluate'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'evaluate'results) where
+ type Cerial msg Calculator'evaluate'results = (Capnp.Gen.ById.X85150b117366d14b.Calculator'evaluate'results msg)
+ decerialize raw = (Calculator'evaluate'results <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Calculator'evaluate'results'value raw) >>= Classes.decerialize))
+instance (Classes.Marshal Calculator'evaluate'results) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'evaluate'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) value) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'evaluate'results'value raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'evaluate'results)
+instance (Classes.Cerialize (V.Vector Calculator'evaluate'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'evaluate'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'evaluate'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'evaluate'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Calculator'defFunction'params
+ = Calculator'defFunction'params
+ {paramCount :: Std_.Int32
+ ,body :: Expression}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'defFunction'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'defFunction'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'defFunction'params) where
+ type Cerial msg Calculator'defFunction'params = (Capnp.Gen.ById.X85150b117366d14b.Calculator'defFunction'params msg)
+ decerialize raw = (Calculator'defFunction'params <$> (Capnp.Gen.ById.X85150b117366d14b.get_Calculator'defFunction'params'paramCount raw)
+ <*> ((Capnp.Gen.ById.X85150b117366d14b.get_Calculator'defFunction'params'body raw) >>= Classes.decerialize))
+instance (Classes.Marshal Calculator'defFunction'params) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'defFunction'params{..} ->
+ (do
+ (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'defFunction'params'paramCount raw_ paramCount)
+ ((Classes.cerialize (Untyped.message raw_) body) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'defFunction'params'body raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'defFunction'params)
+instance (Classes.Cerialize (V.Vector Calculator'defFunction'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'defFunction'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'defFunction'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Calculator'defFunction'results
+ = Calculator'defFunction'results
+ {func :: Function}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'defFunction'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'defFunction'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'defFunction'results) where
+ type Cerial msg Calculator'defFunction'results = (Capnp.Gen.ById.X85150b117366d14b.Calculator'defFunction'results msg)
+ decerialize raw = (Calculator'defFunction'results <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Calculator'defFunction'results'func raw) >>= Classes.decerialize))
+instance (Classes.Marshal Calculator'defFunction'results) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'defFunction'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) func) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'defFunction'results'func raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'defFunction'results)
+instance (Classes.Cerialize (V.Vector Calculator'defFunction'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'defFunction'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'defFunction'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'defFunction'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Calculator'getOperator'params
+ = Calculator'getOperator'params
+ {op :: Capnp.Gen.ById.X85150b117366d14b.Operator}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'getOperator'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'getOperator'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'getOperator'params) where
+ type Cerial msg Calculator'getOperator'params = (Capnp.Gen.ById.X85150b117366d14b.Calculator'getOperator'params msg)
+ decerialize raw = (Calculator'getOperator'params <$> (Capnp.Gen.ById.X85150b117366d14b.get_Calculator'getOperator'params'op raw))
+instance (Classes.Marshal Calculator'getOperator'params) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'getOperator'params{..} ->
+ (do
+ (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'getOperator'params'op raw_ op)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'getOperator'params)
+instance (Classes.Cerialize (V.Vector Calculator'getOperator'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'getOperator'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'getOperator'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Calculator'getOperator'results
+ = Calculator'getOperator'results
+ {func :: Function}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Calculator'getOperator'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Calculator'getOperator'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Calculator'getOperator'results) where
+ type Cerial msg Calculator'getOperator'results = (Capnp.Gen.ById.X85150b117366d14b.Calculator'getOperator'results msg)
+ decerialize raw = (Calculator'getOperator'results <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Calculator'getOperator'results'func raw) >>= Classes.decerialize))
+instance (Classes.Marshal Calculator'getOperator'results) where
+ marshalInto raw_ value_ = case value_ of
+ Calculator'getOperator'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) func) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Calculator'getOperator'results'func raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Calculator'getOperator'results)
+instance (Classes.Cerialize (V.Vector Calculator'getOperator'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Calculator'getOperator'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Calculator'getOperator'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Calculator'getOperator'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Expression
+ = Expression'literal Std_.Double
+ | Expression'previousResult Value
+ | Expression'parameter Std_.Word32
+ | Expression'call Expression'call
+ | Expression'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Expression) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Expression) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Expression) where
+ type Cerial msg Expression = (Capnp.Gen.ById.X85150b117366d14b.Expression msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.X85150b117366d14b.get_Expression' raw)
+ case raw of
+ (Capnp.Gen.ById.X85150b117366d14b.Expression'literal raw) ->
+ (Std_.pure (Expression'literal raw))
+ (Capnp.Gen.ById.X85150b117366d14b.Expression'previousResult raw) ->
+ (Expression'previousResult <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X85150b117366d14b.Expression'parameter raw) ->
+ (Std_.pure (Expression'parameter raw))
+ (Capnp.Gen.ById.X85150b117366d14b.Expression'call raw) ->
+ (Expression'call <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X85150b117366d14b.Expression'unknown' tag) ->
+ (Std_.pure (Expression'unknown' tag))
+ )
+instance (Classes.Marshal Expression) where
+ marshalInto raw_ value_ = case value_ of
+ (Expression'literal arg_) ->
+ (Capnp.Gen.ById.X85150b117366d14b.set_Expression'literal raw_ arg_)
+ (Expression'previousResult arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Expression'previousResult raw_))
+ (Expression'parameter arg_) ->
+ (Capnp.Gen.ById.X85150b117366d14b.set_Expression'parameter raw_ arg_)
+ (Expression'call arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.X85150b117366d14b.set_Expression'call raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Expression'unknown' tag) ->
+ (Capnp.Gen.ById.X85150b117366d14b.set_Expression'unknown' raw_ tag)
+instance (Classes.Cerialize Expression)
+instance (Classes.Cerialize (V.Vector Expression)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Expression))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Expression)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Expression))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Expression)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Expression))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Expression)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Expression'call
+ = Expression'call'
+ {function :: Function
+ ,params :: (V.Vector Expression)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Expression'call) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Expression'call) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Expression'call) where
+ type Cerial msg Expression'call = (Capnp.Gen.ById.X85150b117366d14b.Expression'call msg)
+ decerialize raw = (Expression'call' <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Expression'call'function raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X85150b117366d14b.get_Expression'call'params raw) >>= Classes.decerialize))
+instance (Classes.Marshal Expression'call) where
+ marshalInto raw_ value_ = case value_ of
+ Expression'call'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) function) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Expression'call'function raw_))
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Expression'call'params raw_))
+ (Std_.pure ())
+ )
+newtype Value
+ = Value Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Value'server_ m cap) where
+ {-# MINIMAL value'read #-}
+ value'read :: cap -> (Server.MethodHandler m Value'read'params Value'read'results)
+ value'read _ = Server.methodUnimplemented
+export_Value :: ((Value'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Value)
+export_Value sup_ server_ = (Value <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 14116142932258867410 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (value'read server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Value) where
+ fromClient = Value
+ toClient (Value client) = client
+instance (Classes.FromPtr msg Value) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Value) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Value) where
+ type Cerial msg Value = (Capnp.Gen.ById.X85150b117366d14b.Value msg)
+ decerialize (Capnp.Gen.ById.X85150b117366d14b.Value'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Value Message.nullClient))
+ (Std_.Just cap) ->
+ (Value <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Value) where
+ cerialize msg (Value client) = (Capnp.Gen.ById.X85150b117366d14b.Value'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Value'server_ Std_.IO Value) where
+ value'read (Value client) = (Rpc.clientMethodHandler 14116142932258867410 0 client)
+data Value'read'params
+ = Value'read'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value'read'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value'read'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value'read'params) where
+ type Cerial msg Value'read'params = (Capnp.Gen.ById.X85150b117366d14b.Value'read'params msg)
+ decerialize raw = (Std_.pure Value'read'params)
+instance (Classes.Marshal Value'read'params) where
+ marshalInto raw_ value_ = case value_ of
+ (Value'read'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Value'read'params)
+instance (Classes.Cerialize (V.Vector Value'read'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value'read'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value'read'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value'read'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Value'read'results
+ = Value'read'results
+ {value :: Std_.Double}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value'read'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value'read'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value'read'results) where
+ type Cerial msg Value'read'results = (Capnp.Gen.ById.X85150b117366d14b.Value'read'results msg)
+ decerialize raw = (Value'read'results <$> (Capnp.Gen.ById.X85150b117366d14b.get_Value'read'results'value raw))
+instance (Classes.Marshal Value'read'results) where
+ marshalInto raw_ value_ = case value_ of
+ Value'read'results{..} ->
+ (do
+ (Capnp.Gen.ById.X85150b117366d14b.set_Value'read'results'value raw_ value)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Value'read'results)
+instance (Classes.Cerialize (V.Vector Value'read'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value'read'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value'read'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value'read'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'read'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Function
+ = Function Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Function'server_ m cap) where
+ {-# MINIMAL function'call #-}
+ function'call :: cap -> (Server.MethodHandler m Function'call'params Function'call'results)
+ function'call _ = Server.methodUnimplemented
+export_Function :: ((Function'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Function)
+export_Function sup_ server_ = (Function <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 17143016017778443156 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (function'call server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Function) where
+ fromClient = Function
+ toClient (Function client) = client
+instance (Classes.FromPtr msg Function) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Function) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Function) where
+ type Cerial msg Function = (Capnp.Gen.ById.X85150b117366d14b.Function msg)
+ decerialize (Capnp.Gen.ById.X85150b117366d14b.Function'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Function Message.nullClient))
+ (Std_.Just cap) ->
+ (Function <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Function) where
+ cerialize msg (Function client) = (Capnp.Gen.ById.X85150b117366d14b.Function'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Function'server_ Std_.IO Function) where
+ function'call (Function client) = (Rpc.clientMethodHandler 17143016017778443156 0 client)
+data Function'call'params
+ = Function'call'params
+ {params :: (V.Vector Std_.Double)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Function'call'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Function'call'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Function'call'params) where
+ type Cerial msg Function'call'params = (Capnp.Gen.ById.X85150b117366d14b.Function'call'params msg)
+ decerialize raw = (Function'call'params <$> ((Capnp.Gen.ById.X85150b117366d14b.get_Function'call'params'params raw) >>= Classes.decerialize))
+instance (Classes.Marshal Function'call'params) where
+ marshalInto raw_ value_ = case value_ of
+ Function'call'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.X85150b117366d14b.set_Function'call'params'params raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Function'call'params)
+instance (Classes.Cerialize (V.Vector Function'call'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Function'call'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Function'call'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Function'call'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Function'call'results
+ = Function'call'results
+ {value :: Std_.Double}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Function'call'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Function'call'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Function'call'results) where
+ type Cerial msg Function'call'results = (Capnp.Gen.ById.X85150b117366d14b.Function'call'results msg)
+ decerialize raw = (Function'call'results <$> (Capnp.Gen.ById.X85150b117366d14b.get_Function'call'results'value raw))
+instance (Classes.Marshal Function'call'results) where
+ marshalInto raw_ value_ = case value_ of
+ Function'call'results{..} ->
+ (do
+ (Capnp.Gen.ById.X85150b117366d14b.set_Function'call'results'value raw_ value)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Function'call'results)
+instance (Classes.Cerialize (V.Vector Function'call'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Function'call'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Function'call'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Function'call'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Function'call'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Decerialize Capnp.Gen.ById.X85150b117366d14b.Operator) where
+ type Cerial msg Capnp.Gen.ById.X85150b117366d14b.Operator = Capnp.Gen.ById.X85150b117366d14b.Operator
+ decerialize = Std_.pure
+instance (Classes.Cerialize Capnp.Gen.ById.X85150b117366d14b.Operator) where
+ cerialize _ = Std_.pure
+instance (Classes.Cerialize (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator)) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator)))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator)))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X85150b117366d14b.Operator))))))) where
+ cerialize = Classes.cerializeBasicVec
diff --git a/examples/gen/lib/Capnp/Gen/Echo.hs b/examples/gen/lib/Capnp/Gen/Echo.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/Echo.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Echo where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Echo msg
+ = Echo'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Echo msg)) where
+ fromPtr msg ptr = (Echo'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo (Message.MutMsg s))) where
+ toPtr msg (Echo'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Echo'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Echo'echo'params msg
+ = Echo'echo'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Echo'echo'params) where
+ tMsg f (Echo'echo'params'newtype_ s) = (Echo'echo'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Echo'echo'params msg)) where
+ fromStruct struct = (Std_.pure (Echo'echo'params'newtype_ struct))
+instance (Classes.ToStruct msg (Echo'echo'params msg)) where
+ toStruct (Echo'echo'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Echo'echo'params msg)) where
+ type InMessage (Echo'echo'params msg) = msg
+ message (Echo'echo'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Echo'echo'params msg)) where
+ messageDefault msg = (Echo'echo'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Echo'echo'params msg)) where
+ fromPtr msg ptr = (Echo'echo'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo'echo'params (Message.MutMsg s))) where
+ toPtr msg (Echo'echo'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Echo'echo'params (Message.MutMsg s))) where
+ new msg = (Echo'echo'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Echo'echo'params msg)) where
+ newtype List msg (Echo'echo'params msg)
+ = Echo'echo'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Echo'echo'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Echo'echo'params'List_ l) = (Untyped.ListStruct l)
+ length (Echo'echo'params'List_ l) = (Untyped.length l)
+ index i (Echo'echo'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Echo'echo'params (Message.MutMsg s))) where
+ setIndex (Echo'echo'params'newtype_ elt) i (Echo'echo'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Echo'echo'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Echo'echo'params'query :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m (Basics.Text msg))
+get_Echo'echo'params'query (Echo'echo'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Echo'echo'params'query :: ((Untyped.RWCtx m s)) => (Echo'echo'params (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Echo'echo'params'query (Echo'echo'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Echo'echo'params'query :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m Std_.Bool)
+has_Echo'echo'params'query (Echo'echo'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Echo'echo'params'query :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'params (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Echo'echo'params'query len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Echo'echo'params'query struct result)
+ (Std_.pure result)
+ )
+newtype Echo'echo'results msg
+ = Echo'echo'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Echo'echo'results) where
+ tMsg f (Echo'echo'results'newtype_ s) = (Echo'echo'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Echo'echo'results msg)) where
+ fromStruct struct = (Std_.pure (Echo'echo'results'newtype_ struct))
+instance (Classes.ToStruct msg (Echo'echo'results msg)) where
+ toStruct (Echo'echo'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Echo'echo'results msg)) where
+ type InMessage (Echo'echo'results msg) = msg
+ message (Echo'echo'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Echo'echo'results msg)) where
+ messageDefault msg = (Echo'echo'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Echo'echo'results msg)) where
+ fromPtr msg ptr = (Echo'echo'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo'echo'results (Message.MutMsg s))) where
+ toPtr msg (Echo'echo'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Echo'echo'results (Message.MutMsg s))) where
+ new msg = (Echo'echo'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Echo'echo'results msg)) where
+ newtype List msg (Echo'echo'results msg)
+ = Echo'echo'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Echo'echo'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Echo'echo'results'List_ l) = (Untyped.ListStruct l)
+ length (Echo'echo'results'List_ l) = (Untyped.length l)
+ index i (Echo'echo'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Echo'echo'results (Message.MutMsg s))) where
+ setIndex (Echo'echo'results'newtype_ elt) i (Echo'echo'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Echo'echo'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Echo'echo'results'reply :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m (Basics.Text msg))
+get_Echo'echo'results'reply (Echo'echo'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Echo'echo'results'reply :: ((Untyped.RWCtx m s)) => (Echo'echo'results (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Echo'echo'results'reply (Echo'echo'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Echo'echo'results'reply :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m Std_.Bool)
+has_Echo'echo'results'reply (Echo'echo'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Echo'echo'results'reply :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'results (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Echo'echo'results'reply len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Echo'echo'results'reply struct result)
+ (Std_.pure result)
+ )
diff --git a/examples/gen/lib/Capnp/Gen/Echo/Pure.hs b/examples/gen/lib/Capnp/Gen/Echo/Pure.hs
new file mode 100644
--- /dev/null
+++ b/examples/gen/lib/Capnp/Gen/Echo/Pure.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Echo.Pure(Echo(..)
+ ,Echo'server_(..)
+ ,export_Echo
+ ,Echo'echo'params(..)
+ ,Echo'echo'results(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Rpc.Untyped as Rpc
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.GenHelpers.Rpc as RpcHelpers
+import qualified Capnp.GenHelpers.ReExports.Control.Concurrent.STM as STM
+import qualified Capnp.GenHelpers.ReExports.Supervisors as Supervisors
+import qualified Capnp.Gen.ById.Xd0a87f36fa0182f5
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Echo
+ = Echo Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Echo'server_ m cap) where
+ {-# MINIMAL echo'echo #-}
+ echo'echo :: cap -> (Server.MethodHandler m Echo'echo'params Echo'echo'results)
+ echo'echo _ = Server.methodUnimplemented
+export_Echo :: ((Echo'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Echo)
+export_Echo sup_ server_ = (Echo <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 16940812395455687611 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (echo'echo server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Echo) where
+ fromClient = Echo
+ toClient (Echo client) = client
+instance (Classes.FromPtr msg Echo) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Echo) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Echo) where
+ type Cerial msg Echo = (Capnp.Gen.ById.Xd0a87f36fa0182f5.Echo msg)
+ decerialize (Capnp.Gen.ById.Xd0a87f36fa0182f5.Echo'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Echo Message.nullClient))
+ (Std_.Just cap) ->
+ (Echo <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Echo) where
+ cerialize msg (Echo client) = (Capnp.Gen.ById.Xd0a87f36fa0182f5.Echo'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Echo'server_ Std_.IO Echo) where
+ echo'echo (Echo client) = (Rpc.clientMethodHandler 16940812395455687611 0 client)
+data Echo'echo'params
+ = Echo'echo'params
+ {query :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Echo'echo'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Echo'echo'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Echo'echo'params) where
+ type Cerial msg Echo'echo'params = (Capnp.Gen.ById.Xd0a87f36fa0182f5.Echo'echo'params msg)
+ decerialize raw = (Echo'echo'params <$> ((Capnp.Gen.ById.Xd0a87f36fa0182f5.get_Echo'echo'params'query raw) >>= Classes.decerialize))
+instance (Classes.Marshal Echo'echo'params) where
+ marshalInto raw_ value_ = case value_ of
+ Echo'echo'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) query) >>= (Capnp.Gen.ById.Xd0a87f36fa0182f5.set_Echo'echo'params'query raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Echo'echo'params)
+instance (Classes.Cerialize (V.Vector Echo'echo'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Echo'echo'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Echo'echo'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Echo'echo'results
+ = Echo'echo'results
+ {reply :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Echo'echo'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Echo'echo'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Echo'echo'results) where
+ type Cerial msg Echo'echo'results = (Capnp.Gen.ById.Xd0a87f36fa0182f5.Echo'echo'results msg)
+ decerialize raw = (Echo'echo'results <$> ((Capnp.Gen.ById.Xd0a87f36fa0182f5.get_Echo'echo'results'reply raw) >>= Classes.decerialize))
+instance (Classes.Marshal Echo'echo'results) where
+ marshalInto raw_ value_ = case value_ of
+ Echo'echo'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) reply) >>= (Capnp.Gen.ById.Xd0a87f36fa0182f5.set_Echo'echo'results'reply raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Echo'echo'results)
+instance (Classes.Cerialize (V.Vector Echo'echo'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Echo'echo'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Echo'echo'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
diff --git a/examples/lib/Examples/Rpc/CalculatorClient.hs b/examples/lib/Examples/Rpc/CalculatorClient.hs
new file mode 100644
--- /dev/null
+++ b/examples/lib/Examples/Rpc/CalculatorClient.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Examples.Rpc.CalculatorClient (main) where
+
+import Network.Simple.TCP (connect)
+
+import qualified Data.Vector as V
+
+import Capnp (def, defaultLimit)
+import Capnp.Rpc (ConnConfig(..), handleConn, socketTransport, wait, (?))
+import Control.Monad (when)
+
+import Capnp.Gen.Calculator.Pure
+
+main :: IO ()
+main = connect "localhost" "4000" $ \(sock, _addr) ->
+ handleConn (socketTransport sock defaultLimit) def
+ { debugMode = True
+ , withBootstrap = Just $ \_sup client -> do
+ let calc = Calculator client
+
+ Calculator'evaluate'results{value} <-
+ calculator'evaluate calc ? def
+ { expression = Expression'literal 123 }
+ >>= wait
+ Value'read'results{value} <- value'read value ? def >>= wait
+ assertEq value 123
+
+ Calculator'getOperator'results{func=add} <-
+ calculator'getOperator calc ? def { op = Operator'add } >>= wait
+ Calculator'getOperator'results{func=subtract} <-
+ calculator'getOperator calc ? def { op = Operator'subtract } >>= wait
+ Calculator'evaluate'results{value} <- calculator'evaluate calc ? def
+ { expression =
+ Expression'call Expression'call'
+ { function = subtract
+ , params = V.fromList
+ [ Expression'call Expression'call'
+ { function = add
+ , params = V.fromList
+ [ Expression'literal 123
+ , Expression'literal 45
+ ]
+ }
+ , Expression'literal 67
+ ]
+ }
+ }
+ >>= wait
+ Value'read'results{value} <- value'read value ? def >>= wait
+ assertEq value 101
+
+ putStrLn "PASS"
+ }
+
+assertEq :: (Show a, Eq a) => a -> a -> IO ()
+assertEq got want =
+ when (got /= want) $
+ error $ "Got " ++ show got ++ " but wanted " ++ show want
diff --git a/examples/lib/Examples/Rpc/CalculatorServer.hs b/examples/lib/Examples/Rpc/CalculatorServer.hs
new file mode 100644
--- /dev/null
+++ b/examples/lib/Examples/Rpc/CalculatorServer.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Examples.Rpc.CalculatorServer (main) where
+
+import Prelude hiding (subtract)
+
+import Data.Int
+
+import Control.Concurrent.STM (STM, atomically)
+import Control.Monad (when)
+import Network.Simple.TCP (serve)
+import Supervisors (Supervisor)
+
+import qualified Data.Vector as V
+
+import Capnp (def, defaultLimit)
+import Capnp.Rpc
+ ( ConnConfig(..)
+ , handleConn
+ , pureHandler
+ , socketTransport
+ , throwFailed
+ , toClient
+ , wait
+ , (?)
+ )
+
+import Capnp.Gen.Calculator.Pure
+
+newtype LitValue = LitValue Double
+
+instance Value'server_ IO LitValue where
+ value'read = pureHandler $ \(LitValue val) _ ->
+ pure Value'read'results { value = val }
+
+newtype OpFunc = OpFunc (Double -> Double -> Double)
+
+instance Function'server_ IO OpFunc where
+ function'call = pureHandler $ \(OpFunc op) Function'call'params{params} -> do
+ when (V.length params /= 2) $
+ throwFailed "Wrong number of parameters."
+ pure Function'call'results
+ { value = (params V.! 0) `op` (params V.! 1) }
+
+data ExprFunc = ExprFunc
+ { paramCount :: !Int32
+ , body :: Expression
+ }
+
+instance Function'server_ IO ExprFunc where
+ function'call =
+ pureHandler $ \ExprFunc{..} Function'call'params{params} -> do
+ when (fromIntegral (V.length params) /= paramCount) $
+ throwFailed "Wrong number of parameters."
+ Function'call'results <$> eval params body
+
+data MyCalc = MyCalc
+ { add :: Function
+ , subtract :: Function
+ , multiply :: Function
+ , divide :: Function
+ , sup :: Supervisor
+ }
+
+instance Calculator'server_ IO MyCalc where
+ calculator'evaluate =
+ pureHandler $ \MyCalc{sup} Calculator'evaluate'params{expression} ->
+ Calculator'evaluate'results <$>
+ (eval V.empty expression >>= atomically . export_Value sup . LitValue)
+
+ calculator'getOperator =
+ pureHandler $ \MyCalc{..} Calculator'getOperator'params{op} ->
+ Calculator'getOperator'results <$> case op of
+ Operator'add -> pure add
+ Operator'subtract -> pure subtract
+ Operator'multiply -> pure multiply
+ Operator'divide -> pure divide
+
+ Operator'unknown' _ ->
+ throwFailed "Unknown operator"
+
+ calculator'defFunction =
+ pureHandler $ \MyCalc{sup} Calculator'defFunction'params{..} ->
+ Calculator'defFunction'results <$>
+ atomically (export_Function sup ExprFunc{..})
+
+newCalculator :: Supervisor -> STM Calculator
+newCalculator sup = do
+ add <- export_Function sup $ OpFunc (+)
+ subtract <- export_Function sup $ OpFunc (-)
+ multiply <- export_Function sup $ OpFunc (*)
+ divide <- export_Function sup $ OpFunc (/)
+ export_Calculator sup MyCalc{..}
+
+eval :: V.Vector Double -> Expression -> IO Double
+eval _ (Expression'literal lit) =
+ pure lit
+eval _ (Expression'previousResult val) = do
+ Value'read'results{value} <- value'read val ? def >>= wait
+ pure value
+eval args (Expression'parameter idx)
+ | fromIntegral idx >= V.length args =
+ throwFailed "Parameter index out of bounds"
+ | otherwise =
+ pure $ args V.! fromIntegral idx
+eval outerParams (Expression'call Expression'call'{function, params=innerParams}) = do
+ args' <- traverse (eval outerParams) innerParams
+ Function'call'results{value} <-
+ function'call function ? Function'call'params { params = args' }
+ >>= wait
+ pure value
+eval _ (Expression'unknown' _) =
+ throwFailed "Unknown expression type"
+
+main :: IO ()
+main = serve "localhost" "4000" $ \(sock, _addr) ->
+ handleConn (socketTransport sock defaultLimit) def
+ { getBootstrap = fmap (Just . toClient) . newCalculator
+ , debugMode = True
+ }
diff --git a/exe/capnpc-haskell/Backends/Common.hs b/exe/capnpc-haskell/Backends/Common.hs
deleted file mode 100644
--- a/exe/capnpc-haskell/Backends/Common.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/exe/capnpc-haskell/Backends/Pure.hs
+++ /dev/null
@@ -1,426 +0,0 @@
-{-# 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 Fmt
-import IR
-import Util
-
--- | 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 #-}"
- , "{-# OPTIONS_HADDOCK hide #-}"
- , "{- |"
- , 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 DefStruct{}) =
- fmtName Pure thisMod name <> "(..)"
-fmtExport thisMod (name, DeclDef DefUnion{}) =
- fmtName Pure thisMod name <> "(..)"
-
--- These are 'Raw' because we're just re-exporting them:
-fmtExport thisMod (name, DeclDef DefEnum{}) =
- fmtName Raw thisMod name <> "(..)"
-fmtExport thisMod (name, DeclConst VoidConst) =
- fmtName Raw thisMod (valueName name)
-fmtExport thisMod (name, DeclConst WordConst{}) =
- fmtName Raw thisMod (valueName name)
-
-fmtExport thisMod (name, DeclConst _) =
- fmtName Pure thisMod (valueName name)
-
-fmtImport :: ModRefType -> Import -> PP.Doc
-fmtImport ty (Import ref) = "import qualified " <> fmtModRef ty ref
-
-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 case value of
- -- For word types, We just re-export the definitions from the
- -- low-level module, so we don't need to declare anything here:
- VoidConst -> ""
- WordConst{} -> ""
-
- PtrConst{ptrType} -> vcat
- [ hcat [ pureName, " :: ", fmtType thisMod (PtrType ptrType) ]
- , hcat [ pureName, " = PH'.toPurePtrConst ", rawName ]
- ]
-
-fmtDataDef :: Id -> Name -> DataDef -> PP.Doc
-fmtDataDef thisMod dataName DefEnum{} =
- -- We end up re-exporting these, but doing nothing else.
- ""
-fmtDataDef thisMod dataName dataDef =
- let rawName = fmtName Raw thisMod dataName
- pureName = fmtName Pure thisMod dataName
-
- unknownName = subName dataName "unknown'"
- in vcat
- [ case dataDef of
- DefEnum{} ->
- -- TODO: refactor so we don't need this case.
- error "BUG: this should have been ruled out above."
- DefStruct StructDef{fields,info} ->
- let dataVariant =
- -- TODO: some of the functions we use still expect structs
- -- to just be single-variant unions; this is a stand-in,
- -- but we should update those at some point.
- Variant
- { variantName = dataName
- , variantParams = Record fields
- , variantTag = 0 -- doesn't matter; just formatting
- -- the data constructor, so this
- -- isn't used.
- }
- in vcat
- [ data_ (fmtName Pure thisMod dataName)
- [ fmtVariant thisMod dataVariant ]
- ["Show", "Read", "Eq", "Generic"]
- , instance_ [] ("C'.Decerialize " <> pureName)
- [ hcat [ "type Cerial msg ", pureName, " = ", rawName, " msg" ]
- , "decerialize raw = do"
- , indent $ fmtDecerializeArgs dataName fields
- ]
- , instance_ [] ("C'.Marshal " <> pureName)
- [ "marshalInto raw value = do"
- , indent $ vcat
- [ "case value of\n"
- , indent $ vcat
- [ fmtCerializeVariant False dataVariant ]
- ]
- ]
- , case info of
- IsStandalone{} ->
- instance_ [] ("C'.Cerialize s " <> pureName)
- []
- _ ->
- ""
- ]
- DefUnion{dataVariants,parentStructName,parentStruct=StructDef{info}} ->
- let unknownVariantName = subName parentStructName "unknown'"
- in vcat
- [ data_
- (fmtName Pure thisMod dataName)
- (map (fmtVariant thisMod) dataVariants ++
- [ fmtName Pure thisMod unknownVariantName <> " Word16" ]
- )
- ["Show", "Read", "Eq", "Generic"]
- , instance_ [] ("C'.Decerialize " <> pureName)
- [ hcat [ "type Cerial msg ", pureName, " = ", rawName, " msg" ]
- , "decerialize raw = do"
- , indent $ vcat
- [ hcat [ "raw <- ", fmtName Raw thisMod $ prefixName "get_" (subName dataName ""), " raw" ]
- , "case raw of"
- , indent $ vcat
- [ vcat (map fmtDecerializeVariant dataVariants)
- , hcat
- [ fmtName Raw thisMod unknownName, " val -> pure $ "
- , fmtName Pure thisMod unknownVariantName, " val"
- ]
- ]
- ]
- ]
- , instance_ [] ("C'.Marshal " <> pureName)
- [ "marshalInto raw value = do"
- , indent $ vcat
- [ "case value of\n"
- , indent $ vcat
- [ vcat $ map (fmtCerializeVariant True) dataVariants
- , hcat
- [ fmtName Pure thisMod unknownVariantName, " arg_ -> "
- , fmtName Raw thisMod $ prefixName "set_" unknownName, " raw arg_"
- ]
- ]
- ]
- ]
- , case info of
- IsStandalone{} ->
- instance_ [] ("C'.Cerialize s " <> pureName)
- []
- _ ->
- ""
- ]
- , instance_ [] ("C'.FromStruct M'.ConstMsg " <> pureName)
- [ "fromStruct struct = do"
- , indent $ vcat
- [ "raw <- C'.fromStruct struct"
- , hcat [ "C'.decerialize (raw :: ", rawName, " M'.ConstMsg)" ]
- ]
- ]
- , instance_ [] ("Default " <> pureName)
- [ "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
deleted file mode 100644
--- a/exe/capnpc-haskell/Backends/Raw.hs
+++ /dev/null
@@ -1,669 +0,0 @@
--- Generate low-level accessors from type types in IR.
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-module Backends.Raw
- ( fmtModule
- ) where
-
-import Data.Function ((&))
-import Data.List (sortOn)
-import Data.Monoid ((<>))
-import Data.Ord (Down(..))
-import Data.String (IsString(..))
-import GHC.Exts (IsList(fromList))
-import Text.PrettyPrint.Leijen.Text (hcat, vcat)
-import Text.Printf (printf)
-
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Map.Strict as M
-import qualified Data.Text as T
-import qualified Text.PrettyPrint.Leijen.Text as PP
-
-import Fmt
-import IR
-import Util
-
-import Backends.Common (dataFieldSize, fmtPrimWord)
-
-import Data.Capnp
- (cerialize, createPure, defaultLimit, msgToLBS, newMessage, setRoot)
-
-import qualified Data.Capnp.Untyped.Pure as Untyped
-
--- | Sort varaints by their tag, in decending order (with no tag at all being last).
-sortVariants = sortOn (Down . variantTag)
-
-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 #-}"
- , "{-# OPTIONS_HADDOCK hide #-}"
- , "{- |"
- , 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"
- , "import qualified Data.ByteString"
- -- The trailing ' is to avoid possible name collisions:
- , "import qualified Data.Capnp.Classes as C'"
- , "import qualified Data.Capnp.Basics as B'"
- , "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 =
- instance_ [] ("C'.IsPtr msg (B'.List msg (" <> nameText <> " msg))")
- [ hcat [ "fromPtr msg ptr = List_", nameText, " <$> C'.fromPtr msg ptr" ]
- , hcat [ "toPtr (List_", nameText, " l) = C'.toPtr l" ]
- ]
-
--- | Generate declarations common to all types which are represented
--- by 'Untyped.Struct'.
---
--- parameters:
---
--- * thisMod - the module that we are generating.
--- * name - the name of the type.
--- * info - the StructInfo; this is a group, some instances will be skipped.
-fmtNewtypeStruct :: Module -> Name -> IR.StructInfo -> PP.Doc
-fmtNewtypeStruct thisMod name info =
- let typeCon = fmtName thisMod name
- dataCon = typeCon <> "_newtype_"
- in vcat
- [ hcat [ "newtype ", typeCon, " msg = ", dataCon, " (U'.Struct msg)" ]
- , instance_ [] ("C'.FromStruct msg (" <> typeCon <> " msg)")
- [ hcat [ "fromStruct = pure . ", dataCon ]
- ]
- , instance_ [] ("C'.ToStruct msg (" <> typeCon <> " msg)")
- [ hcat [ "toStruct (", dataCon, " struct) = struct" ]
- ]
- , instance_ [] ("U'.HasMessage (" <> typeCon <> " msg)")
- [ hcat [ "type InMessage (", typeCon, " msg) = msg" ]
- , hcat [ "message (", dataCon, " struct) = U'.message struct" ]
- ]
- , instance_ [] ("U'.MessageDefault (" <> typeCon <> " msg)")
- [ hcat [ "messageDefault = ", dataCon, " . U'.messageDefault" ]
- ]
- , case info of
- IR.IsGroup ->
- ""
- IR.IsStandalone{dataSz, ptrSz} -> vcat
- [ fmtStructListElem typeCon
- , instance_ [] ("C'.IsPtr msg (" <> typeCon <> " msg)")
- [ hcat [ "fromPtr msg ptr = ", dataCon, " <$> C'.fromPtr msg ptr" ]
- , hcat [ "toPtr (", dataCon, " struct) = C'.toPtr struct" ]
- ]
- , instance_ [] ("B'.MutListElem s (" <> typeCon <> " (M'.MutMsg s))")
- [ hcat [ "setIndex (", dataCon, " elt) i (List_", typeCon, " l) = U'.setIndex elt i l" ]
- , hcat
- [ "newList msg len = List_", typeCon, " <$> U'.allocCompositeList msg "
- , fromString (show dataSz), " "
- , fromString (show ptrSz), " len"
- ]
- ]
- , instance_ [] ("C'.Allocate s (" <> typeCon <> " (M'.MutMsg s))")
- [ hcat
- [ "new msg = ", dataCon , " <$> U'.allocStruct msg "
- , fromString (show dataSz), " "
- , fromString (show ptrSz)
- ]
- ]
- , fmtStructListIsPtr typeCon
- ]
- ]
-
--- | 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 =
- instance_ [] ("B'.ListElem msg (" <> nameText <> " msg)")
- [ hcat [ "newtype List msg (", nameText, " msg) = List_", nameText, " (U'.ListOf msg (U'.Struct msg))" ]
- , hcat [ "length (List_", nameText, " l) = U'.length l" ]
- , hcat [ "index i (List_", nameText, " l) = U'.index i l >>= ", fmtRestrictedFromStruct nameText ]
- ]
-
--- | Output an expression equivalent to fromStruct, but restricted to the type
--- with the given type constructor (which must have kind * -> *).
-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 =
- case fieldLocType of
- PtrField idx _ -> vcat
- [ hcat [ hasName, " :: U'.ReadCtx m msg => ", typeCon, " msg -> m Bool" ]
- , hcat
- [ hasName, "(", dataCon, " struct) = "
- , "Data.Maybe.isJust <$> U'.getPtr "
- , fromString (show idx)
- , " struct"
- ]
- ]
- _ ->
- ""
- fmtSetter =
- let setType fieldType = typeCon <> " (M'.MutMsg s) -> " <> fmtType thisMod "(M'.MutMsg s)" fieldType <> " -> m ()"
- typeAnnotation fieldType = setName <> " :: U'.RWCtx m s => " <> setType fieldType
- 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 -> Maybe Variant -> PP.Doc
-fmtUnionSetter thisMod parentType tagLoc variant =
- let (variantName, variantParams) = case variant of
- Just Variant{..} ->
- (variantName, Just variantParams)
- Nothing ->
- ( subName parentType "unknown'"
- , Nothing
- )
- accessorName prefix = prefix <> fmtName thisMod variantName
- setName = "set_" <> fmtName thisMod variantName
- parentTypeCon = fmtName thisMod parentType
- parentDataCon = parentTypeCon <> "_newtype_"
- fmtSetTag = fmtSetWordField
- "struct"
- (case variant of
- Just Variant{variantTag} ->
- hcat [ "(", fromString (show variantTag), " :: Word16)" ]
- Nothing ->
- "(tagValue :: Word16)")
- tagLoc
- in case variantParams of
- Nothing -> vcat
- [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> Word16 -> m ()" ]
- , hcat
- [ setName, "(", parentDataCon, " struct) tagValue = "
- , fmtSetTag
- ]
- ]
- Just (Record _) ->
- -- Variant is a group; we return a reference to the group so the user can
- -- modify it.
- let childTypeCon = fmtName thisMod (subName variantName "group'")
- 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" ]
- ]
- ]
- Just (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
- ]
- ]
- Just (Unnamed _ fieldLocType@(PtrField index typ)) -> vcat
- [ hcat
- [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> "
- , fmtType thisMod "(M'.MutMsg s)" (PtrType typ), " -> m ()"
- ]
- , 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
- ]
- Just (Unnamed _ VoidField) -> vcat
- [ hcat [ setName, " :: U'.RWCtx m s => ", parentTypeCon, " (M'.MutMsg s) -> m ()" ]
- , hcat [ setName, " (", parentDataCon, " struct) = ", fmtSetTag ]
- ]
- Just (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, " = ()" ]
- ]
- PtrConst{ptrType,ptrValue} ->
- vcat
- [ hcat [ nameText, " :: ", fmtType thisMod "M'.ConstMsg" (PtrType ptrType) ]
- , hcat
- [ nameText, " = H'.getPtrConst $ Data.ByteString.pack "
- , makePtrByteList ptrValue
- ]
- ]
- where
- makePtrByteList ptr =
- let assertRight (Left e) = error (show e)
- assertRight (Right v) = v
- msg = assertRight $ createPure defaultLimit $ do
- msg <- newMessage
- rootPtr <- cerialize msg $ Untyped.Struct
- (fromList [])
- (fromList [ptr])
- setRoot rootPtr
- pure msg
- in
- msgToLBS msg &
- LBS.unpack &
- show &
- T.pack &
- PP.textStrict
-
-fmtDataDef :: Module -> Name -> DataDef -> PP.Doc
-fmtDataDef thisMod dataName (DefStruct StructDef{fields, info}) = vcat
- [ fmtNewtypeStruct thisMod dataName info
- , vcat $ map (fmtFieldAccessor thisMod dataName dataName) fields
- ]
-fmtDataDef thisMod dataName DefUnion{dataVariants,dataTagLoc,parentStruct=StructDef{info}} =
- let unionName = subName dataName ""
- unionNameText = fmtName thisMod unionName
- unknownName = subName dataName "unknown'"
- in vcat
- [ fmtNewtypeStruct thisMod dataName info
- , data_
- (unionNameText <> " msg")
- (map fmtDataVariant dataVariants ++
- [fmtName thisMod unknownName <> " Word16"]
- )
- []
- , fmtFieldAccessor thisMod dataName dataName Field
- { fieldName = ""
- , fieldLocType = HereField $ StructType unionName []
- }
- , vcat $ map (fmtUnionSetter thisMod dataName dataTagLoc . Just) dataVariants
- , fmtUnionSetter thisMod dataName dataTagLoc Nothing
- -- Generate auxiliary newtype definitions for group fields:
- , vcat $ map fmtVariantAuxNewtype dataVariants
- , instance_ [] ("C'.FromStruct msg (" <> unionNameText <> " msg)")
- [ vcat
- [ "fromStruct struct = do"
- , indent $ vcat
- [ hcat [ "tag <- ", fmtGetWordField "struct" dataTagLoc ]
- , "case tag of"
- , indent $ vcat
- [ vcat $ map fmtVariantCase $ sortVariants dataVariants
- , hcat [ "_ -> pure $ ", fmtName thisMod unknownName, " tag" ]
- ]
- ]
- ]
- ]
- ]
- 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 hcat
- [ fromString (show variantTag), " -> "
- , case variantParams of
- Record _ -> nameText <> " <$> C'.fromStruct struct"
- Unnamed _ (HereField _) -> nameText <> " <$> C'.fromStruct struct"
- Unnamed _ VoidField ->
- "pure " <> nameText
- Unnamed _ (DataField loc _) ->
- nameText <> " <$> " <> fmtGetWordField "struct" loc
- Unnamed _ (PtrField idx _) -> hcat
- [ nameText," <$> "
- , " (U'.getPtr ", fromString (show idx), " struct"
- , " >>= C'.fromPtr (U'.message struct))"
- ]
- ]
- fmtVariantAuxNewtype Variant{variantName, variantParams=Record fields} =
- let typeName = subName variantName "group'"
- in vcat
- [ fmtNewtypeStruct thisMod typeName IR.IsGroup
- , vcat $ map (fmtFieldAccessor thisMod typeName variantName) fields
- ]
- fmtVariantAuxNewtype _ = ""
-fmtDataDef thisMod dataName (DefEnum enumerants) =
- let typeName = fmtName thisMod dataName
- unknownName = subName dataName "unknown'"
- in vcat
- [ data_ typeName
- (map (fmtName thisMod) enumerants ++
- [fmtName thisMod unknownName <> " Word16"]
- )
- ["Show", "Read", "Eq", "Generic"]
- -- Generate an Enum instance. This is a trivial wrapper around the
- -- IsWord instance, below.
- , instance_ [] ("Enum " <> typeName)
- [ "toEnum = C'.fromWord . fromIntegral"
- , "fromEnum = fromIntegral . C'.toWord"
- ]
- -- Generate an IsWord instance.
- , instance_ [] ("C'.IsWord " <> typeName)
- [ "fromWord n = go (fromIntegral n :: Word16) where"
- , indent $ vcat $
- zipWith fmtFromWordCase enumerants [0..]
- ++
- [ hcat
- [ "go tag = "
- , fmtName thisMod unknownName
- , " (fromIntegral tag)"
- ]
- ]
- , vcat $
- zipWith fmtToWordCase enumerants [0..]
- ++
- [ hcat [ "toWord (", fmtName thisMod unknownName, " tag) = fromIntegral tag" ] ]
- ]
- , instance_ [] ("B'.ListElem msg " <> typeName)
- [ hcat [ "newtype List msg ", typeName, " = List_", typeName, " (U'.ListOf msg Word16)" ]
- , hcat [ "length (List_", typeName, " l) = U'.length l" ]
- , hcat [ "index i (List_", typeName, " l) = (C'.fromWord . fromIntegral) <$> U'.index i l" ]
- ]
- , instance_ [] ("B'.MutListElem s " <> typeName)
- [ hcat [ "setIndex elt i (List_", typeName, " l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l" ]
- , hcat [ "newList msg size = List_", typeName, " <$> U'.allocList16 msg size" ]
- ]
- , instance_ [] ("C'.IsPtr msg (B'.List msg " <> typeName <> ")")
- [ hcat [ "fromPtr msg ptr = List_", typeName, " <$> C'.fromPtr msg ptr" ]
- , hcat [ "toPtr (List_", typeName, " l) = C'.toPtr l" ]
- ]
- ]
- where
- -- | Format an equation in an enum's IsWord.fromWord implementation.
- fmtFromWordCase name ordinal =
- hcat [ "go ", fromString (show ordinal), " = ", fmtName thisMod name ]
- -- | Format an equation in an enum's IsWord.toWord implementation.
- fmtToWordCase name ordinal =
- hcat [ "toWord ", fmtName thisMod name, " = ", fromString (show ordinal) ]
-
--- | @'fmtType ident msg ty@ formats the type @ty@ from module @ident@,
--- using @msg@ as the message parameter, if any.
-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/Fmt.hs b/exe/capnpc-haskell/Fmt.hs
deleted file mode 100644
--- a/exe/capnpc-haskell/Fmt.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-|
-Module: Fmt
-Description: Helpers for generating haskell code.
-
-This module defines combinators for generating haskell code, on top of
-wl-pprint.
-
-We will expand this to cover more constructs, make it more type safe,
-and so forth as we go.
--}
-module Fmt where
-
-import Text.PrettyPrint.Leijen.Text (Doc, hcat, vcat)
-
-import qualified Text.PrettyPrint.Leijen.Text as PP
-
-indent = PP.indent 4
-
--- | @'data_' typeCon dataCons derving_@ generates a @data@
--- declaration. @typeCon@ is the texst of the type constructor
--- *and type parameters*. @dataCons@ are the data constructors.
--- @deriving_@ is a list of type classes to go in the deriving
--- clause, if any.
-data_ :: Doc -> [Doc] -> [Doc] -> Doc
-data_ typeCon dataCons deriving_ = vcat
- [ hcat [ "data ", typeCon ]
- , indent $ vcat
- [ case dataCons of
- (d:ds) -> vcat $
- ("= " <> d) : map ("| " <>) ds
- [] ->
- ""
- , case deriving_ of
- [] -> ""
- _ -> "deriving" <> PP.tupled deriving_
- ]
- ]
-
--- @'instance_' ctx typeCon defs@ defines an instance for @typeCon@
--- given the context @ctx@. @defs@ is the set of definitions in the
--- instance.
-instance_ :: [Doc] -> Doc -> [Doc] -> Doc
-instance_ ctx typeCon defs = vcat
- [ hcat
- [ "instance "
- , case ctx of
- [] -> ""
- [one] -> one <> " => "
- _ -> PP.tupled ctx <> " => "
- , typeCon
- , case defs of
- [] -> ""
- _ -> " where"
- ]
- , indent $ vcat defs
- ]
diff --git a/exe/capnpc-haskell/FrontEnd.hs b/exe/capnpc-haskell/FrontEnd.hs
deleted file mode 100644
--- a/exe/capnpc-haskell/FrontEnd.hs
+++ /dev/null
@@ -1,541 +0,0 @@
-{-# 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 Data.Text.Encoding (encodeUtf8)
-import Util (Id, splitOn)
-
-import qualified Data.ByteString as BS
-import qualified Data.Map.Strict as M
-import qualified Data.Text as T
-import qualified Data.Vector as V
-
-import Capnp.Capnp.Schema.Pure
-
-import Backends.Common (dataFieldSize)
-
-import qualified Data.Capnp.Untyped.Pure as Untyped
-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
- unionName = IR.subName name ""
-
- structDef = IR.StructDef
- { fields = formatStructBody thisModule nodeMap typeName allFields
- , info = if isGroup
- then IR.IsGroup
- else IR.IsStandalone
- { dataSz = dataWordCount
- , ptrSz = pointerCount
- }
- }
- bodyFields = IR.DeclDef (IR.DefStruct structDef)
-
- bodyUnion = IR.DeclDef IR.DefUnion
- { dataVariants =
- map (generateVariant thisModule nodeMap name) unionFields
- , dataTagLoc = dataLoc
- discriminantOffset
- (IR.PrimWord IR.PrimInt{isSigned = False, size = 16})
- -- The default value for a union tag is always zero:
- (Value'uint16 0)
- , parentStructName = name
- , parentStruct = structDef
- }
-
- 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.
- [ ( typeName, 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.
- [ ( typeName, bodyFields )
- , ( unionName, bodyUnion )
- ]
- Node'enum{..} ->
- [ ( name
- , IR.DeclDef $ IR.DefEnum $ map
- (\Enumerant{name=variantName} ->
- IR.subName name variantName
- )
- (V.toList enumerants)
- )
- ]
- 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))]
- Node'const{type_=Type'text,value=Value'text v} ->
- [ ( name
- , IR.DeclConst IR.PtrConst
- { ptrType = IR.PrimPtr IR.PrimText
- , ptrValue = Just $ Untyped.PtrList $ Untyped.List8 $
- encodeUtf8 v
- & BS.unpack
- & (++ [0])
- & V.fromList
- }
- )
- ]
- Node'const{type_=Type'data_,value=Value'data_ v} ->
- [ ( name
- , IR.DeclConst IR.PtrConst
- { ptrType = IR.PrimPtr IR.PrimData
- , ptrValue = Just $ Untyped.PtrList $ Untyped.List8 $
- BS.unpack v
- & V.fromList
- }
- )
- ]
- Node'const{type_=Type'list{elementType},value=Value'list v} ->
- [ ( name
- , IR.DeclConst IR.PtrConst
- { ptrType = IR.ListOf (formatType thisModule nodeMap elementType)
- , ptrValue = v
- }
- )
- ]
- Node'const{type_=Type'enum{typeId},value=Value'enum v} ->
- -- TODO: do something with brand.
- [ ( name
- , IR.DeclConst IR.WordConst
- { wordValue = fromIntegral v
- , wordType = IR.EnumType $ identifierFromMetaData thisModule (nodeMap M.! typeId)
- }
- )
- ]
- -- TODO: group constants?
- Node'const{type_=Type'struct{typeId},value=Value'struct v} ->
- [ ( name
- , IR.DeclConst IR.PtrConst
- { ptrType = IR.PtrComposite $ IR.StructType
- (identifierFromMetaData thisModule (nodeMap M.! typeId))
- []
- , ptrValue = v
- }
- )
- ]
- -- TODO: interface constants
- Node'const
- { type_=Type'anyPointer{union'=Type'anyPointer'unconstrained{union'}}
- , value=Value'anyPointer v
- } ->
- [ ( name
- , IR.DeclConst IR.PtrConst
- { ptrValue = v
- , ptrType = IR.PrimPtr $ IR.PrimAnyPtr $ case union' of
- Type'anyPointer'unconstrained'anyKind -> IR.Ptr
- Type'anyPointer'unconstrained'struct -> IR.Struct
- Type'anyPointer'unconstrained'list -> IR.List
-
- -- TODO: we'll want to restrict this once we actually
- -- support interfaces:
- Type'anyPointer'unconstrained'capability -> IR.Ptr
-
- Type'anyPointer'unconstrained'unknown' _ -> IR.Ptr
- }
- )
- ]
- -- TODO: "constrained" anyPointer constants. This has to wait until
- -- we support type parameters.
- _ -> [] -- TODO
-
-primWordConst :: Integral a => IR.PrimWord -> a -> IR.Decl
-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
- }
-
--- | 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.Field]
-formatStructBody thisModule nodeMap parentName fields =
- 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 = discriminantValue
- }
- Field'group{..} ->
- let NodeMetaData{node=node@Node{..},..} = nodeMap M.! typeId
- in case union' of
- Node'struct{..} -> IR.Variant
- { variantName
- , variantParams =
- IR.Record $ formatStructBody thisModule nodeMap variantName $ V.toList fields
- , variantTag = 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 = discriminantValue
- }
- 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
deleted file mode 100644
--- a/exe/capnpc-haskell/IR.hs
+++ /dev/null
@@ -1,262 +0,0 @@
-{-# 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(..)
- , StructDef(..)
- , Const(..)
- , FieldLocType(..)
- , DataLoc(..)
- , StructInfo(..)
- , 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
-
-import qualified Data.Capnp.Untyped.Pure as Untyped
-
-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 :: !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
- | PtrConst
- { ptrValue :: Maybe Untyped.PtrType
- , ptrType :: PtrType
- }
- deriving(Show, Read, Eq)
-
-data DataDef
- = DefUnion
- { dataVariants :: [Variant]
- -- | The location of the tag for the union.
- , dataTagLoc :: DataLoc
- -- | The name of the containing struct.
- , parentStructName :: Name
- , parentStruct :: StructDef
- }
- | DefStruct StructDef
- | DefEnum [Name]
- deriving(Show, Read, Eq)
-
-data StructDef = StructDef
- { fields :: [Field]
- , info :: StructInfo
- }
- deriving(Show, Read, Eq)
-
-data StructInfo
- = IsGroup
- -- ^ The struct is really a group.
- | IsStandalone
- { dataSz :: !Word16
- , ptrSz :: !Word16
- }
- -- ^ The struct is a full-fledged struct that can be directly
- -- allocated, stored in a list, etc. Info contains the sizes
- -- of its sections.
- deriving(Show, Read, Eq)
-
--- | The type and location of a field.
-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
deleted file mode 100644
--- a/exe/capnpc-haskell/Main.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-| 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 (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
deleted file mode 100644
--- a/exe/capnpc-haskell/Util.hs
+++ /dev/null
@@ -1,28 +0,0 @@
--- | 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/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34.hs b/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X8ef99297a43a5e34(module Capnp.Gen.Capnp.Json) where
+import Capnp.Gen.Capnp.Json
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34/Pure.hs b/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/X8ef99297a43a5e34/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X8ef99297a43a5e34.Pure(module Capnp.Gen.Capnp.Json.Pure) where
+import Capnp.Gen.Capnp.Json.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1.hs b/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xa184c7885cdaf2a1(module Capnp.Gen.Capnp.RpcTwoparty) where
+import Capnp.Gen.Capnp.RpcTwoparty
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1/Pure.hs b/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xa184c7885cdaf2a1/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xa184c7885cdaf2a1.Pure(module Capnp.Gen.Capnp.RpcTwoparty.Pure) where
+import Capnp.Gen.Capnp.RpcTwoparty.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9.hs b/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xa93fc509624c72d9(module Capnp.Gen.Capnp.Schema) where
+import Capnp.Gen.Capnp.Schema
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9/Pure.hs b/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xa93fc509624c72d9/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xa93fc509624c72d9.Pure(module Capnp.Gen.Capnp.Schema.Pure) where
+import Capnp.Gen.Capnp.Schema.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xb312981b2552a250.hs b/gen/lib/Capnp/Gen/ById/Xb312981b2552a250.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xb312981b2552a250.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xb312981b2552a250(module Capnp.Gen.Capnp.Rpc) where
+import Capnp.Gen.Capnp.Rpc
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xb312981b2552a250/Pure.hs b/gen/lib/Capnp/Gen/ById/Xb312981b2552a250/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xb312981b2552a250/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xb312981b2552a250.Pure(module Capnp.Gen.Capnp.Rpc.Pure) where
+import Capnp.Gen.Capnp.Rpc.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xb8630836983feed7.hs b/gen/lib/Capnp/Gen/ById/Xb8630836983feed7.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xb8630836983feed7.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xb8630836983feed7(module Capnp.Gen.Capnp.Persistent) where
+import Capnp.Gen.Capnp.Persistent
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xb8630836983feed7/Pure.hs b/gen/lib/Capnp/Gen/ById/Xb8630836983feed7/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xb8630836983feed7/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xb8630836983feed7.Pure(module Capnp.Gen.Capnp.Persistent.Pure) where
+import Capnp.Gen.Capnp.Persistent.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81.hs b/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xbdf87d7bb8304e81(module Capnp.Gen.Capnp.Cxx) where
+import Capnp.Gen.Capnp.Cxx
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81/Pure.hs b/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/ById/Xbdf87d7bb8304e81/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.Xbdf87d7bb8304e81.Pure(module Capnp.Gen.Capnp.Cxx.Pure) where
+import Capnp.Gen.Capnp.Cxx.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/Capnp/Cxx.hs b/gen/lib/Capnp/Gen/Capnp/Cxx.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Cxx.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Cxx where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/Capnp/Cxx/Pure.hs b/gen/lib/Capnp/Gen/Capnp/Cxx/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Cxx/Pure.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Cxx.Pure() where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/lib/Capnp/Gen/Capnp/Json.hs b/gen/lib/Capnp/Gen/Capnp/Json.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Json.hs
@@ -0,0 +1,403 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Json where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Value msg
+ = Value'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value) where
+ tMsg f (Value'newtype_ s) = (Value'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value msg)) where
+ fromStruct struct = (Std_.pure (Value'newtype_ struct))
+instance (Classes.ToStruct msg (Value msg)) where
+ toStruct (Value'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value msg)) where
+ type InMessage (Value msg) = msg
+ message (Value'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value msg)) where
+ messageDefault msg = (Value'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value msg)) where
+ fromPtr msg ptr = (Value'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value (Message.MutMsg s))) where
+ toPtr msg (Value'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value (Message.MutMsg s))) where
+ new msg = (Value'newtype_ <$> (Untyped.allocStruct msg 2 1))
+instance (Basics.ListElem msg (Value msg)) where
+ newtype List msg (Value msg)
+ = Value'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'List_ l) = (Untyped.ListStruct l)
+ length (Value'List_ l) = (Untyped.length l)
+ index i (Value'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value (Message.MutMsg s))) where
+ setIndex (Value'newtype_ elt) i (Value'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'List_ <$> (Untyped.allocCompositeList msg 2 1 len))
+data Value' msg
+ = Value'null
+ | Value'boolean Std_.Bool
+ | Value'number Std_.Double
+ | Value'string (Basics.Text msg)
+ | Value'array (Basics.List msg (Value msg))
+ | Value'object (Basics.List msg (Value'Field msg))
+ | Value'call (Value'Call msg)
+ | Value'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Value' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Value'null)
+ 1 ->
+ (Value'boolean <$> (GenHelpers.getWordField struct 0 16 0))
+ 2 ->
+ (Value'number <$> (GenHelpers.getWordField struct 1 0 0))
+ 3 ->
+ (Value'string <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 4 ->
+ (Value'array <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 5 ->
+ (Value'object <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 6 ->
+ (Value'call <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Value'unknown' (Std_.fromIntegral tag)))
+ )
+get_Value' :: ((Untyped.ReadCtx m msg)) => (Value msg) -> (m (Value' msg))
+get_Value' (Value'newtype_ struct) = (Classes.fromStruct struct)
+set_Value'null :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (m ())
+set_Value'null (Value'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Value'boolean :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Value'boolean (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 16 0)
+ )
+set_Value'number :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Value'number (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Value'string :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Value'string (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'array :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Value (Message.MutMsg s))) -> (m ())
+set_Value'array (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'object :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Value'Field (Message.MutMsg s))) -> (m ())
+set_Value'object (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'call :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Value'Call (Message.MutMsg s)) -> (m ())
+set_Value'call (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'unknown' :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Value'unknown' (Value'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Value'Field msg
+ = Value'Field'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value'Field) where
+ tMsg f (Value'Field'newtype_ s) = (Value'Field'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value'Field msg)) where
+ fromStruct struct = (Std_.pure (Value'Field'newtype_ struct))
+instance (Classes.ToStruct msg (Value'Field msg)) where
+ toStruct (Value'Field'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value'Field msg)) where
+ type InMessage (Value'Field msg) = msg
+ message (Value'Field'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value'Field msg)) where
+ messageDefault msg = (Value'Field'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value'Field msg)) where
+ fromPtr msg ptr = (Value'Field'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value'Field (Message.MutMsg s))) where
+ toPtr msg (Value'Field'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value'Field (Message.MutMsg s))) where
+ new msg = (Value'Field'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (Value'Field msg)) where
+ newtype List msg (Value'Field msg)
+ = Value'Field'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'Field'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'Field'List_ l) = (Untyped.ListStruct l)
+ length (Value'Field'List_ l) = (Untyped.length l)
+ index i (Value'Field'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value'Field (Message.MutMsg s))) where
+ setIndex (Value'Field'newtype_ elt) i (Value'Field'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'Field'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_Value'Field'name :: ((Untyped.ReadCtx m msg)) => (Value'Field msg) -> (m (Basics.Text msg))
+get_Value'Field'name (Value'Field'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Value'Field'name :: ((Untyped.RWCtx m s)) => (Value'Field (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Value'Field'name (Value'Field'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Value'Field'name :: ((Untyped.ReadCtx m msg)) => (Value'Field msg) -> (m Std_.Bool)
+has_Value'Field'name (Value'Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Value'Field'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Value'Field (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Value'Field'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Value'Field'name struct result)
+ (Std_.pure result)
+ )
+get_Value'Field'value :: ((Untyped.ReadCtx m msg)) => (Value'Field msg) -> (m (Value msg))
+get_Value'Field'value (Value'Field'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Value'Field'value :: ((Untyped.RWCtx m s)) => (Value'Field (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Value'Field'value (Value'Field'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Value'Field'value :: ((Untyped.ReadCtx m msg)) => (Value'Field msg) -> (m Std_.Bool)
+has_Value'Field'value (Value'Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Value'Field'value :: ((Untyped.RWCtx m s)) => (Value'Field (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
+new_Value'Field'value struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Value'Field'value struct result)
+ (Std_.pure result)
+ )
+newtype Value'Call msg
+ = Value'Call'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value'Call) where
+ tMsg f (Value'Call'newtype_ s) = (Value'Call'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value'Call msg)) where
+ fromStruct struct = (Std_.pure (Value'Call'newtype_ struct))
+instance (Classes.ToStruct msg (Value'Call msg)) where
+ toStruct (Value'Call'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value'Call msg)) where
+ type InMessage (Value'Call msg) = msg
+ message (Value'Call'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value'Call msg)) where
+ messageDefault msg = (Value'Call'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value'Call msg)) where
+ fromPtr msg ptr = (Value'Call'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value'Call (Message.MutMsg s))) where
+ toPtr msg (Value'Call'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value'Call (Message.MutMsg s))) where
+ new msg = (Value'Call'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (Value'Call msg)) where
+ newtype List msg (Value'Call msg)
+ = Value'Call'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'Call'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'Call'List_ l) = (Untyped.ListStruct l)
+ length (Value'Call'List_ l) = (Untyped.length l)
+ index i (Value'Call'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value'Call (Message.MutMsg s))) where
+ setIndex (Value'Call'newtype_ elt) i (Value'Call'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'Call'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_Value'Call'function :: ((Untyped.ReadCtx m msg)) => (Value'Call msg) -> (m (Basics.Text msg))
+get_Value'Call'function (Value'Call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Value'Call'function :: ((Untyped.RWCtx m s)) => (Value'Call (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Value'Call'function (Value'Call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Value'Call'function :: ((Untyped.ReadCtx m msg)) => (Value'Call msg) -> (m Std_.Bool)
+has_Value'Call'function (Value'Call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Value'Call'function :: ((Untyped.RWCtx m s)) => Std_.Int -> (Value'Call (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Value'Call'function len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Value'Call'function struct result)
+ (Std_.pure result)
+ )
+get_Value'Call'params :: ((Untyped.ReadCtx m msg)) => (Value'Call msg) -> (m (Basics.List msg (Value msg)))
+get_Value'Call'params (Value'Call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Value'Call'params :: ((Untyped.RWCtx m s)) => (Value'Call (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Value (Message.MutMsg s))) -> (m ())
+set_Value'Call'params (Value'Call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Value'Call'params :: ((Untyped.ReadCtx m msg)) => (Value'Call msg) -> (m Std_.Bool)
+has_Value'Call'params (Value'Call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Value'Call'params :: ((Untyped.RWCtx m s)) => Std_.Int -> (Value'Call (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Value (Message.MutMsg s))))
+new_Value'Call'params len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Value'Call'params struct result)
+ (Std_.pure result)
+ )
+newtype FlattenOptions msg
+ = FlattenOptions'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg FlattenOptions) where
+ tMsg f (FlattenOptions'newtype_ s) = (FlattenOptions'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (FlattenOptions msg)) where
+ fromStruct struct = (Std_.pure (FlattenOptions'newtype_ struct))
+instance (Classes.ToStruct msg (FlattenOptions msg)) where
+ toStruct (FlattenOptions'newtype_ struct) = struct
+instance (Untyped.HasMessage (FlattenOptions msg)) where
+ type InMessage (FlattenOptions msg) = msg
+ message (FlattenOptions'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (FlattenOptions msg)) where
+ messageDefault msg = (FlattenOptions'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (FlattenOptions msg)) where
+ fromPtr msg ptr = (FlattenOptions'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (FlattenOptions (Message.MutMsg s))) where
+ toPtr msg (FlattenOptions'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (FlattenOptions (Message.MutMsg s))) where
+ new msg = (FlattenOptions'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (FlattenOptions msg)) where
+ newtype List msg (FlattenOptions msg)
+ = FlattenOptions'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (FlattenOptions'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (FlattenOptions'List_ l) = (Untyped.ListStruct l)
+ length (FlattenOptions'List_ l) = (Untyped.length l)
+ index i (FlattenOptions'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (FlattenOptions (Message.MutMsg s))) where
+ setIndex (FlattenOptions'newtype_ elt) i (FlattenOptions'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (FlattenOptions'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_FlattenOptions'prefix :: ((Untyped.ReadCtx m msg)) => (FlattenOptions msg) -> (m (Basics.Text msg))
+get_FlattenOptions'prefix (FlattenOptions'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_FlattenOptions'prefix :: ((Untyped.RWCtx m s)) => (FlattenOptions (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_FlattenOptions'prefix (FlattenOptions'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_FlattenOptions'prefix :: ((Untyped.ReadCtx m msg)) => (FlattenOptions msg) -> (m Std_.Bool)
+has_FlattenOptions'prefix (FlattenOptions'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_FlattenOptions'prefix :: ((Untyped.RWCtx m s)) => Std_.Int -> (FlattenOptions (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_FlattenOptions'prefix len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_FlattenOptions'prefix struct result)
+ (Std_.pure result)
+ )
+newtype DiscriminatorOptions msg
+ = DiscriminatorOptions'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg DiscriminatorOptions) where
+ tMsg f (DiscriminatorOptions'newtype_ s) = (DiscriminatorOptions'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (DiscriminatorOptions msg)) where
+ fromStruct struct = (Std_.pure (DiscriminatorOptions'newtype_ struct))
+instance (Classes.ToStruct msg (DiscriminatorOptions msg)) where
+ toStruct (DiscriminatorOptions'newtype_ struct) = struct
+instance (Untyped.HasMessage (DiscriminatorOptions msg)) where
+ type InMessage (DiscriminatorOptions msg) = msg
+ message (DiscriminatorOptions'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (DiscriminatorOptions msg)) where
+ messageDefault msg = (DiscriminatorOptions'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (DiscriminatorOptions msg)) where
+ fromPtr msg ptr = (DiscriminatorOptions'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (DiscriminatorOptions (Message.MutMsg s))) where
+ toPtr msg (DiscriminatorOptions'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (DiscriminatorOptions (Message.MutMsg s))) where
+ new msg = (DiscriminatorOptions'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (DiscriminatorOptions msg)) where
+ newtype List msg (DiscriminatorOptions msg)
+ = DiscriminatorOptions'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (DiscriminatorOptions'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (DiscriminatorOptions'List_ l) = (Untyped.ListStruct l)
+ length (DiscriminatorOptions'List_ l) = (Untyped.length l)
+ index i (DiscriminatorOptions'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (DiscriminatorOptions (Message.MutMsg s))) where
+ setIndex (DiscriminatorOptions'newtype_ elt) i (DiscriminatorOptions'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (DiscriminatorOptions'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_DiscriminatorOptions'name :: ((Untyped.ReadCtx m msg)) => (DiscriminatorOptions msg) -> (m (Basics.Text msg))
+get_DiscriminatorOptions'name (DiscriminatorOptions'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_DiscriminatorOptions'name :: ((Untyped.RWCtx m s)) => (DiscriminatorOptions (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_DiscriminatorOptions'name (DiscriminatorOptions'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_DiscriminatorOptions'name :: ((Untyped.ReadCtx m msg)) => (DiscriminatorOptions msg) -> (m Std_.Bool)
+has_DiscriminatorOptions'name (DiscriminatorOptions'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_DiscriminatorOptions'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (DiscriminatorOptions (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_DiscriminatorOptions'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_DiscriminatorOptions'name struct result)
+ (Std_.pure result)
+ )
+get_DiscriminatorOptions'valueName :: ((Untyped.ReadCtx m msg)) => (DiscriminatorOptions msg) -> (m (Basics.Text msg))
+get_DiscriminatorOptions'valueName (DiscriminatorOptions'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_DiscriminatorOptions'valueName :: ((Untyped.RWCtx m s)) => (DiscriminatorOptions (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_DiscriminatorOptions'valueName (DiscriminatorOptions'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_DiscriminatorOptions'valueName :: ((Untyped.ReadCtx m msg)) => (DiscriminatorOptions msg) -> (m Std_.Bool)
+has_DiscriminatorOptions'valueName (DiscriminatorOptions'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_DiscriminatorOptions'valueName :: ((Untyped.RWCtx m s)) => Std_.Int -> (DiscriminatorOptions (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_DiscriminatorOptions'valueName len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_DiscriminatorOptions'valueName struct result)
+ (Std_.pure result)
+ )
diff --git a/gen/lib/Capnp/Gen/Capnp/Json/Pure.hs b/gen/lib/Capnp/Gen/Capnp/Json/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Json/Pure.hs
@@ -0,0 +1,253 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Json.Pure(Value(..)
+ ,Value'Field(..)
+ ,Value'Call(..)
+ ,FlattenOptions(..)
+ ,DiscriminatorOptions(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Gen.ById.X8ef99297a43a5e34
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+data Value
+ = Value'null
+ | Value'boolean Std_.Bool
+ | Value'number Std_.Double
+ | Value'string T.Text
+ | Value'array (V.Vector Value)
+ | Value'object (V.Vector Value'Field)
+ | Value'call Value'Call
+ | Value'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value) where
+ type Cerial msg Value = (Capnp.Gen.ById.X8ef99297a43a5e34.Value msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.X8ef99297a43a5e34.get_Value' raw)
+ case raw of
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'null) ->
+ (Std_.pure Value'null)
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'boolean raw) ->
+ (Std_.pure (Value'boolean raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'number raw) ->
+ (Std_.pure (Value'number raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'string raw) ->
+ (Value'string <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'array raw) ->
+ (Value'array <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'object raw) ->
+ (Value'object <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'call raw) ->
+ (Value'call <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X8ef99297a43a5e34.Value'unknown' tag) ->
+ (Std_.pure (Value'unknown' tag))
+ )
+instance (Classes.Marshal Value) where
+ marshalInto raw_ value_ = case value_ of
+ (Value'null) ->
+ (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'null raw_)
+ (Value'boolean arg_) ->
+ (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'boolean raw_ arg_)
+ (Value'number arg_) ->
+ (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'number raw_ arg_)
+ (Value'string arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'string raw_))
+ (Value'array arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'array raw_))
+ (Value'object arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'object raw_))
+ (Value'call arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'call raw_))
+ (Value'unknown' tag) ->
+ (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'unknown' raw_ tag)
+instance (Classes.Cerialize Value)
+instance (Classes.Cerialize (V.Vector Value)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Value'Field
+ = Value'Field
+ {name :: T.Text
+ ,value :: Value}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value'Field) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value'Field) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value'Field) where
+ type Cerial msg Value'Field = (Capnp.Gen.ById.X8ef99297a43a5e34.Value'Field msg)
+ decerialize raw = (Value'Field <$> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_Value'Field'name raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_Value'Field'value raw) >>= Classes.decerialize))
+instance (Classes.Marshal Value'Field) where
+ marshalInto raw_ value_ = case value_ of
+ Value'Field{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'Field'name raw_))
+ ((Classes.cerialize (Untyped.message raw_) value) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'Field'value raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Value'Field)
+instance (Classes.Cerialize (V.Vector Value'Field)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value'Field))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value'Field)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value'Field))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Field)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Field))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Field)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Value'Call
+ = Value'Call
+ {function :: T.Text
+ ,params :: (V.Vector Value)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value'Call) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value'Call) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value'Call) where
+ type Cerial msg Value'Call = (Capnp.Gen.ById.X8ef99297a43a5e34.Value'Call msg)
+ decerialize raw = (Value'Call <$> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_Value'Call'function raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_Value'Call'params raw) >>= Classes.decerialize))
+instance (Classes.Marshal Value'Call) where
+ marshalInto raw_ value_ = case value_ of
+ Value'Call{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) function) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'Call'function raw_))
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_Value'Call'params raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Value'Call)
+instance (Classes.Cerialize (V.Vector Value'Call)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value'Call))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value'Call)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value'Call))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Call)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Call))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value'Call)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data FlattenOptions
+ = FlattenOptions
+ {prefix :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default FlattenOptions) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg FlattenOptions) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize FlattenOptions) where
+ type Cerial msg FlattenOptions = (Capnp.Gen.ById.X8ef99297a43a5e34.FlattenOptions msg)
+ decerialize raw = (FlattenOptions <$> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_FlattenOptions'prefix raw) >>= Classes.decerialize))
+instance (Classes.Marshal FlattenOptions) where
+ marshalInto raw_ value_ = case value_ of
+ FlattenOptions{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) prefix) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_FlattenOptions'prefix raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize FlattenOptions)
+instance (Classes.Cerialize (V.Vector FlattenOptions)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector FlattenOptions))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector FlattenOptions)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector FlattenOptions))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector FlattenOptions)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector FlattenOptions))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector FlattenOptions)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data DiscriminatorOptions
+ = DiscriminatorOptions
+ {name :: T.Text
+ ,valueName :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default DiscriminatorOptions) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg DiscriminatorOptions) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize DiscriminatorOptions) where
+ type Cerial msg DiscriminatorOptions = (Capnp.Gen.ById.X8ef99297a43a5e34.DiscriminatorOptions msg)
+ decerialize raw = (DiscriminatorOptions <$> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_DiscriminatorOptions'name raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X8ef99297a43a5e34.get_DiscriminatorOptions'valueName raw) >>= Classes.decerialize))
+instance (Classes.Marshal DiscriminatorOptions) where
+ marshalInto raw_ value_ = case value_ of
+ DiscriminatorOptions{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_DiscriminatorOptions'name raw_))
+ ((Classes.cerialize (Untyped.message raw_) valueName) >>= (Capnp.Gen.ById.X8ef99297a43a5e34.set_DiscriminatorOptions'valueName raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize DiscriminatorOptions)
+instance (Classes.Cerialize (V.Vector DiscriminatorOptions)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector DiscriminatorOptions))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector DiscriminatorOptions)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector DiscriminatorOptions))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector DiscriminatorOptions)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector DiscriminatorOptions))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector DiscriminatorOptions)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
diff --git a/gen/lib/Capnp/Gen/Capnp/Persistent.hs b/gen/lib/Capnp/Gen/Capnp/Persistent.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Persistent.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Persistent where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Persistent msg
+ = Persistent'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Persistent msg)) where
+ fromPtr msg ptr = (Persistent'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Persistent (Message.MutMsg s))) where
+ toPtr msg (Persistent'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Persistent'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Persistent'SaveParams msg
+ = Persistent'SaveParams'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Persistent'SaveParams) where
+ tMsg f (Persistent'SaveParams'newtype_ s) = (Persistent'SaveParams'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Persistent'SaveParams msg)) where
+ fromStruct struct = (Std_.pure (Persistent'SaveParams'newtype_ struct))
+instance (Classes.ToStruct msg (Persistent'SaveParams msg)) where
+ toStruct (Persistent'SaveParams'newtype_ struct) = struct
+instance (Untyped.HasMessage (Persistent'SaveParams msg)) where
+ type InMessage (Persistent'SaveParams msg) = msg
+ message (Persistent'SaveParams'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Persistent'SaveParams msg)) where
+ messageDefault msg = (Persistent'SaveParams'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Persistent'SaveParams msg)) where
+ fromPtr msg ptr = (Persistent'SaveParams'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Persistent'SaveParams (Message.MutMsg s))) where
+ toPtr msg (Persistent'SaveParams'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Persistent'SaveParams (Message.MutMsg s))) where
+ new msg = (Persistent'SaveParams'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Persistent'SaveParams msg)) where
+ newtype List msg (Persistent'SaveParams msg)
+ = Persistent'SaveParams'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Persistent'SaveParams'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Persistent'SaveParams'List_ l) = (Untyped.ListStruct l)
+ length (Persistent'SaveParams'List_ l) = (Untyped.length l)
+ index i (Persistent'SaveParams'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Persistent'SaveParams (Message.MutMsg s))) where
+ setIndex (Persistent'SaveParams'newtype_ elt) i (Persistent'SaveParams'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Persistent'SaveParams'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Persistent'SaveParams'sealFor :: ((Untyped.ReadCtx m msg)) => (Persistent'SaveParams msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Persistent'SaveParams'sealFor (Persistent'SaveParams'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Persistent'SaveParams'sealFor :: ((Untyped.RWCtx m s)) => (Persistent'SaveParams (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Persistent'SaveParams'sealFor (Persistent'SaveParams'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Persistent'SaveParams'sealFor :: ((Untyped.ReadCtx m msg)) => (Persistent'SaveParams msg) -> (m Std_.Bool)
+has_Persistent'SaveParams'sealFor (Persistent'SaveParams'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype Persistent'SaveResults msg
+ = Persistent'SaveResults'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Persistent'SaveResults) where
+ tMsg f (Persistent'SaveResults'newtype_ s) = (Persistent'SaveResults'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Persistent'SaveResults msg)) where
+ fromStruct struct = (Std_.pure (Persistent'SaveResults'newtype_ struct))
+instance (Classes.ToStruct msg (Persistent'SaveResults msg)) where
+ toStruct (Persistent'SaveResults'newtype_ struct) = struct
+instance (Untyped.HasMessage (Persistent'SaveResults msg)) where
+ type InMessage (Persistent'SaveResults msg) = msg
+ message (Persistent'SaveResults'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Persistent'SaveResults msg)) where
+ messageDefault msg = (Persistent'SaveResults'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Persistent'SaveResults msg)) where
+ fromPtr msg ptr = (Persistent'SaveResults'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Persistent'SaveResults (Message.MutMsg s))) where
+ toPtr msg (Persistent'SaveResults'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Persistent'SaveResults (Message.MutMsg s))) where
+ new msg = (Persistent'SaveResults'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Persistent'SaveResults msg)) where
+ newtype List msg (Persistent'SaveResults msg)
+ = Persistent'SaveResults'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Persistent'SaveResults'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Persistent'SaveResults'List_ l) = (Untyped.ListStruct l)
+ length (Persistent'SaveResults'List_ l) = (Untyped.length l)
+ index i (Persistent'SaveResults'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Persistent'SaveResults (Message.MutMsg s))) where
+ setIndex (Persistent'SaveResults'newtype_ elt) i (Persistent'SaveResults'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Persistent'SaveResults'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Persistent'SaveResults'sturdyRef :: ((Untyped.ReadCtx m msg)) => (Persistent'SaveResults msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Persistent'SaveResults'sturdyRef (Persistent'SaveResults'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Persistent'SaveResults'sturdyRef :: ((Untyped.RWCtx m s)) => (Persistent'SaveResults (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Persistent'SaveResults'sturdyRef (Persistent'SaveResults'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Persistent'SaveResults'sturdyRef :: ((Untyped.ReadCtx m msg)) => (Persistent'SaveResults msg) -> (m Std_.Bool)
+has_Persistent'SaveResults'sturdyRef (Persistent'SaveResults'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype RealmGateway msg
+ = RealmGateway'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (RealmGateway msg)) where
+ fromPtr msg ptr = (RealmGateway'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (RealmGateway (Message.MutMsg s))) where
+ toPtr msg (RealmGateway'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (RealmGateway'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype RealmGateway'import'params msg
+ = RealmGateway'import'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg RealmGateway'import'params) where
+ tMsg f (RealmGateway'import'params'newtype_ s) = (RealmGateway'import'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (RealmGateway'import'params msg)) where
+ fromStruct struct = (Std_.pure (RealmGateway'import'params'newtype_ struct))
+instance (Classes.ToStruct msg (RealmGateway'import'params msg)) where
+ toStruct (RealmGateway'import'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (RealmGateway'import'params msg)) where
+ type InMessage (RealmGateway'import'params msg) = msg
+ message (RealmGateway'import'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (RealmGateway'import'params msg)) where
+ messageDefault msg = (RealmGateway'import'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (RealmGateway'import'params msg)) where
+ fromPtr msg ptr = (RealmGateway'import'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (RealmGateway'import'params (Message.MutMsg s))) where
+ toPtr msg (RealmGateway'import'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (RealmGateway'import'params (Message.MutMsg s))) where
+ new msg = (RealmGateway'import'params'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (RealmGateway'import'params msg)) where
+ newtype List msg (RealmGateway'import'params msg)
+ = RealmGateway'import'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (RealmGateway'import'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (RealmGateway'import'params'List_ l) = (Untyped.ListStruct l)
+ length (RealmGateway'import'params'List_ l) = (Untyped.length l)
+ index i (RealmGateway'import'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (RealmGateway'import'params (Message.MutMsg s))) where
+ setIndex (RealmGateway'import'params'newtype_ elt) i (RealmGateway'import'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (RealmGateway'import'params'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_RealmGateway'import'params'cap :: ((Untyped.ReadCtx m msg)) => (RealmGateway'import'params msg) -> (m (Persistent msg))
+get_RealmGateway'import'params'cap (RealmGateway'import'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_RealmGateway'import'params'cap :: ((Untyped.RWCtx m s)) => (RealmGateway'import'params (Message.MutMsg s)) -> (Persistent (Message.MutMsg s)) -> (m ())
+set_RealmGateway'import'params'cap (RealmGateway'import'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_RealmGateway'import'params'cap :: ((Untyped.ReadCtx m msg)) => (RealmGateway'import'params msg) -> (m Std_.Bool)
+has_RealmGateway'import'params'cap (RealmGateway'import'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_RealmGateway'import'params'params :: ((Untyped.ReadCtx m msg)) => (RealmGateway'import'params msg) -> (m (Persistent'SaveParams msg))
+get_RealmGateway'import'params'params (RealmGateway'import'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_RealmGateway'import'params'params :: ((Untyped.RWCtx m s)) => (RealmGateway'import'params (Message.MutMsg s)) -> (Persistent'SaveParams (Message.MutMsg s)) -> (m ())
+set_RealmGateway'import'params'params (RealmGateway'import'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_RealmGateway'import'params'params :: ((Untyped.ReadCtx m msg)) => (RealmGateway'import'params msg) -> (m Std_.Bool)
+has_RealmGateway'import'params'params (RealmGateway'import'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_RealmGateway'import'params'params :: ((Untyped.RWCtx m s)) => (RealmGateway'import'params (Message.MutMsg s)) -> (m (Persistent'SaveParams (Message.MutMsg s)))
+new_RealmGateway'import'params'params struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_RealmGateway'import'params'params struct result)
+ (Std_.pure result)
+ )
+newtype RealmGateway'export'params msg
+ = RealmGateway'export'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg RealmGateway'export'params) where
+ tMsg f (RealmGateway'export'params'newtype_ s) = (RealmGateway'export'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (RealmGateway'export'params msg)) where
+ fromStruct struct = (Std_.pure (RealmGateway'export'params'newtype_ struct))
+instance (Classes.ToStruct msg (RealmGateway'export'params msg)) where
+ toStruct (RealmGateway'export'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (RealmGateway'export'params msg)) where
+ type InMessage (RealmGateway'export'params msg) = msg
+ message (RealmGateway'export'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (RealmGateway'export'params msg)) where
+ messageDefault msg = (RealmGateway'export'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (RealmGateway'export'params msg)) where
+ fromPtr msg ptr = (RealmGateway'export'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (RealmGateway'export'params (Message.MutMsg s))) where
+ toPtr msg (RealmGateway'export'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (RealmGateway'export'params (Message.MutMsg s))) where
+ new msg = (RealmGateway'export'params'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (RealmGateway'export'params msg)) where
+ newtype List msg (RealmGateway'export'params msg)
+ = RealmGateway'export'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (RealmGateway'export'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (RealmGateway'export'params'List_ l) = (Untyped.ListStruct l)
+ length (RealmGateway'export'params'List_ l) = (Untyped.length l)
+ index i (RealmGateway'export'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (RealmGateway'export'params (Message.MutMsg s))) where
+ setIndex (RealmGateway'export'params'newtype_ elt) i (RealmGateway'export'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (RealmGateway'export'params'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_RealmGateway'export'params'cap :: ((Untyped.ReadCtx m msg)) => (RealmGateway'export'params msg) -> (m (Persistent msg))
+get_RealmGateway'export'params'cap (RealmGateway'export'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_RealmGateway'export'params'cap :: ((Untyped.RWCtx m s)) => (RealmGateway'export'params (Message.MutMsg s)) -> (Persistent (Message.MutMsg s)) -> (m ())
+set_RealmGateway'export'params'cap (RealmGateway'export'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_RealmGateway'export'params'cap :: ((Untyped.ReadCtx m msg)) => (RealmGateway'export'params msg) -> (m Std_.Bool)
+has_RealmGateway'export'params'cap (RealmGateway'export'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_RealmGateway'export'params'params :: ((Untyped.ReadCtx m msg)) => (RealmGateway'export'params msg) -> (m (Persistent'SaveParams msg))
+get_RealmGateway'export'params'params (RealmGateway'export'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_RealmGateway'export'params'params :: ((Untyped.RWCtx m s)) => (RealmGateway'export'params (Message.MutMsg s)) -> (Persistent'SaveParams (Message.MutMsg s)) -> (m ())
+set_RealmGateway'export'params'params (RealmGateway'export'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_RealmGateway'export'params'params :: ((Untyped.ReadCtx m msg)) => (RealmGateway'export'params msg) -> (m Std_.Bool)
+has_RealmGateway'export'params'params (RealmGateway'export'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_RealmGateway'export'params'params :: ((Untyped.RWCtx m s)) => (RealmGateway'export'params (Message.MutMsg s)) -> (m (Persistent'SaveParams (Message.MutMsg s)))
+new_RealmGateway'export'params'params struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_RealmGateway'export'params'params struct result)
+ (Std_.pure result)
+ )
diff --git a/gen/lib/Capnp/Gen/Capnp/Persistent/Pure.hs b/gen/lib/Capnp/Gen/Capnp/Persistent/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Persistent/Pure.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Persistent.Pure(Persistent(..)
+ ,Persistent'server_(..)
+ ,export_Persistent
+ ,Persistent'SaveParams(..)
+ ,Persistent'SaveResults(..)
+ ,RealmGateway(..)
+ ,RealmGateway'server_(..)
+ ,export_RealmGateway
+ ,RealmGateway'import'params(..)
+ ,RealmGateway'export'params(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Rpc.Untyped as Rpc
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.GenHelpers.Rpc as RpcHelpers
+import qualified Capnp.GenHelpers.ReExports.Control.Concurrent.STM as STM
+import qualified Capnp.GenHelpers.ReExports.Supervisors as Supervisors
+import qualified Capnp.Gen.ById.Xb8630836983feed7
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Persistent
+ = Persistent Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Persistent'server_ m cap) where
+ {-# MINIMAL persistent'save #-}
+ persistent'save :: cap -> (Server.MethodHandler m Persistent'SaveParams Persistent'SaveResults)
+ persistent'save _ = Server.methodUnimplemented
+export_Persistent :: ((Persistent'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Persistent)
+export_Persistent sup_ server_ = (Persistent <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 14468694717054801553 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (persistent'save server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Persistent) where
+ fromClient = Persistent
+ toClient (Persistent client) = client
+instance (Classes.FromPtr msg Persistent) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Persistent) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Persistent) where
+ type Cerial msg Persistent = (Capnp.Gen.ById.Xb8630836983feed7.Persistent msg)
+ decerialize (Capnp.Gen.ById.Xb8630836983feed7.Persistent'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Persistent Message.nullClient))
+ (Std_.Just cap) ->
+ (Persistent <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Persistent) where
+ cerialize msg (Persistent client) = (Capnp.Gen.ById.Xb8630836983feed7.Persistent'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Persistent'server_ Std_.IO Persistent) where
+ persistent'save (Persistent client) = (Rpc.clientMethodHandler 14468694717054801553 0 client)
+data Persistent'SaveParams
+ = Persistent'SaveParams
+ {sealFor :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Persistent'SaveParams) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Persistent'SaveParams) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Persistent'SaveParams) where
+ type Cerial msg Persistent'SaveParams = (Capnp.Gen.ById.Xb8630836983feed7.Persistent'SaveParams msg)
+ decerialize raw = (Persistent'SaveParams <$> ((Capnp.Gen.ById.Xb8630836983feed7.get_Persistent'SaveParams'sealFor raw) >>= Classes.decerialize))
+instance (Classes.Marshal Persistent'SaveParams) where
+ marshalInto raw_ value_ = case value_ of
+ Persistent'SaveParams{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) sealFor) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_Persistent'SaveParams'sealFor raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Persistent'SaveParams)
+instance (Classes.Cerialize (V.Vector Persistent'SaveParams)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Persistent'SaveParams))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Persistent'SaveParams)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveParams))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveParams)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveParams))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveParams)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Persistent'SaveResults
+ = Persistent'SaveResults
+ {sturdyRef :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Persistent'SaveResults) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Persistent'SaveResults) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Persistent'SaveResults) where
+ type Cerial msg Persistent'SaveResults = (Capnp.Gen.ById.Xb8630836983feed7.Persistent'SaveResults msg)
+ decerialize raw = (Persistent'SaveResults <$> ((Capnp.Gen.ById.Xb8630836983feed7.get_Persistent'SaveResults'sturdyRef raw) >>= Classes.decerialize))
+instance (Classes.Marshal Persistent'SaveResults) where
+ marshalInto raw_ value_ = case value_ of
+ Persistent'SaveResults{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) sturdyRef) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_Persistent'SaveResults'sturdyRef raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Persistent'SaveResults)
+instance (Classes.Cerialize (V.Vector Persistent'SaveResults)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Persistent'SaveResults))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Persistent'SaveResults)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveResults))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveResults)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveResults))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Persistent'SaveResults)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype RealmGateway
+ = RealmGateway Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (RealmGateway'server_ m cap) where
+ {-# MINIMAL realmGateway'import_,realmGateway'export #-}
+ realmGateway'import_ :: cap -> (Server.MethodHandler m RealmGateway'import'params Persistent'SaveResults)
+ realmGateway'import_ _ = Server.methodUnimplemented
+ realmGateway'export :: cap -> (Server.MethodHandler m RealmGateway'export'params Persistent'SaveResults)
+ realmGateway'export _ = Server.methodUnimplemented
+export_RealmGateway :: ((RealmGateway'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM RealmGateway)
+export_RealmGateway sup_ server_ = (RealmGateway <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 9583422979879616212 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (realmGateway'import_ server_))
+ 1 ->
+ (Server.toUntypedHandler (realmGateway'export server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient RealmGateway) where
+ fromClient = RealmGateway
+ toClient (RealmGateway client) = client
+instance (Classes.FromPtr msg RealmGateway) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s RealmGateway) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize RealmGateway) where
+ type Cerial msg RealmGateway = (Capnp.Gen.ById.Xb8630836983feed7.RealmGateway msg)
+ decerialize (Capnp.Gen.ById.Xb8630836983feed7.RealmGateway'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (RealmGateway Message.nullClient))
+ (Std_.Just cap) ->
+ (RealmGateway <$> (Untyped.getClient cap))
+instance (Classes.Cerialize RealmGateway) where
+ cerialize msg (RealmGateway client) = (Capnp.Gen.ById.Xb8630836983feed7.RealmGateway'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (RealmGateway'server_ Std_.IO RealmGateway) where
+ realmGateway'import_ (RealmGateway client) = (Rpc.clientMethodHandler 9583422979879616212 0 client)
+ realmGateway'export (RealmGateway client) = (Rpc.clientMethodHandler 9583422979879616212 1 client)
+data RealmGateway'import'params
+ = RealmGateway'import'params
+ {cap :: Persistent
+ ,params :: Persistent'SaveParams}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default RealmGateway'import'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg RealmGateway'import'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize RealmGateway'import'params) where
+ type Cerial msg RealmGateway'import'params = (Capnp.Gen.ById.Xb8630836983feed7.RealmGateway'import'params msg)
+ decerialize raw = (RealmGateway'import'params <$> ((Capnp.Gen.ById.Xb8630836983feed7.get_RealmGateway'import'params'cap raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb8630836983feed7.get_RealmGateway'import'params'params raw) >>= Classes.decerialize))
+instance (Classes.Marshal RealmGateway'import'params) where
+ marshalInto raw_ value_ = case value_ of
+ RealmGateway'import'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) cap) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_RealmGateway'import'params'cap raw_))
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_RealmGateway'import'params'params raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize RealmGateway'import'params)
+instance (Classes.Cerialize (V.Vector RealmGateway'import'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector RealmGateway'import'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector RealmGateway'import'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'import'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'import'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'import'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'import'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data RealmGateway'export'params
+ = RealmGateway'export'params
+ {cap :: Persistent
+ ,params :: Persistent'SaveParams}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default RealmGateway'export'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg RealmGateway'export'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize RealmGateway'export'params) where
+ type Cerial msg RealmGateway'export'params = (Capnp.Gen.ById.Xb8630836983feed7.RealmGateway'export'params msg)
+ decerialize raw = (RealmGateway'export'params <$> ((Capnp.Gen.ById.Xb8630836983feed7.get_RealmGateway'export'params'cap raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb8630836983feed7.get_RealmGateway'export'params'params raw) >>= Classes.decerialize))
+instance (Classes.Marshal RealmGateway'export'params) where
+ marshalInto raw_ value_ = case value_ of
+ RealmGateway'export'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) cap) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_RealmGateway'export'params'cap raw_))
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.Xb8630836983feed7.set_RealmGateway'export'params'params raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize RealmGateway'export'params)
+instance (Classes.Cerialize (V.Vector RealmGateway'export'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector RealmGateway'export'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector RealmGateway'export'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'export'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'export'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'export'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RealmGateway'export'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
diff --git a/gen/lib/Capnp/Gen/Capnp/Rpc.hs b/gen/lib/Capnp/Gen/Capnp/Rpc.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Rpc.hs
@@ -0,0 +1,1524 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Rpc where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Message msg
+ = Message'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Message) where
+ tMsg f (Message'newtype_ s) = (Message'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Message msg)) where
+ fromStruct struct = (Std_.pure (Message'newtype_ struct))
+instance (Classes.ToStruct msg (Message msg)) where
+ toStruct (Message'newtype_ struct) = struct
+instance (Untyped.HasMessage (Message msg)) where
+ type InMessage (Message msg) = msg
+ message (Message'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Message msg)) where
+ messageDefault msg = (Message'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Message msg)) where
+ fromPtr msg ptr = (Message'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Message (Message.MutMsg s))) where
+ toPtr msg (Message'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Message (Message.MutMsg s))) where
+ new msg = (Message'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Message msg)) where
+ newtype List msg (Message msg)
+ = Message'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Message'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Message'List_ l) = (Untyped.ListStruct l)
+ length (Message'List_ l) = (Untyped.length l)
+ index i (Message'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Message (Message.MutMsg s))) where
+ setIndex (Message'newtype_ elt) i (Message'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Message'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+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 (Std_.Maybe (Untyped.Ptr msg))
+ | Message'bootstrap (Bootstrap msg)
+ | Message'obsoleteDelete (Std_.Maybe (Untyped.Ptr msg))
+ | Message'provide (Provide msg)
+ | Message'accept (Accept msg)
+ | Message'join (Join msg)
+ | Message'disembargo (Disembargo msg)
+ | Message'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Message' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Message'unimplemented <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 1 ->
+ (Message'abort <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 2 ->
+ (Message'call <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 3 ->
+ (Message'return <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 4 ->
+ (Message'finish <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 5 ->
+ (Message'resolve <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 6 ->
+ (Message'release <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 7 ->
+ (Message'obsoleteSave <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 8 ->
+ (Message'bootstrap <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 9 ->
+ (Message'obsoleteDelete <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 10 ->
+ (Message'provide <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 11 ->
+ (Message'accept <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 12 ->
+ (Message'join <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 13 ->
+ (Message'disembargo <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Message'unknown' (Std_.fromIntegral tag)))
+ )
+get_Message' :: ((Untyped.ReadCtx m msg)) => (Message msg) -> (m (Message' msg))
+get_Message' (Message'newtype_ struct) = (Classes.fromStruct struct)
+set_Message'unimplemented :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Message (Message.MutMsg s)) -> (m ())
+set_Message'unimplemented (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'abort :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Exception (Message.MutMsg s)) -> (m ())
+set_Message'abort (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'call :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Call (Message.MutMsg s)) -> (m ())
+set_Message'call (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'return :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Return (Message.MutMsg s)) -> (m ())
+set_Message'return (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'finish :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Finish (Message.MutMsg s)) -> (m ())
+set_Message'finish (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'resolve :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Resolve (Message.MutMsg s)) -> (m ())
+set_Message'resolve (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'release :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Release (Message.MutMsg s)) -> (m ())
+set_Message'release (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'obsoleteSave :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Message'obsoleteSave (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'bootstrap :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Bootstrap (Message.MutMsg s)) -> (m ())
+set_Message'bootstrap (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'obsoleteDelete :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Message'obsoleteDelete (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'provide :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Provide (Message.MutMsg s)) -> (m ())
+set_Message'provide (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'accept :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Accept (Message.MutMsg s)) -> (m ())
+set_Message'accept (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'join :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Join (Message.MutMsg s)) -> (m ())
+set_Message'join (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (12 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'disembargo :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> (Disembargo (Message.MutMsg s)) -> (m ())
+set_Message'disembargo (Message'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (13 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Message'unknown' :: ((Untyped.RWCtx m s)) => (Message (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Message'unknown' (Message'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Bootstrap msg
+ = Bootstrap'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Bootstrap) where
+ tMsg f (Bootstrap'newtype_ s) = (Bootstrap'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Bootstrap msg)) where
+ fromStruct struct = (Std_.pure (Bootstrap'newtype_ struct))
+instance (Classes.ToStruct msg (Bootstrap msg)) where
+ toStruct (Bootstrap'newtype_ struct) = struct
+instance (Untyped.HasMessage (Bootstrap msg)) where
+ type InMessage (Bootstrap msg) = msg
+ message (Bootstrap'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Bootstrap msg)) where
+ messageDefault msg = (Bootstrap'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Bootstrap msg)) where
+ fromPtr msg ptr = (Bootstrap'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Bootstrap (Message.MutMsg s))) where
+ toPtr msg (Bootstrap'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Bootstrap (Message.MutMsg s))) where
+ new msg = (Bootstrap'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Bootstrap msg)) where
+ newtype List msg (Bootstrap msg)
+ = Bootstrap'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Bootstrap'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Bootstrap'List_ l) = (Untyped.ListStruct l)
+ length (Bootstrap'List_ l) = (Untyped.length l)
+ index i (Bootstrap'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Bootstrap (Message.MutMsg s))) where
+ setIndex (Bootstrap'newtype_ elt) i (Bootstrap'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Bootstrap'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Bootstrap'questionId :: ((Untyped.ReadCtx m msg)) => (Bootstrap msg) -> (m Std_.Word32)
+get_Bootstrap'questionId (Bootstrap'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Bootstrap'questionId :: ((Untyped.RWCtx m s)) => (Bootstrap (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Bootstrap'questionId (Bootstrap'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Bootstrap'deprecatedObjectId :: ((Untyped.ReadCtx m msg)) => (Bootstrap msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Bootstrap'deprecatedObjectId (Bootstrap'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Bootstrap'deprecatedObjectId :: ((Untyped.RWCtx m s)) => (Bootstrap (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Bootstrap'deprecatedObjectId (Bootstrap'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Bootstrap'deprecatedObjectId :: ((Untyped.ReadCtx m msg)) => (Bootstrap msg) -> (m Std_.Bool)
+has_Bootstrap'deprecatedObjectId (Bootstrap'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype Call msg
+ = Call'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Call) where
+ tMsg f (Call'newtype_ s) = (Call'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Call msg)) where
+ fromStruct struct = (Std_.pure (Call'newtype_ struct))
+instance (Classes.ToStruct msg (Call msg)) where
+ toStruct (Call'newtype_ struct) = struct
+instance (Untyped.HasMessage (Call msg)) where
+ type InMessage (Call msg) = msg
+ message (Call'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Call msg)) where
+ messageDefault msg = (Call'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Call msg)) where
+ fromPtr msg ptr = (Call'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Call (Message.MutMsg s))) where
+ toPtr msg (Call'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Call (Message.MutMsg s))) where
+ new msg = (Call'newtype_ <$> (Untyped.allocStruct msg 3 3))
+instance (Basics.ListElem msg (Call msg)) where
+ newtype List msg (Call msg)
+ = Call'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Call'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Call'List_ l) = (Untyped.ListStruct l)
+ length (Call'List_ l) = (Untyped.length l)
+ index i (Call'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Call (Message.MutMsg s))) where
+ setIndex (Call'newtype_ elt) i (Call'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Call'List_ <$> (Untyped.allocCompositeList msg 3 3 len))
+get_Call'questionId :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Word32)
+get_Call'questionId (Call'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Call'questionId :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Call'questionId (Call'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Call'target :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m (MessageTarget msg))
+get_Call'target (Call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Call'target :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> (MessageTarget (Message.MutMsg s)) -> (m ())
+set_Call'target (Call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Call'target :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Bool)
+has_Call'target (Call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Call'target :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> (m (MessageTarget (Message.MutMsg s)))
+new_Call'target struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Call'target struct result)
+ (Std_.pure result)
+ )
+get_Call'interfaceId :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Word64)
+get_Call'interfaceId (Call'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Call'interfaceId :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Call'interfaceId (Call'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Call'methodId :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Word16)
+get_Call'methodId (Call'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_Call'methodId :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Call'methodId (Call'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+get_Call'params :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m (Payload msg))
+get_Call'params (Call'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Call'params :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> (Payload (Message.MutMsg s)) -> (m ())
+set_Call'params (Call'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Call'params :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Bool)
+has_Call'params (Call'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Call'params :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> (m (Payload (Message.MutMsg s)))
+new_Call'params struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Call'params struct result)
+ (Std_.pure result)
+ )
+get_Call'sendResultsTo :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m (Call'sendResultsTo msg))
+get_Call'sendResultsTo (Call'newtype_ struct) = (Classes.fromStruct struct)
+get_Call'allowThirdPartyTailCall :: ((Untyped.ReadCtx m msg)) => (Call msg) -> (m Std_.Bool)
+get_Call'allowThirdPartyTailCall (Call'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Call'allowThirdPartyTailCall :: ((Untyped.RWCtx m s)) => (Call (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Call'allowThirdPartyTailCall (Call'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 2 0 0)
+newtype Call'sendResultsTo msg
+ = Call'sendResultsTo'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Call'sendResultsTo) where
+ tMsg f (Call'sendResultsTo'newtype_ s) = (Call'sendResultsTo'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Call'sendResultsTo msg)) where
+ fromStruct struct = (Std_.pure (Call'sendResultsTo'newtype_ struct))
+instance (Classes.ToStruct msg (Call'sendResultsTo msg)) where
+ toStruct (Call'sendResultsTo'newtype_ struct) = struct
+instance (Untyped.HasMessage (Call'sendResultsTo msg)) where
+ type InMessage (Call'sendResultsTo msg) = msg
+ message (Call'sendResultsTo'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Call'sendResultsTo msg)) where
+ messageDefault msg = (Call'sendResultsTo'newtype_ (Untyped.messageDefault msg))
+data Call'sendResultsTo' msg
+ = Call'sendResultsTo'caller
+ | Call'sendResultsTo'yourself
+ | Call'sendResultsTo'thirdParty (Std_.Maybe (Untyped.Ptr msg))
+ | Call'sendResultsTo'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Call'sendResultsTo' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 3)
+ case tag of
+ 0 ->
+ (Std_.pure Call'sendResultsTo'caller)
+ 1 ->
+ (Std_.pure Call'sendResultsTo'yourself)
+ 2 ->
+ (Call'sendResultsTo'thirdParty <$> (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Call'sendResultsTo'unknown' (Std_.fromIntegral tag)))
+ )
+get_Call'sendResultsTo' :: ((Untyped.ReadCtx m msg)) => (Call'sendResultsTo msg) -> (m (Call'sendResultsTo' msg))
+get_Call'sendResultsTo' (Call'sendResultsTo'newtype_ struct) = (Classes.fromStruct struct)
+set_Call'sendResultsTo'caller :: ((Untyped.RWCtx m s)) => (Call'sendResultsTo (Message.MutMsg s)) -> (m ())
+set_Call'sendResultsTo'caller (Call'sendResultsTo'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 48 0)
+ (Std_.pure ())
+ )
+set_Call'sendResultsTo'yourself :: ((Untyped.RWCtx m s)) => (Call'sendResultsTo (Message.MutMsg s)) -> (m ())
+set_Call'sendResultsTo'yourself (Call'sendResultsTo'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 48 0)
+ (Std_.pure ())
+ )
+set_Call'sendResultsTo'thirdParty :: ((Untyped.RWCtx m s)) => (Call'sendResultsTo (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Call'sendResultsTo'thirdParty (Call'sendResultsTo'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 48 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+ )
+set_Call'sendResultsTo'unknown' :: ((Untyped.RWCtx m s)) => (Call'sendResultsTo (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Call'sendResultsTo'unknown' (Call'sendResultsTo'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 48 0)
+newtype Return msg
+ = Return'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Return) where
+ tMsg f (Return'newtype_ s) = (Return'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Return msg)) where
+ fromStruct struct = (Std_.pure (Return'newtype_ struct))
+instance (Classes.ToStruct msg (Return msg)) where
+ toStruct (Return'newtype_ struct) = struct
+instance (Untyped.HasMessage (Return msg)) where
+ type InMessage (Return msg) = msg
+ message (Return'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Return msg)) where
+ messageDefault msg = (Return'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Return msg)) where
+ fromPtr msg ptr = (Return'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Return (Message.MutMsg s))) where
+ toPtr msg (Return'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Return (Message.MutMsg s))) where
+ new msg = (Return'newtype_ <$> (Untyped.allocStruct msg 2 1))
+instance (Basics.ListElem msg (Return msg)) where
+ newtype List msg (Return msg)
+ = Return'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Return'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Return'List_ l) = (Untyped.ListStruct l)
+ length (Return'List_ l) = (Untyped.length l)
+ index i (Return'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Return (Message.MutMsg s))) where
+ setIndex (Return'newtype_ elt) i (Return'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Return'List_ <$> (Untyped.allocCompositeList msg 2 1 len))
+get_Return'answerId :: ((Untyped.ReadCtx m msg)) => (Return msg) -> (m Std_.Word32)
+get_Return'answerId (Return'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Return'answerId :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Return'answerId (Return'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Return'releaseParamCaps :: ((Untyped.ReadCtx m msg)) => (Return msg) -> (m Std_.Bool)
+get_Return'releaseParamCaps (Return'newtype_ struct) = (GenHelpers.getWordField struct 0 32 1)
+set_Return'releaseParamCaps :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Return'releaseParamCaps (Return'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 32 1)
+data Return' msg
+ = Return'results (Payload msg)
+ | Return'exception (Exception msg)
+ | Return'canceled
+ | Return'resultsSentElsewhere
+ | Return'takeFromOtherQuestion Std_.Word32
+ | Return'acceptFromThirdParty (Std_.Maybe (Untyped.Ptr msg))
+ | Return'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Return' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 3)
+ case tag of
+ 0 ->
+ (Return'results <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 1 ->
+ (Return'exception <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 2 ->
+ (Std_.pure Return'canceled)
+ 3 ->
+ (Std_.pure Return'resultsSentElsewhere)
+ 4 ->
+ (Return'takeFromOtherQuestion <$> (GenHelpers.getWordField struct 1 0 0))
+ 5 ->
+ (Return'acceptFromThirdParty <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Return'unknown' (Std_.fromIntegral tag)))
+ )
+get_Return' :: ((Untyped.ReadCtx m msg)) => (Return msg) -> (m (Return' msg))
+get_Return' (Return'newtype_ struct) = (Classes.fromStruct struct)
+set_Return'results :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> (Payload (Message.MutMsg s)) -> (m ())
+set_Return'results (Return'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 48 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Return'exception :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> (Exception (Message.MutMsg s)) -> (m ())
+set_Return'exception (Return'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 48 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Return'canceled :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> (m ())
+set_Return'canceled (Return'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 48 0)
+ (Std_.pure ())
+ )
+set_Return'resultsSentElsewhere :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> (m ())
+set_Return'resultsSentElsewhere (Return'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 48 0)
+ (Std_.pure ())
+ )
+set_Return'takeFromOtherQuestion :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Return'takeFromOtherQuestion (Return'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 48 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+ )
+set_Return'acceptFromThirdParty :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Return'acceptFromThirdParty (Return'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 48 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Return'unknown' :: ((Untyped.RWCtx m s)) => (Return (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Return'unknown' (Return'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 48 0)
+newtype Finish msg
+ = Finish'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Finish) where
+ tMsg f (Finish'newtype_ s) = (Finish'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Finish msg)) where
+ fromStruct struct = (Std_.pure (Finish'newtype_ struct))
+instance (Classes.ToStruct msg (Finish msg)) where
+ toStruct (Finish'newtype_ struct) = struct
+instance (Untyped.HasMessage (Finish msg)) where
+ type InMessage (Finish msg) = msg
+ message (Finish'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Finish msg)) where
+ messageDefault msg = (Finish'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Finish msg)) where
+ fromPtr msg ptr = (Finish'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Finish (Message.MutMsg s))) where
+ toPtr msg (Finish'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Finish (Message.MutMsg s))) where
+ new msg = (Finish'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Finish msg)) where
+ newtype List msg (Finish msg)
+ = Finish'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Finish'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Finish'List_ l) = (Untyped.ListStruct l)
+ length (Finish'List_ l) = (Untyped.length l)
+ index i (Finish'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Finish (Message.MutMsg s))) where
+ setIndex (Finish'newtype_ elt) i (Finish'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Finish'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Finish'questionId :: ((Untyped.ReadCtx m msg)) => (Finish msg) -> (m Std_.Word32)
+get_Finish'questionId (Finish'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Finish'questionId :: ((Untyped.RWCtx m s)) => (Finish (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Finish'questionId (Finish'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Finish'releaseResultCaps :: ((Untyped.ReadCtx m msg)) => (Finish msg) -> (m Std_.Bool)
+get_Finish'releaseResultCaps (Finish'newtype_ struct) = (GenHelpers.getWordField struct 0 32 1)
+set_Finish'releaseResultCaps :: ((Untyped.RWCtx m s)) => (Finish (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Finish'releaseResultCaps (Finish'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 32 1)
+newtype Resolve msg
+ = Resolve'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Resolve) where
+ tMsg f (Resolve'newtype_ s) = (Resolve'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Resolve msg)) where
+ fromStruct struct = (Std_.pure (Resolve'newtype_ struct))
+instance (Classes.ToStruct msg (Resolve msg)) where
+ toStruct (Resolve'newtype_ struct) = struct
+instance (Untyped.HasMessage (Resolve msg)) where
+ type InMessage (Resolve msg) = msg
+ message (Resolve'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Resolve msg)) where
+ messageDefault msg = (Resolve'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Resolve msg)) where
+ fromPtr msg ptr = (Resolve'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Resolve (Message.MutMsg s))) where
+ toPtr msg (Resolve'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Resolve (Message.MutMsg s))) where
+ new msg = (Resolve'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Resolve msg)) where
+ newtype List msg (Resolve msg)
+ = Resolve'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Resolve'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Resolve'List_ l) = (Untyped.ListStruct l)
+ length (Resolve'List_ l) = (Untyped.length l)
+ index i (Resolve'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Resolve (Message.MutMsg s))) where
+ setIndex (Resolve'newtype_ elt) i (Resolve'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Resolve'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Resolve'promiseId :: ((Untyped.ReadCtx m msg)) => (Resolve msg) -> (m Std_.Word32)
+get_Resolve'promiseId (Resolve'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Resolve'promiseId :: ((Untyped.RWCtx m s)) => (Resolve (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Resolve'promiseId (Resolve'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+data Resolve' msg
+ = Resolve'cap (CapDescriptor msg)
+ | Resolve'exception (Exception msg)
+ | Resolve'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Resolve' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 2)
+ case tag of
+ 0 ->
+ (Resolve'cap <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 1 ->
+ (Resolve'exception <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Resolve'unknown' (Std_.fromIntegral tag)))
+ )
+get_Resolve' :: ((Untyped.ReadCtx m msg)) => (Resolve msg) -> (m (Resolve' msg))
+get_Resolve' (Resolve'newtype_ struct) = (Classes.fromStruct struct)
+set_Resolve'cap :: ((Untyped.RWCtx m s)) => (Resolve (Message.MutMsg s)) -> (CapDescriptor (Message.MutMsg s)) -> (m ())
+set_Resolve'cap (Resolve'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 32 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Resolve'exception :: ((Untyped.RWCtx m s)) => (Resolve (Message.MutMsg s)) -> (Exception (Message.MutMsg s)) -> (m ())
+set_Resolve'exception (Resolve'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 32 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Resolve'unknown' :: ((Untyped.RWCtx m s)) => (Resolve (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Resolve'unknown' (Resolve'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+newtype Release msg
+ = Release'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Release) where
+ tMsg f (Release'newtype_ s) = (Release'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Release msg)) where
+ fromStruct struct = (Std_.pure (Release'newtype_ struct))
+instance (Classes.ToStruct msg (Release msg)) where
+ toStruct (Release'newtype_ struct) = struct
+instance (Untyped.HasMessage (Release msg)) where
+ type InMessage (Release msg) = msg
+ message (Release'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Release msg)) where
+ messageDefault msg = (Release'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Release msg)) where
+ fromPtr msg ptr = (Release'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Release (Message.MutMsg s))) where
+ toPtr msg (Release'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Release (Message.MutMsg s))) where
+ new msg = (Release'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Release msg)) where
+ newtype List msg (Release msg)
+ = Release'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Release'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Release'List_ l) = (Untyped.ListStruct l)
+ length (Release'List_ l) = (Untyped.length l)
+ index i (Release'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Release (Message.MutMsg s))) where
+ setIndex (Release'newtype_ elt) i (Release'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Release'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Release'id :: ((Untyped.ReadCtx m msg)) => (Release msg) -> (m Std_.Word32)
+get_Release'id (Release'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Release'id :: ((Untyped.RWCtx m s)) => (Release (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Release'id (Release'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Release'referenceCount :: ((Untyped.ReadCtx m msg)) => (Release msg) -> (m Std_.Word32)
+get_Release'referenceCount (Release'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_Release'referenceCount :: ((Untyped.RWCtx m s)) => (Release (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Release'referenceCount (Release'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+newtype Disembargo msg
+ = Disembargo'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Disembargo) where
+ tMsg f (Disembargo'newtype_ s) = (Disembargo'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Disembargo msg)) where
+ fromStruct struct = (Std_.pure (Disembargo'newtype_ struct))
+instance (Classes.ToStruct msg (Disembargo msg)) where
+ toStruct (Disembargo'newtype_ struct) = struct
+instance (Untyped.HasMessage (Disembargo msg)) where
+ type InMessage (Disembargo msg) = msg
+ message (Disembargo'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Disembargo msg)) where
+ messageDefault msg = (Disembargo'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Disembargo msg)) where
+ fromPtr msg ptr = (Disembargo'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Disembargo (Message.MutMsg s))) where
+ toPtr msg (Disembargo'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Disembargo (Message.MutMsg s))) where
+ new msg = (Disembargo'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Disembargo msg)) where
+ newtype List msg (Disembargo msg)
+ = Disembargo'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Disembargo'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Disembargo'List_ l) = (Untyped.ListStruct l)
+ length (Disembargo'List_ l) = (Untyped.length l)
+ index i (Disembargo'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Disembargo (Message.MutMsg s))) where
+ setIndex (Disembargo'newtype_ elt) i (Disembargo'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Disembargo'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Disembargo'target :: ((Untyped.ReadCtx m msg)) => (Disembargo msg) -> (m (MessageTarget msg))
+get_Disembargo'target (Disembargo'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Disembargo'target :: ((Untyped.RWCtx m s)) => (Disembargo (Message.MutMsg s)) -> (MessageTarget (Message.MutMsg s)) -> (m ())
+set_Disembargo'target (Disembargo'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Disembargo'target :: ((Untyped.ReadCtx m msg)) => (Disembargo msg) -> (m Std_.Bool)
+has_Disembargo'target (Disembargo'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Disembargo'target :: ((Untyped.RWCtx m s)) => (Disembargo (Message.MutMsg s)) -> (m (MessageTarget (Message.MutMsg s)))
+new_Disembargo'target struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Disembargo'target struct result)
+ (Std_.pure result)
+ )
+get_Disembargo'context :: ((Untyped.ReadCtx m msg)) => (Disembargo msg) -> (m (Disembargo'context msg))
+get_Disembargo'context (Disembargo'newtype_ struct) = (Classes.fromStruct struct)
+newtype Disembargo'context msg
+ = Disembargo'context'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Disembargo'context) where
+ tMsg f (Disembargo'context'newtype_ s) = (Disembargo'context'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Disembargo'context msg)) where
+ fromStruct struct = (Std_.pure (Disembargo'context'newtype_ struct))
+instance (Classes.ToStruct msg (Disembargo'context msg)) where
+ toStruct (Disembargo'context'newtype_ struct) = struct
+instance (Untyped.HasMessage (Disembargo'context msg)) where
+ type InMessage (Disembargo'context msg) = msg
+ message (Disembargo'context'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Disembargo'context msg)) where
+ messageDefault msg = (Disembargo'context'newtype_ (Untyped.messageDefault msg))
+data Disembargo'context' msg
+ = Disembargo'context'senderLoopback Std_.Word32
+ | Disembargo'context'receiverLoopback Std_.Word32
+ | Disembargo'context'accept
+ | Disembargo'context'provide Std_.Word32
+ | Disembargo'context'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Disembargo'context' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 2)
+ case tag of
+ 0 ->
+ (Disembargo'context'senderLoopback <$> (GenHelpers.getWordField struct 0 0 0))
+ 1 ->
+ (Disembargo'context'receiverLoopback <$> (GenHelpers.getWordField struct 0 0 0))
+ 2 ->
+ (Std_.pure Disembargo'context'accept)
+ 3 ->
+ (Disembargo'context'provide <$> (GenHelpers.getWordField struct 0 0 0))
+ _ ->
+ (Std_.pure (Disembargo'context'unknown' (Std_.fromIntegral tag)))
+ )
+get_Disembargo'context' :: ((Untyped.ReadCtx m msg)) => (Disembargo'context msg) -> (m (Disembargo'context' msg))
+get_Disembargo'context' (Disembargo'context'newtype_ struct) = (Classes.fromStruct struct)
+set_Disembargo'context'senderLoopback :: ((Untyped.RWCtx m s)) => (Disembargo'context (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Disembargo'context'senderLoopback (Disembargo'context'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 32 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+ )
+set_Disembargo'context'receiverLoopback :: ((Untyped.RWCtx m s)) => (Disembargo'context (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Disembargo'context'receiverLoopback (Disembargo'context'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 32 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+ )
+set_Disembargo'context'accept :: ((Untyped.RWCtx m s)) => (Disembargo'context (Message.MutMsg s)) -> (m ())
+set_Disembargo'context'accept (Disembargo'context'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 32 0)
+ (Std_.pure ())
+ )
+set_Disembargo'context'provide :: ((Untyped.RWCtx m s)) => (Disembargo'context (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Disembargo'context'provide (Disembargo'context'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 32 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+ )
+set_Disembargo'context'unknown' :: ((Untyped.RWCtx m s)) => (Disembargo'context (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Disembargo'context'unknown' (Disembargo'context'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+newtype Provide msg
+ = Provide'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Provide) where
+ tMsg f (Provide'newtype_ s) = (Provide'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Provide msg)) where
+ fromStruct struct = (Std_.pure (Provide'newtype_ struct))
+instance (Classes.ToStruct msg (Provide msg)) where
+ toStruct (Provide'newtype_ struct) = struct
+instance (Untyped.HasMessage (Provide msg)) where
+ type InMessage (Provide msg) = msg
+ message (Provide'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Provide msg)) where
+ messageDefault msg = (Provide'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Provide msg)) where
+ fromPtr msg ptr = (Provide'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Provide (Message.MutMsg s))) where
+ toPtr msg (Provide'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Provide (Message.MutMsg s))) where
+ new msg = (Provide'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Provide msg)) where
+ newtype List msg (Provide msg)
+ = Provide'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Provide'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Provide'List_ l) = (Untyped.ListStruct l)
+ length (Provide'List_ l) = (Untyped.length l)
+ index i (Provide'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Provide (Message.MutMsg s))) where
+ setIndex (Provide'newtype_ elt) i (Provide'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Provide'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Provide'questionId :: ((Untyped.ReadCtx m msg)) => (Provide msg) -> (m Std_.Word32)
+get_Provide'questionId (Provide'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Provide'questionId :: ((Untyped.RWCtx m s)) => (Provide (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Provide'questionId (Provide'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Provide'target :: ((Untyped.ReadCtx m msg)) => (Provide msg) -> (m (MessageTarget msg))
+get_Provide'target (Provide'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Provide'target :: ((Untyped.RWCtx m s)) => (Provide (Message.MutMsg s)) -> (MessageTarget (Message.MutMsg s)) -> (m ())
+set_Provide'target (Provide'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Provide'target :: ((Untyped.ReadCtx m msg)) => (Provide msg) -> (m Std_.Bool)
+has_Provide'target (Provide'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Provide'target :: ((Untyped.RWCtx m s)) => (Provide (Message.MutMsg s)) -> (m (MessageTarget (Message.MutMsg s)))
+new_Provide'target struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Provide'target struct result)
+ (Std_.pure result)
+ )
+get_Provide'recipient :: ((Untyped.ReadCtx m msg)) => (Provide msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Provide'recipient (Provide'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Provide'recipient :: ((Untyped.RWCtx m s)) => (Provide (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Provide'recipient (Provide'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Provide'recipient :: ((Untyped.ReadCtx m msg)) => (Provide msg) -> (m Std_.Bool)
+has_Provide'recipient (Provide'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+newtype Accept msg
+ = Accept'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Accept) where
+ tMsg f (Accept'newtype_ s) = (Accept'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Accept msg)) where
+ fromStruct struct = (Std_.pure (Accept'newtype_ struct))
+instance (Classes.ToStruct msg (Accept msg)) where
+ toStruct (Accept'newtype_ struct) = struct
+instance (Untyped.HasMessage (Accept msg)) where
+ type InMessage (Accept msg) = msg
+ message (Accept'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Accept msg)) where
+ messageDefault msg = (Accept'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Accept msg)) where
+ fromPtr msg ptr = (Accept'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Accept (Message.MutMsg s))) where
+ toPtr msg (Accept'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Accept (Message.MutMsg s))) where
+ new msg = (Accept'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Accept msg)) where
+ newtype List msg (Accept msg)
+ = Accept'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Accept'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Accept'List_ l) = (Untyped.ListStruct l)
+ length (Accept'List_ l) = (Untyped.length l)
+ index i (Accept'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Accept (Message.MutMsg s))) where
+ setIndex (Accept'newtype_ elt) i (Accept'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Accept'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Accept'questionId :: ((Untyped.ReadCtx m msg)) => (Accept msg) -> (m Std_.Word32)
+get_Accept'questionId (Accept'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Accept'questionId :: ((Untyped.RWCtx m s)) => (Accept (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Accept'questionId (Accept'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Accept'provision :: ((Untyped.ReadCtx m msg)) => (Accept msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Accept'provision (Accept'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Accept'provision :: ((Untyped.RWCtx m s)) => (Accept (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Accept'provision (Accept'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Accept'provision :: ((Untyped.ReadCtx m msg)) => (Accept msg) -> (m Std_.Bool)
+has_Accept'provision (Accept'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_Accept'embargo :: ((Untyped.ReadCtx m msg)) => (Accept msg) -> (m Std_.Bool)
+get_Accept'embargo (Accept'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_Accept'embargo :: ((Untyped.RWCtx m s)) => (Accept (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Accept'embargo (Accept'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 32 0)
+newtype Join msg
+ = Join'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Join) where
+ tMsg f (Join'newtype_ s) = (Join'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Join msg)) where
+ fromStruct struct = (Std_.pure (Join'newtype_ struct))
+instance (Classes.ToStruct msg (Join msg)) where
+ toStruct (Join'newtype_ struct) = struct
+instance (Untyped.HasMessage (Join msg)) where
+ type InMessage (Join msg) = msg
+ message (Join'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Join msg)) where
+ messageDefault msg = (Join'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Join msg)) where
+ fromPtr msg ptr = (Join'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Join (Message.MutMsg s))) where
+ toPtr msg (Join'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Join (Message.MutMsg s))) where
+ new msg = (Join'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Join msg)) where
+ newtype List msg (Join msg)
+ = Join'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Join'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Join'List_ l) = (Untyped.ListStruct l)
+ length (Join'List_ l) = (Untyped.length l)
+ index i (Join'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Join (Message.MutMsg s))) where
+ setIndex (Join'newtype_ elt) i (Join'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Join'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Join'questionId :: ((Untyped.ReadCtx m msg)) => (Join msg) -> (m Std_.Word32)
+get_Join'questionId (Join'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Join'questionId :: ((Untyped.RWCtx m s)) => (Join (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Join'questionId (Join'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_Join'target :: ((Untyped.ReadCtx m msg)) => (Join msg) -> (m (MessageTarget msg))
+get_Join'target (Join'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Join'target :: ((Untyped.RWCtx m s)) => (Join (Message.MutMsg s)) -> (MessageTarget (Message.MutMsg s)) -> (m ())
+set_Join'target (Join'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Join'target :: ((Untyped.ReadCtx m msg)) => (Join msg) -> (m Std_.Bool)
+has_Join'target (Join'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Join'target :: ((Untyped.RWCtx m s)) => (Join (Message.MutMsg s)) -> (m (MessageTarget (Message.MutMsg s)))
+new_Join'target struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Join'target struct result)
+ (Std_.pure result)
+ )
+get_Join'keyPart :: ((Untyped.ReadCtx m msg)) => (Join msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Join'keyPart (Join'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Join'keyPart :: ((Untyped.RWCtx m s)) => (Join (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Join'keyPart (Join'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Join'keyPart :: ((Untyped.ReadCtx m msg)) => (Join msg) -> (m Std_.Bool)
+has_Join'keyPart (Join'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+newtype MessageTarget msg
+ = MessageTarget'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg MessageTarget) where
+ tMsg f (MessageTarget'newtype_ s) = (MessageTarget'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (MessageTarget msg)) where
+ fromStruct struct = (Std_.pure (MessageTarget'newtype_ struct))
+instance (Classes.ToStruct msg (MessageTarget msg)) where
+ toStruct (MessageTarget'newtype_ struct) = struct
+instance (Untyped.HasMessage (MessageTarget msg)) where
+ type InMessage (MessageTarget msg) = msg
+ message (MessageTarget'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (MessageTarget msg)) where
+ messageDefault msg = (MessageTarget'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (MessageTarget msg)) where
+ fromPtr msg ptr = (MessageTarget'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (MessageTarget (Message.MutMsg s))) where
+ toPtr msg (MessageTarget'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (MessageTarget (Message.MutMsg s))) where
+ new msg = (MessageTarget'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (MessageTarget msg)) where
+ newtype List msg (MessageTarget msg)
+ = MessageTarget'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (MessageTarget'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (MessageTarget'List_ l) = (Untyped.ListStruct l)
+ length (MessageTarget'List_ l) = (Untyped.length l)
+ index i (MessageTarget'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (MessageTarget (Message.MutMsg s))) where
+ setIndex (MessageTarget'newtype_ elt) i (MessageTarget'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (MessageTarget'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+data MessageTarget' msg
+ = MessageTarget'importedCap Std_.Word32
+ | MessageTarget'promisedAnswer (PromisedAnswer msg)
+ | MessageTarget'unknown' Std_.Word16
+instance (Classes.FromStruct msg (MessageTarget' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 2)
+ case tag of
+ 0 ->
+ (MessageTarget'importedCap <$> (GenHelpers.getWordField struct 0 0 0))
+ 1 ->
+ (MessageTarget'promisedAnswer <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (MessageTarget'unknown' (Std_.fromIntegral tag)))
+ )
+get_MessageTarget' :: ((Untyped.ReadCtx m msg)) => (MessageTarget msg) -> (m (MessageTarget' msg))
+get_MessageTarget' (MessageTarget'newtype_ struct) = (Classes.fromStruct struct)
+set_MessageTarget'importedCap :: ((Untyped.RWCtx m s)) => (MessageTarget (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_MessageTarget'importedCap (MessageTarget'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 32 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+ )
+set_MessageTarget'promisedAnswer :: ((Untyped.RWCtx m s)) => (MessageTarget (Message.MutMsg s)) -> (PromisedAnswer (Message.MutMsg s)) -> (m ())
+set_MessageTarget'promisedAnswer (MessageTarget'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 32 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_MessageTarget'unknown' :: ((Untyped.RWCtx m s)) => (MessageTarget (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_MessageTarget'unknown' (MessageTarget'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+newtype Payload msg
+ = Payload'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Payload) where
+ tMsg f (Payload'newtype_ s) = (Payload'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Payload msg)) where
+ fromStruct struct = (Std_.pure (Payload'newtype_ struct))
+instance (Classes.ToStruct msg (Payload msg)) where
+ toStruct (Payload'newtype_ struct) = struct
+instance (Untyped.HasMessage (Payload msg)) where
+ type InMessage (Payload msg) = msg
+ message (Payload'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Payload msg)) where
+ messageDefault msg = (Payload'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Payload msg)) where
+ fromPtr msg ptr = (Payload'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Payload (Message.MutMsg s))) where
+ toPtr msg (Payload'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Payload (Message.MutMsg s))) where
+ new msg = (Payload'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (Payload msg)) where
+ newtype List msg (Payload msg)
+ = Payload'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Payload'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Payload'List_ l) = (Untyped.ListStruct l)
+ length (Payload'List_ l) = (Untyped.length l)
+ index i (Payload'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Payload (Message.MutMsg s))) where
+ setIndex (Payload'newtype_ elt) i (Payload'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Payload'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_Payload'content :: ((Untyped.ReadCtx m msg)) => (Payload msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_Payload'content (Payload'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Payload'content :: ((Untyped.RWCtx m s)) => (Payload (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Payload'content (Payload'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Payload'content :: ((Untyped.ReadCtx m msg)) => (Payload msg) -> (m Std_.Bool)
+has_Payload'content (Payload'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_Payload'capTable :: ((Untyped.ReadCtx m msg)) => (Payload msg) -> (m (Basics.List msg (CapDescriptor msg)))
+get_Payload'capTable (Payload'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Payload'capTable :: ((Untyped.RWCtx m s)) => (Payload (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (CapDescriptor (Message.MutMsg s))) -> (m ())
+set_Payload'capTable (Payload'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Payload'capTable :: ((Untyped.ReadCtx m msg)) => (Payload msg) -> (m Std_.Bool)
+has_Payload'capTable (Payload'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Payload'capTable :: ((Untyped.RWCtx m s)) => Std_.Int -> (Payload (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (CapDescriptor (Message.MutMsg s))))
+new_Payload'capTable len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Payload'capTable struct result)
+ (Std_.pure result)
+ )
+newtype CapDescriptor msg
+ = CapDescriptor'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CapDescriptor) where
+ tMsg f (CapDescriptor'newtype_ s) = (CapDescriptor'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CapDescriptor msg)) where
+ fromStruct struct = (Std_.pure (CapDescriptor'newtype_ struct))
+instance (Classes.ToStruct msg (CapDescriptor msg)) where
+ toStruct (CapDescriptor'newtype_ struct) = struct
+instance (Untyped.HasMessage (CapDescriptor msg)) where
+ type InMessage (CapDescriptor msg) = msg
+ message (CapDescriptor'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CapDescriptor msg)) where
+ messageDefault msg = (CapDescriptor'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CapDescriptor msg)) where
+ fromPtr msg ptr = (CapDescriptor'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CapDescriptor (Message.MutMsg s))) where
+ toPtr msg (CapDescriptor'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CapDescriptor (Message.MutMsg s))) where
+ new msg = (CapDescriptor'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (CapDescriptor msg)) where
+ newtype List msg (CapDescriptor msg)
+ = CapDescriptor'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CapDescriptor'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CapDescriptor'List_ l) = (Untyped.ListStruct l)
+ length (CapDescriptor'List_ l) = (Untyped.length l)
+ index i (CapDescriptor'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CapDescriptor (Message.MutMsg s))) where
+ setIndex (CapDescriptor'newtype_ elt) i (CapDescriptor'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CapDescriptor'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+data CapDescriptor' msg
+ = CapDescriptor'none
+ | CapDescriptor'senderHosted Std_.Word32
+ | CapDescriptor'senderPromise Std_.Word32
+ | CapDescriptor'receiverHosted Std_.Word32
+ | CapDescriptor'receiverAnswer (PromisedAnswer msg)
+ | CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor msg)
+ | CapDescriptor'unknown' Std_.Word16
+instance (Classes.FromStruct msg (CapDescriptor' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure CapDescriptor'none)
+ 1 ->
+ (CapDescriptor'senderHosted <$> (GenHelpers.getWordField struct 0 32 0))
+ 2 ->
+ (CapDescriptor'senderPromise <$> (GenHelpers.getWordField struct 0 32 0))
+ 3 ->
+ (CapDescriptor'receiverHosted <$> (GenHelpers.getWordField struct 0 32 0))
+ 4 ->
+ (CapDescriptor'receiverAnswer <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 5 ->
+ (CapDescriptor'thirdPartyHosted <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (CapDescriptor'unknown' (Std_.fromIntegral tag)))
+ )
+get_CapDescriptor' :: ((Untyped.ReadCtx m msg)) => (CapDescriptor msg) -> (m (CapDescriptor' msg))
+get_CapDescriptor' (CapDescriptor'newtype_ struct) = (Classes.fromStruct struct)
+set_CapDescriptor'none :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> (m ())
+set_CapDescriptor'none (CapDescriptor'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_CapDescriptor'senderHosted :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_CapDescriptor'senderHosted (CapDescriptor'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_CapDescriptor'senderPromise :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_CapDescriptor'senderPromise (CapDescriptor'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_CapDescriptor'receiverHosted :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_CapDescriptor'receiverHosted (CapDescriptor'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_CapDescriptor'receiverAnswer :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> (PromisedAnswer (Message.MutMsg s)) -> (m ())
+set_CapDescriptor'receiverAnswer (CapDescriptor'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_CapDescriptor'thirdPartyHosted :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> (ThirdPartyCapDescriptor (Message.MutMsg s)) -> (m ())
+set_CapDescriptor'thirdPartyHosted (CapDescriptor'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_CapDescriptor'unknown' :: ((Untyped.RWCtx m s)) => (CapDescriptor (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_CapDescriptor'unknown' (CapDescriptor'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype PromisedAnswer msg
+ = PromisedAnswer'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg PromisedAnswer) where
+ tMsg f (PromisedAnswer'newtype_ s) = (PromisedAnswer'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (PromisedAnswer msg)) where
+ fromStruct struct = (Std_.pure (PromisedAnswer'newtype_ struct))
+instance (Classes.ToStruct msg (PromisedAnswer msg)) where
+ toStruct (PromisedAnswer'newtype_ struct) = struct
+instance (Untyped.HasMessage (PromisedAnswer msg)) where
+ type InMessage (PromisedAnswer msg) = msg
+ message (PromisedAnswer'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (PromisedAnswer msg)) where
+ messageDefault msg = (PromisedAnswer'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (PromisedAnswer msg)) where
+ fromPtr msg ptr = (PromisedAnswer'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (PromisedAnswer (Message.MutMsg s))) where
+ toPtr msg (PromisedAnswer'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (PromisedAnswer (Message.MutMsg s))) where
+ new msg = (PromisedAnswer'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (PromisedAnswer msg)) where
+ newtype List msg (PromisedAnswer msg)
+ = PromisedAnswer'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (PromisedAnswer'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (PromisedAnswer'List_ l) = (Untyped.ListStruct l)
+ length (PromisedAnswer'List_ l) = (Untyped.length l)
+ index i (PromisedAnswer'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (PromisedAnswer (Message.MutMsg s))) where
+ setIndex (PromisedAnswer'newtype_ elt) i (PromisedAnswer'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (PromisedAnswer'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_PromisedAnswer'questionId :: ((Untyped.ReadCtx m msg)) => (PromisedAnswer msg) -> (m Std_.Word32)
+get_PromisedAnswer'questionId (PromisedAnswer'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_PromisedAnswer'questionId :: ((Untyped.RWCtx m s)) => (PromisedAnswer (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_PromisedAnswer'questionId (PromisedAnswer'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_PromisedAnswer'transform :: ((Untyped.ReadCtx m msg)) => (PromisedAnswer msg) -> (m (Basics.List msg (PromisedAnswer'Op msg)))
+get_PromisedAnswer'transform (PromisedAnswer'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_PromisedAnswer'transform :: ((Untyped.RWCtx m s)) => (PromisedAnswer (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (PromisedAnswer'Op (Message.MutMsg s))) -> (m ())
+set_PromisedAnswer'transform (PromisedAnswer'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_PromisedAnswer'transform :: ((Untyped.ReadCtx m msg)) => (PromisedAnswer msg) -> (m Std_.Bool)
+has_PromisedAnswer'transform (PromisedAnswer'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_PromisedAnswer'transform :: ((Untyped.RWCtx m s)) => Std_.Int -> (PromisedAnswer (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (PromisedAnswer'Op (Message.MutMsg s))))
+new_PromisedAnswer'transform len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_PromisedAnswer'transform struct result)
+ (Std_.pure result)
+ )
+newtype PromisedAnswer'Op msg
+ = PromisedAnswer'Op'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg PromisedAnswer'Op) where
+ tMsg f (PromisedAnswer'Op'newtype_ s) = (PromisedAnswer'Op'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (PromisedAnswer'Op msg)) where
+ fromStruct struct = (Std_.pure (PromisedAnswer'Op'newtype_ struct))
+instance (Classes.ToStruct msg (PromisedAnswer'Op msg)) where
+ toStruct (PromisedAnswer'Op'newtype_ struct) = struct
+instance (Untyped.HasMessage (PromisedAnswer'Op msg)) where
+ type InMessage (PromisedAnswer'Op msg) = msg
+ message (PromisedAnswer'Op'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (PromisedAnswer'Op msg)) where
+ messageDefault msg = (PromisedAnswer'Op'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (PromisedAnswer'Op msg)) where
+ fromPtr msg ptr = (PromisedAnswer'Op'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (PromisedAnswer'Op (Message.MutMsg s))) where
+ toPtr msg (PromisedAnswer'Op'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (PromisedAnswer'Op (Message.MutMsg s))) where
+ new msg = (PromisedAnswer'Op'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (PromisedAnswer'Op msg)) where
+ newtype List msg (PromisedAnswer'Op msg)
+ = PromisedAnswer'Op'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (PromisedAnswer'Op'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (PromisedAnswer'Op'List_ l) = (Untyped.ListStruct l)
+ length (PromisedAnswer'Op'List_ l) = (Untyped.length l)
+ index i (PromisedAnswer'Op'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (PromisedAnswer'Op (Message.MutMsg s))) where
+ setIndex (PromisedAnswer'Op'newtype_ elt) i (PromisedAnswer'Op'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (PromisedAnswer'Op'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+data PromisedAnswer'Op' msg
+ = PromisedAnswer'Op'noop
+ | PromisedAnswer'Op'getPointerField Std_.Word16
+ | PromisedAnswer'Op'unknown' Std_.Word16
+instance (Classes.FromStruct msg (PromisedAnswer'Op' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure PromisedAnswer'Op'noop)
+ 1 ->
+ (PromisedAnswer'Op'getPointerField <$> (GenHelpers.getWordField struct 0 16 0))
+ _ ->
+ (Std_.pure (PromisedAnswer'Op'unknown' (Std_.fromIntegral tag)))
+ )
+get_PromisedAnswer'Op' :: ((Untyped.ReadCtx m msg)) => (PromisedAnswer'Op msg) -> (m (PromisedAnswer'Op' msg))
+get_PromisedAnswer'Op' (PromisedAnswer'Op'newtype_ struct) = (Classes.fromStruct struct)
+set_PromisedAnswer'Op'noop :: ((Untyped.RWCtx m s)) => (PromisedAnswer'Op (Message.MutMsg s)) -> (m ())
+set_PromisedAnswer'Op'noop (PromisedAnswer'Op'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_PromisedAnswer'Op'getPointerField :: ((Untyped.RWCtx m s)) => (PromisedAnswer'Op (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_PromisedAnswer'Op'getPointerField (PromisedAnswer'Op'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 0)
+ )
+set_PromisedAnswer'Op'unknown' :: ((Untyped.RWCtx m s)) => (PromisedAnswer'Op (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_PromisedAnswer'Op'unknown' (PromisedAnswer'Op'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype ThirdPartyCapDescriptor msg
+ = ThirdPartyCapDescriptor'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg ThirdPartyCapDescriptor) where
+ tMsg f (ThirdPartyCapDescriptor'newtype_ s) = (ThirdPartyCapDescriptor'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (ThirdPartyCapDescriptor msg)) where
+ fromStruct struct = (Std_.pure (ThirdPartyCapDescriptor'newtype_ struct))
+instance (Classes.ToStruct msg (ThirdPartyCapDescriptor msg)) where
+ toStruct (ThirdPartyCapDescriptor'newtype_ struct) = struct
+instance (Untyped.HasMessage (ThirdPartyCapDescriptor msg)) where
+ type InMessage (ThirdPartyCapDescriptor msg) = msg
+ message (ThirdPartyCapDescriptor'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (ThirdPartyCapDescriptor msg)) where
+ messageDefault msg = (ThirdPartyCapDescriptor'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (ThirdPartyCapDescriptor msg)) where
+ fromPtr msg ptr = (ThirdPartyCapDescriptor'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (ThirdPartyCapDescriptor (Message.MutMsg s))) where
+ toPtr msg (ThirdPartyCapDescriptor'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (ThirdPartyCapDescriptor (Message.MutMsg s))) where
+ new msg = (ThirdPartyCapDescriptor'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (ThirdPartyCapDescriptor msg)) where
+ newtype List msg (ThirdPartyCapDescriptor msg)
+ = ThirdPartyCapDescriptor'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (ThirdPartyCapDescriptor'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (ThirdPartyCapDescriptor'List_ l) = (Untyped.ListStruct l)
+ length (ThirdPartyCapDescriptor'List_ l) = (Untyped.length l)
+ index i (ThirdPartyCapDescriptor'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (ThirdPartyCapDescriptor (Message.MutMsg s))) where
+ setIndex (ThirdPartyCapDescriptor'newtype_ elt) i (ThirdPartyCapDescriptor'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (ThirdPartyCapDescriptor'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_ThirdPartyCapDescriptor'id :: ((Untyped.ReadCtx m msg)) => (ThirdPartyCapDescriptor msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_ThirdPartyCapDescriptor'id (ThirdPartyCapDescriptor'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_ThirdPartyCapDescriptor'id :: ((Untyped.RWCtx m s)) => (ThirdPartyCapDescriptor (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_ThirdPartyCapDescriptor'id (ThirdPartyCapDescriptor'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_ThirdPartyCapDescriptor'id :: ((Untyped.ReadCtx m msg)) => (ThirdPartyCapDescriptor msg) -> (m Std_.Bool)
+has_ThirdPartyCapDescriptor'id (ThirdPartyCapDescriptor'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+get_ThirdPartyCapDescriptor'vineId :: ((Untyped.ReadCtx m msg)) => (ThirdPartyCapDescriptor msg) -> (m Std_.Word32)
+get_ThirdPartyCapDescriptor'vineId (ThirdPartyCapDescriptor'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_ThirdPartyCapDescriptor'vineId :: ((Untyped.RWCtx m s)) => (ThirdPartyCapDescriptor (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_ThirdPartyCapDescriptor'vineId (ThirdPartyCapDescriptor'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+newtype Exception msg
+ = Exception'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Exception) where
+ tMsg f (Exception'newtype_ s) = (Exception'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Exception msg)) where
+ fromStruct struct = (Std_.pure (Exception'newtype_ struct))
+instance (Classes.ToStruct msg (Exception msg)) where
+ toStruct (Exception'newtype_ struct) = struct
+instance (Untyped.HasMessage (Exception msg)) where
+ type InMessage (Exception msg) = msg
+ message (Exception'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Exception msg)) where
+ messageDefault msg = (Exception'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Exception msg)) where
+ fromPtr msg ptr = (Exception'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Exception (Message.MutMsg s))) where
+ toPtr msg (Exception'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Exception (Message.MutMsg s))) where
+ new msg = (Exception'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Exception msg)) where
+ newtype List msg (Exception msg)
+ = Exception'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Exception'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Exception'List_ l) = (Untyped.ListStruct l)
+ length (Exception'List_ l) = (Untyped.length l)
+ index i (Exception'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Exception (Message.MutMsg s))) where
+ setIndex (Exception'newtype_ elt) i (Exception'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Exception'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Exception'reason :: ((Untyped.ReadCtx m msg)) => (Exception msg) -> (m (Basics.Text msg))
+get_Exception'reason (Exception'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Exception'reason :: ((Untyped.RWCtx m s)) => (Exception (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Exception'reason (Exception'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Exception'reason :: ((Untyped.ReadCtx m msg)) => (Exception msg) -> (m Std_.Bool)
+has_Exception'reason (Exception'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Exception'reason :: ((Untyped.RWCtx m s)) => Std_.Int -> (Exception (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Exception'reason len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Exception'reason struct result)
+ (Std_.pure result)
+ )
+get_Exception'obsoleteIsCallersFault :: ((Untyped.ReadCtx m msg)) => (Exception msg) -> (m Std_.Bool)
+get_Exception'obsoleteIsCallersFault (Exception'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Exception'obsoleteIsCallersFault :: ((Untyped.RWCtx m s)) => (Exception (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Exception'obsoleteIsCallersFault (Exception'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 0 0)
+get_Exception'obsoleteDurability :: ((Untyped.ReadCtx m msg)) => (Exception msg) -> (m Std_.Word16)
+get_Exception'obsoleteDurability (Exception'newtype_ struct) = (GenHelpers.getWordField struct 0 16 0)
+set_Exception'obsoleteDurability :: ((Untyped.RWCtx m s)) => (Exception (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Exception'obsoleteDurability (Exception'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 0)
+get_Exception'type_ :: ((Untyped.ReadCtx m msg)) => (Exception msg) -> (m Exception'Type)
+get_Exception'type_ (Exception'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_Exception'type_ :: ((Untyped.RWCtx m s)) => (Exception (Message.MutMsg s)) -> Exception'Type -> (m ())
+set_Exception'type_ (Exception'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+data Exception'Type
+ = Exception'Type'failed
+ | Exception'Type'overloaded
+ | Exception'Type'disconnected
+ | Exception'Type'unimplemented
+ | Exception'Type'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Read
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Classes.IsWord Exception'Type) where
+ fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
+ 0 ->
+ Exception'Type'failed
+ 1 ->
+ Exception'Type'overloaded
+ 2 ->
+ Exception'Type'disconnected
+ 3 ->
+ Exception'Type'unimplemented
+ tag ->
+ (Exception'Type'unknown' tag)
+ toWord (Exception'Type'failed) = 0
+ toWord (Exception'Type'overloaded) = 1
+ toWord (Exception'Type'disconnected) = 2
+ toWord (Exception'Type'unimplemented) = 3
+ toWord (Exception'Type'unknown' tag) = (Std_.fromIntegral tag)
+instance (Std_.Enum Exception'Type) where
+ fromEnum x = (Std_.fromIntegral (Classes.toWord x))
+ toEnum x = (Classes.fromWord (Std_.fromIntegral x))
+instance (Basics.ListElem msg Exception'Type) where
+ newtype List msg Exception'Type
+ = Exception'Type'List_ (Untyped.ListOf msg Std_.Word16)
+ index i (Exception'Type'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
+ listFromPtr msg ptr = (Exception'Type'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Exception'Type'List_ l) = (Untyped.List16 l)
+ length (Exception'Type'List_ l) = (Untyped.length l)
+instance (Classes.MutListElem s Exception'Type) where
+ setIndex elt i (Exception'Type'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
+ newList msg size = (Exception'Type'List_ <$> (Untyped.allocList16 msg size))
diff --git a/gen/lib/Capnp/Gen/Capnp/Rpc/Pure.hs b/gen/lib/Capnp/Gen/Capnp/Rpc/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Rpc/Pure.hs
@@ -0,0 +1,1066 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Rpc.Pure(Capnp.Gen.ById.Xb312981b2552a250.Exception'Type(..)
+ ,Message(..)
+ ,Bootstrap(..)
+ ,Call(..)
+ ,Call'sendResultsTo(..)
+ ,Return(..)
+ ,Return'(..)
+ ,Finish(..)
+ ,Resolve(..)
+ ,Resolve'(..)
+ ,Release(..)
+ ,Disembargo(..)
+ ,Disembargo'context(..)
+ ,Provide(..)
+ ,Accept(..)
+ ,Join(..)
+ ,MessageTarget(..)
+ ,Payload(..)
+ ,CapDescriptor(..)
+ ,PromisedAnswer(..)
+ ,PromisedAnswer'Op(..)
+ ,ThirdPartyCapDescriptor(..)
+ ,Exception(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Gen.ById.Xb312981b2552a250
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+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 (Std_.Maybe UntypedPure.Ptr)
+ | Message'bootstrap Bootstrap
+ | Message'obsoleteDelete (Std_.Maybe UntypedPure.Ptr)
+ | Message'provide Provide
+ | Message'accept Accept
+ | Message'join Join
+ | Message'disembargo Disembargo
+ | Message'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Message) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Message) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Message) where
+ type Cerial msg Message = (Capnp.Gen.ById.Xb312981b2552a250.Message msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_Message' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'unimplemented raw) ->
+ (Message'unimplemented <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'abort raw) ->
+ (Message'abort <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'call raw) ->
+ (Message'call <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'return raw) ->
+ (Message'return <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'finish raw) ->
+ (Message'finish <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'resolve raw) ->
+ (Message'resolve <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'release raw) ->
+ (Message'release <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'obsoleteSave raw) ->
+ (Message'obsoleteSave <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'bootstrap raw) ->
+ (Message'bootstrap <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'obsoleteDelete raw) ->
+ (Message'obsoleteDelete <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'provide raw) ->
+ (Message'provide <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'accept raw) ->
+ (Message'accept <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'join raw) ->
+ (Message'join <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'disembargo raw) ->
+ (Message'disembargo <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Message'unknown' tag) ->
+ (Std_.pure (Message'unknown' tag))
+ )
+instance (Classes.Marshal Message) where
+ marshalInto raw_ value_ = case value_ of
+ (Message'unimplemented arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'unimplemented raw_))
+ (Message'abort arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'abort raw_))
+ (Message'call arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'call raw_))
+ (Message'return arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'return raw_))
+ (Message'finish arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'finish raw_))
+ (Message'resolve arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'resolve raw_))
+ (Message'release arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'release raw_))
+ (Message'obsoleteSave arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'obsoleteSave raw_))
+ (Message'bootstrap arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'bootstrap raw_))
+ (Message'obsoleteDelete arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'obsoleteDelete raw_))
+ (Message'provide arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'provide raw_))
+ (Message'accept arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'accept raw_))
+ (Message'join arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'join raw_))
+ (Message'disembargo arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Message'disembargo raw_))
+ (Message'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Message'unknown' raw_ tag)
+instance (Classes.Cerialize Message)
+instance (Classes.Cerialize (V.Vector Message)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Message))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Message)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Message))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Message)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Message))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Message)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Bootstrap
+ = Bootstrap
+ {questionId :: Std_.Word32
+ ,deprecatedObjectId :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Bootstrap) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Bootstrap) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Bootstrap) where
+ type Cerial msg Bootstrap = (Capnp.Gen.ById.Xb312981b2552a250.Bootstrap msg)
+ decerialize raw = (Bootstrap <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Bootstrap'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Bootstrap'deprecatedObjectId raw) >>= Classes.decerialize))
+instance (Classes.Marshal Bootstrap) where
+ marshalInto raw_ value_ = case value_ of
+ Bootstrap{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Bootstrap'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) deprecatedObjectId) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Bootstrap'deprecatedObjectId raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Bootstrap)
+instance (Classes.Cerialize (V.Vector Bootstrap)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Bootstrap))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Bootstrap)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Bootstrap))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bootstrap)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bootstrap))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bootstrap)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Call
+ = Call
+ {questionId :: Std_.Word32
+ ,target :: MessageTarget
+ ,interfaceId :: Std_.Word64
+ ,methodId :: Std_.Word16
+ ,params :: Payload
+ ,sendResultsTo :: Call'sendResultsTo
+ ,allowThirdPartyTailCall :: Std_.Bool}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Call) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Call) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Call) where
+ type Cerial msg Call = (Capnp.Gen.ById.Xb312981b2552a250.Call msg)
+ decerialize raw = (Call <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Call'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Call'target raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Call'interfaceId raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Call'methodId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Call'params raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Call'sendResultsTo raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Call'allowThirdPartyTailCall raw))
+instance (Classes.Marshal Call) where
+ marshalInto raw_ value_ = case value_ of
+ Call{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) target) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Call'target raw_))
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'interfaceId raw_ interfaceId)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'methodId raw_ methodId)
+ ((Classes.cerialize (Untyped.message raw_) params) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Call'params raw_))
+ (do
+ raw_ <- (Capnp.Gen.ById.Xb312981b2552a250.get_Call'sendResultsTo raw_)
+ (Classes.marshalInto raw_ sendResultsTo)
+ )
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'allowThirdPartyTailCall raw_ allowThirdPartyTailCall)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Call)
+instance (Classes.Cerialize (V.Vector Call)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Call))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Call)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Call))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Call)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Call))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Call)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Call'sendResultsTo
+ = Call'sendResultsTo'caller
+ | Call'sendResultsTo'yourself
+ | Call'sendResultsTo'thirdParty (Std_.Maybe UntypedPure.Ptr)
+ | Call'sendResultsTo'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Call'sendResultsTo) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Call'sendResultsTo) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Call'sendResultsTo) where
+ type Cerial msg Call'sendResultsTo = (Capnp.Gen.ById.Xb312981b2552a250.Call'sendResultsTo msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_Call'sendResultsTo' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.Call'sendResultsTo'caller) ->
+ (Std_.pure Call'sendResultsTo'caller)
+ (Capnp.Gen.ById.Xb312981b2552a250.Call'sendResultsTo'yourself) ->
+ (Std_.pure Call'sendResultsTo'yourself)
+ (Capnp.Gen.ById.Xb312981b2552a250.Call'sendResultsTo'thirdParty raw) ->
+ (Call'sendResultsTo'thirdParty <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Call'sendResultsTo'unknown' tag) ->
+ (Std_.pure (Call'sendResultsTo'unknown' tag))
+ )
+instance (Classes.Marshal Call'sendResultsTo) where
+ marshalInto raw_ value_ = case value_ of
+ (Call'sendResultsTo'caller) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'sendResultsTo'caller raw_)
+ (Call'sendResultsTo'yourself) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'sendResultsTo'yourself raw_)
+ (Call'sendResultsTo'thirdParty arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Call'sendResultsTo'thirdParty raw_))
+ (Call'sendResultsTo'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Call'sendResultsTo'unknown' raw_ tag)
+data Return
+ = Return
+ {answerId :: Std_.Word32
+ ,releaseParamCaps :: Std_.Bool
+ ,union' :: Return'}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Return) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Return) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Return) where
+ type Cerial msg Return = (Capnp.Gen.ById.Xb312981b2552a250.Return msg)
+ decerialize raw = (Return <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Return'answerId raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Return'releaseParamCaps raw)
+ <*> (Classes.decerialize raw))
+instance (Classes.Marshal Return) where
+ marshalInto raw_ value_ = case value_ of
+ Return{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'answerId raw_ answerId)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'releaseParamCaps raw_ releaseParamCaps)
+ (do
+ (Classes.marshalInto raw_ union')
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Return)
+instance (Classes.Cerialize (V.Vector Return)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Return))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Return)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Return))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Return)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Return))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Return)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Return'
+ = Return'results Payload
+ | Return'exception Exception
+ | Return'canceled
+ | Return'resultsSentElsewhere
+ | Return'takeFromOtherQuestion Std_.Word32
+ | Return'acceptFromThirdParty (Std_.Maybe UntypedPure.Ptr)
+ | Return'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Return') where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Return') where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Return') where
+ type Cerial msg Return' = (Capnp.Gen.ById.Xb312981b2552a250.Return msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_Return' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'results raw) ->
+ (Return'results <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'exception raw) ->
+ (Return'exception <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'canceled) ->
+ (Std_.pure Return'canceled)
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'resultsSentElsewhere) ->
+ (Std_.pure Return'resultsSentElsewhere)
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'takeFromOtherQuestion raw) ->
+ (Std_.pure (Return'takeFromOtherQuestion raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'acceptFromThirdParty raw) ->
+ (Return'acceptFromThirdParty <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Return'unknown' tag) ->
+ (Std_.pure (Return'unknown' tag))
+ )
+instance (Classes.Marshal Return') where
+ marshalInto raw_ value_ = case value_ of
+ (Return'results arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Return'results raw_))
+ (Return'exception arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Return'exception raw_))
+ (Return'canceled) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'canceled raw_)
+ (Return'resultsSentElsewhere) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'resultsSentElsewhere raw_)
+ (Return'takeFromOtherQuestion arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'takeFromOtherQuestion raw_ arg_)
+ (Return'acceptFromThirdParty arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Return'acceptFromThirdParty raw_))
+ (Return'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Return'unknown' raw_ tag)
+data Finish
+ = Finish
+ {questionId :: Std_.Word32
+ ,releaseResultCaps :: Std_.Bool}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Finish) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Finish) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Finish) where
+ type Cerial msg Finish = (Capnp.Gen.ById.Xb312981b2552a250.Finish msg)
+ decerialize raw = (Finish <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Finish'questionId raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Finish'releaseResultCaps raw))
+instance (Classes.Marshal Finish) where
+ marshalInto raw_ value_ = case value_ of
+ Finish{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Finish'questionId raw_ questionId)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Finish'releaseResultCaps raw_ releaseResultCaps)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Finish)
+instance (Classes.Cerialize (V.Vector Finish)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Finish))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Finish)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Finish))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Finish)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Finish))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Finish)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Resolve
+ = Resolve
+ {promiseId :: Std_.Word32
+ ,union' :: Resolve'}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Resolve) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Resolve) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Resolve) where
+ type Cerial msg Resolve = (Capnp.Gen.ById.Xb312981b2552a250.Resolve msg)
+ decerialize raw = (Resolve <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Resolve'promiseId raw)
+ <*> (Classes.decerialize raw))
+instance (Classes.Marshal Resolve) where
+ marshalInto raw_ value_ = case value_ of
+ Resolve{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Resolve'promiseId raw_ promiseId)
+ (do
+ (Classes.marshalInto raw_ union')
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Resolve)
+instance (Classes.Cerialize (V.Vector Resolve)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Resolve))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Resolve)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Resolve))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Resolve)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Resolve))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Resolve)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Resolve'
+ = Resolve'cap CapDescriptor
+ | Resolve'exception Exception
+ | Resolve'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Resolve') where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Resolve') where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Resolve') where
+ type Cerial msg Resolve' = (Capnp.Gen.ById.Xb312981b2552a250.Resolve msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_Resolve' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.Resolve'cap raw) ->
+ (Resolve'cap <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Resolve'exception raw) ->
+ (Resolve'exception <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Resolve'unknown' tag) ->
+ (Std_.pure (Resolve'unknown' tag))
+ )
+instance (Classes.Marshal Resolve') where
+ marshalInto raw_ value_ = case value_ of
+ (Resolve'cap arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Resolve'cap raw_))
+ (Resolve'exception arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Resolve'exception raw_))
+ (Resolve'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Resolve'unknown' raw_ tag)
+data Release
+ = Release
+ {id :: Std_.Word32
+ ,referenceCount :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Release) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Release) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Release) where
+ type Cerial msg Release = (Capnp.Gen.ById.Xb312981b2552a250.Release msg)
+ decerialize raw = (Release <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Release'id raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Release'referenceCount raw))
+instance (Classes.Marshal Release) where
+ marshalInto raw_ value_ = case value_ of
+ Release{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Release'id raw_ id)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Release'referenceCount raw_ referenceCount)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Release)
+instance (Classes.Cerialize (V.Vector Release)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Release))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Release)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Release))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Release)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Release))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Release)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Disembargo
+ = Disembargo
+ {target :: MessageTarget
+ ,context :: Disembargo'context}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Disembargo) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Disembargo) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Disembargo) where
+ type Cerial msg Disembargo = (Capnp.Gen.ById.Xb312981b2552a250.Disembargo msg)
+ decerialize raw = (Disembargo <$> ((Capnp.Gen.ById.Xb312981b2552a250.get_Disembargo'target raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Disembargo'context raw) >>= Classes.decerialize))
+instance (Classes.Marshal Disembargo) where
+ marshalInto raw_ value_ = case value_ of
+ Disembargo{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) target) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'target raw_))
+ (do
+ raw_ <- (Capnp.Gen.ById.Xb312981b2552a250.get_Disembargo'context raw_)
+ (Classes.marshalInto raw_ context)
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Disembargo)
+instance (Classes.Cerialize (V.Vector Disembargo)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Disembargo))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Disembargo)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Disembargo))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Disembargo)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Disembargo))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Disembargo)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Disembargo'context
+ = Disembargo'context'senderLoopback Std_.Word32
+ | Disembargo'context'receiverLoopback Std_.Word32
+ | Disembargo'context'accept
+ | Disembargo'context'provide Std_.Word32
+ | Disembargo'context'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Disembargo'context) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Disembargo'context) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Disembargo'context) where
+ type Cerial msg Disembargo'context = (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_Disembargo'context' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context'senderLoopback raw) ->
+ (Std_.pure (Disembargo'context'senderLoopback raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context'receiverLoopback raw) ->
+ (Std_.pure (Disembargo'context'receiverLoopback raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context'accept) ->
+ (Std_.pure Disembargo'context'accept)
+ (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context'provide raw) ->
+ (Std_.pure (Disembargo'context'provide raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.Disembargo'context'unknown' tag) ->
+ (Std_.pure (Disembargo'context'unknown' tag))
+ )
+instance (Classes.Marshal Disembargo'context) where
+ marshalInto raw_ value_ = case value_ of
+ (Disembargo'context'senderLoopback arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'context'senderLoopback raw_ arg_)
+ (Disembargo'context'receiverLoopback arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'context'receiverLoopback raw_ arg_)
+ (Disembargo'context'accept) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'context'accept raw_)
+ (Disembargo'context'provide arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'context'provide raw_ arg_)
+ (Disembargo'context'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Disembargo'context'unknown' raw_ tag)
+data Provide
+ = Provide
+ {questionId :: Std_.Word32
+ ,target :: MessageTarget
+ ,recipient :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Provide) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Provide) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Provide) where
+ type Cerial msg Provide = (Capnp.Gen.ById.Xb312981b2552a250.Provide msg)
+ decerialize raw = (Provide <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Provide'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Provide'target raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Provide'recipient raw) >>= Classes.decerialize))
+instance (Classes.Marshal Provide) where
+ marshalInto raw_ value_ = case value_ of
+ Provide{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Provide'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) target) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Provide'target raw_))
+ ((Classes.cerialize (Untyped.message raw_) recipient) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Provide'recipient raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Provide)
+instance (Classes.Cerialize (V.Vector Provide)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Provide))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Provide)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Provide))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Provide)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Provide))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Provide)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Accept
+ = Accept
+ {questionId :: Std_.Word32
+ ,provision :: (Std_.Maybe UntypedPure.Ptr)
+ ,embargo :: Std_.Bool}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Accept) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Accept) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Accept) where
+ type Cerial msg Accept = (Capnp.Gen.ById.Xb312981b2552a250.Accept msg)
+ decerialize raw = (Accept <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Accept'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Accept'provision raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Accept'embargo raw))
+instance (Classes.Marshal Accept) where
+ marshalInto raw_ value_ = case value_ of
+ Accept{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Accept'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) provision) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Accept'provision raw_))
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Accept'embargo raw_ embargo)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Accept)
+instance (Classes.Cerialize (V.Vector Accept)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Accept))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Accept)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Accept))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Accept)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Accept))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Accept)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Join
+ = Join
+ {questionId :: Std_.Word32
+ ,target :: MessageTarget
+ ,keyPart :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Join) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Join) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Join) where
+ type Cerial msg Join = (Capnp.Gen.ById.Xb312981b2552a250.Join msg)
+ decerialize raw = (Join <$> (Capnp.Gen.ById.Xb312981b2552a250.get_Join'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Join'target raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Join'keyPart raw) >>= Classes.decerialize))
+instance (Classes.Marshal Join) where
+ marshalInto raw_ value_ = case value_ of
+ Join{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Join'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) target) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Join'target raw_))
+ ((Classes.cerialize (Untyped.message raw_) keyPart) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Join'keyPart raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Join)
+instance (Classes.Cerialize (V.Vector Join)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Join))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Join)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Join))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Join)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Join))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Join)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data MessageTarget
+ = MessageTarget'importedCap Std_.Word32
+ | MessageTarget'promisedAnswer PromisedAnswer
+ | MessageTarget'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default MessageTarget) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg MessageTarget) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize MessageTarget) where
+ type Cerial msg MessageTarget = (Capnp.Gen.ById.Xb312981b2552a250.MessageTarget msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_MessageTarget' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.MessageTarget'importedCap raw) ->
+ (Std_.pure (MessageTarget'importedCap raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.MessageTarget'promisedAnswer raw) ->
+ (MessageTarget'promisedAnswer <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.MessageTarget'unknown' tag) ->
+ (Std_.pure (MessageTarget'unknown' tag))
+ )
+instance (Classes.Marshal MessageTarget) where
+ marshalInto raw_ value_ = case value_ of
+ (MessageTarget'importedCap arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_MessageTarget'importedCap raw_ arg_)
+ (MessageTarget'promisedAnswer arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_MessageTarget'promisedAnswer raw_))
+ (MessageTarget'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_MessageTarget'unknown' raw_ tag)
+instance (Classes.Cerialize MessageTarget)
+instance (Classes.Cerialize (V.Vector MessageTarget)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector MessageTarget))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector MessageTarget)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector MessageTarget))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector MessageTarget)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector MessageTarget))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector MessageTarget)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Payload
+ = Payload
+ {content :: (Std_.Maybe UntypedPure.Ptr)
+ ,capTable :: (V.Vector CapDescriptor)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Payload) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Payload) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Payload) where
+ type Cerial msg Payload = (Capnp.Gen.ById.Xb312981b2552a250.Payload msg)
+ decerialize raw = (Payload <$> ((Capnp.Gen.ById.Xb312981b2552a250.get_Payload'content raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_Payload'capTable raw) >>= Classes.decerialize))
+instance (Classes.Marshal Payload) where
+ marshalInto raw_ value_ = case value_ of
+ Payload{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) content) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Payload'content raw_))
+ ((Classes.cerialize (Untyped.message raw_) capTable) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Payload'capTable raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Payload)
+instance (Classes.Cerialize (V.Vector Payload)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Payload))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Payload)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Payload))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Payload)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Payload))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Payload)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CapDescriptor
+ = CapDescriptor'none
+ | CapDescriptor'senderHosted Std_.Word32
+ | CapDescriptor'senderPromise Std_.Word32
+ | CapDescriptor'receiverHosted Std_.Word32
+ | CapDescriptor'receiverAnswer PromisedAnswer
+ | CapDescriptor'thirdPartyHosted ThirdPartyCapDescriptor
+ | CapDescriptor'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CapDescriptor) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CapDescriptor) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CapDescriptor) where
+ type Cerial msg CapDescriptor = (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_CapDescriptor' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'none) ->
+ (Std_.pure CapDescriptor'none)
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'senderHosted raw) ->
+ (Std_.pure (CapDescriptor'senderHosted raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'senderPromise raw) ->
+ (Std_.pure (CapDescriptor'senderPromise raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'receiverHosted raw) ->
+ (Std_.pure (CapDescriptor'receiverHosted raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'receiverAnswer raw) ->
+ (CapDescriptor'receiverAnswer <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'thirdPartyHosted raw) ->
+ (CapDescriptor'thirdPartyHosted <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.CapDescriptor'unknown' tag) ->
+ (Std_.pure (CapDescriptor'unknown' tag))
+ )
+instance (Classes.Marshal CapDescriptor) where
+ marshalInto raw_ value_ = case value_ of
+ (CapDescriptor'none) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'none raw_)
+ (CapDescriptor'senderHosted arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'senderHosted raw_ arg_)
+ (CapDescriptor'senderPromise arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'senderPromise raw_ arg_)
+ (CapDescriptor'receiverHosted arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'receiverHosted raw_ arg_)
+ (CapDescriptor'receiverAnswer arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'receiverAnswer raw_))
+ (CapDescriptor'thirdPartyHosted arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'thirdPartyHosted raw_))
+ (CapDescriptor'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_CapDescriptor'unknown' raw_ tag)
+instance (Classes.Cerialize CapDescriptor)
+instance (Classes.Cerialize (V.Vector CapDescriptor)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CapDescriptor))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CapDescriptor)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CapDescriptor))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapDescriptor)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapDescriptor))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapDescriptor)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data PromisedAnswer
+ = PromisedAnswer
+ {questionId :: Std_.Word32
+ ,transform :: (V.Vector PromisedAnswer'Op)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default PromisedAnswer) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg PromisedAnswer) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize PromisedAnswer) where
+ type Cerial msg PromisedAnswer = (Capnp.Gen.ById.Xb312981b2552a250.PromisedAnswer msg)
+ decerialize raw = (PromisedAnswer <$> (Capnp.Gen.ById.Xb312981b2552a250.get_PromisedAnswer'questionId raw)
+ <*> ((Capnp.Gen.ById.Xb312981b2552a250.get_PromisedAnswer'transform raw) >>= Classes.decerialize))
+instance (Classes.Marshal PromisedAnswer) where
+ marshalInto raw_ value_ = case value_ of
+ PromisedAnswer{..} ->
+ (do
+ (Capnp.Gen.ById.Xb312981b2552a250.set_PromisedAnswer'questionId raw_ questionId)
+ ((Classes.cerialize (Untyped.message raw_) transform) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_PromisedAnswer'transform raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize PromisedAnswer)
+instance (Classes.Cerialize (V.Vector PromisedAnswer)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector PromisedAnswer))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector PromisedAnswer)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data PromisedAnswer'Op
+ = PromisedAnswer'Op'noop
+ | PromisedAnswer'Op'getPointerField Std_.Word16
+ | PromisedAnswer'Op'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default PromisedAnswer'Op) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg PromisedAnswer'Op) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize PromisedAnswer'Op) where
+ type Cerial msg PromisedAnswer'Op = (Capnp.Gen.ById.Xb312981b2552a250.PromisedAnswer'Op msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xb312981b2552a250.get_PromisedAnswer'Op' raw)
+ case raw of
+ (Capnp.Gen.ById.Xb312981b2552a250.PromisedAnswer'Op'noop) ->
+ (Std_.pure PromisedAnswer'Op'noop)
+ (Capnp.Gen.ById.Xb312981b2552a250.PromisedAnswer'Op'getPointerField raw) ->
+ (Std_.pure (PromisedAnswer'Op'getPointerField raw))
+ (Capnp.Gen.ById.Xb312981b2552a250.PromisedAnswer'Op'unknown' tag) ->
+ (Std_.pure (PromisedAnswer'Op'unknown' tag))
+ )
+instance (Classes.Marshal PromisedAnswer'Op) where
+ marshalInto raw_ value_ = case value_ of
+ (PromisedAnswer'Op'noop) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_PromisedAnswer'Op'noop raw_)
+ (PromisedAnswer'Op'getPointerField arg_) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_PromisedAnswer'Op'getPointerField raw_ arg_)
+ (PromisedAnswer'Op'unknown' tag) ->
+ (Capnp.Gen.ById.Xb312981b2552a250.set_PromisedAnswer'Op'unknown' raw_ tag)
+instance (Classes.Cerialize PromisedAnswer'Op)
+instance (Classes.Cerialize (V.Vector PromisedAnswer'Op)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector PromisedAnswer'Op))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector PromisedAnswer'Op)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer'Op))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer'Op)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer'Op))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PromisedAnswer'Op)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data ThirdPartyCapDescriptor
+ = ThirdPartyCapDescriptor
+ {id :: (Std_.Maybe UntypedPure.Ptr)
+ ,vineId :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default ThirdPartyCapDescriptor) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg ThirdPartyCapDescriptor) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize ThirdPartyCapDescriptor) where
+ type Cerial msg ThirdPartyCapDescriptor = (Capnp.Gen.ById.Xb312981b2552a250.ThirdPartyCapDescriptor msg)
+ decerialize raw = (ThirdPartyCapDescriptor <$> ((Capnp.Gen.ById.Xb312981b2552a250.get_ThirdPartyCapDescriptor'id raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_ThirdPartyCapDescriptor'vineId raw))
+instance (Classes.Marshal ThirdPartyCapDescriptor) where
+ marshalInto raw_ value_ = case value_ of
+ ThirdPartyCapDescriptor{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) id) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'id raw_))
+ (Capnp.Gen.ById.Xb312981b2552a250.set_ThirdPartyCapDescriptor'vineId raw_ vineId)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize ThirdPartyCapDescriptor)
+instance (Classes.Cerialize (V.Vector ThirdPartyCapDescriptor)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector ThirdPartyCapDescriptor))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector ThirdPartyCapDescriptor)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapDescriptor))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapDescriptor)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapDescriptor))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapDescriptor)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Exception
+ = Exception
+ {reason :: T.Text
+ ,obsoleteIsCallersFault :: Std_.Bool
+ ,obsoleteDurability :: Std_.Word16
+ ,type_ :: Capnp.Gen.ById.Xb312981b2552a250.Exception'Type}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Exception) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Exception) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Exception) where
+ type Cerial msg Exception = (Capnp.Gen.ById.Xb312981b2552a250.Exception msg)
+ decerialize raw = (Exception <$> ((Capnp.Gen.ById.Xb312981b2552a250.get_Exception'reason raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Exception'obsoleteIsCallersFault raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Exception'obsoleteDurability raw)
+ <*> (Capnp.Gen.ById.Xb312981b2552a250.get_Exception'type_ raw))
+instance (Classes.Marshal Exception) where
+ marshalInto raw_ value_ = case value_ of
+ Exception{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) reason) >>= (Capnp.Gen.ById.Xb312981b2552a250.set_Exception'reason raw_))
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Exception'obsoleteIsCallersFault raw_ obsoleteIsCallersFault)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Exception'obsoleteDurability raw_ obsoleteDurability)
+ (Capnp.Gen.ById.Xb312981b2552a250.set_Exception'type_ raw_ type_)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Exception)
+instance (Classes.Cerialize (V.Vector Exception)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Exception))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Exception)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Exception))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Exception)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Exception))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Exception)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Decerialize Capnp.Gen.ById.Xb312981b2552a250.Exception'Type) where
+ type Cerial msg Capnp.Gen.ById.Xb312981b2552a250.Exception'Type = Capnp.Gen.ById.Xb312981b2552a250.Exception'Type
+ decerialize = Std_.pure
+instance (Classes.Cerialize Capnp.Gen.ById.Xb312981b2552a250.Exception'Type) where
+ cerialize _ = Std_.pure
+instance (Classes.Cerialize (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type)) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type)))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type)))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xb312981b2552a250.Exception'Type))))))) where
+ cerialize = Classes.cerializeBasicVec
diff --git a/gen/lib/Capnp/Gen/Capnp/RpcTwoparty.hs b/gen/lib/Capnp/Gen/Capnp/RpcTwoparty.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/RpcTwoparty.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.RpcTwoparty where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+data Side
+ = Side'server
+ | Side'client
+ | Side'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Read
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Classes.IsWord Side) where
+ fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
+ 0 ->
+ Side'server
+ 1 ->
+ Side'client
+ tag ->
+ (Side'unknown' tag)
+ toWord (Side'server) = 0
+ toWord (Side'client) = 1
+ toWord (Side'unknown' tag) = (Std_.fromIntegral tag)
+instance (Std_.Enum Side) where
+ fromEnum x = (Std_.fromIntegral (Classes.toWord x))
+ toEnum x = (Classes.fromWord (Std_.fromIntegral x))
+instance (Basics.ListElem msg Side) where
+ newtype List msg Side
+ = Side'List_ (Untyped.ListOf msg Std_.Word16)
+ index i (Side'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
+ listFromPtr msg ptr = (Side'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Side'List_ l) = (Untyped.List16 l)
+ length (Side'List_ l) = (Untyped.length l)
+instance (Classes.MutListElem s Side) where
+ setIndex elt i (Side'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
+ newList msg size = (Side'List_ <$> (Untyped.allocList16 msg size))
+newtype VatId msg
+ = VatId'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VatId) where
+ tMsg f (VatId'newtype_ s) = (VatId'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VatId msg)) where
+ fromStruct struct = (Std_.pure (VatId'newtype_ struct))
+instance (Classes.ToStruct msg (VatId msg)) where
+ toStruct (VatId'newtype_ struct) = struct
+instance (Untyped.HasMessage (VatId msg)) where
+ type InMessage (VatId msg) = msg
+ message (VatId'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VatId msg)) where
+ messageDefault msg = (VatId'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VatId msg)) where
+ fromPtr msg ptr = (VatId'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VatId (Message.MutMsg s))) where
+ toPtr msg (VatId'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VatId (Message.MutMsg s))) where
+ new msg = (VatId'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (VatId msg)) where
+ newtype List msg (VatId msg)
+ = VatId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VatId'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VatId'List_ l) = (Untyped.ListStruct l)
+ length (VatId'List_ l) = (Untyped.length l)
+ index i (VatId'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VatId (Message.MutMsg s))) where
+ setIndex (VatId'newtype_ elt) i (VatId'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VatId'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_VatId'side :: ((Untyped.ReadCtx m msg)) => (VatId msg) -> (m Side)
+get_VatId'side (VatId'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_VatId'side :: ((Untyped.RWCtx m s)) => (VatId (Message.MutMsg s)) -> Side -> (m ())
+set_VatId'side (VatId'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype ProvisionId msg
+ = ProvisionId'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg ProvisionId) where
+ tMsg f (ProvisionId'newtype_ s) = (ProvisionId'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (ProvisionId msg)) where
+ fromStruct struct = (Std_.pure (ProvisionId'newtype_ struct))
+instance (Classes.ToStruct msg (ProvisionId msg)) where
+ toStruct (ProvisionId'newtype_ struct) = struct
+instance (Untyped.HasMessage (ProvisionId msg)) where
+ type InMessage (ProvisionId msg) = msg
+ message (ProvisionId'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (ProvisionId msg)) where
+ messageDefault msg = (ProvisionId'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (ProvisionId msg)) where
+ fromPtr msg ptr = (ProvisionId'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (ProvisionId (Message.MutMsg s))) where
+ toPtr msg (ProvisionId'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (ProvisionId (Message.MutMsg s))) where
+ new msg = (ProvisionId'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (ProvisionId msg)) where
+ newtype List msg (ProvisionId msg)
+ = ProvisionId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (ProvisionId'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (ProvisionId'List_ l) = (Untyped.ListStruct l)
+ length (ProvisionId'List_ l) = (Untyped.length l)
+ index i (ProvisionId'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (ProvisionId (Message.MutMsg s))) where
+ setIndex (ProvisionId'newtype_ elt) i (ProvisionId'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (ProvisionId'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_ProvisionId'joinId :: ((Untyped.ReadCtx m msg)) => (ProvisionId msg) -> (m Std_.Word32)
+get_ProvisionId'joinId (ProvisionId'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_ProvisionId'joinId :: ((Untyped.RWCtx m s)) => (ProvisionId (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_ProvisionId'joinId (ProvisionId'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+newtype RecipientId msg
+ = RecipientId'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg RecipientId) where
+ tMsg f (RecipientId'newtype_ s) = (RecipientId'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (RecipientId msg)) where
+ fromStruct struct = (Std_.pure (RecipientId'newtype_ struct))
+instance (Classes.ToStruct msg (RecipientId msg)) where
+ toStruct (RecipientId'newtype_ struct) = struct
+instance (Untyped.HasMessage (RecipientId msg)) where
+ type InMessage (RecipientId msg) = msg
+ message (RecipientId'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (RecipientId msg)) where
+ messageDefault msg = (RecipientId'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (RecipientId msg)) where
+ fromPtr msg ptr = (RecipientId'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (RecipientId (Message.MutMsg s))) where
+ toPtr msg (RecipientId'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (RecipientId (Message.MutMsg s))) where
+ new msg = (RecipientId'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (RecipientId msg)) where
+ newtype List msg (RecipientId msg)
+ = RecipientId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (RecipientId'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (RecipientId'List_ l) = (Untyped.ListStruct l)
+ length (RecipientId'List_ l) = (Untyped.length l)
+ index i (RecipientId'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (RecipientId (Message.MutMsg s))) where
+ setIndex (RecipientId'newtype_ elt) i (RecipientId'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (RecipientId'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype ThirdPartyCapId msg
+ = ThirdPartyCapId'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg ThirdPartyCapId) where
+ tMsg f (ThirdPartyCapId'newtype_ s) = (ThirdPartyCapId'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (ThirdPartyCapId msg)) where
+ fromStruct struct = (Std_.pure (ThirdPartyCapId'newtype_ struct))
+instance (Classes.ToStruct msg (ThirdPartyCapId msg)) where
+ toStruct (ThirdPartyCapId'newtype_ struct) = struct
+instance (Untyped.HasMessage (ThirdPartyCapId msg)) where
+ type InMessage (ThirdPartyCapId msg) = msg
+ message (ThirdPartyCapId'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (ThirdPartyCapId msg)) where
+ messageDefault msg = (ThirdPartyCapId'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (ThirdPartyCapId msg)) where
+ fromPtr msg ptr = (ThirdPartyCapId'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (ThirdPartyCapId (Message.MutMsg s))) where
+ toPtr msg (ThirdPartyCapId'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (ThirdPartyCapId (Message.MutMsg s))) where
+ new msg = (ThirdPartyCapId'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (ThirdPartyCapId msg)) where
+ newtype List msg (ThirdPartyCapId msg)
+ = ThirdPartyCapId'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (ThirdPartyCapId'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (ThirdPartyCapId'List_ l) = (Untyped.ListStruct l)
+ length (ThirdPartyCapId'List_ l) = (Untyped.length l)
+ index i (ThirdPartyCapId'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (ThirdPartyCapId (Message.MutMsg s))) where
+ setIndex (ThirdPartyCapId'newtype_ elt) i (ThirdPartyCapId'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (ThirdPartyCapId'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype JoinKeyPart msg
+ = JoinKeyPart'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg JoinKeyPart) where
+ tMsg f (JoinKeyPart'newtype_ s) = (JoinKeyPart'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (JoinKeyPart msg)) where
+ fromStruct struct = (Std_.pure (JoinKeyPart'newtype_ struct))
+instance (Classes.ToStruct msg (JoinKeyPart msg)) where
+ toStruct (JoinKeyPart'newtype_ struct) = struct
+instance (Untyped.HasMessage (JoinKeyPart msg)) where
+ type InMessage (JoinKeyPart msg) = msg
+ message (JoinKeyPart'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (JoinKeyPart msg)) where
+ messageDefault msg = (JoinKeyPart'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (JoinKeyPart msg)) where
+ fromPtr msg ptr = (JoinKeyPart'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (JoinKeyPart (Message.MutMsg s))) where
+ toPtr msg (JoinKeyPart'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (JoinKeyPart (Message.MutMsg s))) where
+ new msg = (JoinKeyPart'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (JoinKeyPart msg)) where
+ newtype List msg (JoinKeyPart msg)
+ = JoinKeyPart'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (JoinKeyPart'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (JoinKeyPart'List_ l) = (Untyped.ListStruct l)
+ length (JoinKeyPart'List_ l) = (Untyped.length l)
+ index i (JoinKeyPart'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (JoinKeyPart (Message.MutMsg s))) where
+ setIndex (JoinKeyPart'newtype_ elt) i (JoinKeyPart'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (JoinKeyPart'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_JoinKeyPart'joinId :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word32)
+get_JoinKeyPart'joinId (JoinKeyPart'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_JoinKeyPart'joinId :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_JoinKeyPart'joinId (JoinKeyPart'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_JoinKeyPart'partCount :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word16)
+get_JoinKeyPart'partCount (JoinKeyPart'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_JoinKeyPart'partCount :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_JoinKeyPart'partCount (JoinKeyPart'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 32 0)
+get_JoinKeyPart'partNum :: ((Untyped.ReadCtx m msg)) => (JoinKeyPart msg) -> (m Std_.Word16)
+get_JoinKeyPart'partNum (JoinKeyPart'newtype_ struct) = (GenHelpers.getWordField struct 0 48 0)
+set_JoinKeyPart'partNum :: ((Untyped.RWCtx m s)) => (JoinKeyPart (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_JoinKeyPart'partNum (JoinKeyPart'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 48 0)
+newtype JoinResult msg
+ = JoinResult'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg JoinResult) where
+ tMsg f (JoinResult'newtype_ s) = (JoinResult'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (JoinResult msg)) where
+ fromStruct struct = (Std_.pure (JoinResult'newtype_ struct))
+instance (Classes.ToStruct msg (JoinResult msg)) where
+ toStruct (JoinResult'newtype_ struct) = struct
+instance (Untyped.HasMessage (JoinResult msg)) where
+ type InMessage (JoinResult msg) = msg
+ message (JoinResult'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (JoinResult msg)) where
+ messageDefault msg = (JoinResult'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (JoinResult msg)) where
+ fromPtr msg ptr = (JoinResult'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (JoinResult (Message.MutMsg s))) where
+ toPtr msg (JoinResult'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (JoinResult (Message.MutMsg s))) where
+ new msg = (JoinResult'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (JoinResult msg)) where
+ newtype List msg (JoinResult msg)
+ = JoinResult'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (JoinResult'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (JoinResult'List_ l) = (Untyped.ListStruct l)
+ length (JoinResult'List_ l) = (Untyped.length l)
+ index i (JoinResult'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (JoinResult (Message.MutMsg s))) where
+ setIndex (JoinResult'newtype_ elt) i (JoinResult'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (JoinResult'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_JoinResult'joinId :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Word32)
+get_JoinResult'joinId (JoinResult'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_JoinResult'joinId :: ((Untyped.RWCtx m s)) => (JoinResult (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_JoinResult'joinId (JoinResult'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_JoinResult'succeeded :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Bool)
+get_JoinResult'succeeded (JoinResult'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_JoinResult'succeeded :: ((Untyped.RWCtx m s)) => (JoinResult (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_JoinResult'succeeded (JoinResult'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 32 0)
+get_JoinResult'cap :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m (Std_.Maybe (Untyped.Ptr msg)))
+get_JoinResult'cap (JoinResult'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_JoinResult'cap :: ((Untyped.RWCtx m s)) => (JoinResult (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_JoinResult'cap (JoinResult'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_JoinResult'cap :: ((Untyped.ReadCtx m msg)) => (JoinResult msg) -> (m Std_.Bool)
+has_JoinResult'cap (JoinResult'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
diff --git a/gen/lib/Capnp/Gen/Capnp/RpcTwoparty/Pure.hs b/gen/lib/Capnp/Gen/Capnp/RpcTwoparty/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/RpcTwoparty/Pure.hs
@@ -0,0 +1,272 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.RpcTwoparty.Pure(Capnp.Gen.ById.Xa184c7885cdaf2a1.Side(..)
+ ,VatId(..)
+ ,ProvisionId(..)
+ ,RecipientId(..)
+ ,ThirdPartyCapId(..)
+ ,JoinKeyPart(..)
+ ,JoinResult(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Gen.ById.Xa184c7885cdaf2a1
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+data VatId
+ = VatId
+ {side :: Capnp.Gen.ById.Xa184c7885cdaf2a1.Side}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VatId) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VatId) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VatId) where
+ type Cerial msg VatId = (Capnp.Gen.ById.Xa184c7885cdaf2a1.VatId msg)
+ decerialize raw = (VatId <$> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_VatId'side raw))
+instance (Classes.Marshal VatId) where
+ marshalInto raw_ value_ = case value_ of
+ VatId{..} ->
+ (do
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_VatId'side raw_ side)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VatId)
+instance (Classes.Cerialize (V.Vector VatId)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VatId))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VatId)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VatId))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VatId)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VatId))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VatId)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data ProvisionId
+ = ProvisionId
+ {joinId :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default ProvisionId) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg ProvisionId) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize ProvisionId) where
+ type Cerial msg ProvisionId = (Capnp.Gen.ById.Xa184c7885cdaf2a1.ProvisionId msg)
+ decerialize raw = (ProvisionId <$> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_ProvisionId'joinId raw))
+instance (Classes.Marshal ProvisionId) where
+ marshalInto raw_ value_ = case value_ of
+ ProvisionId{..} ->
+ (do
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_ProvisionId'joinId raw_ joinId)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize ProvisionId)
+instance (Classes.Cerialize (V.Vector ProvisionId)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector ProvisionId))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector ProvisionId)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector ProvisionId))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ProvisionId)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ProvisionId))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ProvisionId)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data RecipientId
+ = RecipientId
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default RecipientId) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg RecipientId) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize RecipientId) where
+ type Cerial msg RecipientId = (Capnp.Gen.ById.Xa184c7885cdaf2a1.RecipientId msg)
+ decerialize raw = (Std_.pure RecipientId)
+instance (Classes.Marshal RecipientId) where
+ marshalInto raw_ value_ = case value_ of
+ (RecipientId) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize RecipientId)
+instance (Classes.Cerialize (V.Vector RecipientId)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector RecipientId))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector RecipientId)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector RecipientId))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RecipientId)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RecipientId))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RecipientId)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data ThirdPartyCapId
+ = ThirdPartyCapId
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default ThirdPartyCapId) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg ThirdPartyCapId) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize ThirdPartyCapId) where
+ type Cerial msg ThirdPartyCapId = (Capnp.Gen.ById.Xa184c7885cdaf2a1.ThirdPartyCapId msg)
+ decerialize raw = (Std_.pure ThirdPartyCapId)
+instance (Classes.Marshal ThirdPartyCapId) where
+ marshalInto raw_ value_ = case value_ of
+ (ThirdPartyCapId) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize ThirdPartyCapId)
+instance (Classes.Cerialize (V.Vector ThirdPartyCapId)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector ThirdPartyCapId))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector ThirdPartyCapId)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapId))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapId)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapId))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ThirdPartyCapId)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data JoinKeyPart
+ = JoinKeyPart
+ {joinId :: Std_.Word32
+ ,partCount :: Std_.Word16
+ ,partNum :: Std_.Word16}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default JoinKeyPart) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg JoinKeyPart) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize JoinKeyPart) where
+ type Cerial msg JoinKeyPart = (Capnp.Gen.ById.Xa184c7885cdaf2a1.JoinKeyPart msg)
+ decerialize raw = (JoinKeyPart <$> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'joinId raw)
+ <*> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'partCount raw)
+ <*> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinKeyPart'partNum raw))
+instance (Classes.Marshal JoinKeyPart) where
+ marshalInto raw_ value_ = case value_ of
+ JoinKeyPart{..} ->
+ (do
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'joinId raw_ joinId)
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partCount raw_ partCount)
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinKeyPart'partNum raw_ partNum)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize JoinKeyPart)
+instance (Classes.Cerialize (V.Vector JoinKeyPart)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector JoinKeyPart))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector JoinKeyPart)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector JoinKeyPart))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinKeyPart)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinKeyPart))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinKeyPart)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data JoinResult
+ = JoinResult
+ {joinId :: Std_.Word32
+ ,succeeded :: Std_.Bool
+ ,cap :: (Std_.Maybe UntypedPure.Ptr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default JoinResult) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg JoinResult) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize JoinResult) where
+ type Cerial msg JoinResult = (Capnp.Gen.ById.Xa184c7885cdaf2a1.JoinResult msg)
+ decerialize raw = (JoinResult <$> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinResult'joinId raw)
+ <*> (Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinResult'succeeded raw)
+ <*> ((Capnp.Gen.ById.Xa184c7885cdaf2a1.get_JoinResult'cap raw) >>= Classes.decerialize))
+instance (Classes.Marshal JoinResult) where
+ marshalInto raw_ value_ = case value_ of
+ JoinResult{..} ->
+ (do
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinResult'joinId raw_ joinId)
+ (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinResult'succeeded raw_ succeeded)
+ ((Classes.cerialize (Untyped.message raw_) cap) >>= (Capnp.Gen.ById.Xa184c7885cdaf2a1.set_JoinResult'cap raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize JoinResult)
+instance (Classes.Cerialize (V.Vector JoinResult)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector JoinResult))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector JoinResult)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector JoinResult))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinResult)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinResult))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector JoinResult)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Decerialize Capnp.Gen.ById.Xa184c7885cdaf2a1.Side) where
+ type Cerial msg Capnp.Gen.ById.Xa184c7885cdaf2a1.Side = Capnp.Gen.ById.Xa184c7885cdaf2a1.Side
+ decerialize = Std_.pure
+instance (Classes.Cerialize Capnp.Gen.ById.Xa184c7885cdaf2a1.Side) where
+ cerialize _ = Std_.pure
+instance (Classes.Cerialize (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side)) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side)))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side)))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa184c7885cdaf2a1.Side))))))) where
+ cerialize = Classes.cerializeBasicVec
diff --git a/gen/lib/Capnp/Gen/Capnp/Schema.hs b/gen/lib/Capnp/Gen/Capnp/Schema.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Schema.hs
@@ -0,0 +1,2475 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Schema where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+newtype Node msg
+ = Node'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node) where
+ tMsg f (Node'newtype_ s) = (Node'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node msg)) where
+ fromStruct struct = (Std_.pure (Node'newtype_ struct))
+instance (Classes.ToStruct msg (Node msg)) where
+ toStruct (Node'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node msg)) where
+ type InMessage (Node msg) = msg
+ message (Node'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node msg)) where
+ messageDefault msg = (Node'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Node msg)) where
+ fromPtr msg ptr = (Node'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Node (Message.MutMsg s))) where
+ toPtr msg (Node'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Node (Message.MutMsg s))) where
+ new msg = (Node'newtype_ <$> (Untyped.allocStruct msg 5 6))
+instance (Basics.ListElem msg (Node msg)) where
+ newtype List msg (Node msg)
+ = Node'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Node'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Node'List_ l) = (Untyped.ListStruct l)
+ length (Node'List_ l) = (Untyped.length l)
+ index i (Node'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Node (Message.MutMsg s))) where
+ setIndex (Node'newtype_ elt) i (Node'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Node'List_ <$> (Untyped.allocCompositeList msg 5 6 len))
+get_Node'id :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64)
+get_Node'id (Node'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Node'id :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Node'id (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Node'displayName :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.Text msg))
+get_Node'displayName (Node'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'displayName :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Node'displayName (Node'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Node'displayName :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
+has_Node'displayName (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Node'displayName :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Node'displayName len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Node'displayName struct result)
+ (Std_.pure result)
+ )
+get_Node'displayNamePrefixLength :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word32)
+get_Node'displayNamePrefixLength (Node'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Node'displayNamePrefixLength :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Node'displayNamePrefixLength (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+get_Node'scopeId :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Word64)
+get_Node'scopeId (Node'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Node'scopeId :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Node'scopeId (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+get_Node'nestedNodes :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Node'NestedNode msg)))
+get_Node'nestedNodes (Node'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'nestedNodes :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))) -> (m ())
+set_Node'nestedNodes (Node'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Node'nestedNodes :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
+has_Node'nestedNodes (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Node'nestedNodes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'NestedNode (Message.MutMsg s))))
+new_Node'nestedNodes len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'nestedNodes struct result)
+ (Std_.pure result)
+ )
+get_Node'annotations :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Annotation msg)))
+get_Node'annotations (Node'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'annotations :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
+set_Node'annotations (Node'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_Node'annotations :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
+has_Node'annotations (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_Node'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
+new_Node'annotations len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'annotations struct result)
+ (Std_.pure result)
+ )
+get_Node'parameters :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Basics.List msg (Node'Parameter msg)))
+get_Node'parameters (Node'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 5 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'parameters :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ())
+set_Node'parameters (Node'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 5 struct)
+ )
+has_Node'parameters :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
+has_Node'parameters (Node'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 5 struct))
+new_Node'parameters :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))
+new_Node'parameters len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'parameters struct result)
+ (Std_.pure result)
+ )
+get_Node'isGeneric :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m Std_.Bool)
+get_Node'isGeneric (Node'newtype_ struct) = (GenHelpers.getWordField struct 4 32 0)
+set_Node'isGeneric :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'isGeneric (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 4 32 0)
+data Node' msg
+ = Node'file
+ | Node'struct (Node'struct msg)
+ | Node'enum (Node'enum msg)
+ | Node'interface (Node'interface msg)
+ | Node'const (Node'const msg)
+ | Node'annotation (Node'annotation msg)
+ | Node'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Node' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 6)
+ case tag of
+ 0 ->
+ (Std_.pure Node'file)
+ 1 ->
+ (Node'struct <$> (Classes.fromStruct struct))
+ 2 ->
+ (Node'enum <$> (Classes.fromStruct struct))
+ 3 ->
+ (Node'interface <$> (Classes.fromStruct struct))
+ 4 ->
+ (Node'const <$> (Classes.fromStruct struct))
+ 5 ->
+ (Node'annotation <$> (Classes.fromStruct struct))
+ _ ->
+ (Std_.pure (Node'unknown' (Std_.fromIntegral tag)))
+ )
+get_Node' :: ((Untyped.ReadCtx m msg)) => (Node msg) -> (m (Node' msg))
+get_Node' (Node'newtype_ struct) = (Classes.fromStruct struct)
+set_Node'file :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m ())
+set_Node'file (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 32 0)
+ (Std_.pure ())
+ )
+set_Node'struct :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'struct (Message.MutMsg s)))
+set_Node'struct (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 32 0)
+ (Classes.fromStruct struct)
+ )
+set_Node'enum :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'enum (Message.MutMsg s)))
+set_Node'enum (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 1 32 0)
+ (Classes.fromStruct struct)
+ )
+set_Node'interface :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'interface (Message.MutMsg s)))
+set_Node'interface (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 1 32 0)
+ (Classes.fromStruct struct)
+ )
+set_Node'const :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'const (Message.MutMsg s)))
+set_Node'const (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 1 32 0)
+ (Classes.fromStruct struct)
+ )
+set_Node'annotation :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> (m (Node'annotation (Message.MutMsg s)))
+set_Node'annotation (Node'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 1 32 0)
+ (Classes.fromStruct struct)
+ )
+set_Node'unknown' :: ((Untyped.RWCtx m s)) => (Node (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Node'unknown' (Node'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 32 0)
+newtype Node'struct msg
+ = Node'struct'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'struct) where
+ tMsg f (Node'struct'newtype_ s) = (Node'struct'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'struct msg)) where
+ fromStruct struct = (Std_.pure (Node'struct'newtype_ struct))
+instance (Classes.ToStruct msg (Node'struct msg)) where
+ toStruct (Node'struct'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'struct msg)) where
+ type InMessage (Node'struct msg) = msg
+ message (Node'struct'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'struct msg)) where
+ messageDefault msg = (Node'struct'newtype_ (Untyped.messageDefault msg))
+get_Node'struct'dataWordCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
+get_Node'struct'dataWordCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 1 48 0)
+set_Node'struct'dataWordCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Node'struct'dataWordCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 48 0)
+get_Node'struct'pointerCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
+get_Node'struct'pointerCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 0 0)
+set_Node'struct'pointerCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Node'struct'pointerCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 0 0)
+get_Node'struct'preferredListEncoding :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m ElementSize)
+get_Node'struct'preferredListEncoding (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 16 0)
+set_Node'struct'preferredListEncoding :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> ElementSize -> (m ())
+set_Node'struct'preferredListEncoding (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 16 0)
+get_Node'struct'isGroup :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool)
+get_Node'struct'isGroup (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 32 0)
+set_Node'struct'isGroup :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'struct'isGroup (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 3 32 0)
+get_Node'struct'discriminantCount :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word16)
+get_Node'struct'discriminantCount (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 3 48 0)
+set_Node'struct'discriminantCount :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Node'struct'discriminantCount (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 3 48 0)
+get_Node'struct'discriminantOffset :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Word32)
+get_Node'struct'discriminantOffset (Node'struct'newtype_ struct) = (GenHelpers.getWordField struct 4 0 0)
+set_Node'struct'discriminantOffset :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Node'struct'discriminantOffset (Node'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 4 0 0)
+get_Node'struct'fields :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m (Basics.List msg (Field msg)))
+get_Node'struct'fields (Node'struct'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'struct'fields :: ((Untyped.RWCtx m s)) => (Node'struct (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))) -> (m ())
+set_Node'struct'fields (Node'struct'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Node'struct'fields :: ((Untyped.ReadCtx m msg)) => (Node'struct msg) -> (m Std_.Bool)
+has_Node'struct'fields (Node'struct'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Node'struct'fields :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'struct (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Field (Message.MutMsg s))))
+new_Node'struct'fields len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'struct'fields struct result)
+ (Std_.pure result)
+ )
+newtype Node'enum msg
+ = Node'enum'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'enum) where
+ tMsg f (Node'enum'newtype_ s) = (Node'enum'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'enum msg)) where
+ fromStruct struct = (Std_.pure (Node'enum'newtype_ struct))
+instance (Classes.ToStruct msg (Node'enum msg)) where
+ toStruct (Node'enum'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'enum msg)) where
+ type InMessage (Node'enum msg) = msg
+ message (Node'enum'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'enum msg)) where
+ messageDefault msg = (Node'enum'newtype_ (Untyped.messageDefault msg))
+get_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)) => (Node'enum msg) -> (m (Basics.List msg (Enumerant msg)))
+get_Node'enum'enumerants (Node'enum'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'enum'enumerants :: ((Untyped.RWCtx m s)) => (Node'enum (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))) -> (m ())
+set_Node'enum'enumerants (Node'enum'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Node'enum'enumerants :: ((Untyped.ReadCtx m msg)) => (Node'enum msg) -> (m Std_.Bool)
+has_Node'enum'enumerants (Node'enum'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Node'enum'enumerants :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'enum (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Enumerant (Message.MutMsg s))))
+new_Node'enum'enumerants len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'enum'enumerants struct result)
+ (Std_.pure result)
+ )
+newtype Node'interface msg
+ = Node'interface'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'interface) where
+ tMsg f (Node'interface'newtype_ s) = (Node'interface'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'interface msg)) where
+ fromStruct struct = (Std_.pure (Node'interface'newtype_ struct))
+instance (Classes.ToStruct msg (Node'interface msg)) where
+ toStruct (Node'interface'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'interface msg)) where
+ type InMessage (Node'interface msg) = msg
+ message (Node'interface'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'interface msg)) where
+ messageDefault msg = (Node'interface'newtype_ (Untyped.messageDefault msg))
+get_Node'interface'methods :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m (Basics.List msg (Method msg)))
+get_Node'interface'methods (Node'interface'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'interface'methods :: ((Untyped.RWCtx m s)) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))) -> (m ())
+set_Node'interface'methods (Node'interface'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Node'interface'methods :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool)
+has_Node'interface'methods (Node'interface'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Node'interface'methods :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'interface (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Method (Message.MutMsg s))))
+new_Node'interface'methods len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'interface'methods struct result)
+ (Std_.pure result)
+ )
+get_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m (Basics.List msg (Superclass msg)))
+get_Node'interface'superclasses (Node'interface'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 4 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'interface'superclasses :: ((Untyped.RWCtx m s)) => (Node'interface (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))) -> (m ())
+set_Node'interface'superclasses (Node'interface'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 4 struct)
+ )
+has_Node'interface'superclasses :: ((Untyped.ReadCtx m msg)) => (Node'interface msg) -> (m Std_.Bool)
+has_Node'interface'superclasses (Node'interface'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 struct))
+new_Node'interface'superclasses :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'interface (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Superclass (Message.MutMsg s))))
+new_Node'interface'superclasses len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'interface'superclasses struct result)
+ (Std_.pure result)
+ )
+newtype Node'const msg
+ = Node'const'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'const) where
+ tMsg f (Node'const'newtype_ s) = (Node'const'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'const msg)) where
+ fromStruct struct = (Std_.pure (Node'const'newtype_ struct))
+instance (Classes.ToStruct msg (Node'const msg)) where
+ toStruct (Node'const'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'const msg)) where
+ type InMessage (Node'const msg) = msg
+ message (Node'const'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'const msg)) where
+ messageDefault msg = (Node'const'newtype_ (Untyped.messageDefault msg))
+get_Node'const'type_ :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m (Type msg))
+get_Node'const'type_ (Node'const'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'const'type_ :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
+set_Node'const'type_ (Node'const'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Node'const'type_ :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool)
+has_Node'const'type_ (Node'const'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Node'const'type_ :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
+new_Node'const'type_ struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Node'const'type_ struct result)
+ (Std_.pure result)
+ )
+get_Node'const'value :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m (Value msg))
+get_Node'const'value (Node'const'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 4 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'const'value :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Node'const'value (Node'const'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 4 struct)
+ )
+has_Node'const'value :: ((Untyped.ReadCtx m msg)) => (Node'const msg) -> (m Std_.Bool)
+has_Node'const'value (Node'const'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 struct))
+new_Node'const'value :: ((Untyped.RWCtx m s)) => (Node'const (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
+new_Node'const'value struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Node'const'value struct result)
+ (Std_.pure result)
+ )
+newtype Node'annotation msg
+ = Node'annotation'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'annotation) where
+ tMsg f (Node'annotation'newtype_ s) = (Node'annotation'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'annotation msg)) where
+ fromStruct struct = (Std_.pure (Node'annotation'newtype_ struct))
+instance (Classes.ToStruct msg (Node'annotation msg)) where
+ toStruct (Node'annotation'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'annotation msg)) where
+ type InMessage (Node'annotation msg) = msg
+ message (Node'annotation'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'annotation msg)) where
+ messageDefault msg = (Node'annotation'newtype_ (Untyped.messageDefault msg))
+get_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m (Type msg))
+get_Node'annotation'type_ (Node'annotation'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'annotation'type_ :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
+set_Node'annotation'type_ (Node'annotation'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Node'annotation'type_ :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+has_Node'annotation'type_ (Node'annotation'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Node'annotation'type_ :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
+new_Node'annotation'type_ struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Node'annotation'type_ struct result)
+ (Std_.pure result)
+ )
+get_Node'annotation'targetsFile :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsFile (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 48 0)
+set_Node'annotation'targetsFile :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsFile (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 48 0)
+get_Node'annotation'targetsConst :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsConst (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 49 0)
+set_Node'annotation'targetsConst :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsConst (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 49 0)
+get_Node'annotation'targetsEnum :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsEnum (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 50 0)
+set_Node'annotation'targetsEnum :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsEnum (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 50 0)
+get_Node'annotation'targetsEnumerant :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsEnumerant (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 51 0)
+set_Node'annotation'targetsEnumerant :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsEnumerant (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 51 0)
+get_Node'annotation'targetsStruct :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsStruct (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 52 0)
+set_Node'annotation'targetsStruct :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsStruct (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 52 0)
+get_Node'annotation'targetsField :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsField (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 53 0)
+set_Node'annotation'targetsField :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsField (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 53 0)
+get_Node'annotation'targetsUnion :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsUnion (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 54 0)
+set_Node'annotation'targetsUnion :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsUnion (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 54 0)
+get_Node'annotation'targetsGroup :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsGroup (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 55 0)
+set_Node'annotation'targetsGroup :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsGroup (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 55 0)
+get_Node'annotation'targetsInterface :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsInterface (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 56 0)
+set_Node'annotation'targetsInterface :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsInterface (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 56 0)
+get_Node'annotation'targetsMethod :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsMethod (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 57 0)
+set_Node'annotation'targetsMethod :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsMethod (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 57 0)
+get_Node'annotation'targetsParam :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsParam (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 58 0)
+set_Node'annotation'targetsParam :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsParam (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 58 0)
+get_Node'annotation'targetsAnnotation :: ((Untyped.ReadCtx m msg)) => (Node'annotation msg) -> (m Std_.Bool)
+get_Node'annotation'targetsAnnotation (Node'annotation'newtype_ struct) = (GenHelpers.getWordField struct 1 59 0)
+set_Node'annotation'targetsAnnotation :: ((Untyped.RWCtx m s)) => (Node'annotation (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Node'annotation'targetsAnnotation (Node'annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 59 0)
+newtype Node'Parameter msg
+ = Node'Parameter'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'Parameter) where
+ tMsg f (Node'Parameter'newtype_ s) = (Node'Parameter'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'Parameter msg)) where
+ fromStruct struct = (Std_.pure (Node'Parameter'newtype_ struct))
+instance (Classes.ToStruct msg (Node'Parameter msg)) where
+ toStruct (Node'Parameter'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'Parameter msg)) where
+ type InMessage (Node'Parameter msg) = msg
+ message (Node'Parameter'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'Parameter msg)) where
+ messageDefault msg = (Node'Parameter'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Node'Parameter msg)) where
+ fromPtr msg ptr = (Node'Parameter'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Node'Parameter (Message.MutMsg s))) where
+ toPtr msg (Node'Parameter'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Node'Parameter (Message.MutMsg s))) where
+ new msg = (Node'Parameter'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Node'Parameter msg)) where
+ newtype List msg (Node'Parameter msg)
+ = Node'Parameter'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Node'Parameter'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Node'Parameter'List_ l) = (Untyped.ListStruct l)
+ length (Node'Parameter'List_ l) = (Untyped.length l)
+ index i (Node'Parameter'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Node'Parameter (Message.MutMsg s))) where
+ setIndex (Node'Parameter'newtype_ elt) i (Node'Parameter'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Node'Parameter'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Node'Parameter'name :: ((Untyped.ReadCtx m msg)) => (Node'Parameter msg) -> (m (Basics.Text msg))
+get_Node'Parameter'name (Node'Parameter'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'Parameter'name :: ((Untyped.RWCtx m s)) => (Node'Parameter (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Node'Parameter'name (Node'Parameter'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Node'Parameter'name :: ((Untyped.ReadCtx m msg)) => (Node'Parameter msg) -> (m Std_.Bool)
+has_Node'Parameter'name (Node'Parameter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Node'Parameter'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'Parameter (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Node'Parameter'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Node'Parameter'name struct result)
+ (Std_.pure result)
+ )
+newtype Node'NestedNode msg
+ = Node'NestedNode'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'NestedNode) where
+ tMsg f (Node'NestedNode'newtype_ s) = (Node'NestedNode'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'NestedNode msg)) where
+ fromStruct struct = (Std_.pure (Node'NestedNode'newtype_ struct))
+instance (Classes.ToStruct msg (Node'NestedNode msg)) where
+ toStruct (Node'NestedNode'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'NestedNode msg)) where
+ type InMessage (Node'NestedNode msg) = msg
+ message (Node'NestedNode'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'NestedNode msg)) where
+ messageDefault msg = (Node'NestedNode'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Node'NestedNode msg)) where
+ fromPtr msg ptr = (Node'NestedNode'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Node'NestedNode (Message.MutMsg s))) where
+ toPtr msg (Node'NestedNode'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Node'NestedNode (Message.MutMsg s))) where
+ new msg = (Node'NestedNode'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Node'NestedNode msg)) where
+ newtype List msg (Node'NestedNode msg)
+ = Node'NestedNode'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Node'NestedNode'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Node'NestedNode'List_ l) = (Untyped.ListStruct l)
+ length (Node'NestedNode'List_ l) = (Untyped.length l)
+ index i (Node'NestedNode'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Node'NestedNode (Message.MutMsg s))) where
+ setIndex (Node'NestedNode'newtype_ elt) i (Node'NestedNode'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Node'NestedNode'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m (Basics.Text msg))
+get_Node'NestedNode'name (Node'NestedNode'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'NestedNode'name :: ((Untyped.RWCtx m s)) => (Node'NestedNode (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Node'NestedNode'name (Node'NestedNode'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Node'NestedNode'name :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Bool)
+has_Node'NestedNode'name (Node'NestedNode'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Node'NestedNode'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'NestedNode (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Node'NestedNode'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Node'NestedNode'name struct result)
+ (Std_.pure result)
+ )
+get_Node'NestedNode'id :: ((Untyped.ReadCtx m msg)) => (Node'NestedNode msg) -> (m Std_.Word64)
+get_Node'NestedNode'id (Node'NestedNode'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Node'NestedNode'id :: ((Untyped.RWCtx m s)) => (Node'NestedNode (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Node'NestedNode'id (Node'NestedNode'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+newtype Node'SourceInfo msg
+ = Node'SourceInfo'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'SourceInfo) where
+ tMsg f (Node'SourceInfo'newtype_ s) = (Node'SourceInfo'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'SourceInfo msg)) where
+ fromStruct struct = (Std_.pure (Node'SourceInfo'newtype_ struct))
+instance (Classes.ToStruct msg (Node'SourceInfo msg)) where
+ toStruct (Node'SourceInfo'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'SourceInfo msg)) where
+ type InMessage (Node'SourceInfo msg) = msg
+ message (Node'SourceInfo'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'SourceInfo msg)) where
+ messageDefault msg = (Node'SourceInfo'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Node'SourceInfo msg)) where
+ fromPtr msg ptr = (Node'SourceInfo'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Node'SourceInfo (Message.MutMsg s))) where
+ toPtr msg (Node'SourceInfo'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Node'SourceInfo (Message.MutMsg s))) where
+ new msg = (Node'SourceInfo'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Node'SourceInfo msg)) where
+ newtype List msg (Node'SourceInfo msg)
+ = Node'SourceInfo'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Node'SourceInfo'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Node'SourceInfo'List_ l) = (Untyped.ListStruct l)
+ length (Node'SourceInfo'List_ l) = (Untyped.length l)
+ index i (Node'SourceInfo'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Node'SourceInfo (Message.MutMsg s))) where
+ setIndex (Node'SourceInfo'newtype_ elt) i (Node'SourceInfo'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Node'SourceInfo'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Node'SourceInfo'id :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Word64)
+get_Node'SourceInfo'id (Node'SourceInfo'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Node'SourceInfo'id :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Node'SourceInfo'id (Node'SourceInfo'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m (Basics.Text msg))
+get_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'SourceInfo'docComment :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Node'SourceInfo'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool)
+has_Node'SourceInfo'docComment (Node'SourceInfo'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Node'SourceInfo'docComment :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Node'SourceInfo'docComment len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Node'SourceInfo'docComment struct result)
+ (Std_.pure result)
+ )
+get_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m (Basics.List msg (Node'SourceInfo'Member msg)))
+get_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'SourceInfo'members :: ((Untyped.RWCtx m s)) => (Node'SourceInfo (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))) -> (m ())
+set_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Node'SourceInfo'members :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo msg) -> (m Std_.Bool)
+has_Node'SourceInfo'members (Node'SourceInfo'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Node'SourceInfo'members :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'SourceInfo'Member (Message.MutMsg s))))
+new_Node'SourceInfo'members len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Node'SourceInfo'members struct result)
+ (Std_.pure result)
+ )
+newtype Node'SourceInfo'Member msg
+ = Node'SourceInfo'Member'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Node'SourceInfo'Member) where
+ tMsg f (Node'SourceInfo'Member'newtype_ s) = (Node'SourceInfo'Member'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Node'SourceInfo'Member msg)) where
+ fromStruct struct = (Std_.pure (Node'SourceInfo'Member'newtype_ struct))
+instance (Classes.ToStruct msg (Node'SourceInfo'Member msg)) where
+ toStruct (Node'SourceInfo'Member'newtype_ struct) = struct
+instance (Untyped.HasMessage (Node'SourceInfo'Member msg)) where
+ type InMessage (Node'SourceInfo'Member msg) = msg
+ message (Node'SourceInfo'Member'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Node'SourceInfo'Member msg)) where
+ messageDefault msg = (Node'SourceInfo'Member'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Node'SourceInfo'Member msg)) where
+ fromPtr msg ptr = (Node'SourceInfo'Member'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Node'SourceInfo'Member (Message.MutMsg s))) where
+ toPtr msg (Node'SourceInfo'Member'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Node'SourceInfo'Member (Message.MutMsg s))) where
+ new msg = (Node'SourceInfo'Member'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Node'SourceInfo'Member msg)) where
+ newtype List msg (Node'SourceInfo'Member msg)
+ = Node'SourceInfo'Member'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Node'SourceInfo'Member'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Node'SourceInfo'Member'List_ l) = (Untyped.ListStruct l)
+ length (Node'SourceInfo'Member'List_ l) = (Untyped.length l)
+ index i (Node'SourceInfo'Member'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Node'SourceInfo'Member (Message.MutMsg s))) where
+ setIndex (Node'SourceInfo'Member'newtype_ elt) i (Node'SourceInfo'Member'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Node'SourceInfo'Member'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Node'SourceInfo'Member'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo'Member msg) -> (m (Basics.Text msg))
+get_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Node'SourceInfo'Member'docComment :: ((Untyped.RWCtx m s)) => (Node'SourceInfo'Member (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Node'SourceInfo'Member'docComment :: ((Untyped.ReadCtx m msg)) => (Node'SourceInfo'Member msg) -> (m Std_.Bool)
+has_Node'SourceInfo'Member'docComment (Node'SourceInfo'Member'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Node'SourceInfo'Member'docComment :: ((Untyped.RWCtx m s)) => Std_.Int -> (Node'SourceInfo'Member (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Node'SourceInfo'Member'docComment len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Node'SourceInfo'Member'docComment struct result)
+ (Std_.pure result)
+ )
+newtype Field msg
+ = Field'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Field) where
+ tMsg f (Field'newtype_ s) = (Field'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Field msg)) where
+ fromStruct struct = (Std_.pure (Field'newtype_ struct))
+instance (Classes.ToStruct msg (Field msg)) where
+ toStruct (Field'newtype_ struct) = struct
+instance (Untyped.HasMessage (Field msg)) where
+ type InMessage (Field msg) = msg
+ message (Field'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Field msg)) where
+ messageDefault msg = (Field'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Field msg)) where
+ fromPtr msg ptr = (Field'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Field (Message.MutMsg s))) where
+ toPtr msg (Field'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Field (Message.MutMsg s))) where
+ new msg = (Field'newtype_ <$> (Untyped.allocStruct msg 3 4))
+instance (Basics.ListElem msg (Field msg)) where
+ newtype List msg (Field msg)
+ = Field'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Field'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Field'List_ l) = (Untyped.ListStruct l)
+ length (Field'List_ l) = (Untyped.length l)
+ index i (Field'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Field (Message.MutMsg s))) where
+ setIndex (Field'newtype_ elt) i (Field'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Field'List_ <$> (Untyped.allocCompositeList msg 3 4 len))
+get_Field'name :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Basics.Text msg))
+get_Field'name (Field'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Field'name :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Field'name (Field'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Field'name :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool)
+has_Field'name (Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Field'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Field (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Field'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Field'name struct result)
+ (Std_.pure result)
+ )
+get_Field'codeOrder :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16)
+get_Field'codeOrder (Field'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Field'codeOrder :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Field'codeOrder (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_Field'annotations :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Basics.List msg (Annotation msg)))
+get_Field'annotations (Field'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Field'annotations :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
+set_Field'annotations (Field'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Field'annotations :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Bool)
+has_Field'annotations (Field'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Field'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Field (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
+new_Field'annotations len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Field'annotations struct result)
+ (Std_.pure result)
+ )
+get_Field'discriminantValue :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m Std_.Word16)
+get_Field'discriminantValue (Field'newtype_ struct) = (GenHelpers.getWordField struct 0 16 65535)
+set_Field'discriminantValue :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Field'discriminantValue (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 65535)
+get_Field'ordinal :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Field'ordinal msg))
+get_Field'ordinal (Field'newtype_ struct) = (Classes.fromStruct struct)
+data Field' msg
+ = Field'slot (Field'slot msg)
+ | Field'group (Field'group msg)
+ | Field'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Field' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 4)
+ case tag of
+ 0 ->
+ (Field'slot <$> (Classes.fromStruct struct))
+ 1 ->
+ (Field'group <$> (Classes.fromStruct struct))
+ _ ->
+ (Std_.pure (Field'unknown' (Std_.fromIntegral tag)))
+ )
+get_Field' :: ((Untyped.ReadCtx m msg)) => (Field msg) -> (m (Field' msg))
+get_Field' (Field'newtype_ struct) = (Classes.fromStruct struct)
+set_Field'slot :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (m (Field'slot (Message.MutMsg s)))
+set_Field'slot (Field'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Field'group :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> (m (Field'group (Message.MutMsg s)))
+set_Field'group (Field'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Field'unknown' :: ((Untyped.RWCtx m s)) => (Field (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Field'unknown' (Field'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+newtype Field'slot msg
+ = Field'slot'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Field'slot) where
+ tMsg f (Field'slot'newtype_ s) = (Field'slot'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Field'slot msg)) where
+ fromStruct struct = (Std_.pure (Field'slot'newtype_ struct))
+instance (Classes.ToStruct msg (Field'slot msg)) where
+ toStruct (Field'slot'newtype_ struct) = struct
+instance (Untyped.HasMessage (Field'slot msg)) where
+ type InMessage (Field'slot msg) = msg
+ message (Field'slot'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Field'slot msg)) where
+ messageDefault msg = (Field'slot'newtype_ (Untyped.messageDefault msg))
+get_Field'slot'offset :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Word32)
+get_Field'slot'offset (Field'slot'newtype_ struct) = (GenHelpers.getWordField struct 0 32 0)
+set_Field'slot'offset :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Field'slot'offset (Field'slot'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+get_Field'slot'type_ :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m (Type msg))
+get_Field'slot'type_ (Field'slot'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Field'slot'type_ :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
+set_Field'slot'type_ (Field'slot'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_Field'slot'type_ :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
+has_Field'slot'type_ (Field'slot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_Field'slot'type_ :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
+new_Field'slot'type_ struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Field'slot'type_ struct result)
+ (Std_.pure result)
+ )
+get_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m (Value msg))
+get_Field'slot'defaultValue (Field'slot'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Field'slot'defaultValue :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Field'slot'defaultValue (Field'slot'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Field'slot'defaultValue :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
+has_Field'slot'defaultValue (Field'slot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Field'slot'defaultValue :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
+new_Field'slot'defaultValue struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Field'slot'defaultValue struct result)
+ (Std_.pure result)
+ )
+get_Field'slot'hadExplicitDefault :: ((Untyped.ReadCtx m msg)) => (Field'slot msg) -> (m Std_.Bool)
+get_Field'slot'hadExplicitDefault (Field'slot'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Field'slot'hadExplicitDefault :: ((Untyped.RWCtx m s)) => (Field'slot (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Field'slot'hadExplicitDefault (Field'slot'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 2 0 0)
+newtype Field'group msg
+ = Field'group'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Field'group) where
+ tMsg f (Field'group'newtype_ s) = (Field'group'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Field'group msg)) where
+ fromStruct struct = (Std_.pure (Field'group'newtype_ struct))
+instance (Classes.ToStruct msg (Field'group msg)) where
+ toStruct (Field'group'newtype_ struct) = struct
+instance (Untyped.HasMessage (Field'group msg)) where
+ type InMessage (Field'group msg) = msg
+ message (Field'group'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Field'group msg)) where
+ messageDefault msg = (Field'group'newtype_ (Untyped.messageDefault msg))
+get_Field'group'typeId :: ((Untyped.ReadCtx m msg)) => (Field'group msg) -> (m Std_.Word64)
+get_Field'group'typeId (Field'group'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Field'group'typeId :: ((Untyped.RWCtx m s)) => (Field'group (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Field'group'typeId (Field'group'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+newtype Field'ordinal msg
+ = Field'ordinal'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Field'ordinal) where
+ tMsg f (Field'ordinal'newtype_ s) = (Field'ordinal'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Field'ordinal msg)) where
+ fromStruct struct = (Std_.pure (Field'ordinal'newtype_ struct))
+instance (Classes.ToStruct msg (Field'ordinal msg)) where
+ toStruct (Field'ordinal'newtype_ struct) = struct
+instance (Untyped.HasMessage (Field'ordinal msg)) where
+ type InMessage (Field'ordinal msg) = msg
+ message (Field'ordinal'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Field'ordinal msg)) where
+ messageDefault msg = (Field'ordinal'newtype_ (Untyped.messageDefault msg))
+data Field'ordinal' msg
+ = Field'ordinal'implicit
+ | Field'ordinal'explicit Std_.Word16
+ | Field'ordinal'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Field'ordinal' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 5)
+ case tag of
+ 0 ->
+ (Std_.pure Field'ordinal'implicit)
+ 1 ->
+ (Field'ordinal'explicit <$> (GenHelpers.getWordField struct 1 32 0))
+ _ ->
+ (Std_.pure (Field'ordinal'unknown' (Std_.fromIntegral tag)))
+ )
+get_Field'ordinal' :: ((Untyped.ReadCtx m msg)) => (Field'ordinal msg) -> (m (Field'ordinal' msg))
+get_Field'ordinal' (Field'ordinal'newtype_ struct) = (Classes.fromStruct struct)
+set_Field'ordinal'implicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> (m ())
+set_Field'ordinal'implicit (Field'ordinal'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 16 0)
+ (Std_.pure ())
+ )
+set_Field'ordinal'explicit :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Field'ordinal'explicit (Field'ordinal'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 16 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 32 0)
+ )
+set_Field'ordinal'unknown' :: ((Untyped.RWCtx m s)) => (Field'ordinal (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Field'ordinal'unknown' (Field'ordinal'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 16 0)
+field'noDiscriminant :: Std_.Word16
+field'noDiscriminant = (Classes.fromWord 65535)
+newtype Enumerant msg
+ = Enumerant'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Enumerant) where
+ tMsg f (Enumerant'newtype_ s) = (Enumerant'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Enumerant msg)) where
+ fromStruct struct = (Std_.pure (Enumerant'newtype_ struct))
+instance (Classes.ToStruct msg (Enumerant msg)) where
+ toStruct (Enumerant'newtype_ struct) = struct
+instance (Untyped.HasMessage (Enumerant msg)) where
+ type InMessage (Enumerant msg) = msg
+ message (Enumerant'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Enumerant msg)) where
+ messageDefault msg = (Enumerant'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Enumerant msg)) where
+ fromPtr msg ptr = (Enumerant'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Enumerant (Message.MutMsg s))) where
+ toPtr msg (Enumerant'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Enumerant (Message.MutMsg s))) where
+ new msg = (Enumerant'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Enumerant msg)) where
+ newtype List msg (Enumerant msg)
+ = Enumerant'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Enumerant'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Enumerant'List_ l) = (Untyped.ListStruct l)
+ length (Enumerant'List_ l) = (Untyped.length l)
+ index i (Enumerant'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Enumerant (Message.MutMsg s))) where
+ setIndex (Enumerant'newtype_ elt) i (Enumerant'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Enumerant'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Enumerant'name :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m (Basics.Text msg))
+get_Enumerant'name (Enumerant'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Enumerant'name :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Enumerant'name (Enumerant'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Enumerant'name :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool)
+has_Enumerant'name (Enumerant'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Enumerant'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Enumerant (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Enumerant'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Enumerant'name struct result)
+ (Std_.pure result)
+ )
+get_Enumerant'codeOrder :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Word16)
+get_Enumerant'codeOrder (Enumerant'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Enumerant'codeOrder :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Enumerant'codeOrder (Enumerant'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_Enumerant'annotations :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m (Basics.List msg (Annotation msg)))
+get_Enumerant'annotations (Enumerant'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Enumerant'annotations :: ((Untyped.RWCtx m s)) => (Enumerant (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
+set_Enumerant'annotations (Enumerant'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Enumerant'annotations :: ((Untyped.ReadCtx m msg)) => (Enumerant msg) -> (m Std_.Bool)
+has_Enumerant'annotations (Enumerant'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Enumerant'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Enumerant (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
+new_Enumerant'annotations len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Enumerant'annotations struct result)
+ (Std_.pure result)
+ )
+newtype Superclass msg
+ = Superclass'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Superclass) where
+ tMsg f (Superclass'newtype_ s) = (Superclass'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Superclass msg)) where
+ fromStruct struct = (Std_.pure (Superclass'newtype_ struct))
+instance (Classes.ToStruct msg (Superclass msg)) where
+ toStruct (Superclass'newtype_ struct) = struct
+instance (Untyped.HasMessage (Superclass msg)) where
+ type InMessage (Superclass msg) = msg
+ message (Superclass'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Superclass msg)) where
+ messageDefault msg = (Superclass'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Superclass msg)) where
+ fromPtr msg ptr = (Superclass'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Superclass (Message.MutMsg s))) where
+ toPtr msg (Superclass'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Superclass (Message.MutMsg s))) where
+ new msg = (Superclass'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Superclass msg)) where
+ newtype List msg (Superclass msg)
+ = Superclass'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Superclass'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Superclass'List_ l) = (Untyped.ListStruct l)
+ length (Superclass'List_ l) = (Untyped.length l)
+ index i (Superclass'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Superclass (Message.MutMsg s))) where
+ setIndex (Superclass'newtype_ elt) i (Superclass'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Superclass'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_Superclass'id :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Word64)
+get_Superclass'id (Superclass'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Superclass'id :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Superclass'id (Superclass'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Superclass'brand :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m (Brand msg))
+get_Superclass'brand (Superclass'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Superclass'brand :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Superclass'brand (Superclass'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Superclass'brand :: ((Untyped.ReadCtx m msg)) => (Superclass msg) -> (m Std_.Bool)
+has_Superclass'brand (Superclass'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Superclass'brand :: ((Untyped.RWCtx m s)) => (Superclass (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Superclass'brand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Superclass'brand struct result)
+ (Std_.pure result)
+ )
+newtype Method msg
+ = Method'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Method) where
+ tMsg f (Method'newtype_ s) = (Method'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Method msg)) where
+ fromStruct struct = (Std_.pure (Method'newtype_ struct))
+instance (Classes.ToStruct msg (Method msg)) where
+ toStruct (Method'newtype_ struct) = struct
+instance (Untyped.HasMessage (Method msg)) where
+ type InMessage (Method msg) = msg
+ message (Method'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Method msg)) where
+ messageDefault msg = (Method'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Method msg)) where
+ fromPtr msg ptr = (Method'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Method (Message.MutMsg s))) where
+ toPtr msg (Method'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Method (Message.MutMsg s))) where
+ new msg = (Method'newtype_ <$> (Untyped.allocStruct msg 3 5))
+instance (Basics.ListElem msg (Method msg)) where
+ newtype List msg (Method msg)
+ = Method'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Method'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Method'List_ l) = (Untyped.ListStruct l)
+ length (Method'List_ l) = (Untyped.length l)
+ index i (Method'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Method (Message.MutMsg s))) where
+ setIndex (Method'newtype_ elt) i (Method'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Method'List_ <$> (Untyped.allocCompositeList msg 3 5 len))
+get_Method'name :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.Text msg))
+get_Method'name (Method'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Method'name :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Method'name (Method'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Method'name :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
+has_Method'name (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Method'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Method'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Method'name struct result)
+ (Std_.pure result)
+ )
+get_Method'codeOrder :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word16)
+get_Method'codeOrder (Method'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Method'codeOrder :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Method'codeOrder (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_Method'paramStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64)
+get_Method'paramStructType (Method'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Method'paramStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Method'paramStructType (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Method'resultStructType :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Word64)
+get_Method'resultStructType (Method'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Method'resultStructType :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Method'resultStructType (Method'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+get_Method'annotations :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.List msg (Annotation msg)))
+get_Method'annotations (Method'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Method'annotations :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))) -> (m ())
+set_Method'annotations (Method'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Method'annotations :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
+has_Method'annotations (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Method'annotations :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Annotation (Message.MutMsg s))))
+new_Method'annotations len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Method'annotations struct result)
+ (Std_.pure result)
+ )
+get_Method'paramBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Brand msg))
+get_Method'paramBrand (Method'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Method'paramBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Method'paramBrand (Method'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_Method'paramBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
+has_Method'paramBrand (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_Method'paramBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Method'paramBrand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Method'paramBrand struct result)
+ (Std_.pure result)
+ )
+get_Method'resultBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Brand msg))
+get_Method'resultBrand (Method'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Method'resultBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Method'resultBrand (Method'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_Method'resultBrand :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
+has_Method'resultBrand (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_Method'resultBrand :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Method'resultBrand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Method'resultBrand struct result)
+ (Std_.pure result)
+ )
+get_Method'implicitParameters :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m (Basics.List msg (Node'Parameter msg)))
+get_Method'implicitParameters (Method'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 4 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Method'implicitParameters :: ((Untyped.RWCtx m s)) => (Method (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))) -> (m ())
+set_Method'implicitParameters (Method'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 4 struct)
+ )
+has_Method'implicitParameters :: ((Untyped.ReadCtx m msg)) => (Method msg) -> (m Std_.Bool)
+has_Method'implicitParameters (Method'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 4 struct))
+new_Method'implicitParameters :: ((Untyped.RWCtx m s)) => Std_.Int -> (Method (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'Parameter (Message.MutMsg s))))
+new_Method'implicitParameters len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Method'implicitParameters struct result)
+ (Std_.pure result)
+ )
+newtype Type msg
+ = Type'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type) where
+ tMsg f (Type'newtype_ s) = (Type'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type msg)) where
+ fromStruct struct = (Std_.pure (Type'newtype_ struct))
+instance (Classes.ToStruct msg (Type msg)) where
+ toStruct (Type'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type msg)) where
+ type InMessage (Type msg) = msg
+ message (Type'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type msg)) where
+ messageDefault msg = (Type'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Type msg)) where
+ fromPtr msg ptr = (Type'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Type (Message.MutMsg s))) where
+ toPtr msg (Type'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Type (Message.MutMsg s))) where
+ new msg = (Type'newtype_ <$> (Untyped.allocStruct msg 3 1))
+instance (Basics.ListElem msg (Type msg)) where
+ newtype List msg (Type msg)
+ = Type'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Type'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Type'List_ l) = (Untyped.ListStruct l)
+ length (Type'List_ l) = (Untyped.length l)
+ index i (Type'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Type (Message.MutMsg s))) where
+ setIndex (Type'newtype_ elt) i (Type'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Type'List_ <$> (Untyped.allocCompositeList msg 3 1 len))
+data Type' msg
+ = Type'void
+ | Type'bool
+ | Type'int8
+ | Type'int16
+ | Type'int32
+ | Type'int64
+ | Type'uint8
+ | Type'uint16
+ | Type'uint32
+ | Type'uint64
+ | Type'float32
+ | Type'float64
+ | Type'text
+ | Type'data_
+ | Type'list (Type'list msg)
+ | Type'enum (Type'enum msg)
+ | Type'struct (Type'struct msg)
+ | Type'interface (Type'interface msg)
+ | Type'anyPointer (Type'anyPointer msg)
+ | Type'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Type' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Type'void)
+ 1 ->
+ (Std_.pure Type'bool)
+ 2 ->
+ (Std_.pure Type'int8)
+ 3 ->
+ (Std_.pure Type'int16)
+ 4 ->
+ (Std_.pure Type'int32)
+ 5 ->
+ (Std_.pure Type'int64)
+ 6 ->
+ (Std_.pure Type'uint8)
+ 7 ->
+ (Std_.pure Type'uint16)
+ 8 ->
+ (Std_.pure Type'uint32)
+ 9 ->
+ (Std_.pure Type'uint64)
+ 10 ->
+ (Std_.pure Type'float32)
+ 11 ->
+ (Std_.pure Type'float64)
+ 12 ->
+ (Std_.pure Type'text)
+ 13 ->
+ (Std_.pure Type'data_)
+ 14 ->
+ (Type'list <$> (Classes.fromStruct struct))
+ 15 ->
+ (Type'enum <$> (Classes.fromStruct struct))
+ 16 ->
+ (Type'struct <$> (Classes.fromStruct struct))
+ 17 ->
+ (Type'interface <$> (Classes.fromStruct struct))
+ 18 ->
+ (Type'anyPointer <$> (Classes.fromStruct struct))
+ _ ->
+ (Std_.pure (Type'unknown' (Std_.fromIntegral tag)))
+ )
+get_Type' :: ((Untyped.ReadCtx m msg)) => (Type msg) -> (m (Type' msg))
+get_Type' (Type'newtype_ struct) = (Classes.fromStruct struct)
+set_Type'void :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'void (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'bool :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'bool (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'int8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'int8 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'int16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'int16 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'int32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'int32 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'int64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'int64 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'uint8 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'uint8 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'uint16 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'uint16 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'uint32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'uint32 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'uint64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'uint64 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'float32 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'float32 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'float64 :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'float64 (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'text :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'text (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (12 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'data_ :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m ())
+set_Type'data_ (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (13 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Type'list :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m (Type'list (Message.MutMsg s)))
+set_Type'list (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (14 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'enum :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m (Type'enum (Message.MutMsg s)))
+set_Type'enum (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (15 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'struct :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m (Type'struct (Message.MutMsg s)))
+set_Type'struct (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (16 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'interface :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m (Type'interface (Message.MutMsg s)))
+set_Type'interface (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (17 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'anyPointer :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> (m (Type'anyPointer (Message.MutMsg s)))
+set_Type'anyPointer (Type'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (18 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'unknown' :: ((Untyped.RWCtx m s)) => (Type (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Type'unknown' (Type'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Type'list msg
+ = Type'list'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'list) where
+ tMsg f (Type'list'newtype_ s) = (Type'list'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'list msg)) where
+ fromStruct struct = (Std_.pure (Type'list'newtype_ struct))
+instance (Classes.ToStruct msg (Type'list msg)) where
+ toStruct (Type'list'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'list msg)) where
+ type InMessage (Type'list msg) = msg
+ message (Type'list'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'list msg)) where
+ messageDefault msg = (Type'list'newtype_ (Untyped.messageDefault msg))
+get_Type'list'elementType :: ((Untyped.ReadCtx m msg)) => (Type'list msg) -> (m (Type msg))
+get_Type'list'elementType (Type'list'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Type'list'elementType :: ((Untyped.RWCtx m s)) => (Type'list (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
+set_Type'list'elementType (Type'list'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Type'list'elementType :: ((Untyped.ReadCtx m msg)) => (Type'list msg) -> (m Std_.Bool)
+has_Type'list'elementType (Type'list'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Type'list'elementType :: ((Untyped.RWCtx m s)) => (Type'list (Message.MutMsg s)) -> (m (Type (Message.MutMsg s)))
+new_Type'list'elementType struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Type'list'elementType struct result)
+ (Std_.pure result)
+ )
+newtype Type'enum msg
+ = Type'enum'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'enum) where
+ tMsg f (Type'enum'newtype_ s) = (Type'enum'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'enum msg)) where
+ fromStruct struct = (Std_.pure (Type'enum'newtype_ struct))
+instance (Classes.ToStruct msg (Type'enum msg)) where
+ toStruct (Type'enum'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'enum msg)) where
+ type InMessage (Type'enum msg) = msg
+ message (Type'enum'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'enum msg)) where
+ messageDefault msg = (Type'enum'newtype_ (Untyped.messageDefault msg))
+get_Type'enum'typeId :: ((Untyped.ReadCtx m msg)) => (Type'enum msg) -> (m Std_.Word64)
+get_Type'enum'typeId (Type'enum'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Type'enum'typeId :: ((Untyped.RWCtx m s)) => (Type'enum (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Type'enum'typeId (Type'enum'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Type'enum'brand :: ((Untyped.ReadCtx m msg)) => (Type'enum msg) -> (m (Brand msg))
+get_Type'enum'brand (Type'enum'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Type'enum'brand :: ((Untyped.RWCtx m s)) => (Type'enum (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Type'enum'brand (Type'enum'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Type'enum'brand :: ((Untyped.ReadCtx m msg)) => (Type'enum msg) -> (m Std_.Bool)
+has_Type'enum'brand (Type'enum'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Type'enum'brand :: ((Untyped.RWCtx m s)) => (Type'enum (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Type'enum'brand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Type'enum'brand struct result)
+ (Std_.pure result)
+ )
+newtype Type'struct msg
+ = Type'struct'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'struct) where
+ tMsg f (Type'struct'newtype_ s) = (Type'struct'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'struct msg)) where
+ fromStruct struct = (Std_.pure (Type'struct'newtype_ struct))
+instance (Classes.ToStruct msg (Type'struct msg)) where
+ toStruct (Type'struct'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'struct msg)) where
+ type InMessage (Type'struct msg) = msg
+ message (Type'struct'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'struct msg)) where
+ messageDefault msg = (Type'struct'newtype_ (Untyped.messageDefault msg))
+get_Type'struct'typeId :: ((Untyped.ReadCtx m msg)) => (Type'struct msg) -> (m Std_.Word64)
+get_Type'struct'typeId (Type'struct'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Type'struct'typeId :: ((Untyped.RWCtx m s)) => (Type'struct (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Type'struct'typeId (Type'struct'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Type'struct'brand :: ((Untyped.ReadCtx m msg)) => (Type'struct msg) -> (m (Brand msg))
+get_Type'struct'brand (Type'struct'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Type'struct'brand :: ((Untyped.RWCtx m s)) => (Type'struct (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Type'struct'brand (Type'struct'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Type'struct'brand :: ((Untyped.ReadCtx m msg)) => (Type'struct msg) -> (m Std_.Bool)
+has_Type'struct'brand (Type'struct'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Type'struct'brand :: ((Untyped.RWCtx m s)) => (Type'struct (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Type'struct'brand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Type'struct'brand struct result)
+ (Std_.pure result)
+ )
+newtype Type'interface msg
+ = Type'interface'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'interface) where
+ tMsg f (Type'interface'newtype_ s) = (Type'interface'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'interface msg)) where
+ fromStruct struct = (Std_.pure (Type'interface'newtype_ struct))
+instance (Classes.ToStruct msg (Type'interface msg)) where
+ toStruct (Type'interface'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'interface msg)) where
+ type InMessage (Type'interface msg) = msg
+ message (Type'interface'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'interface msg)) where
+ messageDefault msg = (Type'interface'newtype_ (Untyped.messageDefault msg))
+get_Type'interface'typeId :: ((Untyped.ReadCtx m msg)) => (Type'interface msg) -> (m Std_.Word64)
+get_Type'interface'typeId (Type'interface'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Type'interface'typeId :: ((Untyped.RWCtx m s)) => (Type'interface (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Type'interface'typeId (Type'interface'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Type'interface'brand :: ((Untyped.ReadCtx m msg)) => (Type'interface msg) -> (m (Brand msg))
+get_Type'interface'brand (Type'interface'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Type'interface'brand :: ((Untyped.RWCtx m s)) => (Type'interface (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Type'interface'brand (Type'interface'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Type'interface'brand :: ((Untyped.ReadCtx m msg)) => (Type'interface msg) -> (m Std_.Bool)
+has_Type'interface'brand (Type'interface'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Type'interface'brand :: ((Untyped.RWCtx m s)) => (Type'interface (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Type'interface'brand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Type'interface'brand struct result)
+ (Std_.pure result)
+ )
+newtype Type'anyPointer msg
+ = Type'anyPointer'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'anyPointer) where
+ tMsg f (Type'anyPointer'newtype_ s) = (Type'anyPointer'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'anyPointer msg)) where
+ fromStruct struct = (Std_.pure (Type'anyPointer'newtype_ struct))
+instance (Classes.ToStruct msg (Type'anyPointer msg)) where
+ toStruct (Type'anyPointer'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'anyPointer msg)) where
+ type InMessage (Type'anyPointer msg) = msg
+ message (Type'anyPointer'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'anyPointer msg)) where
+ messageDefault msg = (Type'anyPointer'newtype_ (Untyped.messageDefault msg))
+data Type'anyPointer' msg
+ = Type'anyPointer'unconstrained (Type'anyPointer'unconstrained msg)
+ | Type'anyPointer'parameter (Type'anyPointer'parameter msg)
+ | Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter msg)
+ | Type'anyPointer'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Type'anyPointer' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 4)
+ case tag of
+ 0 ->
+ (Type'anyPointer'unconstrained <$> (Classes.fromStruct struct))
+ 1 ->
+ (Type'anyPointer'parameter <$> (Classes.fromStruct struct))
+ 2 ->
+ (Type'anyPointer'implicitMethodParameter <$> (Classes.fromStruct struct))
+ _ ->
+ (Std_.pure (Type'anyPointer'unknown' (Std_.fromIntegral tag)))
+ )
+get_Type'anyPointer' :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer msg) -> (m (Type'anyPointer' msg))
+get_Type'anyPointer' (Type'anyPointer'newtype_ struct) = (Classes.fromStruct struct)
+set_Type'anyPointer'unconstrained :: ((Untyped.RWCtx m s)) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'unconstrained (Message.MutMsg s)))
+set_Type'anyPointer'unconstrained (Type'anyPointer'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'anyPointer'parameter :: ((Untyped.RWCtx m s)) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'parameter (Message.MutMsg s)))
+set_Type'anyPointer'parameter (Type'anyPointer'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'anyPointer'implicitMethodParameter :: ((Untyped.RWCtx m s)) => (Type'anyPointer (Message.MutMsg s)) -> (m (Type'anyPointer'implicitMethodParameter (Message.MutMsg s)))
+set_Type'anyPointer'implicitMethodParameter (Type'anyPointer'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 1 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Type'anyPointer'unknown' :: ((Untyped.RWCtx m s)) => (Type'anyPointer (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Type'anyPointer'unknown' (Type'anyPointer'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+newtype Type'anyPointer'unconstrained msg
+ = Type'anyPointer'unconstrained'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'anyPointer'unconstrained) where
+ tMsg f (Type'anyPointer'unconstrained'newtype_ s) = (Type'anyPointer'unconstrained'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'anyPointer'unconstrained msg)) where
+ fromStruct struct = (Std_.pure (Type'anyPointer'unconstrained'newtype_ struct))
+instance (Classes.ToStruct msg (Type'anyPointer'unconstrained msg)) where
+ toStruct (Type'anyPointer'unconstrained'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'anyPointer'unconstrained msg)) where
+ type InMessage (Type'anyPointer'unconstrained msg) = msg
+ message (Type'anyPointer'unconstrained'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'anyPointer'unconstrained msg)) where
+ messageDefault msg = (Type'anyPointer'unconstrained'newtype_ (Untyped.messageDefault msg))
+data Type'anyPointer'unconstrained' msg
+ = Type'anyPointer'unconstrained'anyKind
+ | Type'anyPointer'unconstrained'struct
+ | Type'anyPointer'unconstrained'list
+ | Type'anyPointer'unconstrained'capability
+ | Type'anyPointer'unconstrained'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Type'anyPointer'unconstrained' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 5)
+ case tag of
+ 0 ->
+ (Std_.pure Type'anyPointer'unconstrained'anyKind)
+ 1 ->
+ (Std_.pure Type'anyPointer'unconstrained'struct)
+ 2 ->
+ (Std_.pure Type'anyPointer'unconstrained'list)
+ 3 ->
+ (Std_.pure Type'anyPointer'unconstrained'capability)
+ _ ->
+ (Std_.pure (Type'anyPointer'unconstrained'unknown' (Std_.fromIntegral tag)))
+ )
+get_Type'anyPointer'unconstrained' :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'unconstrained msg) -> (m (Type'anyPointer'unconstrained' msg))
+get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained'newtype_ struct) = (Classes.fromStruct struct)
+set_Type'anyPointer'unconstrained'anyKind :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
+set_Type'anyPointer'unconstrained'anyKind (Type'anyPointer'unconstrained'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 16 0)
+ (Std_.pure ())
+ )
+set_Type'anyPointer'unconstrained'struct :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
+set_Type'anyPointer'unconstrained'struct (Type'anyPointer'unconstrained'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 16 0)
+ (Std_.pure ())
+ )
+set_Type'anyPointer'unconstrained'list :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
+set_Type'anyPointer'unconstrained'list (Type'anyPointer'unconstrained'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 1 16 0)
+ (Std_.pure ())
+ )
+set_Type'anyPointer'unconstrained'capability :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> (m ())
+set_Type'anyPointer'unconstrained'capability (Type'anyPointer'unconstrained'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 1 16 0)
+ (Std_.pure ())
+ )
+set_Type'anyPointer'unconstrained'unknown' :: ((Untyped.RWCtx m s)) => (Type'anyPointer'unconstrained (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Type'anyPointer'unconstrained'unknown' (Type'anyPointer'unconstrained'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 16 0)
+newtype Type'anyPointer'parameter msg
+ = Type'anyPointer'parameter'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'anyPointer'parameter) where
+ tMsg f (Type'anyPointer'parameter'newtype_ s) = (Type'anyPointer'parameter'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'anyPointer'parameter msg)) where
+ fromStruct struct = (Std_.pure (Type'anyPointer'parameter'newtype_ struct))
+instance (Classes.ToStruct msg (Type'anyPointer'parameter msg)) where
+ toStruct (Type'anyPointer'parameter'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'anyPointer'parameter msg)) where
+ type InMessage (Type'anyPointer'parameter msg) = msg
+ message (Type'anyPointer'parameter'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'anyPointer'parameter msg)) where
+ messageDefault msg = (Type'anyPointer'parameter'newtype_ (Untyped.messageDefault msg))
+get_Type'anyPointer'parameter'scopeId :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'parameter msg) -> (m Std_.Word64)
+get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Type'anyPointer'parameter'scopeId :: ((Untyped.RWCtx m s)) => (Type'anyPointer'parameter (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+get_Type'anyPointer'parameter'parameterIndex :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'parameter msg) -> (m Std_.Word16)
+get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'newtype_ struct) = (GenHelpers.getWordField struct 1 16 0)
+set_Type'anyPointer'parameter'parameterIndex :: ((Untyped.RWCtx m s)) => (Type'anyPointer'parameter (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 16 0)
+newtype Type'anyPointer'implicitMethodParameter msg
+ = Type'anyPointer'implicitMethodParameter'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Type'anyPointer'implicitMethodParameter) where
+ tMsg f (Type'anyPointer'implicitMethodParameter'newtype_ s) = (Type'anyPointer'implicitMethodParameter'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Type'anyPointer'implicitMethodParameter msg)) where
+ fromStruct struct = (Std_.pure (Type'anyPointer'implicitMethodParameter'newtype_ struct))
+instance (Classes.ToStruct msg (Type'anyPointer'implicitMethodParameter msg)) where
+ toStruct (Type'anyPointer'implicitMethodParameter'newtype_ struct) = struct
+instance (Untyped.HasMessage (Type'anyPointer'implicitMethodParameter msg)) where
+ type InMessage (Type'anyPointer'implicitMethodParameter msg) = msg
+ message (Type'anyPointer'implicitMethodParameter'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Type'anyPointer'implicitMethodParameter msg)) where
+ messageDefault msg = (Type'anyPointer'implicitMethodParameter'newtype_ (Untyped.messageDefault msg))
+get_Type'anyPointer'implicitMethodParameter'parameterIndex :: ((Untyped.ReadCtx m msg)) => (Type'anyPointer'implicitMethodParameter msg) -> (m Std_.Word16)
+get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'newtype_ struct) = (GenHelpers.getWordField struct 1 16 0)
+set_Type'anyPointer'implicitMethodParameter'parameterIndex :: ((Untyped.RWCtx m s)) => (Type'anyPointer'implicitMethodParameter (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 16 0)
+newtype Brand msg
+ = Brand'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Brand) where
+ tMsg f (Brand'newtype_ s) = (Brand'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Brand msg)) where
+ fromStruct struct = (Std_.pure (Brand'newtype_ struct))
+instance (Classes.ToStruct msg (Brand msg)) where
+ toStruct (Brand'newtype_ struct) = struct
+instance (Untyped.HasMessage (Brand msg)) where
+ type InMessage (Brand msg) = msg
+ message (Brand'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Brand msg)) where
+ messageDefault msg = (Brand'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Brand msg)) where
+ fromPtr msg ptr = (Brand'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Brand (Message.MutMsg s))) where
+ toPtr msg (Brand'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Brand (Message.MutMsg s))) where
+ new msg = (Brand'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Brand msg)) where
+ newtype List msg (Brand msg)
+ = Brand'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Brand'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Brand'List_ l) = (Untyped.ListStruct l)
+ length (Brand'List_ l) = (Untyped.length l)
+ index i (Brand'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Brand (Message.MutMsg s))) where
+ setIndex (Brand'newtype_ elt) i (Brand'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Brand'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Brand'scopes :: ((Untyped.ReadCtx m msg)) => (Brand msg) -> (m (Basics.List msg (Brand'Scope msg)))
+get_Brand'scopes (Brand'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Brand'scopes :: ((Untyped.RWCtx m s)) => (Brand (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Brand'Scope (Message.MutMsg s))) -> (m ())
+set_Brand'scopes (Brand'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Brand'scopes :: ((Untyped.ReadCtx m msg)) => (Brand msg) -> (m Std_.Bool)
+has_Brand'scopes (Brand'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Brand'scopes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Brand (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Brand'Scope (Message.MutMsg s))))
+new_Brand'scopes len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Brand'scopes struct result)
+ (Std_.pure result)
+ )
+newtype Brand'Scope msg
+ = Brand'Scope'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Brand'Scope) where
+ tMsg f (Brand'Scope'newtype_ s) = (Brand'Scope'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Brand'Scope msg)) where
+ fromStruct struct = (Std_.pure (Brand'Scope'newtype_ struct))
+instance (Classes.ToStruct msg (Brand'Scope msg)) where
+ toStruct (Brand'Scope'newtype_ struct) = struct
+instance (Untyped.HasMessage (Brand'Scope msg)) where
+ type InMessage (Brand'Scope msg) = msg
+ message (Brand'Scope'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Brand'Scope msg)) where
+ messageDefault msg = (Brand'Scope'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Brand'Scope msg)) where
+ fromPtr msg ptr = (Brand'Scope'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Brand'Scope (Message.MutMsg s))) where
+ toPtr msg (Brand'Scope'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Brand'Scope (Message.MutMsg s))) where
+ new msg = (Brand'Scope'newtype_ <$> (Untyped.allocStruct msg 2 1))
+instance (Basics.ListElem msg (Brand'Scope msg)) where
+ newtype List msg (Brand'Scope msg)
+ = Brand'Scope'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Brand'Scope'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Brand'Scope'List_ l) = (Untyped.ListStruct l)
+ length (Brand'Scope'List_ l) = (Untyped.length l)
+ index i (Brand'Scope'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Brand'Scope (Message.MutMsg s))) where
+ setIndex (Brand'Scope'newtype_ elt) i (Brand'Scope'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Brand'Scope'List_ <$> (Untyped.allocCompositeList msg 2 1 len))
+get_Brand'Scope'scopeId :: ((Untyped.ReadCtx m msg)) => (Brand'Scope msg) -> (m Std_.Word64)
+get_Brand'Scope'scopeId (Brand'Scope'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Brand'Scope'scopeId :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Brand'Scope'scopeId (Brand'Scope'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+data Brand'Scope' msg
+ = Brand'Scope'bind (Basics.List msg (Brand'Binding msg))
+ | Brand'Scope'inherit
+ | Brand'Scope'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Brand'Scope' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 4)
+ case tag of
+ 0 ->
+ (Brand'Scope'bind <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 1 ->
+ (Std_.pure Brand'Scope'inherit)
+ _ ->
+ (Std_.pure (Brand'Scope'unknown' (Std_.fromIntegral tag)))
+ )
+get_Brand'Scope' :: ((Untyped.ReadCtx m msg)) => (Brand'Scope msg) -> (m (Brand'Scope' msg))
+get_Brand'Scope' (Brand'Scope'newtype_ struct) = (Classes.fromStruct struct)
+set_Brand'Scope'bind :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Brand'Binding (Message.MutMsg s))) -> (m ())
+set_Brand'Scope'bind (Brand'Scope'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 1 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Brand'Scope'inherit :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> (m ())
+set_Brand'Scope'inherit (Brand'Scope'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 1 0 0)
+ (Std_.pure ())
+ )
+set_Brand'Scope'unknown' :: ((Untyped.RWCtx m s)) => (Brand'Scope (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Brand'Scope'unknown' (Brand'Scope'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+newtype Brand'Binding msg
+ = Brand'Binding'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Brand'Binding) where
+ tMsg f (Brand'Binding'newtype_ s) = (Brand'Binding'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Brand'Binding msg)) where
+ fromStruct struct = (Std_.pure (Brand'Binding'newtype_ struct))
+instance (Classes.ToStruct msg (Brand'Binding msg)) where
+ toStruct (Brand'Binding'newtype_ struct) = struct
+instance (Untyped.HasMessage (Brand'Binding msg)) where
+ type InMessage (Brand'Binding msg) = msg
+ message (Brand'Binding'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Brand'Binding msg)) where
+ messageDefault msg = (Brand'Binding'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Brand'Binding msg)) where
+ fromPtr msg ptr = (Brand'Binding'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Brand'Binding (Message.MutMsg s))) where
+ toPtr msg (Brand'Binding'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Brand'Binding (Message.MutMsg s))) where
+ new msg = (Brand'Binding'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Brand'Binding msg)) where
+ newtype List msg (Brand'Binding msg)
+ = Brand'Binding'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Brand'Binding'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Brand'Binding'List_ l) = (Untyped.ListStruct l)
+ length (Brand'Binding'List_ l) = (Untyped.length l)
+ index i (Brand'Binding'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Brand'Binding (Message.MutMsg s))) where
+ setIndex (Brand'Binding'newtype_ elt) i (Brand'Binding'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Brand'Binding'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+data Brand'Binding' msg
+ = Brand'Binding'unbound
+ | Brand'Binding'type_ (Type msg)
+ | Brand'Binding'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Brand'Binding' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Brand'Binding'unbound)
+ 1 ->
+ (Brand'Binding'type_ <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Brand'Binding'unknown' (Std_.fromIntegral tag)))
+ )
+get_Brand'Binding' :: ((Untyped.ReadCtx m msg)) => (Brand'Binding msg) -> (m (Brand'Binding' msg))
+get_Brand'Binding' (Brand'Binding'newtype_ struct) = (Classes.fromStruct struct)
+set_Brand'Binding'unbound :: ((Untyped.RWCtx m s)) => (Brand'Binding (Message.MutMsg s)) -> (m ())
+set_Brand'Binding'unbound (Brand'Binding'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Brand'Binding'type_ :: ((Untyped.RWCtx m s)) => (Brand'Binding (Message.MutMsg s)) -> (Type (Message.MutMsg s)) -> (m ())
+set_Brand'Binding'type_ (Brand'Binding'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Brand'Binding'unknown' :: ((Untyped.RWCtx m s)) => (Brand'Binding (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Brand'Binding'unknown' (Brand'Binding'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Value msg
+ = Value'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Value) where
+ tMsg f (Value'newtype_ s) = (Value'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Value msg)) where
+ fromStruct struct = (Std_.pure (Value'newtype_ struct))
+instance (Classes.ToStruct msg (Value msg)) where
+ toStruct (Value'newtype_ struct) = struct
+instance (Untyped.HasMessage (Value msg)) where
+ type InMessage (Value msg) = msg
+ message (Value'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Value msg)) where
+ messageDefault msg = (Value'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Value msg)) where
+ fromPtr msg ptr = (Value'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Value (Message.MutMsg s))) where
+ toPtr msg (Value'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Value (Message.MutMsg s))) where
+ new msg = (Value'newtype_ <$> (Untyped.allocStruct msg 2 1))
+instance (Basics.ListElem msg (Value msg)) where
+ newtype List msg (Value msg)
+ = Value'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Value'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Value'List_ l) = (Untyped.ListStruct l)
+ length (Value'List_ l) = (Untyped.length l)
+ index i (Value'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Value (Message.MutMsg s))) where
+ setIndex (Value'newtype_ elt) i (Value'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Value'List_ <$> (Untyped.allocCompositeList msg 2 1 len))
+data Value' msg
+ = Value'void
+ | Value'bool Std_.Bool
+ | Value'int8 Std_.Int8
+ | Value'int16 Std_.Int16
+ | Value'int32 Std_.Int32
+ | Value'int64 Std_.Int64
+ | Value'uint8 Std_.Word8
+ | Value'uint16 Std_.Word16
+ | Value'uint32 Std_.Word32
+ | Value'uint64 Std_.Word64
+ | Value'float32 Std_.Float
+ | Value'float64 Std_.Double
+ | Value'text (Basics.Text msg)
+ | Value'data_ (Basics.Data msg)
+ | Value'list (Std_.Maybe (Untyped.Ptr msg))
+ | Value'enum Std_.Word16
+ | Value'struct (Std_.Maybe (Untyped.Ptr msg))
+ | Value'interface
+ | Value'anyPointer (Std_.Maybe (Untyped.Ptr msg))
+ | Value'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Value' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Value'void)
+ 1 ->
+ (Value'bool <$> (GenHelpers.getWordField struct 0 16 0))
+ 2 ->
+ (Value'int8 <$> (GenHelpers.getWordField struct 0 16 0))
+ 3 ->
+ (Value'int16 <$> (GenHelpers.getWordField struct 0 16 0))
+ 4 ->
+ (Value'int32 <$> (GenHelpers.getWordField struct 0 32 0))
+ 5 ->
+ (Value'int64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 6 ->
+ (Value'uint8 <$> (GenHelpers.getWordField struct 0 16 0))
+ 7 ->
+ (Value'uint16 <$> (GenHelpers.getWordField struct 0 16 0))
+ 8 ->
+ (Value'uint32 <$> (GenHelpers.getWordField struct 0 32 0))
+ 9 ->
+ (Value'uint64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 10 ->
+ (Value'float32 <$> (GenHelpers.getWordField struct 0 32 0))
+ 11 ->
+ (Value'float64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 12 ->
+ (Value'text <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 13 ->
+ (Value'data_ <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 14 ->
+ (Value'list <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 15 ->
+ (Value'enum <$> (GenHelpers.getWordField struct 0 16 0))
+ 16 ->
+ (Value'struct <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 17 ->
+ (Std_.pure Value'interface)
+ 18 ->
+ (Value'anyPointer <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Value'unknown' (Std_.fromIntegral tag)))
+ )
+get_Value' :: ((Untyped.ReadCtx m msg)) => (Value msg) -> (m (Value' msg))
+get_Value' (Value'newtype_ struct) = (Classes.fromStruct struct)
+set_Value'void :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (m ())
+set_Value'void (Value'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Value'bool :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Value'bool (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 0 16 0)
+ )
+set_Value'int8 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int8 -> (m ())
+set_Value'int8 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 16 0)
+ )
+set_Value'int16 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_Value'int16 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 0)
+ )
+set_Value'int32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_Value'int32 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_Value'int64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_Value'int64 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Value'uint8 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_Value'uint8 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 16 0)
+ )
+set_Value'uint16 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Value'uint16 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 0)
+ )
+set_Value'uint32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Value'uint32 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_Value'uint64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Value'uint64 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Value'float32 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Float -> (m ())
+set_Value'float32 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 0)
+ )
+set_Value'float64 :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Value'float64 (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Value'text :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Value'text (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (12 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'data_ :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
+set_Value'data_ (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (13 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'list :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Value'list (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (14 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'enum :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Value'enum (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (15 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 16 0)
+ )
+set_Value'struct :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Value'struct (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (16 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'interface :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (m ())
+set_Value'interface (Value'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (17 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Value'anyPointer :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> (Std_.Maybe (Untyped.Ptr (Message.MutMsg s))) -> (m ())
+set_Value'anyPointer (Value'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (18 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Value'unknown' :: ((Untyped.RWCtx m s)) => (Value (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Value'unknown' (Value'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Annotation msg
+ = Annotation'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Annotation) where
+ tMsg f (Annotation'newtype_ s) = (Annotation'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Annotation msg)) where
+ fromStruct struct = (Std_.pure (Annotation'newtype_ struct))
+instance (Classes.ToStruct msg (Annotation msg)) where
+ toStruct (Annotation'newtype_ struct) = struct
+instance (Untyped.HasMessage (Annotation msg)) where
+ type InMessage (Annotation msg) = msg
+ message (Annotation'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Annotation msg)) where
+ messageDefault msg = (Annotation'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Annotation msg)) where
+ fromPtr msg ptr = (Annotation'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Annotation (Message.MutMsg s))) where
+ toPtr msg (Annotation'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Annotation (Message.MutMsg s))) where
+ new msg = (Annotation'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Annotation msg)) where
+ newtype List msg (Annotation msg)
+ = Annotation'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Annotation'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Annotation'List_ l) = (Untyped.ListStruct l)
+ length (Annotation'List_ l) = (Untyped.length l)
+ index i (Annotation'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Annotation (Message.MutMsg s))) where
+ setIndex (Annotation'newtype_ elt) i (Annotation'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Annotation'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Annotation'id :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Word64)
+get_Annotation'id (Annotation'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Annotation'id :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Annotation'id (Annotation'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Annotation'value :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m (Value msg))
+get_Annotation'value (Annotation'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Annotation'value :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (Value (Message.MutMsg s)) -> (m ())
+set_Annotation'value (Annotation'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Annotation'value :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Bool)
+has_Annotation'value (Annotation'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Annotation'value :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (m (Value (Message.MutMsg s)))
+new_Annotation'value struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Annotation'value struct result)
+ (Std_.pure result)
+ )
+get_Annotation'brand :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m (Brand msg))
+get_Annotation'brand (Annotation'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Annotation'brand :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (Brand (Message.MutMsg s)) -> (m ())
+set_Annotation'brand (Annotation'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Annotation'brand :: ((Untyped.ReadCtx m msg)) => (Annotation msg) -> (m Std_.Bool)
+has_Annotation'brand (Annotation'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Annotation'brand :: ((Untyped.RWCtx m s)) => (Annotation (Message.MutMsg s)) -> (m (Brand (Message.MutMsg s)))
+new_Annotation'brand struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Annotation'brand struct result)
+ (Std_.pure result)
+ )
+data ElementSize
+ = ElementSize'empty
+ | ElementSize'bit
+ | ElementSize'byte
+ | ElementSize'twoBytes
+ | ElementSize'fourBytes
+ | ElementSize'eightBytes
+ | ElementSize'pointer
+ | ElementSize'inlineComposite
+ | ElementSize'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Read
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Classes.IsWord ElementSize) where
+ fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
+ 0 ->
+ ElementSize'empty
+ 1 ->
+ ElementSize'bit
+ 2 ->
+ ElementSize'byte
+ 3 ->
+ ElementSize'twoBytes
+ 4 ->
+ ElementSize'fourBytes
+ 5 ->
+ ElementSize'eightBytes
+ 6 ->
+ ElementSize'pointer
+ 7 ->
+ ElementSize'inlineComposite
+ tag ->
+ (ElementSize'unknown' tag)
+ toWord (ElementSize'empty) = 0
+ toWord (ElementSize'bit) = 1
+ toWord (ElementSize'byte) = 2
+ toWord (ElementSize'twoBytes) = 3
+ toWord (ElementSize'fourBytes) = 4
+ toWord (ElementSize'eightBytes) = 5
+ toWord (ElementSize'pointer) = 6
+ toWord (ElementSize'inlineComposite) = 7
+ toWord (ElementSize'unknown' tag) = (Std_.fromIntegral tag)
+instance (Std_.Enum ElementSize) where
+ fromEnum x = (Std_.fromIntegral (Classes.toWord x))
+ toEnum x = (Classes.fromWord (Std_.fromIntegral x))
+instance (Basics.ListElem msg ElementSize) where
+ newtype List msg ElementSize
+ = ElementSize'List_ (Untyped.ListOf msg Std_.Word16)
+ index i (ElementSize'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
+ listFromPtr msg ptr = (ElementSize'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (ElementSize'List_ l) = (Untyped.List16 l)
+ length (ElementSize'List_ l) = (Untyped.length l)
+instance (Classes.MutListElem s ElementSize) where
+ setIndex elt i (ElementSize'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
+ newList msg size = (ElementSize'List_ <$> (Untyped.allocList16 msg size))
+newtype CapnpVersion msg
+ = CapnpVersion'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CapnpVersion) where
+ tMsg f (CapnpVersion'newtype_ s) = (CapnpVersion'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CapnpVersion msg)) where
+ fromStruct struct = (Std_.pure (CapnpVersion'newtype_ struct))
+instance (Classes.ToStruct msg (CapnpVersion msg)) where
+ toStruct (CapnpVersion'newtype_ struct) = struct
+instance (Untyped.HasMessage (CapnpVersion msg)) where
+ type InMessage (CapnpVersion msg) = msg
+ message (CapnpVersion'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CapnpVersion msg)) where
+ messageDefault msg = (CapnpVersion'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CapnpVersion msg)) where
+ fromPtr msg ptr = (CapnpVersion'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CapnpVersion (Message.MutMsg s))) where
+ toPtr msg (CapnpVersion'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CapnpVersion (Message.MutMsg s))) where
+ new msg = (CapnpVersion'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (CapnpVersion msg)) where
+ newtype List msg (CapnpVersion msg)
+ = CapnpVersion'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CapnpVersion'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CapnpVersion'List_ l) = (Untyped.ListStruct l)
+ length (CapnpVersion'List_ l) = (Untyped.length l)
+ index i (CapnpVersion'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CapnpVersion (Message.MutMsg s))) where
+ setIndex (CapnpVersion'newtype_ elt) i (CapnpVersion'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CapnpVersion'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_CapnpVersion'major :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word16)
+get_CapnpVersion'major (CapnpVersion'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_CapnpVersion'major :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_CapnpVersion'major (CapnpVersion'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_CapnpVersion'minor :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word8)
+get_CapnpVersion'minor (CapnpVersion'newtype_ struct) = (GenHelpers.getWordField struct 0 16 0)
+set_CapnpVersion'minor :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_CapnpVersion'minor (CapnpVersion'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 16 0)
+get_CapnpVersion'micro :: ((Untyped.ReadCtx m msg)) => (CapnpVersion msg) -> (m Std_.Word8)
+get_CapnpVersion'micro (CapnpVersion'newtype_ struct) = (GenHelpers.getWordField struct 0 24 0)
+set_CapnpVersion'micro :: ((Untyped.RWCtx m s)) => (CapnpVersion (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_CapnpVersion'micro (CapnpVersion'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 24 0)
+newtype CodeGeneratorRequest msg
+ = CodeGeneratorRequest'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CodeGeneratorRequest) where
+ tMsg f (CodeGeneratorRequest'newtype_ s) = (CodeGeneratorRequest'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CodeGeneratorRequest msg)) where
+ fromStruct struct = (Std_.pure (CodeGeneratorRequest'newtype_ struct))
+instance (Classes.ToStruct msg (CodeGeneratorRequest msg)) where
+ toStruct (CodeGeneratorRequest'newtype_ struct) = struct
+instance (Untyped.HasMessage (CodeGeneratorRequest msg)) where
+ type InMessage (CodeGeneratorRequest msg) = msg
+ message (CodeGeneratorRequest'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CodeGeneratorRequest msg)) where
+ messageDefault msg = (CodeGeneratorRequest'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CodeGeneratorRequest msg)) where
+ fromPtr msg ptr = (CodeGeneratorRequest'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CodeGeneratorRequest (Message.MutMsg s))) where
+ toPtr msg (CodeGeneratorRequest'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CodeGeneratorRequest (Message.MutMsg s))) where
+ new msg = (CodeGeneratorRequest'newtype_ <$> (Untyped.allocStruct msg 0 4))
+instance (Basics.ListElem msg (CodeGeneratorRequest msg)) where
+ newtype List msg (CodeGeneratorRequest msg)
+ = CodeGeneratorRequest'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CodeGeneratorRequest'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CodeGeneratorRequest'List_ l) = (Untyped.ListStruct l)
+ length (CodeGeneratorRequest'List_ l) = (Untyped.length l)
+ index i (CodeGeneratorRequest'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CodeGeneratorRequest (Message.MutMsg s))) where
+ setIndex (CodeGeneratorRequest'newtype_ elt) i (CodeGeneratorRequest'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CodeGeneratorRequest'List_ <$> (Untyped.allocCompositeList msg 0 4 len))
+get_CodeGeneratorRequest'nodes :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (Node msg)))
+get_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'nodes :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node (Message.MutMsg s))) -> (m ())
+set_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_CodeGeneratorRequest'nodes :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'nodes (CodeGeneratorRequest'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_CodeGeneratorRequest'nodes :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node (Message.MutMsg s))))
+new_CodeGeneratorRequest'nodes len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'nodes struct result)
+ (Std_.pure result)
+ )
+get_CodeGeneratorRequest'requestedFiles :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (CodeGeneratorRequest'RequestedFile msg)))
+get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'requestedFiles :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) -> (m ())
+set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_CodeGeneratorRequest'requestedFiles :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_CodeGeneratorRequest'requestedFiles :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))))
+new_CodeGeneratorRequest'requestedFiles len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'requestedFiles struct result)
+ (Std_.pure result)
+ )
+get_CodeGeneratorRequest'capnpVersion :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m (CapnpVersion msg))
+get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'capnpVersion :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (CapnpVersion (Message.MutMsg s)) -> (m ())
+set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_CodeGeneratorRequest'capnpVersion :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_CodeGeneratorRequest'capnpVersion :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (m (CapnpVersion (Message.MutMsg s)))
+new_CodeGeneratorRequest'capnpVersion struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_CodeGeneratorRequest'capnpVersion struct result)
+ (Std_.pure result)
+ )
+get_CodeGeneratorRequest'sourceInfo :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m (Basics.List msg (Node'SourceInfo msg)))
+get_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 3 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'sourceInfo :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Node'SourceInfo (Message.MutMsg s))) -> (m ())
+set_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 3 struct)
+ )
+has_CodeGeneratorRequest'sourceInfo :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'sourceInfo (CodeGeneratorRequest'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 3 struct))
+new_CodeGeneratorRequest'sourceInfo :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Node'SourceInfo (Message.MutMsg s))))
+new_CodeGeneratorRequest'sourceInfo len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'sourceInfo struct result)
+ (Std_.pure result)
+ )
+newtype CodeGeneratorRequest'RequestedFile msg
+ = CodeGeneratorRequest'RequestedFile'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CodeGeneratorRequest'RequestedFile) where
+ tMsg f (CodeGeneratorRequest'RequestedFile'newtype_ s) = (CodeGeneratorRequest'RequestedFile'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CodeGeneratorRequest'RequestedFile msg)) where
+ fromStruct struct = (Std_.pure (CodeGeneratorRequest'RequestedFile'newtype_ struct))
+instance (Classes.ToStruct msg (CodeGeneratorRequest'RequestedFile msg)) where
+ toStruct (CodeGeneratorRequest'RequestedFile'newtype_ struct) = struct
+instance (Untyped.HasMessage (CodeGeneratorRequest'RequestedFile msg)) where
+ type InMessage (CodeGeneratorRequest'RequestedFile msg) = msg
+ message (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CodeGeneratorRequest'RequestedFile msg)) where
+ messageDefault msg = (CodeGeneratorRequest'RequestedFile'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CodeGeneratorRequest'RequestedFile msg)) where
+ fromPtr msg ptr = (CodeGeneratorRequest'RequestedFile'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
+ toPtr msg (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
+ new msg = (CodeGeneratorRequest'RequestedFile'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (CodeGeneratorRequest'RequestedFile msg)) where
+ newtype List msg (CodeGeneratorRequest'RequestedFile msg)
+ = CodeGeneratorRequest'RequestedFile'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CodeGeneratorRequest'RequestedFile'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CodeGeneratorRequest'RequestedFile'List_ l) = (Untyped.ListStruct l)
+ length (CodeGeneratorRequest'RequestedFile'List_ l) = (Untyped.length l)
+ index i (CodeGeneratorRequest'RequestedFile'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CodeGeneratorRequest'RequestedFile (Message.MutMsg s))) where
+ setIndex (CodeGeneratorRequest'RequestedFile'newtype_ elt) i (CodeGeneratorRequest'RequestedFile'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CodeGeneratorRequest'RequestedFile'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_CodeGeneratorRequest'RequestedFile'id :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Word64)
+get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_CodeGeneratorRequest'RequestedFile'id :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m (Basics.Text msg))
+get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_CodeGeneratorRequest'RequestedFile'filename :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_CodeGeneratorRequest'RequestedFile'filename len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'RequestedFile'filename struct result)
+ (Std_.pure result)
+ )
+get_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m (Basics.List msg (CodeGeneratorRequest'RequestedFile'Import msg)))
+get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) -> (m ())
+set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_CodeGeneratorRequest'RequestedFile'imports :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))))
+new_CodeGeneratorRequest'RequestedFile'imports len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'RequestedFile'imports struct result)
+ (Std_.pure result)
+ )
+newtype CodeGeneratorRequest'RequestedFile'Import msg
+ = CodeGeneratorRequest'RequestedFile'Import'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CodeGeneratorRequest'RequestedFile'Import) where
+ tMsg f (CodeGeneratorRequest'RequestedFile'Import'newtype_ s) = (CodeGeneratorRequest'RequestedFile'Import'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ fromStruct struct = (Std_.pure (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct))
+instance (Classes.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ toStruct (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = struct
+instance (Untyped.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ type InMessage (CodeGeneratorRequest'RequestedFile'Import msg) = msg
+ message (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ messageDefault msg = (CodeGeneratorRequest'RequestedFile'Import'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ fromPtr msg ptr = (CodeGeneratorRequest'RequestedFile'Import'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
+ toPtr msg (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
+ new msg = (CodeGeneratorRequest'RequestedFile'Import'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
+ newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg)
+ = CodeGeneratorRequest'RequestedFile'Import'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CodeGeneratorRequest'RequestedFile'Import'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (Untyped.ListStruct l)
+ length (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (Untyped.length l)
+ index i (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s))) where
+ setIndex (CodeGeneratorRequest'RequestedFile'Import'newtype_ elt) i (CodeGeneratorRequest'RequestedFile'Import'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CodeGeneratorRequest'RequestedFile'Import'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_CodeGeneratorRequest'RequestedFile'Import'id :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m Std_.Word64)
+get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_CodeGeneratorRequest'RequestedFile'Import'id :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m (Basics.Text msg))
+get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.RWCtx m s)) => (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.ReadCtx m msg)) => (CodeGeneratorRequest'RequestedFile'Import msg) -> (m Std_.Bool)
+has_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_CodeGeneratorRequest'RequestedFile'Import'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (CodeGeneratorRequest'RequestedFile'Import (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_CodeGeneratorRequest'RequestedFile'Import'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_CodeGeneratorRequest'RequestedFile'Import'name struct result)
+ (Std_.pure result)
+ )
diff --git a/gen/lib/Capnp/Gen/Capnp/Schema/Pure.hs b/gen/lib/Capnp/Gen/Capnp/Schema/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Capnp/Gen/Capnp/Schema/Pure.hs
@@ -0,0 +1,1680 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Capnp.Schema.Pure(Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize(..)
+ ,Node(..)
+ ,Node'(..)
+ ,Node'struct(..)
+ ,Node'enum(..)
+ ,Node'interface(..)
+ ,Node'const(..)
+ ,Node'annotation(..)
+ ,Node'Parameter(..)
+ ,Node'NestedNode(..)
+ ,Node'SourceInfo(..)
+ ,Node'SourceInfo'Member(..)
+ ,Field(..)
+ ,Field'(..)
+ ,Field'slot(..)
+ ,Field'group(..)
+ ,Field'ordinal(..)
+ ,Capnp.Gen.ById.Xa93fc509624c72d9.field'noDiscriminant
+ ,Enumerant(..)
+ ,Superclass(..)
+ ,Method(..)
+ ,Type(..)
+ ,Type'list(..)
+ ,Type'enum(..)
+ ,Type'struct(..)
+ ,Type'interface(..)
+ ,Type'anyPointer(..)
+ ,Type'anyPointer'unconstrained(..)
+ ,Type'anyPointer'parameter(..)
+ ,Type'anyPointer'implicitMethodParameter(..)
+ ,Brand(..)
+ ,Brand'Scope(..)
+ ,Brand'Scope'(..)
+ ,Brand'Binding(..)
+ ,Value(..)
+ ,Annotation(..)
+ ,CapnpVersion(..)
+ ,CodeGeneratorRequest(..)
+ ,CodeGeneratorRequest'RequestedFile(..)
+ ,CodeGeneratorRequest'RequestedFile'Import(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Gen.ById.Xa93fc509624c72d9
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+data Node
+ = Node
+ {id :: Std_.Word64
+ ,displayName :: T.Text
+ ,displayNamePrefixLength :: Std_.Word32
+ ,scopeId :: Std_.Word64
+ ,nestedNodes :: (V.Vector Node'NestedNode)
+ ,annotations :: (V.Vector Annotation)
+ ,parameters :: (V.Vector Node'Parameter)
+ ,isGeneric :: Std_.Bool
+ ,union' :: Node'}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node) where
+ type Cerial msg Node = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
+ decerialize raw = (Node <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayName raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'displayNamePrefixLength raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'scopeId raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'nestedNodes raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotations raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'parameters raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'isGeneric raw)
+ <*> (Classes.decerialize raw))
+instance (Classes.Marshal Node) where
+ marshalInto raw_ value_ = case value_ of
+ Node{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) displayName) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayName raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'displayNamePrefixLength raw_ displayNamePrefixLength)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'scopeId raw_ scopeId)
+ ((Classes.cerialize (Untyped.message raw_) nestedNodes) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'nestedNodes raw_))
+ ((Classes.cerialize (Untyped.message raw_) annotations) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotations raw_))
+ ((Classes.cerialize (Untyped.message raw_) parameters) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'parameters raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'isGeneric raw_ isGeneric)
+ (do
+ (Classes.marshalInto raw_ union')
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Node)
+instance (Classes.Cerialize (V.Vector Node)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Node))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Node)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Node))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Node'
+ = Node'file
+ | Node'struct Node'struct
+ | Node'enum Node'enum
+ | Node'interface Node'interface
+ | Node'const Node'const
+ | Node'annotation Node'annotation
+ | Node'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node') where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node') where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node') where
+ type Cerial msg Node' = (Capnp.Gen.ById.Xa93fc509624c72d9.Node msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'file) ->
+ (Std_.pure Node'file)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'struct raw) ->
+ (Node'struct <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'enum raw) ->
+ (Node'enum <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'interface raw) ->
+ (Node'interface <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'const raw) ->
+ (Node'const <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'annotation raw) ->
+ (Node'annotation <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Node'unknown' tag) ->
+ (Std_.pure (Node'unknown' tag))
+ )
+instance (Classes.Marshal Node') where
+ marshalInto raw_ value_ = case value_ of
+ (Node'file) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'file raw_)
+ (Node'struct arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Node'enum arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Node'interface arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Node'const arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Node'annotation arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Node'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'unknown' raw_ tag)
+data Node'struct
+ = Node'struct'
+ {dataWordCount :: Std_.Word16
+ ,pointerCount :: Std_.Word16
+ ,preferredListEncoding :: Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize
+ ,isGroup :: Std_.Bool
+ ,discriminantCount :: Std_.Word16
+ ,discriminantOffset :: Std_.Word32
+ ,fields :: (V.Vector Field)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'struct) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'struct) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'struct) where
+ type Cerial msg Node'struct = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'struct msg)
+ decerialize raw = (Node'struct' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'dataWordCount raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'pointerCount raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'preferredListEncoding raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'isGroup raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantCount raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'discriminantOffset raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'struct'fields raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'struct) where
+ marshalInto raw_ value_ = case value_ of
+ Node'struct'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'dataWordCount raw_ dataWordCount)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'pointerCount raw_ pointerCount)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'preferredListEncoding raw_ preferredListEncoding)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'isGroup raw_ isGroup)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantCount raw_ discriminantCount)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'discriminantOffset raw_ discriminantOffset)
+ ((Classes.cerialize (Untyped.message raw_) fields) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'struct'fields raw_))
+ (Std_.pure ())
+ )
+data Node'enum
+ = Node'enum'
+ {enumerants :: (V.Vector Enumerant)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'enum) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'enum) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'enum) where
+ type Cerial msg Node'enum = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'enum msg)
+ decerialize raw = (Node'enum' <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'enum'enumerants raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'enum) where
+ marshalInto raw_ value_ = case value_ of
+ Node'enum'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) enumerants) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'enum'enumerants raw_))
+ (Std_.pure ())
+ )
+data Node'interface
+ = Node'interface'
+ {methods :: (V.Vector Method)
+ ,superclasses :: (V.Vector Superclass)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'interface) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'interface) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'interface) where
+ type Cerial msg Node'interface = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'interface msg)
+ decerialize raw = (Node'interface' <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'interface'methods raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'interface'superclasses raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'interface) where
+ marshalInto raw_ value_ = case value_ of
+ Node'interface'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) methods) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'methods raw_))
+ ((Classes.cerialize (Untyped.message raw_) superclasses) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'interface'superclasses raw_))
+ (Std_.pure ())
+ )
+data Node'const
+ = Node'const'
+ {type_ :: Type
+ ,value :: Value}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'const) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'const) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'const) where
+ type Cerial msg Node'const = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'const msg)
+ decerialize raw = (Node'const' <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'type_ raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'const'value raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'const) where
+ marshalInto raw_ value_ = case value_ of
+ Node'const'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) type_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'type_ raw_))
+ ((Classes.cerialize (Untyped.message raw_) value) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'const'value raw_))
+ (Std_.pure ())
+ )
+data Node'annotation
+ = Node'annotation'
+ {type_ :: Type
+ ,targetsFile :: Std_.Bool
+ ,targetsConst :: Std_.Bool
+ ,targetsEnum :: Std_.Bool
+ ,targetsEnumerant :: Std_.Bool
+ ,targetsStruct :: Std_.Bool
+ ,targetsField :: Std_.Bool
+ ,targetsUnion :: Std_.Bool
+ ,targetsGroup :: Std_.Bool
+ ,targetsInterface :: Std_.Bool
+ ,targetsMethod :: Std_.Bool
+ ,targetsParam :: Std_.Bool
+ ,targetsAnnotation :: Std_.Bool}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'annotation) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'annotation) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'annotation) where
+ type Cerial msg Node'annotation = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'annotation msg)
+ decerialize raw = (Node'annotation' <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'type_ raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsFile raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsConst raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnum raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsEnumerant raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsStruct raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsField raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsUnion raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsGroup raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsInterface raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsMethod raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsParam raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'annotation'targetsAnnotation raw))
+instance (Classes.Marshal Node'annotation) where
+ marshalInto raw_ value_ = case value_ of
+ Node'annotation'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) type_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'type_ raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsFile raw_ targetsFile)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsConst raw_ targetsConst)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnum raw_ targetsEnum)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsEnumerant raw_ targetsEnumerant)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsStruct raw_ targetsStruct)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsField raw_ targetsField)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsUnion raw_ targetsUnion)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsGroup raw_ targetsGroup)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsInterface raw_ targetsInterface)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsMethod raw_ targetsMethod)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsParam raw_ targetsParam)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'annotation'targetsAnnotation raw_ targetsAnnotation)
+ (Std_.pure ())
+ )
+data Node'Parameter
+ = Node'Parameter
+ {name :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'Parameter) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'Parameter) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'Parameter) where
+ type Cerial msg Node'Parameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'Parameter msg)
+ decerialize raw = (Node'Parameter <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'Parameter'name raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'Parameter) where
+ marshalInto raw_ value_ = case value_ of
+ Node'Parameter{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'Parameter'name raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Node'Parameter)
+instance (Classes.Cerialize (V.Vector Node'Parameter)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Node'Parameter))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Node'Parameter)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'Parameter)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Node'NestedNode
+ = Node'NestedNode
+ {name :: T.Text
+ ,id :: Std_.Word64}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'NestedNode) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'NestedNode) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'NestedNode) where
+ type Cerial msg Node'NestedNode = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'NestedNode msg)
+ decerialize raw = (Node'NestedNode <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'name raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'NestedNode'id raw))
+instance (Classes.Marshal Node'NestedNode) where
+ marshalInto raw_ value_ = case value_ of
+ Node'NestedNode{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'name raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'NestedNode'id raw_ id)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Node'NestedNode)
+instance (Classes.Cerialize (V.Vector Node'NestedNode)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Node'NestedNode))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Node'NestedNode)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'NestedNode)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Node'SourceInfo
+ = Node'SourceInfo
+ {id :: Std_.Word64
+ ,docComment :: T.Text
+ ,members :: (V.Vector Node'SourceInfo'Member)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'SourceInfo) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'SourceInfo) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'SourceInfo) where
+ type Cerial msg Node'SourceInfo = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'SourceInfo msg)
+ decerialize raw = (Node'SourceInfo <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'docComment raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'members raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'SourceInfo) where
+ marshalInto raw_ value_ = case value_ of
+ Node'SourceInfo{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) docComment) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'docComment raw_))
+ ((Classes.cerialize (Untyped.message raw_) members) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'members raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Node'SourceInfo)
+instance (Classes.Cerialize (V.Vector Node'SourceInfo)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Node'SourceInfo))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Node'SourceInfo)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Node'SourceInfo'Member
+ = Node'SourceInfo'Member
+ {docComment :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Node'SourceInfo'Member) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Node'SourceInfo'Member) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Node'SourceInfo'Member) where
+ type Cerial msg Node'SourceInfo'Member = (Capnp.Gen.ById.Xa93fc509624c72d9.Node'SourceInfo'Member msg)
+ decerialize raw = (Node'SourceInfo'Member <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Node'SourceInfo'Member'docComment raw) >>= Classes.decerialize))
+instance (Classes.Marshal Node'SourceInfo'Member) where
+ marshalInto raw_ value_ = case value_ of
+ Node'SourceInfo'Member{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) docComment) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Node'SourceInfo'Member'docComment raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Node'SourceInfo'Member)
+instance (Classes.Cerialize (V.Vector Node'SourceInfo'Member)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Node'SourceInfo'Member))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Node'SourceInfo'Member)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Field
+ = Field
+ {name :: T.Text
+ ,codeOrder :: Std_.Word16
+ ,annotations :: (V.Vector Annotation)
+ ,discriminantValue :: Std_.Word16
+ ,ordinal :: Field'ordinal
+ ,union' :: Field'}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Field) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Field) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Field) where
+ type Cerial msg Field = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
+ decerialize raw = (Field <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'name raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'codeOrder raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'annotations raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'discriminantValue raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal raw) >>= Classes.decerialize)
+ <*> (Classes.decerialize raw))
+instance (Classes.Marshal Field) where
+ marshalInto raw_ value_ = case value_ of
+ Field{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'name raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'codeOrder raw_ codeOrder)
+ ((Classes.cerialize (Untyped.message raw_) annotations) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'annotations raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'discriminantValue raw_ discriminantValue)
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal raw_)
+ (Classes.marshalInto raw_ ordinal)
+ )
+ (do
+ (Classes.marshalInto raw_ union')
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Field)
+instance (Classes.Cerialize (V.Vector Field)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Field))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Field)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Field))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Field)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Field'
+ = Field'slot Field'slot
+ | Field'group Field'group
+ | Field'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Field') where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Field') where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Field') where
+ type Cerial msg Field' = (Capnp.Gen.ById.Xa93fc509624c72d9.Field msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'slot raw) ->
+ (Field'slot <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'group raw) ->
+ (Field'group <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'unknown' tag) ->
+ (Std_.pure (Field'unknown' tag))
+ )
+instance (Classes.Marshal Field') where
+ marshalInto raw_ value_ = case value_ of
+ (Field'slot arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Field'group arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Field'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'unknown' raw_ tag)
+data Field'slot
+ = Field'slot'
+ {offset :: Std_.Word32
+ ,type_ :: Type
+ ,defaultValue :: Value
+ ,hadExplicitDefault :: Std_.Bool}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Field'slot) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Field'slot) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Field'slot) where
+ type Cerial msg Field'slot = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'slot msg)
+ decerialize raw = (Field'slot' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'offset raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'type_ raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'defaultValue raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'slot'hadExplicitDefault raw))
+instance (Classes.Marshal Field'slot) where
+ marshalInto raw_ value_ = case value_ of
+ Field'slot'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'offset raw_ offset)
+ ((Classes.cerialize (Untyped.message raw_) type_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'type_ raw_))
+ ((Classes.cerialize (Untyped.message raw_) defaultValue) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'defaultValue raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'slot'hadExplicitDefault raw_ hadExplicitDefault)
+ (Std_.pure ())
+ )
+data Field'group
+ = Field'group'
+ {typeId :: Std_.Word64}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Field'group) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Field'group) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Field'group) where
+ type Cerial msg Field'group = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'group msg)
+ decerialize raw = (Field'group' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'group'typeId raw))
+instance (Classes.Marshal Field'group) where
+ marshalInto raw_ value_ = case value_ of
+ Field'group'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'group'typeId raw_ typeId)
+ (Std_.pure ())
+ )
+data Field'ordinal
+ = Field'ordinal'implicit
+ | Field'ordinal'explicit Std_.Word16
+ | Field'ordinal'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Field'ordinal) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Field'ordinal) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Field'ordinal) where
+ type Cerial msg Field'ordinal = (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Field'ordinal' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'implicit) ->
+ (Std_.pure Field'ordinal'implicit)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'explicit raw) ->
+ (Std_.pure (Field'ordinal'explicit raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Field'ordinal'unknown' tag) ->
+ (Std_.pure (Field'ordinal'unknown' tag))
+ )
+instance (Classes.Marshal Field'ordinal) where
+ marshalInto raw_ value_ = case value_ of
+ (Field'ordinal'implicit) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'implicit raw_)
+ (Field'ordinal'explicit arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'explicit raw_ arg_)
+ (Field'ordinal'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Field'ordinal'unknown' raw_ tag)
+data Enumerant
+ = Enumerant
+ {name :: T.Text
+ ,codeOrder :: Std_.Word16
+ ,annotations :: (V.Vector Annotation)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Enumerant) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Enumerant) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Enumerant) where
+ type Cerial msg Enumerant = (Capnp.Gen.ById.Xa93fc509624c72d9.Enumerant msg)
+ decerialize raw = (Enumerant <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'name raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'codeOrder raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Enumerant'annotations raw) >>= Classes.decerialize))
+instance (Classes.Marshal Enumerant) where
+ marshalInto raw_ value_ = case value_ of
+ Enumerant{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'name raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'codeOrder raw_ codeOrder)
+ ((Classes.cerialize (Untyped.message raw_) annotations) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Enumerant'annotations raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Enumerant)
+instance (Classes.Cerialize (V.Vector Enumerant)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Enumerant))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Enumerant)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Enumerant))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Enumerant)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Superclass
+ = Superclass
+ {id :: Std_.Word64
+ ,brand :: Brand}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Superclass) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Superclass) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Superclass) where
+ type Cerial msg Superclass = (Capnp.Gen.ById.Xa93fc509624c72d9.Superclass msg)
+ decerialize raw = (Superclass <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Superclass'brand raw) >>= Classes.decerialize))
+instance (Classes.Marshal Superclass) where
+ marshalInto raw_ value_ = case value_ of
+ Superclass{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) brand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Superclass'brand raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Superclass)
+instance (Classes.Cerialize (V.Vector Superclass)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Superclass))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Superclass)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Superclass))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Superclass)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Method
+ = Method
+ {name :: T.Text
+ ,codeOrder :: Std_.Word16
+ ,paramStructType :: Std_.Word64
+ ,resultStructType :: Std_.Word64
+ ,annotations :: (V.Vector Annotation)
+ ,paramBrand :: Brand
+ ,resultBrand :: Brand
+ ,implicitParameters :: (V.Vector Node'Parameter)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Method) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Method) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Method) where
+ type Cerial msg Method = (Capnp.Gen.ById.Xa93fc509624c72d9.Method msg)
+ decerialize raw = (Method <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'name raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'codeOrder raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramStructType raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultStructType raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'annotations raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'paramBrand raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'resultBrand raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Method'implicitParameters raw) >>= Classes.decerialize))
+instance (Classes.Marshal Method) where
+ marshalInto raw_ value_ = case value_ of
+ Method{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'name raw_))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'codeOrder raw_ codeOrder)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramStructType raw_ paramStructType)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultStructType raw_ resultStructType)
+ ((Classes.cerialize (Untyped.message raw_) annotations) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'annotations raw_))
+ ((Classes.cerialize (Untyped.message raw_) paramBrand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'paramBrand raw_))
+ ((Classes.cerialize (Untyped.message raw_) resultBrand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'resultBrand raw_))
+ ((Classes.cerialize (Untyped.message raw_) implicitParameters) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Method'implicitParameters raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Method)
+instance (Classes.Cerialize (V.Vector Method)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Method))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Method)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Method))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Method)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+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 Type'list
+ | Type'enum Type'enum
+ | Type'struct Type'struct
+ | Type'interface Type'interface
+ | Type'anyPointer Type'anyPointer
+ | Type'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type) where
+ type Cerial msg Type = (Capnp.Gen.ById.Xa93fc509624c72d9.Type msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'void) ->
+ (Std_.pure Type'void)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'bool) ->
+ (Std_.pure Type'bool)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'int8) ->
+ (Std_.pure Type'int8)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'int16) ->
+ (Std_.pure Type'int16)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'int32) ->
+ (Std_.pure Type'int32)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'int64) ->
+ (Std_.pure Type'int64)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint8) ->
+ (Std_.pure Type'uint8)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint16) ->
+ (Std_.pure Type'uint16)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint32) ->
+ (Std_.pure Type'uint32)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'uint64) ->
+ (Std_.pure Type'uint64)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'float32) ->
+ (Std_.pure Type'float32)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'float64) ->
+ (Std_.pure Type'float64)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'text) ->
+ (Std_.pure Type'text)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'data_) ->
+ (Std_.pure Type'data_)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'list raw) ->
+ (Type'list <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'enum raw) ->
+ (Type'enum <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'struct raw) ->
+ (Type'struct <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'interface raw) ->
+ (Type'interface <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer raw) ->
+ (Type'anyPointer <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'unknown' tag) ->
+ (Std_.pure (Type'unknown' tag))
+ )
+instance (Classes.Marshal Type) where
+ marshalInto raw_ value_ = case value_ of
+ (Type'void) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'void raw_)
+ (Type'bool) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'bool raw_)
+ (Type'int8) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int8 raw_)
+ (Type'int16) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int16 raw_)
+ (Type'int32) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int32 raw_)
+ (Type'int64) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'int64 raw_)
+ (Type'uint8) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint8 raw_)
+ (Type'uint16) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint16 raw_)
+ (Type'uint32) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint32 raw_)
+ (Type'uint64) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'uint64 raw_)
+ (Type'float32) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float32 raw_)
+ (Type'float64) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'float64 raw_)
+ (Type'text) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'text raw_)
+ (Type'data_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'data_ raw_)
+ (Type'list arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'enum arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'struct arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'interface arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'anyPointer arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'unknown' raw_ tag)
+instance (Classes.Cerialize Type)
+instance (Classes.Cerialize (V.Vector Type)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Type))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Type)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Type))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Type)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Type'list
+ = Type'list'
+ {elementType :: Type}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'list) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'list) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'list) where
+ type Cerial msg Type'list = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'list msg)
+ decerialize raw = (Type'list' <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'list'elementType raw) >>= Classes.decerialize))
+instance (Classes.Marshal Type'list) where
+ marshalInto raw_ value_ = case value_ of
+ Type'list'{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) elementType) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'list'elementType raw_))
+ (Std_.pure ())
+ )
+data Type'enum
+ = Type'enum'
+ {typeId :: Std_.Word64
+ ,brand :: Brand}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'enum) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'enum) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'enum) where
+ type Cerial msg Type'enum = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'enum msg)
+ decerialize raw = (Type'enum' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'typeId raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'enum'brand raw) >>= Classes.decerialize))
+instance (Classes.Marshal Type'enum) where
+ marshalInto raw_ value_ = case value_ of
+ Type'enum'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'typeId raw_ typeId)
+ ((Classes.cerialize (Untyped.message raw_) brand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'enum'brand raw_))
+ (Std_.pure ())
+ )
+data Type'struct
+ = Type'struct'
+ {typeId :: Std_.Word64
+ ,brand :: Brand}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'struct) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'struct) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'struct) where
+ type Cerial msg Type'struct = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'struct msg)
+ decerialize raw = (Type'struct' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'typeId raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'struct'brand raw) >>= Classes.decerialize))
+instance (Classes.Marshal Type'struct) where
+ marshalInto raw_ value_ = case value_ of
+ Type'struct'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'typeId raw_ typeId)
+ ((Classes.cerialize (Untyped.message raw_) brand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'struct'brand raw_))
+ (Std_.pure ())
+ )
+data Type'interface
+ = Type'interface'
+ {typeId :: Std_.Word64
+ ,brand :: Brand}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'interface) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'interface) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'interface) where
+ type Cerial msg Type'interface = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'interface msg)
+ decerialize raw = (Type'interface' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'typeId raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'interface'brand raw) >>= Classes.decerialize))
+instance (Classes.Marshal Type'interface) where
+ marshalInto raw_ value_ = case value_ of
+ Type'interface'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'typeId raw_ typeId)
+ ((Classes.cerialize (Untyped.message raw_) brand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'interface'brand raw_))
+ (Std_.pure ())
+ )
+data Type'anyPointer
+ = Type'anyPointer'unconstrained Type'anyPointer'unconstrained
+ | Type'anyPointer'parameter Type'anyPointer'parameter
+ | Type'anyPointer'implicitMethodParameter Type'anyPointer'implicitMethodParameter
+ | Type'anyPointer'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'anyPointer) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'anyPointer) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'anyPointer) where
+ type Cerial msg Type'anyPointer = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained raw) ->
+ (Type'anyPointer'unconstrained <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'parameter raw) ->
+ (Type'anyPointer'parameter <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter raw) ->
+ (Type'anyPointer'implicitMethodParameter <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unknown' tag) ->
+ (Std_.pure (Type'anyPointer'unknown' tag))
+ )
+instance (Classes.Marshal Type'anyPointer) where
+ marshalInto raw_ value_ = case value_ of
+ (Type'anyPointer'unconstrained arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'anyPointer'parameter arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'anyPointer'implicitMethodParameter arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Type'anyPointer'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unknown' raw_ tag)
+data Type'anyPointer'unconstrained
+ = Type'anyPointer'unconstrained'anyKind
+ | Type'anyPointer'unconstrained'struct
+ | Type'anyPointer'unconstrained'list
+ | Type'anyPointer'unconstrained'capability
+ | Type'anyPointer'unconstrained'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'anyPointer'unconstrained) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'anyPointer'unconstrained) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'anyPointer'unconstrained) where
+ type Cerial msg Type'anyPointer'unconstrained = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'unconstrained' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'anyKind) ->
+ (Std_.pure Type'anyPointer'unconstrained'anyKind)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'struct) ->
+ (Std_.pure Type'anyPointer'unconstrained'struct)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'list) ->
+ (Std_.pure Type'anyPointer'unconstrained'list)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'capability) ->
+ (Std_.pure Type'anyPointer'unconstrained'capability)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained'unknown' tag) ->
+ (Std_.pure (Type'anyPointer'unconstrained'unknown' tag))
+ )
+instance (Classes.Marshal Type'anyPointer'unconstrained) where
+ marshalInto raw_ value_ = case value_ of
+ (Type'anyPointer'unconstrained'anyKind) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'anyKind raw_)
+ (Type'anyPointer'unconstrained'struct) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'struct raw_)
+ (Type'anyPointer'unconstrained'list) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'list raw_)
+ (Type'anyPointer'unconstrained'capability) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'capability raw_)
+ (Type'anyPointer'unconstrained'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'unconstrained'unknown' raw_ tag)
+data Type'anyPointer'parameter
+ = Type'anyPointer'parameter'
+ {scopeId :: Std_.Word64
+ ,parameterIndex :: Std_.Word16}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'anyPointer'parameter) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'anyPointer'parameter) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'anyPointer'parameter) where
+ type Cerial msg Type'anyPointer'parameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'parameter msg)
+ decerialize raw = (Type'anyPointer'parameter' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'scopeId raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'parameter'parameterIndex raw))
+instance (Classes.Marshal Type'anyPointer'parameter) where
+ marshalInto raw_ value_ = case value_ of
+ Type'anyPointer'parameter'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'scopeId raw_ scopeId)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'parameter'parameterIndex raw_ parameterIndex)
+ (Std_.pure ())
+ )
+data Type'anyPointer'implicitMethodParameter
+ = Type'anyPointer'implicitMethodParameter'
+ {parameterIndex :: Std_.Word16}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Type'anyPointer'implicitMethodParameter) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Type'anyPointer'implicitMethodParameter) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Type'anyPointer'implicitMethodParameter) where
+ type Cerial msg Type'anyPointer'implicitMethodParameter = (Capnp.Gen.ById.Xa93fc509624c72d9.Type'anyPointer'implicitMethodParameter msg)
+ decerialize raw = (Type'anyPointer'implicitMethodParameter' <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Type'anyPointer'implicitMethodParameter'parameterIndex raw))
+instance (Classes.Marshal Type'anyPointer'implicitMethodParameter) where
+ marshalInto raw_ value_ = case value_ of
+ Type'anyPointer'implicitMethodParameter'{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Type'anyPointer'implicitMethodParameter'parameterIndex raw_ parameterIndex)
+ (Std_.pure ())
+ )
+data Brand
+ = Brand
+ {scopes :: (V.Vector Brand'Scope)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Brand) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Brand) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Brand) where
+ type Cerial msg Brand = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand msg)
+ decerialize raw = (Brand <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'scopes raw) >>= Classes.decerialize))
+instance (Classes.Marshal Brand) where
+ marshalInto raw_ value_ = case value_ of
+ Brand{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) scopes) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'scopes raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Brand)
+instance (Classes.Cerialize (V.Vector Brand)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Brand))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Brand)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Brand))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Brand'Scope
+ = Brand'Scope
+ {scopeId :: Std_.Word64
+ ,union' :: Brand'Scope'}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Brand'Scope) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Brand'Scope) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Brand'Scope) where
+ type Cerial msg Brand'Scope = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope msg)
+ decerialize raw = (Brand'Scope <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope'scopeId raw)
+ <*> (Classes.decerialize raw))
+instance (Classes.Marshal Brand'Scope) where
+ marshalInto raw_ value_ = case value_ of
+ Brand'Scope{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'scopeId raw_ scopeId)
+ (do
+ (Classes.marshalInto raw_ union')
+ )
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Brand'Scope)
+instance (Classes.Cerialize (V.Vector Brand'Scope)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Brand'Scope))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Brand'Scope)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Scope)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Brand'Scope'
+ = Brand'Scope'bind (V.Vector Brand'Binding)
+ | Brand'Scope'inherit
+ | Brand'Scope'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Brand'Scope') where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Brand'Scope') where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Brand'Scope') where
+ type Cerial msg Brand'Scope' = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Scope' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'bind raw) ->
+ (Brand'Scope'bind <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'inherit) ->
+ (Std_.pure Brand'Scope'inherit)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Scope'unknown' tag) ->
+ (Std_.pure (Brand'Scope'unknown' tag))
+ )
+instance (Classes.Marshal Brand'Scope') where
+ marshalInto raw_ value_ = case value_ of
+ (Brand'Scope'bind arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'bind raw_))
+ (Brand'Scope'inherit) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'inherit raw_)
+ (Brand'Scope'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Scope'unknown' raw_ tag)
+data Brand'Binding
+ = Brand'Binding'unbound
+ | Brand'Binding'type_ Type
+ | Brand'Binding'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Brand'Binding) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Brand'Binding) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Brand'Binding) where
+ type Cerial msg Brand'Binding = (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Brand'Binding' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'unbound) ->
+ (Std_.pure Brand'Binding'unbound)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'type_ raw) ->
+ (Brand'Binding'type_ <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Brand'Binding'unknown' tag) ->
+ (Std_.pure (Brand'Binding'unknown' tag))
+ )
+instance (Classes.Marshal Brand'Binding) where
+ marshalInto raw_ value_ = case value_ of
+ (Brand'Binding'unbound) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unbound raw_)
+ (Brand'Binding'type_ arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'type_ raw_))
+ (Brand'Binding'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Brand'Binding'unknown' raw_ tag)
+instance (Classes.Cerialize Brand'Binding)
+instance (Classes.Cerialize (V.Vector Brand'Binding)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Brand'Binding))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Brand'Binding)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Brand'Binding)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Value
+ = Value'void
+ | Value'bool Std_.Bool
+ | Value'int8 Std_.Int8
+ | Value'int16 Std_.Int16
+ | Value'int32 Std_.Int32
+ | Value'int64 Std_.Int64
+ | Value'uint8 Std_.Word8
+ | Value'uint16 Std_.Word16
+ | Value'uint32 Std_.Word32
+ | Value'uint64 Std_.Word64
+ | Value'float32 Std_.Float
+ | Value'float64 Std_.Double
+ | Value'text T.Text
+ | Value'data_ BS.ByteString
+ | Value'list (Std_.Maybe UntypedPure.Ptr)
+ | Value'enum Std_.Word16
+ | Value'struct (Std_.Maybe UntypedPure.Ptr)
+ | Value'interface
+ | Value'anyPointer (Std_.Maybe UntypedPure.Ptr)
+ | Value'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Value) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Value) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Value) where
+ type Cerial msg Value = (Capnp.Gen.ById.Xa93fc509624c72d9.Value msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.Xa93fc509624c72d9.get_Value' raw)
+ case raw of
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'void) ->
+ (Std_.pure Value'void)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'bool raw) ->
+ (Std_.pure (Value'bool raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int8 raw) ->
+ (Std_.pure (Value'int8 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int16 raw) ->
+ (Std_.pure (Value'int16 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int32 raw) ->
+ (Std_.pure (Value'int32 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'int64 raw) ->
+ (Std_.pure (Value'int64 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint8 raw) ->
+ (Std_.pure (Value'uint8 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint16 raw) ->
+ (Std_.pure (Value'uint16 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint32 raw) ->
+ (Std_.pure (Value'uint32 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'uint64 raw) ->
+ (Std_.pure (Value'uint64 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'float32 raw) ->
+ (Std_.pure (Value'float32 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'float64 raw) ->
+ (Std_.pure (Value'float64 raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'text raw) ->
+ (Value'text <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'data_ raw) ->
+ (Value'data_ <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'list raw) ->
+ (Value'list <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'enum raw) ->
+ (Std_.pure (Value'enum raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'struct raw) ->
+ (Value'struct <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'interface) ->
+ (Std_.pure Value'interface)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'anyPointer raw) ->
+ (Value'anyPointer <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.Xa93fc509624c72d9.Value'unknown' tag) ->
+ (Std_.pure (Value'unknown' tag))
+ )
+instance (Classes.Marshal Value) where
+ marshalInto raw_ value_ = case value_ of
+ (Value'void) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'void raw_)
+ (Value'bool arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'bool raw_ arg_)
+ (Value'int8 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int8 raw_ arg_)
+ (Value'int16 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int16 raw_ arg_)
+ (Value'int32 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int32 raw_ arg_)
+ (Value'int64 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'int64 raw_ arg_)
+ (Value'uint8 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint8 raw_ arg_)
+ (Value'uint16 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint16 raw_ arg_)
+ (Value'uint32 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint32 raw_ arg_)
+ (Value'uint64 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'uint64 raw_ arg_)
+ (Value'float32 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float32 raw_ arg_)
+ (Value'float64 arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'float64 raw_ arg_)
+ (Value'text arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'text raw_))
+ (Value'data_ arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'data_ raw_))
+ (Value'list arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'list raw_))
+ (Value'enum arg_) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'enum raw_ arg_)
+ (Value'struct arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'struct raw_))
+ (Value'interface) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'interface raw_)
+ (Value'anyPointer arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'anyPointer raw_))
+ (Value'unknown' tag) ->
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Value'unknown' raw_ tag)
+instance (Classes.Cerialize Value)
+instance (Classes.Cerialize (V.Vector Value)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Value))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Value)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Value))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Value)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Annotation
+ = Annotation
+ {id :: Std_.Word64
+ ,value :: Value
+ ,brand :: Brand}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Annotation) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Annotation) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Annotation) where
+ type Cerial msg Annotation = (Capnp.Gen.ById.Xa93fc509624c72d9.Annotation msg)
+ decerialize raw = (Annotation <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'value raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_Annotation'brand raw) >>= Classes.decerialize))
+instance (Classes.Marshal Annotation) where
+ marshalInto raw_ value_ = case value_ of
+ Annotation{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) value) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'value raw_))
+ ((Classes.cerialize (Untyped.message raw_) brand) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_Annotation'brand raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Annotation)
+instance (Classes.Cerialize (V.Vector Annotation)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Annotation))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Annotation)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Annotation))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Annotation)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CapnpVersion
+ = CapnpVersion
+ {major :: Std_.Word16
+ ,minor :: Std_.Word8
+ ,micro :: Std_.Word8}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CapnpVersion) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CapnpVersion) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CapnpVersion) where
+ type Cerial msg CapnpVersion = (Capnp.Gen.ById.Xa93fc509624c72d9.CapnpVersion msg)
+ decerialize raw = (CapnpVersion <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'major raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'minor raw)
+ <*> (Capnp.Gen.ById.Xa93fc509624c72d9.get_CapnpVersion'micro raw))
+instance (Classes.Marshal CapnpVersion) where
+ marshalInto raw_ value_ = case value_ of
+ CapnpVersion{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'major raw_ major)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'minor raw_ minor)
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_CapnpVersion'micro raw_ micro)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CapnpVersion)
+instance (Classes.Cerialize (V.Vector CapnpVersion)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CapnpVersion))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CapnpVersion)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CapnpVersion)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CodeGeneratorRequest
+ = CodeGeneratorRequest
+ {nodes :: (V.Vector Node)
+ ,requestedFiles :: (V.Vector CodeGeneratorRequest'RequestedFile)
+ ,capnpVersion :: CapnpVersion
+ ,sourceInfo :: (V.Vector Node'SourceInfo)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CodeGeneratorRequest) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CodeGeneratorRequest) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CodeGeneratorRequest) where
+ type Cerial msg CodeGeneratorRequest = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest msg)
+ decerialize raw = (CodeGeneratorRequest <$> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'nodes raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'requestedFiles raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'capnpVersion raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'sourceInfo raw) >>= Classes.decerialize))
+instance (Classes.Marshal CodeGeneratorRequest) where
+ marshalInto raw_ value_ = case value_ of
+ CodeGeneratorRequest{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) nodes) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'nodes raw_))
+ ((Classes.cerialize (Untyped.message raw_) requestedFiles) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'requestedFiles raw_))
+ ((Classes.cerialize (Untyped.message raw_) capnpVersion) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'capnpVersion raw_))
+ ((Classes.cerialize (Untyped.message raw_) sourceInfo) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'sourceInfo raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CodeGeneratorRequest)
+instance (Classes.Cerialize (V.Vector CodeGeneratorRequest)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CodeGeneratorRequest))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CodeGeneratorRequest'RequestedFile
+ = CodeGeneratorRequest'RequestedFile
+ {id :: Std_.Word64
+ ,filename :: T.Text
+ ,imports :: (V.Vector CodeGeneratorRequest'RequestedFile'Import)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CodeGeneratorRequest'RequestedFile) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CodeGeneratorRequest'RequestedFile) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CodeGeneratorRequest'RequestedFile) where
+ type Cerial msg CodeGeneratorRequest'RequestedFile = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile msg)
+ decerialize raw = (CodeGeneratorRequest'RequestedFile <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'filename raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'imports raw) >>= Classes.decerialize))
+instance (Classes.Marshal CodeGeneratorRequest'RequestedFile) where
+ marshalInto raw_ value_ = case value_ of
+ CodeGeneratorRequest'RequestedFile{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) filename) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'filename raw_))
+ ((Classes.cerialize (Untyped.message raw_) imports) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'imports raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CodeGeneratorRequest'RequestedFile)
+instance (Classes.Cerialize (V.Vector CodeGeneratorRequest'RequestedFile)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CodeGeneratorRequest'RequestedFile'Import
+ = CodeGeneratorRequest'RequestedFile'Import
+ {id :: Std_.Word64
+ ,name :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CodeGeneratorRequest'RequestedFile'Import) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CodeGeneratorRequest'RequestedFile'Import) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CodeGeneratorRequest'RequestedFile'Import) where
+ type Cerial msg CodeGeneratorRequest'RequestedFile'Import = (Capnp.Gen.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import msg)
+ decerialize raw = (CodeGeneratorRequest'RequestedFile'Import <$> (Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'id raw)
+ <*> ((Capnp.Gen.ById.Xa93fc509624c72d9.get_CodeGeneratorRequest'RequestedFile'Import'name raw) >>= Classes.decerialize))
+instance (Classes.Marshal CodeGeneratorRequest'RequestedFile'Import) where
+ marshalInto raw_ value_ = case value_ of
+ CodeGeneratorRequest'RequestedFile'Import{..} ->
+ (do
+ (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'id raw_ id)
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.Xa93fc509624c72d9.set_CodeGeneratorRequest'RequestedFile'Import'name raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CodeGeneratorRequest'RequestedFile'Import)
+instance (Classes.Cerialize (V.Vector CodeGeneratorRequest'RequestedFile'Import)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CodeGeneratorRequest'RequestedFile'Import)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Decerialize Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize) where
+ type Cerial msg Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize = Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize
+ decerialize = Std_.pure
+instance (Classes.Cerialize Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize) where
+ cerialize _ = Std_.pure
+instance (Classes.Cerialize (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize)))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.Xa93fc509624c72d9.ElementSize))))))) where
+ cerialize = Classes.cerializeBasicVec
diff --git a/gen/lib/Internal/Gen/Instances.hs b/gen/lib/Internal/Gen/Instances.hs
new file mode 100644
--- /dev/null
+++ b/gen/lib/Internal/Gen/Instances.hs
@@ -0,0 +1,308 @@
+{-# 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 Capnp.Classes
+ ( ListElem(..)
+ , MutListElem(..)
+ , FromPtr(..)
+ , Decerialize(..)
+ , Cerialize(..)
+ , cerializeBasicVec
+ )
+
+import qualified Capnp.Untyped as U
+import qualified Data.Vector as V
+
+instance ListElem msg Int8 where
+ newtype List msg Int8 = ListInt8 (U.ListOf msg Word8)
+ listFromPtr msg ptr = ListInt8 <$> fromPtr msg ptr
+ toUntypedList (ListInt8 l) = U.List8 l
+ 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 Decerialize Int8 where
+ type Cerial msg Int8 = Int8
+ decerialize val = pure val
+instance Cerialize Int8 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Int8) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Int8)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Int8))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Int8)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int8))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int8)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Int16 where
+ newtype List msg Int16 = ListInt16 (U.ListOf msg Word16)
+ listFromPtr msg ptr = ListInt16 <$> fromPtr msg ptr
+ toUntypedList (ListInt16 l) = U.List16 l
+ 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 Decerialize Int16 where
+ type Cerial msg Int16 = Int16
+ decerialize val = pure val
+instance Cerialize Int16 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Int16) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Int16)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Int16))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Int16)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int16))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int16)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Int32 where
+ newtype List msg Int32 = ListInt32 (U.ListOf msg Word32)
+ listFromPtr msg ptr = ListInt32 <$> fromPtr msg ptr
+ toUntypedList (ListInt32 l) = U.List32 l
+ 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 Decerialize Int32 where
+ type Cerial msg Int32 = Int32
+ decerialize val = pure val
+instance Cerialize Int32 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Int32) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Int32)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Int32))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Int32)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int32))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int32)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Int64 where
+ newtype List msg Int64 = ListInt64 (U.ListOf msg Word64)
+ listFromPtr msg ptr = ListInt64 <$> fromPtr msg ptr
+ toUntypedList (ListInt64 l) = U.List64 l
+ 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 Decerialize Int64 where
+ type Cerial msg Int64 = Int64
+ decerialize val = pure val
+instance Cerialize Int64 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Int64) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Int64)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Int64))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Int64)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int64))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Int64)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Word8 where
+ newtype List msg Word8 = ListWord8 (U.ListOf msg Word8)
+ listFromPtr msg ptr = ListWord8 <$> fromPtr msg ptr
+ toUntypedList (ListWord8 l) = U.List8 l
+ 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 Decerialize Word8 where
+ type Cerial msg Word8 = Word8
+ decerialize val = pure val
+instance Cerialize Word8 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Word8) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Word8)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Word8))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Word8)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word8))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word8)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Word16 where
+ newtype List msg Word16 = ListWord16 (U.ListOf msg Word16)
+ listFromPtr msg ptr = ListWord16 <$> fromPtr msg ptr
+ toUntypedList (ListWord16 l) = U.List16 l
+ 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 Decerialize Word16 where
+ type Cerial msg Word16 = Word16
+ decerialize val = pure val
+instance Cerialize Word16 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Word16) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Word16)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Word16))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Word16)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word16))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word16)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Word32 where
+ newtype List msg Word32 = ListWord32 (U.ListOf msg Word32)
+ listFromPtr msg ptr = ListWord32 <$> fromPtr msg ptr
+ toUntypedList (ListWord32 l) = U.List32 l
+ 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 Decerialize Word32 where
+ type Cerial msg Word32 = Word32
+ decerialize val = pure val
+instance Cerialize Word32 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Word32) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Word32)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Word32))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Word32)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word32))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word32)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Word64 where
+ newtype List msg Word64 = ListWord64 (U.ListOf msg Word64)
+ listFromPtr msg ptr = ListWord64 <$> fromPtr msg ptr
+ toUntypedList (ListWord64 l) = U.List64 l
+ 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 Decerialize Word64 where
+ type Cerial msg Word64 = Word64
+ decerialize val = pure val
+instance Cerialize Word64 where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Word64) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Word64)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Word64))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Word64)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word64))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Word64)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Float where
+ newtype List msg Float = ListFloat (U.ListOf msg Word32)
+ listFromPtr msg ptr = ListFloat <$> fromPtr msg ptr
+ toUntypedList (ListFloat l) = U.List32 l
+ 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 Decerialize Float where
+ type Cerial msg Float = Float
+ decerialize val = pure val
+instance Cerialize Float where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Float) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Float)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Float))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Float)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Float))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Float)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Double where
+ newtype List msg Double = ListDouble (U.ListOf msg Word64)
+ listFromPtr msg ptr = ListDouble <$> fromPtr msg ptr
+ toUntypedList (ListDouble l) = U.List64 l
+ 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 Decerialize Double where
+ type Cerial msg Double = Double
+ decerialize val = pure val
+instance Cerialize Double where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Double) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Double)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Double))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Double)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Double))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Double)))))) where
+ cerialize = cerializeBasicVec
+instance ListElem msg Bool where
+ newtype List msg Bool = ListBool (U.ListOf msg Bool)
+ listFromPtr msg ptr = ListBool <$> fromPtr msg ptr
+ toUntypedList (ListBool l) = U.List1 l
+ 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 Decerialize Bool where
+ type Cerial msg Bool = Bool
+ decerialize val = pure val
+instance Cerialize Bool where
+ cerialize _ val = pure val
+instance Cerialize (V.Vector Bool) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Bool)) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Bool))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Bool)))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bool))))) where
+ cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bool)))))) where
+ cerialize = cerializeBasicVec
diff --git a/gen/tests/Capnp/Gen/Aircraft.hs b/gen/tests/Capnp/Gen/Aircraft.hs
new file mode 100644
--- /dev/null
+++ b/gen/tests/Capnp/Gen/Aircraft.hs
@@ -0,0 +1,3754 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Aircraft where
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Basics as Basics
+import qualified Capnp.GenHelpers as GenHelpers
+import qualified Capnp.Classes as Classes
+import qualified GHC.Generics as Generics
+import qualified Capnp.Bits as Std_
+import qualified Data.Maybe as Std_
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+constDate :: (Zdate Message.ConstMsg)
+constDate = (GenHelpers.getPtrConst ("\NUL\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\223\a\b\ESC\NUL\NUL\NUL\NUL" :: BS.ByteString))
+constList :: (Basics.List Message.ConstMsg (Zdate Message.ConstMsg))
+constList = (GenHelpers.getPtrConst ("\NUL\NUL\NUL\NUL\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\SOH\NUL\NUL\NUL\ETB\NUL\NUL\NUL\b\NUL\NUL\NUL\SOH\NUL\NUL\NUL\223\a\b\ESC\NUL\NUL\NUL\NUL\223\a\b\FS\NUL\NUL\NUL\NUL" :: BS.ByteString))
+constEnum :: Airport
+constEnum = (Classes.fromWord 1)
+newtype Zdate msg
+ = Zdate'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Zdate) where
+ tMsg f (Zdate'newtype_ s) = (Zdate'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Zdate msg)) where
+ fromStruct struct = (Std_.pure (Zdate'newtype_ struct))
+instance (Classes.ToStruct msg (Zdate msg)) where
+ toStruct (Zdate'newtype_ struct) = struct
+instance (Untyped.HasMessage (Zdate msg)) where
+ type InMessage (Zdate msg) = msg
+ message (Zdate'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Zdate msg)) where
+ messageDefault msg = (Zdate'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Zdate msg)) where
+ fromPtr msg ptr = (Zdate'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Zdate (Message.MutMsg s))) where
+ toPtr msg (Zdate'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Zdate (Message.MutMsg s))) where
+ new msg = (Zdate'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (Zdate msg)) where
+ newtype List msg (Zdate msg)
+ = Zdate'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Zdate'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Zdate'List_ l) = (Untyped.ListStruct l)
+ length (Zdate'List_ l) = (Untyped.length l)
+ index i (Zdate'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Zdate (Message.MutMsg s))) where
+ setIndex (Zdate'newtype_ elt) i (Zdate'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Zdate'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_Zdate'year :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Int16)
+get_Zdate'year (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Zdate'year :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_Zdate'year (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_Zdate'month :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Word8)
+get_Zdate'month (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 16 0)
+set_Zdate'month :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_Zdate'month (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 16 0)
+get_Zdate'day :: ((Untyped.ReadCtx m msg)) => (Zdate msg) -> (m Std_.Word8)
+get_Zdate'day (Zdate'newtype_ struct) = (GenHelpers.getWordField struct 0 24 0)
+set_Zdate'day :: ((Untyped.RWCtx m s)) => (Zdate (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_Zdate'day (Zdate'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 0 24 0)
+newtype Zdata msg
+ = Zdata'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Zdata) where
+ tMsg f (Zdata'newtype_ s) = (Zdata'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Zdata msg)) where
+ fromStruct struct = (Std_.pure (Zdata'newtype_ struct))
+instance (Classes.ToStruct msg (Zdata msg)) where
+ toStruct (Zdata'newtype_ struct) = struct
+instance (Untyped.HasMessage (Zdata msg)) where
+ type InMessage (Zdata msg) = msg
+ message (Zdata'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Zdata msg)) where
+ messageDefault msg = (Zdata'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Zdata msg)) where
+ fromPtr msg ptr = (Zdata'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Zdata (Message.MutMsg s))) where
+ toPtr msg (Zdata'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Zdata (Message.MutMsg s))) where
+ new msg = (Zdata'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Zdata msg)) where
+ newtype List msg (Zdata msg)
+ = Zdata'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Zdata'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Zdata'List_ l) = (Untyped.ListStruct l)
+ length (Zdata'List_ l) = (Untyped.length l)
+ index i (Zdata'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Zdata (Message.MutMsg s))) where
+ setIndex (Zdata'newtype_ elt) i (Zdata'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Zdata'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Zdata'data_ :: ((Untyped.ReadCtx m msg)) => (Zdata msg) -> (m (Basics.Data msg))
+get_Zdata'data_ (Zdata'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Zdata'data_ :: ((Untyped.RWCtx m s)) => (Zdata (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
+set_Zdata'data_ (Zdata'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Zdata'data_ :: ((Untyped.ReadCtx m msg)) => (Zdata msg) -> (m Std_.Bool)
+has_Zdata'data_ (Zdata'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Zdata'data_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zdata (Message.MutMsg s)) -> (m (Basics.Data (Message.MutMsg s)))
+new_Zdata'data_ len struct = (do
+ result <- (Basics.newData (Untyped.message struct) len)
+ (set_Zdata'data_ struct result)
+ (Std_.pure result)
+ )
+data Airport
+ = Airport'none
+ | Airport'jfk
+ | Airport'lax
+ | Airport'sfo
+ | Airport'luv
+ | Airport'dfw
+ | Airport'test
+ | Airport'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Read
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Classes.IsWord Airport) where
+ fromWord n = case ((Std_.fromIntegral n) :: Std_.Word16) of
+ 0 ->
+ Airport'none
+ 1 ->
+ Airport'jfk
+ 2 ->
+ Airport'lax
+ 3 ->
+ Airport'sfo
+ 4 ->
+ Airport'luv
+ 5 ->
+ Airport'dfw
+ 6 ->
+ Airport'test
+ tag ->
+ (Airport'unknown' tag)
+ toWord (Airport'none) = 0
+ toWord (Airport'jfk) = 1
+ toWord (Airport'lax) = 2
+ toWord (Airport'sfo) = 3
+ toWord (Airport'luv) = 4
+ toWord (Airport'dfw) = 5
+ toWord (Airport'test) = 6
+ toWord (Airport'unknown' tag) = (Std_.fromIntegral tag)
+instance (Std_.Enum Airport) where
+ fromEnum x = (Std_.fromIntegral (Classes.toWord x))
+ toEnum x = (Classes.fromWord (Std_.fromIntegral x))
+instance (Basics.ListElem msg Airport) where
+ newtype List msg Airport
+ = Airport'List_ (Untyped.ListOf msg Std_.Word16)
+ index i (Airport'List_ l) = (Classes.fromWord <$> (Std_.fromIntegral <$> (Untyped.index i l)))
+ listFromPtr msg ptr = (Airport'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Airport'List_ l) = (Untyped.List16 l)
+ length (Airport'List_ l) = (Untyped.length l)
+instance (Classes.MutListElem s Airport) where
+ setIndex elt i (Airport'List_ l) = (Untyped.setIndex (Std_.fromIntegral (Classes.toWord elt)) i l)
+ newList msg size = (Airport'List_ <$> (Untyped.allocList16 msg size))
+newtype PlaneBase msg
+ = PlaneBase'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg PlaneBase) where
+ tMsg f (PlaneBase'newtype_ s) = (PlaneBase'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (PlaneBase msg)) where
+ fromStruct struct = (Std_.pure (PlaneBase'newtype_ struct))
+instance (Classes.ToStruct msg (PlaneBase msg)) where
+ toStruct (PlaneBase'newtype_ struct) = struct
+instance (Untyped.HasMessage (PlaneBase msg)) where
+ type InMessage (PlaneBase msg) = msg
+ message (PlaneBase'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (PlaneBase msg)) where
+ messageDefault msg = (PlaneBase'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (PlaneBase msg)) where
+ fromPtr msg ptr = (PlaneBase'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (PlaneBase (Message.MutMsg s))) where
+ toPtr msg (PlaneBase'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (PlaneBase (Message.MutMsg s))) where
+ new msg = (PlaneBase'newtype_ <$> (Untyped.allocStruct msg 4 2))
+instance (Basics.ListElem msg (PlaneBase msg)) where
+ newtype List msg (PlaneBase msg)
+ = PlaneBase'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (PlaneBase'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (PlaneBase'List_ l) = (Untyped.ListStruct l)
+ length (PlaneBase'List_ l) = (Untyped.length l)
+ index i (PlaneBase'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (PlaneBase (Message.MutMsg s))) where
+ setIndex (PlaneBase'newtype_ elt) i (PlaneBase'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (PlaneBase'List_ <$> (Untyped.allocCompositeList msg 4 2 len))
+get_PlaneBase'name :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m (Basics.Text msg))
+get_PlaneBase'name (PlaneBase'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_PlaneBase'name :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_PlaneBase'name (PlaneBase'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_PlaneBase'name :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
+has_PlaneBase'name (PlaneBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_PlaneBase'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (PlaneBase (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_PlaneBase'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_PlaneBase'name struct result)
+ (Std_.pure result)
+ )
+get_PlaneBase'homes :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m (Basics.List msg Airport))
+get_PlaneBase'homes (PlaneBase'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_PlaneBase'homes :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Airport) -> (m ())
+set_PlaneBase'homes (PlaneBase'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_PlaneBase'homes :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
+has_PlaneBase'homes (PlaneBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_PlaneBase'homes :: ((Untyped.RWCtx m s)) => Std_.Int -> (PlaneBase (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Airport))
+new_PlaneBase'homes len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_PlaneBase'homes struct result)
+ (Std_.pure result)
+ )
+get_PlaneBase'rating :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Int64)
+get_PlaneBase'rating (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_PlaneBase'rating :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_PlaneBase'rating (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_PlaneBase'canFly :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Bool)
+get_PlaneBase'canFly (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_PlaneBase'canFly :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_PlaneBase'canFly (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 0 0)
+get_PlaneBase'capacity :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Int64)
+get_PlaneBase'capacity (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_PlaneBase'capacity :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_PlaneBase'capacity (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+get_PlaneBase'maxSpeed :: ((Untyped.ReadCtx m msg)) => (PlaneBase msg) -> (m Std_.Double)
+get_PlaneBase'maxSpeed (PlaneBase'newtype_ struct) = (GenHelpers.getWordField struct 3 0 0)
+set_PlaneBase'maxSpeed :: ((Untyped.RWCtx m s)) => (PlaneBase (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_PlaneBase'maxSpeed (PlaneBase'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 3 0 0)
+newtype B737 msg
+ = B737'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg B737) where
+ tMsg f (B737'newtype_ s) = (B737'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (B737 msg)) where
+ fromStruct struct = (Std_.pure (B737'newtype_ struct))
+instance (Classes.ToStruct msg (B737 msg)) where
+ toStruct (B737'newtype_ struct) = struct
+instance (Untyped.HasMessage (B737 msg)) where
+ type InMessage (B737 msg) = msg
+ message (B737'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (B737 msg)) where
+ messageDefault msg = (B737'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (B737 msg)) where
+ fromPtr msg ptr = (B737'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (B737 (Message.MutMsg s))) where
+ toPtr msg (B737'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (B737 (Message.MutMsg s))) where
+ new msg = (B737'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (B737 msg)) where
+ newtype List msg (B737 msg)
+ = B737'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (B737'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (B737'List_ l) = (Untyped.ListStruct l)
+ length (B737'List_ l) = (Untyped.length l)
+ index i (B737'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (B737 (Message.MutMsg s))) where
+ setIndex (B737'newtype_ elt) i (B737'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (B737'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_B737'base :: ((Untyped.ReadCtx m msg)) => (B737 msg) -> (m (PlaneBase msg))
+get_B737'base (B737'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_B737'base :: ((Untyped.RWCtx m s)) => (B737 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
+set_B737'base (B737'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_B737'base :: ((Untyped.ReadCtx m msg)) => (B737 msg) -> (m Std_.Bool)
+has_B737'base (B737'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_B737'base :: ((Untyped.RWCtx m s)) => (B737 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
+new_B737'base struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_B737'base struct result)
+ (Std_.pure result)
+ )
+newtype A320 msg
+ = A320'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg A320) where
+ tMsg f (A320'newtype_ s) = (A320'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (A320 msg)) where
+ fromStruct struct = (Std_.pure (A320'newtype_ struct))
+instance (Classes.ToStruct msg (A320 msg)) where
+ toStruct (A320'newtype_ struct) = struct
+instance (Untyped.HasMessage (A320 msg)) where
+ type InMessage (A320 msg) = msg
+ message (A320'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (A320 msg)) where
+ messageDefault msg = (A320'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (A320 msg)) where
+ fromPtr msg ptr = (A320'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (A320 (Message.MutMsg s))) where
+ toPtr msg (A320'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (A320 (Message.MutMsg s))) where
+ new msg = (A320'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (A320 msg)) where
+ newtype List msg (A320 msg)
+ = A320'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (A320'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (A320'List_ l) = (Untyped.ListStruct l)
+ length (A320'List_ l) = (Untyped.length l)
+ index i (A320'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (A320 (Message.MutMsg s))) where
+ setIndex (A320'newtype_ elt) i (A320'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (A320'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_A320'base :: ((Untyped.ReadCtx m msg)) => (A320 msg) -> (m (PlaneBase msg))
+get_A320'base (A320'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_A320'base :: ((Untyped.RWCtx m s)) => (A320 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
+set_A320'base (A320'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_A320'base :: ((Untyped.ReadCtx m msg)) => (A320 msg) -> (m Std_.Bool)
+has_A320'base (A320'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_A320'base :: ((Untyped.RWCtx m s)) => (A320 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
+new_A320'base struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_A320'base struct result)
+ (Std_.pure result)
+ )
+newtype F16 msg
+ = F16'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg F16) where
+ tMsg f (F16'newtype_ s) = (F16'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (F16 msg)) where
+ fromStruct struct = (Std_.pure (F16'newtype_ struct))
+instance (Classes.ToStruct msg (F16 msg)) where
+ toStruct (F16'newtype_ struct) = struct
+instance (Untyped.HasMessage (F16 msg)) where
+ type InMessage (F16 msg) = msg
+ message (F16'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (F16 msg)) where
+ messageDefault msg = (F16'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (F16 msg)) where
+ fromPtr msg ptr = (F16'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (F16 (Message.MutMsg s))) where
+ toPtr msg (F16'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (F16 (Message.MutMsg s))) where
+ new msg = (F16'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (F16 msg)) where
+ newtype List msg (F16 msg)
+ = F16'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (F16'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (F16'List_ l) = (Untyped.ListStruct l)
+ length (F16'List_ l) = (Untyped.length l)
+ index i (F16'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (F16 (Message.MutMsg s))) where
+ setIndex (F16'newtype_ elt) i (F16'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (F16'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_F16'base :: ((Untyped.ReadCtx m msg)) => (F16 msg) -> (m (PlaneBase msg))
+get_F16'base (F16'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_F16'base :: ((Untyped.RWCtx m s)) => (F16 (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
+set_F16'base (F16'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_F16'base :: ((Untyped.ReadCtx m msg)) => (F16 msg) -> (m Std_.Bool)
+has_F16'base (F16'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_F16'base :: ((Untyped.RWCtx m s)) => (F16 (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
+new_F16'base struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_F16'base struct result)
+ (Std_.pure result)
+ )
+newtype Regression msg
+ = Regression'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Regression) where
+ tMsg f (Regression'newtype_ s) = (Regression'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Regression msg)) where
+ fromStruct struct = (Std_.pure (Regression'newtype_ struct))
+instance (Classes.ToStruct msg (Regression msg)) where
+ toStruct (Regression'newtype_ struct) = struct
+instance (Untyped.HasMessage (Regression msg)) where
+ type InMessage (Regression msg) = msg
+ message (Regression'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Regression msg)) where
+ messageDefault msg = (Regression'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Regression msg)) where
+ fromPtr msg ptr = (Regression'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Regression (Message.MutMsg s))) where
+ toPtr msg (Regression'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Regression (Message.MutMsg s))) where
+ new msg = (Regression'newtype_ <$> (Untyped.allocStruct msg 3 3))
+instance (Basics.ListElem msg (Regression msg)) where
+ newtype List msg (Regression msg)
+ = Regression'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Regression'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Regression'List_ l) = (Untyped.ListStruct l)
+ length (Regression'List_ l) = (Untyped.length l)
+ index i (Regression'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Regression (Message.MutMsg s))) where
+ setIndex (Regression'newtype_ elt) i (Regression'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Regression'List_ <$> (Untyped.allocCompositeList msg 3 3 len))
+get_Regression'base :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (PlaneBase msg))
+get_Regression'base (Regression'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Regression'base :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
+set_Regression'base (Regression'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Regression'base :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
+has_Regression'base (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Regression'base :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (m (PlaneBase (Message.MutMsg s)))
+new_Regression'base struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Regression'base struct result)
+ (Std_.pure result)
+ )
+get_Regression'b0 :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
+get_Regression'b0 (Regression'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Regression'b0 :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Regression'b0 (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Regression'beta :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (Basics.List msg Std_.Double))
+get_Regression'beta (Regression'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Regression'beta :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Double) -> (m ())
+set_Regression'beta (Regression'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Regression'beta :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
+has_Regression'beta (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Regression'beta :: ((Untyped.RWCtx m s)) => Std_.Int -> (Regression (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Std_.Double))
+new_Regression'beta len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Regression'beta struct result)
+ (Std_.pure result)
+ )
+get_Regression'planes :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m (Basics.List msg (Aircraft msg)))
+get_Regression'planes (Regression'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Regression'planes :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))) -> (m ())
+set_Regression'planes (Regression'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_Regression'planes :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Bool)
+has_Regression'planes (Regression'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_Regression'planes :: ((Untyped.RWCtx m s)) => Std_.Int -> (Regression (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))))
+new_Regression'planes len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Regression'planes struct result)
+ (Std_.pure result)
+ )
+get_Regression'ymu :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
+get_Regression'ymu (Regression'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Regression'ymu :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Regression'ymu (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Regression'ysd :: ((Untyped.ReadCtx m msg)) => (Regression msg) -> (m Std_.Double)
+get_Regression'ysd (Regression'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Regression'ysd :: ((Untyped.RWCtx m s)) => (Regression (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Regression'ysd (Regression'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+newtype Aircraft msg
+ = Aircraft'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Aircraft) where
+ tMsg f (Aircraft'newtype_ s) = (Aircraft'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Aircraft msg)) where
+ fromStruct struct = (Std_.pure (Aircraft'newtype_ struct))
+instance (Classes.ToStruct msg (Aircraft msg)) where
+ toStruct (Aircraft'newtype_ struct) = struct
+instance (Untyped.HasMessage (Aircraft msg)) where
+ type InMessage (Aircraft msg) = msg
+ message (Aircraft'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Aircraft msg)) where
+ messageDefault msg = (Aircraft'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Aircraft msg)) where
+ fromPtr msg ptr = (Aircraft'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Aircraft (Message.MutMsg s))) where
+ toPtr msg (Aircraft'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Aircraft (Message.MutMsg s))) where
+ new msg = (Aircraft'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (Aircraft msg)) where
+ newtype List msg (Aircraft msg)
+ = Aircraft'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Aircraft'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Aircraft'List_ l) = (Untyped.ListStruct l)
+ length (Aircraft'List_ l) = (Untyped.length l)
+ index i (Aircraft'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Aircraft (Message.MutMsg s))) where
+ setIndex (Aircraft'newtype_ elt) i (Aircraft'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Aircraft'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+data Aircraft' msg
+ = Aircraft'void
+ | Aircraft'b737 (B737 msg)
+ | Aircraft'a320 (A320 msg)
+ | Aircraft'f16 (F16 msg)
+ | Aircraft'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Aircraft' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Aircraft'void)
+ 1 ->
+ (Aircraft'b737 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 2 ->
+ (Aircraft'a320 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 3 ->
+ (Aircraft'f16 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Aircraft'unknown' (Std_.fromIntegral tag)))
+ )
+get_Aircraft' :: ((Untyped.ReadCtx m msg)) => (Aircraft msg) -> (m (Aircraft' msg))
+get_Aircraft' (Aircraft'newtype_ struct) = (Classes.fromStruct struct)
+set_Aircraft'void :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (m ())
+set_Aircraft'void (Aircraft'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Aircraft'b737 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (B737 (Message.MutMsg s)) -> (m ())
+set_Aircraft'b737 (Aircraft'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Aircraft'a320 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (A320 (Message.MutMsg s)) -> (m ())
+set_Aircraft'a320 (Aircraft'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Aircraft'f16 :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> (F16 (Message.MutMsg s)) -> (m ())
+set_Aircraft'f16 (Aircraft'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Aircraft'unknown' :: ((Untyped.RWCtx m s)) => (Aircraft (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Aircraft'unknown' (Aircraft'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Z msg
+ = Z'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Z) where
+ tMsg f (Z'newtype_ s) = (Z'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Z msg)) where
+ fromStruct struct = (Std_.pure (Z'newtype_ struct))
+instance (Classes.ToStruct msg (Z msg)) where
+ toStruct (Z'newtype_ struct) = struct
+instance (Untyped.HasMessage (Z msg)) where
+ type InMessage (Z msg) = msg
+ message (Z'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Z msg)) where
+ messageDefault msg = (Z'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Z msg)) where
+ fromPtr msg ptr = (Z'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Z (Message.MutMsg s))) where
+ toPtr msg (Z'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Z (Message.MutMsg s))) where
+ new msg = (Z'newtype_ <$> (Untyped.allocStruct msg 3 1))
+instance (Basics.ListElem msg (Z msg)) where
+ newtype List msg (Z msg)
+ = Z'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Z'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Z'List_ l) = (Untyped.ListStruct l)
+ length (Z'List_ l) = (Untyped.length l)
+ index i (Z'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Z (Message.MutMsg s))) where
+ setIndex (Z'newtype_ elt) i (Z'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Z'List_ <$> (Untyped.allocCompositeList msg 3 1 len))
+data Z' msg
+ = Z'void
+ | Z'zz (Z msg)
+ | Z'f64 Std_.Double
+ | Z'f32 Std_.Float
+ | Z'i64 Std_.Int64
+ | Z'i32 Std_.Int32
+ | Z'i16 Std_.Int16
+ | Z'i8 Std_.Int8
+ | Z'u64 Std_.Word64
+ | Z'u32 Std_.Word32
+ | Z'u16 Std_.Word16
+ | Z'u8 Std_.Word8
+ | Z'bool Std_.Bool
+ | Z'text (Basics.Text msg)
+ | Z'blob (Basics.Data msg)
+ | Z'f64vec (Basics.List msg Std_.Double)
+ | Z'f32vec (Basics.List msg Std_.Float)
+ | Z'i64vec (Basics.List msg Std_.Int64)
+ | Z'i32vec (Basics.List msg Std_.Int32)
+ | Z'i16vec (Basics.List msg Std_.Int16)
+ | Z'i8vec (Basics.List msg Std_.Int8)
+ | Z'u64vec (Basics.List msg Std_.Word64)
+ | Z'u32vec (Basics.List msg Std_.Word32)
+ | Z'u16vec (Basics.List msg Std_.Word16)
+ | Z'u8vec (Basics.List msg Std_.Word8)
+ | Z'zvec (Basics.List msg (Z msg))
+ | Z'zvecvec (Basics.List msg (Basics.List msg (Z msg)))
+ | Z'zdate (Zdate msg)
+ | Z'zdata (Zdata msg)
+ | Z'aircraftvec (Basics.List msg (Aircraft msg))
+ | Z'aircraft (Aircraft msg)
+ | Z'regression (Regression msg)
+ | Z'planebase (PlaneBase msg)
+ | Z'airport Airport
+ | Z'b737 (B737 msg)
+ | Z'a320 (A320 msg)
+ | Z'f16 (F16 msg)
+ | Z'zdatevec (Basics.List msg (Zdate msg))
+ | Z'zdatavec (Basics.List msg (Zdata msg))
+ | Z'boolvec (Basics.List msg Std_.Bool)
+ | Z'datavec (Basics.List msg (Basics.Data msg))
+ | Z'textvec (Basics.List msg (Basics.Text msg))
+ | Z'grp (Z'grp msg)
+ | Z'echo (Echo msg)
+ | Z'echoBases (EchoBases msg)
+ | Z'unknown' Std_.Word16
+instance (Classes.FromStruct msg (Z' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure Z'void)
+ 1 ->
+ (Z'zz <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 2 ->
+ (Z'f64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 3 ->
+ (Z'f32 <$> (GenHelpers.getWordField struct 1 0 0))
+ 4 ->
+ (Z'i64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 5 ->
+ (Z'i32 <$> (GenHelpers.getWordField struct 1 0 0))
+ 6 ->
+ (Z'i16 <$> (GenHelpers.getWordField struct 1 0 0))
+ 7 ->
+ (Z'i8 <$> (GenHelpers.getWordField struct 1 0 0))
+ 8 ->
+ (Z'u64 <$> (GenHelpers.getWordField struct 1 0 0))
+ 9 ->
+ (Z'u32 <$> (GenHelpers.getWordField struct 1 0 0))
+ 10 ->
+ (Z'u16 <$> (GenHelpers.getWordField struct 1 0 0))
+ 11 ->
+ (Z'u8 <$> (GenHelpers.getWordField struct 1 0 0))
+ 12 ->
+ (Z'bool <$> (GenHelpers.getWordField struct 1 0 0))
+ 13 ->
+ (Z'text <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 14 ->
+ (Z'blob <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 15 ->
+ (Z'f64vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 16 ->
+ (Z'f32vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 17 ->
+ (Z'i64vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 18 ->
+ (Z'i32vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 19 ->
+ (Z'i16vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 20 ->
+ (Z'i8vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 21 ->
+ (Z'u64vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 22 ->
+ (Z'u32vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 23 ->
+ (Z'u16vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 24 ->
+ (Z'u8vec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 25 ->
+ (Z'zvec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 26 ->
+ (Z'zvecvec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 27 ->
+ (Z'zdate <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 28 ->
+ (Z'zdata <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 29 ->
+ (Z'aircraftvec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 30 ->
+ (Z'aircraft <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 31 ->
+ (Z'regression <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 32 ->
+ (Z'planebase <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 33 ->
+ (Z'airport <$> (GenHelpers.getWordField struct 1 0 0))
+ 34 ->
+ (Z'b737 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 35 ->
+ (Z'a320 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 36 ->
+ (Z'f16 <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 37 ->
+ (Z'zdatevec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 38 ->
+ (Z'zdatavec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 39 ->
+ (Z'boolvec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 40 ->
+ (Z'datavec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 41 ->
+ (Z'textvec <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 42 ->
+ (Z'grp <$> (Classes.fromStruct struct))
+ 43 ->
+ (Z'echo <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ 44 ->
+ (Z'echoBases <$> (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ ))
+ _ ->
+ (Std_.pure (Z'unknown' (Std_.fromIntegral tag)))
+ )
+get_Z' :: ((Untyped.ReadCtx m msg)) => (Z msg) -> (m (Z' msg))
+get_Z' (Z'newtype_ struct) = (Classes.fromStruct struct)
+set_Z'void :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (m ())
+set_Z'void (Z'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_Z'zz :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Z (Message.MutMsg s)) -> (m ())
+set_Z'zz (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'f64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_Z'f64 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (2 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Z'f32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Float -> (m ())
+set_Z'f32 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (3 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+ )
+set_Z'i64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_Z'i64 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (4 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Z'i32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_Z'i32 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (5 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+ )
+set_Z'i16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_Z'i16 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (6 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+ )
+set_Z'i8 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Int8 -> (m ())
+set_Z'i8 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (7 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 1 0 0)
+ )
+set_Z'u64 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Z'u64 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (8 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+ )
+set_Z'u32 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Z'u32 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (9 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+ )
+set_Z'u16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Z'u16 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (10 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+ )
+set_Z'u8 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word8 -> (m ())
+set_Z'u8 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (11 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word8) 1 0 0)
+ )
+set_Z'bool :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_Z'bool (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (12 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 0 0)
+ )
+set_Z'text :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Z'text (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (13 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'blob :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
+set_Z'blob (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (14 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'f64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Double) -> (m ())
+set_Z'f64vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (15 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'f32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Float) -> (m ())
+set_Z'f32vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (16 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'i64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int64) -> (m ())
+set_Z'i64vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (17 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'i32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int32) -> (m ())
+set_Z'i32vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (18 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'i16vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int16) -> (m ())
+set_Z'i16vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (19 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'i8vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int8) -> (m ())
+set_Z'i8vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (20 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'u64vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word64) -> (m ())
+set_Z'u64vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (21 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'u32vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word32) -> (m ())
+set_Z'u32vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (22 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'u16vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word16) -> (m ())
+set_Z'u16vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (23 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'u8vec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Word8) -> (m ())
+set_Z'u8vec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (24 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Z (Message.MutMsg s))) -> (m ())
+set_Z'zvec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (25 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zvecvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Z (Message.MutMsg s)))) -> (m ())
+set_Z'zvecvec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (26 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zdate :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Zdate (Message.MutMsg s)) -> (m ())
+set_Z'zdate (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (27 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zdata :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Zdata (Message.MutMsg s)) -> (m ())
+set_Z'zdata (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (28 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'aircraftvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Aircraft (Message.MutMsg s))) -> (m ())
+set_Z'aircraftvec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (29 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'aircraft :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Aircraft (Message.MutMsg s)) -> (m ())
+set_Z'aircraft (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (30 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'regression :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Regression (Message.MutMsg s)) -> (m ())
+set_Z'regression (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (31 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'planebase :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (PlaneBase (Message.MutMsg s)) -> (m ())
+set_Z'planebase (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (32 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'airport :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Airport -> (m ())
+set_Z'airport (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (33 :: Std_.Word16) 0 0 0)
+ (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 1 0 0)
+ )
+set_Z'b737 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (B737 (Message.MutMsg s)) -> (m ())
+set_Z'b737 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (34 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'a320 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (A320 (Message.MutMsg s)) -> (m ())
+set_Z'a320 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (35 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'f16 :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (F16 (Message.MutMsg s)) -> (m ())
+set_Z'f16 (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (36 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zdatevec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zdate (Message.MutMsg s))) -> (m ())
+set_Z'zdatevec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (37 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'zdatavec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zdata (Message.MutMsg s))) -> (m ())
+set_Z'zdatavec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (38 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'boolvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Bool) -> (m ())
+set_Z'boolvec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (39 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'datavec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Data (Message.MutMsg s))) -> (m ())
+set_Z'datavec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (40 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'textvec :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
+set_Z'textvec (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (41 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'grp :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (m (Z'grp (Message.MutMsg s)))
+set_Z'grp (Z'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (42 :: Std_.Word16) 0 0 0)
+ (Classes.fromStruct struct)
+ )
+set_Z'echo :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (Echo (Message.MutMsg s)) -> (m ())
+set_Z'echo (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (43 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'echoBases :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> (EchoBases (Message.MutMsg s)) -> (m ())
+set_Z'echoBases (Z'newtype_ struct) value = (do
+ (GenHelpers.setWordField struct (44 :: Std_.Word16) 0 0 0)
+ (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+ )
+set_Z'unknown' :: ((Untyped.RWCtx m s)) => (Z (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_Z'unknown' (Z'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Z'grp msg
+ = Z'grp'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Z'grp) where
+ tMsg f (Z'grp'newtype_ s) = (Z'grp'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Z'grp msg)) where
+ fromStruct struct = (Std_.pure (Z'grp'newtype_ struct))
+instance (Classes.ToStruct msg (Z'grp msg)) where
+ toStruct (Z'grp'newtype_ struct) = struct
+instance (Untyped.HasMessage (Z'grp msg)) where
+ type InMessage (Z'grp msg) = msg
+ message (Z'grp'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Z'grp msg)) where
+ messageDefault msg = (Z'grp'newtype_ (Untyped.messageDefault msg))
+get_Z'grp'first :: ((Untyped.ReadCtx m msg)) => (Z'grp msg) -> (m Std_.Word64)
+get_Z'grp'first (Z'grp'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_Z'grp'first :: ((Untyped.RWCtx m s)) => (Z'grp (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Z'grp'first (Z'grp'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_Z'grp'second :: ((Untyped.ReadCtx m msg)) => (Z'grp msg) -> (m Std_.Word64)
+get_Z'grp'second (Z'grp'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_Z'grp'second :: ((Untyped.RWCtx m s)) => (Z'grp (Message.MutMsg s)) -> Std_.Word64 -> (m ())
+set_Z'grp'second (Z'grp'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+newtype Counter msg
+ = Counter'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Counter) where
+ tMsg f (Counter'newtype_ s) = (Counter'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Counter msg)) where
+ fromStruct struct = (Std_.pure (Counter'newtype_ struct))
+instance (Classes.ToStruct msg (Counter msg)) where
+ toStruct (Counter'newtype_ struct) = struct
+instance (Untyped.HasMessage (Counter msg)) where
+ type InMessage (Counter msg) = msg
+ message (Counter'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Counter msg)) where
+ messageDefault msg = (Counter'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Counter msg)) where
+ fromPtr msg ptr = (Counter'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Counter (Message.MutMsg s))) where
+ toPtr msg (Counter'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Counter (Message.MutMsg s))) where
+ new msg = (Counter'newtype_ <$> (Untyped.allocStruct msg 1 2))
+instance (Basics.ListElem msg (Counter msg)) where
+ newtype List msg (Counter msg)
+ = Counter'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Counter'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Counter'List_ l) = (Untyped.ListStruct l)
+ length (Counter'List_ l) = (Untyped.length l)
+ index i (Counter'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Counter (Message.MutMsg s))) where
+ setIndex (Counter'newtype_ elt) i (Counter'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Counter'List_ <$> (Untyped.allocCompositeList msg 1 2 len))
+get_Counter'size :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Int64)
+get_Counter'size (Counter'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_Counter'size :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_Counter'size (Counter'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_Counter'words :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m (Basics.Text msg))
+get_Counter'words (Counter'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Counter'words :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Counter'words (Counter'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Counter'words :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Bool)
+has_Counter'words (Counter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Counter'words :: ((Untyped.RWCtx m s)) => Std_.Int -> (Counter (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Counter'words len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Counter'words struct result)
+ (Std_.pure result)
+ )
+get_Counter'wordlist :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m (Basics.List msg (Basics.Text msg)))
+get_Counter'wordlist (Counter'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Counter'wordlist :: ((Untyped.RWCtx m s)) => (Counter (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
+set_Counter'wordlist (Counter'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Counter'wordlist :: ((Untyped.ReadCtx m msg)) => (Counter msg) -> (m Std_.Bool)
+has_Counter'wordlist (Counter'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Counter'wordlist :: ((Untyped.RWCtx m s)) => Std_.Int -> (Counter (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
+new_Counter'wordlist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Counter'wordlist struct result)
+ (Std_.pure result)
+ )
+newtype Bag msg
+ = Bag'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Bag) where
+ tMsg f (Bag'newtype_ s) = (Bag'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Bag msg)) where
+ fromStruct struct = (Std_.pure (Bag'newtype_ struct))
+instance (Classes.ToStruct msg (Bag msg)) where
+ toStruct (Bag'newtype_ struct) = struct
+instance (Untyped.HasMessage (Bag msg)) where
+ type InMessage (Bag msg) = msg
+ message (Bag'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Bag msg)) where
+ messageDefault msg = (Bag'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Bag msg)) where
+ fromPtr msg ptr = (Bag'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Bag (Message.MutMsg s))) where
+ toPtr msg (Bag'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Bag (Message.MutMsg s))) where
+ new msg = (Bag'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Bag msg)) where
+ newtype List msg (Bag msg)
+ = Bag'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Bag'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Bag'List_ l) = (Untyped.ListStruct l)
+ length (Bag'List_ l) = (Untyped.length l)
+ index i (Bag'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Bag (Message.MutMsg s))) where
+ setIndex (Bag'newtype_ elt) i (Bag'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Bag'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Bag'counter :: ((Untyped.ReadCtx m msg)) => (Bag msg) -> (m (Counter msg))
+get_Bag'counter (Bag'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Bag'counter :: ((Untyped.RWCtx m s)) => (Bag (Message.MutMsg s)) -> (Counter (Message.MutMsg s)) -> (m ())
+set_Bag'counter (Bag'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Bag'counter :: ((Untyped.ReadCtx m msg)) => (Bag msg) -> (m Std_.Bool)
+has_Bag'counter (Bag'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Bag'counter :: ((Untyped.RWCtx m s)) => (Bag (Message.MutMsg s)) -> (m (Counter (Message.MutMsg s)))
+new_Bag'counter struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Bag'counter struct result)
+ (Std_.pure result)
+ )
+newtype Zserver msg
+ = Zserver'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Zserver) where
+ tMsg f (Zserver'newtype_ s) = (Zserver'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Zserver msg)) where
+ fromStruct struct = (Std_.pure (Zserver'newtype_ struct))
+instance (Classes.ToStruct msg (Zserver msg)) where
+ toStruct (Zserver'newtype_ struct) = struct
+instance (Untyped.HasMessage (Zserver msg)) where
+ type InMessage (Zserver msg) = msg
+ message (Zserver'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Zserver msg)) where
+ messageDefault msg = (Zserver'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Zserver msg)) where
+ fromPtr msg ptr = (Zserver'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Zserver (Message.MutMsg s))) where
+ toPtr msg (Zserver'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Zserver (Message.MutMsg s))) where
+ new msg = (Zserver'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Zserver msg)) where
+ newtype List msg (Zserver msg)
+ = Zserver'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Zserver'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Zserver'List_ l) = (Untyped.ListStruct l)
+ length (Zserver'List_ l) = (Untyped.length l)
+ index i (Zserver'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Zserver (Message.MutMsg s))) where
+ setIndex (Zserver'newtype_ elt) i (Zserver'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Zserver'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Zserver'waitingjobs :: ((Untyped.ReadCtx m msg)) => (Zserver msg) -> (m (Basics.List msg (Zjob msg)))
+get_Zserver'waitingjobs (Zserver'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Zserver'waitingjobs :: ((Untyped.RWCtx m s)) => (Zserver (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Zjob (Message.MutMsg s))) -> (m ())
+set_Zserver'waitingjobs (Zserver'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Zserver'waitingjobs :: ((Untyped.ReadCtx m msg)) => (Zserver msg) -> (m Std_.Bool)
+has_Zserver'waitingjobs (Zserver'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Zserver'waitingjobs :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zserver (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Zjob (Message.MutMsg s))))
+new_Zserver'waitingjobs len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Zserver'waitingjobs struct result)
+ (Std_.pure result)
+ )
+newtype Zjob msg
+ = Zjob'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Zjob) where
+ tMsg f (Zjob'newtype_ s) = (Zjob'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Zjob msg)) where
+ fromStruct struct = (Std_.pure (Zjob'newtype_ struct))
+instance (Classes.ToStruct msg (Zjob msg)) where
+ toStruct (Zjob'newtype_ struct) = struct
+instance (Untyped.HasMessage (Zjob msg)) where
+ type InMessage (Zjob msg) = msg
+ message (Zjob'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Zjob msg)) where
+ messageDefault msg = (Zjob'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Zjob msg)) where
+ fromPtr msg ptr = (Zjob'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Zjob (Message.MutMsg s))) where
+ toPtr msg (Zjob'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Zjob (Message.MutMsg s))) where
+ new msg = (Zjob'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (Zjob msg)) where
+ newtype List msg (Zjob msg)
+ = Zjob'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Zjob'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Zjob'List_ l) = (Untyped.ListStruct l)
+ length (Zjob'List_ l) = (Untyped.length l)
+ index i (Zjob'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Zjob (Message.MutMsg s))) where
+ setIndex (Zjob'newtype_ elt) i (Zjob'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Zjob'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_Zjob'cmd :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m (Basics.Text msg))
+get_Zjob'cmd (Zjob'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Zjob'cmd :: ((Untyped.RWCtx m s)) => (Zjob (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Zjob'cmd (Zjob'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Zjob'cmd :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m Std_.Bool)
+has_Zjob'cmd (Zjob'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Zjob'cmd :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zjob (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Zjob'cmd len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Zjob'cmd struct result)
+ (Std_.pure result)
+ )
+get_Zjob'args :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m (Basics.List msg (Basics.Text msg)))
+get_Zjob'args (Zjob'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Zjob'args :: ((Untyped.RWCtx m s)) => (Zjob (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
+set_Zjob'args (Zjob'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Zjob'args :: ((Untyped.ReadCtx m msg)) => (Zjob msg) -> (m Std_.Bool)
+has_Zjob'args (Zjob'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Zjob'args :: ((Untyped.RWCtx m s)) => Std_.Int -> (Zjob (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
+new_Zjob'args len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Zjob'args struct result)
+ (Std_.pure result)
+ )
+newtype VerEmpty msg
+ = VerEmpty'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerEmpty) where
+ tMsg f (VerEmpty'newtype_ s) = (VerEmpty'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerEmpty msg)) where
+ fromStruct struct = (Std_.pure (VerEmpty'newtype_ struct))
+instance (Classes.ToStruct msg (VerEmpty msg)) where
+ toStruct (VerEmpty'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerEmpty msg)) where
+ type InMessage (VerEmpty msg) = msg
+ message (VerEmpty'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerEmpty msg)) where
+ messageDefault msg = (VerEmpty'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerEmpty msg)) where
+ fromPtr msg ptr = (VerEmpty'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerEmpty (Message.MutMsg s))) where
+ toPtr msg (VerEmpty'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerEmpty (Message.MutMsg s))) where
+ new msg = (VerEmpty'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (VerEmpty msg)) where
+ newtype List msg (VerEmpty msg)
+ = VerEmpty'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerEmpty'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerEmpty'List_ l) = (Untyped.ListStruct l)
+ length (VerEmpty'List_ l) = (Untyped.length l)
+ index i (VerEmpty'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerEmpty (Message.MutMsg s))) where
+ setIndex (VerEmpty'newtype_ elt) i (VerEmpty'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerEmpty'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype VerOneData msg
+ = VerOneData'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerOneData) where
+ tMsg f (VerOneData'newtype_ s) = (VerOneData'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerOneData msg)) where
+ fromStruct struct = (Std_.pure (VerOneData'newtype_ struct))
+instance (Classes.ToStruct msg (VerOneData msg)) where
+ toStruct (VerOneData'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerOneData msg)) where
+ type InMessage (VerOneData msg) = msg
+ message (VerOneData'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerOneData msg)) where
+ messageDefault msg = (VerOneData'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerOneData msg)) where
+ fromPtr msg ptr = (VerOneData'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerOneData (Message.MutMsg s))) where
+ toPtr msg (VerOneData'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerOneData (Message.MutMsg s))) where
+ new msg = (VerOneData'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (VerOneData msg)) where
+ newtype List msg (VerOneData msg)
+ = VerOneData'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerOneData'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerOneData'List_ l) = (Untyped.ListStruct l)
+ length (VerOneData'List_ l) = (Untyped.length l)
+ index i (VerOneData'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerOneData (Message.MutMsg s))) where
+ setIndex (VerOneData'newtype_ elt) i (VerOneData'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerOneData'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_VerOneData'val :: ((Untyped.ReadCtx m msg)) => (VerOneData msg) -> (m Std_.Int16)
+get_VerOneData'val (VerOneData'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_VerOneData'val :: ((Untyped.RWCtx m s)) => (VerOneData (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_VerOneData'val (VerOneData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype VerTwoData msg
+ = VerTwoData'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerTwoData) where
+ tMsg f (VerTwoData'newtype_ s) = (VerTwoData'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerTwoData msg)) where
+ fromStruct struct = (Std_.pure (VerTwoData'newtype_ struct))
+instance (Classes.ToStruct msg (VerTwoData msg)) where
+ toStruct (VerTwoData'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerTwoData msg)) where
+ type InMessage (VerTwoData msg) = msg
+ message (VerTwoData'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerTwoData msg)) where
+ messageDefault msg = (VerTwoData'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerTwoData msg)) where
+ fromPtr msg ptr = (VerTwoData'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerTwoData (Message.MutMsg s))) where
+ toPtr msg (VerTwoData'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerTwoData (Message.MutMsg s))) where
+ new msg = (VerTwoData'newtype_ <$> (Untyped.allocStruct msg 2 0))
+instance (Basics.ListElem msg (VerTwoData msg)) where
+ newtype List msg (VerTwoData msg)
+ = VerTwoData'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerTwoData'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerTwoData'List_ l) = (Untyped.ListStruct l)
+ length (VerTwoData'List_ l) = (Untyped.length l)
+ index i (VerTwoData'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerTwoData (Message.MutMsg s))) where
+ setIndex (VerTwoData'newtype_ elt) i (VerTwoData'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerTwoData'List_ <$> (Untyped.allocCompositeList msg 2 0 len))
+get_VerTwoData'val :: ((Untyped.ReadCtx m msg)) => (VerTwoData msg) -> (m Std_.Int16)
+get_VerTwoData'val (VerTwoData'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_VerTwoData'val :: ((Untyped.RWCtx m s)) => (VerTwoData (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_VerTwoData'val (VerTwoData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_VerTwoData'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoData msg) -> (m Std_.Int64)
+get_VerTwoData'duo (VerTwoData'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_VerTwoData'duo :: ((Untyped.RWCtx m s)) => (VerTwoData (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_VerTwoData'duo (VerTwoData'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+newtype VerOnePtr msg
+ = VerOnePtr'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerOnePtr) where
+ tMsg f (VerOnePtr'newtype_ s) = (VerOnePtr'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerOnePtr msg)) where
+ fromStruct struct = (Std_.pure (VerOnePtr'newtype_ struct))
+instance (Classes.ToStruct msg (VerOnePtr msg)) where
+ toStruct (VerOnePtr'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerOnePtr msg)) where
+ type InMessage (VerOnePtr msg) = msg
+ message (VerOnePtr'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerOnePtr msg)) where
+ messageDefault msg = (VerOnePtr'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerOnePtr msg)) where
+ fromPtr msg ptr = (VerOnePtr'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerOnePtr (Message.MutMsg s))) where
+ toPtr msg (VerOnePtr'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerOnePtr (Message.MutMsg s))) where
+ new msg = (VerOnePtr'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (VerOnePtr msg)) where
+ newtype List msg (VerOnePtr msg)
+ = VerOnePtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerOnePtr'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerOnePtr'List_ l) = (Untyped.ListStruct l)
+ length (VerOnePtr'List_ l) = (Untyped.length l)
+ index i (VerOnePtr'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerOnePtr (Message.MutMsg s))) where
+ setIndex (VerOnePtr'newtype_ elt) i (VerOnePtr'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerOnePtr'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_VerOnePtr'ptr :: ((Untyped.ReadCtx m msg)) => (VerOnePtr msg) -> (m (VerOneData msg))
+get_VerOnePtr'ptr (VerOnePtr'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerOnePtr'ptr :: ((Untyped.RWCtx m s)) => (VerOnePtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
+set_VerOnePtr'ptr (VerOnePtr'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_VerOnePtr'ptr :: ((Untyped.ReadCtx m msg)) => (VerOnePtr msg) -> (m Std_.Bool)
+has_VerOnePtr'ptr (VerOnePtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_VerOnePtr'ptr :: ((Untyped.RWCtx m s)) => (VerOnePtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
+new_VerOnePtr'ptr struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerOnePtr'ptr struct result)
+ (Std_.pure result)
+ )
+newtype VerTwoPtr msg
+ = VerTwoPtr'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerTwoPtr) where
+ tMsg f (VerTwoPtr'newtype_ s) = (VerTwoPtr'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerTwoPtr msg)) where
+ fromStruct struct = (Std_.pure (VerTwoPtr'newtype_ struct))
+instance (Classes.ToStruct msg (VerTwoPtr msg)) where
+ toStruct (VerTwoPtr'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerTwoPtr msg)) where
+ type InMessage (VerTwoPtr msg) = msg
+ message (VerTwoPtr'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerTwoPtr msg)) where
+ messageDefault msg = (VerTwoPtr'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerTwoPtr msg)) where
+ fromPtr msg ptr = (VerTwoPtr'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerTwoPtr (Message.MutMsg s))) where
+ toPtr msg (VerTwoPtr'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerTwoPtr (Message.MutMsg s))) where
+ new msg = (VerTwoPtr'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (VerTwoPtr msg)) where
+ newtype List msg (VerTwoPtr msg)
+ = VerTwoPtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerTwoPtr'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerTwoPtr'List_ l) = (Untyped.ListStruct l)
+ length (VerTwoPtr'List_ l) = (Untyped.length l)
+ index i (VerTwoPtr'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerTwoPtr (Message.MutMsg s))) where
+ setIndex (VerTwoPtr'newtype_ elt) i (VerTwoPtr'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerTwoPtr'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_VerTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m (VerOneData msg))
+get_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
+set_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_VerTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m Std_.Bool)
+has_VerTwoPtr'ptr1 (VerTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_VerTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
+new_VerTwoPtr'ptr1 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoPtr'ptr1 struct result)
+ (Std_.pure result)
+ )
+get_VerTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m (VerOneData msg))
+get_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
+set_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_VerTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoPtr msg) -> (m Std_.Bool)
+has_VerTwoPtr'ptr2 (VerTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_VerTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
+new_VerTwoPtr'ptr2 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoPtr'ptr2 struct result)
+ (Std_.pure result)
+ )
+newtype VerTwoDataTwoPtr msg
+ = VerTwoDataTwoPtr'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerTwoDataTwoPtr) where
+ tMsg f (VerTwoDataTwoPtr'newtype_ s) = (VerTwoDataTwoPtr'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerTwoDataTwoPtr msg)) where
+ fromStruct struct = (Std_.pure (VerTwoDataTwoPtr'newtype_ struct))
+instance (Classes.ToStruct msg (VerTwoDataTwoPtr msg)) where
+ toStruct (VerTwoDataTwoPtr'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerTwoDataTwoPtr msg)) where
+ type InMessage (VerTwoDataTwoPtr msg) = msg
+ message (VerTwoDataTwoPtr'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerTwoDataTwoPtr msg)) where
+ messageDefault msg = (VerTwoDataTwoPtr'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerTwoDataTwoPtr msg)) where
+ fromPtr msg ptr = (VerTwoDataTwoPtr'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerTwoDataTwoPtr (Message.MutMsg s))) where
+ toPtr msg (VerTwoDataTwoPtr'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerTwoDataTwoPtr (Message.MutMsg s))) where
+ new msg = (VerTwoDataTwoPtr'newtype_ <$> (Untyped.allocStruct msg 2 2))
+instance (Basics.ListElem msg (VerTwoDataTwoPtr msg)) where
+ newtype List msg (VerTwoDataTwoPtr msg)
+ = VerTwoDataTwoPtr'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerTwoDataTwoPtr'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerTwoDataTwoPtr'List_ l) = (Untyped.ListStruct l)
+ length (VerTwoDataTwoPtr'List_ l) = (Untyped.length l)
+ index i (VerTwoDataTwoPtr'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerTwoDataTwoPtr (Message.MutMsg s))) where
+ setIndex (VerTwoDataTwoPtr'newtype_ elt) i (VerTwoDataTwoPtr'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerTwoDataTwoPtr'List_ <$> (Untyped.allocCompositeList msg 2 2 len))
+get_VerTwoDataTwoPtr'val :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Int16)
+get_VerTwoDataTwoPtr'val (VerTwoDataTwoPtr'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_VerTwoDataTwoPtr'val :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_VerTwoDataTwoPtr'val (VerTwoDataTwoPtr'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_VerTwoDataTwoPtr'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Int64)
+get_VerTwoDataTwoPtr'duo (VerTwoDataTwoPtr'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_VerTwoDataTwoPtr'duo :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_VerTwoDataTwoPtr'duo (VerTwoDataTwoPtr'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_VerTwoDataTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m (VerOneData msg))
+get_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoDataTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
+set_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_VerTwoDataTwoPtr'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Bool)
+has_VerTwoDataTwoPtr'ptr1 (VerTwoDataTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_VerTwoDataTwoPtr'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
+new_VerTwoDataTwoPtr'ptr1 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoDataTwoPtr'ptr1 struct result)
+ (Std_.pure result)
+ )
+get_VerTwoDataTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m (VerOneData msg))
+get_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoDataTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (VerOneData (Message.MutMsg s)) -> (m ())
+set_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_VerTwoDataTwoPtr'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoDataTwoPtr msg) -> (m Std_.Bool)
+has_VerTwoDataTwoPtr'ptr2 (VerTwoDataTwoPtr'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_VerTwoDataTwoPtr'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m (VerOneData (Message.MutMsg s)))
+new_VerTwoDataTwoPtr'ptr2 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoDataTwoPtr'ptr2 struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerEmptyList msg
+ = HoldsVerEmptyList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerEmptyList) where
+ tMsg f (HoldsVerEmptyList'newtype_ s) = (HoldsVerEmptyList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerEmptyList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerEmptyList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerEmptyList msg)) where
+ toStruct (HoldsVerEmptyList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerEmptyList msg)) where
+ type InMessage (HoldsVerEmptyList msg) = msg
+ message (HoldsVerEmptyList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerEmptyList msg)) where
+ messageDefault msg = (HoldsVerEmptyList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerEmptyList msg)) where
+ fromPtr msg ptr = (HoldsVerEmptyList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerEmptyList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerEmptyList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerEmptyList (Message.MutMsg s))) where
+ new msg = (HoldsVerEmptyList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerEmptyList msg)) where
+ newtype List msg (HoldsVerEmptyList msg)
+ = HoldsVerEmptyList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerEmptyList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerEmptyList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerEmptyList'List_ l) = (Untyped.length l)
+ index i (HoldsVerEmptyList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerEmptyList (Message.MutMsg s))) where
+ setIndex (HoldsVerEmptyList'newtype_ elt) i (HoldsVerEmptyList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerEmptyList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerEmptyList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerEmptyList msg) -> (m (Basics.List msg (VerEmpty msg)))
+get_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerEmptyList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerEmptyList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerEmpty (Message.MutMsg s))) -> (m ())
+set_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerEmptyList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerEmptyList msg) -> (m Std_.Bool)
+has_HoldsVerEmptyList'mylist (HoldsVerEmptyList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerEmptyList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerEmptyList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerEmpty (Message.MutMsg s))))
+new_HoldsVerEmptyList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerEmptyList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerOneDataList msg
+ = HoldsVerOneDataList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerOneDataList) where
+ tMsg f (HoldsVerOneDataList'newtype_ s) = (HoldsVerOneDataList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerOneDataList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerOneDataList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerOneDataList msg)) where
+ toStruct (HoldsVerOneDataList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerOneDataList msg)) where
+ type InMessage (HoldsVerOneDataList msg) = msg
+ message (HoldsVerOneDataList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerOneDataList msg)) where
+ messageDefault msg = (HoldsVerOneDataList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerOneDataList msg)) where
+ fromPtr msg ptr = (HoldsVerOneDataList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerOneDataList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerOneDataList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerOneDataList (Message.MutMsg s))) where
+ new msg = (HoldsVerOneDataList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerOneDataList msg)) where
+ newtype List msg (HoldsVerOneDataList msg)
+ = HoldsVerOneDataList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerOneDataList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerOneDataList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerOneDataList'List_ l) = (Untyped.length l)
+ index i (HoldsVerOneDataList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerOneDataList (Message.MutMsg s))) where
+ setIndex (HoldsVerOneDataList'newtype_ elt) i (HoldsVerOneDataList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerOneDataList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerOneDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOneDataList msg) -> (m (Basics.List msg (VerOneData msg)))
+get_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerOneDataList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerOneDataList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerOneData (Message.MutMsg s))) -> (m ())
+set_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerOneDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOneDataList msg) -> (m Std_.Bool)
+has_HoldsVerOneDataList'mylist (HoldsVerOneDataList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerOneDataList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerOneDataList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerOneData (Message.MutMsg s))))
+new_HoldsVerOneDataList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerOneDataList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerTwoDataList msg
+ = HoldsVerTwoDataList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerTwoDataList) where
+ tMsg f (HoldsVerTwoDataList'newtype_ s) = (HoldsVerTwoDataList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerTwoDataList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerTwoDataList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerTwoDataList msg)) where
+ toStruct (HoldsVerTwoDataList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerTwoDataList msg)) where
+ type InMessage (HoldsVerTwoDataList msg) = msg
+ message (HoldsVerTwoDataList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerTwoDataList msg)) where
+ messageDefault msg = (HoldsVerTwoDataList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerTwoDataList msg)) where
+ fromPtr msg ptr = (HoldsVerTwoDataList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerTwoDataList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerTwoDataList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerTwoDataList (Message.MutMsg s))) where
+ new msg = (HoldsVerTwoDataList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerTwoDataList msg)) where
+ newtype List msg (HoldsVerTwoDataList msg)
+ = HoldsVerTwoDataList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerTwoDataList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerTwoDataList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerTwoDataList'List_ l) = (Untyped.length l)
+ index i (HoldsVerTwoDataList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerTwoDataList (Message.MutMsg s))) where
+ setIndex (HoldsVerTwoDataList'newtype_ elt) i (HoldsVerTwoDataList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerTwoDataList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerTwoDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoDataList msg) -> (m (Basics.List msg (VerTwoData msg)))
+get_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerTwoDataList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoDataList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoData (Message.MutMsg s))) -> (m ())
+set_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerTwoDataList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoDataList msg) -> (m Std_.Bool)
+has_HoldsVerTwoDataList'mylist (HoldsVerTwoDataList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerTwoDataList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoDataList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoData (Message.MutMsg s))))
+new_HoldsVerTwoDataList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerTwoDataList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerOnePtrList msg
+ = HoldsVerOnePtrList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerOnePtrList) where
+ tMsg f (HoldsVerOnePtrList'newtype_ s) = (HoldsVerOnePtrList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerOnePtrList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerOnePtrList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerOnePtrList msg)) where
+ toStruct (HoldsVerOnePtrList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerOnePtrList msg)) where
+ type InMessage (HoldsVerOnePtrList msg) = msg
+ message (HoldsVerOnePtrList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerOnePtrList msg)) where
+ messageDefault msg = (HoldsVerOnePtrList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerOnePtrList msg)) where
+ fromPtr msg ptr = (HoldsVerOnePtrList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerOnePtrList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerOnePtrList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerOnePtrList (Message.MutMsg s))) where
+ new msg = (HoldsVerOnePtrList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerOnePtrList msg)) where
+ newtype List msg (HoldsVerOnePtrList msg)
+ = HoldsVerOnePtrList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerOnePtrList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerOnePtrList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerOnePtrList'List_ l) = (Untyped.length l)
+ index i (HoldsVerOnePtrList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerOnePtrList (Message.MutMsg s))) where
+ setIndex (HoldsVerOnePtrList'newtype_ elt) i (HoldsVerOnePtrList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerOnePtrList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerOnePtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOnePtrList msg) -> (m (Basics.List msg (VerOnePtr msg)))
+get_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerOnePtrList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerOnePtrList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerOnePtr (Message.MutMsg s))) -> (m ())
+set_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerOnePtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerOnePtrList msg) -> (m Std_.Bool)
+has_HoldsVerOnePtrList'mylist (HoldsVerOnePtrList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerOnePtrList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerOnePtrList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerOnePtr (Message.MutMsg s))))
+new_HoldsVerOnePtrList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerOnePtrList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerTwoPtrList msg
+ = HoldsVerTwoPtrList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerTwoPtrList) where
+ tMsg f (HoldsVerTwoPtrList'newtype_ s) = (HoldsVerTwoPtrList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerTwoPtrList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerTwoPtrList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerTwoPtrList msg)) where
+ toStruct (HoldsVerTwoPtrList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerTwoPtrList msg)) where
+ type InMessage (HoldsVerTwoPtrList msg) = msg
+ message (HoldsVerTwoPtrList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerTwoPtrList msg)) where
+ messageDefault msg = (HoldsVerTwoPtrList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerTwoPtrList msg)) where
+ fromPtr msg ptr = (HoldsVerTwoPtrList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerTwoPtrList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerTwoPtrList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerTwoPtrList (Message.MutMsg s))) where
+ new msg = (HoldsVerTwoPtrList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerTwoPtrList msg)) where
+ newtype List msg (HoldsVerTwoPtrList msg)
+ = HoldsVerTwoPtrList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerTwoPtrList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerTwoPtrList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerTwoPtrList'List_ l) = (Untyped.length l)
+ index i (HoldsVerTwoPtrList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerTwoPtrList (Message.MutMsg s))) where
+ setIndex (HoldsVerTwoPtrList'newtype_ elt) i (HoldsVerTwoPtrList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerTwoPtrList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerTwoPtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoPtrList msg) -> (m (Basics.List msg (VerTwoPtr msg)))
+get_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerTwoPtrList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoPtrList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoPtr (Message.MutMsg s))) -> (m ())
+set_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerTwoPtrList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoPtrList msg) -> (m Std_.Bool)
+has_HoldsVerTwoPtrList'mylist (HoldsVerTwoPtrList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerTwoPtrList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoPtrList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoPtr (Message.MutMsg s))))
+new_HoldsVerTwoPtrList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerTwoPtrList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerTwoTwoList msg
+ = HoldsVerTwoTwoList'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerTwoTwoList) where
+ tMsg f (HoldsVerTwoTwoList'newtype_ s) = (HoldsVerTwoTwoList'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerTwoTwoList msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerTwoTwoList'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerTwoTwoList msg)) where
+ toStruct (HoldsVerTwoTwoList'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerTwoTwoList msg)) where
+ type InMessage (HoldsVerTwoTwoList msg) = msg
+ message (HoldsVerTwoTwoList'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerTwoTwoList msg)) where
+ messageDefault msg = (HoldsVerTwoTwoList'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerTwoTwoList msg)) where
+ fromPtr msg ptr = (HoldsVerTwoTwoList'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerTwoTwoList (Message.MutMsg s))) where
+ toPtr msg (HoldsVerTwoTwoList'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerTwoTwoList (Message.MutMsg s))) where
+ new msg = (HoldsVerTwoTwoList'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerTwoTwoList msg)) where
+ newtype List msg (HoldsVerTwoTwoList msg)
+ = HoldsVerTwoTwoList'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerTwoTwoList'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerTwoTwoList'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerTwoTwoList'List_ l) = (Untyped.length l)
+ index i (HoldsVerTwoTwoList'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerTwoTwoList (Message.MutMsg s))) where
+ setIndex (HoldsVerTwoTwoList'newtype_ elt) i (HoldsVerTwoTwoList'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerTwoTwoList'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerTwoTwoList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoList msg) -> (m (Basics.List msg (VerTwoDataTwoPtr msg)))
+get_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerTwoTwoList'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoTwoList (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoDataTwoPtr (Message.MutMsg s))) -> (m ())
+set_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerTwoTwoList'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoList msg) -> (m Std_.Bool)
+has_HoldsVerTwoTwoList'mylist (HoldsVerTwoTwoList'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerTwoTwoList'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoTwoList (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoDataTwoPtr (Message.MutMsg s))))
+new_HoldsVerTwoTwoList'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerTwoTwoList'mylist struct result)
+ (Std_.pure result)
+ )
+newtype HoldsVerTwoTwoPlus msg
+ = HoldsVerTwoTwoPlus'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsVerTwoTwoPlus) where
+ tMsg f (HoldsVerTwoTwoPlus'newtype_ s) = (HoldsVerTwoTwoPlus'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsVerTwoTwoPlus msg)) where
+ fromStruct struct = (Std_.pure (HoldsVerTwoTwoPlus'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsVerTwoTwoPlus msg)) where
+ toStruct (HoldsVerTwoTwoPlus'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsVerTwoTwoPlus msg)) where
+ type InMessage (HoldsVerTwoTwoPlus msg) = msg
+ message (HoldsVerTwoTwoPlus'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsVerTwoTwoPlus msg)) where
+ messageDefault msg = (HoldsVerTwoTwoPlus'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsVerTwoTwoPlus msg)) where
+ fromPtr msg ptr = (HoldsVerTwoTwoPlus'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
+ toPtr msg (HoldsVerTwoTwoPlus'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
+ new msg = (HoldsVerTwoTwoPlus'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (HoldsVerTwoTwoPlus msg)) where
+ newtype List msg (HoldsVerTwoTwoPlus msg)
+ = HoldsVerTwoTwoPlus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsVerTwoTwoPlus'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsVerTwoTwoPlus'List_ l) = (Untyped.ListStruct l)
+ length (HoldsVerTwoTwoPlus'List_ l) = (Untyped.length l)
+ index i (HoldsVerTwoTwoPlus'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsVerTwoTwoPlus (Message.MutMsg s))) where
+ setIndex (HoldsVerTwoTwoPlus'newtype_ elt) i (HoldsVerTwoTwoPlus'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsVerTwoTwoPlus'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_HoldsVerTwoTwoPlus'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoPlus msg) -> (m (Basics.List msg (VerTwoTwoPlus msg)))
+get_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsVerTwoTwoPlus'mylist :: ((Untyped.RWCtx m s)) => (HoldsVerTwoTwoPlus (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (VerTwoTwoPlus (Message.MutMsg s))) -> (m ())
+set_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsVerTwoTwoPlus'mylist :: ((Untyped.ReadCtx m msg)) => (HoldsVerTwoTwoPlus msg) -> (m Std_.Bool)
+has_HoldsVerTwoTwoPlus'mylist (HoldsVerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsVerTwoTwoPlus'mylist :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsVerTwoTwoPlus (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (VerTwoTwoPlus (Message.MutMsg s))))
+new_HoldsVerTwoTwoPlus'mylist len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsVerTwoTwoPlus'mylist struct result)
+ (Std_.pure result)
+ )
+newtype VerTwoTwoPlus msg
+ = VerTwoTwoPlus'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VerTwoTwoPlus) where
+ tMsg f (VerTwoTwoPlus'newtype_ s) = (VerTwoTwoPlus'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VerTwoTwoPlus msg)) where
+ fromStruct struct = (Std_.pure (VerTwoTwoPlus'newtype_ struct))
+instance (Classes.ToStruct msg (VerTwoTwoPlus msg)) where
+ toStruct (VerTwoTwoPlus'newtype_ struct) = struct
+instance (Untyped.HasMessage (VerTwoTwoPlus msg)) where
+ type InMessage (VerTwoTwoPlus msg) = msg
+ message (VerTwoTwoPlus'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VerTwoTwoPlus msg)) where
+ messageDefault msg = (VerTwoTwoPlus'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VerTwoTwoPlus msg)) where
+ fromPtr msg ptr = (VerTwoTwoPlus'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VerTwoTwoPlus (Message.MutMsg s))) where
+ toPtr msg (VerTwoTwoPlus'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VerTwoTwoPlus (Message.MutMsg s))) where
+ new msg = (VerTwoTwoPlus'newtype_ <$> (Untyped.allocStruct msg 3 3))
+instance (Basics.ListElem msg (VerTwoTwoPlus msg)) where
+ newtype List msg (VerTwoTwoPlus msg)
+ = VerTwoTwoPlus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VerTwoTwoPlus'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VerTwoTwoPlus'List_ l) = (Untyped.ListStruct l)
+ length (VerTwoTwoPlus'List_ l) = (Untyped.length l)
+ index i (VerTwoTwoPlus'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VerTwoTwoPlus (Message.MutMsg s))) where
+ setIndex (VerTwoTwoPlus'newtype_ elt) i (VerTwoTwoPlus'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VerTwoTwoPlus'List_ <$> (Untyped.allocCompositeList msg 3 3 len))
+get_VerTwoTwoPlus'val :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int16)
+get_VerTwoTwoPlus'val (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_VerTwoTwoPlus'val :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int16 -> (m ())
+set_VerTwoTwoPlus'val (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+get_VerTwoTwoPlus'duo :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int64)
+get_VerTwoTwoPlus'duo (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_VerTwoTwoPlus'duo :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_VerTwoTwoPlus'duo (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 1 0 0)
+get_VerTwoTwoPlus'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (VerTwoDataTwoPtr msg))
+get_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoTwoPlus'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
+set_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_VerTwoTwoPlus'ptr1 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
+has_VerTwoTwoPlus'ptr1 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_VerTwoTwoPlus'ptr1 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
+new_VerTwoTwoPlus'ptr1 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoTwoPlus'ptr1 struct result)
+ (Std_.pure result)
+ )
+get_VerTwoTwoPlus'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (VerTwoDataTwoPtr msg))
+get_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoTwoPlus'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
+set_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_VerTwoTwoPlus'ptr2 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
+has_VerTwoTwoPlus'ptr2 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_VerTwoTwoPlus'ptr2 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
+new_VerTwoTwoPlus'ptr2 struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_VerTwoTwoPlus'ptr2 struct result)
+ (Std_.pure result)
+ )
+get_VerTwoTwoPlus'tre :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Int64)
+get_VerTwoTwoPlus'tre (VerTwoTwoPlus'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_VerTwoTwoPlus'tre :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_VerTwoTwoPlus'tre (VerTwoTwoPlus'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
+get_VerTwoTwoPlus'lst3 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m (Basics.List msg Std_.Int64))
+get_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_VerTwoTwoPlus'lst3 :: ((Untyped.RWCtx m s)) => (VerTwoTwoPlus (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) Std_.Int64) -> (m ())
+set_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_VerTwoTwoPlus'lst3 :: ((Untyped.ReadCtx m msg)) => (VerTwoTwoPlus msg) -> (m Std_.Bool)
+has_VerTwoTwoPlus'lst3 (VerTwoTwoPlus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_VerTwoTwoPlus'lst3 :: ((Untyped.RWCtx m s)) => Std_.Int -> (VerTwoTwoPlus (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) Std_.Int64))
+new_VerTwoTwoPlus'lst3 len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_VerTwoTwoPlus'lst3 struct result)
+ (Std_.pure result)
+ )
+newtype HoldsText msg
+ = HoldsText'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg HoldsText) where
+ tMsg f (HoldsText'newtype_ s) = (HoldsText'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (HoldsText msg)) where
+ fromStruct struct = (Std_.pure (HoldsText'newtype_ struct))
+instance (Classes.ToStruct msg (HoldsText msg)) where
+ toStruct (HoldsText'newtype_ struct) = struct
+instance (Untyped.HasMessage (HoldsText msg)) where
+ type InMessage (HoldsText msg) = msg
+ message (HoldsText'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (HoldsText msg)) where
+ messageDefault msg = (HoldsText'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (HoldsText msg)) where
+ fromPtr msg ptr = (HoldsText'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (HoldsText (Message.MutMsg s))) where
+ toPtr msg (HoldsText'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (HoldsText (Message.MutMsg s))) where
+ new msg = (HoldsText'newtype_ <$> (Untyped.allocStruct msg 0 3))
+instance (Basics.ListElem msg (HoldsText msg)) where
+ newtype List msg (HoldsText msg)
+ = HoldsText'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (HoldsText'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (HoldsText'List_ l) = (Untyped.ListStruct l)
+ length (HoldsText'List_ l) = (Untyped.length l)
+ index i (HoldsText'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (HoldsText (Message.MutMsg s))) where
+ setIndex (HoldsText'newtype_ elt) i (HoldsText'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (HoldsText'List_ <$> (Untyped.allocCompositeList msg 0 3 len))
+get_HoldsText'txt :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.Text msg))
+get_HoldsText'txt (HoldsText'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsText'txt :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_HoldsText'txt (HoldsText'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_HoldsText'txt :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
+has_HoldsText'txt (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_HoldsText'txt :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_HoldsText'txt len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_HoldsText'txt struct result)
+ (Std_.pure result)
+ )
+get_HoldsText'lst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.List msg (Basics.Text msg)))
+get_HoldsText'lst (HoldsText'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsText'lst :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
+set_HoldsText'lst (HoldsText'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_HoldsText'lst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
+has_HoldsText'lst (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_HoldsText'lst :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
+new_HoldsText'lst len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsText'lst struct result)
+ (Std_.pure result)
+ )
+get_HoldsText'lstlst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m (Basics.List msg (Basics.List msg (Basics.Text msg))))
+get_HoldsText'lstlst (HoldsText'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 2 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_HoldsText'lstlst :: ((Untyped.RWCtx m s)) => (HoldsText (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s)))) -> (m ())
+set_HoldsText'lstlst (HoldsText'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 2 struct)
+ )
+has_HoldsText'lstlst :: ((Untyped.ReadCtx m msg)) => (HoldsText msg) -> (m Std_.Bool)
+has_HoldsText'lstlst (HoldsText'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 2 struct))
+new_HoldsText'lstlst :: ((Untyped.RWCtx m s)) => Std_.Int -> (HoldsText (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s)))))
+new_HoldsText'lstlst len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_HoldsText'lstlst struct result)
+ (Std_.pure result)
+ )
+newtype WrapEmpty msg
+ = WrapEmpty'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg WrapEmpty) where
+ tMsg f (WrapEmpty'newtype_ s) = (WrapEmpty'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (WrapEmpty msg)) where
+ fromStruct struct = (Std_.pure (WrapEmpty'newtype_ struct))
+instance (Classes.ToStruct msg (WrapEmpty msg)) where
+ toStruct (WrapEmpty'newtype_ struct) = struct
+instance (Untyped.HasMessage (WrapEmpty msg)) where
+ type InMessage (WrapEmpty msg) = msg
+ message (WrapEmpty'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (WrapEmpty msg)) where
+ messageDefault msg = (WrapEmpty'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (WrapEmpty msg)) where
+ fromPtr msg ptr = (WrapEmpty'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (WrapEmpty (Message.MutMsg s))) where
+ toPtr msg (WrapEmpty'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (WrapEmpty (Message.MutMsg s))) where
+ new msg = (WrapEmpty'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (WrapEmpty msg)) where
+ newtype List msg (WrapEmpty msg)
+ = WrapEmpty'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (WrapEmpty'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (WrapEmpty'List_ l) = (Untyped.ListStruct l)
+ length (WrapEmpty'List_ l) = (Untyped.length l)
+ index i (WrapEmpty'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (WrapEmpty (Message.MutMsg s))) where
+ setIndex (WrapEmpty'newtype_ elt) i (WrapEmpty'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (WrapEmpty'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (WrapEmpty msg) -> (m (VerEmpty msg))
+get_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (WrapEmpty (Message.MutMsg s)) -> (VerEmpty (Message.MutMsg s)) -> (m ())
+set_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (WrapEmpty msg) -> (m Std_.Bool)
+has_WrapEmpty'mightNotBeReallyEmpty (WrapEmpty'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_WrapEmpty'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (WrapEmpty (Message.MutMsg s)) -> (m (VerEmpty (Message.MutMsg s)))
+new_WrapEmpty'mightNotBeReallyEmpty struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_WrapEmpty'mightNotBeReallyEmpty struct result)
+ (Std_.pure result)
+ )
+newtype Wrap2x2 msg
+ = Wrap2x2'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Wrap2x2) where
+ tMsg f (Wrap2x2'newtype_ s) = (Wrap2x2'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Wrap2x2 msg)) where
+ fromStruct struct = (Std_.pure (Wrap2x2'newtype_ struct))
+instance (Classes.ToStruct msg (Wrap2x2 msg)) where
+ toStruct (Wrap2x2'newtype_ struct) = struct
+instance (Untyped.HasMessage (Wrap2x2 msg)) where
+ type InMessage (Wrap2x2 msg) = msg
+ message (Wrap2x2'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Wrap2x2 msg)) where
+ messageDefault msg = (Wrap2x2'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Wrap2x2 msg)) where
+ fromPtr msg ptr = (Wrap2x2'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Wrap2x2 (Message.MutMsg s))) where
+ toPtr msg (Wrap2x2'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Wrap2x2 (Message.MutMsg s))) where
+ new msg = (Wrap2x2'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Wrap2x2 msg)) where
+ newtype List msg (Wrap2x2 msg)
+ = Wrap2x2'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Wrap2x2'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Wrap2x2'List_ l) = (Untyped.ListStruct l)
+ length (Wrap2x2'List_ l) = (Untyped.length l)
+ index i (Wrap2x2'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Wrap2x2 (Message.MutMsg s))) where
+ setIndex (Wrap2x2'newtype_ elt) i (Wrap2x2'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Wrap2x2'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2 msg) -> (m (VerTwoDataTwoPtr msg))
+get_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2 (Message.MutMsg s)) -> (VerTwoDataTwoPtr (Message.MutMsg s)) -> (m ())
+set_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2 msg) -> (m Std_.Bool)
+has_Wrap2x2'mightNotBeReallyEmpty (Wrap2x2'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Wrap2x2'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2 (Message.MutMsg s)) -> (m (VerTwoDataTwoPtr (Message.MutMsg s)))
+new_Wrap2x2'mightNotBeReallyEmpty struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Wrap2x2'mightNotBeReallyEmpty struct result)
+ (Std_.pure result)
+ )
+newtype Wrap2x2plus msg
+ = Wrap2x2plus'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Wrap2x2plus) where
+ tMsg f (Wrap2x2plus'newtype_ s) = (Wrap2x2plus'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Wrap2x2plus msg)) where
+ fromStruct struct = (Std_.pure (Wrap2x2plus'newtype_ struct))
+instance (Classes.ToStruct msg (Wrap2x2plus msg)) where
+ toStruct (Wrap2x2plus'newtype_ struct) = struct
+instance (Untyped.HasMessage (Wrap2x2plus msg)) where
+ type InMessage (Wrap2x2plus msg) = msg
+ message (Wrap2x2plus'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Wrap2x2plus msg)) where
+ messageDefault msg = (Wrap2x2plus'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Wrap2x2plus msg)) where
+ fromPtr msg ptr = (Wrap2x2plus'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Wrap2x2plus (Message.MutMsg s))) where
+ toPtr msg (Wrap2x2plus'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Wrap2x2plus (Message.MutMsg s))) where
+ new msg = (Wrap2x2plus'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Wrap2x2plus msg)) where
+ newtype List msg (Wrap2x2plus msg)
+ = Wrap2x2plus'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Wrap2x2plus'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Wrap2x2plus'List_ l) = (Untyped.ListStruct l)
+ length (Wrap2x2plus'List_ l) = (Untyped.length l)
+ index i (Wrap2x2plus'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Wrap2x2plus (Message.MutMsg s))) where
+ setIndex (Wrap2x2plus'newtype_ elt) i (Wrap2x2plus'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Wrap2x2plus'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2plus msg) -> (m (VerTwoTwoPlus msg))
+get_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2plus (Message.MutMsg s)) -> (VerTwoTwoPlus (Message.MutMsg s)) -> (m ())
+set_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.ReadCtx m msg)) => (Wrap2x2plus msg) -> (m Std_.Bool)
+has_Wrap2x2plus'mightNotBeReallyEmpty (Wrap2x2plus'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Wrap2x2plus'mightNotBeReallyEmpty :: ((Untyped.RWCtx m s)) => (Wrap2x2plus (Message.MutMsg s)) -> (m (VerTwoTwoPlus (Message.MutMsg s)))
+new_Wrap2x2plus'mightNotBeReallyEmpty struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Wrap2x2plus'mightNotBeReallyEmpty struct result)
+ (Std_.pure result)
+ )
+newtype VoidUnion msg
+ = VoidUnion'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg VoidUnion) where
+ tMsg f (VoidUnion'newtype_ s) = (VoidUnion'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (VoidUnion msg)) where
+ fromStruct struct = (Std_.pure (VoidUnion'newtype_ struct))
+instance (Classes.ToStruct msg (VoidUnion msg)) where
+ toStruct (VoidUnion'newtype_ struct) = struct
+instance (Untyped.HasMessage (VoidUnion msg)) where
+ type InMessage (VoidUnion msg) = msg
+ message (VoidUnion'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (VoidUnion msg)) where
+ messageDefault msg = (VoidUnion'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (VoidUnion msg)) where
+ fromPtr msg ptr = (VoidUnion'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (VoidUnion (Message.MutMsg s))) where
+ toPtr msg (VoidUnion'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (VoidUnion (Message.MutMsg s))) where
+ new msg = (VoidUnion'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (VoidUnion msg)) where
+ newtype List msg (VoidUnion msg)
+ = VoidUnion'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (VoidUnion'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (VoidUnion'List_ l) = (Untyped.ListStruct l)
+ length (VoidUnion'List_ l) = (Untyped.length l)
+ index i (VoidUnion'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (VoidUnion (Message.MutMsg s))) where
+ setIndex (VoidUnion'newtype_ elt) i (VoidUnion'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (VoidUnion'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+data VoidUnion' msg
+ = VoidUnion'a
+ | VoidUnion'b
+ | VoidUnion'unknown' Std_.Word16
+instance (Classes.FromStruct msg (VoidUnion' msg)) where
+ fromStruct struct = (do
+ tag <- (GenHelpers.getTag struct 0)
+ case tag of
+ 0 ->
+ (Std_.pure VoidUnion'a)
+ 1 ->
+ (Std_.pure VoidUnion'b)
+ _ ->
+ (Std_.pure (VoidUnion'unknown' (Std_.fromIntegral tag)))
+ )
+get_VoidUnion' :: ((Untyped.ReadCtx m msg)) => (VoidUnion msg) -> (m (VoidUnion' msg))
+get_VoidUnion' (VoidUnion'newtype_ struct) = (Classes.fromStruct struct)
+set_VoidUnion'a :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> (m ())
+set_VoidUnion'a (VoidUnion'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (0 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_VoidUnion'b :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> (m ())
+set_VoidUnion'b (VoidUnion'newtype_ struct) = (do
+ (GenHelpers.setWordField struct (1 :: Std_.Word16) 0 0 0)
+ (Std_.pure ())
+ )
+set_VoidUnion'unknown' :: ((Untyped.RWCtx m s)) => (VoidUnion (Message.MutMsg s)) -> Std_.Word16 -> (m ())
+set_VoidUnion'unknown' (VoidUnion'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word16) 0 0 0)
+newtype Nester1Capn msg
+ = Nester1Capn'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Nester1Capn) where
+ tMsg f (Nester1Capn'newtype_ s) = (Nester1Capn'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Nester1Capn msg)) where
+ fromStruct struct = (Std_.pure (Nester1Capn'newtype_ struct))
+instance (Classes.ToStruct msg (Nester1Capn msg)) where
+ toStruct (Nester1Capn'newtype_ struct) = struct
+instance (Untyped.HasMessage (Nester1Capn msg)) where
+ type InMessage (Nester1Capn msg) = msg
+ message (Nester1Capn'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Nester1Capn msg)) where
+ messageDefault msg = (Nester1Capn'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Nester1Capn msg)) where
+ fromPtr msg ptr = (Nester1Capn'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Nester1Capn (Message.MutMsg s))) where
+ toPtr msg (Nester1Capn'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Nester1Capn (Message.MutMsg s))) where
+ new msg = (Nester1Capn'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Nester1Capn msg)) where
+ newtype List msg (Nester1Capn msg)
+ = Nester1Capn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Nester1Capn'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Nester1Capn'List_ l) = (Untyped.ListStruct l)
+ length (Nester1Capn'List_ l) = (Untyped.length l)
+ index i (Nester1Capn'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Nester1Capn (Message.MutMsg s))) where
+ setIndex (Nester1Capn'newtype_ elt) i (Nester1Capn'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Nester1Capn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Nester1Capn'strs :: ((Untyped.ReadCtx m msg)) => (Nester1Capn msg) -> (m (Basics.List msg (Basics.Text msg)))
+get_Nester1Capn'strs (Nester1Capn'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Nester1Capn'strs :: ((Untyped.RWCtx m s)) => (Nester1Capn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))) -> (m ())
+set_Nester1Capn'strs (Nester1Capn'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Nester1Capn'strs :: ((Untyped.ReadCtx m msg)) => (Nester1Capn msg) -> (m Std_.Bool)
+has_Nester1Capn'strs (Nester1Capn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Nester1Capn'strs :: ((Untyped.RWCtx m s)) => Std_.Int -> (Nester1Capn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.Text (Message.MutMsg s))))
+new_Nester1Capn'strs len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_Nester1Capn'strs struct result)
+ (Std_.pure result)
+ )
+newtype RWTestCapn msg
+ = RWTestCapn'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg RWTestCapn) where
+ tMsg f (RWTestCapn'newtype_ s) = (RWTestCapn'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (RWTestCapn msg)) where
+ fromStruct struct = (Std_.pure (RWTestCapn'newtype_ struct))
+instance (Classes.ToStruct msg (RWTestCapn msg)) where
+ toStruct (RWTestCapn'newtype_ struct) = struct
+instance (Untyped.HasMessage (RWTestCapn msg)) where
+ type InMessage (RWTestCapn msg) = msg
+ message (RWTestCapn'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (RWTestCapn msg)) where
+ messageDefault msg = (RWTestCapn'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (RWTestCapn msg)) where
+ fromPtr msg ptr = (RWTestCapn'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (RWTestCapn (Message.MutMsg s))) where
+ toPtr msg (RWTestCapn'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (RWTestCapn (Message.MutMsg s))) where
+ new msg = (RWTestCapn'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (RWTestCapn msg)) where
+ newtype List msg (RWTestCapn msg)
+ = RWTestCapn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (RWTestCapn'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (RWTestCapn'List_ l) = (Untyped.ListStruct l)
+ length (RWTestCapn'List_ l) = (Untyped.length l)
+ index i (RWTestCapn'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (RWTestCapn (Message.MutMsg s))) where
+ setIndex (RWTestCapn'newtype_ elt) i (RWTestCapn'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (RWTestCapn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_RWTestCapn'nestMatrix :: ((Untyped.ReadCtx m msg)) => (RWTestCapn msg) -> (m (Basics.List msg (Basics.List msg (Nester1Capn msg))))
+get_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_RWTestCapn'nestMatrix :: ((Untyped.RWCtx m s)) => (RWTestCapn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s)))) -> (m ())
+set_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_RWTestCapn'nestMatrix :: ((Untyped.ReadCtx m msg)) => (RWTestCapn msg) -> (m Std_.Bool)
+has_RWTestCapn'nestMatrix (RWTestCapn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_RWTestCapn'nestMatrix :: ((Untyped.RWCtx m s)) => Std_.Int -> (RWTestCapn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s)))))
+new_RWTestCapn'nestMatrix len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_RWTestCapn'nestMatrix struct result)
+ (Std_.pure result)
+ )
+newtype ListStructCapn msg
+ = ListStructCapn'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg ListStructCapn) where
+ tMsg f (ListStructCapn'newtype_ s) = (ListStructCapn'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (ListStructCapn msg)) where
+ fromStruct struct = (Std_.pure (ListStructCapn'newtype_ struct))
+instance (Classes.ToStruct msg (ListStructCapn msg)) where
+ toStruct (ListStructCapn'newtype_ struct) = struct
+instance (Untyped.HasMessage (ListStructCapn msg)) where
+ type InMessage (ListStructCapn msg) = msg
+ message (ListStructCapn'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (ListStructCapn msg)) where
+ messageDefault msg = (ListStructCapn'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (ListStructCapn msg)) where
+ fromPtr msg ptr = (ListStructCapn'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (ListStructCapn (Message.MutMsg s))) where
+ toPtr msg (ListStructCapn'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (ListStructCapn (Message.MutMsg s))) where
+ new msg = (ListStructCapn'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (ListStructCapn msg)) where
+ newtype List msg (ListStructCapn msg)
+ = ListStructCapn'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (ListStructCapn'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (ListStructCapn'List_ l) = (Untyped.ListStruct l)
+ length (ListStructCapn'List_ l) = (Untyped.length l)
+ index i (ListStructCapn'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (ListStructCapn (Message.MutMsg s))) where
+ setIndex (ListStructCapn'newtype_ elt) i (ListStructCapn'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (ListStructCapn'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_ListStructCapn'vec :: ((Untyped.ReadCtx m msg)) => (ListStructCapn msg) -> (m (Basics.List msg (Nester1Capn msg)))
+get_ListStructCapn'vec (ListStructCapn'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_ListStructCapn'vec :: ((Untyped.RWCtx m s)) => (ListStructCapn (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s))) -> (m ())
+set_ListStructCapn'vec (ListStructCapn'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_ListStructCapn'vec :: ((Untyped.ReadCtx m msg)) => (ListStructCapn msg) -> (m Std_.Bool)
+has_ListStructCapn'vec (ListStructCapn'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_ListStructCapn'vec :: ((Untyped.RWCtx m s)) => Std_.Int -> (ListStructCapn (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (Nester1Capn (Message.MutMsg s))))
+new_ListStructCapn'vec len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_ListStructCapn'vec struct result)
+ (Std_.pure result)
+ )
+newtype Echo msg
+ = Echo'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Echo msg)) where
+ fromPtr msg ptr = (Echo'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo (Message.MutMsg s))) where
+ toPtr msg (Echo'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Echo'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Echo'echo'params msg
+ = Echo'echo'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Echo'echo'params) where
+ tMsg f (Echo'echo'params'newtype_ s) = (Echo'echo'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Echo'echo'params msg)) where
+ fromStruct struct = (Std_.pure (Echo'echo'params'newtype_ struct))
+instance (Classes.ToStruct msg (Echo'echo'params msg)) where
+ toStruct (Echo'echo'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Echo'echo'params msg)) where
+ type InMessage (Echo'echo'params msg) = msg
+ message (Echo'echo'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Echo'echo'params msg)) where
+ messageDefault msg = (Echo'echo'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Echo'echo'params msg)) where
+ fromPtr msg ptr = (Echo'echo'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo'echo'params (Message.MutMsg s))) where
+ toPtr msg (Echo'echo'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Echo'echo'params (Message.MutMsg s))) where
+ new msg = (Echo'echo'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Echo'echo'params msg)) where
+ newtype List msg (Echo'echo'params msg)
+ = Echo'echo'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Echo'echo'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Echo'echo'params'List_ l) = (Untyped.ListStruct l)
+ length (Echo'echo'params'List_ l) = (Untyped.length l)
+ index i (Echo'echo'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Echo'echo'params (Message.MutMsg s))) where
+ setIndex (Echo'echo'params'newtype_ elt) i (Echo'echo'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Echo'echo'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Echo'echo'params'in_ :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m (Basics.Text msg))
+get_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Echo'echo'params'in_ :: ((Untyped.RWCtx m s)) => (Echo'echo'params (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Echo'echo'params'in_ :: ((Untyped.ReadCtx m msg)) => (Echo'echo'params msg) -> (m Std_.Bool)
+has_Echo'echo'params'in_ (Echo'echo'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Echo'echo'params'in_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'params (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Echo'echo'params'in_ len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Echo'echo'params'in_ struct result)
+ (Std_.pure result)
+ )
+newtype Echo'echo'results msg
+ = Echo'echo'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Echo'echo'results) where
+ tMsg f (Echo'echo'results'newtype_ s) = (Echo'echo'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Echo'echo'results msg)) where
+ fromStruct struct = (Std_.pure (Echo'echo'results'newtype_ struct))
+instance (Classes.ToStruct msg (Echo'echo'results msg)) where
+ toStruct (Echo'echo'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Echo'echo'results msg)) where
+ type InMessage (Echo'echo'results msg) = msg
+ message (Echo'echo'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Echo'echo'results msg)) where
+ messageDefault msg = (Echo'echo'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Echo'echo'results msg)) where
+ fromPtr msg ptr = (Echo'echo'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Echo'echo'results (Message.MutMsg s))) where
+ toPtr msg (Echo'echo'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Echo'echo'results (Message.MutMsg s))) where
+ new msg = (Echo'echo'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Echo'echo'results msg)) where
+ newtype List msg (Echo'echo'results msg)
+ = Echo'echo'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Echo'echo'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Echo'echo'results'List_ l) = (Untyped.ListStruct l)
+ length (Echo'echo'results'List_ l) = (Untyped.length l)
+ index i (Echo'echo'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Echo'echo'results (Message.MutMsg s))) where
+ setIndex (Echo'echo'results'newtype_ elt) i (Echo'echo'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Echo'echo'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Echo'echo'results'out :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m (Basics.Text msg))
+get_Echo'echo'results'out (Echo'echo'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Echo'echo'results'out :: ((Untyped.RWCtx m s)) => (Echo'echo'results (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Echo'echo'results'out (Echo'echo'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Echo'echo'results'out :: ((Untyped.ReadCtx m msg)) => (Echo'echo'results msg) -> (m Std_.Bool)
+has_Echo'echo'results'out (Echo'echo'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Echo'echo'results'out :: ((Untyped.RWCtx m s)) => Std_.Int -> (Echo'echo'results (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Echo'echo'results'out len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Echo'echo'results'out struct result)
+ (Std_.pure result)
+ )
+newtype Hoth msg
+ = Hoth'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Hoth) where
+ tMsg f (Hoth'newtype_ s) = (Hoth'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Hoth msg)) where
+ fromStruct struct = (Std_.pure (Hoth'newtype_ struct))
+instance (Classes.ToStruct msg (Hoth msg)) where
+ toStruct (Hoth'newtype_ struct) = struct
+instance (Untyped.HasMessage (Hoth msg)) where
+ type InMessage (Hoth msg) = msg
+ message (Hoth'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Hoth msg)) where
+ messageDefault msg = (Hoth'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Hoth msg)) where
+ fromPtr msg ptr = (Hoth'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Hoth (Message.MutMsg s))) where
+ toPtr msg (Hoth'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Hoth (Message.MutMsg s))) where
+ new msg = (Hoth'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (Hoth msg)) where
+ newtype List msg (Hoth msg)
+ = Hoth'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Hoth'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Hoth'List_ l) = (Untyped.ListStruct l)
+ length (Hoth'List_ l) = (Untyped.length l)
+ index i (Hoth'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Hoth (Message.MutMsg s))) where
+ setIndex (Hoth'newtype_ elt) i (Hoth'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Hoth'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_Hoth'base :: ((Untyped.ReadCtx m msg)) => (Hoth msg) -> (m (EchoBase msg))
+get_Hoth'base (Hoth'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Hoth'base :: ((Untyped.RWCtx m s)) => (Hoth (Message.MutMsg s)) -> (EchoBase (Message.MutMsg s)) -> (m ())
+set_Hoth'base (Hoth'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Hoth'base :: ((Untyped.ReadCtx m msg)) => (Hoth msg) -> (m Std_.Bool)
+has_Hoth'base (Hoth'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Hoth'base :: ((Untyped.RWCtx m s)) => (Hoth (Message.MutMsg s)) -> (m (EchoBase (Message.MutMsg s)))
+new_Hoth'base struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_Hoth'base struct result)
+ (Std_.pure result)
+ )
+newtype EchoBase msg
+ = EchoBase'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg EchoBase) where
+ tMsg f (EchoBase'newtype_ s) = (EchoBase'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (EchoBase msg)) where
+ fromStruct struct = (Std_.pure (EchoBase'newtype_ struct))
+instance (Classes.ToStruct msg (EchoBase msg)) where
+ toStruct (EchoBase'newtype_ struct) = struct
+instance (Untyped.HasMessage (EchoBase msg)) where
+ type InMessage (EchoBase msg) = msg
+ message (EchoBase'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (EchoBase msg)) where
+ messageDefault msg = (EchoBase'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (EchoBase msg)) where
+ fromPtr msg ptr = (EchoBase'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (EchoBase (Message.MutMsg s))) where
+ toPtr msg (EchoBase'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (EchoBase (Message.MutMsg s))) where
+ new msg = (EchoBase'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (EchoBase msg)) where
+ newtype List msg (EchoBase msg)
+ = EchoBase'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (EchoBase'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (EchoBase'List_ l) = (Untyped.ListStruct l)
+ length (EchoBase'List_ l) = (Untyped.length l)
+ index i (EchoBase'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (EchoBase (Message.MutMsg s))) where
+ setIndex (EchoBase'newtype_ elt) i (EchoBase'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (EchoBase'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_EchoBase'echo :: ((Untyped.ReadCtx m msg)) => (EchoBase msg) -> (m (Echo msg))
+get_EchoBase'echo (EchoBase'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_EchoBase'echo :: ((Untyped.RWCtx m s)) => (EchoBase (Message.MutMsg s)) -> (Echo (Message.MutMsg s)) -> (m ())
+set_EchoBase'echo (EchoBase'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_EchoBase'echo :: ((Untyped.ReadCtx m msg)) => (EchoBase msg) -> (m Std_.Bool)
+has_EchoBase'echo (EchoBase'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype EchoBases msg
+ = EchoBases'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg EchoBases) where
+ tMsg f (EchoBases'newtype_ s) = (EchoBases'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (EchoBases msg)) where
+ fromStruct struct = (Std_.pure (EchoBases'newtype_ struct))
+instance (Classes.ToStruct msg (EchoBases msg)) where
+ toStruct (EchoBases'newtype_ struct) = struct
+instance (Untyped.HasMessage (EchoBases msg)) where
+ type InMessage (EchoBases msg) = msg
+ message (EchoBases'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (EchoBases msg)) where
+ messageDefault msg = (EchoBases'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (EchoBases msg)) where
+ fromPtr msg ptr = (EchoBases'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (EchoBases (Message.MutMsg s))) where
+ toPtr msg (EchoBases'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (EchoBases (Message.MutMsg s))) where
+ new msg = (EchoBases'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (EchoBases msg)) where
+ newtype List msg (EchoBases msg)
+ = EchoBases'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (EchoBases'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (EchoBases'List_ l) = (Untyped.ListStruct l)
+ length (EchoBases'List_ l) = (Untyped.length l)
+ index i (EchoBases'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (EchoBases (Message.MutMsg s))) where
+ setIndex (EchoBases'newtype_ elt) i (EchoBases'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (EchoBases'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_EchoBases'bases :: ((Untyped.ReadCtx m msg)) => (EchoBases msg) -> (m (Basics.List msg (EchoBase msg)))
+get_EchoBases'bases (EchoBases'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_EchoBases'bases :: ((Untyped.RWCtx m s)) => (EchoBases (Message.MutMsg s)) -> (Basics.List (Message.MutMsg s) (EchoBase (Message.MutMsg s))) -> (m ())
+set_EchoBases'bases (EchoBases'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_EchoBases'bases :: ((Untyped.ReadCtx m msg)) => (EchoBases msg) -> (m Std_.Bool)
+has_EchoBases'bases (EchoBases'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_EchoBases'bases :: ((Untyped.RWCtx m s)) => Std_.Int -> (EchoBases (Message.MutMsg s)) -> (m (Basics.List (Message.MutMsg s) (EchoBase (Message.MutMsg s))))
+new_EchoBases'bases len struct = (do
+ result <- (Classes.newList (Untyped.message struct) len)
+ (set_EchoBases'bases struct result)
+ (Std_.pure result)
+ )
+newtype StackingRoot msg
+ = StackingRoot'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg StackingRoot) where
+ tMsg f (StackingRoot'newtype_ s) = (StackingRoot'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (StackingRoot msg)) where
+ fromStruct struct = (Std_.pure (StackingRoot'newtype_ struct))
+instance (Classes.ToStruct msg (StackingRoot msg)) where
+ toStruct (StackingRoot'newtype_ struct) = struct
+instance (Untyped.HasMessage (StackingRoot msg)) where
+ type InMessage (StackingRoot msg) = msg
+ message (StackingRoot'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (StackingRoot msg)) where
+ messageDefault msg = (StackingRoot'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (StackingRoot msg)) where
+ fromPtr msg ptr = (StackingRoot'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (StackingRoot (Message.MutMsg s))) where
+ toPtr msg (StackingRoot'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (StackingRoot (Message.MutMsg s))) where
+ new msg = (StackingRoot'newtype_ <$> (Untyped.allocStruct msg 0 2))
+instance (Basics.ListElem msg (StackingRoot msg)) where
+ newtype List msg (StackingRoot msg)
+ = StackingRoot'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (StackingRoot'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (StackingRoot'List_ l) = (Untyped.ListStruct l)
+ length (StackingRoot'List_ l) = (Untyped.length l)
+ index i (StackingRoot'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (StackingRoot (Message.MutMsg s))) where
+ setIndex (StackingRoot'newtype_ elt) i (StackingRoot'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (StackingRoot'List_ <$> (Untyped.allocCompositeList msg 0 2 len))
+get_StackingRoot'aWithDefault :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m (StackingA msg))
+get_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_StackingRoot'aWithDefault :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (StackingA (Message.MutMsg s)) -> (m ())
+set_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_StackingRoot'aWithDefault :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m Std_.Bool)
+has_StackingRoot'aWithDefault (StackingRoot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_StackingRoot'aWithDefault :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (m (StackingA (Message.MutMsg s)))
+new_StackingRoot'aWithDefault struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_StackingRoot'aWithDefault struct result)
+ (Std_.pure result)
+ )
+get_StackingRoot'a :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m (StackingA msg))
+get_StackingRoot'a (StackingRoot'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_StackingRoot'a :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (StackingA (Message.MutMsg s)) -> (m ())
+set_StackingRoot'a (StackingRoot'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_StackingRoot'a :: ((Untyped.ReadCtx m msg)) => (StackingRoot msg) -> (m Std_.Bool)
+has_StackingRoot'a (StackingRoot'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_StackingRoot'a :: ((Untyped.RWCtx m s)) => (StackingRoot (Message.MutMsg s)) -> (m (StackingA (Message.MutMsg s)))
+new_StackingRoot'a struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_StackingRoot'a struct result)
+ (Std_.pure result)
+ )
+newtype StackingA msg
+ = StackingA'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg StackingA) where
+ tMsg f (StackingA'newtype_ s) = (StackingA'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (StackingA msg)) where
+ fromStruct struct = (Std_.pure (StackingA'newtype_ struct))
+instance (Classes.ToStruct msg (StackingA msg)) where
+ toStruct (StackingA'newtype_ struct) = struct
+instance (Untyped.HasMessage (StackingA msg)) where
+ type InMessage (StackingA msg) = msg
+ message (StackingA'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (StackingA msg)) where
+ messageDefault msg = (StackingA'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (StackingA msg)) where
+ fromPtr msg ptr = (StackingA'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (StackingA (Message.MutMsg s))) where
+ toPtr msg (StackingA'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (StackingA (Message.MutMsg s))) where
+ new msg = (StackingA'newtype_ <$> (Untyped.allocStruct msg 1 1))
+instance (Basics.ListElem msg (StackingA msg)) where
+ newtype List msg (StackingA msg)
+ = StackingA'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (StackingA'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (StackingA'List_ l) = (Untyped.ListStruct l)
+ length (StackingA'List_ l) = (Untyped.length l)
+ index i (StackingA'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (StackingA (Message.MutMsg s))) where
+ setIndex (StackingA'newtype_ elt) i (StackingA'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (StackingA'List_ <$> (Untyped.allocCompositeList msg 1 1 len))
+get_StackingA'num :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m Std_.Int32)
+get_StackingA'num (StackingA'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_StackingA'num :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_StackingA'num (StackingA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+get_StackingA'b :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m (StackingB msg))
+get_StackingA'b (StackingA'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_StackingA'b :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> (StackingB (Message.MutMsg s)) -> (m ())
+set_StackingA'b (StackingA'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_StackingA'b :: ((Untyped.ReadCtx m msg)) => (StackingA msg) -> (m Std_.Bool)
+has_StackingA'b (StackingA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_StackingA'b :: ((Untyped.RWCtx m s)) => (StackingA (Message.MutMsg s)) -> (m (StackingB (Message.MutMsg s)))
+new_StackingA'b struct = (do
+ result <- (Classes.new (Untyped.message struct))
+ (set_StackingA'b struct result)
+ (Std_.pure result)
+ )
+newtype StackingB msg
+ = StackingB'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg StackingB) where
+ tMsg f (StackingB'newtype_ s) = (StackingB'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (StackingB msg)) where
+ fromStruct struct = (Std_.pure (StackingB'newtype_ struct))
+instance (Classes.ToStruct msg (StackingB msg)) where
+ toStruct (StackingB'newtype_ struct) = struct
+instance (Untyped.HasMessage (StackingB msg)) where
+ type InMessage (StackingB msg) = msg
+ message (StackingB'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (StackingB msg)) where
+ messageDefault msg = (StackingB'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (StackingB msg)) where
+ fromPtr msg ptr = (StackingB'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (StackingB (Message.MutMsg s))) where
+ toPtr msg (StackingB'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (StackingB (Message.MutMsg s))) where
+ new msg = (StackingB'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (StackingB msg)) where
+ newtype List msg (StackingB msg)
+ = StackingB'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (StackingB'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (StackingB'List_ l) = (Untyped.ListStruct l)
+ length (StackingB'List_ l) = (Untyped.length l)
+ index i (StackingB'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (StackingB (Message.MutMsg s))) where
+ setIndex (StackingB'newtype_ elt) i (StackingB'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (StackingB'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_StackingB'num :: ((Untyped.ReadCtx m msg)) => (StackingB msg) -> (m Std_.Int32)
+get_StackingB'num (StackingB'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_StackingB'num :: ((Untyped.RWCtx m s)) => (StackingB (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_StackingB'num (StackingB'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+newtype CallSequence msg
+ = CallSequence'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (CallSequence msg)) where
+ fromPtr msg ptr = (CallSequence'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CallSequence (Message.MutMsg s))) where
+ toPtr msg (CallSequence'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (CallSequence'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype CallSequence'getNumber'params msg
+ = CallSequence'getNumber'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CallSequence'getNumber'params) where
+ tMsg f (CallSequence'getNumber'params'newtype_ s) = (CallSequence'getNumber'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CallSequence'getNumber'params msg)) where
+ fromStruct struct = (Std_.pure (CallSequence'getNumber'params'newtype_ struct))
+instance (Classes.ToStruct msg (CallSequence'getNumber'params msg)) where
+ toStruct (CallSequence'getNumber'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (CallSequence'getNumber'params msg)) where
+ type InMessage (CallSequence'getNumber'params msg) = msg
+ message (CallSequence'getNumber'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CallSequence'getNumber'params msg)) where
+ messageDefault msg = (CallSequence'getNumber'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CallSequence'getNumber'params msg)) where
+ fromPtr msg ptr = (CallSequence'getNumber'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CallSequence'getNumber'params (Message.MutMsg s))) where
+ toPtr msg (CallSequence'getNumber'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CallSequence'getNumber'params (Message.MutMsg s))) where
+ new msg = (CallSequence'getNumber'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (CallSequence'getNumber'params msg)) where
+ newtype List msg (CallSequence'getNumber'params msg)
+ = CallSequence'getNumber'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CallSequence'getNumber'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CallSequence'getNumber'params'List_ l) = (Untyped.ListStruct l)
+ length (CallSequence'getNumber'params'List_ l) = (Untyped.length l)
+ index i (CallSequence'getNumber'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CallSequence'getNumber'params (Message.MutMsg s))) where
+ setIndex (CallSequence'getNumber'params'newtype_ elt) i (CallSequence'getNumber'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CallSequence'getNumber'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype CallSequence'getNumber'results msg
+ = CallSequence'getNumber'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CallSequence'getNumber'results) where
+ tMsg f (CallSequence'getNumber'results'newtype_ s) = (CallSequence'getNumber'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CallSequence'getNumber'results msg)) where
+ fromStruct struct = (Std_.pure (CallSequence'getNumber'results'newtype_ struct))
+instance (Classes.ToStruct msg (CallSequence'getNumber'results msg)) where
+ toStruct (CallSequence'getNumber'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (CallSequence'getNumber'results msg)) where
+ type InMessage (CallSequence'getNumber'results msg) = msg
+ message (CallSequence'getNumber'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CallSequence'getNumber'results msg)) where
+ messageDefault msg = (CallSequence'getNumber'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CallSequence'getNumber'results msg)) where
+ fromPtr msg ptr = (CallSequence'getNumber'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CallSequence'getNumber'results (Message.MutMsg s))) where
+ toPtr msg (CallSequence'getNumber'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CallSequence'getNumber'results (Message.MutMsg s))) where
+ new msg = (CallSequence'getNumber'results'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (CallSequence'getNumber'results msg)) where
+ newtype List msg (CallSequence'getNumber'results msg)
+ = CallSequence'getNumber'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CallSequence'getNumber'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CallSequence'getNumber'results'List_ l) = (Untyped.ListStruct l)
+ length (CallSequence'getNumber'results'List_ l) = (Untyped.length l)
+ index i (CallSequence'getNumber'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CallSequence'getNumber'results (Message.MutMsg s))) where
+ setIndex (CallSequence'getNumber'results'newtype_ elt) i (CallSequence'getNumber'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CallSequence'getNumber'results'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_CallSequence'getNumber'results'n :: ((Untyped.ReadCtx m msg)) => (CallSequence'getNumber'results msg) -> (m Std_.Word32)
+get_CallSequence'getNumber'results'n (CallSequence'getNumber'results'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_CallSequence'getNumber'results'n :: ((Untyped.RWCtx m s)) => (CallSequence'getNumber'results (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_CallSequence'getNumber'results'n (CallSequence'getNumber'results'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+newtype CounterFactory msg
+ = CounterFactory'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (CounterFactory msg)) where
+ fromPtr msg ptr = (CounterFactory'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterFactory (Message.MutMsg s))) where
+ toPtr msg (CounterFactory'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (CounterFactory'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype CounterFactory'newCounter'params msg
+ = CounterFactory'newCounter'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CounterFactory'newCounter'params) where
+ tMsg f (CounterFactory'newCounter'params'newtype_ s) = (CounterFactory'newCounter'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CounterFactory'newCounter'params msg)) where
+ fromStruct struct = (Std_.pure (CounterFactory'newCounter'params'newtype_ struct))
+instance (Classes.ToStruct msg (CounterFactory'newCounter'params msg)) where
+ toStruct (CounterFactory'newCounter'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (CounterFactory'newCounter'params msg)) where
+ type InMessage (CounterFactory'newCounter'params msg) = msg
+ message (CounterFactory'newCounter'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CounterFactory'newCounter'params msg)) where
+ messageDefault msg = (CounterFactory'newCounter'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CounterFactory'newCounter'params msg)) where
+ fromPtr msg ptr = (CounterFactory'newCounter'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterFactory'newCounter'params (Message.MutMsg s))) where
+ toPtr msg (CounterFactory'newCounter'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CounterFactory'newCounter'params (Message.MutMsg s))) where
+ new msg = (CounterFactory'newCounter'params'newtype_ <$> (Untyped.allocStruct msg 1 0))
+instance (Basics.ListElem msg (CounterFactory'newCounter'params msg)) where
+ newtype List msg (CounterFactory'newCounter'params msg)
+ = CounterFactory'newCounter'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CounterFactory'newCounter'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CounterFactory'newCounter'params'List_ l) = (Untyped.ListStruct l)
+ length (CounterFactory'newCounter'params'List_ l) = (Untyped.length l)
+ index i (CounterFactory'newCounter'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CounterFactory'newCounter'params (Message.MutMsg s))) where
+ setIndex (CounterFactory'newCounter'params'newtype_ elt) i (CounterFactory'newCounter'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CounterFactory'newCounter'params'List_ <$> (Untyped.allocCompositeList msg 1 0 len))
+get_CounterFactory'newCounter'params'start :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'params msg) -> (m Std_.Word32)
+get_CounterFactory'newCounter'params'start (CounterFactory'newCounter'params'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_CounterFactory'newCounter'params'start :: ((Untyped.RWCtx m s)) => (CounterFactory'newCounter'params (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_CounterFactory'newCounter'params'start (CounterFactory'newCounter'params'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 0)
+newtype CounterFactory'newCounter'results msg
+ = CounterFactory'newCounter'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CounterFactory'newCounter'results) where
+ tMsg f (CounterFactory'newCounter'results'newtype_ s) = (CounterFactory'newCounter'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CounterFactory'newCounter'results msg)) where
+ fromStruct struct = (Std_.pure (CounterFactory'newCounter'results'newtype_ struct))
+instance (Classes.ToStruct msg (CounterFactory'newCounter'results msg)) where
+ toStruct (CounterFactory'newCounter'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (CounterFactory'newCounter'results msg)) where
+ type InMessage (CounterFactory'newCounter'results msg) = msg
+ message (CounterFactory'newCounter'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CounterFactory'newCounter'results msg)) where
+ messageDefault msg = (CounterFactory'newCounter'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CounterFactory'newCounter'results msg)) where
+ fromPtr msg ptr = (CounterFactory'newCounter'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterFactory'newCounter'results (Message.MutMsg s))) where
+ toPtr msg (CounterFactory'newCounter'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CounterFactory'newCounter'results (Message.MutMsg s))) where
+ new msg = (CounterFactory'newCounter'results'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (CounterFactory'newCounter'results msg)) where
+ newtype List msg (CounterFactory'newCounter'results msg)
+ = CounterFactory'newCounter'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CounterFactory'newCounter'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CounterFactory'newCounter'results'List_ l) = (Untyped.ListStruct l)
+ length (CounterFactory'newCounter'results'List_ l) = (Untyped.length l)
+ index i (CounterFactory'newCounter'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CounterFactory'newCounter'results (Message.MutMsg s))) where
+ setIndex (CounterFactory'newCounter'results'newtype_ elt) i (CounterFactory'newCounter'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CounterFactory'newCounter'results'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_CounterFactory'newCounter'results'counter :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'results msg) -> (m (CallSequence msg))
+get_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CounterFactory'newCounter'results'counter :: ((Untyped.RWCtx m s)) => (CounterFactory'newCounter'results (Message.MutMsg s)) -> (CallSequence (Message.MutMsg s)) -> (m ())
+set_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_CounterFactory'newCounter'results'counter :: ((Untyped.ReadCtx m msg)) => (CounterFactory'newCounter'results msg) -> (m Std_.Bool)
+has_CounterFactory'newCounter'results'counter (CounterFactory'newCounter'results'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype CounterAcceptor msg
+ = CounterAcceptor'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (CounterAcceptor msg)) where
+ fromPtr msg ptr = (CounterAcceptor'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterAcceptor (Message.MutMsg s))) where
+ toPtr msg (CounterAcceptor'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (CounterAcceptor'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype CounterAcceptor'accept'params msg
+ = CounterAcceptor'accept'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CounterAcceptor'accept'params) where
+ tMsg f (CounterAcceptor'accept'params'newtype_ s) = (CounterAcceptor'accept'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CounterAcceptor'accept'params msg)) where
+ fromStruct struct = (Std_.pure (CounterAcceptor'accept'params'newtype_ struct))
+instance (Classes.ToStruct msg (CounterAcceptor'accept'params msg)) where
+ toStruct (CounterAcceptor'accept'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (CounterAcceptor'accept'params msg)) where
+ type InMessage (CounterAcceptor'accept'params msg) = msg
+ message (CounterAcceptor'accept'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CounterAcceptor'accept'params msg)) where
+ messageDefault msg = (CounterAcceptor'accept'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CounterAcceptor'accept'params msg)) where
+ fromPtr msg ptr = (CounterAcceptor'accept'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterAcceptor'accept'params (Message.MutMsg s))) where
+ toPtr msg (CounterAcceptor'accept'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CounterAcceptor'accept'params (Message.MutMsg s))) where
+ new msg = (CounterAcceptor'accept'params'newtype_ <$> (Untyped.allocStruct msg 0 1))
+instance (Basics.ListElem msg (CounterAcceptor'accept'params msg)) where
+ newtype List msg (CounterAcceptor'accept'params msg)
+ = CounterAcceptor'accept'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CounterAcceptor'accept'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CounterAcceptor'accept'params'List_ l) = (Untyped.ListStruct l)
+ length (CounterAcceptor'accept'params'List_ l) = (Untyped.length l)
+ index i (CounterAcceptor'accept'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CounterAcceptor'accept'params (Message.MutMsg s))) where
+ setIndex (CounterAcceptor'accept'params'newtype_ elt) i (CounterAcceptor'accept'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CounterAcceptor'accept'params'List_ <$> (Untyped.allocCompositeList msg 0 1 len))
+get_CounterAcceptor'accept'params'counter :: ((Untyped.ReadCtx m msg)) => (CounterAcceptor'accept'params msg) -> (m (CallSequence msg))
+get_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_CounterAcceptor'accept'params'counter :: ((Untyped.RWCtx m s)) => (CounterAcceptor'accept'params (Message.MutMsg s)) -> (CallSequence (Message.MutMsg s)) -> (m ())
+set_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_CounterAcceptor'accept'params'counter :: ((Untyped.ReadCtx m msg)) => (CounterAcceptor'accept'params msg) -> (m Std_.Bool)
+has_CounterAcceptor'accept'params'counter (CounterAcceptor'accept'params'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+newtype CounterAcceptor'accept'results msg
+ = CounterAcceptor'accept'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg CounterAcceptor'accept'results) where
+ tMsg f (CounterAcceptor'accept'results'newtype_ s) = (CounterAcceptor'accept'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (CounterAcceptor'accept'results msg)) where
+ fromStruct struct = (Std_.pure (CounterAcceptor'accept'results'newtype_ struct))
+instance (Classes.ToStruct msg (CounterAcceptor'accept'results msg)) where
+ toStruct (CounterAcceptor'accept'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (CounterAcceptor'accept'results msg)) where
+ type InMessage (CounterAcceptor'accept'results msg) = msg
+ message (CounterAcceptor'accept'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (CounterAcceptor'accept'results msg)) where
+ messageDefault msg = (CounterAcceptor'accept'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (CounterAcceptor'accept'results msg)) where
+ fromPtr msg ptr = (CounterAcceptor'accept'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (CounterAcceptor'accept'results (Message.MutMsg s))) where
+ toPtr msg (CounterAcceptor'accept'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (CounterAcceptor'accept'results (Message.MutMsg s))) where
+ new msg = (CounterAcceptor'accept'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (CounterAcceptor'accept'results msg)) where
+ newtype List msg (CounterAcceptor'accept'results msg)
+ = CounterAcceptor'accept'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (CounterAcceptor'accept'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (CounterAcceptor'accept'results'List_ l) = (Untyped.ListStruct l)
+ length (CounterAcceptor'accept'results'List_ l) = (Untyped.length l)
+ index i (CounterAcceptor'accept'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (CounterAcceptor'accept'results (Message.MutMsg s))) where
+ setIndex (CounterAcceptor'accept'results'newtype_ elt) i (CounterAcceptor'accept'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (CounterAcceptor'accept'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Top msg
+ = Top'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Top msg)) where
+ fromPtr msg ptr = (Top'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Top (Message.MutMsg s))) where
+ toPtr msg (Top'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Top'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Top'top'params msg
+ = Top'top'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Top'top'params) where
+ tMsg f (Top'top'params'newtype_ s) = (Top'top'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Top'top'params msg)) where
+ fromStruct struct = (Std_.pure (Top'top'params'newtype_ struct))
+instance (Classes.ToStruct msg (Top'top'params msg)) where
+ toStruct (Top'top'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Top'top'params msg)) where
+ type InMessage (Top'top'params msg) = msg
+ message (Top'top'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Top'top'params msg)) where
+ messageDefault msg = (Top'top'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Top'top'params msg)) where
+ fromPtr msg ptr = (Top'top'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Top'top'params (Message.MutMsg s))) where
+ toPtr msg (Top'top'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Top'top'params (Message.MutMsg s))) where
+ new msg = (Top'top'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Top'top'params msg)) where
+ newtype List msg (Top'top'params msg)
+ = Top'top'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Top'top'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Top'top'params'List_ l) = (Untyped.ListStruct l)
+ length (Top'top'params'List_ l) = (Untyped.length l)
+ index i (Top'top'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Top'top'params (Message.MutMsg s))) where
+ setIndex (Top'top'params'newtype_ elt) i (Top'top'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Top'top'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Top'top'results msg
+ = Top'top'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Top'top'results) where
+ tMsg f (Top'top'results'newtype_ s) = (Top'top'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Top'top'results msg)) where
+ fromStruct struct = (Std_.pure (Top'top'results'newtype_ struct))
+instance (Classes.ToStruct msg (Top'top'results msg)) where
+ toStruct (Top'top'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Top'top'results msg)) where
+ type InMessage (Top'top'results msg) = msg
+ message (Top'top'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Top'top'results msg)) where
+ messageDefault msg = (Top'top'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Top'top'results msg)) where
+ fromPtr msg ptr = (Top'top'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Top'top'results (Message.MutMsg s))) where
+ toPtr msg (Top'top'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Top'top'results (Message.MutMsg s))) where
+ new msg = (Top'top'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Top'top'results msg)) where
+ newtype List msg (Top'top'results msg)
+ = Top'top'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Top'top'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Top'top'results'List_ l) = (Untyped.ListStruct l)
+ length (Top'top'results'List_ l) = (Untyped.length l)
+ index i (Top'top'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Top'top'results (Message.MutMsg s))) where
+ setIndex (Top'top'results'newtype_ elt) i (Top'top'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Top'top'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Left msg
+ = Left'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Left msg)) where
+ fromPtr msg ptr = (Left'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Left (Message.MutMsg s))) where
+ toPtr msg (Left'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Left'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Left'left'params msg
+ = Left'left'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Left'left'params) where
+ tMsg f (Left'left'params'newtype_ s) = (Left'left'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Left'left'params msg)) where
+ fromStruct struct = (Std_.pure (Left'left'params'newtype_ struct))
+instance (Classes.ToStruct msg (Left'left'params msg)) where
+ toStruct (Left'left'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Left'left'params msg)) where
+ type InMessage (Left'left'params msg) = msg
+ message (Left'left'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Left'left'params msg)) where
+ messageDefault msg = (Left'left'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Left'left'params msg)) where
+ fromPtr msg ptr = (Left'left'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Left'left'params (Message.MutMsg s))) where
+ toPtr msg (Left'left'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Left'left'params (Message.MutMsg s))) where
+ new msg = (Left'left'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Left'left'params msg)) where
+ newtype List msg (Left'left'params msg)
+ = Left'left'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Left'left'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Left'left'params'List_ l) = (Untyped.ListStruct l)
+ length (Left'left'params'List_ l) = (Untyped.length l)
+ index i (Left'left'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Left'left'params (Message.MutMsg s))) where
+ setIndex (Left'left'params'newtype_ elt) i (Left'left'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Left'left'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Left'left'results msg
+ = Left'left'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Left'left'results) where
+ tMsg f (Left'left'results'newtype_ s) = (Left'left'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Left'left'results msg)) where
+ fromStruct struct = (Std_.pure (Left'left'results'newtype_ struct))
+instance (Classes.ToStruct msg (Left'left'results msg)) where
+ toStruct (Left'left'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Left'left'results msg)) where
+ type InMessage (Left'left'results msg) = msg
+ message (Left'left'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Left'left'results msg)) where
+ messageDefault msg = (Left'left'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Left'left'results msg)) where
+ fromPtr msg ptr = (Left'left'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Left'left'results (Message.MutMsg s))) where
+ toPtr msg (Left'left'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Left'left'results (Message.MutMsg s))) where
+ new msg = (Left'left'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Left'left'results msg)) where
+ newtype List msg (Left'left'results msg)
+ = Left'left'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Left'left'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Left'left'results'List_ l) = (Untyped.ListStruct l)
+ length (Left'left'results'List_ l) = (Untyped.length l)
+ index i (Left'left'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Left'left'results (Message.MutMsg s))) where
+ setIndex (Left'left'results'newtype_ elt) i (Left'left'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Left'left'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Right msg
+ = Right'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Right msg)) where
+ fromPtr msg ptr = (Right'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Right (Message.MutMsg s))) where
+ toPtr msg (Right'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Right'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Right'right'params msg
+ = Right'right'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Right'right'params) where
+ tMsg f (Right'right'params'newtype_ s) = (Right'right'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Right'right'params msg)) where
+ fromStruct struct = (Std_.pure (Right'right'params'newtype_ struct))
+instance (Classes.ToStruct msg (Right'right'params msg)) where
+ toStruct (Right'right'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Right'right'params msg)) where
+ type InMessage (Right'right'params msg) = msg
+ message (Right'right'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Right'right'params msg)) where
+ messageDefault msg = (Right'right'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Right'right'params msg)) where
+ fromPtr msg ptr = (Right'right'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Right'right'params (Message.MutMsg s))) where
+ toPtr msg (Right'right'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Right'right'params (Message.MutMsg s))) where
+ new msg = (Right'right'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Right'right'params msg)) where
+ newtype List msg (Right'right'params msg)
+ = Right'right'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Right'right'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Right'right'params'List_ l) = (Untyped.ListStruct l)
+ length (Right'right'params'List_ l) = (Untyped.length l)
+ index i (Right'right'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Right'right'params (Message.MutMsg s))) where
+ setIndex (Right'right'params'newtype_ elt) i (Right'right'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Right'right'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Right'right'results msg
+ = Right'right'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Right'right'results) where
+ tMsg f (Right'right'results'newtype_ s) = (Right'right'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Right'right'results msg)) where
+ fromStruct struct = (Std_.pure (Right'right'results'newtype_ struct))
+instance (Classes.ToStruct msg (Right'right'results msg)) where
+ toStruct (Right'right'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Right'right'results msg)) where
+ type InMessage (Right'right'results msg) = msg
+ message (Right'right'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Right'right'results msg)) where
+ messageDefault msg = (Right'right'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Right'right'results msg)) where
+ fromPtr msg ptr = (Right'right'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Right'right'results (Message.MutMsg s))) where
+ toPtr msg (Right'right'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Right'right'results (Message.MutMsg s))) where
+ new msg = (Right'right'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Right'right'results msg)) where
+ newtype List msg (Right'right'results msg)
+ = Right'right'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Right'right'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Right'right'results'List_ l) = (Untyped.ListStruct l)
+ length (Right'right'results'List_ l) = (Untyped.length l)
+ index i (Right'right'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Right'right'results (Message.MutMsg s))) where
+ setIndex (Right'right'results'newtype_ elt) i (Right'right'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Right'right'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Bottom msg
+ = Bottom'newtype_ (Std_.Maybe (Untyped.Cap msg))
+instance (Classes.FromPtr msg (Bottom msg)) where
+ fromPtr msg ptr = (Bottom'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Bottom (Message.MutMsg s))) where
+ toPtr msg (Bottom'newtype_ (Std_.Nothing)) = (Std_.pure Std_.Nothing)
+ toPtr msg (Bottom'newtype_ (Std_.Just cap)) = (Std_.pure (Std_.Just (Untyped.PtrCap cap)))
+newtype Bottom'bottom'params msg
+ = Bottom'bottom'params'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Bottom'bottom'params) where
+ tMsg f (Bottom'bottom'params'newtype_ s) = (Bottom'bottom'params'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Bottom'bottom'params msg)) where
+ fromStruct struct = (Std_.pure (Bottom'bottom'params'newtype_ struct))
+instance (Classes.ToStruct msg (Bottom'bottom'params msg)) where
+ toStruct (Bottom'bottom'params'newtype_ struct) = struct
+instance (Untyped.HasMessage (Bottom'bottom'params msg)) where
+ type InMessage (Bottom'bottom'params msg) = msg
+ message (Bottom'bottom'params'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Bottom'bottom'params msg)) where
+ messageDefault msg = (Bottom'bottom'params'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Bottom'bottom'params msg)) where
+ fromPtr msg ptr = (Bottom'bottom'params'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Bottom'bottom'params (Message.MutMsg s))) where
+ toPtr msg (Bottom'bottom'params'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Bottom'bottom'params (Message.MutMsg s))) where
+ new msg = (Bottom'bottom'params'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Bottom'bottom'params msg)) where
+ newtype List msg (Bottom'bottom'params msg)
+ = Bottom'bottom'params'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Bottom'bottom'params'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Bottom'bottom'params'List_ l) = (Untyped.ListStruct l)
+ length (Bottom'bottom'params'List_ l) = (Untyped.length l)
+ index i (Bottom'bottom'params'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Bottom'bottom'params (Message.MutMsg s))) where
+ setIndex (Bottom'bottom'params'newtype_ elt) i (Bottom'bottom'params'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Bottom'bottom'params'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Bottom'bottom'results msg
+ = Bottom'bottom'results'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Bottom'bottom'results) where
+ tMsg f (Bottom'bottom'results'newtype_ s) = (Bottom'bottom'results'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Bottom'bottom'results msg)) where
+ fromStruct struct = (Std_.pure (Bottom'bottom'results'newtype_ struct))
+instance (Classes.ToStruct msg (Bottom'bottom'results msg)) where
+ toStruct (Bottom'bottom'results'newtype_ struct) = struct
+instance (Untyped.HasMessage (Bottom'bottom'results msg)) where
+ type InMessage (Bottom'bottom'results msg) = msg
+ message (Bottom'bottom'results'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Bottom'bottom'results msg)) where
+ messageDefault msg = (Bottom'bottom'results'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Bottom'bottom'results msg)) where
+ fromPtr msg ptr = (Bottom'bottom'results'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Bottom'bottom'results (Message.MutMsg s))) where
+ toPtr msg (Bottom'bottom'results'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Bottom'bottom'results (Message.MutMsg s))) where
+ new msg = (Bottom'bottom'results'newtype_ <$> (Untyped.allocStruct msg 0 0))
+instance (Basics.ListElem msg (Bottom'bottom'results msg)) where
+ newtype List msg (Bottom'bottom'results msg)
+ = Bottom'bottom'results'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Bottom'bottom'results'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Bottom'bottom'results'List_ l) = (Untyped.ListStruct l)
+ length (Bottom'bottom'results'List_ l) = (Untyped.length l)
+ index i (Bottom'bottom'results'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Bottom'bottom'results (Message.MutMsg s))) where
+ setIndex (Bottom'bottom'results'newtype_ elt) i (Bottom'bottom'results'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Bottom'bottom'results'List_ <$> (Untyped.allocCompositeList msg 0 0 len))
+newtype Defaults msg
+ = Defaults'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg Defaults) where
+ tMsg f (Defaults'newtype_ s) = (Defaults'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (Defaults msg)) where
+ fromStruct struct = (Std_.pure (Defaults'newtype_ struct))
+instance (Classes.ToStruct msg (Defaults msg)) where
+ toStruct (Defaults'newtype_ struct) = struct
+instance (Untyped.HasMessage (Defaults msg)) where
+ type InMessage (Defaults msg) = msg
+ message (Defaults'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (Defaults msg)) where
+ messageDefault msg = (Defaults'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (Defaults msg)) where
+ fromPtr msg ptr = (Defaults'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (Defaults (Message.MutMsg s))) where
+ toPtr msg (Defaults'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (Defaults (Message.MutMsg s))) where
+ new msg = (Defaults'newtype_ <$> (Untyped.allocStruct msg 2 2))
+instance (Basics.ListElem msg (Defaults msg)) where
+ newtype List msg (Defaults msg)
+ = Defaults'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (Defaults'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (Defaults'List_ l) = (Untyped.ListStruct l)
+ length (Defaults'List_ l) = (Untyped.length l)
+ index i (Defaults'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (Defaults (Message.MutMsg s))) where
+ setIndex (Defaults'newtype_ elt) i (Defaults'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (Defaults'List_ <$> (Untyped.allocCompositeList msg 2 2 len))
+get_Defaults'text :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m (Basics.Text msg))
+get_Defaults'text (Defaults'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Defaults'text :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_Defaults'text (Defaults'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_Defaults'text :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Bool)
+has_Defaults'text (Defaults'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_Defaults'text :: ((Untyped.RWCtx m s)) => Std_.Int -> (Defaults (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_Defaults'text len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_Defaults'text struct result)
+ (Std_.pure result)
+ )
+get_Defaults'data_ :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m (Basics.Data msg))
+get_Defaults'data_ (Defaults'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_Defaults'data_ :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> (Basics.Data (Message.MutMsg s)) -> (m ())
+set_Defaults'data_ (Defaults'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_Defaults'data_ :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Bool)
+has_Defaults'data_ (Defaults'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_Defaults'data_ :: ((Untyped.RWCtx m s)) => Std_.Int -> (Defaults (Message.MutMsg s)) -> (m (Basics.Data (Message.MutMsg s)))
+new_Defaults'data_ len struct = (do
+ result <- (Basics.newData (Untyped.message struct) len)
+ (set_Defaults'data_ struct result)
+ (Std_.pure result)
+ )
+get_Defaults'float :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Float)
+get_Defaults'float (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 0 0 1078523331)
+set_Defaults'float :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Float -> (m ())
+set_Defaults'float (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 0 1078523331)
+get_Defaults'int :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Int32)
+get_Defaults'int (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 0 32 18446744073709551493)
+set_Defaults'int :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_Defaults'int (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 0 32 18446744073709551493)
+get_Defaults'uint :: ((Untyped.ReadCtx m msg)) => (Defaults msg) -> (m Std_.Word32)
+get_Defaults'uint (Defaults'newtype_ struct) = (GenHelpers.getWordField struct 1 0 42)
+set_Defaults'uint :: ((Untyped.RWCtx m s)) => (Defaults (Message.MutMsg s)) -> Std_.Word32 -> (m ())
+set_Defaults'uint (Defaults'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 42)
+newtype BenchmarkA msg
+ = BenchmarkA'newtype_ (Untyped.Struct msg)
+instance (Untyped.TraverseMsg BenchmarkA) where
+ tMsg f (BenchmarkA'newtype_ s) = (BenchmarkA'newtype_ <$> (Untyped.tMsg f s))
+instance (Classes.FromStruct msg (BenchmarkA msg)) where
+ fromStruct struct = (Std_.pure (BenchmarkA'newtype_ struct))
+instance (Classes.ToStruct msg (BenchmarkA msg)) where
+ toStruct (BenchmarkA'newtype_ struct) = struct
+instance (Untyped.HasMessage (BenchmarkA msg)) where
+ type InMessage (BenchmarkA msg) = msg
+ message (BenchmarkA'newtype_ struct) = (Untyped.message struct)
+instance (Untyped.MessageDefault (BenchmarkA msg)) where
+ messageDefault msg = (BenchmarkA'newtype_ (Untyped.messageDefault msg))
+instance (Classes.FromPtr msg (BenchmarkA msg)) where
+ fromPtr msg ptr = (BenchmarkA'newtype_ <$> (Classes.fromPtr msg ptr))
+instance (Classes.ToPtr s (BenchmarkA (Message.MutMsg s))) where
+ toPtr msg (BenchmarkA'newtype_ struct) = (Classes.toPtr msg struct)
+instance (Classes.Allocate s (BenchmarkA (Message.MutMsg s))) where
+ new msg = (BenchmarkA'newtype_ <$> (Untyped.allocStruct msg 3 2))
+instance (Basics.ListElem msg (BenchmarkA msg)) where
+ newtype List msg (BenchmarkA msg)
+ = BenchmarkA'List_ (Untyped.ListOf msg (Untyped.Struct msg))
+ listFromPtr msg ptr = (BenchmarkA'List_ <$> (Classes.fromPtr msg ptr))
+ toUntypedList (BenchmarkA'List_ l) = (Untyped.ListStruct l)
+ length (BenchmarkA'List_ l) = (Untyped.length l)
+ index i (BenchmarkA'List_ l) = (do
+ elt <- (Untyped.index i l)
+ (Classes.fromStruct elt)
+ )
+instance (Basics.MutListElem s (BenchmarkA (Message.MutMsg s))) where
+ setIndex (BenchmarkA'newtype_ elt) i (BenchmarkA'List_ l) = (Untyped.setIndex elt i l)
+ newList msg len = (BenchmarkA'List_ <$> (Untyped.allocCompositeList msg 3 2 len))
+get_BenchmarkA'name :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m (Basics.Text msg))
+get_BenchmarkA'name (BenchmarkA'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 0 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_BenchmarkA'name :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_BenchmarkA'name (BenchmarkA'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 0 struct)
+ )
+has_BenchmarkA'name :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
+has_BenchmarkA'name (BenchmarkA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 0 struct))
+new_BenchmarkA'name :: ((Untyped.RWCtx m s)) => Std_.Int -> (BenchmarkA (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_BenchmarkA'name len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_BenchmarkA'name struct result)
+ (Std_.pure result)
+ )
+get_BenchmarkA'birthDay :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Int64)
+get_BenchmarkA'birthDay (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 0 0 0)
+set_BenchmarkA'birthDay :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Int64 -> (m ())
+set_BenchmarkA'birthDay (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 0 0 0)
+get_BenchmarkA'phone :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m (Basics.Text msg))
+get_BenchmarkA'phone (BenchmarkA'newtype_ struct) = (do
+ ptr <- (Untyped.getPtr 1 struct)
+ (Classes.fromPtr (Untyped.message struct) ptr)
+ )
+set_BenchmarkA'phone :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> (Basics.Text (Message.MutMsg s)) -> (m ())
+set_BenchmarkA'phone (BenchmarkA'newtype_ struct) value = (do
+ ptr <- (Classes.toPtr (Untyped.message struct) value)
+ (Untyped.setPtr ptr 1 struct)
+ )
+has_BenchmarkA'phone :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
+has_BenchmarkA'phone (BenchmarkA'newtype_ struct) = (Std_.isJust <$> (Untyped.getPtr 1 struct))
+new_BenchmarkA'phone :: ((Untyped.RWCtx m s)) => Std_.Int -> (BenchmarkA (Message.MutMsg s)) -> (m (Basics.Text (Message.MutMsg s)))
+new_BenchmarkA'phone len struct = (do
+ result <- (Basics.newText (Untyped.message struct) len)
+ (set_BenchmarkA'phone struct result)
+ (Std_.pure result)
+ )
+get_BenchmarkA'siblings :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Int32)
+get_BenchmarkA'siblings (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 1 0 0)
+set_BenchmarkA'siblings :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Int32 -> (m ())
+set_BenchmarkA'siblings (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word32) 1 0 0)
+get_BenchmarkA'spouse :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Bool)
+get_BenchmarkA'spouse (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 1 32 0)
+set_BenchmarkA'spouse :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Bool -> (m ())
+set_BenchmarkA'spouse (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word1) 1 32 0)
+get_BenchmarkA'money :: ((Untyped.ReadCtx m msg)) => (BenchmarkA msg) -> (m Std_.Double)
+get_BenchmarkA'money (BenchmarkA'newtype_ struct) = (GenHelpers.getWordField struct 2 0 0)
+set_BenchmarkA'money :: ((Untyped.RWCtx m s)) => (BenchmarkA (Message.MutMsg s)) -> Std_.Double -> (m ())
+set_BenchmarkA'money (BenchmarkA'newtype_ struct) value = (GenHelpers.setWordField struct ((Std_.fromIntegral (Classes.toWord value)) :: Std_.Word64) 2 0 0)
diff --git a/gen/tests/Capnp/Gen/Aircraft/Pure.hs b/gen/tests/Capnp/Gen/Aircraft/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/tests/Capnp/Gen/Aircraft/Pure.hs
@@ -0,0 +1,2942 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.Aircraft.Pure(Capnp.Gen.ById.X832bcc6686a26d56.Airport(..)
+ ,constDate
+ ,constList
+ ,Capnp.Gen.ById.X832bcc6686a26d56.constEnum
+ ,Zdate(..)
+ ,Zdata(..)
+ ,PlaneBase(..)
+ ,B737(..)
+ ,A320(..)
+ ,F16(..)
+ ,Regression(..)
+ ,Aircraft(..)
+ ,Z(..)
+ ,Z'grp(..)
+ ,Counter(..)
+ ,Bag(..)
+ ,Zserver(..)
+ ,Zjob(..)
+ ,VerEmpty(..)
+ ,VerOneData(..)
+ ,VerTwoData(..)
+ ,VerOnePtr(..)
+ ,VerTwoPtr(..)
+ ,VerTwoDataTwoPtr(..)
+ ,HoldsVerEmptyList(..)
+ ,HoldsVerOneDataList(..)
+ ,HoldsVerTwoDataList(..)
+ ,HoldsVerOnePtrList(..)
+ ,HoldsVerTwoPtrList(..)
+ ,HoldsVerTwoTwoList(..)
+ ,HoldsVerTwoTwoPlus(..)
+ ,VerTwoTwoPlus(..)
+ ,HoldsText(..)
+ ,WrapEmpty(..)
+ ,Wrap2x2(..)
+ ,Wrap2x2plus(..)
+ ,VoidUnion(..)
+ ,Nester1Capn(..)
+ ,RWTestCapn(..)
+ ,ListStructCapn(..)
+ ,Echo(..)
+ ,Echo'server_(..)
+ ,export_Echo
+ ,Echo'echo'params(..)
+ ,Echo'echo'results(..)
+ ,Hoth(..)
+ ,EchoBase(..)
+ ,EchoBases(..)
+ ,StackingRoot(..)
+ ,StackingA(..)
+ ,StackingB(..)
+ ,CallSequence(..)
+ ,CallSequence'server_(..)
+ ,export_CallSequence
+ ,CallSequence'getNumber'params(..)
+ ,CallSequence'getNumber'results(..)
+ ,CounterFactory(..)
+ ,CounterFactory'server_(..)
+ ,export_CounterFactory
+ ,CounterFactory'newCounter'params(..)
+ ,CounterFactory'newCounter'results(..)
+ ,CounterAcceptor(..)
+ ,CounterAcceptor'server_(..)
+ ,export_CounterAcceptor
+ ,CounterAcceptor'accept'params(..)
+ ,CounterAcceptor'accept'results(..)
+ ,Top(..)
+ ,Top'server_(..)
+ ,export_Top
+ ,Top'top'params(..)
+ ,Top'top'results(..)
+ ,Left(..)
+ ,Left'server_(..)
+ ,export_Left
+ ,Left'left'params(..)
+ ,Left'left'results(..)
+ ,Right(..)
+ ,Right'server_(..)
+ ,export_Right
+ ,Right'right'params(..)
+ ,Right'right'results(..)
+ ,Bottom(..)
+ ,Bottom'server_(..)
+ ,export_Bottom
+ ,Bottom'bottom'params(..)
+ ,Bottom'bottom'results(..)
+ ,Defaults(..)
+ ,BenchmarkA(..)) where
+import qualified Capnp.GenHelpers.ReExports.Data.Vector as V
+import qualified Capnp.GenHelpers.ReExports.Data.Text as T
+import qualified Capnp.GenHelpers.ReExports.Data.ByteString as BS
+import qualified Capnp.GenHelpers.ReExports.Data.Default as Default
+import qualified GHC.Generics as Generics
+import qualified Control.Monad.IO.Class as MonadIO
+import qualified Capnp.Untyped.Pure as UntypedPure
+import qualified Capnp.Untyped as Untyped
+import qualified Capnp.Message as Message
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Basics.Pure as BasicsPure
+import qualified Capnp.GenHelpers.Pure as GenHelpersPure
+import qualified Capnp.Rpc.Untyped as Rpc
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.GenHelpers.Rpc as RpcHelpers
+import qualified Capnp.GenHelpers.ReExports.Control.Concurrent.STM as STM
+import qualified Capnp.GenHelpers.ReExports.Supervisors as Supervisors
+import qualified Capnp.Gen.ById.X832bcc6686a26d56
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
+constDate :: Zdate
+constDate = (GenHelpersPure.toPurePtrConst Capnp.Gen.ById.X832bcc6686a26d56.constDate)
+constList :: (V.Vector Zdate)
+constList = (GenHelpersPure.toPurePtrConst Capnp.Gen.ById.X832bcc6686a26d56.constList)
+data Zdate
+ = Zdate
+ {year :: Std_.Int16
+ ,month :: Std_.Word8
+ ,day :: Std_.Word8}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Zdate) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Zdate) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Zdate) where
+ type Cerial msg Zdate = (Capnp.Gen.ById.X832bcc6686a26d56.Zdate msg)
+ decerialize raw = (Zdate <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_Zdate'year raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Zdate'month raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Zdate'day raw))
+instance (Classes.Marshal Zdate) where
+ marshalInto raw_ value_ = case value_ of
+ Zdate{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Zdate'year raw_ year)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Zdate'month raw_ month)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Zdate'day raw_ day)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Zdate)
+instance (Classes.Cerialize (V.Vector Zdate)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Zdate))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Zdate)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Zdate))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdate)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdate))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdate)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Zdata
+ = Zdata
+ {data_ :: BS.ByteString}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Zdata) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Zdata) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Zdata) where
+ type Cerial msg Zdata = (Capnp.Gen.ById.X832bcc6686a26d56.Zdata msg)
+ decerialize raw = (Zdata <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Zdata'data_ raw) >>= Classes.decerialize))
+instance (Classes.Marshal Zdata) where
+ marshalInto raw_ value_ = case value_ of
+ Zdata{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) data_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Zdata'data_ raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Zdata)
+instance (Classes.Cerialize (V.Vector Zdata)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Zdata))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Zdata)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Zdata))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdata)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdata))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zdata)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data PlaneBase
+ = PlaneBase
+ {name :: T.Text
+ ,homes :: (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport)
+ ,rating :: Std_.Int64
+ ,canFly :: Std_.Bool
+ ,capacity :: Std_.Int64
+ ,maxSpeed :: Std_.Double}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default PlaneBase) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg PlaneBase) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize PlaneBase) where
+ type Cerial msg PlaneBase = (Capnp.Gen.ById.X832bcc6686a26d56.PlaneBase msg)
+ decerialize raw = (PlaneBase <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'name raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'homes raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'rating raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'canFly raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'capacity raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_PlaneBase'maxSpeed raw))
+instance (Classes.Marshal PlaneBase) where
+ marshalInto raw_ value_ = case value_ of
+ PlaneBase{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'name raw_))
+ ((Classes.cerialize (Untyped.message raw_) homes) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'homes raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'rating raw_ rating)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'canFly raw_ canFly)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'capacity raw_ capacity)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_PlaneBase'maxSpeed raw_ maxSpeed)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize PlaneBase)
+instance (Classes.Cerialize (V.Vector PlaneBase)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector PlaneBase))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector PlaneBase)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector PlaneBase))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PlaneBase)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PlaneBase))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector PlaneBase)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data B737
+ = B737
+ {base :: PlaneBase}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default B737) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg B737) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize B737) where
+ type Cerial msg B737 = (Capnp.Gen.ById.X832bcc6686a26d56.B737 msg)
+ decerialize raw = (B737 <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_B737'base raw) >>= Classes.decerialize))
+instance (Classes.Marshal B737) where
+ marshalInto raw_ value_ = case value_ of
+ B737{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) base) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_B737'base raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize B737)
+instance (Classes.Cerialize (V.Vector B737)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector B737))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector B737)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector B737))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector B737)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector B737))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector B737)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data A320
+ = A320
+ {base :: PlaneBase}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default A320) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg A320) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize A320) where
+ type Cerial msg A320 = (Capnp.Gen.ById.X832bcc6686a26d56.A320 msg)
+ decerialize raw = (A320 <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_A320'base raw) >>= Classes.decerialize))
+instance (Classes.Marshal A320) where
+ marshalInto raw_ value_ = case value_ of
+ A320{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) base) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_A320'base raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize A320)
+instance (Classes.Cerialize (V.Vector A320)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector A320))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector A320)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector A320))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector A320)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector A320))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector A320)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data F16
+ = F16
+ {base :: PlaneBase}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default F16) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg F16) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize F16) where
+ type Cerial msg F16 = (Capnp.Gen.ById.X832bcc6686a26d56.F16 msg)
+ decerialize raw = (F16 <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_F16'base raw) >>= Classes.decerialize))
+instance (Classes.Marshal F16) where
+ marshalInto raw_ value_ = case value_ of
+ F16{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) base) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_F16'base raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize F16)
+instance (Classes.Cerialize (V.Vector F16)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector F16))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector F16)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector F16))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector F16)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector F16))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector F16)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Regression
+ = Regression
+ {base :: PlaneBase
+ ,b0 :: Std_.Double
+ ,beta :: (V.Vector Std_.Double)
+ ,planes :: (V.Vector Aircraft)
+ ,ymu :: Std_.Double
+ ,ysd :: Std_.Double}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Regression) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Regression) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Regression) where
+ type Cerial msg Regression = (Capnp.Gen.ById.X832bcc6686a26d56.Regression msg)
+ decerialize raw = (Regression <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'base raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'b0 raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'beta raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'planes raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'ymu raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Regression'ysd raw))
+instance (Classes.Marshal Regression) where
+ marshalInto raw_ value_ = case value_ of
+ Regression{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) base) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'base raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'b0 raw_ b0)
+ ((Classes.cerialize (Untyped.message raw_) beta) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'beta raw_))
+ ((Classes.cerialize (Untyped.message raw_) planes) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'planes raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'ymu raw_ ymu)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Regression'ysd raw_ ysd)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Regression)
+instance (Classes.Cerialize (V.Vector Regression)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Regression))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Regression)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Regression))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Regression)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Regression))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Regression)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Aircraft
+ = Aircraft'void
+ | Aircraft'b737 B737
+ | Aircraft'a320 A320
+ | Aircraft'f16 F16
+ | Aircraft'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Aircraft) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Aircraft) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Aircraft) where
+ type Cerial msg Aircraft = (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.X832bcc6686a26d56.get_Aircraft' raw)
+ case raw of
+ (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft'void) ->
+ (Std_.pure Aircraft'void)
+ (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft'b737 raw) ->
+ (Aircraft'b737 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft'a320 raw) ->
+ (Aircraft'a320 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft'f16 raw) ->
+ (Aircraft'f16 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Aircraft'unknown' tag) ->
+ (Std_.pure (Aircraft'unknown' tag))
+ )
+instance (Classes.Marshal Aircraft) where
+ marshalInto raw_ value_ = case value_ of
+ (Aircraft'void) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Aircraft'void raw_)
+ (Aircraft'b737 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Aircraft'b737 raw_))
+ (Aircraft'a320 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Aircraft'a320 raw_))
+ (Aircraft'f16 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Aircraft'f16 raw_))
+ (Aircraft'unknown' tag) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Aircraft'unknown' raw_ tag)
+instance (Classes.Cerialize Aircraft)
+instance (Classes.Cerialize (V.Vector Aircraft)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Aircraft))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Aircraft)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Aircraft))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Aircraft)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Aircraft))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Aircraft)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Z
+ = Z'void
+ | Z'zz Z
+ | Z'f64 Std_.Double
+ | Z'f32 Std_.Float
+ | Z'i64 Std_.Int64
+ | Z'i32 Std_.Int32
+ | Z'i16 Std_.Int16
+ | Z'i8 Std_.Int8
+ | Z'u64 Std_.Word64
+ | Z'u32 Std_.Word32
+ | Z'u16 Std_.Word16
+ | Z'u8 Std_.Word8
+ | Z'bool Std_.Bool
+ | Z'text T.Text
+ | Z'blob BS.ByteString
+ | Z'f64vec (V.Vector Std_.Double)
+ | Z'f32vec (V.Vector Std_.Float)
+ | Z'i64vec (V.Vector Std_.Int64)
+ | Z'i32vec (V.Vector Std_.Int32)
+ | Z'i16vec (V.Vector Std_.Int16)
+ | Z'i8vec (V.Vector Std_.Int8)
+ | Z'u64vec (V.Vector Std_.Word64)
+ | Z'u32vec (V.Vector Std_.Word32)
+ | Z'u16vec (V.Vector Std_.Word16)
+ | Z'u8vec (V.Vector Std_.Word8)
+ | Z'zvec (V.Vector Z)
+ | Z'zvecvec (V.Vector (V.Vector Z))
+ | Z'zdate Zdate
+ | Z'zdata Zdata
+ | Z'aircraftvec (V.Vector Aircraft)
+ | Z'aircraft Aircraft
+ | Z'regression Regression
+ | Z'planebase PlaneBase
+ | Z'airport Capnp.Gen.ById.X832bcc6686a26d56.Airport
+ | Z'b737 B737
+ | Z'a320 A320
+ | Z'f16 F16
+ | Z'zdatevec (V.Vector Zdate)
+ | Z'zdatavec (V.Vector Zdata)
+ | Z'boolvec (V.Vector Std_.Bool)
+ | Z'datavec (V.Vector BS.ByteString)
+ | Z'textvec (V.Vector T.Text)
+ | Z'grp Z'grp
+ | Z'echo Echo
+ | Z'echoBases EchoBases
+ | Z'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Z) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Z) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Z) where
+ type Cerial msg Z = (Capnp.Gen.ById.X832bcc6686a26d56.Z msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.X832bcc6686a26d56.get_Z' raw)
+ case raw of
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'void) ->
+ (Std_.pure Z'void)
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zz raw) ->
+ (Z'zz <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'f64 raw) ->
+ (Std_.pure (Z'f64 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'f32 raw) ->
+ (Std_.pure (Z'f32 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i64 raw) ->
+ (Std_.pure (Z'i64 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i32 raw) ->
+ (Std_.pure (Z'i32 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i16 raw) ->
+ (Std_.pure (Z'i16 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i8 raw) ->
+ (Std_.pure (Z'i8 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u64 raw) ->
+ (Std_.pure (Z'u64 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u32 raw) ->
+ (Std_.pure (Z'u32 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u16 raw) ->
+ (Std_.pure (Z'u16 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u8 raw) ->
+ (Std_.pure (Z'u8 raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'bool raw) ->
+ (Std_.pure (Z'bool raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'text raw) ->
+ (Z'text <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'blob raw) ->
+ (Z'blob <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'f64vec raw) ->
+ (Z'f64vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'f32vec raw) ->
+ (Z'f32vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i64vec raw) ->
+ (Z'i64vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i32vec raw) ->
+ (Z'i32vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i16vec raw) ->
+ (Z'i16vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'i8vec raw) ->
+ (Z'i8vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u64vec raw) ->
+ (Z'u64vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u32vec raw) ->
+ (Z'u32vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u16vec raw) ->
+ (Z'u16vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'u8vec raw) ->
+ (Z'u8vec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zvec raw) ->
+ (Z'zvec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zvecvec raw) ->
+ (Z'zvecvec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zdate raw) ->
+ (Z'zdate <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zdata raw) ->
+ (Z'zdata <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'aircraftvec raw) ->
+ (Z'aircraftvec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'aircraft raw) ->
+ (Z'aircraft <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'regression raw) ->
+ (Z'regression <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'planebase raw) ->
+ (Z'planebase <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'airport raw) ->
+ (Std_.pure (Z'airport raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'b737 raw) ->
+ (Z'b737 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'a320 raw) ->
+ (Z'a320 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'f16 raw) ->
+ (Z'f16 <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zdatevec raw) ->
+ (Z'zdatevec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'zdatavec raw) ->
+ (Z'zdatavec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'boolvec raw) ->
+ (Z'boolvec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'datavec raw) ->
+ (Z'datavec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'textvec raw) ->
+ (Z'textvec <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'grp raw) ->
+ (Z'grp <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'echo raw) ->
+ (Z'echo <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'echoBases raw) ->
+ (Z'echoBases <$> (Classes.decerialize raw))
+ (Capnp.Gen.ById.X832bcc6686a26d56.Z'unknown' tag) ->
+ (Std_.pure (Z'unknown' tag))
+ )
+instance (Classes.Marshal Z) where
+ marshalInto raw_ value_ = case value_ of
+ (Z'void) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'void raw_)
+ (Z'zz arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zz raw_))
+ (Z'f64 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'f64 raw_ arg_)
+ (Z'f32 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'f32 raw_ arg_)
+ (Z'i64 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i64 raw_ arg_)
+ (Z'i32 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i32 raw_ arg_)
+ (Z'i16 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i16 raw_ arg_)
+ (Z'i8 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i8 raw_ arg_)
+ (Z'u64 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u64 raw_ arg_)
+ (Z'u32 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u32 raw_ arg_)
+ (Z'u16 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u16 raw_ arg_)
+ (Z'u8 arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u8 raw_ arg_)
+ (Z'bool arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'bool raw_ arg_)
+ (Z'text arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'text raw_))
+ (Z'blob arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'blob raw_))
+ (Z'f64vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'f64vec raw_))
+ (Z'f32vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'f32vec raw_))
+ (Z'i64vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i64vec raw_))
+ (Z'i32vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i32vec raw_))
+ (Z'i16vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i16vec raw_))
+ (Z'i8vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'i8vec raw_))
+ (Z'u64vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u64vec raw_))
+ (Z'u32vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u32vec raw_))
+ (Z'u16vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u16vec raw_))
+ (Z'u8vec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'u8vec raw_))
+ (Z'zvec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zvec raw_))
+ (Z'zvecvec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zvecvec raw_))
+ (Z'zdate arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zdate raw_))
+ (Z'zdata arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zdata raw_))
+ (Z'aircraftvec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'aircraftvec raw_))
+ (Z'aircraft arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'aircraft raw_))
+ (Z'regression arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'regression raw_))
+ (Z'planebase arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'planebase raw_))
+ (Z'airport arg_) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'airport raw_ arg_)
+ (Z'b737 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'b737 raw_))
+ (Z'a320 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'a320 raw_))
+ (Z'f16 arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'f16 raw_))
+ (Z'zdatevec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zdatevec raw_))
+ (Z'zdatavec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'zdatavec raw_))
+ (Z'boolvec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'boolvec raw_))
+ (Z'datavec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'datavec raw_))
+ (Z'textvec arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'textvec raw_))
+ (Z'grp arg_) ->
+ (do
+ raw_ <- (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'grp raw_)
+ (Classes.marshalInto raw_ arg_)
+ )
+ (Z'echo arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'echo raw_))
+ (Z'echoBases arg_) ->
+ ((Classes.cerialize (Untyped.message raw_) arg_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'echoBases raw_))
+ (Z'unknown' tag) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'unknown' raw_ tag)
+instance (Classes.Cerialize Z)
+instance (Classes.Cerialize (V.Vector Z)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Z))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Z)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Z))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Z)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Z))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Z)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Z'grp
+ = Z'grp'
+ {first :: Std_.Word64
+ ,second :: Std_.Word64}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Z'grp) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Z'grp) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Z'grp) where
+ type Cerial msg Z'grp = (Capnp.Gen.ById.X832bcc6686a26d56.Z'grp msg)
+ decerialize raw = (Z'grp' <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_Z'grp'first raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Z'grp'second raw))
+instance (Classes.Marshal Z'grp) where
+ marshalInto raw_ value_ = case value_ of
+ Z'grp'{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'grp'first raw_ first)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Z'grp'second raw_ second)
+ (Std_.pure ())
+ )
+data Counter
+ = Counter
+ {size :: Std_.Int64
+ ,words :: T.Text
+ ,wordlist :: (V.Vector T.Text)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Counter) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Counter) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Counter) where
+ type Cerial msg Counter = (Capnp.Gen.ById.X832bcc6686a26d56.Counter msg)
+ decerialize raw = (Counter <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_Counter'size raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Counter'words raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Counter'wordlist raw) >>= Classes.decerialize))
+instance (Classes.Marshal Counter) where
+ marshalInto raw_ value_ = case value_ of
+ Counter{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Counter'size raw_ size)
+ ((Classes.cerialize (Untyped.message raw_) words) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Counter'words raw_))
+ ((Classes.cerialize (Untyped.message raw_) wordlist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Counter'wordlist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Counter)
+instance (Classes.Cerialize (V.Vector Counter)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Counter))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Counter)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Counter))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Counter)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Counter))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Counter)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Bag
+ = Bag
+ {counter :: Counter}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Bag) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Bag) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Bag) where
+ type Cerial msg Bag = (Capnp.Gen.ById.X832bcc6686a26d56.Bag msg)
+ decerialize raw = (Bag <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Bag'counter raw) >>= Classes.decerialize))
+instance (Classes.Marshal Bag) where
+ marshalInto raw_ value_ = case value_ of
+ Bag{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) counter) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Bag'counter raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Bag)
+instance (Classes.Cerialize (V.Vector Bag)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Bag))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Bag)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Bag))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bag)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bag))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bag)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Zserver
+ = Zserver
+ {waitingjobs :: (V.Vector Zjob)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Zserver) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Zserver) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Zserver) where
+ type Cerial msg Zserver = (Capnp.Gen.ById.X832bcc6686a26d56.Zserver msg)
+ decerialize raw = (Zserver <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Zserver'waitingjobs raw) >>= Classes.decerialize))
+instance (Classes.Marshal Zserver) where
+ marshalInto raw_ value_ = case value_ of
+ Zserver{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) waitingjobs) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Zserver'waitingjobs raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Zserver)
+instance (Classes.Cerialize (V.Vector Zserver)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Zserver))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Zserver)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Zserver))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zserver)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zserver))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zserver)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Zjob
+ = Zjob
+ {cmd :: T.Text
+ ,args :: (V.Vector T.Text)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Zjob) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Zjob) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Zjob) where
+ type Cerial msg Zjob = (Capnp.Gen.ById.X832bcc6686a26d56.Zjob msg)
+ decerialize raw = (Zjob <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Zjob'cmd raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Zjob'args raw) >>= Classes.decerialize))
+instance (Classes.Marshal Zjob) where
+ marshalInto raw_ value_ = case value_ of
+ Zjob{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) cmd) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Zjob'cmd raw_))
+ ((Classes.cerialize (Untyped.message raw_) args) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Zjob'args raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Zjob)
+instance (Classes.Cerialize (V.Vector Zjob)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Zjob))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Zjob)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Zjob))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zjob)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zjob))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Zjob)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerEmpty
+ = VerEmpty
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerEmpty) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerEmpty) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerEmpty) where
+ type Cerial msg VerEmpty = (Capnp.Gen.ById.X832bcc6686a26d56.VerEmpty msg)
+ decerialize raw = (Std_.pure VerEmpty)
+instance (Classes.Marshal VerEmpty) where
+ marshalInto raw_ value_ = case value_ of
+ (VerEmpty) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerEmpty)
+instance (Classes.Cerialize (V.Vector VerEmpty)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerEmpty))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerEmpty)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerEmpty))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerEmpty)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerEmpty))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerEmpty)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerOneData
+ = VerOneData
+ {val :: Std_.Int16}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerOneData) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerOneData) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerOneData) where
+ type Cerial msg VerOneData = (Capnp.Gen.ById.X832bcc6686a26d56.VerOneData msg)
+ decerialize raw = (VerOneData <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerOneData'val raw))
+instance (Classes.Marshal VerOneData) where
+ marshalInto raw_ value_ = case value_ of
+ VerOneData{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerOneData'val raw_ val)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerOneData)
+instance (Classes.Cerialize (V.Vector VerOneData)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerOneData))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerOneData)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerOneData))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOneData)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOneData))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOneData)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerTwoData
+ = VerTwoData
+ {val :: Std_.Int16
+ ,duo :: Std_.Int64}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerTwoData) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerTwoData) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerTwoData) where
+ type Cerial msg VerTwoData = (Capnp.Gen.ById.X832bcc6686a26d56.VerTwoData msg)
+ decerialize raw = (VerTwoData <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoData'val raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoData'duo raw))
+instance (Classes.Marshal VerTwoData) where
+ marshalInto raw_ value_ = case value_ of
+ VerTwoData{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoData'val raw_ val)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoData'duo raw_ duo)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerTwoData)
+instance (Classes.Cerialize (V.Vector VerTwoData)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerTwoData))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerTwoData)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerTwoData))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoData)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoData))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoData)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerOnePtr
+ = VerOnePtr
+ {ptr :: VerOneData}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerOnePtr) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerOnePtr) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerOnePtr) where
+ type Cerial msg VerOnePtr = (Capnp.Gen.ById.X832bcc6686a26d56.VerOnePtr msg)
+ decerialize raw = (VerOnePtr <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerOnePtr'ptr raw) >>= Classes.decerialize))
+instance (Classes.Marshal VerOnePtr) where
+ marshalInto raw_ value_ = case value_ of
+ VerOnePtr{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) ptr) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerOnePtr'ptr raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerOnePtr)
+instance (Classes.Cerialize (V.Vector VerOnePtr)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerOnePtr))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerOnePtr)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerOnePtr))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOnePtr)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOnePtr))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerOnePtr)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerTwoPtr
+ = VerTwoPtr
+ {ptr1 :: VerOneData
+ ,ptr2 :: VerOneData}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerTwoPtr) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerTwoPtr) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerTwoPtr) where
+ type Cerial msg VerTwoPtr = (Capnp.Gen.ById.X832bcc6686a26d56.VerTwoPtr msg)
+ decerialize raw = (VerTwoPtr <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoPtr'ptr1 raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoPtr'ptr2 raw) >>= Classes.decerialize))
+instance (Classes.Marshal VerTwoPtr) where
+ marshalInto raw_ value_ = case value_ of
+ VerTwoPtr{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) ptr1) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoPtr'ptr1 raw_))
+ ((Classes.cerialize (Untyped.message raw_) ptr2) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoPtr'ptr2 raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerTwoPtr)
+instance (Classes.Cerialize (V.Vector VerTwoPtr)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerTwoPtr))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerTwoPtr)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerTwoPtr))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoPtr)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoPtr))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoPtr)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerTwoDataTwoPtr
+ = VerTwoDataTwoPtr
+ {val :: Std_.Int16
+ ,duo :: Std_.Int64
+ ,ptr1 :: VerOneData
+ ,ptr2 :: VerOneData}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerTwoDataTwoPtr) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerTwoDataTwoPtr) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerTwoDataTwoPtr) where
+ type Cerial msg VerTwoDataTwoPtr = (Capnp.Gen.ById.X832bcc6686a26d56.VerTwoDataTwoPtr msg)
+ decerialize raw = (VerTwoDataTwoPtr <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoDataTwoPtr'val raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoDataTwoPtr'duo raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoDataTwoPtr'ptr1 raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoDataTwoPtr'ptr2 raw) >>= Classes.decerialize))
+instance (Classes.Marshal VerTwoDataTwoPtr) where
+ marshalInto raw_ value_ = case value_ of
+ VerTwoDataTwoPtr{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoDataTwoPtr'val raw_ val)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoDataTwoPtr'duo raw_ duo)
+ ((Classes.cerialize (Untyped.message raw_) ptr1) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoDataTwoPtr'ptr1 raw_))
+ ((Classes.cerialize (Untyped.message raw_) ptr2) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoDataTwoPtr'ptr2 raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerTwoDataTwoPtr)
+instance (Classes.Cerialize (V.Vector VerTwoDataTwoPtr)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerTwoDataTwoPtr))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerTwoDataTwoPtr)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerTwoDataTwoPtr))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoDataTwoPtr)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoDataTwoPtr))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoDataTwoPtr)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerEmptyList
+ = HoldsVerEmptyList
+ {mylist :: (V.Vector VerEmpty)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerEmptyList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerEmptyList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerEmptyList) where
+ type Cerial msg HoldsVerEmptyList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerEmptyList msg)
+ decerialize raw = (HoldsVerEmptyList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerEmptyList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerEmptyList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerEmptyList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerEmptyList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerEmptyList)
+instance (Classes.Cerialize (V.Vector HoldsVerEmptyList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerEmptyList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerEmptyList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerEmptyList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerEmptyList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerEmptyList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerEmptyList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerOneDataList
+ = HoldsVerOneDataList
+ {mylist :: (V.Vector VerOneData)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerOneDataList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerOneDataList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerOneDataList) where
+ type Cerial msg HoldsVerOneDataList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerOneDataList msg)
+ decerialize raw = (HoldsVerOneDataList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerOneDataList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerOneDataList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerOneDataList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerOneDataList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerOneDataList)
+instance (Classes.Cerialize (V.Vector HoldsVerOneDataList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerOneDataList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerOneDataList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOneDataList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOneDataList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOneDataList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOneDataList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerTwoDataList
+ = HoldsVerTwoDataList
+ {mylist :: (V.Vector VerTwoData)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerTwoDataList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerTwoDataList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerTwoDataList) where
+ type Cerial msg HoldsVerTwoDataList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerTwoDataList msg)
+ decerialize raw = (HoldsVerTwoDataList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerTwoDataList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerTwoDataList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerTwoDataList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerTwoDataList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerTwoDataList)
+instance (Classes.Cerialize (V.Vector HoldsVerTwoDataList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerTwoDataList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerTwoDataList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoDataList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoDataList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoDataList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoDataList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerOnePtrList
+ = HoldsVerOnePtrList
+ {mylist :: (V.Vector VerOnePtr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerOnePtrList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerOnePtrList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerOnePtrList) where
+ type Cerial msg HoldsVerOnePtrList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerOnePtrList msg)
+ decerialize raw = (HoldsVerOnePtrList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerOnePtrList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerOnePtrList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerOnePtrList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerOnePtrList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerOnePtrList)
+instance (Classes.Cerialize (V.Vector HoldsVerOnePtrList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerOnePtrList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerOnePtrList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOnePtrList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOnePtrList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOnePtrList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerOnePtrList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerTwoPtrList
+ = HoldsVerTwoPtrList
+ {mylist :: (V.Vector VerTwoPtr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerTwoPtrList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerTwoPtrList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerTwoPtrList) where
+ type Cerial msg HoldsVerTwoPtrList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerTwoPtrList msg)
+ decerialize raw = (HoldsVerTwoPtrList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerTwoPtrList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerTwoPtrList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerTwoPtrList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerTwoPtrList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerTwoPtrList)
+instance (Classes.Cerialize (V.Vector HoldsVerTwoPtrList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerTwoPtrList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerTwoPtrList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoPtrList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoPtrList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoPtrList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoPtrList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerTwoTwoList
+ = HoldsVerTwoTwoList
+ {mylist :: (V.Vector VerTwoDataTwoPtr)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerTwoTwoList) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerTwoTwoList) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerTwoTwoList) where
+ type Cerial msg HoldsVerTwoTwoList = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerTwoTwoList msg)
+ decerialize raw = (HoldsVerTwoTwoList <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerTwoTwoList'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerTwoTwoList) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerTwoTwoList{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerTwoTwoList'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerTwoTwoList)
+instance (Classes.Cerialize (V.Vector HoldsVerTwoTwoList)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerTwoTwoList))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoList)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoList))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoList)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoList))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoList)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsVerTwoTwoPlus
+ = HoldsVerTwoTwoPlus
+ {mylist :: (V.Vector VerTwoTwoPlus)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsVerTwoTwoPlus) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsVerTwoTwoPlus) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsVerTwoTwoPlus) where
+ type Cerial msg HoldsVerTwoTwoPlus = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsVerTwoTwoPlus msg)
+ decerialize raw = (HoldsVerTwoTwoPlus <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsVerTwoTwoPlus'mylist raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsVerTwoTwoPlus) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsVerTwoTwoPlus{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mylist) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsVerTwoTwoPlus'mylist raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsVerTwoTwoPlus)
+instance (Classes.Cerialize (V.Vector HoldsVerTwoTwoPlus)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsVerTwoTwoPlus))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoPlus)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoPlus))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoPlus)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoPlus))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsVerTwoTwoPlus)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VerTwoTwoPlus
+ = VerTwoTwoPlus
+ {val :: Std_.Int16
+ ,duo :: Std_.Int64
+ ,ptr1 :: VerTwoDataTwoPtr
+ ,ptr2 :: VerTwoDataTwoPtr
+ ,tre :: Std_.Int64
+ ,lst3 :: (V.Vector Std_.Int64)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VerTwoTwoPlus) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VerTwoTwoPlus) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VerTwoTwoPlus) where
+ type Cerial msg VerTwoTwoPlus = (Capnp.Gen.ById.X832bcc6686a26d56.VerTwoTwoPlus msg)
+ decerialize raw = (VerTwoTwoPlus <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'val raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'duo raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'ptr1 raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'ptr2 raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'tre raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_VerTwoTwoPlus'lst3 raw) >>= Classes.decerialize))
+instance (Classes.Marshal VerTwoTwoPlus) where
+ marshalInto raw_ value_ = case value_ of
+ VerTwoTwoPlus{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'val raw_ val)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'duo raw_ duo)
+ ((Classes.cerialize (Untyped.message raw_) ptr1) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'ptr1 raw_))
+ ((Classes.cerialize (Untyped.message raw_) ptr2) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'ptr2 raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'tre raw_ tre)
+ ((Classes.cerialize (Untyped.message raw_) lst3) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_VerTwoTwoPlus'lst3 raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize VerTwoTwoPlus)
+instance (Classes.Cerialize (V.Vector VerTwoTwoPlus)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VerTwoTwoPlus))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VerTwoTwoPlus)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VerTwoTwoPlus))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoTwoPlus)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoTwoPlus))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VerTwoTwoPlus)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data HoldsText
+ = HoldsText
+ {txt :: T.Text
+ ,lst :: (V.Vector T.Text)
+ ,lstlst :: (V.Vector (V.Vector T.Text))}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default HoldsText) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg HoldsText) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize HoldsText) where
+ type Cerial msg HoldsText = (Capnp.Gen.ById.X832bcc6686a26d56.HoldsText msg)
+ decerialize raw = (HoldsText <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsText'txt raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsText'lst raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_HoldsText'lstlst raw) >>= Classes.decerialize))
+instance (Classes.Marshal HoldsText) where
+ marshalInto raw_ value_ = case value_ of
+ HoldsText{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) txt) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsText'txt raw_))
+ ((Classes.cerialize (Untyped.message raw_) lst) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsText'lst raw_))
+ ((Classes.cerialize (Untyped.message raw_) lstlst) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_HoldsText'lstlst raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize HoldsText)
+instance (Classes.Cerialize (V.Vector HoldsText)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector HoldsText))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector HoldsText)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector HoldsText))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsText)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsText))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector HoldsText)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data WrapEmpty
+ = WrapEmpty
+ {mightNotBeReallyEmpty :: VerEmpty}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default WrapEmpty) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg WrapEmpty) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize WrapEmpty) where
+ type Cerial msg WrapEmpty = (Capnp.Gen.ById.X832bcc6686a26d56.WrapEmpty msg)
+ decerialize raw = (WrapEmpty <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_WrapEmpty'mightNotBeReallyEmpty raw) >>= Classes.decerialize))
+instance (Classes.Marshal WrapEmpty) where
+ marshalInto raw_ value_ = case value_ of
+ WrapEmpty{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mightNotBeReallyEmpty) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_WrapEmpty'mightNotBeReallyEmpty raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize WrapEmpty)
+instance (Classes.Cerialize (V.Vector WrapEmpty)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector WrapEmpty))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector WrapEmpty)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector WrapEmpty))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector WrapEmpty)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector WrapEmpty))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector WrapEmpty)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Wrap2x2
+ = Wrap2x2
+ {mightNotBeReallyEmpty :: VerTwoDataTwoPtr}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Wrap2x2) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Wrap2x2) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Wrap2x2) where
+ type Cerial msg Wrap2x2 = (Capnp.Gen.ById.X832bcc6686a26d56.Wrap2x2 msg)
+ decerialize raw = (Wrap2x2 <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Wrap2x2'mightNotBeReallyEmpty raw) >>= Classes.decerialize))
+instance (Classes.Marshal Wrap2x2) where
+ marshalInto raw_ value_ = case value_ of
+ Wrap2x2{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mightNotBeReallyEmpty) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Wrap2x2'mightNotBeReallyEmpty raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Wrap2x2)
+instance (Classes.Cerialize (V.Vector Wrap2x2)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Wrap2x2))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Wrap2x2)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Wrap2x2plus
+ = Wrap2x2plus
+ {mightNotBeReallyEmpty :: VerTwoTwoPlus}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Wrap2x2plus) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Wrap2x2plus) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Wrap2x2plus) where
+ type Cerial msg Wrap2x2plus = (Capnp.Gen.ById.X832bcc6686a26d56.Wrap2x2plus msg)
+ decerialize raw = (Wrap2x2plus <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Wrap2x2plus'mightNotBeReallyEmpty raw) >>= Classes.decerialize))
+instance (Classes.Marshal Wrap2x2plus) where
+ marshalInto raw_ value_ = case value_ of
+ Wrap2x2plus{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) mightNotBeReallyEmpty) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Wrap2x2plus'mightNotBeReallyEmpty raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Wrap2x2plus)
+instance (Classes.Cerialize (V.Vector Wrap2x2plus)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Wrap2x2plus))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Wrap2x2plus)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2plus))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2plus)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2plus))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Wrap2x2plus)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data VoidUnion
+ = VoidUnion'a
+ | VoidUnion'b
+ | VoidUnion'unknown' Std_.Word16
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default VoidUnion) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg VoidUnion) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize VoidUnion) where
+ type Cerial msg VoidUnion = (Capnp.Gen.ById.X832bcc6686a26d56.VoidUnion msg)
+ decerialize raw = (do
+ raw <- (Capnp.Gen.ById.X832bcc6686a26d56.get_VoidUnion' raw)
+ case raw of
+ (Capnp.Gen.ById.X832bcc6686a26d56.VoidUnion'a) ->
+ (Std_.pure VoidUnion'a)
+ (Capnp.Gen.ById.X832bcc6686a26d56.VoidUnion'b) ->
+ (Std_.pure VoidUnion'b)
+ (Capnp.Gen.ById.X832bcc6686a26d56.VoidUnion'unknown' tag) ->
+ (Std_.pure (VoidUnion'unknown' tag))
+ )
+instance (Classes.Marshal VoidUnion) where
+ marshalInto raw_ value_ = case value_ of
+ (VoidUnion'a) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VoidUnion'a raw_)
+ (VoidUnion'b) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VoidUnion'b raw_)
+ (VoidUnion'unknown' tag) ->
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_VoidUnion'unknown' raw_ tag)
+instance (Classes.Cerialize VoidUnion)
+instance (Classes.Cerialize (V.Vector VoidUnion)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector VoidUnion))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector VoidUnion)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector VoidUnion))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VoidUnion)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VoidUnion))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector VoidUnion)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Nester1Capn
+ = Nester1Capn
+ {strs :: (V.Vector T.Text)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Nester1Capn) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Nester1Capn) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Nester1Capn) where
+ type Cerial msg Nester1Capn = (Capnp.Gen.ById.X832bcc6686a26d56.Nester1Capn msg)
+ decerialize raw = (Nester1Capn <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Nester1Capn'strs raw) >>= Classes.decerialize))
+instance (Classes.Marshal Nester1Capn) where
+ marshalInto raw_ value_ = case value_ of
+ Nester1Capn{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) strs) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Nester1Capn'strs raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Nester1Capn)
+instance (Classes.Cerialize (V.Vector Nester1Capn)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Nester1Capn))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Nester1Capn)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Nester1Capn))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Nester1Capn)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Nester1Capn))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Nester1Capn)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data RWTestCapn
+ = RWTestCapn
+ {nestMatrix :: (V.Vector (V.Vector Nester1Capn))}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default RWTestCapn) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg RWTestCapn) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize RWTestCapn) where
+ type Cerial msg RWTestCapn = (Capnp.Gen.ById.X832bcc6686a26d56.RWTestCapn msg)
+ decerialize raw = (RWTestCapn <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_RWTestCapn'nestMatrix raw) >>= Classes.decerialize))
+instance (Classes.Marshal RWTestCapn) where
+ marshalInto raw_ value_ = case value_ of
+ RWTestCapn{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) nestMatrix) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_RWTestCapn'nestMatrix raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize RWTestCapn)
+instance (Classes.Cerialize (V.Vector RWTestCapn)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector RWTestCapn))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector RWTestCapn)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector RWTestCapn))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RWTestCapn)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RWTestCapn))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector RWTestCapn)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data ListStructCapn
+ = ListStructCapn
+ {vec :: (V.Vector Nester1Capn)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default ListStructCapn) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg ListStructCapn) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize ListStructCapn) where
+ type Cerial msg ListStructCapn = (Capnp.Gen.ById.X832bcc6686a26d56.ListStructCapn msg)
+ decerialize raw = (ListStructCapn <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_ListStructCapn'vec raw) >>= Classes.decerialize))
+instance (Classes.Marshal ListStructCapn) where
+ marshalInto raw_ value_ = case value_ of
+ ListStructCapn{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) vec) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_ListStructCapn'vec raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize ListStructCapn)
+instance (Classes.Cerialize (V.Vector ListStructCapn)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector ListStructCapn))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector ListStructCapn)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector ListStructCapn))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ListStructCapn)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ListStructCapn))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector ListStructCapn)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Echo
+ = Echo Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Echo'server_ m cap) where
+ {-# MINIMAL echo'echo #-}
+ echo'echo :: cap -> (Server.MethodHandler m Echo'echo'params Echo'echo'results)
+ echo'echo _ = Server.methodUnimplemented
+export_Echo :: ((Echo'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Echo)
+export_Echo sup_ server_ = (Echo <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 10255578992688506164 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (echo'echo server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Echo) where
+ fromClient = Echo
+ toClient (Echo client) = client
+instance (Classes.FromPtr msg Echo) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Echo) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Echo) where
+ type Cerial msg Echo = (Capnp.Gen.ById.X832bcc6686a26d56.Echo msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.Echo'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Echo Message.nullClient))
+ (Std_.Just cap) ->
+ (Echo <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Echo) where
+ cerialize msg (Echo client) = (Capnp.Gen.ById.X832bcc6686a26d56.Echo'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Echo'server_ Std_.IO Echo) where
+ echo'echo (Echo client) = (Rpc.clientMethodHandler 10255578992688506164 0 client)
+data Echo'echo'params
+ = Echo'echo'params
+ {in_ :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Echo'echo'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Echo'echo'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Echo'echo'params) where
+ type Cerial msg Echo'echo'params = (Capnp.Gen.ById.X832bcc6686a26d56.Echo'echo'params msg)
+ decerialize raw = (Echo'echo'params <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Echo'echo'params'in_ raw) >>= Classes.decerialize))
+instance (Classes.Marshal Echo'echo'params) where
+ marshalInto raw_ value_ = case value_ of
+ Echo'echo'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) in_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Echo'echo'params'in_ raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Echo'echo'params)
+instance (Classes.Cerialize (V.Vector Echo'echo'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Echo'echo'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Echo'echo'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Echo'echo'results
+ = Echo'echo'results
+ {out :: T.Text}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Echo'echo'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Echo'echo'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Echo'echo'results) where
+ type Cerial msg Echo'echo'results = (Capnp.Gen.ById.X832bcc6686a26d56.Echo'echo'results msg)
+ decerialize raw = (Echo'echo'results <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Echo'echo'results'out raw) >>= Classes.decerialize))
+instance (Classes.Marshal Echo'echo'results) where
+ marshalInto raw_ value_ = case value_ of
+ Echo'echo'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) out) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Echo'echo'results'out raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Echo'echo'results)
+instance (Classes.Cerialize (V.Vector Echo'echo'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Echo'echo'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Echo'echo'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Echo'echo'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Hoth
+ = Hoth
+ {base :: EchoBase}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Hoth) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Hoth) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Hoth) where
+ type Cerial msg Hoth = (Capnp.Gen.ById.X832bcc6686a26d56.Hoth msg)
+ decerialize raw = (Hoth <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Hoth'base raw) >>= Classes.decerialize))
+instance (Classes.Marshal Hoth) where
+ marshalInto raw_ value_ = case value_ of
+ Hoth{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) base) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Hoth'base raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Hoth)
+instance (Classes.Cerialize (V.Vector Hoth)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Hoth))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Hoth)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Hoth))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Hoth)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Hoth))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Hoth)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data EchoBase
+ = EchoBase
+ {echo :: Echo}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default EchoBase) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg EchoBase) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize EchoBase) where
+ type Cerial msg EchoBase = (Capnp.Gen.ById.X832bcc6686a26d56.EchoBase msg)
+ decerialize raw = (EchoBase <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_EchoBase'echo raw) >>= Classes.decerialize))
+instance (Classes.Marshal EchoBase) where
+ marshalInto raw_ value_ = case value_ of
+ EchoBase{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) echo) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_EchoBase'echo raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize EchoBase)
+instance (Classes.Cerialize (V.Vector EchoBase)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector EchoBase))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector EchoBase)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector EchoBase))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBase)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBase))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBase)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data EchoBases
+ = EchoBases
+ {bases :: (V.Vector EchoBase)}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default EchoBases) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg EchoBases) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize EchoBases) where
+ type Cerial msg EchoBases = (Capnp.Gen.ById.X832bcc6686a26d56.EchoBases msg)
+ decerialize raw = (EchoBases <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_EchoBases'bases raw) >>= Classes.decerialize))
+instance (Classes.Marshal EchoBases) where
+ marshalInto raw_ value_ = case value_ of
+ EchoBases{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) bases) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_EchoBases'bases raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize EchoBases)
+instance (Classes.Cerialize (V.Vector EchoBases)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector EchoBases))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector EchoBases)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector EchoBases))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBases)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBases))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector EchoBases)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data StackingRoot
+ = StackingRoot
+ {aWithDefault :: StackingA
+ ,a :: StackingA}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default StackingRoot) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg StackingRoot) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize StackingRoot) where
+ type Cerial msg StackingRoot = (Capnp.Gen.ById.X832bcc6686a26d56.StackingRoot msg)
+ decerialize raw = (StackingRoot <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_StackingRoot'aWithDefault raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_StackingRoot'a raw) >>= Classes.decerialize))
+instance (Classes.Marshal StackingRoot) where
+ marshalInto raw_ value_ = case value_ of
+ StackingRoot{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) aWithDefault) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_StackingRoot'aWithDefault raw_))
+ ((Classes.cerialize (Untyped.message raw_) a) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_StackingRoot'a raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize StackingRoot)
+instance (Classes.Cerialize (V.Vector StackingRoot)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector StackingRoot))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector StackingRoot)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector StackingRoot))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingRoot)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingRoot))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingRoot)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data StackingA
+ = StackingA
+ {num :: Std_.Int32
+ ,b :: StackingB}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default StackingA) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg StackingA) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize StackingA) where
+ type Cerial msg StackingA = (Capnp.Gen.ById.X832bcc6686a26d56.StackingA msg)
+ decerialize raw = (StackingA <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_StackingA'num raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_StackingA'b raw) >>= Classes.decerialize))
+instance (Classes.Marshal StackingA) where
+ marshalInto raw_ value_ = case value_ of
+ StackingA{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_StackingA'num raw_ num)
+ ((Classes.cerialize (Untyped.message raw_) b) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_StackingA'b raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize StackingA)
+instance (Classes.Cerialize (V.Vector StackingA)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector StackingA))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector StackingA)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector StackingA))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingA)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingA))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingA)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data StackingB
+ = StackingB
+ {num :: Std_.Int32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default StackingB) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg StackingB) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize StackingB) where
+ type Cerial msg StackingB = (Capnp.Gen.ById.X832bcc6686a26d56.StackingB msg)
+ decerialize raw = (StackingB <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_StackingB'num raw))
+instance (Classes.Marshal StackingB) where
+ marshalInto raw_ value_ = case value_ of
+ StackingB{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_StackingB'num raw_ num)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize StackingB)
+instance (Classes.Cerialize (V.Vector StackingB)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector StackingB))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector StackingB)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector StackingB))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingB)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingB))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector StackingB)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype CallSequence
+ = CallSequence Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (CallSequence'server_ m cap) where
+ {-# MINIMAL callSequence'getNumber #-}
+ callSequence'getNumber :: cap -> (Server.MethodHandler m CallSequence'getNumber'params CallSequence'getNumber'results)
+ callSequence'getNumber _ = Server.methodUnimplemented
+export_CallSequence :: ((CallSequence'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM CallSequence)
+export_CallSequence sup_ server_ = (CallSequence <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 12371070827563042848 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (callSequence'getNumber server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient CallSequence) where
+ fromClient = CallSequence
+ toClient (CallSequence client) = client
+instance (Classes.FromPtr msg CallSequence) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s CallSequence) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize CallSequence) where
+ type Cerial msg CallSequence = (Capnp.Gen.ById.X832bcc6686a26d56.CallSequence msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.CallSequence'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (CallSequence Message.nullClient))
+ (Std_.Just cap) ->
+ (CallSequence <$> (Untyped.getClient cap))
+instance (Classes.Cerialize CallSequence) where
+ cerialize msg (CallSequence client) = (Capnp.Gen.ById.X832bcc6686a26d56.CallSequence'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (CallSequence'server_ Std_.IO CallSequence) where
+ callSequence'getNumber (CallSequence client) = (Rpc.clientMethodHandler 12371070827563042848 0 client)
+data CallSequence'getNumber'params
+ = CallSequence'getNumber'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CallSequence'getNumber'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CallSequence'getNumber'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CallSequence'getNumber'params) where
+ type Cerial msg CallSequence'getNumber'params = (Capnp.Gen.ById.X832bcc6686a26d56.CallSequence'getNumber'params msg)
+ decerialize raw = (Std_.pure CallSequence'getNumber'params)
+instance (Classes.Marshal CallSequence'getNumber'params) where
+ marshalInto raw_ value_ = case value_ of
+ (CallSequence'getNumber'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CallSequence'getNumber'params)
+instance (Classes.Cerialize (V.Vector CallSequence'getNumber'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CallSequence'getNumber'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CallSequence'getNumber'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CallSequence'getNumber'results
+ = CallSequence'getNumber'results
+ {n :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CallSequence'getNumber'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CallSequence'getNumber'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CallSequence'getNumber'results) where
+ type Cerial msg CallSequence'getNumber'results = (Capnp.Gen.ById.X832bcc6686a26d56.CallSequence'getNumber'results msg)
+ decerialize raw = (CallSequence'getNumber'results <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_CallSequence'getNumber'results'n raw))
+instance (Classes.Marshal CallSequence'getNumber'results) where
+ marshalInto raw_ value_ = case value_ of
+ CallSequence'getNumber'results{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_CallSequence'getNumber'results'n raw_ n)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CallSequence'getNumber'results)
+instance (Classes.Cerialize (V.Vector CallSequence'getNumber'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CallSequence'getNumber'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CallSequence'getNumber'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CallSequence'getNumber'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype CounterFactory
+ = CounterFactory Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (CounterFactory'server_ m cap) where
+ {-# MINIMAL counterFactory'newCounter #-}
+ counterFactory'newCounter :: cap -> (Server.MethodHandler m CounterFactory'newCounter'params CounterFactory'newCounter'results)
+ counterFactory'newCounter _ = Server.methodUnimplemented
+export_CounterFactory :: ((CounterFactory'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM CounterFactory)
+export_CounterFactory sup_ server_ = (CounterFactory <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 15610220054254702620 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (counterFactory'newCounter server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient CounterFactory) where
+ fromClient = CounterFactory
+ toClient (CounterFactory client) = client
+instance (Classes.FromPtr msg CounterFactory) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s CounterFactory) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize CounterFactory) where
+ type Cerial msg CounterFactory = (Capnp.Gen.ById.X832bcc6686a26d56.CounterFactory msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.CounterFactory'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (CounterFactory Message.nullClient))
+ (Std_.Just cap) ->
+ (CounterFactory <$> (Untyped.getClient cap))
+instance (Classes.Cerialize CounterFactory) where
+ cerialize msg (CounterFactory client) = (Capnp.Gen.ById.X832bcc6686a26d56.CounterFactory'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (CounterFactory'server_ Std_.IO CounterFactory) where
+ counterFactory'newCounter (CounterFactory client) = (Rpc.clientMethodHandler 15610220054254702620 0 client)
+data CounterFactory'newCounter'params
+ = CounterFactory'newCounter'params
+ {start :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CounterFactory'newCounter'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CounterFactory'newCounter'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CounterFactory'newCounter'params) where
+ type Cerial msg CounterFactory'newCounter'params = (Capnp.Gen.ById.X832bcc6686a26d56.CounterFactory'newCounter'params msg)
+ decerialize raw = (CounterFactory'newCounter'params <$> (Capnp.Gen.ById.X832bcc6686a26d56.get_CounterFactory'newCounter'params'start raw))
+instance (Classes.Marshal CounterFactory'newCounter'params) where
+ marshalInto raw_ value_ = case value_ of
+ CounterFactory'newCounter'params{..} ->
+ (do
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_CounterFactory'newCounter'params'start raw_ start)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CounterFactory'newCounter'params)
+instance (Classes.Cerialize (V.Vector CounterFactory'newCounter'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CounterFactory'newCounter'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CounterFactory'newCounter'results
+ = CounterFactory'newCounter'results
+ {counter :: CallSequence}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CounterFactory'newCounter'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CounterFactory'newCounter'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CounterFactory'newCounter'results) where
+ type Cerial msg CounterFactory'newCounter'results = (Capnp.Gen.ById.X832bcc6686a26d56.CounterFactory'newCounter'results msg)
+ decerialize raw = (CounterFactory'newCounter'results <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_CounterFactory'newCounter'results'counter raw) >>= Classes.decerialize))
+instance (Classes.Marshal CounterFactory'newCounter'results) where
+ marshalInto raw_ value_ = case value_ of
+ CounterFactory'newCounter'results{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) counter) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_CounterFactory'newCounter'results'counter raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CounterFactory'newCounter'results)
+instance (Classes.Cerialize (V.Vector CounterFactory'newCounter'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CounterFactory'newCounter'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterFactory'newCounter'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype CounterAcceptor
+ = CounterAcceptor Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (CounterAcceptor'server_ m cap) where
+ {-# MINIMAL counterAcceptor'accept #-}
+ counterAcceptor'accept :: cap -> (Server.MethodHandler m CounterAcceptor'accept'params CounterAcceptor'accept'results)
+ counterAcceptor'accept _ = Server.methodUnimplemented
+export_CounterAcceptor :: ((CounterAcceptor'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM CounterAcceptor)
+export_CounterAcceptor sup_ server_ = (CounterAcceptor <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 14317498215560924065 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (counterAcceptor'accept server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient CounterAcceptor) where
+ fromClient = CounterAcceptor
+ toClient (CounterAcceptor client) = client
+instance (Classes.FromPtr msg CounterAcceptor) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s CounterAcceptor) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize CounterAcceptor) where
+ type Cerial msg CounterAcceptor = (Capnp.Gen.ById.X832bcc6686a26d56.CounterAcceptor msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.CounterAcceptor'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (CounterAcceptor Message.nullClient))
+ (Std_.Just cap) ->
+ (CounterAcceptor <$> (Untyped.getClient cap))
+instance (Classes.Cerialize CounterAcceptor) where
+ cerialize msg (CounterAcceptor client) = (Capnp.Gen.ById.X832bcc6686a26d56.CounterAcceptor'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (CounterAcceptor'server_ Std_.IO CounterAcceptor) where
+ counterAcceptor'accept (CounterAcceptor client) = (Rpc.clientMethodHandler 14317498215560924065 0 client)
+data CounterAcceptor'accept'params
+ = CounterAcceptor'accept'params
+ {counter :: CallSequence}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CounterAcceptor'accept'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CounterAcceptor'accept'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CounterAcceptor'accept'params) where
+ type Cerial msg CounterAcceptor'accept'params = (Capnp.Gen.ById.X832bcc6686a26d56.CounterAcceptor'accept'params msg)
+ decerialize raw = (CounterAcceptor'accept'params <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_CounterAcceptor'accept'params'counter raw) >>= Classes.decerialize))
+instance (Classes.Marshal CounterAcceptor'accept'params) where
+ marshalInto raw_ value_ = case value_ of
+ CounterAcceptor'accept'params{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) counter) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_CounterAcceptor'accept'params'counter raw_))
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CounterAcceptor'accept'params)
+instance (Classes.Cerialize (V.Vector CounterAcceptor'accept'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CounterAcceptor'accept'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data CounterAcceptor'accept'results
+ = CounterAcceptor'accept'results
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default CounterAcceptor'accept'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg CounterAcceptor'accept'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize CounterAcceptor'accept'results) where
+ type Cerial msg CounterAcceptor'accept'results = (Capnp.Gen.ById.X832bcc6686a26d56.CounterAcceptor'accept'results msg)
+ decerialize raw = (Std_.pure CounterAcceptor'accept'results)
+instance (Classes.Marshal CounterAcceptor'accept'results) where
+ marshalInto raw_ value_ = case value_ of
+ (CounterAcceptor'accept'results) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize CounterAcceptor'accept'results)
+instance (Classes.Cerialize (V.Vector CounterAcceptor'accept'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector CounterAcceptor'accept'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector CounterAcceptor'accept'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Top
+ = Top Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)) => (Top'server_ m cap) where
+ {-# MINIMAL top'top #-}
+ top'top :: cap -> (Server.MethodHandler m Top'top'params Top'top'results)
+ top'top _ = Server.methodUnimplemented
+export_Top :: ((Top'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Top)
+export_Top sup_ server_ = (Top <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 17861645508359101525 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (top'top server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Top) where
+ fromClient = Top
+ toClient (Top client) = client
+instance (Classes.FromPtr msg Top) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Top) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Top) where
+ type Cerial msg Top = (Capnp.Gen.ById.X832bcc6686a26d56.Top msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.Top'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Top Message.nullClient))
+ (Std_.Just cap) ->
+ (Top <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Top) where
+ cerialize msg (Top client) = (Capnp.Gen.ById.X832bcc6686a26d56.Top'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Top'server_ Std_.IO Top) where
+ top'top (Top client) = (Rpc.clientMethodHandler 17861645508359101525 0 client)
+data Top'top'params
+ = Top'top'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Top'top'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Top'top'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Top'top'params) where
+ type Cerial msg Top'top'params = (Capnp.Gen.ById.X832bcc6686a26d56.Top'top'params msg)
+ decerialize raw = (Std_.pure Top'top'params)
+instance (Classes.Marshal Top'top'params) where
+ marshalInto raw_ value_ = case value_ of
+ (Top'top'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Top'top'params)
+instance (Classes.Cerialize (V.Vector Top'top'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Top'top'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Top'top'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Top'top'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Top'top'results
+ = Top'top'results
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Top'top'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Top'top'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Top'top'results) where
+ type Cerial msg Top'top'results = (Capnp.Gen.ById.X832bcc6686a26d56.Top'top'results msg)
+ decerialize raw = (Std_.pure Top'top'results)
+instance (Classes.Marshal Top'top'results) where
+ marshalInto raw_ value_ = case value_ of
+ (Top'top'results) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Top'top'results)
+instance (Classes.Cerialize (V.Vector Top'top'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Top'top'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Top'top'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Top'top'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Top'top'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Left
+ = Left Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)
+ ,(Top'server_ m cap)) => (Left'server_ m cap) where
+ {-# MINIMAL left'left #-}
+ left'left :: cap -> (Server.MethodHandler m Left'left'params Left'left'results)
+ left'left _ = Server.methodUnimplemented
+export_Left :: ((Left'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Left)
+export_Left sup_ server_ = (Left <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 17679152961798450446 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (left'left server_))
+ _ ->
+ Server.methodUnimplemented
+ 17861645508359101525 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (top'top server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Left) where
+ fromClient = Left
+ toClient (Left client) = client
+instance (Classes.FromPtr msg Left) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Left) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Left) where
+ type Cerial msg Left = (Capnp.Gen.ById.X832bcc6686a26d56.Left msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.Left'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Left Message.nullClient))
+ (Std_.Just cap) ->
+ (Left <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Left) where
+ cerialize msg (Left client) = (Capnp.Gen.ById.X832bcc6686a26d56.Left'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Left'server_ Std_.IO Left) where
+ left'left (Left client) = (Rpc.clientMethodHandler 17679152961798450446 0 client)
+instance (Top'server_ Std_.IO Left) where
+ top'top (Left client) = (Rpc.clientMethodHandler 17861645508359101525 0 client)
+data Left'left'params
+ = Left'left'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Left'left'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Left'left'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Left'left'params) where
+ type Cerial msg Left'left'params = (Capnp.Gen.ById.X832bcc6686a26d56.Left'left'params msg)
+ decerialize raw = (Std_.pure Left'left'params)
+instance (Classes.Marshal Left'left'params) where
+ marshalInto raw_ value_ = case value_ of
+ (Left'left'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Left'left'params)
+instance (Classes.Cerialize (V.Vector Left'left'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Left'left'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Left'left'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Left'left'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Left'left'results
+ = Left'left'results
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Left'left'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Left'left'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Left'left'results) where
+ type Cerial msg Left'left'results = (Capnp.Gen.ById.X832bcc6686a26d56.Left'left'results msg)
+ decerialize raw = (Std_.pure Left'left'results)
+instance (Classes.Marshal Left'left'results) where
+ marshalInto raw_ value_ = case value_ of
+ (Left'left'results) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Left'left'results)
+instance (Classes.Cerialize (V.Vector Left'left'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Left'left'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Left'left'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Left'left'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Left'left'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Right
+ = Right Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)
+ ,(Top'server_ m cap)) => (Right'server_ m cap) where
+ {-# MINIMAL right'right #-}
+ right'right :: cap -> (Server.MethodHandler m Right'right'params Right'right'results)
+ right'right _ = Server.methodUnimplemented
+export_Right :: ((Right'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Right)
+export_Right sup_ server_ = (Right <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 14712639595305348988 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (right'right server_))
+ _ ->
+ Server.methodUnimplemented
+ 17861645508359101525 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (top'top server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Right) where
+ fromClient = Right
+ toClient (Right client) = client
+instance (Classes.FromPtr msg Right) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Right) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Right) where
+ type Cerial msg Right = (Capnp.Gen.ById.X832bcc6686a26d56.Right msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.Right'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Right Message.nullClient))
+ (Std_.Just cap) ->
+ (Right <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Right) where
+ cerialize msg (Right client) = (Capnp.Gen.ById.X832bcc6686a26d56.Right'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Right'server_ Std_.IO Right) where
+ right'right (Right client) = (Rpc.clientMethodHandler 14712639595305348988 0 client)
+instance (Top'server_ Std_.IO Right) where
+ top'top (Right client) = (Rpc.clientMethodHandler 17861645508359101525 0 client)
+data Right'right'params
+ = Right'right'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Right'right'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Right'right'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Right'right'params) where
+ type Cerial msg Right'right'params = (Capnp.Gen.ById.X832bcc6686a26d56.Right'right'params msg)
+ decerialize raw = (Std_.pure Right'right'params)
+instance (Classes.Marshal Right'right'params) where
+ marshalInto raw_ value_ = case value_ of
+ (Right'right'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Right'right'params)
+instance (Classes.Cerialize (V.Vector Right'right'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Right'right'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Right'right'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Right'right'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Right'right'results
+ = Right'right'results
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Right'right'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Right'right'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Right'right'results) where
+ type Cerial msg Right'right'results = (Capnp.Gen.ById.X832bcc6686a26d56.Right'right'results msg)
+ decerialize raw = (Std_.pure Right'right'results)
+instance (Classes.Marshal Right'right'results) where
+ marshalInto raw_ value_ = case value_ of
+ (Right'right'results) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Right'right'results)
+instance (Classes.Cerialize (V.Vector Right'right'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Right'right'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Right'right'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Right'right'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Right'right'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+newtype Bottom
+ = Bottom Message.Client
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+class ((MonadIO.MonadIO m)
+ ,(Left'server_ m cap)
+ ,(Right'server_ m cap)) => (Bottom'server_ m cap) where
+ {-# MINIMAL bottom'bottom #-}
+ bottom'bottom :: cap -> (Server.MethodHandler m Bottom'bottom'params Bottom'bottom'results)
+ bottom'bottom _ = Server.methodUnimplemented
+export_Bottom :: ((Bottom'server_ Std_.IO a)) => Supervisors.Supervisor -> a -> (STM.STM Bottom)
+export_Bottom sup_ server_ = (Bottom <$> (Rpc.export sup_ Server.ServerOps{handleStop = (Std_.pure ())
+ ,handleCall = (\interfaceId_ methodId_ -> case interfaceId_ of
+ 18402872613340521775 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (bottom'bottom server_))
+ _ ->
+ Server.methodUnimplemented
+ 14712639595305348988 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (right'right server_))
+ _ ->
+ Server.methodUnimplemented
+ 17679152961798450446 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (left'left server_))
+ _ ->
+ Server.methodUnimplemented
+ 17861645508359101525 ->
+ case methodId_ of
+ 0 ->
+ (Server.toUntypedHandler (top'top server_))
+ _ ->
+ Server.methodUnimplemented
+ _ ->
+ Server.methodUnimplemented)}))
+instance (Rpc.IsClient Bottom) where
+ fromClient = Bottom
+ toClient (Bottom client) = client
+instance (Classes.FromPtr msg Bottom) where
+ fromPtr = RpcHelpers.isClientFromPtr
+instance (Classes.ToPtr s Bottom) where
+ toPtr = RpcHelpers.isClientToPtr
+instance (Classes.Decerialize Bottom) where
+ type Cerial msg Bottom = (Capnp.Gen.ById.X832bcc6686a26d56.Bottom msg)
+ decerialize (Capnp.Gen.ById.X832bcc6686a26d56.Bottom'newtype_ maybeCap) = case maybeCap of
+ (Std_.Nothing) ->
+ (Std_.pure (Bottom Message.nullClient))
+ (Std_.Just cap) ->
+ (Bottom <$> (Untyped.getClient cap))
+instance (Classes.Cerialize Bottom) where
+ cerialize msg (Bottom client) = (Capnp.Gen.ById.X832bcc6686a26d56.Bottom'newtype_ <$> (Std_.Just <$> (Untyped.appendCap msg client)))
+instance (Bottom'server_ Std_.IO Bottom) where
+ bottom'bottom (Bottom client) = (Rpc.clientMethodHandler 18402872613340521775 0 client)
+instance (Right'server_ Std_.IO Bottom) where
+ right'right (Bottom client) = (Rpc.clientMethodHandler 14712639595305348988 0 client)
+instance (Left'server_ Std_.IO Bottom) where
+ left'left (Bottom client) = (Rpc.clientMethodHandler 17679152961798450446 0 client)
+instance (Top'server_ Std_.IO Bottom) where
+ top'top (Bottom client) = (Rpc.clientMethodHandler 17861645508359101525 0 client)
+data Bottom'bottom'params
+ = Bottom'bottom'params
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Bottom'bottom'params) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Bottom'bottom'params) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Bottom'bottom'params) where
+ type Cerial msg Bottom'bottom'params = (Capnp.Gen.ById.X832bcc6686a26d56.Bottom'bottom'params msg)
+ decerialize raw = (Std_.pure Bottom'bottom'params)
+instance (Classes.Marshal Bottom'bottom'params) where
+ marshalInto raw_ value_ = case value_ of
+ (Bottom'bottom'params) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Bottom'bottom'params)
+instance (Classes.Cerialize (V.Vector Bottom'bottom'params)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Bottom'bottom'params))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Bottom'bottom'params)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'params))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'params)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'params))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'params)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Bottom'bottom'results
+ = Bottom'bottom'results
+ {}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Bottom'bottom'results) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Bottom'bottom'results) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Bottom'bottom'results) where
+ type Cerial msg Bottom'bottom'results = (Capnp.Gen.ById.X832bcc6686a26d56.Bottom'bottom'results msg)
+ decerialize raw = (Std_.pure Bottom'bottom'results)
+instance (Classes.Marshal Bottom'bottom'results) where
+ marshalInto raw_ value_ = case value_ of
+ (Bottom'bottom'results) ->
+ (do
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Bottom'bottom'results)
+instance (Classes.Cerialize (V.Vector Bottom'bottom'results)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Bottom'bottom'results))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Bottom'bottom'results)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'results))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'results)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'results))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Bottom'bottom'results)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data Defaults
+ = Defaults
+ {text :: T.Text
+ ,data_ :: BS.ByteString
+ ,float :: Std_.Float
+ ,int :: Std_.Int32
+ ,uint :: Std_.Word32}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default Defaults) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg Defaults) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize Defaults) where
+ type Cerial msg Defaults = (Capnp.Gen.ById.X832bcc6686a26d56.Defaults msg)
+ decerialize raw = (Defaults <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Defaults'text raw) >>= Classes.decerialize)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_Defaults'data_ raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Defaults'float raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Defaults'int raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_Defaults'uint raw))
+instance (Classes.Marshal Defaults) where
+ marshalInto raw_ value_ = case value_ of
+ Defaults{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) text) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Defaults'text raw_))
+ ((Classes.cerialize (Untyped.message raw_) data_) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_Defaults'data_ raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Defaults'float raw_ float)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Defaults'int raw_ int)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_Defaults'uint raw_ uint)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize Defaults)
+instance (Classes.Cerialize (V.Vector Defaults)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector Defaults))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Defaults)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Defaults))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Defaults)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Defaults))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Defaults)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+data BenchmarkA
+ = BenchmarkA
+ {name :: T.Text
+ ,birthDay :: Std_.Int64
+ ,phone :: T.Text
+ ,siblings :: Std_.Int32
+ ,spouse :: Std_.Bool
+ ,money :: Std_.Double}
+ deriving(Std_.Show
+ ,Std_.Eq
+ ,Generics.Generic)
+instance (Default.Default BenchmarkA) where
+ def = GenHelpersPure.defaultStruct
+instance (Classes.FromStruct Message.ConstMsg BenchmarkA) where
+ fromStruct struct = ((Classes.fromStruct struct) >>= Classes.decerialize)
+instance (Classes.Decerialize BenchmarkA) where
+ type Cerial msg BenchmarkA = (Capnp.Gen.ById.X832bcc6686a26d56.BenchmarkA msg)
+ decerialize raw = (BenchmarkA <$> ((Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'name raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'birthDay raw)
+ <*> ((Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'phone raw) >>= Classes.decerialize)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'siblings raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'spouse raw)
+ <*> (Capnp.Gen.ById.X832bcc6686a26d56.get_BenchmarkA'money raw))
+instance (Classes.Marshal BenchmarkA) where
+ marshalInto raw_ value_ = case value_ of
+ BenchmarkA{..} ->
+ (do
+ ((Classes.cerialize (Untyped.message raw_) name) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'name raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'birthDay raw_ birthDay)
+ ((Classes.cerialize (Untyped.message raw_) phone) >>= (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'phone raw_))
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'siblings raw_ siblings)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'spouse raw_ spouse)
+ (Capnp.Gen.ById.X832bcc6686a26d56.set_BenchmarkA'money raw_ money)
+ (Std_.pure ())
+ )
+instance (Classes.Cerialize BenchmarkA)
+instance (Classes.Cerialize (V.Vector BenchmarkA)) where
+ cerialize = GenHelpersPure.cerializeCompositeVec
+instance (Classes.Cerialize (V.Vector (V.Vector BenchmarkA))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector BenchmarkA)))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector BenchmarkA))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector BenchmarkA)))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector BenchmarkA))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector BenchmarkA)))))))) where
+ cerialize = GenHelpersPure.cerializeBasicVec
+instance (Classes.Decerialize Capnp.Gen.ById.X832bcc6686a26d56.Airport) where
+ type Cerial msg Capnp.Gen.ById.X832bcc6686a26d56.Airport = Capnp.Gen.ById.X832bcc6686a26d56.Airport
+ decerialize = Std_.pure
+instance (Classes.Cerialize Capnp.Gen.ById.X832bcc6686a26d56.Airport) where
+ cerialize _ = Std_.pure
+instance (Classes.Cerialize (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport)) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport)))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport)))))) where
+ cerialize = Classes.cerializeBasicVec
+instance (Classes.Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Capnp.Gen.ById.X832bcc6686a26d56.Airport))))))) where
+ cerialize = Classes.cerializeBasicVec
diff --git a/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56.hs b/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56.hs
new file mode 100644
--- /dev/null
+++ b/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X832bcc6686a26d56(module Capnp.Gen.Aircraft) where
+import Capnp.Gen.Aircraft
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56/Pure.hs b/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56/Pure.hs
new file mode 100644
--- /dev/null
+++ b/gen/tests/Capnp/Gen/ById/X832bcc6686a26d56/Pure.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports #-}
+{-# OPTIONS_GHC -Wno-unused-matches #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Capnp.Gen.ById.X832bcc6686a26d56.Pure(module Capnp.Gen.Aircraft.Pure) where
+import Capnp.Gen.Aircraft.Pure
+import qualified Prelude as Std_
+import qualified Data.Word as Std_
+import qualified Data.Int as Std_
+import Prelude ((<$>), (<*>), (>>=))
diff --git a/lib/Capnp.hs b/lib/Capnp.hs
--- a/lib/Capnp.hs
+++ b/lib/Capnp.hs
@@ -1,9 +1,81 @@
{- |
Module: Capnp
-Description: Code generated by the schema compiler.
+Description: The most commonly used functionality in the capnp package.
-The @Capnp@ module hierarchy contains code generated by the schema compiler.
-See "Data.Capnp.Tutorial" for a description of what code is generated for
-each schema, as well as a general introduction to the library.
+This module re-exports the most commonly used functionality from other modules in the
+library.
+
+Users getting acquainted with the library are *strongly* encouraged to read the
+"Capnp.Tutorial" module before anything else.
-}
-module Capnp () where
+module 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.MutMsg
+ , Message.newMessage
+
+ -- * Manipulating the root object of a message
+ , Codec.getRoot
+ , Codec.newRoot
+ , Codec.setRoot
+
+ -- * Marshalling data into and out of messages
+ , Classes.Decerialize(..)
+ , Classes.Cerialize(..)
+
+ -- * IO
+ , module Capnp.IO
+
+ -- * Type aliases for common contexts
+ , Message.WriteCtx
+ , Untyped.ReadCtx
+ , Untyped.RWCtx
+
+ -- * Converting between messages, Cap'N Proto values, and raw bytes
+ , module Capnp.Convert
+
+ -- * Managing resource limits
+ , module Capnp.TraversalLimit
+
+ -- * Freezing and thawing values
+ , module Data.Mutable
+
+ -- * Building messages in pure code
+ , PureBuilder
+ , createPure
+
+ -- * Re-exported from "Data.Default", for convienence.
+ , def
+ ) where
+
+import Data.Default (def)
+
+import Capnp.Convert
+import Capnp.IO
+import Capnp.TraversalLimit
+import Data.Mutable
+
+import Internal.BuildPure (PureBuilder, createPure)
+
+import qualified Capnp.Basics as Basics
+import qualified Capnp.Classes as Classes
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Codec.Capnp as Codec
+
+
+
+-- Just for instances:
+import Capnp.Basics.Pure ()
diff --git a/lib/Capnp/Address.hs b/lib/Capnp/Address.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Address.hs
@@ -0,0 +1,87 @@
+{-|
+Module: Capnp.Address
+Description: Utilities for manipulating addresses within capnproto messages.
+
+This module provides facilities for manipulating raw addresses within
+Cap'N Proto messages.
+
+This is a low level module that very few users will need to use directly.
+-}
+{-# LANGUAGE RecordWildCards #-}
+module Capnp.Address
+ ( WordAddr(..)
+ , CapAddr(..)
+ , Addr(..)
+ , OffsetError(..)
+ , computeOffset
+ , pointerFrom
+ )
+ where
+
+import Data.Bits
+import Data.Word
+
+import Capnp.Bits (WordCount)
+
+import qualified 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
+ -- | The address of some data in the message.
+ = WordAddr !WordAddr
+ -- | The "address" of a capability.
+ | 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
diff --git a/lib/Capnp/Basics.hs b/lib/Capnp/Basics.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Basics.hs
@@ -0,0 +1,159 @@
+{-|
+Module: 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).
+* Lists of types other than those in "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 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 Capnp.Classes
+ (FromPtr(..), ListElem(..), MutListElem(..), ToPtr(..))
+import Internal.Gen.Instances ()
+
+import qualified Capnp.Errors as E
+import qualified Capnp.Message as M
+import qualified 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 ++ ")"
+ pure $ Text 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 = textBuffer >=> U.rawBytes
+
+------------------- (Mut)ListElem instances for text and data ------------------
+instance ListElem msg (Data msg) where
+ newtype List msg (Data msg) = DataList (U.ListOf msg (Maybe (U.Ptr msg)))
+
+ listFromPtr msg ptr = DataList <$> fromPtr msg ptr
+ toUntypedList (DataList l) = U.ListPtr l
+
+ length (DataList l) = U.length l
+ index i (DataList l) = ptrListIndex i l
+
+instance MutListElem s (Data (M.MutMsg s)) where
+ setIndex (Data e) i (DataList l) =
+ U.setIndex (Just (U.PtrList (U.List8 e))) i l
+ newList msg len = DataList <$> U.allocListPtr msg len
+
+instance ListElem msg (Text msg) where
+ newtype List msg (Text msg) = TextList (U.ListOf msg (Maybe (U.Ptr msg)))
+
+ listFromPtr msg ptr = TextList <$> fromPtr msg ptr
+ toUntypedList (TextList l) = U.ListPtr l
+
+ length (TextList l) = U.length l
+ index i (TextList l) = ptrListIndex i l
+
+instance MutListElem s (Text (M.MutMsg s)) where
+ setIndex (Text e) i (TextList l) =
+ U.setIndex (Just (U.PtrList (U.List8 e))) i l
+ newList msg len = TextList <$> U.allocListPtr msg len
+
+-- helper for the above instances.
+ptrListIndex :: (U.ReadCtx m msg, FromPtr msg a) => Int -> U.ListOf msg (Maybe (U.Ptr msg)) -> m a
+ptrListIndex i list = do
+ ptr <- U.index i list
+ fromPtr (U.message list) ptr
+
+--------- To/FromPtr instances for Text and Data. These wrap lists of bytes. --------
+
+instance FromPtr msg (Data msg) where
+ fromPtr msg ptr = fromPtr msg ptr >>= getData
+instance ToPtr s (Data (M.MutMsg s)) where
+ toPtr msg (Data l) = toPtr msg l
+
+instance FromPtr 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
+instance ToPtr s (Text (M.MutMsg s)) where
+ toPtr msg (Text l) = toPtr msg l
diff --git a/lib/Capnp/Basics/Pure.hs b/lib/Capnp/Basics/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Basics/Pure.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{- |
+Module: Capnp.Basics.Pure
+Description: Handling of "basic" capnp datatypes (high-level API).
+
+Analogous to '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 Capnp.Basics.Pure
+ ( Data
+ , Text
+ ) where
+
+import Prelude hiding (length)
+
+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 qualified Data.Vector as V
+
+import Capnp.Classes
+
+import Capnp.Errors (Error(InvalidUtf8Error))
+import Capnp.Untyped (rawBytes)
+
+import qualified Capnp.Basics as Basics
+import qualified Capnp.Message as M
+import qualified 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 Cerialize Data where
+ cerialize msg bytes = do
+ dest <- Basics.newData msg (BS.length bytes)
+ marshalInto dest bytes
+ pure dest
+
+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 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
+
+instance Cerialize (V.Vector Text) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector Data) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Text)) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector Data)) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Text))) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector Data))) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Text)))) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector Data)))) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Text))))) where cerialize = cerializeBasicVec
+instance Cerialize (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Data))))) where cerialize = cerializeBasicVec
diff --git a/lib/Capnp/Bits.hs b/lib/Capnp/Bits.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Bits.hs
@@ -0,0 +1,130 @@
+{-|
+Module: Capnp.Bits
+Description: Utilities for bitwhacking useful for capnproto.
+
+This module provides misc. utilities for bitwhacking that are useful
+in dealing with low-level details of the Cap'N Proto wire format.
+
+This is mostly an implementation detail; users are unlikely to need
+to use this module directly.
+-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module 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, Bounded)
+
+-- | A quantity of bytes
+newtype ByteCount = ByteCount Int
+ deriving(Num, Real, Integral, Bits, Ord, Eq, Enum, Show, Bounded)
+
+-- | A quantity of 64-bit words
+newtype WordCount = WordCount Int
+ deriving(Num, Real, Integral, Bits, Ord, Eq, Enum, Show, Bounded)
+
+-- | 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/Capnp/ById/X8ef99297a43a5e34.hs b/lib/Capnp/ById/X8ef99297a43a5e34.hs
deleted file mode 100644
--- a/lib/Capnp/ById/X8ef99297a43a5e34.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/X8ef99297a43a5e34/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xa184c7885cdaf2a1.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xa184c7885cdaf2a1/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xa93fc509624c72d9.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xa93fc509624c72d9/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xb312981b2552a250.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xb312981b2552a250/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xb8630836983feed7.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xb8630836983feed7/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xbdf87d7bb8304e81.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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
deleted file mode 100644
--- a/lib/Capnp/ById/Xbdf87d7bb8304e81/Pure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-imports #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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.hs b/lib/Capnp/Capnp.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-|
-Module: Capnp.Capnp
-Description: Generated modules for the schema that ship with Cap'N Proto
-
-The modules under 'Capnp.Capnp' are generated code for the schema files that
-ship with the Cap'N Proto reference implementation.
--}
-module Capnp.Capnp () where
diff --git a/lib/Capnp/Capnp/Cxx.hs b/lib/Capnp/Capnp/Cxx.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/Cxx.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
diff --git a/lib/Capnp/Capnp/Cxx/Pure.hs b/lib/Capnp/Capnp/Cxx/Pure.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/Cxx/Pure.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/lib/Capnp/Capnp/Json.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
-import qualified Capnp.ById.Xbdf87d7bb8304e81
-newtype 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 U'.HasMessage (JsonValue msg) where
- type InMessage (JsonValue msg) = msg
- message (JsonValue_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (JsonValue msg) where
- messageDefault = JsonValue_newtype_ . U'.messageDefault
-instance B'.ListElem msg (JsonValue msg) where
- newtype List msg (JsonValue msg) = List_JsonValue (U'.ListOf msg (U'.Struct msg))
- length (List_JsonValue l) = U'.length l
- index i (List_JsonValue l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (JsonValue msg) where
- fromPtr msg ptr = JsonValue_newtype_ <$> C'.fromPtr msg ptr
- toPtr (JsonValue_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (JsonValue (M'.MutMsg s)) where
- setIndex (JsonValue_newtype_ elt) i (List_JsonValue l) = U'.setIndex elt i l
- newList msg len = List_JsonValue <$> U'.allocCompositeList msg 2 1 len
-instance 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
-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 U'.HasMessage (JsonValue'Call msg) where
- type InMessage (JsonValue'Call msg) = msg
- message (JsonValue'Call_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (JsonValue'Call msg) where
- messageDefault = JsonValue'Call_newtype_ . U'.messageDefault
-instance B'.ListElem msg (JsonValue'Call msg) where
- newtype List msg (JsonValue'Call msg) = List_JsonValue'Call (U'.ListOf msg (U'.Struct msg))
- length (List_JsonValue'Call l) = U'.length l
- index i (List_JsonValue'Call l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue'Call msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (JsonValue'Call msg) where
- fromPtr msg ptr = JsonValue'Call_newtype_ <$> C'.fromPtr msg ptr
- toPtr (JsonValue'Call_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (JsonValue'Call (M'.MutMsg s)) where
- setIndex (JsonValue'Call_newtype_ elt) i (List_JsonValue'Call l) = U'.setIndex elt i l
- newList msg len = List_JsonValue'Call <$> U'.allocCompositeList msg 0 2 len
-instance 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 U'.HasMessage (JsonValue'Field msg) where
- type InMessage (JsonValue'Field msg) = msg
- message (JsonValue'Field_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (JsonValue'Field msg) where
- messageDefault = JsonValue'Field_newtype_ . U'.messageDefault
-instance B'.ListElem msg (JsonValue'Field msg) where
- newtype List msg (JsonValue'Field msg) = List_JsonValue'Field (U'.ListOf msg (U'.Struct msg))
- length (List_JsonValue'Field l) = U'.length l
- index i (List_JsonValue'Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JsonValue'Field msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (JsonValue'Field msg) where
- fromPtr msg ptr = JsonValue'Field_newtype_ <$> C'.fromPtr msg ptr
- toPtr (JsonValue'Field_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (JsonValue'Field (M'.MutMsg s)) where
- setIndex (JsonValue'Field_newtype_ elt) i (List_JsonValue'Field l) = U'.setIndex elt i l
- newList msg len = List_JsonValue'Field <$> U'.allocCompositeList msg 0 2 len
-instance 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
deleted file mode 100644
--- a/lib/Capnp/Capnp/Json/Pure.hs
+++ /dev/null
@@ -1,147 +0,0 @@
-{-# 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'.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 C'.FromStruct M'.ConstMsg JsonValue where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue M'.ConstMsg)
-instance Default JsonValue where
- def = PH'.defaultStruct
-data JsonValue'Call
- = JsonValue'Call
- {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'.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 C'.FromStruct M'.ConstMsg JsonValue'Call where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Call M'.ConstMsg)
-instance Default JsonValue'Call where
- def = PH'.defaultStruct
-data JsonValue'Field
- = JsonValue'Field
- {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'.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 C'.FromStruct M'.ConstMsg JsonValue'Field where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.X8ef99297a43a5e34.JsonValue'Field M'.ConstMsg)
-instance Default JsonValue'Field where
- def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Persistent.hs b/lib/Capnp/Capnp/Persistent.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/Persistent.hs
+++ /dev/null
@@ -1,95 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
-import qualified Capnp.ById.Xbdf87d7bb8304e81
-newtype 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 U'.HasMessage (Persistent'SaveParams msg) where
- type InMessage (Persistent'SaveParams msg) = msg
- message (Persistent'SaveParams_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Persistent'SaveParams msg) where
- messageDefault = Persistent'SaveParams_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Persistent'SaveParams msg) where
- newtype List msg (Persistent'SaveParams msg) = List_Persistent'SaveParams (U'.ListOf msg (U'.Struct msg))
- length (List_Persistent'SaveParams l) = U'.length l
- index i (List_Persistent'SaveParams l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Persistent'SaveParams msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Persistent'SaveParams msg) where
- fromPtr msg ptr = Persistent'SaveParams_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Persistent'SaveParams_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Persistent'SaveParams (M'.MutMsg s)) where
- setIndex (Persistent'SaveParams_newtype_ elt) i (List_Persistent'SaveParams l) = U'.setIndex elt i l
- newList msg len = List_Persistent'SaveParams <$> U'.allocCompositeList msg 0 1 len
-instance 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 U'.HasMessage (Persistent'SaveResults msg) where
- type InMessage (Persistent'SaveResults msg) = msg
- message (Persistent'SaveResults_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Persistent'SaveResults msg) where
- messageDefault = Persistent'SaveResults_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Persistent'SaveResults msg) where
- newtype List msg (Persistent'SaveResults msg) = List_Persistent'SaveResults (U'.ListOf msg (U'.Struct msg))
- length (List_Persistent'SaveResults l) = U'.length l
- index i (List_Persistent'SaveResults l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Persistent'SaveResults msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Persistent'SaveResults msg) where
- fromPtr msg ptr = Persistent'SaveResults_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Persistent'SaveResults_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Persistent'SaveResults (M'.MutMsg s)) where
- setIndex (Persistent'SaveResults_newtype_ elt) i (List_Persistent'SaveResults l) = U'.setIndex elt i l
- newList msg len = List_Persistent'SaveResults <$> U'.allocCompositeList msg 0 1 len
-instance 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
deleted file mode 100644
--- a/lib/Capnp/Capnp/Persistent/Pure.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# 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'.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 C'.FromStruct M'.ConstMsg Persistent'SaveParams where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveParams M'.ConstMsg)
-instance Default Persistent'SaveParams where
- def = PH'.defaultStruct
-data Persistent'SaveResults
- = Persistent'SaveResults
- {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'.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 C'.FromStruct M'.ConstMsg Persistent'SaveResults where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb8630836983feed7.Persistent'SaveResults M'.ConstMsg)
-instance Default Persistent'SaveResults where
- def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Rpc.hs b/lib/Capnp/Capnp/Rpc.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/Rpc.hs
+++ /dev/null
@@ -1,1228 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
-import qualified Capnp.ById.Xbdf87d7bb8304e81
-newtype 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 U'.HasMessage (Accept msg) where
- type InMessage (Accept msg) = msg
- message (Accept_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Accept msg) where
- messageDefault = Accept_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Accept msg) where
- newtype List msg (Accept msg) = List_Accept (U'.ListOf msg (U'.Struct msg))
- length (List_Accept l) = U'.length l
- index i (List_Accept l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Accept msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Accept msg) where
- fromPtr msg ptr = Accept_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Accept_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Accept (M'.MutMsg s)) where
- setIndex (Accept_newtype_ elt) i (List_Accept l) = U'.setIndex elt i l
- newList msg len = List_Accept <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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
-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 U'.HasMessage (Bootstrap msg) where
- type InMessage (Bootstrap msg) = msg
- message (Bootstrap_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Bootstrap msg) where
- messageDefault = Bootstrap_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Bootstrap msg) where
- newtype List msg (Bootstrap msg) = List_Bootstrap (U'.ListOf msg (U'.Struct msg))
- length (List_Bootstrap l) = U'.length l
- index i (List_Bootstrap l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Bootstrap msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Bootstrap msg) where
- fromPtr msg ptr = Bootstrap_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Bootstrap_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Bootstrap (M'.MutMsg s)) where
- setIndex (Bootstrap_newtype_ elt) i (List_Bootstrap l) = U'.setIndex elt i l
- newList msg len = List_Bootstrap <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Call msg) where
- type InMessage (Call msg) = msg
- message (Call_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Call msg) where
- messageDefault = Call_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Call msg) where
- newtype List msg (Call msg) = List_Call (U'.ListOf msg (U'.Struct msg))
- length (List_Call l) = U'.length l
- index i (List_Call l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Call msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Call msg) where
- fromPtr msg ptr = Call_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Call_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Call (M'.MutMsg s)) where
- setIndex (Call_newtype_ elt) i (List_Call l) = U'.setIndex elt i l
- newList msg len = List_Call <$> U'.allocCompositeList msg 3 3 len
-instance 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
-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
-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
-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
-get_Call'allowThirdPartyTailCall :: U'.ReadCtx m msg => Call msg -> m Bool
-get_Call'allowThirdPartyTailCall (Call_newtype_ struct) = H'.getWordField struct 2 0 0
-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 U'.HasMessage (CapDescriptor msg) where
- type InMessage (CapDescriptor msg) = msg
- message (CapDescriptor_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (CapDescriptor msg) where
- messageDefault = CapDescriptor_newtype_ . U'.messageDefault
-instance B'.ListElem msg (CapDescriptor msg) where
- newtype List msg (CapDescriptor msg) = List_CapDescriptor (U'.ListOf msg (U'.Struct msg))
- length (List_CapDescriptor l) = U'.length l
- index i (List_CapDescriptor l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapDescriptor msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (CapDescriptor msg) where
- fromPtr msg ptr = CapDescriptor_newtype_ <$> C'.fromPtr msg ptr
- toPtr (CapDescriptor_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (CapDescriptor (M'.MutMsg s)) where
- setIndex (CapDescriptor_newtype_ elt) i (List_CapDescriptor l) = U'.setIndex elt i l
- newList msg len = List_CapDescriptor <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Disembargo msg) where
- type InMessage (Disembargo msg) = msg
- message (Disembargo_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Disembargo msg) where
- messageDefault = Disembargo_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Disembargo msg) where
- newtype List msg (Disembargo msg) = List_Disembargo (U'.ListOf msg (U'.Struct msg))
- length (List_Disembargo l) = U'.length l
- index i (List_Disembargo l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Disembargo msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Disembargo msg) where
- fromPtr msg ptr = Disembargo_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Disembargo_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Disembargo (M'.MutMsg s)) where
- setIndex (Disembargo_newtype_ elt) i (List_Disembargo l) = U'.setIndex elt i l
- newList msg len = List_Disembargo <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Exception msg) where
- type InMessage (Exception msg) = msg
- message (Exception_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Exception msg) where
- messageDefault = Exception_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Exception msg) where
- newtype List msg (Exception msg) = List_Exception (U'.ListOf msg (U'.Struct msg))
- length (List_Exception l) = U'.length l
- index i (List_Exception l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Exception msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Exception msg) where
- fromPtr msg ptr = Exception_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Exception_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Exception (M'.MutMsg s)) where
- setIndex (Exception_newtype_ elt) i (List_Exception l) = U'.setIndex elt i l
- newList msg len = List_Exception <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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
-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
-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 U'.HasMessage (Finish msg) where
- type InMessage (Finish msg) = msg
- message (Finish_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Finish msg) where
- messageDefault = Finish_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Finish msg) where
- newtype List msg (Finish msg) = List_Finish (U'.ListOf msg (U'.Struct msg))
- length (List_Finish l) = U'.length l
- index i (List_Finish l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Finish msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Finish msg) where
- fromPtr msg ptr = Finish_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Finish_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Finish (M'.MutMsg s)) where
- setIndex (Finish_newtype_ elt) i (List_Finish l) = U'.setIndex elt i l
- newList msg len = List_Finish <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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
-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 U'.HasMessage (Join msg) where
- type InMessage (Join msg) = msg
- message (Join_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Join msg) where
- messageDefault = Join_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Join msg) where
- newtype List msg (Join msg) = List_Join (U'.ListOf msg (U'.Struct msg))
- length (List_Join l) = U'.length l
- index i (List_Join l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Join msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Join msg) where
- fromPtr msg ptr = Join_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Join_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Join (M'.MutMsg s)) where
- setIndex (Join_newtype_ elt) i (List_Join l) = U'.setIndex elt i l
- newList msg len = List_Join <$> U'.allocCompositeList msg 1 2 len
-instance 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
-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 U'.HasMessage (Message msg) where
- type InMessage (Message msg) = msg
- message (Message_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Message msg) where
- messageDefault = Message_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Message msg) where
- newtype List msg (Message msg) = List_Message (U'.ListOf msg (U'.Struct msg))
- length (List_Message l) = U'.length l
- index i (List_Message l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Message msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Message msg) where
- fromPtr msg ptr = Message_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Message_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Message (M'.MutMsg s)) where
- setIndex (Message_newtype_ elt) i (List_Message l) = U'.setIndex elt i l
- newList msg len = List_Message <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (MessageTarget msg) where
- type InMessage (MessageTarget msg) = msg
- message (MessageTarget_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (MessageTarget msg) where
- messageDefault = MessageTarget_newtype_ . U'.messageDefault
-instance B'.ListElem msg (MessageTarget msg) where
- newtype List msg (MessageTarget msg) = List_MessageTarget (U'.ListOf msg (U'.Struct msg))
- length (List_MessageTarget l) = U'.length l
- index i (List_MessageTarget l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (MessageTarget msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (MessageTarget msg) where
- fromPtr msg ptr = MessageTarget_newtype_ <$> C'.fromPtr msg ptr
- toPtr (MessageTarget_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (MessageTarget (M'.MutMsg s)) where
- setIndex (MessageTarget_newtype_ elt) i (List_MessageTarget l) = U'.setIndex elt i l
- newList msg len = List_MessageTarget <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Payload msg) where
- type InMessage (Payload msg) = msg
- message (Payload_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Payload msg) where
- messageDefault = Payload_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Payload msg) where
- newtype List msg (Payload msg) = List_Payload (U'.ListOf msg (U'.Struct msg))
- length (List_Payload l) = U'.length l
- index i (List_Payload l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Payload msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Payload msg) where
- fromPtr msg ptr = Payload_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Payload_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Payload (M'.MutMsg s)) where
- setIndex (Payload_newtype_ elt) i (List_Payload l) = U'.setIndex elt i l
- newList msg len = List_Payload <$> U'.allocCompositeList msg 0 2 len
-instance 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 U'.HasMessage (PromisedAnswer msg) where
- type InMessage (PromisedAnswer msg) = msg
- message (PromisedAnswer_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (PromisedAnswer msg) where
- messageDefault = PromisedAnswer_newtype_ . U'.messageDefault
-instance B'.ListElem msg (PromisedAnswer msg) where
- newtype List msg (PromisedAnswer msg) = List_PromisedAnswer (U'.ListOf msg (U'.Struct msg))
- length (List_PromisedAnswer l) = U'.length l
- index i (List_PromisedAnswer l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (PromisedAnswer msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (PromisedAnswer msg) where
- fromPtr msg ptr = PromisedAnswer_newtype_ <$> C'.fromPtr msg ptr
- toPtr (PromisedAnswer_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (PromisedAnswer (M'.MutMsg s)) where
- setIndex (PromisedAnswer_newtype_ elt) i (List_PromisedAnswer l) = U'.setIndex elt i l
- newList msg len = List_PromisedAnswer <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Provide msg) where
- type InMessage (Provide msg) = msg
- message (Provide_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Provide msg) where
- messageDefault = Provide_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Provide msg) where
- newtype List msg (Provide msg) = List_Provide (U'.ListOf msg (U'.Struct msg))
- length (List_Provide l) = U'.length l
- index i (List_Provide l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Provide msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Provide msg) where
- fromPtr msg ptr = Provide_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Provide_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Provide (M'.MutMsg s)) where
- setIndex (Provide_newtype_ elt) i (List_Provide l) = U'.setIndex elt i l
- newList msg len = List_Provide <$> U'.allocCompositeList msg 1 2 len
-instance 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
-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 U'.HasMessage (Release msg) where
- type InMessage (Release msg) = msg
- message (Release_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Release msg) where
- messageDefault = Release_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Release msg) where
- newtype List msg (Release msg) = List_Release (U'.ListOf msg (U'.Struct msg))
- length (List_Release l) = U'.length l
- index i (List_Release l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Release msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Release msg) where
- fromPtr msg ptr = Release_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Release_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Release (M'.MutMsg s)) where
- setIndex (Release_newtype_ elt) i (List_Release l) = U'.setIndex elt i l
- newList msg len = List_Release <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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
-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 U'.HasMessage (Resolve msg) where
- type InMessage (Resolve msg) = msg
- message (Resolve_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Resolve msg) where
- messageDefault = Resolve_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Resolve msg) where
- newtype List msg (Resolve msg) = List_Resolve (U'.ListOf msg (U'.Struct msg))
- length (List_Resolve l) = U'.length l
- index i (List_Resolve l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Resolve msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Resolve msg) where
- fromPtr msg ptr = Resolve_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Resolve_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Resolve (M'.MutMsg s)) where
- setIndex (Resolve_newtype_ elt) i (List_Resolve l) = U'.setIndex elt i l
- newList msg len = List_Resolve <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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
-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 U'.HasMessage (Return msg) where
- type InMessage (Return msg) = msg
- message (Return_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Return msg) where
- messageDefault = Return_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Return msg) where
- newtype List msg (Return msg) = List_Return (U'.ListOf msg (U'.Struct msg))
- length (List_Return l) = U'.length l
- index i (List_Return l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Return msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Return msg) where
- fromPtr msg ptr = Return_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Return_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Return (M'.MutMsg s)) where
- setIndex (Return_newtype_ elt) i (List_Return l) = U'.setIndex elt i l
- newList msg len = List_Return <$> U'.allocCompositeList msg 2 1 len
-instance 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
-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
-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
-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 U'.HasMessage (ThirdPartyCapDescriptor msg) where
- type InMessage (ThirdPartyCapDescriptor msg) = msg
- message (ThirdPartyCapDescriptor_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (ThirdPartyCapDescriptor msg) where
- messageDefault = ThirdPartyCapDescriptor_newtype_ . U'.messageDefault
-instance B'.ListElem msg (ThirdPartyCapDescriptor msg) where
- newtype List msg (ThirdPartyCapDescriptor msg) = List_ThirdPartyCapDescriptor (U'.ListOf msg (U'.Struct msg))
- length (List_ThirdPartyCapDescriptor l) = U'.length l
- index i (List_ThirdPartyCapDescriptor l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (ThirdPartyCapDescriptor msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (ThirdPartyCapDescriptor msg) where
- fromPtr msg ptr = ThirdPartyCapDescriptor_newtype_ <$> C'.fromPtr msg ptr
- toPtr (ThirdPartyCapDescriptor_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (ThirdPartyCapDescriptor (M'.MutMsg s)) where
- setIndex (ThirdPartyCapDescriptor_newtype_ elt) i (List_ThirdPartyCapDescriptor l) = U'.setIndex elt i l
- newList msg len = List_ThirdPartyCapDescriptor <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Call'sendResultsTo msg) where
- type InMessage (Call'sendResultsTo msg) = msg
- message (Call'sendResultsTo_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Call'sendResultsTo msg) where
- messageDefault = Call'sendResultsTo_newtype_ . U'.messageDefault
-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
-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 U'.HasMessage (Disembargo'context msg) where
- type InMessage (Disembargo'context msg) = msg
- message (Disembargo'context_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Disembargo'context msg) where
- messageDefault = Disembargo'context_newtype_ . U'.messageDefault
-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
-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 0 = Exception'Type'failed
- go 1 = Exception'Type'overloaded
- go 2 = Exception'Type'disconnected
- go 3 = Exception'Type'unimplemented
- go tag = Exception'Type'unknown' (fromIntegral tag)
- toWord Exception'Type'failed = 0
- toWord Exception'Type'overloaded = 1
- toWord Exception'Type'disconnected = 2
- toWord Exception'Type'unimplemented = 3
- toWord (Exception'Type'unknown' tag) = fromIntegral tag
-instance B'.ListElem msg Exception'Type where
- newtype List msg Exception'Type = List_Exception'Type (U'.ListOf msg Word16)
- 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 U'.HasMessage (PromisedAnswer'Op msg) where
- type InMessage (PromisedAnswer'Op msg) = msg
- message (PromisedAnswer'Op_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (PromisedAnswer'Op msg) where
- messageDefault = PromisedAnswer'Op_newtype_ . U'.messageDefault
-instance B'.ListElem msg (PromisedAnswer'Op msg) where
- newtype List msg (PromisedAnswer'Op msg) = List_PromisedAnswer'Op (U'.ListOf msg (U'.Struct msg))
- length (List_PromisedAnswer'Op l) = U'.length l
- index i (List_PromisedAnswer'Op l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (PromisedAnswer'Op msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (PromisedAnswer'Op msg) where
- fromPtr msg ptr = PromisedAnswer'Op_newtype_ <$> C'.fromPtr msg ptr
- toPtr (PromisedAnswer'Op_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (PromisedAnswer'Op (M'.MutMsg s)) where
- setIndex (PromisedAnswer'Op_newtype_ elt) i (List_PromisedAnswer'Op l) = U'.setIndex elt i l
- newList msg len = List_PromisedAnswer'Op <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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 U'.HasMessage (Resolve' msg) where
- type InMessage (Resolve' msg) = msg
- message (Resolve'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Resolve' msg) where
- messageDefault = Resolve'_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Resolve' msg) where
- newtype List msg (Resolve' msg) = List_Resolve' (U'.ListOf msg (U'.Struct msg))
- length (List_Resolve' l) = U'.length l
- index i (List_Resolve' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Resolve' msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Resolve' msg) where
- fromPtr msg ptr = Resolve'_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Resolve'_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Resolve' (M'.MutMsg s)) where
- setIndex (Resolve'_newtype_ elt) i (List_Resolve' l) = U'.setIndex elt i l
- newList msg len = List_Resolve' <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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 U'.HasMessage (Return' msg) where
- type InMessage (Return' msg) = msg
- message (Return'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Return' msg) where
- messageDefault = Return'_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Return' msg) where
- newtype List msg (Return' msg) = List_Return' (U'.ListOf msg (U'.Struct msg))
- length (List_Return' l) = U'.length l
- index i (List_Return' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Return' msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Return' msg) where
- fromPtr msg ptr = Return'_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Return'_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Return' (M'.MutMsg s)) where
- setIndex (Return'_newtype_ elt) i (List_Return' l) = U'.setIndex elt i l
- newList msg len = List_Return' <$> U'.allocCompositeList msg 2 1 len
-instance 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
-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
deleted file mode 100644
--- a/lib/Capnp/Capnp/Rpc/Pure.hs
+++ /dev/null
@@ -1,751 +0,0 @@
-{-# 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'.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 C'.FromStruct M'.ConstMsg Accept where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Accept M'.ConstMsg)
-instance Default Accept where
- def = PH'.defaultStruct
-data Bootstrap
- = Bootstrap
- {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'.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 C'.FromStruct M'.ConstMsg Bootstrap where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Bootstrap M'.ConstMsg)
-instance Default Bootstrap where
- def = PH'.defaultStruct
-data Call
- = Call
- {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'.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 C'.FromStruct M'.ConstMsg Call where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call M'.ConstMsg)
-instance Default Call where
- def = PH'.defaultStruct
-data CapDescriptor
- = CapDescriptor'none
- | CapDescriptor'senderHosted (Word32)
- | CapDescriptor'senderPromise (Word32)
- | CapDescriptor'receiverHosted (Word32)
- | CapDescriptor'receiverAnswer (PromisedAnswer)
- | CapDescriptor'thirdPartyHosted (ThirdPartyCapDescriptor)
- | CapDescriptor'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg CapDescriptor where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.CapDescriptor M'.ConstMsg)
-instance Default CapDescriptor where
- def = PH'.defaultStruct
-data Disembargo
- = Disembargo
- {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'.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 C'.FromStruct M'.ConstMsg Disembargo where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo M'.ConstMsg)
-instance Default Disembargo where
- def = PH'.defaultStruct
-data Exception
- = Exception
- {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'.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 C'.FromStruct M'.ConstMsg Exception where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Exception M'.ConstMsg)
-instance Default Exception where
- def = PH'.defaultStruct
-data Finish
- = Finish
- {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'.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 C'.FromStruct M'.ConstMsg Finish where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Finish M'.ConstMsg)
-instance Default Finish where
- def = PH'.defaultStruct
-data Join
- = Join
- {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'.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 C'.FromStruct M'.ConstMsg Join where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Join M'.ConstMsg)
-instance Default Join where
- def = PH'.defaultStruct
-data Message
- = Message'unimplemented (Message)
- | Message'abort (Exception)
- | Message'call (Call)
- | Message'return (Return)
- | Message'finish (Finish)
- | Message'resolve (Resolve)
- | Message'release (Release)
- | Message'obsoleteSave (Maybe (PU'.PtrType))
- | Message'bootstrap (Bootstrap)
- | Message'obsoleteDelete (Maybe (PU'.PtrType))
- | Message'provide (Provide)
- | Message'accept (Accept)
- | Message'join (Join)
- | Message'disembargo (Disembargo)
- | Message'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Message where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Message M'.ConstMsg)
-instance Default Message where
- def = PH'.defaultStruct
-data MessageTarget
- = MessageTarget'importedCap (Word32)
- | MessageTarget'promisedAnswer (PromisedAnswer)
- | MessageTarget'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg MessageTarget where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.MessageTarget M'.ConstMsg)
-instance Default MessageTarget where
- def = PH'.defaultStruct
-data Payload
- = Payload
- {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'.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 C'.FromStruct M'.ConstMsg Payload where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Payload M'.ConstMsg)
-instance Default Payload where
- def = PH'.defaultStruct
-data PromisedAnswer
- = PromisedAnswer
- {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'.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 C'.FromStruct M'.ConstMsg PromisedAnswer where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer M'.ConstMsg)
-instance Default PromisedAnswer where
- def = PH'.defaultStruct
-data Provide
- = Provide
- {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'.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 C'.FromStruct M'.ConstMsg Provide where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Provide M'.ConstMsg)
-instance Default Provide where
- def = PH'.defaultStruct
-data Release
- = Release
- {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'.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 C'.FromStruct M'.ConstMsg Release where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Release M'.ConstMsg)
-instance Default Release where
- def = PH'.defaultStruct
-data Resolve
- = Resolve
- {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'.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 C'.FromStruct M'.ConstMsg Resolve where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve M'.ConstMsg)
-instance Default Resolve where
- def = PH'.defaultStruct
-data Return
- = Return
- {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'.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 C'.FromStruct M'.ConstMsg Return where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return M'.ConstMsg)
-instance Default Return where
- def = PH'.defaultStruct
-data ThirdPartyCapDescriptor
- = ThirdPartyCapDescriptor
- {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'.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 C'.FromStruct M'.ConstMsg ThirdPartyCapDescriptor where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.ThirdPartyCapDescriptor M'.ConstMsg)
-instance Default ThirdPartyCapDescriptor where
- def = PH'.defaultStruct
-data Call'sendResultsTo
- = Call'sendResultsTo'caller
- | Call'sendResultsTo'yourself
- | Call'sendResultsTo'thirdParty (Maybe (PU'.PtrType))
- | Call'sendResultsTo'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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'.FromStruct M'.ConstMsg Call'sendResultsTo where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Call'sendResultsTo M'.ConstMsg)
-instance Default Call'sendResultsTo where
- def = PH'.defaultStruct
-data Disembargo'context
- = Disembargo'context'senderLoopback (Word32)
- | Disembargo'context'receiverLoopback (Word32)
- | Disembargo'context'accept
- | Disembargo'context'provide (Word32)
- | Disembargo'context'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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'.FromStruct M'.ConstMsg Disembargo'context where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Disembargo'context M'.ConstMsg)
-instance Default Disembargo'context where
- def = PH'.defaultStruct
-data PromisedAnswer'Op
- = PromisedAnswer'Op'noop
- | PromisedAnswer'Op'getPointerField (Word16)
- | PromisedAnswer'Op'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg PromisedAnswer'Op where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.PromisedAnswer'Op M'.ConstMsg)
-instance Default PromisedAnswer'Op where
- def = PH'.defaultStruct
-data Resolve'
- = Resolve'cap (CapDescriptor)
- | Resolve'exception (Exception)
- | Resolve'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Resolve' where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Resolve' M'.ConstMsg)
-instance Default Resolve' where
- def = PH'.defaultStruct
-data Return'
- = Return'results (Payload)
- | Return'exception (Exception)
- | Return'canceled
- | Return'resultsSentElsewhere
- | Return'takeFromOtherQuestion (Word32)
- | Return'acceptFromThirdParty (Maybe (PU'.PtrType))
- | Return'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Return' where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xb312981b2552a250.Return' M'.ConstMsg)
-instance Default Return' where
- def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/RpcTwoparty.hs b/lib/Capnp/Capnp/RpcTwoparty.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/RpcTwoparty.hs
+++ /dev/null
@@ -1,191 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
-import qualified Capnp.ById.Xbdf87d7bb8304e81
-newtype 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 U'.HasMessage (JoinKeyPart msg) where
- type InMessage (JoinKeyPart msg) = msg
- message (JoinKeyPart_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (JoinKeyPart msg) where
- messageDefault = JoinKeyPart_newtype_ . U'.messageDefault
-instance B'.ListElem msg (JoinKeyPart msg) where
- newtype List msg (JoinKeyPart msg) = List_JoinKeyPart (U'.ListOf msg (U'.Struct msg))
- length (List_JoinKeyPart l) = U'.length l
- index i (List_JoinKeyPart l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JoinKeyPart msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (JoinKeyPart msg) where
- fromPtr msg ptr = JoinKeyPart_newtype_ <$> C'.fromPtr msg ptr
- toPtr (JoinKeyPart_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (JoinKeyPart (M'.MutMsg s)) where
- setIndex (JoinKeyPart_newtype_ elt) i (List_JoinKeyPart l) = U'.setIndex elt i l
- newList msg len = List_JoinKeyPart <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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
-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
-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 U'.HasMessage (JoinResult msg) where
- type InMessage (JoinResult msg) = msg
- message (JoinResult_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (JoinResult msg) where
- messageDefault = JoinResult_newtype_ . U'.messageDefault
-instance B'.ListElem msg (JoinResult msg) where
- newtype List msg (JoinResult msg) = List_JoinResult (U'.ListOf msg (U'.Struct msg))
- length (List_JoinResult l) = U'.length l
- index i (List_JoinResult l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (JoinResult msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (JoinResult msg) where
- fromPtr msg ptr = JoinResult_newtype_ <$> C'.fromPtr msg ptr
- toPtr (JoinResult_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (JoinResult (M'.MutMsg s)) where
- setIndex (JoinResult_newtype_ elt) i (List_JoinResult l) = U'.setIndex elt i l
- newList msg len = List_JoinResult <$> U'.allocCompositeList msg 1 1 len
-instance 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
-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
-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 U'.HasMessage (ProvisionId msg) where
- type InMessage (ProvisionId msg) = msg
- message (ProvisionId_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (ProvisionId msg) where
- messageDefault = ProvisionId_newtype_ . U'.messageDefault
-instance B'.ListElem msg (ProvisionId msg) where
- newtype List msg (ProvisionId msg) = List_ProvisionId (U'.ListOf msg (U'.Struct msg))
- length (List_ProvisionId l) = U'.length l
- index i (List_ProvisionId l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (ProvisionId msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (ProvisionId msg) where
- fromPtr msg ptr = ProvisionId_newtype_ <$> C'.fromPtr msg ptr
- toPtr (ProvisionId_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (ProvisionId (M'.MutMsg s)) where
- setIndex (ProvisionId_newtype_ elt) i (List_ProvisionId l) = U'.setIndex elt i l
- newList msg len = List_ProvisionId <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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 0 = Side'server
- go 1 = Side'client
- go tag = Side'unknown' (fromIntegral tag)
- toWord Side'server = 0
- toWord Side'client = 1
- toWord (Side'unknown' tag) = fromIntegral tag
-instance B'.ListElem msg Side where
- newtype List msg Side = List_Side (U'.ListOf msg Word16)
- 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 U'.HasMessage (VatId msg) where
- type InMessage (VatId msg) = msg
- message (VatId_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (VatId msg) where
- messageDefault = VatId_newtype_ . U'.messageDefault
-instance B'.ListElem msg (VatId msg) where
- newtype List msg (VatId msg) = List_VatId (U'.ListOf msg (U'.Struct msg))
- length (List_VatId l) = U'.length l
- index i (List_VatId l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (VatId msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (VatId msg) where
- fromPtr msg ptr = VatId_newtype_ <$> C'.fromPtr msg ptr
- toPtr (VatId_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (VatId (M'.MutMsg s)) where
- setIndex (VatId_newtype_ elt) i (List_VatId l) = U'.setIndex elt i l
- newList msg len = List_VatId <$> U'.allocCompositeList msg 1 0 len
-instance 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
-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
deleted file mode 100644
--- a/lib/Capnp/Capnp/RpcTwoparty/Pure.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-# 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'.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 C'.FromStruct M'.ConstMsg JoinKeyPart where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinKeyPart M'.ConstMsg)
-instance Default JoinKeyPart where
- def = PH'.defaultStruct
-data JoinResult
- = JoinResult
- {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'.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 C'.FromStruct M'.ConstMsg JoinResult where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.JoinResult M'.ConstMsg)
-instance Default JoinResult where
- def = PH'.defaultStruct
-data ProvisionId
- = ProvisionId
- {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'.Marshal ProvisionId where
- marshalInto raw value = do
- case value of
- ProvisionId{..} -> do
- Capnp.ById.Xa184c7885cdaf2a1.set_ProvisionId'joinId raw joinId
-instance C'.Cerialize s ProvisionId
-instance C'.FromStruct M'.ConstMsg ProvisionId where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.ProvisionId M'.ConstMsg)
-instance Default ProvisionId where
- def = PH'.defaultStruct
-data VatId
- = VatId
- {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'.Marshal VatId where
- marshalInto raw value = do
- case value of
- VatId{..} -> do
- Capnp.ById.Xa184c7885cdaf2a1.set_VatId'side raw side
-instance C'.Cerialize s VatId
-instance C'.FromStruct M'.ConstMsg VatId where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa184c7885cdaf2a1.VatId M'.ConstMsg)
-instance Default VatId where
- def = PH'.defaultStruct
diff --git a/lib/Capnp/Capnp/Schema.hs b/lib/Capnp/Capnp/Schema.hs
deleted file mode 100644
--- a/lib/Capnp/Capnp/Schema.hs
+++ /dev/null
@@ -1,1870 +0,0 @@
-{-# 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.ByteString
-import qualified Data.Capnp.Classes as C'
-import qualified Data.Capnp.Basics as B'
-import qualified Data.Capnp.GenHelpers as H'
-import qualified Data.Capnp.TraversalLimit as TL'
-import qualified Data.Capnp.Untyped as U'
-import qualified Data.Capnp.Message as M'
-import qualified Capnp.ById.Xbdf87d7bb8304e81
-newtype Annotation msg = Annotation_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Annotation msg) where
- fromStruct = pure . Annotation_newtype_
-instance C'.ToStruct msg (Annotation msg) where
- toStruct (Annotation_newtype_ struct) = struct
-instance U'.HasMessage (Annotation msg) where
- type InMessage (Annotation msg) = msg
- message (Annotation_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Annotation msg) where
- messageDefault = Annotation_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Annotation msg) where
- newtype List msg (Annotation msg) = List_Annotation (U'.ListOf msg (U'.Struct msg))
- length (List_Annotation l) = U'.length l
- index i (List_Annotation l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Annotation msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Annotation msg) where
- fromPtr msg ptr = Annotation_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Annotation_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Annotation (M'.MutMsg s)) where
- setIndex (Annotation_newtype_ elt) i (List_Annotation l) = U'.setIndex elt i l
- newList msg len = List_Annotation <$> U'.allocCompositeList msg 1 2 len
-instance C'.Allocate s (Annotation (M'.MutMsg s)) where
- new msg = Annotation_newtype_ <$> U'.allocStruct msg 1 2
-instance C'.IsPtr msg (B'.List msg (Annotation msg)) where
- fromPtr msg ptr = List_Annotation <$> C'.fromPtr msg ptr
- toPtr (List_Annotation l) = C'.toPtr l
-get_Annotation'id :: U'.ReadCtx m msg => Annotation msg -> m Word64
-get_Annotation'id (Annotation_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Annotation'id :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> Word64 -> m ()
-set_Annotation'id (Annotation_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m (Value msg)
-get_Annotation'value (Annotation_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Annotation'value :: U'.ReadCtx m msg => Annotation msg -> m Bool
-has_Annotation'value(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
-set_Annotation'value (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Annotation'value :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
-new_Annotation'value struct = do
- result <- C'.new (U'.message struct)
- set_Annotation'value struct result
- pure result
-get_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m (Brand msg)
-get_Annotation'brand (Annotation_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_Annotation'brand :: U'.ReadCtx m msg => Annotation msg -> m Bool
-has_Annotation'brand(Annotation_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Annotation'brand (Annotation_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_Annotation'brand :: U'.RWCtx m s => Annotation (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Annotation'brand struct = do
- result <- C'.new (U'.message struct)
- set_Annotation'brand struct result
- pure result
-newtype Brand msg = Brand_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Brand msg) where
- fromStruct = pure . Brand_newtype_
-instance C'.ToStruct msg (Brand msg) where
- toStruct (Brand_newtype_ struct) = struct
-instance U'.HasMessage (Brand msg) where
- type InMessage (Brand msg) = msg
- message (Brand_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Brand msg) where
- messageDefault = Brand_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Brand msg) where
- newtype List msg (Brand msg) = List_Brand (U'.ListOf msg (U'.Struct msg))
- length (List_Brand l) = U'.length l
- index i (List_Brand l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Brand msg) where
- fromPtr msg ptr = Brand_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Brand_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Brand (M'.MutMsg s)) where
- setIndex (Brand_newtype_ elt) i (List_Brand l) = U'.setIndex elt i l
- newList msg len = List_Brand <$> U'.allocCompositeList msg 0 1 len
-instance C'.Allocate s (Brand (M'.MutMsg s)) where
- new msg = Brand_newtype_ <$> U'.allocStruct msg 0 1
-instance C'.IsPtr msg (B'.List msg (Brand msg)) where
- fromPtr msg ptr = List_Brand <$> C'.fromPtr msg ptr
- toPtr (List_Brand l) = C'.toPtr l
-get_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m (B'.List msg (Brand'Scope msg))
-get_Brand'scopes (Brand_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Brand'scopes :: U'.ReadCtx m msg => Brand msg -> m Bool
-has_Brand'scopes(Brand_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Brand'scopes :: U'.RWCtx m s => Brand (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))) -> m ()
-set_Brand'scopes (Brand_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Brand'scopes :: U'.RWCtx m s => Int -> Brand (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Scope (M'.MutMsg s))))
-new_Brand'scopes len struct = do
- result <- C'.newList (U'.message struct) len
- set_Brand'scopes struct result
- pure result
-newtype CapnpVersion msg = CapnpVersion_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (CapnpVersion msg) where
- fromStruct = pure . CapnpVersion_newtype_
-instance C'.ToStruct msg (CapnpVersion msg) where
- toStruct (CapnpVersion_newtype_ struct) = struct
-instance U'.HasMessage (CapnpVersion msg) where
- type InMessage (CapnpVersion msg) = msg
- message (CapnpVersion_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (CapnpVersion msg) where
- messageDefault = CapnpVersion_newtype_ . U'.messageDefault
-instance B'.ListElem msg (CapnpVersion msg) where
- newtype List msg (CapnpVersion msg) = List_CapnpVersion (U'.ListOf msg (U'.Struct msg))
- length (List_CapnpVersion l) = U'.length l
- index i (List_CapnpVersion l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CapnpVersion msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (CapnpVersion msg) where
- fromPtr msg ptr = CapnpVersion_newtype_ <$> C'.fromPtr msg ptr
- toPtr (CapnpVersion_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (CapnpVersion (M'.MutMsg s)) where
- setIndex (CapnpVersion_newtype_ elt) i (List_CapnpVersion l) = U'.setIndex elt i l
- newList msg len = List_CapnpVersion <$> U'.allocCompositeList msg 1 0 len
-instance C'.Allocate s (CapnpVersion (M'.MutMsg s)) where
- new msg = CapnpVersion_newtype_ <$> U'.allocStruct msg 1 0
-instance C'.IsPtr msg (B'.List msg (CapnpVersion msg)) where
- fromPtr msg ptr = List_CapnpVersion <$> C'.fromPtr msg ptr
- toPtr (List_CapnpVersion l) = C'.toPtr l
-get_CapnpVersion'major :: U'.ReadCtx m msg => CapnpVersion msg -> m Word16
-get_CapnpVersion'major (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 0 0
-set_CapnpVersion'major :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word16 -> m ()
-set_CapnpVersion'major (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
-get_CapnpVersion'minor :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8
-get_CapnpVersion'minor (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 16 0
-set_CapnpVersion'minor :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m ()
-set_CapnpVersion'minor (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
-get_CapnpVersion'micro :: U'.ReadCtx m msg => CapnpVersion msg -> m Word8
-get_CapnpVersion'micro (CapnpVersion_newtype_ struct) = H'.getWordField struct 0 24 0
-set_CapnpVersion'micro :: U'.RWCtx m s => CapnpVersion (M'.MutMsg s) -> Word8 -> m ()
-set_CapnpVersion'micro (CapnpVersion_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 24 0
-newtype CodeGeneratorRequest msg = CodeGeneratorRequest_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (CodeGeneratorRequest msg) where
- fromStruct = pure . CodeGeneratorRequest_newtype_
-instance C'.ToStruct msg (CodeGeneratorRequest msg) where
- toStruct (CodeGeneratorRequest_newtype_ struct) = struct
-instance U'.HasMessage (CodeGeneratorRequest msg) where
- type InMessage (CodeGeneratorRequest msg) = msg
- message (CodeGeneratorRequest_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (CodeGeneratorRequest msg) where
- messageDefault = CodeGeneratorRequest_newtype_ . U'.messageDefault
-instance B'.ListElem msg (CodeGeneratorRequest msg) where
- newtype List msg (CodeGeneratorRequest msg) = List_CodeGeneratorRequest (U'.ListOf msg (U'.Struct msg))
- length (List_CodeGeneratorRequest l) = U'.length l
- index i (List_CodeGeneratorRequest l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (CodeGeneratorRequest msg) where
- fromPtr msg ptr = CodeGeneratorRequest_newtype_ <$> C'.fromPtr msg ptr
- toPtr (CodeGeneratorRequest_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (CodeGeneratorRequest (M'.MutMsg s)) where
- setIndex (CodeGeneratorRequest_newtype_ elt) i (List_CodeGeneratorRequest l) = U'.setIndex elt i l
- newList msg len = List_CodeGeneratorRequest <$> U'.allocCompositeList msg 0 3 len
-instance C'.Allocate s (CodeGeneratorRequest (M'.MutMsg s)) where
- new msg = CodeGeneratorRequest_newtype_ <$> U'.allocStruct msg 0 3
-instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest msg)) where
- fromPtr msg ptr = List_CodeGeneratorRequest <$> C'.fromPtr msg ptr
- toPtr (List_CodeGeneratorRequest l) = C'.toPtr l
-get_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (Node msg))
-get_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'nodes :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
-has_CodeGeneratorRequest'nodes(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_CodeGeneratorRequest'nodes :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node (M'.MutMsg s))) -> m ()
-set_CodeGeneratorRequest'nodes (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_CodeGeneratorRequest'nodes :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node (M'.MutMsg s))))
-new_CodeGeneratorRequest'nodes len struct = do
- result <- C'.newList (U'.message struct) len
- set_CodeGeneratorRequest'nodes struct result
- pure result
-get_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile msg))
-get_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'requestedFiles :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
-has_CodeGeneratorRequest'requestedFiles(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))) -> m ()
-set_CodeGeneratorRequest'requestedFiles (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_CodeGeneratorRequest'requestedFiles :: U'.RWCtx m s => Int -> CodeGeneratorRequest (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile (M'.MutMsg s))))
-new_CodeGeneratorRequest'requestedFiles len struct = do
- result <- C'.newList (U'.message struct) len
- set_CodeGeneratorRequest'requestedFiles struct result
- pure result
-get_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m (CapnpVersion msg)
-get_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) =
- U'.getPtr 2 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'capnpVersion :: U'.ReadCtx m msg => CodeGeneratorRequest msg -> m Bool
-has_CodeGeneratorRequest'capnpVersion(CodeGeneratorRequest_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
-set_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> (CapnpVersion (M'.MutMsg s)) -> m ()
-set_CodeGeneratorRequest'capnpVersion (CodeGeneratorRequest_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
-new_CodeGeneratorRequest'capnpVersion :: U'.RWCtx m s => CodeGeneratorRequest (M'.MutMsg s) -> m ((CapnpVersion (M'.MutMsg s)))
-new_CodeGeneratorRequest'capnpVersion struct = do
- result <- C'.new (U'.message struct)
- set_CodeGeneratorRequest'capnpVersion struct result
- pure result
-data ElementSize
- = ElementSize'empty
- | ElementSize'bit
- | ElementSize'byte
- | ElementSize'twoBytes
- | ElementSize'fourBytes
- | ElementSize'eightBytes
- | ElementSize'pointer
- | ElementSize'inlineComposite
- | ElementSize'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-instance Enum ElementSize where
- toEnum = C'.fromWord . fromIntegral
- fromEnum = fromIntegral . C'.toWord
-instance C'.IsWord ElementSize where
- fromWord n = go (fromIntegral n :: Word16) where
- go 0 = ElementSize'empty
- go 1 = ElementSize'bit
- go 2 = ElementSize'byte
- go 3 = ElementSize'twoBytes
- go 4 = ElementSize'fourBytes
- go 5 = ElementSize'eightBytes
- go 6 = ElementSize'pointer
- go 7 = ElementSize'inlineComposite
- go tag = ElementSize'unknown' (fromIntegral tag)
- toWord ElementSize'empty = 0
- toWord ElementSize'bit = 1
- toWord ElementSize'byte = 2
- toWord ElementSize'twoBytes = 3
- toWord ElementSize'fourBytes = 4
- toWord ElementSize'eightBytes = 5
- toWord ElementSize'pointer = 6
- toWord ElementSize'inlineComposite = 7
- toWord (ElementSize'unknown' tag) = fromIntegral tag
-instance B'.ListElem msg ElementSize where
- newtype List msg ElementSize = List_ElementSize (U'.ListOf msg Word16)
- length (List_ElementSize l) = U'.length l
- index i (List_ElementSize l) = (C'.fromWord . fromIntegral) <$> U'.index i l
-instance B'.MutListElem s ElementSize where
- setIndex elt i (List_ElementSize l) = U'.setIndex (fromIntegral $ C'.toWord elt) i l
- newList msg size = List_ElementSize <$> U'.allocList16 msg size
-instance C'.IsPtr msg (B'.List msg ElementSize) where
- fromPtr msg ptr = List_ElementSize <$> C'.fromPtr msg ptr
- toPtr (List_ElementSize l) = C'.toPtr l
-newtype Enumerant msg = Enumerant_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Enumerant msg) where
- fromStruct = pure . Enumerant_newtype_
-instance C'.ToStruct msg (Enumerant msg) where
- toStruct (Enumerant_newtype_ struct) = struct
-instance U'.HasMessage (Enumerant msg) where
- type InMessage (Enumerant msg) = msg
- message (Enumerant_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Enumerant msg) where
- messageDefault = Enumerant_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Enumerant msg) where
- newtype List msg (Enumerant msg) = List_Enumerant (U'.ListOf msg (U'.Struct msg))
- length (List_Enumerant l) = U'.length l
- index i (List_Enumerant l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Enumerant msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Enumerant msg) where
- fromPtr msg ptr = Enumerant_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Enumerant_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Enumerant (M'.MutMsg s)) where
- setIndex (Enumerant_newtype_ elt) i (List_Enumerant l) = U'.setIndex elt i l
- newList msg len = List_Enumerant <$> U'.allocCompositeList msg 1 2 len
-instance C'.Allocate s (Enumerant (M'.MutMsg s)) where
- new msg = Enumerant_newtype_ <$> U'.allocStruct msg 1 2
-instance C'.IsPtr msg (B'.List msg (Enumerant msg)) where
- fromPtr msg ptr = List_Enumerant <$> C'.fromPtr msg ptr
- toPtr (List_Enumerant l) = C'.toPtr l
-get_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m (B'.Text msg)
-get_Enumerant'name (Enumerant_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Enumerant'name :: U'.ReadCtx m msg => Enumerant msg -> m Bool
-has_Enumerant'name(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Enumerant'name :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Enumerant'name (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Enumerant'name :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Enumerant'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_Enumerant'name struct result
- pure result
-get_Enumerant'codeOrder :: U'.ReadCtx m msg => Enumerant msg -> m Word16
-get_Enumerant'codeOrder (Enumerant_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Enumerant'codeOrder :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> Word16 -> m ()
-set_Enumerant'codeOrder (Enumerant_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
-get_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m (B'.List msg (Annotation msg))
-get_Enumerant'annotations (Enumerant_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_Enumerant'annotations :: U'.ReadCtx m msg => Enumerant msg -> m Bool
-has_Enumerant'annotations(Enumerant_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_Enumerant'annotations :: U'.RWCtx m s => Enumerant (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
-set_Enumerant'annotations (Enumerant_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_Enumerant'annotations :: U'.RWCtx m s => Int -> Enumerant (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
-new_Enumerant'annotations len struct = do
- result <- C'.newList (U'.message struct) len
- set_Enumerant'annotations struct result
- pure result
-newtype Field msg = Field_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Field msg) where
- fromStruct = pure . Field_newtype_
-instance C'.ToStruct msg (Field msg) where
- toStruct (Field_newtype_ struct) = struct
-instance U'.HasMessage (Field msg) where
- type InMessage (Field msg) = msg
- message (Field_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Field msg) where
- messageDefault = Field_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Field msg) where
- newtype List msg (Field msg) = List_Field (U'.ListOf msg (U'.Struct msg))
- length (List_Field l) = U'.length l
- index i (List_Field l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Field msg) where
- fromPtr msg ptr = Field_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Field_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Field (M'.MutMsg s)) where
- setIndex (Field_newtype_ elt) i (List_Field l) = U'.setIndex elt i l
- newList msg len = List_Field <$> U'.allocCompositeList msg 3 4 len
-instance C'.Allocate s (Field (M'.MutMsg s)) where
- new msg = Field_newtype_ <$> U'.allocStruct msg 3 4
-instance C'.IsPtr msg (B'.List msg (Field msg)) where
- fromPtr msg ptr = List_Field <$> C'.fromPtr msg ptr
- toPtr (List_Field l) = C'.toPtr l
-get_Field'name :: U'.ReadCtx m msg => Field msg -> m (B'.Text msg)
-get_Field'name (Field_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Field'name :: U'.ReadCtx m msg => Field msg -> m Bool
-has_Field'name(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Field'name :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Field'name (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Field'name :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Field'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_Field'name struct result
- pure result
-get_Field'codeOrder :: U'.ReadCtx m msg => Field msg -> m Word16
-get_Field'codeOrder (Field_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Field'codeOrder :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m ()
-set_Field'codeOrder (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
-get_Field'annotations :: U'.ReadCtx m msg => Field msg -> m (B'.List msg (Annotation msg))
-get_Field'annotations (Field_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_Field'annotations :: U'.ReadCtx m msg => Field msg -> m Bool
-has_Field'annotations(Field_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_Field'annotations :: U'.RWCtx m s => Field (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
-set_Field'annotations (Field_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_Field'annotations :: U'.RWCtx m s => Int -> Field (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
-new_Field'annotations len struct = do
- result <- C'.newList (U'.message struct) len
- set_Field'annotations struct result
- pure result
-get_Field'discriminantValue :: U'.ReadCtx m msg => Field msg -> m Word16
-get_Field'discriminantValue (Field_newtype_ struct) = H'.getWordField struct 0 16 65535
-set_Field'discriminantValue :: U'.RWCtx m s => Field (M'.MutMsg s) -> Word16 -> m ()
-set_Field'discriminantValue (Field_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 65535
-get_Field'ordinal :: U'.ReadCtx m msg => Field msg -> m (Field'ordinal msg)
-get_Field'ordinal (Field_newtype_ struct) = C'.fromStruct struct
-get_Field'union' :: U'.ReadCtx m msg => Field msg -> m (Field' msg)
-get_Field'union' (Field_newtype_ struct) = C'.fromStruct struct
-newtype Method msg = Method_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Method msg) where
- fromStruct = pure . Method_newtype_
-instance C'.ToStruct msg (Method msg) where
- toStruct (Method_newtype_ struct) = struct
-instance U'.HasMessage (Method msg) where
- type InMessage (Method msg) = msg
- message (Method_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Method msg) where
- messageDefault = Method_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Method msg) where
- newtype List msg (Method msg) = List_Method (U'.ListOf msg (U'.Struct msg))
- length (List_Method l) = U'.length l
- index i (List_Method l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Method msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Method msg) where
- fromPtr msg ptr = Method_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Method_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Method (M'.MutMsg s)) where
- setIndex (Method_newtype_ elt) i (List_Method l) = U'.setIndex elt i l
- newList msg len = List_Method <$> U'.allocCompositeList msg 3 5 len
-instance C'.Allocate s (Method (M'.MutMsg s)) where
- new msg = Method_newtype_ <$> U'.allocStruct msg 3 5
-instance C'.IsPtr msg (B'.List msg (Method msg)) where
- fromPtr msg ptr = List_Method <$> C'.fromPtr msg ptr
- toPtr (List_Method l) = C'.toPtr l
-get_Method'name :: U'.ReadCtx m msg => Method msg -> m (B'.Text msg)
-get_Method'name (Method_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Method'name :: U'.ReadCtx m msg => Method msg -> m Bool
-has_Method'name(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Method'name :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Method'name (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Method'name :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Method'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_Method'name struct result
- pure result
-get_Method'codeOrder :: U'.ReadCtx m msg => Method msg -> m Word16
-get_Method'codeOrder (Method_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Method'codeOrder :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word16 -> m ()
-set_Method'codeOrder (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 0 0
-get_Method'paramStructType :: U'.ReadCtx m msg => Method msg -> m Word64
-get_Method'paramStructType (Method_newtype_ struct) = H'.getWordField struct 1 0 0
-set_Method'paramStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m ()
-set_Method'paramStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-get_Method'resultStructType :: U'.ReadCtx m msg => Method msg -> m Word64
-get_Method'resultStructType (Method_newtype_ struct) = H'.getWordField struct 2 0 0
-set_Method'resultStructType :: U'.RWCtx m s => Method (M'.MutMsg s) -> Word64 -> m ()
-set_Method'resultStructType (Method_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
-get_Method'annotations :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Annotation msg))
-get_Method'annotations (Method_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_Method'annotations :: U'.ReadCtx m msg => Method msg -> m Bool
-has_Method'annotations(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_Method'annotations :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
-set_Method'annotations (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_Method'annotations :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
-new_Method'annotations len struct = do
- result <- C'.newList (U'.message struct) len
- set_Method'annotations struct result
- pure result
-get_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg)
-get_Method'paramBrand (Method_newtype_ struct) =
- U'.getPtr 2 struct
- >>= C'.fromPtr (U'.message struct)
-has_Method'paramBrand :: U'.ReadCtx m msg => Method msg -> m Bool
-has_Method'paramBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
-set_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Method'paramBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
-new_Method'paramBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Method'paramBrand struct = do
- result <- C'.new (U'.message struct)
- set_Method'paramBrand struct result
- pure result
-get_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m (Brand msg)
-get_Method'resultBrand (Method_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Method'resultBrand :: U'.ReadCtx m msg => Method msg -> m Bool
-has_Method'resultBrand(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Method'resultBrand (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Method'resultBrand :: U'.RWCtx m s => Method (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Method'resultBrand struct = do
- result <- C'.new (U'.message struct)
- set_Method'resultBrand struct result
- pure result
-get_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m (B'.List msg (Node'Parameter msg))
-get_Method'implicitParameters (Method_newtype_ struct) =
- U'.getPtr 4 struct
- >>= C'.fromPtr (U'.message struct)
-has_Method'implicitParameters :: U'.ReadCtx m msg => Method msg -> m Bool
-has_Method'implicitParameters(Method_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
-set_Method'implicitParameters :: U'.RWCtx m s => Method (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m ()
-set_Method'implicitParameters (Method_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
-new_Method'implicitParameters :: U'.RWCtx m s => Int -> Method (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))))
-new_Method'implicitParameters len struct = do
- result <- C'.newList (U'.message struct) len
- set_Method'implicitParameters struct result
- pure result
-newtype Node msg = Node_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node msg) where
- fromStruct = pure . Node_newtype_
-instance C'.ToStruct msg (Node msg) where
- toStruct (Node_newtype_ struct) = struct
-instance U'.HasMessage (Node msg) where
- type InMessage (Node msg) = msg
- message (Node_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node msg) where
- messageDefault = Node_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Node msg) where
- newtype List msg (Node msg) = List_Node (U'.ListOf msg (U'.Struct msg))
- length (List_Node l) = U'.length l
- index i (List_Node l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Node msg) where
- fromPtr msg ptr = Node_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Node_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Node (M'.MutMsg s)) where
- setIndex (Node_newtype_ elt) i (List_Node l) = U'.setIndex elt i l
- newList msg len = List_Node <$> U'.allocCompositeList msg 5 6 len
-instance C'.Allocate s (Node (M'.MutMsg s)) where
- new msg = Node_newtype_ <$> U'.allocStruct msg 5 6
-instance C'.IsPtr msg (B'.List msg (Node msg)) where
- fromPtr msg ptr = List_Node <$> C'.fromPtr msg ptr
- toPtr (List_Node l) = C'.toPtr l
-get_Node'id :: U'.ReadCtx m msg => Node msg -> m Word64
-get_Node'id (Node_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Node'id :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m ()
-set_Node'id (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_Node'displayName :: U'.ReadCtx m msg => Node msg -> m (B'.Text msg)
-get_Node'displayName (Node_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'displayName :: U'.ReadCtx m msg => Node msg -> m Bool
-has_Node'displayName(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Node'displayName :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Node'displayName (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Node'displayName :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Node'displayName len struct = do
- result <- B'.newText (U'.message struct) len
- set_Node'displayName struct result
- pure result
-get_Node'displayNamePrefixLength :: U'.ReadCtx m msg => Node msg -> m Word32
-get_Node'displayNamePrefixLength (Node_newtype_ struct) = H'.getWordField struct 1 0 0
-set_Node'displayNamePrefixLength :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word32 -> m ()
-set_Node'displayNamePrefixLength (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 1 0 0
-get_Node'scopeId :: U'.ReadCtx m msg => Node msg -> m Word64
-get_Node'scopeId (Node_newtype_ struct) = H'.getWordField struct 2 0 0
-set_Node'scopeId :: U'.RWCtx m s => Node (M'.MutMsg s) -> Word64 -> m ()
-set_Node'scopeId (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
-get_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'NestedNode msg))
-get_Node'nestedNodes (Node_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'nestedNodes :: U'.ReadCtx m msg => Node msg -> m Bool
-has_Node'nestedNodes(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_Node'nestedNodes :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))) -> m ()
-set_Node'nestedNodes (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_Node'nestedNodes :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'NestedNode (M'.MutMsg s))))
-new_Node'nestedNodes len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'nestedNodes struct result
- pure result
-get_Node'annotations :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Annotation msg))
-get_Node'annotations (Node_newtype_ struct) =
- U'.getPtr 2 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'annotations :: U'.ReadCtx m msg => Node msg -> m Bool
-has_Node'annotations(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
-set_Node'annotations :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))) -> m ()
-set_Node'annotations (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
-new_Node'annotations :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Annotation (M'.MutMsg s))))
-new_Node'annotations len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'annotations struct result
- pure result
-get_Node'parameters :: U'.ReadCtx m msg => Node msg -> m (B'.List msg (Node'Parameter msg))
-get_Node'parameters (Node_newtype_ struct) =
- U'.getPtr 5 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'parameters :: U'.ReadCtx m msg => Node msg -> m Bool
-has_Node'parameters(Node_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 5 struct
-set_Node'parameters :: U'.RWCtx m s => Node (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))) -> m ()
-set_Node'parameters (Node_newtype_ struct) value = U'.setPtr (C'.toPtr value) 5 struct
-new_Node'parameters :: U'.RWCtx m s => Int -> Node (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Node'Parameter (M'.MutMsg s))))
-new_Node'parameters len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'parameters struct result
- pure result
-get_Node'isGeneric :: U'.ReadCtx m msg => Node msg -> m Bool
-get_Node'isGeneric (Node_newtype_ struct) = H'.getWordField struct 4 32 0
-set_Node'isGeneric :: U'.RWCtx m s => Node (M'.MutMsg s) -> Bool -> m ()
-set_Node'isGeneric (Node_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 4 32 0
-get_Node'union' :: U'.ReadCtx m msg => Node msg -> m (Node' msg)
-get_Node'union' (Node_newtype_ struct) = C'.fromStruct struct
-newtype Superclass msg = Superclass_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Superclass msg) where
- fromStruct = pure . Superclass_newtype_
-instance C'.ToStruct msg (Superclass msg) where
- toStruct (Superclass_newtype_ struct) = struct
-instance U'.HasMessage (Superclass msg) where
- type InMessage (Superclass msg) = msg
- message (Superclass_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Superclass msg) where
- messageDefault = Superclass_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Superclass msg) where
- newtype List msg (Superclass msg) = List_Superclass (U'.ListOf msg (U'.Struct msg))
- length (List_Superclass l) = U'.length l
- index i (List_Superclass l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Superclass msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Superclass msg) where
- fromPtr msg ptr = Superclass_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Superclass_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Superclass (M'.MutMsg s)) where
- setIndex (Superclass_newtype_ elt) i (List_Superclass l) = U'.setIndex elt i l
- newList msg len = List_Superclass <$> U'.allocCompositeList msg 1 1 len
-instance C'.Allocate s (Superclass (M'.MutMsg s)) where
- new msg = Superclass_newtype_ <$> U'.allocStruct msg 1 1
-instance C'.IsPtr msg (B'.List msg (Superclass msg)) where
- fromPtr msg ptr = List_Superclass <$> C'.fromPtr msg ptr
- toPtr (List_Superclass l) = C'.toPtr l
-get_Superclass'id :: U'.ReadCtx m msg => Superclass msg -> m Word64
-get_Superclass'id (Superclass_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Superclass'id :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> Word64 -> m ()
-set_Superclass'id (Superclass_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m (Brand msg)
-get_Superclass'brand (Superclass_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Superclass'brand :: U'.ReadCtx m msg => Superclass msg -> m Bool
-has_Superclass'brand(Superclass_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Superclass'brand (Superclass_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Superclass'brand :: U'.RWCtx m s => Superclass (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Superclass'brand struct = do
- result <- C'.new (U'.message struct)
- set_Superclass'brand struct result
- pure result
-newtype Type msg = Type_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type msg) where
- fromStruct = pure . Type_newtype_
-instance C'.ToStruct msg (Type msg) where
- toStruct (Type_newtype_ struct) = struct
-instance U'.HasMessage (Type msg) where
- type InMessage (Type msg) = msg
- message (Type_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type msg) where
- messageDefault = Type_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Type msg) where
- newtype List msg (Type msg) = List_Type (U'.ListOf msg (U'.Struct msg))
- length (List_Type l) = U'.length l
- index i (List_Type l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Type msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Type msg) where
- fromPtr msg ptr = Type_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Type_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Type (M'.MutMsg s)) where
- setIndex (Type_newtype_ elt) i (List_Type l) = U'.setIndex elt i l
- newList msg len = List_Type <$> U'.allocCompositeList msg 3 1 len
-instance C'.Allocate s (Type (M'.MutMsg s)) where
- new msg = Type_newtype_ <$> U'.allocStruct msg 3 1
-instance C'.IsPtr msg (B'.List msg (Type msg)) where
- fromPtr msg ptr = List_Type <$> C'.fromPtr msg ptr
- toPtr (List_Type l) = C'.toPtr l
-data Type' msg
- = Type'void
- | Type'bool
- | Type'int8
- | Type'int16
- | Type'int32
- | Type'int64
- | Type'uint8
- | Type'uint16
- | Type'uint32
- | Type'uint64
- | Type'float32
- | Type'float64
- | Type'text
- | Type'data_
- | Type'list (Type'list'group' msg)
- | Type'enum (Type'enum'group' msg)
- | Type'struct (Type'struct'group' msg)
- | Type'interface (Type'interface'group' msg)
- | Type'anyPointer (Type'anyPointer'group' msg)
- | Type'unknown' Word16
-get_Type' :: U'.ReadCtx m msg => Type msg -> m (Type' msg)
-get_Type' (Type_newtype_ struct) = C'.fromStruct struct
-set_Type'void :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'void (Type_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
-set_Type'bool :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'bool (Type_newtype_ struct) = H'.setWordField struct (1 :: Word16) 0 0 0
-set_Type'int8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'int8 (Type_newtype_ struct) = H'.setWordField struct (2 :: Word16) 0 0 0
-set_Type'int16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'int16 (Type_newtype_ struct) = H'.setWordField struct (3 :: Word16) 0 0 0
-set_Type'int32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'int32 (Type_newtype_ struct) = H'.setWordField struct (4 :: Word16) 0 0 0
-set_Type'int64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'int64 (Type_newtype_ struct) = H'.setWordField struct (5 :: Word16) 0 0 0
-set_Type'uint8 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'uint8 (Type_newtype_ struct) = H'.setWordField struct (6 :: Word16) 0 0 0
-set_Type'uint16 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'uint16 (Type_newtype_ struct) = H'.setWordField struct (7 :: Word16) 0 0 0
-set_Type'uint32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'uint32 (Type_newtype_ struct) = H'.setWordField struct (8 :: Word16) 0 0 0
-set_Type'uint64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'uint64 (Type_newtype_ struct) = H'.setWordField struct (9 :: Word16) 0 0 0
-set_Type'float32 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'float32 (Type_newtype_ struct) = H'.setWordField struct (10 :: Word16) 0 0 0
-set_Type'float64 :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'float64 (Type_newtype_ struct) = H'.setWordField struct (11 :: Word16) 0 0 0
-set_Type'text :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'text (Type_newtype_ struct) = H'.setWordField struct (12 :: Word16) 0 0 0
-set_Type'data_ :: U'.RWCtx m s => Type (M'.MutMsg s) -> m ()
-set_Type'data_ (Type_newtype_ struct) = H'.setWordField struct (13 :: Word16) 0 0 0
-set_Type'list :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'list'group' (M'.MutMsg s))
-set_Type'list (Type_newtype_ struct) = do
- H'.setWordField struct (14 :: Word16) 0 0 0
- pure $ Type'list'group'_newtype_ struct
-set_Type'enum :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'enum'group' (M'.MutMsg s))
-set_Type'enum (Type_newtype_ struct) = do
- H'.setWordField struct (15 :: Word16) 0 0 0
- pure $ Type'enum'group'_newtype_ struct
-set_Type'struct :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'struct'group' (M'.MutMsg s))
-set_Type'struct (Type_newtype_ struct) = do
- H'.setWordField struct (16 :: Word16) 0 0 0
- pure $ Type'struct'group'_newtype_ struct
-set_Type'interface :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'interface'group' (M'.MutMsg s))
-set_Type'interface (Type_newtype_ struct) = do
- H'.setWordField struct (17 :: Word16) 0 0 0
- pure $ Type'interface'group'_newtype_ struct
-set_Type'anyPointer :: U'.RWCtx m s => Type (M'.MutMsg s) -> m (Type'anyPointer'group' (M'.MutMsg s))
-set_Type'anyPointer (Type_newtype_ struct) = do
- H'.setWordField struct (18 :: Word16) 0 0 0
- pure $ Type'anyPointer'group'_newtype_ struct
-set_Type'unknown' :: U'.RWCtx m s => Type (M'.MutMsg s) -> Word16 -> m ()
-set_Type'unknown'(Type_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
-newtype Type'list'group' msg = Type'list'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'list'group' msg) where
- fromStruct = pure . Type'list'group'_newtype_
-instance C'.ToStruct msg (Type'list'group' msg) where
- toStruct (Type'list'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'list'group' msg) where
- type InMessage (Type'list'group' msg) = msg
- message (Type'list'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'list'group' msg) where
- messageDefault = Type'list'group'_newtype_ . U'.messageDefault
-get_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m (Type msg)
-get_Type'list'elementType (Type'list'group'_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Type'list'elementType :: U'.ReadCtx m msg => Type'list'group' msg -> m Bool
-has_Type'list'elementType(Type'list'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
-set_Type'list'elementType (Type'list'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Type'list'elementType :: U'.RWCtx m s => Type'list'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
-new_Type'list'elementType struct = do
- result <- C'.new (U'.message struct)
- set_Type'list'elementType struct result
- pure result
-newtype Type'enum'group' msg = Type'enum'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'enum'group' msg) where
- fromStruct = pure . Type'enum'group'_newtype_
-instance C'.ToStruct msg (Type'enum'group' msg) where
- toStruct (Type'enum'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'enum'group' msg) where
- type InMessage (Type'enum'group' msg) = msg
- message (Type'enum'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'enum'group' msg) where
- messageDefault = Type'enum'group'_newtype_ . U'.messageDefault
-get_Type'enum'typeId :: U'.ReadCtx m msg => Type'enum'group' msg -> m Word64
-get_Type'enum'typeId (Type'enum'group'_newtype_ struct) = H'.getWordField struct 1 0 0
-set_Type'enum'typeId :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> Word64 -> m ()
-set_Type'enum'typeId (Type'enum'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-get_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m (Brand msg)
-get_Type'enum'brand (Type'enum'group'_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Type'enum'brand :: U'.ReadCtx m msg => Type'enum'group' msg -> m Bool
-has_Type'enum'brand(Type'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Type'enum'brand (Type'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Type'enum'brand :: U'.RWCtx m s => Type'enum'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Type'enum'brand struct = do
- result <- C'.new (U'.message struct)
- set_Type'enum'brand struct result
- pure result
-newtype Type'struct'group' msg = Type'struct'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'struct'group' msg) where
- fromStruct = pure . Type'struct'group'_newtype_
-instance C'.ToStruct msg (Type'struct'group' msg) where
- toStruct (Type'struct'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'struct'group' msg) where
- type InMessage (Type'struct'group' msg) = msg
- message (Type'struct'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'struct'group' msg) where
- messageDefault = Type'struct'group'_newtype_ . U'.messageDefault
-get_Type'struct'typeId :: U'.ReadCtx m msg => Type'struct'group' msg -> m Word64
-get_Type'struct'typeId (Type'struct'group'_newtype_ struct) = H'.getWordField struct 1 0 0
-set_Type'struct'typeId :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> Word64 -> m ()
-set_Type'struct'typeId (Type'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-get_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m (Brand msg)
-get_Type'struct'brand (Type'struct'group'_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Type'struct'brand :: U'.ReadCtx m msg => Type'struct'group' msg -> m Bool
-has_Type'struct'brand(Type'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Type'struct'brand (Type'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Type'struct'brand :: U'.RWCtx m s => Type'struct'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Type'struct'brand struct = do
- result <- C'.new (U'.message struct)
- set_Type'struct'brand struct result
- pure result
-newtype Type'interface'group' msg = Type'interface'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'interface'group' msg) where
- fromStruct = pure . Type'interface'group'_newtype_
-instance C'.ToStruct msg (Type'interface'group' msg) where
- toStruct (Type'interface'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'interface'group' msg) where
- type InMessage (Type'interface'group' msg) = msg
- message (Type'interface'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'interface'group' msg) where
- messageDefault = Type'interface'group'_newtype_ . U'.messageDefault
-get_Type'interface'typeId :: U'.ReadCtx m msg => Type'interface'group' msg -> m Word64
-get_Type'interface'typeId (Type'interface'group'_newtype_ struct) = H'.getWordField struct 1 0 0
-set_Type'interface'typeId :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> Word64 -> m ()
-set_Type'interface'typeId (Type'interface'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-get_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m (Brand msg)
-get_Type'interface'brand (Type'interface'group'_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Type'interface'brand :: U'.ReadCtx m msg => Type'interface'group' msg -> m Bool
-has_Type'interface'brand(Type'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> (Brand (M'.MutMsg s)) -> m ()
-set_Type'interface'brand (Type'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Type'interface'brand :: U'.RWCtx m s => Type'interface'group' (M'.MutMsg s) -> m ((Brand (M'.MutMsg s)))
-new_Type'interface'brand struct = do
- result <- C'.new (U'.message struct)
- set_Type'interface'brand struct result
- pure result
-newtype Type'anyPointer'group' msg = Type'anyPointer'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer'group' msg) where
- fromStruct = pure . Type'anyPointer'group'_newtype_
-instance C'.ToStruct msg (Type'anyPointer'group' msg) where
- toStruct (Type'anyPointer'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer'group' msg) where
- type InMessage (Type'anyPointer'group' msg) = msg
- message (Type'anyPointer'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer'group' msg) where
- messageDefault = Type'anyPointer'group'_newtype_ . U'.messageDefault
-get_Type'anyPointer'union' :: U'.ReadCtx m msg => Type'anyPointer'group' msg -> m (Type'anyPointer msg)
-get_Type'anyPointer'union' (Type'anyPointer'group'_newtype_ struct) = C'.fromStruct struct
-instance C'.FromStruct msg (Type' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 0 0 0
- case tag of
- 18 -> Type'anyPointer <$> C'.fromStruct struct
- 17 -> Type'interface <$> C'.fromStruct struct
- 16 -> Type'struct <$> C'.fromStruct struct
- 15 -> Type'enum <$> C'.fromStruct struct
- 14 -> Type'list <$> C'.fromStruct struct
- 13 -> pure Type'data_
- 12 -> pure Type'text
- 11 -> pure Type'float64
- 10 -> pure Type'float32
- 9 -> pure Type'uint64
- 8 -> pure Type'uint32
- 7 -> pure Type'uint16
- 6 -> pure Type'uint8
- 5 -> pure Type'int64
- 4 -> pure Type'int32
- 3 -> pure Type'int16
- 2 -> pure Type'int8
- 1 -> pure Type'bool
- 0 -> pure Type'void
- _ -> pure $ Type'unknown' tag
-newtype Value msg = Value_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Value msg) where
- fromStruct = pure . Value_newtype_
-instance C'.ToStruct msg (Value msg) where
- toStruct (Value_newtype_ struct) = struct
-instance U'.HasMessage (Value msg) where
- type InMessage (Value msg) = msg
- message (Value_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Value msg) where
- messageDefault = Value_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Value msg) where
- newtype List msg (Value msg) = List_Value (U'.ListOf msg (U'.Struct msg))
- length (List_Value l) = U'.length l
- index i (List_Value l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Value msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Value msg) where
- fromPtr msg ptr = Value_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Value_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Value (M'.MutMsg s)) where
- setIndex (Value_newtype_ elt) i (List_Value l) = U'.setIndex elt i l
- newList msg len = List_Value <$> U'.allocCompositeList msg 2 1 len
-instance C'.Allocate s (Value (M'.MutMsg s)) where
- new msg = Value_newtype_ <$> U'.allocStruct msg 2 1
-instance C'.IsPtr msg (B'.List msg (Value msg)) where
- fromPtr msg ptr = List_Value <$> C'.fromPtr msg ptr
- toPtr (List_Value l) = C'.toPtr l
-data Value' msg
- = Value'void
- | Value'bool Bool
- | Value'int8 Int8
- | Value'int16 Int16
- | Value'int32 Int32
- | Value'int64 Int64
- | Value'uint8 Word8
- | Value'uint16 Word16
- | Value'uint32 Word32
- | Value'uint64 Word64
- | Value'float32 Float
- | Value'float64 Double
- | Value'text (B'.Text msg)
- | Value'data_ (B'.Data msg)
- | Value'list (Maybe (U'.Ptr msg))
- | Value'enum Word16
- | Value'struct (Maybe (U'.Ptr msg))
- | Value'interface
- | Value'anyPointer (Maybe (U'.Ptr msg))
- | Value'unknown' Word16
-get_Value' :: U'.ReadCtx m msg => Value msg -> m (Value' msg)
-get_Value' (Value_newtype_ struct) = C'.fromStruct struct
-set_Value'void :: U'.RWCtx m s => Value (M'.MutMsg s) -> m ()
-set_Value'void (Value_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
-set_Value'bool :: U'.RWCtx m s => Value (M'.MutMsg s) -> Bool -> m ()
-set_Value'bool (Value_newtype_ struct) value = do
- H'.setWordField struct (1 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 0 16 0
-set_Value'int8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int8 -> m ()
-set_Value'int8 (Value_newtype_ struct) value = do
- H'.setWordField struct (2 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
-set_Value'int16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int16 -> m ()
-set_Value'int16 (Value_newtype_ struct) value = do
- H'.setWordField struct (3 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
-set_Value'int32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int32 -> m ()
-set_Value'int32 (Value_newtype_ struct) value = do
- H'.setWordField struct (4 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
-set_Value'int64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Int64 -> m ()
-set_Value'int64 (Value_newtype_ struct) value = do
- H'.setWordField struct (5 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-set_Value'uint8 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word8 -> m ()
-set_Value'uint8 (Value_newtype_ struct) value = do
- H'.setWordField struct (6 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word8) 0 16 0
-set_Value'uint16 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
-set_Value'uint16 (Value_newtype_ struct) value = do
- H'.setWordField struct (7 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
-set_Value'uint32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word32 -> m ()
-set_Value'uint32 (Value_newtype_ struct) value = do
- H'.setWordField struct (8 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
-set_Value'uint64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word64 -> m ()
-set_Value'uint64 (Value_newtype_ struct) value = do
- H'.setWordField struct (9 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-set_Value'float32 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Float -> m ()
-set_Value'float32 (Value_newtype_ struct) value = do
- H'.setWordField struct (10 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
-set_Value'float64 :: U'.RWCtx m s => Value (M'.MutMsg s) -> Double -> m ()
-set_Value'float64 (Value_newtype_ struct) value = do
- H'.setWordField struct (11 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 1 0 0
-set_Value'text :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Value'text(Value_newtype_ struct) value = do
- H'.setWordField struct (12 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-new_Value'text :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Value'text len struct = do
- result <- B'.newText (U'.message struct) len
- set_Value'text struct result
- pure result
-set_Value'data_ :: U'.RWCtx m s => Value (M'.MutMsg s) -> (B'.Data (M'.MutMsg s)) -> m ()
-set_Value'data_(Value_newtype_ struct) value = do
- H'.setWordField struct (13 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-new_Value'data_ :: U'.RWCtx m s => Int -> Value (M'.MutMsg s) -> m ((B'.Data (M'.MutMsg s)))
-new_Value'data_ len struct = do
- result <- B'.newData (U'.message struct) len
- set_Value'data_ struct result
- pure result
-set_Value'list :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
-set_Value'list(Value_newtype_ struct) value = do
- H'.setWordField struct (14 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-set_Value'enum :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
-set_Value'enum (Value_newtype_ struct) value = do
- H'.setWordField struct (15 :: Word16) 0 0 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 0 16 0
-set_Value'struct :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
-set_Value'struct(Value_newtype_ struct) value = do
- H'.setWordField struct (16 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-set_Value'interface :: U'.RWCtx m s => Value (M'.MutMsg s) -> m ()
-set_Value'interface (Value_newtype_ struct) = H'.setWordField struct (17 :: Word16) 0 0 0
-set_Value'anyPointer :: U'.RWCtx m s => Value (M'.MutMsg s) -> (Maybe (U'.Ptr (M'.MutMsg s))) -> m ()
-set_Value'anyPointer(Value_newtype_ struct) value = do
- H'.setWordField struct (18 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-set_Value'unknown' :: U'.RWCtx m s => Value (M'.MutMsg s) -> Word16 -> m ()
-set_Value'unknown'(Value_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
-instance C'.FromStruct msg (Value' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 0 0 0
- case tag of
- 18 -> Value'anyPointer <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 17 -> pure Value'interface
- 16 -> Value'struct <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 15 -> Value'enum <$> H'.getWordField struct 0 16 0
- 14 -> Value'list <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 13 -> Value'data_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 12 -> Value'text <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 11 -> Value'float64 <$> H'.getWordField struct 1 0 0
- 10 -> Value'float32 <$> H'.getWordField struct 0 32 0
- 9 -> Value'uint64 <$> H'.getWordField struct 1 0 0
- 8 -> Value'uint32 <$> H'.getWordField struct 0 32 0
- 7 -> Value'uint16 <$> H'.getWordField struct 0 16 0
- 6 -> Value'uint8 <$> H'.getWordField struct 0 16 0
- 5 -> Value'int64 <$> H'.getWordField struct 1 0 0
- 4 -> Value'int32 <$> H'.getWordField struct 0 32 0
- 3 -> Value'int16 <$> H'.getWordField struct 0 16 0
- 2 -> Value'int8 <$> H'.getWordField struct 0 16 0
- 1 -> Value'bool <$> H'.getWordField struct 0 16 0
- 0 -> pure Value'void
- _ -> pure $ Value'unknown' tag
-newtype Brand'Binding msg = Brand'Binding_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Brand'Binding msg) where
- fromStruct = pure . Brand'Binding_newtype_
-instance C'.ToStruct msg (Brand'Binding msg) where
- toStruct (Brand'Binding_newtype_ struct) = struct
-instance U'.HasMessage (Brand'Binding msg) where
- type InMessage (Brand'Binding msg) = msg
- message (Brand'Binding_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Brand'Binding msg) where
- messageDefault = Brand'Binding_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Brand'Binding msg) where
- newtype List msg (Brand'Binding msg) = List_Brand'Binding (U'.ListOf msg (U'.Struct msg))
- length (List_Brand'Binding l) = U'.length l
- index i (List_Brand'Binding l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Binding msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Brand'Binding msg) where
- fromPtr msg ptr = Brand'Binding_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Brand'Binding_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Brand'Binding (M'.MutMsg s)) where
- setIndex (Brand'Binding_newtype_ elt) i (List_Brand'Binding l) = U'.setIndex elt i l
- newList msg len = List_Brand'Binding <$> U'.allocCompositeList msg 1 1 len
-instance C'.Allocate s (Brand'Binding (M'.MutMsg s)) where
- new msg = Brand'Binding_newtype_ <$> U'.allocStruct msg 1 1
-instance C'.IsPtr msg (B'.List msg (Brand'Binding msg)) where
- fromPtr msg ptr = List_Brand'Binding <$> C'.fromPtr msg ptr
- toPtr (List_Brand'Binding l) = C'.toPtr l
-data Brand'Binding' msg
- = Brand'Binding'unbound
- | Brand'Binding'type_ (Type msg)
- | Brand'Binding'unknown' Word16
-get_Brand'Binding' :: U'.ReadCtx m msg => Brand'Binding msg -> m (Brand'Binding' msg)
-get_Brand'Binding' (Brand'Binding_newtype_ struct) = C'.fromStruct struct
-set_Brand'Binding'unbound :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ()
-set_Brand'Binding'unbound (Brand'Binding_newtype_ struct) = H'.setWordField struct (0 :: Word16) 0 0 0
-set_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
-set_Brand'Binding'type_(Brand'Binding_newtype_ struct) value = do
- H'.setWordField struct (1 :: Word16) 0 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-new_Brand'Binding'type_ :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
-new_Brand'Binding'type_ struct = do
- result <- C'.new (U'.message struct)
- set_Brand'Binding'type_ struct result
- pure result
-set_Brand'Binding'unknown' :: U'.RWCtx m s => Brand'Binding (M'.MutMsg s) -> Word16 -> m ()
-set_Brand'Binding'unknown'(Brand'Binding_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 0 0 0
-instance C'.FromStruct msg (Brand'Binding' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 0 0 0
- case tag of
- 1 -> Brand'Binding'type_ <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- 0 -> pure Brand'Binding'unbound
- _ -> pure $ Brand'Binding'unknown' tag
-newtype Brand'Scope msg = Brand'Scope_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Brand'Scope msg) where
- fromStruct = pure . Brand'Scope_newtype_
-instance C'.ToStruct msg (Brand'Scope msg) where
- toStruct (Brand'Scope_newtype_ struct) = struct
-instance U'.HasMessage (Brand'Scope msg) where
- type InMessage (Brand'Scope msg) = msg
- message (Brand'Scope_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Brand'Scope msg) where
- messageDefault = Brand'Scope_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Brand'Scope msg) where
- newtype List msg (Brand'Scope msg) = List_Brand'Scope (U'.ListOf msg (U'.Struct msg))
- length (List_Brand'Scope l) = U'.length l
- index i (List_Brand'Scope l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Brand'Scope msg) where
- fromPtr msg ptr = Brand'Scope_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Brand'Scope_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Brand'Scope (M'.MutMsg s)) where
- setIndex (Brand'Scope_newtype_ elt) i (List_Brand'Scope l) = U'.setIndex elt i l
- newList msg len = List_Brand'Scope <$> U'.allocCompositeList msg 2 1 len
-instance C'.Allocate s (Brand'Scope (M'.MutMsg s)) where
- new msg = Brand'Scope_newtype_ <$> U'.allocStruct msg 2 1
-instance C'.IsPtr msg (B'.List msg (Brand'Scope msg)) where
- fromPtr msg ptr = List_Brand'Scope <$> C'.fromPtr msg ptr
- toPtr (List_Brand'Scope l) = C'.toPtr l
-get_Brand'Scope'scopeId :: U'.ReadCtx m msg => Brand'Scope msg -> m Word64
-get_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Brand'Scope'scopeId :: U'.RWCtx m s => Brand'Scope (M'.MutMsg s) -> Word64 -> m ()
-set_Brand'Scope'scopeId (Brand'Scope_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_Brand'Scope'union' :: U'.ReadCtx m msg => Brand'Scope msg -> m (Brand'Scope' msg)
-get_Brand'Scope'union' (Brand'Scope_newtype_ struct) = C'.fromStruct struct
-newtype Brand'Scope' msg = Brand'Scope'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Brand'Scope' msg) where
- fromStruct = pure . Brand'Scope'_newtype_
-instance C'.ToStruct msg (Brand'Scope' msg) where
- toStruct (Brand'Scope'_newtype_ struct) = struct
-instance U'.HasMessage (Brand'Scope' msg) where
- type InMessage (Brand'Scope' msg) = msg
- message (Brand'Scope'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Brand'Scope' msg) where
- messageDefault = Brand'Scope'_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Brand'Scope' msg) where
- newtype List msg (Brand'Scope' msg) = List_Brand'Scope' (U'.ListOf msg (U'.Struct msg))
- length (List_Brand'Scope' l) = U'.length l
- index i (List_Brand'Scope' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Brand'Scope' msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Brand'Scope' msg) where
- fromPtr msg ptr = Brand'Scope'_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Brand'Scope'_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Brand'Scope' (M'.MutMsg s)) where
- setIndex (Brand'Scope'_newtype_ elt) i (List_Brand'Scope' l) = U'.setIndex elt i l
- newList msg len = List_Brand'Scope' <$> U'.allocCompositeList msg 2 1 len
-instance C'.Allocate s (Brand'Scope' (M'.MutMsg s)) where
- new msg = Brand'Scope'_newtype_ <$> U'.allocStruct msg 2 1
-instance C'.IsPtr msg (B'.List msg (Brand'Scope' msg)) where
- fromPtr msg ptr = List_Brand'Scope' <$> C'.fromPtr msg ptr
- toPtr (List_Brand'Scope' l) = C'.toPtr l
-data Brand'Scope'' msg
- = Brand'Scope'bind (B'.List msg (Brand'Binding msg))
- | Brand'Scope'inherit
- | Brand'Scope''unknown' Word16
-get_Brand'Scope'' :: U'.ReadCtx m msg => Brand'Scope' msg -> m (Brand'Scope'' msg)
-get_Brand'Scope'' (Brand'Scope'_newtype_ struct) = C'.fromStruct struct
-set_Brand'Scope'bind :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))) -> m ()
-set_Brand'Scope'bind(Brand'Scope'_newtype_ struct) value = do
- H'.setWordField struct (0 :: Word16) 1 0 0
- U'.setPtr (C'.toPtr value) 0 struct
-new_Brand'Scope'bind :: U'.RWCtx m s => Int -> Brand'Scope' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Brand'Binding (M'.MutMsg s))))
-new_Brand'Scope'bind len struct = do
- result <- C'.newList (U'.message struct) len
- set_Brand'Scope'bind struct result
- pure result
-set_Brand'Scope'inherit :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> m ()
-set_Brand'Scope'inherit (Brand'Scope'_newtype_ struct) = H'.setWordField struct (1 :: Word16) 1 0 0
-set_Brand'Scope''unknown' :: U'.RWCtx m s => Brand'Scope' (M'.MutMsg s) -> Word16 -> m ()
-set_Brand'Scope''unknown'(Brand'Scope'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
-instance C'.FromStruct msg (Brand'Scope'' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 1 0 0
- case tag of
- 1 -> pure Brand'Scope'inherit
- 0 -> Brand'Scope'bind <$> (U'.getPtr 0 struct >>= C'.fromPtr (U'.message struct))
- _ -> pure $ Brand'Scope''unknown' tag
-newtype CodeGeneratorRequest'RequestedFile msg = CodeGeneratorRequest'RequestedFile_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile msg) where
- fromStruct = pure . CodeGeneratorRequest'RequestedFile_newtype_
-instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile msg) where
- toStruct (CodeGeneratorRequest'RequestedFile_newtype_ struct) = struct
-instance U'.HasMessage (CodeGeneratorRequest'RequestedFile msg) where
- type InMessage (CodeGeneratorRequest'RequestedFile msg) = msg
- message (CodeGeneratorRequest'RequestedFile_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile msg) where
- messageDefault = CodeGeneratorRequest'RequestedFile_newtype_ . U'.messageDefault
-instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile msg) where
- newtype List msg (CodeGeneratorRequest'RequestedFile msg) = List_CodeGeneratorRequest'RequestedFile (U'.ListOf msg (U'.Struct msg))
- length (List_CodeGeneratorRequest'RequestedFile l) = U'.length l
- index i (List_CodeGeneratorRequest'RequestedFile l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile msg) where
- fromPtr msg ptr = CodeGeneratorRequest'RequestedFile_newtype_ <$> C'.fromPtr msg ptr
- toPtr (CodeGeneratorRequest'RequestedFile_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where
- setIndex (CodeGeneratorRequest'RequestedFile_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile l) = U'.setIndex elt i l
- newList msg len = List_CodeGeneratorRequest'RequestedFile <$> U'.allocCompositeList msg 1 2 len
-instance C'.Allocate s (CodeGeneratorRequest'RequestedFile (M'.MutMsg s)) where
- new msg = CodeGeneratorRequest'RequestedFile_newtype_ <$> U'.allocStruct msg 1 2
-instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile msg)) where
- fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile <$> C'.fromPtr msg ptr
- toPtr (List_CodeGeneratorRequest'RequestedFile l) = C'.toPtr l
-get_CodeGeneratorRequest'RequestedFile'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Word64
-get_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) = H'.getWordField struct 0 0 0
-set_CodeGeneratorRequest'RequestedFile'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> Word64 -> m ()
-set_CodeGeneratorRequest'RequestedFile'id (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.Text msg)
-get_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'RequestedFile'filename :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool
-has_CodeGeneratorRequest'RequestedFile'filename(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_CodeGeneratorRequest'RequestedFile'filename (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_CodeGeneratorRequest'RequestedFile'filename :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_CodeGeneratorRequest'RequestedFile'filename len struct = do
- result <- B'.newText (U'.message struct) len
- set_CodeGeneratorRequest'RequestedFile'filename struct result
- pure result
-get_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg))
-get_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) =
- U'.getPtr 1 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'RequestedFile'imports :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile msg -> m Bool
-has_CodeGeneratorRequest'RequestedFile'imports(CodeGeneratorRequest'RequestedFile_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 1 struct
-set_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))) -> m ()
-set_CodeGeneratorRequest'RequestedFile'imports (CodeGeneratorRequest'RequestedFile_newtype_ struct) value = U'.setPtr (C'.toPtr value) 1 struct
-new_CodeGeneratorRequest'RequestedFile'imports :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s))))
-new_CodeGeneratorRequest'RequestedFile'imports len struct = do
- result <- C'.newList (U'.message struct) len
- set_CodeGeneratorRequest'RequestedFile'imports struct result
- pure result
-newtype CodeGeneratorRequest'RequestedFile'Import msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where
- fromStruct = pure . CodeGeneratorRequest'RequestedFile'Import_newtype_
-instance C'.ToStruct msg (CodeGeneratorRequest'RequestedFile'Import msg) where
- toStruct (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = struct
-instance U'.HasMessage (CodeGeneratorRequest'RequestedFile'Import msg) where
- type InMessage (CodeGeneratorRequest'RequestedFile'Import msg) = msg
- message (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (CodeGeneratorRequest'RequestedFile'Import msg) where
- messageDefault = CodeGeneratorRequest'RequestedFile'Import_newtype_ . U'.messageDefault
-instance B'.ListElem msg (CodeGeneratorRequest'RequestedFile'Import msg) where
- newtype List msg (CodeGeneratorRequest'RequestedFile'Import msg) = List_CodeGeneratorRequest'RequestedFile'Import (U'.ListOf msg (U'.Struct msg))
- length (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.length l
- index i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (CodeGeneratorRequest'RequestedFile'Import msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (CodeGeneratorRequest'RequestedFile'Import msg) where
- fromPtr msg ptr = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> C'.fromPtr msg ptr
- toPtr (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where
- setIndex (CodeGeneratorRequest'RequestedFile'Import_newtype_ elt) i (List_CodeGeneratorRequest'RequestedFile'Import l) = U'.setIndex elt i l
- newList msg len = List_CodeGeneratorRequest'RequestedFile'Import <$> U'.allocCompositeList msg 1 1 len
-instance C'.Allocate s (CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s)) where
- new msg = CodeGeneratorRequest'RequestedFile'Import_newtype_ <$> U'.allocStruct msg 1 1
-instance C'.IsPtr msg (B'.List msg (CodeGeneratorRequest'RequestedFile'Import msg)) where
- fromPtr msg ptr = List_CodeGeneratorRequest'RequestedFile'Import <$> C'.fromPtr msg ptr
- toPtr (List_CodeGeneratorRequest'RequestedFile'Import l) = C'.toPtr l
-get_CodeGeneratorRequest'RequestedFile'Import'id :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Word64
-get_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = H'.getWordField struct 0 0 0
-set_CodeGeneratorRequest'RequestedFile'Import'id :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> Word64 -> m ()
-set_CodeGeneratorRequest'RequestedFile'Import'id (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-get_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m (B'.Text msg)
-get_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_CodeGeneratorRequest'RequestedFile'Import'name :: U'.ReadCtx m msg => CodeGeneratorRequest'RequestedFile'Import msg -> m Bool
-has_CodeGeneratorRequest'RequestedFile'Import'name(CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_CodeGeneratorRequest'RequestedFile'Import'name (CodeGeneratorRequest'RequestedFile'Import_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_CodeGeneratorRequest'RequestedFile'Import'name :: U'.RWCtx m s => Int -> CodeGeneratorRequest'RequestedFile'Import (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_CodeGeneratorRequest'RequestedFile'Import'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_CodeGeneratorRequest'RequestedFile'Import'name struct result
- pure result
-newtype Field' msg = Field'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Field' msg) where
- fromStruct = pure . Field'_newtype_
-instance C'.ToStruct msg (Field' msg) where
- toStruct (Field'_newtype_ struct) = struct
-instance U'.HasMessage (Field' msg) where
- type InMessage (Field' msg) = msg
- message (Field'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Field' msg) where
- messageDefault = Field'_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Field' msg) where
- newtype List msg (Field' msg) = List_Field' (U'.ListOf msg (U'.Struct msg))
- length (List_Field' l) = U'.length l
- index i (List_Field' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Field' msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Field' msg) where
- fromPtr msg ptr = Field'_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Field'_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Field' (M'.MutMsg s)) where
- setIndex (Field'_newtype_ elt) i (List_Field' l) = U'.setIndex elt i l
- newList msg len = List_Field' <$> U'.allocCompositeList msg 3 4 len
-instance C'.Allocate s (Field' (M'.MutMsg s)) where
- new msg = Field'_newtype_ <$> U'.allocStruct msg 3 4
-instance C'.IsPtr msg (B'.List msg (Field' msg)) where
- fromPtr msg ptr = List_Field' <$> C'.fromPtr msg ptr
- toPtr (List_Field' l) = C'.toPtr l
-data Field'' msg
- = Field'slot (Field'slot'group' msg)
- | Field'group (Field'group'group' msg)
- | Field''unknown' Word16
-get_Field'' :: U'.ReadCtx m msg => Field' msg -> m (Field'' msg)
-get_Field'' (Field'_newtype_ struct) = C'.fromStruct struct
-set_Field'slot :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'slot'group' (M'.MutMsg s))
-set_Field'slot (Field'_newtype_ struct) = do
- H'.setWordField struct (0 :: Word16) 1 0 0
- pure $ Field'slot'group'_newtype_ struct
-set_Field'group :: U'.RWCtx m s => Field' (M'.MutMsg s) -> m (Field'group'group' (M'.MutMsg s))
-set_Field'group (Field'_newtype_ struct) = do
- H'.setWordField struct (1 :: Word16) 1 0 0
- pure $ Field'group'group'_newtype_ struct
-set_Field''unknown' :: U'.RWCtx m s => Field' (M'.MutMsg s) -> Word16 -> m ()
-set_Field''unknown'(Field'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
-newtype Field'slot'group' msg = Field'slot'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Field'slot'group' msg) where
- fromStruct = pure . Field'slot'group'_newtype_
-instance C'.ToStruct msg (Field'slot'group' msg) where
- toStruct (Field'slot'group'_newtype_ struct) = struct
-instance U'.HasMessage (Field'slot'group' msg) where
- type InMessage (Field'slot'group' msg) = msg
- message (Field'slot'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Field'slot'group' msg) where
- messageDefault = Field'slot'group'_newtype_ . U'.messageDefault
-get_Field'slot'offset :: U'.ReadCtx m msg => Field'slot'group' msg -> m Word32
-get_Field'slot'offset (Field'slot'group'_newtype_ struct) = H'.getWordField struct 0 32 0
-set_Field'slot'offset :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Word32 -> m ()
-set_Field'slot'offset (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 0 32 0
-get_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Type msg)
-get_Field'slot'type_ (Field'slot'group'_newtype_ struct) =
- U'.getPtr 2 struct
- >>= C'.fromPtr (U'.message struct)
-has_Field'slot'type_ :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
-has_Field'slot'type_(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 2 struct
-set_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
-set_Field'slot'type_ (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 2 struct
-new_Field'slot'type_ :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
-new_Field'slot'type_ struct = do
- result <- C'.new (U'.message struct)
- set_Field'slot'type_ struct result
- pure result
-get_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m (Value msg)
-get_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Field'slot'defaultValue :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
-has_Field'slot'defaultValue(Field'slot'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
-set_Field'slot'defaultValue (Field'slot'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Field'slot'defaultValue :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
-new_Field'slot'defaultValue struct = do
- result <- C'.new (U'.message struct)
- set_Field'slot'defaultValue struct result
- pure result
-get_Field'slot'hadExplicitDefault :: U'.ReadCtx m msg => Field'slot'group' msg -> m Bool
-get_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) = H'.getWordField struct 2 0 0
-set_Field'slot'hadExplicitDefault :: U'.RWCtx m s => Field'slot'group' (M'.MutMsg s) -> Bool -> m ()
-set_Field'slot'hadExplicitDefault (Field'slot'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 2 0 0
-newtype Field'group'group' msg = Field'group'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Field'group'group' msg) where
- fromStruct = pure . Field'group'group'_newtype_
-instance C'.ToStruct msg (Field'group'group' msg) where
- toStruct (Field'group'group'_newtype_ struct) = struct
-instance U'.HasMessage (Field'group'group' msg) where
- type InMessage (Field'group'group' msg) = msg
- message (Field'group'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Field'group'group' msg) where
- messageDefault = Field'group'group'_newtype_ . U'.messageDefault
-get_Field'group'typeId :: U'.ReadCtx m msg => Field'group'group' msg -> m Word64
-get_Field'group'typeId (Field'group'group'_newtype_ struct) = H'.getWordField struct 2 0 0
-set_Field'group'typeId :: U'.RWCtx m s => Field'group'group' (M'.MutMsg s) -> Word64 -> m ()
-set_Field'group'typeId (Field'group'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
-instance C'.FromStruct msg (Field'' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 1 0 0
- case tag of
- 1 -> Field'group <$> C'.fromStruct struct
- 0 -> Field'slot <$> C'.fromStruct struct
- _ -> pure $ Field''unknown' tag
-field'noDiscriminant :: Word16
-field'noDiscriminant = C'.fromWord 65535
-newtype Field'ordinal msg = Field'ordinal_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Field'ordinal msg) where
- fromStruct = pure . Field'ordinal_newtype_
-instance C'.ToStruct msg (Field'ordinal msg) where
- toStruct (Field'ordinal_newtype_ struct) = struct
-instance U'.HasMessage (Field'ordinal msg) where
- type InMessage (Field'ordinal msg) = msg
- message (Field'ordinal_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Field'ordinal msg) where
- messageDefault = Field'ordinal_newtype_ . U'.messageDefault
-data Field'ordinal' msg
- = Field'ordinal'implicit
- | Field'ordinal'explicit Word16
- | Field'ordinal'unknown' Word16
-get_Field'ordinal' :: U'.ReadCtx m msg => Field'ordinal msg -> m (Field'ordinal' msg)
-get_Field'ordinal' (Field'ordinal_newtype_ struct) = C'.fromStruct struct
-set_Field'ordinal'implicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> m ()
-set_Field'ordinal'implicit (Field'ordinal_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0
-set_Field'ordinal'explicit :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m ()
-set_Field'ordinal'explicit (Field'ordinal_newtype_ struct) value = do
- H'.setWordField struct (1 :: Word16) 1 16 0
- H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 32 0
-set_Field'ordinal'unknown' :: U'.RWCtx m s => Field'ordinal (M'.MutMsg s) -> Word16 -> m ()
-set_Field'ordinal'unknown'(Field'ordinal_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 16 0
-instance C'.FromStruct msg (Field'ordinal' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 1 16 0
- case tag of
- 1 -> Field'ordinal'explicit <$> H'.getWordField struct 1 32 0
- 0 -> pure Field'ordinal'implicit
- _ -> pure $ Field'ordinal'unknown' tag
-newtype Node' msg = Node'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node' msg) where
- fromStruct = pure . Node'_newtype_
-instance C'.ToStruct msg (Node' msg) where
- toStruct (Node'_newtype_ struct) = struct
-instance U'.HasMessage (Node' msg) where
- type InMessage (Node' msg) = msg
- message (Node'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node' msg) where
- messageDefault = Node'_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Node' msg) where
- newtype List msg (Node' msg) = List_Node' (U'.ListOf msg (U'.Struct msg))
- length (List_Node' l) = U'.length l
- index i (List_Node' l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node' msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Node' msg) where
- fromPtr msg ptr = Node'_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Node'_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Node' (M'.MutMsg s)) where
- setIndex (Node'_newtype_ elt) i (List_Node' l) = U'.setIndex elt i l
- newList msg len = List_Node' <$> U'.allocCompositeList msg 5 6 len
-instance C'.Allocate s (Node' (M'.MutMsg s)) where
- new msg = Node'_newtype_ <$> U'.allocStruct msg 5 6
-instance C'.IsPtr msg (B'.List msg (Node' msg)) where
- fromPtr msg ptr = List_Node' <$> C'.fromPtr msg ptr
- toPtr (List_Node' l) = C'.toPtr l
-data Node'' msg
- = Node'file
- | Node'struct (Node'struct'group' msg)
- | Node'enum (Node'enum'group' msg)
- | Node'interface (Node'interface'group' msg)
- | Node'const (Node'const'group' msg)
- | Node'annotation (Node'annotation'group' msg)
- | Node''unknown' Word16
-get_Node'' :: U'.ReadCtx m msg => Node' msg -> m (Node'' msg)
-get_Node'' (Node'_newtype_ struct) = C'.fromStruct struct
-set_Node'file :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m ()
-set_Node'file (Node'_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 32 0
-set_Node'struct :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'struct'group' (M'.MutMsg s))
-set_Node'struct (Node'_newtype_ struct) = do
- H'.setWordField struct (1 :: Word16) 1 32 0
- pure $ Node'struct'group'_newtype_ struct
-set_Node'enum :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'enum'group' (M'.MutMsg s))
-set_Node'enum (Node'_newtype_ struct) = do
- H'.setWordField struct (2 :: Word16) 1 32 0
- pure $ Node'enum'group'_newtype_ struct
-set_Node'interface :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'interface'group' (M'.MutMsg s))
-set_Node'interface (Node'_newtype_ struct) = do
- H'.setWordField struct (3 :: Word16) 1 32 0
- pure $ Node'interface'group'_newtype_ struct
-set_Node'const :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'const'group' (M'.MutMsg s))
-set_Node'const (Node'_newtype_ struct) = do
- H'.setWordField struct (4 :: Word16) 1 32 0
- pure $ Node'const'group'_newtype_ struct
-set_Node'annotation :: U'.RWCtx m s => Node' (M'.MutMsg s) -> m (Node'annotation'group' (M'.MutMsg s))
-set_Node'annotation (Node'_newtype_ struct) = do
- H'.setWordField struct (5 :: Word16) 1 32 0
- pure $ Node'annotation'group'_newtype_ struct
-set_Node''unknown' :: U'.RWCtx m s => Node' (M'.MutMsg s) -> Word16 -> m ()
-set_Node''unknown'(Node'_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 32 0
-newtype Node'struct'group' msg = Node'struct'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'struct'group' msg) where
- fromStruct = pure . Node'struct'group'_newtype_
-instance C'.ToStruct msg (Node'struct'group' msg) where
- toStruct (Node'struct'group'_newtype_ struct) = struct
-instance U'.HasMessage (Node'struct'group' msg) where
- type InMessage (Node'struct'group' msg) = msg
- message (Node'struct'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'struct'group' msg) where
- messageDefault = Node'struct'group'_newtype_ . U'.messageDefault
-get_Node'struct'dataWordCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
-get_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 1 48 0
-set_Node'struct'dataWordCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
-set_Node'struct'dataWordCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 48 0
-get_Node'struct'pointerCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
-get_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 0 0
-set_Node'struct'pointerCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
-set_Node'struct'pointerCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 0 0
-get_Node'struct'preferredListEncoding :: U'.ReadCtx m msg => Node'struct'group' msg -> m ElementSize
-get_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 16 0
-set_Node'struct'preferredListEncoding :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> ElementSize -> m ()
-set_Node'struct'preferredListEncoding (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 16 0
-get_Node'struct'isGroup :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
-get_Node'struct'isGroup (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 32 0
-set_Node'struct'isGroup :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'struct'isGroup (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 3 32 0
-get_Node'struct'discriminantCount :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word16
-get_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) = H'.getWordField struct 3 48 0
-set_Node'struct'discriminantCount :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word16 -> m ()
-set_Node'struct'discriminantCount (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 3 48 0
-get_Node'struct'discriminantOffset :: U'.ReadCtx m msg => Node'struct'group' msg -> m Word32
-get_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) = H'.getWordField struct 4 0 0
-set_Node'struct'discriminantOffset :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> Word32 -> m ()
-set_Node'struct'discriminantOffset (Node'struct'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word32) 4 0 0
-get_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m (B'.List msg (Field msg))
-get_Node'struct'fields (Node'struct'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'struct'fields :: U'.ReadCtx m msg => Node'struct'group' msg -> m Bool
-has_Node'struct'fields(Node'struct'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Node'struct'fields :: U'.RWCtx m s => Node'struct'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Field (M'.MutMsg s))) -> m ()
-set_Node'struct'fields (Node'struct'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Node'struct'fields :: U'.RWCtx m s => Int -> Node'struct'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Field (M'.MutMsg s))))
-new_Node'struct'fields len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'struct'fields struct result
- pure result
-newtype Node'enum'group' msg = Node'enum'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'enum'group' msg) where
- fromStruct = pure . Node'enum'group'_newtype_
-instance C'.ToStruct msg (Node'enum'group' msg) where
- toStruct (Node'enum'group'_newtype_ struct) = struct
-instance U'.HasMessage (Node'enum'group' msg) where
- type InMessage (Node'enum'group' msg) = msg
- message (Node'enum'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'enum'group' msg) where
- messageDefault = Node'enum'group'_newtype_ . U'.messageDefault
-get_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m (B'.List msg (Enumerant msg))
-get_Node'enum'enumerants (Node'enum'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'enum'enumerants :: U'.ReadCtx m msg => Node'enum'group' msg -> m Bool
-has_Node'enum'enumerants(Node'enum'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Node'enum'enumerants :: U'.RWCtx m s => Node'enum'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))) -> m ()
-set_Node'enum'enumerants (Node'enum'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Node'enum'enumerants :: U'.RWCtx m s => Int -> Node'enum'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Enumerant (M'.MutMsg s))))
-new_Node'enum'enumerants len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'enum'enumerants struct result
- pure result
-newtype Node'interface'group' msg = Node'interface'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'interface'group' msg) where
- fromStruct = pure . Node'interface'group'_newtype_
-instance C'.ToStruct msg (Node'interface'group' msg) where
- toStruct (Node'interface'group'_newtype_ struct) = struct
-instance U'.HasMessage (Node'interface'group' msg) where
- type InMessage (Node'interface'group' msg) = msg
- message (Node'interface'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'interface'group' msg) where
- messageDefault = Node'interface'group'_newtype_ . U'.messageDefault
-get_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Method msg))
-get_Node'interface'methods (Node'interface'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'interface'methods :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool
-has_Node'interface'methods(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Node'interface'methods :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Method (M'.MutMsg s))) -> m ()
-set_Node'interface'methods (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Node'interface'methods :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Method (M'.MutMsg s))))
-new_Node'interface'methods len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'interface'methods struct result
- pure result
-get_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m (B'.List msg (Superclass msg))
-get_Node'interface'superclasses (Node'interface'group'_newtype_ struct) =
- U'.getPtr 4 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'interface'superclasses :: U'.ReadCtx m msg => Node'interface'group' msg -> m Bool
-has_Node'interface'superclasses(Node'interface'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
-set_Node'interface'superclasses :: U'.RWCtx m s => Node'interface'group' (M'.MutMsg s) -> (B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))) -> m ()
-set_Node'interface'superclasses (Node'interface'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
-new_Node'interface'superclasses :: U'.RWCtx m s => Int -> Node'interface'group' (M'.MutMsg s) -> m ((B'.List (M'.MutMsg s) (Superclass (M'.MutMsg s))))
-new_Node'interface'superclasses len struct = do
- result <- C'.newList (U'.message struct) len
- set_Node'interface'superclasses struct result
- pure result
-newtype Node'const'group' msg = Node'const'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'const'group' msg) where
- fromStruct = pure . Node'const'group'_newtype_
-instance C'.ToStruct msg (Node'const'group' msg) where
- toStruct (Node'const'group'_newtype_ struct) = struct
-instance U'.HasMessage (Node'const'group' msg) where
- type InMessage (Node'const'group' msg) = msg
- message (Node'const'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'const'group' msg) where
- messageDefault = Node'const'group'_newtype_ . U'.messageDefault
-get_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m (Type msg)
-get_Node'const'type_ (Node'const'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'const'type_ :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool
-has_Node'const'type_(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
-set_Node'const'type_ (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Node'const'type_ :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
-new_Node'const'type_ struct = do
- result <- C'.new (U'.message struct)
- set_Node'const'type_ struct result
- pure result
-get_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m (Value msg)
-get_Node'const'value (Node'const'group'_newtype_ struct) =
- U'.getPtr 4 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'const'value :: U'.ReadCtx m msg => Node'const'group' msg -> m Bool
-has_Node'const'value(Node'const'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 4 struct
-set_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> (Value (M'.MutMsg s)) -> m ()
-set_Node'const'value (Node'const'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 4 struct
-new_Node'const'value :: U'.RWCtx m s => Node'const'group' (M'.MutMsg s) -> m ((Value (M'.MutMsg s)))
-new_Node'const'value struct = do
- result <- C'.new (U'.message struct)
- set_Node'const'value struct result
- pure result
-newtype Node'annotation'group' msg = Node'annotation'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'annotation'group' msg) where
- fromStruct = pure . Node'annotation'group'_newtype_
-instance C'.ToStruct msg (Node'annotation'group' msg) where
- toStruct (Node'annotation'group'_newtype_ struct) = struct
-instance U'.HasMessage (Node'annotation'group' msg) where
- type InMessage (Node'annotation'group' msg) = msg
- message (Node'annotation'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'annotation'group' msg) where
- messageDefault = Node'annotation'group'_newtype_ . U'.messageDefault
-get_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m (Type msg)
-get_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) =
- U'.getPtr 3 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'annotation'type_ :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-has_Node'annotation'type_(Node'annotation'group'_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 3 struct
-set_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> (Type (M'.MutMsg s)) -> m ()
-set_Node'annotation'type_ (Node'annotation'group'_newtype_ struct) value = U'.setPtr (C'.toPtr value) 3 struct
-new_Node'annotation'type_ :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> m ((Type (M'.MutMsg s)))
-new_Node'annotation'type_ struct = do
- result <- C'.new (U'.message struct)
- set_Node'annotation'type_ struct result
- pure result
-get_Node'annotation'targetsFile :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 48 0
-set_Node'annotation'targetsFile :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsFile (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 48 0
-get_Node'annotation'targetsConst :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 49 0
-set_Node'annotation'targetsConst :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsConst (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 49 0
-get_Node'annotation'targetsEnum :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 50 0
-set_Node'annotation'targetsEnum :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsEnum (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 50 0
-get_Node'annotation'targetsEnumerant :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 51 0
-set_Node'annotation'targetsEnumerant :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsEnumerant (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 51 0
-get_Node'annotation'targetsStruct :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 52 0
-set_Node'annotation'targetsStruct :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsStruct (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 52 0
-get_Node'annotation'targetsField :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 53 0
-set_Node'annotation'targetsField :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsField (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 53 0
-get_Node'annotation'targetsUnion :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 54 0
-set_Node'annotation'targetsUnion :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsUnion (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 54 0
-get_Node'annotation'targetsGroup :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 55 0
-set_Node'annotation'targetsGroup :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsGroup (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 55 0
-get_Node'annotation'targetsInterface :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 56 0
-set_Node'annotation'targetsInterface :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsInterface (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 56 0
-get_Node'annotation'targetsMethod :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 57 0
-set_Node'annotation'targetsMethod :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsMethod (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 57 0
-get_Node'annotation'targetsParam :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 58 0
-set_Node'annotation'targetsParam :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsParam (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 58 0
-get_Node'annotation'targetsAnnotation :: U'.ReadCtx m msg => Node'annotation'group' msg -> m Bool
-get_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) = H'.getWordField struct 1 59 0
-set_Node'annotation'targetsAnnotation :: U'.RWCtx m s => Node'annotation'group' (M'.MutMsg s) -> Bool -> m ()
-set_Node'annotation'targetsAnnotation (Node'annotation'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word1) 1 59 0
-instance C'.FromStruct msg (Node'' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 1 32 0
- case tag of
- 5 -> Node'annotation <$> C'.fromStruct struct
- 4 -> Node'const <$> C'.fromStruct struct
- 3 -> Node'interface <$> C'.fromStruct struct
- 2 -> Node'enum <$> C'.fromStruct struct
- 1 -> Node'struct <$> C'.fromStruct struct
- 0 -> pure Node'file
- _ -> pure $ Node''unknown' tag
-newtype Node'NestedNode msg = Node'NestedNode_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'NestedNode msg) where
- fromStruct = pure . Node'NestedNode_newtype_
-instance C'.ToStruct msg (Node'NestedNode msg) where
- toStruct (Node'NestedNode_newtype_ struct) = struct
-instance U'.HasMessage (Node'NestedNode msg) where
- type InMessage (Node'NestedNode msg) = msg
- message (Node'NestedNode_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'NestedNode msg) where
- messageDefault = Node'NestedNode_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Node'NestedNode msg) where
- newtype List msg (Node'NestedNode msg) = List_Node'NestedNode (U'.ListOf msg (U'.Struct msg))
- length (List_Node'NestedNode l) = U'.length l
- index i (List_Node'NestedNode l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'NestedNode msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Node'NestedNode msg) where
- fromPtr msg ptr = Node'NestedNode_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Node'NestedNode_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Node'NestedNode (M'.MutMsg s)) where
- setIndex (Node'NestedNode_newtype_ elt) i (List_Node'NestedNode l) = U'.setIndex elt i l
- newList msg len = List_Node'NestedNode <$> U'.allocCompositeList msg 1 1 len
-instance C'.Allocate s (Node'NestedNode (M'.MutMsg s)) where
- new msg = Node'NestedNode_newtype_ <$> U'.allocStruct msg 1 1
-instance C'.IsPtr msg (B'.List msg (Node'NestedNode msg)) where
- fromPtr msg ptr = List_Node'NestedNode <$> C'.fromPtr msg ptr
- toPtr (List_Node'NestedNode l) = C'.toPtr l
-get_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m (B'.Text msg)
-get_Node'NestedNode'name (Node'NestedNode_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'NestedNode'name :: U'.ReadCtx m msg => Node'NestedNode msg -> m Bool
-has_Node'NestedNode'name(Node'NestedNode_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Node'NestedNode'name :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Node'NestedNode'name (Node'NestedNode_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Node'NestedNode'name :: U'.RWCtx m s => Int -> Node'NestedNode (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Node'NestedNode'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_Node'NestedNode'name struct result
- pure result
-get_Node'NestedNode'id :: U'.ReadCtx m msg => Node'NestedNode msg -> m Word64
-get_Node'NestedNode'id (Node'NestedNode_newtype_ struct) = H'.getWordField struct 0 0 0
-set_Node'NestedNode'id :: U'.RWCtx m s => Node'NestedNode (M'.MutMsg s) -> Word64 -> m ()
-set_Node'NestedNode'id (Node'NestedNode_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 0 0 0
-newtype Node'Parameter msg = Node'Parameter_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Node'Parameter msg) where
- fromStruct = pure . Node'Parameter_newtype_
-instance C'.ToStruct msg (Node'Parameter msg) where
- toStruct (Node'Parameter_newtype_ struct) = struct
-instance U'.HasMessage (Node'Parameter msg) where
- type InMessage (Node'Parameter msg) = msg
- message (Node'Parameter_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Node'Parameter msg) where
- messageDefault = Node'Parameter_newtype_ . U'.messageDefault
-instance B'.ListElem msg (Node'Parameter msg) where
- newtype List msg (Node'Parameter msg) = List_Node'Parameter (U'.ListOf msg (U'.Struct msg))
- length (List_Node'Parameter l) = U'.length l
- index i (List_Node'Parameter l) = U'.index i l >>= (let {go :: U'.ReadCtx m msg => U'.Struct msg -> m (Node'Parameter msg); go = C'.fromStruct} in go)
-instance C'.IsPtr msg (Node'Parameter msg) where
- fromPtr msg ptr = Node'Parameter_newtype_ <$> C'.fromPtr msg ptr
- toPtr (Node'Parameter_newtype_ struct) = C'.toPtr struct
-instance B'.MutListElem s (Node'Parameter (M'.MutMsg s)) where
- setIndex (Node'Parameter_newtype_ elt) i (List_Node'Parameter l) = U'.setIndex elt i l
- newList msg len = List_Node'Parameter <$> U'.allocCompositeList msg 0 1 len
-instance C'.Allocate s (Node'Parameter (M'.MutMsg s)) where
- new msg = Node'Parameter_newtype_ <$> U'.allocStruct msg 0 1
-instance C'.IsPtr msg (B'.List msg (Node'Parameter msg)) where
- fromPtr msg ptr = List_Node'Parameter <$> C'.fromPtr msg ptr
- toPtr (List_Node'Parameter l) = C'.toPtr l
-get_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m (B'.Text msg)
-get_Node'Parameter'name (Node'Parameter_newtype_ struct) =
- U'.getPtr 0 struct
- >>= C'.fromPtr (U'.message struct)
-has_Node'Parameter'name :: U'.ReadCtx m msg => Node'Parameter msg -> m Bool
-has_Node'Parameter'name(Node'Parameter_newtype_ struct) = Data.Maybe.isJust <$> U'.getPtr 0 struct
-set_Node'Parameter'name :: U'.RWCtx m s => Node'Parameter (M'.MutMsg s) -> (B'.Text (M'.MutMsg s)) -> m ()
-set_Node'Parameter'name (Node'Parameter_newtype_ struct) value = U'.setPtr (C'.toPtr value) 0 struct
-new_Node'Parameter'name :: U'.RWCtx m s => Int -> Node'Parameter (M'.MutMsg s) -> m ((B'.Text (M'.MutMsg s)))
-new_Node'Parameter'name len struct = do
- result <- B'.newText (U'.message struct) len
- set_Node'Parameter'name struct result
- pure result
-newtype Type'anyPointer msg = Type'anyPointer_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer msg) where
- fromStruct = pure . Type'anyPointer_newtype_
-instance C'.ToStruct msg (Type'anyPointer msg) where
- toStruct (Type'anyPointer_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer msg) where
- type InMessage (Type'anyPointer msg) = msg
- message (Type'anyPointer_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer msg) where
- messageDefault = Type'anyPointer_newtype_ . U'.messageDefault
-data Type'anyPointer' msg
- = Type'anyPointer'unconstrained (Type'anyPointer'unconstrained'group' msg)
- | Type'anyPointer'parameter (Type'anyPointer'parameter'group' msg)
- | Type'anyPointer'implicitMethodParameter (Type'anyPointer'implicitMethodParameter'group' msg)
- | Type'anyPointer'unknown' Word16
-get_Type'anyPointer' :: U'.ReadCtx m msg => Type'anyPointer msg -> m (Type'anyPointer' msg)
-get_Type'anyPointer' (Type'anyPointer_newtype_ struct) = C'.fromStruct struct
-set_Type'anyPointer'unconstrained :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'unconstrained'group' (M'.MutMsg s))
-set_Type'anyPointer'unconstrained (Type'anyPointer_newtype_ struct) = do
- H'.setWordField struct (0 :: Word16) 1 0 0
- pure $ Type'anyPointer'unconstrained'group'_newtype_ struct
-set_Type'anyPointer'parameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'parameter'group' (M'.MutMsg s))
-set_Type'anyPointer'parameter (Type'anyPointer_newtype_ struct) = do
- H'.setWordField struct (1 :: Word16) 1 0 0
- pure $ Type'anyPointer'parameter'group'_newtype_ struct
-set_Type'anyPointer'implicitMethodParameter :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> m (Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s))
-set_Type'anyPointer'implicitMethodParameter (Type'anyPointer_newtype_ struct) = do
- H'.setWordField struct (2 :: Word16) 1 0 0
- pure $ Type'anyPointer'implicitMethodParameter'group'_newtype_ struct
-set_Type'anyPointer'unknown' :: U'.RWCtx m s => Type'anyPointer (M'.MutMsg s) -> Word16 -> m ()
-set_Type'anyPointer'unknown'(Type'anyPointer_newtype_ struct) tagValue = H'.setWordField struct (tagValue :: Word16) 1 0 0
-newtype Type'anyPointer'unconstrained'group' msg = Type'anyPointer'unconstrained'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer'unconstrained'group' msg) where
- fromStruct = pure . Type'anyPointer'unconstrained'group'_newtype_
-instance C'.ToStruct msg (Type'anyPointer'unconstrained'group' msg) where
- toStruct (Type'anyPointer'unconstrained'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer'unconstrained'group' msg) where
- type InMessage (Type'anyPointer'unconstrained'group' msg) = msg
- message (Type'anyPointer'unconstrained'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer'unconstrained'group' msg) where
- messageDefault = Type'anyPointer'unconstrained'group'_newtype_ . U'.messageDefault
-get_Type'anyPointer'unconstrained'union' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained'group' msg -> m (Type'anyPointer'unconstrained msg)
-get_Type'anyPointer'unconstrained'union' (Type'anyPointer'unconstrained'group'_newtype_ struct) = C'.fromStruct struct
-newtype Type'anyPointer'parameter'group' msg = Type'anyPointer'parameter'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer'parameter'group' msg) where
- fromStruct = pure . Type'anyPointer'parameter'group'_newtype_
-instance C'.ToStruct msg (Type'anyPointer'parameter'group' msg) where
- toStruct (Type'anyPointer'parameter'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer'parameter'group' msg) where
- type InMessage (Type'anyPointer'parameter'group' msg) = msg
- message (Type'anyPointer'parameter'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer'parameter'group' msg) where
- messageDefault = Type'anyPointer'parameter'group'_newtype_ . U'.messageDefault
-get_Type'anyPointer'parameter'scopeId :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word64
-get_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 2 0 0
-set_Type'anyPointer'parameter'scopeId :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word64 -> m ()
-set_Type'anyPointer'parameter'scopeId (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word64) 2 0 0
-get_Type'anyPointer'parameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'parameter'group' msg -> m Word16
-get_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0
-set_Type'anyPointer'parameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'parameter'group' (M'.MutMsg s) -> Word16 -> m ()
-set_Type'anyPointer'parameter'parameterIndex (Type'anyPointer'parameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0
-newtype Type'anyPointer'implicitMethodParameter'group' msg = Type'anyPointer'implicitMethodParameter'group'_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where
- fromStruct = pure . Type'anyPointer'implicitMethodParameter'group'_newtype_
-instance C'.ToStruct msg (Type'anyPointer'implicitMethodParameter'group' msg) where
- toStruct (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer'implicitMethodParameter'group' msg) where
- type InMessage (Type'anyPointer'implicitMethodParameter'group' msg) = msg
- message (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer'implicitMethodParameter'group' msg) where
- messageDefault = Type'anyPointer'implicitMethodParameter'group'_newtype_ . U'.messageDefault
-get_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.ReadCtx m msg => Type'anyPointer'implicitMethodParameter'group' msg -> m Word16
-get_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) = H'.getWordField struct 1 16 0
-set_Type'anyPointer'implicitMethodParameter'parameterIndex :: U'.RWCtx m s => Type'anyPointer'implicitMethodParameter'group' (M'.MutMsg s) -> Word16 -> m ()
-set_Type'anyPointer'implicitMethodParameter'parameterIndex (Type'anyPointer'implicitMethodParameter'group'_newtype_ struct) value = H'.setWordField struct (fromIntegral (C'.toWord value) :: Word16) 1 16 0
-instance C'.FromStruct msg (Type'anyPointer' msg) where
- fromStruct struct = do
- tag <- H'.getWordField struct 1 0 0
- case tag of
- 2 -> Type'anyPointer'implicitMethodParameter <$> C'.fromStruct struct
- 1 -> Type'anyPointer'parameter <$> C'.fromStruct struct
- 0 -> Type'anyPointer'unconstrained <$> C'.fromStruct struct
- _ -> pure $ Type'anyPointer'unknown' tag
-newtype Type'anyPointer'unconstrained msg = Type'anyPointer'unconstrained_newtype_ (U'.Struct msg)
-instance C'.FromStruct msg (Type'anyPointer'unconstrained msg) where
- fromStruct = pure . Type'anyPointer'unconstrained_newtype_
-instance C'.ToStruct msg (Type'anyPointer'unconstrained msg) where
- toStruct (Type'anyPointer'unconstrained_newtype_ struct) = struct
-instance U'.HasMessage (Type'anyPointer'unconstrained msg) where
- type InMessage (Type'anyPointer'unconstrained msg) = msg
- message (Type'anyPointer'unconstrained_newtype_ struct) = U'.message struct
-instance U'.MessageDefault (Type'anyPointer'unconstrained msg) where
- messageDefault = Type'anyPointer'unconstrained_newtype_ . U'.messageDefault
-data Type'anyPointer'unconstrained' msg
- = Type'anyPointer'unconstrained'anyKind
- | Type'anyPointer'unconstrained'struct
- | Type'anyPointer'unconstrained'list
- | Type'anyPointer'unconstrained'capability
- | Type'anyPointer'unconstrained'unknown' Word16
-get_Type'anyPointer'unconstrained' :: U'.ReadCtx m msg => Type'anyPointer'unconstrained msg -> m (Type'anyPointer'unconstrained' msg)
-get_Type'anyPointer'unconstrained' (Type'anyPointer'unconstrained_newtype_ struct) = C'.fromStruct struct
-set_Type'anyPointer'unconstrained'anyKind :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
-set_Type'anyPointer'unconstrained'anyKind (Type'anyPointer'unconstrained_newtype_ struct) = H'.setWordField struct (0 :: Word16) 1 16 0
-set_Type'anyPointer'unconstrained'struct :: U'.RWCtx m s => Type'anyPointer'unconstrained (M'.MutMsg s) -> m ()
-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
deleted file mode 100644
--- a/lib/Capnp/Capnp/Schema/Pure.hs
+++ /dev/null
@@ -1,1034 +0,0 @@
-{-# 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'(..), Capnp.ById.Xa93fc509624c72d9.field'noDiscriminant, Field'ordinal(..), Node'(..), Node'NestedNode(..), Node'Parameter(..), Type'anyPointer(..), Type'anyPointer'unconstrained(..)
-) where
--- Code generated by capnpc-haskell. DO NOT EDIT.
--- Generated from schema file: capnp/schema.capnp
-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'.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 C'.FromStruct M'.ConstMsg Annotation where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Annotation M'.ConstMsg)
-instance Default Annotation where
- def = PH'.defaultStruct
-data Brand
- = Brand
- {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'.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 C'.FromStruct M'.ConstMsg Brand where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand M'.ConstMsg)
-instance Default Brand where
- def = PH'.defaultStruct
-data CapnpVersion
- = CapnpVersion
- {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'.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 C'.FromStruct M'.ConstMsg CapnpVersion where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CapnpVersion M'.ConstMsg)
-instance Default CapnpVersion where
- def = PH'.defaultStruct
-data CodeGeneratorRequest
- = CodeGeneratorRequest
- {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'.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 C'.FromStruct M'.ConstMsg CodeGeneratorRequest where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest M'.ConstMsg)
-instance Default CodeGeneratorRequest where
- def = PH'.defaultStruct
-data Enumerant
- = Enumerant
- {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'.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 C'.FromStruct M'.ConstMsg Enumerant where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Enumerant M'.ConstMsg)
-instance Default Enumerant where
- def = PH'.defaultStruct
-data Field
- = Field
- {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'.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 C'.FromStruct M'.ConstMsg Field where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field M'.ConstMsg)
-instance Default Field where
- def = PH'.defaultStruct
-data Method
- = Method
- {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'.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 C'.FromStruct M'.ConstMsg Method where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Method M'.ConstMsg)
-instance Default Method where
- def = PH'.defaultStruct
-data Node
- = Node
- {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'.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 C'.FromStruct M'.ConstMsg Node where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node M'.ConstMsg)
-instance Default Node where
- def = PH'.defaultStruct
-data Superclass
- = Superclass
- {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'.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 C'.FromStruct M'.ConstMsg Superclass where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Superclass M'.ConstMsg)
-instance Default Superclass where
- def = PH'.defaultStruct
-data Type
- = Type'void
- | Type'bool
- | Type'int8
- | Type'int16
- | Type'int32
- | Type'int64
- | Type'uint8
- | Type'uint16
- | Type'uint32
- | Type'uint64
- | Type'float32
- | Type'float64
- | Type'text
- | Type'data_
- | Type'list
- {elementType :: Type}
- | Type'enum
- {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'.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 C'.FromStruct M'.ConstMsg Type where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type M'.ConstMsg)
-instance Default Type where
- def = PH'.defaultStruct
-data Value
- = Value'void
- | Value'bool (Bool)
- | Value'int8 (Int8)
- | Value'int16 (Int16)
- | Value'int32 (Int32)
- | Value'int64 (Int64)
- | Value'uint8 (Word8)
- | Value'uint16 (Word16)
- | Value'uint32 (Word32)
- | Value'uint64 (Word64)
- | Value'float32 (Float)
- | Value'float64 (Double)
- | Value'text (Text)
- | Value'data_ (Data)
- | Value'list (Maybe (PU'.PtrType))
- | Value'enum (Word16)
- | Value'struct (Maybe (PU'.PtrType))
- | Value'interface
- | Value'anyPointer (Maybe (PU'.PtrType))
- | Value'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Value where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Value M'.ConstMsg)
-instance Default Value where
- def = PH'.defaultStruct
-data Brand'Binding
- = Brand'Binding'unbound
- | Brand'Binding'type_ (Type)
- | Brand'Binding'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Brand'Binding where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Binding M'.ConstMsg)
-instance Default Brand'Binding where
- def = PH'.defaultStruct
-data Brand'Scope
- = Brand'Scope
- {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'.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 C'.FromStruct M'.ConstMsg Brand'Scope where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope M'.ConstMsg)
-instance Default Brand'Scope where
- def = PH'.defaultStruct
-data Brand'Scope'
- = Brand'Scope'bind (PU'.ListOf (Brand'Binding))
- | Brand'Scope'inherit
- | Brand'Scope'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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 C'.FromStruct M'.ConstMsg Brand'Scope' where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Brand'Scope' M'.ConstMsg)
-instance Default Brand'Scope' where
- def = PH'.defaultStruct
-data CodeGeneratorRequest'RequestedFile
- = CodeGeneratorRequest'RequestedFile
- {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'.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 C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile M'.ConstMsg)
-instance Default CodeGeneratorRequest'RequestedFile where
- def = PH'.defaultStruct
-data CodeGeneratorRequest'RequestedFile'Import
- = CodeGeneratorRequest'RequestedFile'Import
- {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'.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 C'.FromStruct M'.ConstMsg CodeGeneratorRequest'RequestedFile'Import where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.CodeGeneratorRequest'RequestedFile'Import M'.ConstMsg)
-instance Default CodeGeneratorRequest'RequestedFile'Import where
- def = PH'.defaultStruct
-data Field'
- = Field'slot
- {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'.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 C'.FromStruct M'.ConstMsg Field' where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field' M'.ConstMsg)
-instance Default Field' where
- def = PH'.defaultStruct
-data 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'.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'.FromStruct M'.ConstMsg Field'ordinal where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Field'ordinal M'.ConstMsg)
-instance Default Field'ordinal where
- def = PH'.defaultStruct
-data Node'
- = Node'file
- | Node'struct
- {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'.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 C'.FromStruct M'.ConstMsg Node' where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node' M'.ConstMsg)
-instance Default Node' where
- def = PH'.defaultStruct
-data Node'NestedNode
- = Node'NestedNode
- {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'.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 C'.FromStruct M'.ConstMsg Node'NestedNode where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'NestedNode M'.ConstMsg)
-instance Default Node'NestedNode where
- def = PH'.defaultStruct
-data Node'Parameter
- = Node'Parameter
- {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'.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 C'.FromStruct M'.ConstMsg Node'Parameter where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Node'Parameter M'.ConstMsg)
-instance Default Node'Parameter where
- def = PH'.defaultStruct
-data Type'anyPointer
- = Type'anyPointer'unconstrained
- {union' :: Type'anyPointer'unconstrained}
- | Type'anyPointer'parameter
- {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'.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'.FromStruct M'.ConstMsg Type'anyPointer where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer M'.ConstMsg)
-instance Default Type'anyPointer where
- def = PH'.defaultStruct
-data Type'anyPointer'unconstrained
- = Type'anyPointer'unconstrained'anyKind
- | Type'anyPointer'unconstrained'struct
- | Type'anyPointer'unconstrained'list
- | Type'anyPointer'unconstrained'capability
- | Type'anyPointer'unconstrained'unknown' Word16
- deriving(Show,Read,Eq,Generic)
-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'.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'.FromStruct M'.ConstMsg Type'anyPointer'unconstrained where
- fromStruct struct = do
- raw <- C'.fromStruct struct
- C'.decerialize (raw :: Capnp.ById.Xa93fc509624c72d9.Type'anyPointer'unconstrained M'.ConstMsg)
-instance Default Type'anyPointer'unconstrained where
- def = PH'.defaultStruct
diff --git a/lib/Capnp/Classes.hs b/lib/Capnp/Classes.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Classes.hs
@@ -0,0 +1,371 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{- |
+Module: 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 Capnp.Classes
+ ( IsWord(..)
+ , ListElem(..)
+ , MutListElem(..)
+ , FromPtr(..)
+ , ToPtr(..)
+ , FromStruct(..)
+ , ToStruct(..)
+ , Allocate(..)
+ , Marshal(..)
+ , Cerialize(..)
+ , Decerialize(..)
+ , cerializeBasicVec
+ , cerializeCompositeVec
+ ) where
+
+import Prelude hiding (length)
+
+import Data.Bits
+import Data.Int
+import Data.ReinterpretCast
+import Data.Word
+
+import Control.Monad.Catch (MonadThrow(throwM))
+import Data.Foldable (for_)
+
+import Capnp.Bits (Word1(..))
+import Capnp.Errors (Error(SchemaViolationError))
+import Capnp.Untyped (Cap, ListOf, Ptr(..), ReadCtx, Struct, messageDefault)
+
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
+
+import qualified Data.Vector as V
+
+-- | Types that can be converted to and from a 64-bit word.
+--
+-- Anything that goes in the data section of a struct will have
+-- an instance of this.
+class IsWord a where
+ -- | Convert from a 64-bit words Truncates the word if the
+ -- type has less than 64 bits.
+ fromWord :: Word64 -> a
+
+ -- | Convert to a 64-bit word.
+ 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
+
+ -- | Convert an untyped list to a list of this type. May fail
+ -- with a 'SchemaViolationError' if the list does not have the
+ -- correct representation.
+ --
+ -- TODO: this is basically just fromPtr; refactor so this is less
+ -- redundant.
+ listFromPtr :: U.ReadCtx m msg => msg -> Maybe (U.Ptr msg) -> m (List msg e)
+
+ toUntypedList :: List msg e -> U.List msg
+
+ -- | 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 marshaled 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 be 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 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 from an untyped pointer.
+--
+-- Note that decoding do not have to succeed, if the pointer is
+-- the wrong type.
+class FromPtr msg a where
+ -- | Convert an untyped pointer to an @a@.
+ fromPtr :: ReadCtx m msg => msg -> Maybe (Ptr msg) -> m a
+
+-- | Types that can be converted to an untyped pointer.
+class ToPtr s a where
+ -- | Convert an @a@ to an untyped pointer.
+ toPtr :: M.WriteCtx m s => M.MutMsg s -> a -> m (Maybe (Ptr (M.MutMsg s)))
+
+-- | 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
+
+-- To/FromPtr instance for lists of Void/().
+instance FromPtr msg (ListOf msg ()) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List0 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 0"
+instance ToPtr s (ListOf (M.MutMsg s) ()) where
+ toPtr _ = pure . Just . PtrList . U.List0
+
+-- To/FromPtr instances for lists of unsigned integers.
+instance FromPtr msg (ListOf msg Word8) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List8 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 8"
+instance ToPtr s (ListOf (M.MutMsg s) Word8) where
+ toPtr _ = pure . Just . PtrList . U.List8
+instance FromPtr msg (ListOf msg Word16) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List16 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 16"
+instance ToPtr s (ListOf (M.MutMsg s) Word16) where
+ toPtr _ = pure . Just . PtrList . U.List16
+instance FromPtr msg (ListOf msg Word32) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List32 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 32"
+instance ToPtr s (ListOf (M.MutMsg s) Word32) where
+ toPtr _ = pure . Just . PtrList . U.List32
+instance FromPtr msg (ListOf msg Word64) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List64 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 64"
+instance ToPtr s (ListOf (M.MutMsg s) Word64) where
+ toPtr _ = pure . Just . PtrList . U.List64
+
+instance FromPtr msg (ListOf msg Bool) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.List1 list))) = pure list
+ fromPtr _ _ = expected "pointer to list with element size 1."
+instance ToPtr s (ListOf (M.MutMsg s) Bool) where
+ toPtr _ = pure . Just . PtrList . U.List1
+
+-- To/FromPtr instance for pointers -- this is just the identity.
+instance FromPtr msg (Maybe (Ptr msg)) where
+ fromPtr _ = pure
+instance ToPtr s (Maybe (Ptr (M.MutMsg s))) where
+ toPtr _ = pure
+
+-- To/FromPtr instance for composite lists.
+instance FromPtr msg (ListOf msg (Struct msg)) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.ListStruct list))) = pure list
+ fromPtr _ _ = expected "pointer to list of structs"
+instance ToPtr s (ListOf (M.MutMsg s) (Struct (M.MutMsg s))) where
+ toPtr _ = pure . Just . PtrList . U.ListStruct
+
+-- To/FromPtr instance for lists of pointers.
+instance FromPtr msg (ListOf msg (Maybe (Ptr msg))) where
+ fromPtr msg Nothing = pure $ messageDefault msg
+ fromPtr _ (Just (PtrList (U.ListPtr list))) = pure list
+ fromPtr _ _ = expected "pointer to list of pointers"
+instance ToPtr s (ListOf (M.MutMsg s) (Maybe (Ptr (M.MutMsg s)))) where
+ toPtr _ = pure . Just . PtrList . U.ListPtr
+
+-- To/FromPtr instance for *typed* lists.
+instance ListElem msg e => FromPtr msg (List msg e) where
+ fromPtr = listFromPtr
+instance ListElem (M.MutMsg s) e => ToPtr s (List (M.MutMsg s) e) where
+ toPtr _ = pure . Just . PtrList . toUntypedList
+
+-- ListElem instance for (typed) nested lists.
+instance ListElem msg e => ListElem msg (List msg e) where
+ newtype List msg (List msg e) = NestedList (U.ListOf msg (Maybe (U.Ptr msg)))
+
+ listFromPtr msg ptr = NestedList <$> fromPtr msg ptr
+ toUntypedList (NestedList l) = U.ListPtr l
+
+ length (NestedList l) = U.length l
+ index i (NestedList l) = do
+ ptr <- U.index i l
+ fromPtr (U.message l) ptr
+
+instance MutListElem s e => MutListElem s (List (M.MutMsg s) e) where
+ setIndex e i (NestedList l) = U.setIndex (Just (U.PtrList (toUntypedList e))) i l
+ newList msg len = NestedList <$> U.allocListPtr msg len
+
+-- FromStruct instance for Struct; just the identity.
+instance FromStruct msg (Struct msg) where
+ fromStruct = pure
+
+instance ToStruct msg (Struct msg) where
+ toStruct = id
+
+instance FromPtr 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 _ (Just (PtrStruct s)) = fromStruct s
+ fromPtr _ _ = expected "pointer to struct"
+instance ToPtr s (Struct (M.MutMsg s)) where
+ toPtr _ = pure . Just . PtrStruct
+
+instance FromPtr msg (Maybe (Cap msg)) where
+ fromPtr _ Nothing = pure Nothing
+ fromPtr _ (Just (PtrCap cap)) = pure (Just cap)
+ fromPtr _ _ = expected "pointer to capability"
+instance ToPtr s (Maybe (Cap (M.MutMsg s))) where
+ toPtr _ = pure . fmap PtrCap
+
+-- | A valid implementation of 'cerialize', which just cerializes the
+-- elements of a list individually and puts them in the list.
+--
+-- Note that while this is *correct* for composite lists, it is inefficient,
+-- since it will separately allocate the elements and then copy them into
+-- the list, doing extra work and leaking space. See 'cerializeCompositeVec'.
+cerializeBasicVec ::
+ ( U.RWCtx m s
+ , MutListElem s (Cerial (M.MutMsg s) a)
+ , Cerialize a
+ )
+ => M.MutMsg s
+ -> V.Vector a
+ -> m (List (M.MutMsg s) (Cerial (M.MutMsg s) a))
+cerializeBasicVec msg vec = do
+ list <- newList msg (V.length vec)
+ for_ [0..V.length vec - 1] $ \i -> do
+ e <- cerialize msg (vec V.! i)
+ setIndex e i list
+ pure list
+
+-- | A valid implementation of 'cerialize', which allocates a list of the
+-- correct size and then marshals the elements of a vector into the elements
+-- of the list. This is more efficient for composite types than
+-- 'cerializeBasicVec', hence the name.
+cerializeCompositeVec ::
+ ( U.RWCtx m s
+ , MutListElem s (Cerial (M.MutMsg s) a)
+ , Marshal a
+ )
+ => M.MutMsg s
+ -> V.Vector a
+ -> m (List (M.MutMsg s) (Cerial (M.MutMsg s) a))
+cerializeCompositeVec msg vec = do
+ list <- newList msg (V.length vec)
+ for_ [0..V.length vec - 1] $ \i -> do
+ targ <- index i list
+ marshalInto targ (vec V.! i)
+ pure list
+
+-- Generic decerialize instances for lists, given that the element type has an instance.
+instance
+ ( ListElem M.ConstMsg (Cerial M.ConstMsg a)
+ , Decerialize a
+ ) => Decerialize (V.Vector a)
+ where
+ type Cerial msg (V.Vector a) = List msg (Cerial msg a)
+ decerialize raw = V.generateM (length raw) (\i -> index i raw >>= decerialize)
diff --git a/lib/Capnp/Convert.hs b/lib/Capnp/Convert.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Convert.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: Capnp.Convert
+Description: Convert between messages, typed capnproto values, and (lazy)bytestring(builders).
+
+This module provides various helper functions to convert between messages, types defined
+in capnproto schema (called "values" in the rest of this module's documentation),
+bytestrings (both lazy and strict), and bytestring builders.
+
+Note that most of the functions which decode messages or raw bytes do *not* need to be
+run inside of an instance of 'MonadLimit'; they choose an appropriate limit based on the
+size of the input.
+
+Note that not all conversions exist or necessarily make sense.
+-}
+module Capnp.Convert
+ ( msgToBuilder
+ , msgToLBS
+ , msgToBS
+ , msgToValue
+ , bsToMsg
+ , bsToValue
+ , lbsToMsg
+ , lbsToValue
+ , valueToBuilder
+ , valueToBS
+ , valueToLBS
+ , valueToMsg
+ ) where
+
+import Control.Monad ((>=>))
+import Control.Monad.Catch (MonadThrow)
+import Data.Foldable (foldlM)
+import Data.Functor.Identity (runIdentity)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BB
+import qualified Data.ByteString.Lazy as LBS
+
+import Capnp.Classes
+
+import Capnp.Bits (WordCount)
+import Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT)
+import Codec.Capnp (getRoot, setRoot)
+import Data.Mutable (freeze)
+
+import qualified Capnp.Message as M
+
+-- | Compute a reasonable limit based on the size of a message. The limit
+-- is the total number of words in all of the message's segments, multiplied
+-- by 10 to provide some slack for decoding default values.
+limitFromMsg :: (MonadThrow m, M.Message m msg) => msg -> m WordCount
+limitFromMsg msg = do
+ messageWords <- countMessageWords
+ pure (messageWords * 10)
+ where
+ countMessageWords = do
+ segCount <- M.numSegs msg
+ foldlM
+ (\total i -> do
+ words <- M.getSegment msg i >>= M.numWords
+ pure (words + total)
+ )
+ 0
+ [0..segCount - 1]
+
+-- | Convert an immutable message to a bytestring 'BB.Builder'.
+-- To convert a mutable message, 'freeze' it first.
+msgToBuilder :: M.ConstMsg -> BB.Builder
+msgToBuilder = runIdentity . M.encode
+
+-- | Convert an immutable message to a lazy 'LBS.ByteString'.
+-- To convert a mutable message, 'freeze' it first.
+msgToLBS :: M.ConstMsg -> LBS.ByteString
+msgToLBS = BB.toLazyByteString . msgToBuilder
+
+-- | Convert an immutable message to a strict 'BS.ByteString'.
+-- To convert a mutable message, 'freeze' it first.
+msgToBS :: M.ConstMsg -> BS.ByteString
+msgToBS = LBS.toStrict . msgToLBS
+
+-- | Convert a message to a value.
+msgToValue :: (MonadThrow m, M.Message (LimitT m) msg, M.Message m msg, FromStruct msg a) => msg -> m a
+msgToValue msg = do
+ limit <- limitFromMsg msg
+ evalLimitT limit (getRoot msg)
+
+-- | Convert a strict 'BS.ByteString' to a message.
+bsToMsg :: MonadThrow m => BS.ByteString -> m M.ConstMsg
+bsToMsg = M.decode
+
+-- | Convert a strict 'BS.ByteString' to a value.
+bsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => BS.ByteString -> m a
+bsToValue = bsToMsg >=> msgToValue
+
+-- | Convert a lazy 'LBS.ByteString' to a message.
+lbsToMsg :: MonadThrow m => LBS.ByteString -> m M.ConstMsg
+lbsToMsg = bsToMsg . LBS.toStrict
+
+-- | Convert a lazy 'LBS.ByteString' to a value.
+lbsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => LBS.ByteString -> m a
+lbsToValue = bsToValue . LBS.toStrict
+
+-- | Convert a value to a 'BS.Builder'.
+valueToBuilder :: (MonadLimit m, M.WriteCtx m s, Cerialize a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BB.Builder
+valueToBuilder val = msgToBuilder <$> (valueToMsg val >>= freeze)
+
+-- | Convert a value to a strict 'BS.ByteString'.
+valueToBS :: (MonadLimit m, M.WriteCtx m s, Cerialize a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BS.ByteString
+valueToBS = fmap LBS.toStrict . valueToLBS
+
+-- | Convert a value to a lazy 'LBS.ByteString'.
+valueToLBS :: (MonadLimit m, M.WriteCtx m s, Cerialize a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m LBS.ByteString
+valueToLBS = fmap BB.toLazyByteString . valueToBuilder
+
+-- | Convert a value to a message.
+valueToMsg :: (MonadLimit m, M.WriteCtx m s, Cerialize a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m (M.MutMsg s)
+valueToMsg val = do
+ msg <- M.newMessage Nothing
+ ret <- cerialize msg val
+ setRoot ret
+ pure msg
diff --git a/lib/Capnp/Errors.hs b/lib/Capnp/Errors.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Errors.hs
@@ -0,0 +1,54 @@
+{-|
+Module: Capnp.Errors
+Description: Error handling utilities
+-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+module 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/Capnp/Gen.hs b/lib/Capnp/Gen.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Gen.hs
@@ -0,0 +1,9 @@
+{- |
+Module: Capnp.Gen
+Description: Code generated by the schema compiler.
+
+The @Capnp.Gen@ module hierarchy contains code generated by the schema compiler.
+See "Capnp.Tutorial" for a description of what code is generated for
+each schema, as well as a general introduction to the library.
+-}
+module Capnp.Gen () where
diff --git a/lib/Capnp/Gen/Capnp.hs b/lib/Capnp/Gen/Capnp.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Gen/Capnp.hs
@@ -0,0 +1,8 @@
+{-|
+Module: Capnp.Gen.Capnp
+Description: Generated modules for the schema that ship with Cap'N Proto
+
+The modules under 'Capnp.Gen.Capnp' are generated code for the schema files that
+ship with the Cap'N Proto reference implementation.
+-}
+module Capnp.Gen.Capnp () where
diff --git a/lib/Capnp/GenHelpers.hs b/lib/Capnp/GenHelpers.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers.hs
@@ -0,0 +1,76 @@
+{- |
+Module: 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. "Capnp.GenHelpers.Pure"
+defines helpers used by high-level api.
+-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+module Capnp.GenHelpers where
+
+import Data.Bits
+import Data.Word
+
+import Data.Maybe (fromJust)
+
+import qualified Data.ByteString as BS
+
+import Capnp.Bits
+
+import Capnp (bsToMsg, evalLimitT)
+
+import qualified Capnp.Classes as C
+import qualified Capnp.Message as M
+import qualified 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 -> Word64 -> m ()
+setWordField struct value idx offset def = do
+ old <- U.getData idx struct
+ let new = replaceBits (value `xor` C.fromWord def) old offset
+ U.setData new idx struct
+
+embedCapPtr :: M.WriteCtx m s => M.MutMsg s -> M.Client -> m (Maybe (U.Ptr (M.MutMsg s)))
+embedCapPtr msg client =
+ Just . U.PtrCap <$> U.appendCap msg client
+
+-- | Get a pointer from a ByteString, where the root object is a struct with
+-- one pointer, which is the pointer we will retrieve. This is only safe for
+-- trusted inputs; it reads the message with a traversal limit of 'maxBound'
+-- (and so is suseptable to denial of service attacks), and it calls 'error'
+-- if decoding is not successful.
+--
+-- The purpose of this is for defining constants of pointer type from a schema.
+getPtrConst :: C.FromPtr M.ConstMsg a => BS.ByteString -> a
+getPtrConst bytes = fromJust $ do
+ msg <- bsToMsg bytes
+ evalLimitT maxBound $ U.rootPtr msg >>= U.getPtr 0 >>= C.fromPtr msg
+
+
+getTag :: U.ReadCtx m msg => U.Struct msg -> Int -> m Word16
+getTag struct offset = do
+ word <- U.getData (offset `div` 4) struct
+ pure $ fromIntegral $ word `shiftR` ((offset `mod` 4) * 16)
diff --git a/lib/Capnp/GenHelpers/Pure.hs b/lib/Capnp/GenHelpers/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/Pure.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{- |
+Module: 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. "Capnp.GenHelpers"
+defines helpers used by the low-level api.
+-}
+module Capnp.GenHelpers.Pure
+ ( defaultStruct
+ , convertValue
+ , getRoot
+ , createPure
+ , toPurePtrConst
+ , cerializeBasicVec
+ , cerializeCompositeVec
+ ) where
+
+import Data.Maybe (fromJust)
+
+import Capnp.Classes (cerializeBasicVec, cerializeCompositeVec)
+import Capnp.TraversalLimit (evalLimitT)
+import Codec.Capnp (getRoot)
+
+import Data.Mutable (freeze)
+import Internal.BuildPure (createPure)
+
+import qualified Capnp.Classes as C
+import qualified Capnp.Convert as Convert
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
+
+-- | A valid implementation for 'Data.Default.Default' for any type that meets
+-- the given constraints.
+defaultStruct :: (C.Decerialize a, C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg a)) => a
+defaultStruct =
+ fromJust $
+ evalLimitT maxBound $
+ U.rootPtr M.empty >>= C.fromStruct >>= C.decerialize
+
+convertValue ::
+ ( U.RWCtx m s
+ , M.Message m M.ConstMsg
+ , C.Cerialize a
+ , C.ToStruct (M.MutMsg s) (C.Cerial (M.MutMsg s) a)
+ , C.Decerialize b
+ , C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg b)
+ ) => a -> m b
+convertValue from = do
+ constMsg :: M.ConstMsg <- Convert.valueToMsg from >>= freeze
+ Convert.msgToValue constMsg >>= C.decerialize
+
+-- | convert a low-level value to a high-level one. This is not safe against
+-- malicious or invalid input; it is used for declaring top-level constants.
+toPurePtrConst :: C.Decerialize a => C.Cerial M.ConstMsg a -> a
+toPurePtrConst = fromJust . evalLimitT maxBound . C.decerialize
diff --git a/lib/Capnp/GenHelpers/ReExports.hs b/lib/Capnp/GenHelpers/ReExports.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports.hs
@@ -0,0 +1,11 @@
+-- |
+-- Module: Capnp.GenHelpers.ReExports
+-- Description: Re-exported modules from common libraries.
+--
+-- This module heirarchy exists so that generated code doesn't have to
+-- import anything outside of base and the capnp package; the generated
+-- code uses modules from several common libraries (bytestring, vector,
+-- text...), but we would prefer not to burden developers packaging schema
+-- with having to list each of these in their build-depends, so instead
+-- we re-export the modules from here.
+module Capnp.GenHelpers.ReExports() where
diff --git a/lib/Capnp/GenHelpers/ReExports/Control/Concurrent/STM.hs b/lib/Capnp/GenHelpers/ReExports/Control/Concurrent/STM.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Control/Concurrent/STM.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Control.Concurrent.STM
+ ( module Control.Concurrent.STM
+ ) where
+
+import Control.Concurrent.STM
diff --git a/lib/Capnp/GenHelpers/ReExports/Data/ByteString.hs b/lib/Capnp/GenHelpers/ReExports/Data/ByteString.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Data/ByteString.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Data.ByteString
+ ( module Data.ByteString
+ ) where
+
+import Data.ByteString
diff --git a/lib/Capnp/GenHelpers/ReExports/Data/Default.hs b/lib/Capnp/GenHelpers/ReExports/Data/Default.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Data/Default.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Data.Default
+ ( module Data.Default
+ ) where
+
+import Data.Default
diff --git a/lib/Capnp/GenHelpers/ReExports/Data/Text.hs b/lib/Capnp/GenHelpers/ReExports/Data/Text.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Data/Text.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Data.Text
+ ( module Data.Text
+ ) where
+
+import Data.Text
diff --git a/lib/Capnp/GenHelpers/ReExports/Data/Vector.hs b/lib/Capnp/GenHelpers/ReExports/Data/Vector.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Data/Vector.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Data.Vector
+ ( module Data.Vector
+ ) where
+
+import Data.Vector
diff --git a/lib/Capnp/GenHelpers/ReExports/Supervisors.hs b/lib/Capnp/GenHelpers/ReExports/Supervisors.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/ReExports/Supervisors.hs
@@ -0,0 +1,5 @@
+module Capnp.GenHelpers.ReExports.Supervisors
+ ( module Supervisors
+ ) where
+
+import Supervisors
diff --git a/lib/Capnp/GenHelpers/Rpc.hs b/lib/Capnp/GenHelpers/Rpc.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/GenHelpers/Rpc.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |
+-- Module: Capnp.GenHelpers.Rpc
+-- Description: Rpc-system helpers for genrated code.
+--
+-- This module defines various helpers used by generated code. Users
+-- of the library are not expected to use this module directly.
+module Capnp.GenHelpers.Rpc where
+
+import Control.Exception.Safe (fromException, tryAny)
+import Control.Monad.Catch (MonadThrow(..))
+import Data.Default (def)
+
+import Capnp.Classes (Decerialize(..), FromPtr(..))
+import Capnp.TraversalLimit (evalLimitT)
+
+import qualified Capnp.Errors as E
+import qualified Capnp.GenHelpers.Pure as PH
+import qualified Capnp.Message as M
+import qualified Capnp.Rpc.Promise as Promise
+import qualified Capnp.Rpc.Untyped as Rpc
+import qualified Capnp.Untyped as U
+
+handleMethod server method paramContent fulfiller = do
+ ret <- tryAny $ do
+ content <- evalLimitT maxBound $
+ fromPtr M.empty paramContent >>= decerialize
+ results <- method content server
+ evalLimitT maxBound $ PH.convertValue results
+ case ret of
+ Right resultStruct ->
+ Promise.fulfill fulfiller resultStruct
+ Left e ->
+ case fromException e of
+ Just exn ->
+ Promise.breakPromise fulfiller exn
+ Nothing ->
+ Promise.breakPromise fulfiller def
+ { Rpc.type_ = Rpc.Exception'Type'failed
+ , Rpc.reason = "Method threw an unhandled exception."
+ }
+
+-- | A valid implementation of 'fromPtr' for any type that implements 'IsClient'.
+--
+-- GHC gets very confused if we try to just define a single instance
+-- @IsClient a => FromPtr msg a@, so instead we define this helper function and
+-- emit a trivial instance for each type from the code generator.
+isClientFromPtr :: (Rpc.IsClient a, U.ReadCtx m msg) => msg -> Maybe (U.Ptr msg) -> m a
+isClientFromPtr _ Nothing = pure $ Rpc.fromClient Rpc.nullClient
+isClientFromPtr _ (Just (U.PtrCap cap)) = Rpc.fromClient <$> U.getClient cap
+isClientFromPtr _ (Just _) = throwM $ E.SchemaViolationError "Expected capability pointer"
+
+-- | A valid implementation of 'toPtr' for any type that implements 'IsClient'.
+--
+-- See the notes for 'isClientFromPtr'.
+isClientToPtr :: (Rpc.IsClient a, M.WriteCtx m s) => M.MutMsg s -> a -> m (Maybe (U.Ptr (M.MutMsg s)))
+isClientToPtr msg client = do
+ cap <- U.appendCap msg (Rpc.toClient client)
+ pure $ Just $ U.PtrCap cap
diff --git a/lib/Capnp/IO.hs b/lib/Capnp/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/IO.hs
@@ -0,0 +1,124 @@
+{- |
+Module: Capnp.IO
+Description: Utilities for reading and writing values to handles.
+
+This module provides utilities for reading and writing values to and
+from file 'Handle's.
+-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Capnp.IO
+ ( hGetValue
+ , getValue
+ , sGetMsg
+ , sGetValue
+ , hPutValue
+ , putValue
+ , sPutValue
+ , sPutMsg
+ , M.hGetMsg
+ , M.getMsg
+ , M.hPutMsg
+ , M.putMsg
+ ) where
+
+import Data.Bits
+
+import Control.Exception (throwIO)
+import Control.Monad.Primitive (RealWorld)
+import Control.Monad.Trans.Class (lift)
+import Network.Simple.TCP (Socket, recv, sendLazy)
+import System.IO (Handle, stdin, stdout)
+import System.IO.Error (eofErrorType, mkIOError)
+
+import qualified Data.ByteString as BS
+
+import Capnp.Bits (WordCount, wordsToBytes)
+import Capnp.Classes
+ (Cerialize(..), Decerialize(..), FromStruct(..), ToStruct(..))
+import Capnp.Convert (msgToLBS, valueToLBS)
+import Capnp.TraversalLimit (evalLimitT)
+import Codec.Capnp (getRoot, setRoot)
+import Data.Mutable (Thaw(..))
+
+import qualified 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.
+--
+-- It may throw a 'Capnp.Errors.Error' if there is a problem decoding the message,
+-- or an 'IOError' raised by the underlying IO libraries.
+hGetValue :: FromStruct M.ConstMsg a => Handle -> WordCount -> 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 => WordCount -> IO a
+getValue = hGetValue stdin
+
+-- | Like 'hGetValue', except that it takes a socket instead of a 'Handle'.
+sGetValue :: FromStruct M.ConstMsg a => Socket -> WordCount -> IO a
+sGetValue socket limit = do
+ msg <- sGetMsg socket limit
+ evalLimitT limit (getRoot msg)
+
+-- | Like 'hGetMsg', except that it takes a socket instead of a 'Handle'.
+sGetMsg :: Socket -> WordCount -> IO M.ConstMsg
+sGetMsg socket limit =
+ evalLimitT limit $ M.readMessage (lift read32) (lift . readSegment)
+ where
+ read32 = do
+ bytes <- recvFull 4
+ pure $
+ (fromIntegral (bytes `BS.index` 0) `shiftL` 0) .|.
+ (fromIntegral (bytes `BS.index` 1) `shiftL` 8) .|.
+ (fromIntegral (bytes `BS.index` 2) `shiftL` 16) .|.
+ (fromIntegral (bytes `BS.index` 3) `shiftL` 24)
+ readSegment !words = do
+ bytes <- recvFull (fromIntegral $ wordsToBytes words)
+ M.fromByteString bytes
+
+ -- | Like recv, but (1) never returns less than `count` bytes, (2)
+ -- uses `socket`, rather than taking the socket as an argument, and (3)
+ -- throws an EOF exception when the connection is closed.
+ recvFull :: Int -> IO BS.ByteString
+ recvFull !count = do
+ maybeBytes <- recv socket count
+ case maybeBytes of
+ Nothing ->
+ throwIO $ mkIOError eofErrorType "Remote socket closed" Nothing Nothing
+ Just bytes
+ | BS.length bytes == count ->
+ pure bytes
+ | otherwise ->
+ (bytes <>) <$> recvFull (count - BS.length bytes)
+
+-- | @'hPutValue' handle value@ writes @value@ to handle, as the root object of
+-- a message. If it throws an exception, it will be an 'IOError' raised by the
+-- underlying IO libraries.
+hPutValue :: (Cerialize a, ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a))
+ => Handle -> a -> IO ()
+hPutValue handle value = do
+ msg <- M.newMessage Nothing
+ root <- evalLimitT maxBound $ cerialize msg value
+ setRoot root
+ constMsg <- freeze msg
+ M.hPutMsg handle constMsg
+
+-- | 'putValue' is equivalent to @'hPutValue' 'stdin'@
+putValue :: (Cerialize a, ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a))
+ => a -> IO ()
+putValue = hPutValue stdout
+
+-- | Like 'hPutMsg', except that it takes a 'Socket' instead of a 'Handle'.
+sPutMsg :: Socket -> M.ConstMsg -> IO ()
+sPutMsg socket = sendLazy socket . msgToLBS
+
+-- | Like 'hPutValue', except that it takes a 'Socket' instead of a 'Handle'.
+sPutValue :: (Cerialize a, ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a))
+ => Socket -> a -> IO ()
+sPutValue socket value = do
+ lbs <- evalLimitT maxBound $ valueToLBS value
+ sendLazy socket lbs
diff --git a/lib/Capnp/Message.hs b/lib/Capnp/Message.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Message.hs
@@ -0,0 +1,558 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: Capnp.Message
+Description: Cap'N Proto messages
+
+This module provides support for working directly with Cap'N Proto messages.
+-}
+module Capnp.Message (
+ -- * Reading and writing messages
+ hPutMsg
+ , hGetMsg
+ , putMsg
+ , getMsg
+
+ , readMessage
+ , writeMessage
+
+ -- * Limits on message size
+ , maxSegmentSize
+ , maxSegments
+ , maxCaps
+
+ -- * Converting between messages and 'ByteString's
+ , encode
+ , decode
+
+ -- * Message type class
+ , Message(..)
+
+ -- * Immutable messages
+ , ConstMsg
+ , empty
+
+ -- * Reading data from messages
+ , getSegment
+ , getWord
+ , getCap
+ , getCapTable
+
+ -- * Mutable Messages
+ , MutMsg
+ , newMessage
+
+ -- ** Allocating space in messages
+ , alloc
+ , allocInSeg
+ , newSegment
+
+ -- ** Modifying messages
+ , setSegment
+ , setWord
+ , setCap
+ , appendCap
+
+ , WriteCtx
+
+ , Client
+ , nullClient
+ , withCapTable
+ ) where
+
+import {-# SOURCE #-} Capnp.Rpc.Untyped (Client, nullClient)
+
+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.Maybe (fromJust)
+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.Generic.Mutable as GMV
+import qualified Data.Vector.Mutable as MV
+import qualified Data.Vector.Storable as SV
+import qualified Data.Vector.Storable.Mutable as SMV
+
+import Capnp.Address (WordAddr(..))
+import Capnp.Bits (WordCount(..), hi, lo)
+import Capnp.TraversalLimit (LimitT, MonadLimit(invoice), evalLimitT)
+import Data.Mutable (Mutable(..))
+import Internal.AppendVec (AppendVec)
+
+import qualified Capnp.Errors as E
+import qualified Internal.AppendVec as AppendVec
+
+
+-- | The maximum size of a segment supported by this libarary, in words.
+maxSegmentSize :: Int
+maxSegmentSize = 1 `shiftL` 28 -- 2 GiB.
+
+-- | The maximum number of segments allowed in a message by this library.
+maxSegments :: Int
+maxSegments = 1024
+
+-- | The maximum number of capabilities allowed in a message by this library.
+maxCaps :: Int
+maxCaps = 512
+
+-- | 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
+ -- | 'numWords' gets the number of words in a segment.
+ numWords :: Segment msg -> m WordCount
+ -- | 'numCaps' gets the number of capabilities in a message's capability
+ -- table.
+ numCaps :: 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)
+ -- | @'internalGetCap' cap index@ reads a capability from the message's
+ -- capability table, returning the client. does not check bounds. Callers
+ -- should use getCap instead.
+ internalGetCap :: msg -> Int -> m Client
+ -- | @'slice' start length segment@ extracts a sub-section of the segment,
+ -- starting at index @start@, of length @length@.
+ slice :: WordCount -> WordCount -> 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 -> WordCount -> 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
+
+-- | @'getSegment' message index@ fetches the given segment in the message.
+-- It throws a 'E.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
+
+-- | @'withCapTable'@ replaces the capability table in the message.
+withCapTable :: V.Vector Client -> ConstMsg -> ConstMsg
+withCapTable newCaps msg = msg { constCaps = newCaps }
+
+-- | 'getCapTable' gets the capability table from a 'ConstMsg'.
+getCapTable :: ConstMsg -> V.Vector Client
+getCapTable = constCaps
+
+-- | @'getCap' message index@ gets the capability with the given index from
+-- the message. throws 'E.BoundsError' if the index is out
+-- of bounds.
+getCap :: (MonadThrow m, Message m msg) => msg -> Int -> m Client
+getCap msg i = do
+ ncaps <- numCaps msg
+ if i >= ncaps || i < 0
+ then pure nullClient
+ else msg `internalGetCap` i
+
+-- | @'getWord' msg addr@ returns the word at @addr@ within @msg@. It throws a
+-- 'E.BoundsError' if the address is out of bounds.
+getWord :: (MonadThrow m, Message m msg) => msg -> WordAddr -> m Word64
+getWord msg WordAt{wordIndex=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 'E.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
+-- 'E.BoundsError' will be thrown.
+setWord :: (WriteCtx m s, MonadThrow m) => MutMsg s -> WordAddr -> Word64 -> m ()
+setWord msg WordAt{wordIndex=i, segIndex} val = do
+ seg <- getSegment msg segIndex
+ checkIndex i =<< numWords seg
+ write seg i val
+
+-- | @'setCap' message index cap@ sets the sets the capability at @index@ in
+-- the message's capability table to @cap@. If the index is out of bounds, a
+-- 'E.BoundsError' will be thrown.
+setCap :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Client -> m ()
+setCap msg@MutMsg{mutCaps} i cap = do
+ checkIndex i =<< numCaps msg
+ capTable <- AppendVec.getVector <$> readMutVar mutCaps
+ MV.write capTable i cap
+
+-- | 'appendCap' appends a new capabilty to the end of a message's capability
+-- table, returning its index.
+appendCap :: WriteCtx m s => MutMsg s -> Client -> m Int
+appendCap msg@MutMsg{mutCaps} cap = do
+ i <- numCaps msg
+ capTable <- readMutVar mutCaps
+ capTable <- AppendVec.grow capTable 1 maxCaps
+ writeMutVar mutCaps capTable
+ setCap msg i cap
+ pure i
+
+-- | 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.
+data ConstMsg = ConstMsg
+ { constSegs :: V.Vector (Segment ConstMsg)
+ , constCaps :: V.Vector Client
+ }
+ deriving(Eq)
+
+instance Monad m => Message m ConstMsg where
+ newtype Segment ConstMsg = ConstSegment { constSegToVec :: SV.Vector Word64 }
+ deriving(Eq)
+
+ numSegs ConstMsg{constSegs} = pure $ V.length constSegs
+ numCaps ConstMsg{constCaps} = pure $ V.length constCaps
+ internalGetSeg ConstMsg{constSegs} i = constSegs `V.indexM` i
+ internalGetCap ConstMsg{constCaps} i = constCaps `V.indexM` i
+
+ numWords (ConstSegment vec) = pure $ WordCount $ SV.length vec
+ slice (WordCount start) (WordCount len) (ConstSegment vec) =
+ pure $ ConstSegment (SV.slice start len vec)
+ read (ConstSegment vec) i = fromLE64 <$> vec `SV.indexM` fromIntegral 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 :: Monad m => ConstMsg -> m BB.Builder
+encode msg =
+ -- We use Maybe as the MonadThrow instance required by
+ -- writeMessage/toByteString, but we know this can't actually fail,
+ -- so we ignore errors. TODO: we should get rid of the Monad constraint
+ -- on this function and just have the tyep be ConstMsg -> BB.Builder,
+ -- but that will have some cascading api effects, so we're deferring
+ -- that for a bit.
+ pure $ fromJust $ execWriterT $ writeMessage
+ msg
+ (tell . BB.word32LE)
+ (toByteString >=> tell . BB.byteString)
+
+-- | 'decodeSeg' decodes a message from a segment, treating the segment as if
+-- it were raw bytes.
+--
+-- 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 traversal limit to avoid needing to do bounds checking
+ -- here; since readMessage invoices the limit before reading, we can rely
+ -- on it not to read past the end of the blob.
+ --
+ -- TODO: while this works, it means that we throw 'TraversalLimitError'
+ -- on failure, which makes for a confusing API.
+ 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 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
+ constSegs <- V.mapM (readSegment . fromIntegral) segSizes
+ pure ConstMsg{constSegs, constCaps = V.empty}
+
+-- | @'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{constSegs} write32 writeSegment = do
+ let numSegs = V.length constSegs
+ write32 (fromIntegral numSegs - 1)
+ V.forM_ constSegs $ \seg -> write32 =<< fromIntegral <$> numWords seg
+ when (numSegs `mod` 2 == 0) $ write32 0
+ V.forM_ constSegs writeSegment
+
+
+-- | @'hPutMsg' handle msg@ writes @msg@ to @handle@. If there is an exception,
+-- it will be an 'IOError' raised by the underlying IO libraries.
+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 -> WordCount -> IO ConstMsg
+hGetMsg handle size =
+ evalLimitT size $ readMessage read32 readSegment
+ where
+ read32 :: LimitT IO Word32
+ read32 = lift $ do
+ bytes <- BS.hGet handle 4
+ case runGetS getWord32le bytes of
+ Left _ ->
+ -- the only way this can happen is if we get < 4 bytes.
+ throwM $ E.InvalidDataError "Unexpected end of input"
+ Right result ->
+ pure result
+ readSegment n = lift $ BS.hGet handle (fromIntegral n * 8) >>= fromByteString
+
+-- | Equivalent to @'hGetMsg' 'stdin'@
+getMsg :: WordCount -> 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
+ { mutSegs :: MutVar s (AppendVec MV.MVector s (Segment (MutMsg s)))
+ , mutCaps :: MutVar s (AppendVec MV.MVector s Client)
+ }
+ deriving(Eq)
+
+-- | 'WriteCtx' is the context needed for most write operations.
+type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m)
+
+instance (PrimMonad m, s ~ PrimState m) => Message m (MutMsg s) where
+ newtype Segment (MutMsg s) = MutSegment (AppendVec SMV.MVector s Word64)
+
+ numWords (MutSegment mseg) = pure $ WordCount $ GMV.length (AppendVec.getVector mseg)
+ slice (WordCount start) (WordCount len) (MutSegment mseg) =
+ pure $ MutSegment $ AppendVec.fromVector $
+ SMV.slice start len (AppendVec.getVector mseg)
+ read (MutSegment mseg) i = fromLE64 <$> SMV.read (AppendVec.getVector mseg) (fromIntegral i)
+ fromByteString bytes = do
+ vec <- constSegToVec <$> fromByteString bytes
+ MutSegment . AppendVec.fromVector <$> SV.thaw vec
+ toByteString mseg = do
+ seg <- freeze mseg
+ toByteString (seg :: Segment ConstMsg)
+
+ numSegs MutMsg{mutSegs} = GMV.length . AppendVec.getVector <$> readMutVar mutSegs
+ numCaps MutMsg{mutCaps} = GMV.length . AppendVec.getVector <$> readMutVar mutCaps
+ internalGetSeg MutMsg{mutSegs} i = do
+ segs <- AppendVec.getVector <$> readMutVar mutSegs
+ MV.read segs i
+ internalGetCap MutMsg{mutCaps} i = do
+ caps <- AppendVec.getVector <$> readMutVar mutCaps
+ MV.read caps 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{mutSegs} segIndex seg = do
+ segs <- AppendVec.getVector <$> readMutVar mutSegs
+ 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) -> WordCount -> Word64 -> m ()
+write (MutSegment seg) (WordCount i) val =
+ SMV.write (AppendVec.getVector seg) i (toLE64 val)
+
+-- | @'grow' segment amount@ grows the segment by the specified number
+-- of 64-bit words. The original segment should not be used afterwards.
+grow :: WriteCtx m s => Segment (MutMsg s) -> Int -> m (Segment (MutMsg s))
+grow (MutSegment vec) amount =
+ MutSegment <$> AppendVec.grow vec amount maxSegmentSize
+
+-- | @'newSegment' msg sizeHint@ allocates a new, initially empty segment in
+-- @msg@ with a capacity of @sizeHint@. It returns the a pair of the segment
+-- number and the segment itself. Amortized O(1).
+newSegment :: WriteCtx m s => MutMsg s -> Int -> m (Int, Segment (MutMsg s))
+newSegment msg@MutMsg{mutSegs} sizeHint = do
+ -- the next segment number will be equal to the *current* number of
+ -- segments:
+ segIndex <- numSegs msg
+
+ -- make space for th new segment
+ segs <- readMutVar mutSegs
+ segs <- AppendVec.grow segs 1 maxSegments
+ writeMutVar mutSegs segs
+
+ newSeg <- MutSegment . AppendVec.makeEmpty <$> SMV.new sizeHint
+ 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 vec) <- getSegment msg segIndex
+ let ret = WordAt
+ { segIndex
+ , wordIndex = WordCount $ GMV.length $ AppendVec.getVector vec
+ }
+ newSeg <- grow oldSeg size
+ setSegment msg segIndex newSeg
+ pure ret
+
+-- | @'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@(WordCount sizeInt) = do
+ segIndex <- pred <$> numSegs msg
+ MutSegment vec <- getSegment msg segIndex
+ if AppendVec.canGrowWithoutCopy vec sizeInt
+ then
+ allocInSeg msg segIndex size
+ else do
+ segments <- readMutVar (mutSegs msg)
+ segs <- V.freeze (AppendVec.getVector segments)
+ let totalAllocation = V.sum $ fmap (\(MutSegment vec) -> AppendVec.getCapacity vec) segs
+ -- the new segment's size should match the total size of existing segments
+ ( newSegIndex, _ ) <- newSegment msg (min maxSegmentSize (max totalAllocation sizeInt))
+ allocInSeg msg newSegIndex size
+
+-- | 'empty' is an empty message, i.e. a minimal message with a null pointer as
+-- its root object.
+empty :: ConstMsg
+empty = ConstMsg
+ { constSegs = V.fromList [ ConstSegment $ SV.fromList [0] ]
+ , constCaps = V.empty
+ }
+
+-- | @'newMessage' sizeHint@ allocates a new empty message, with a single segment
+-- having capacity @sizeHint@. If @sizeHint@ is 'Nothing', defaults to a sensible
+-- value.
+newMessage :: WriteCtx m s => Maybe WordCount -> m (MutMsg s)
+newMessage Nothing = newMessage (Just 32)
+ -- The default value above is somewhat arbitrary, and just a guess -- we
+ -- should do some profiling to figure out what a good value is here.
+newMessage (Just (WordCount sizeHint)) = do
+ mutSegs <- MV.new 1 >>= newMutVar . AppendVec.makeEmpty
+ mutCaps <- MV.new 0 >>= newMutVar . AppendVec.makeEmpty
+ let msg = MutMsg{mutSegs,mutCaps}
+ -- allocte the first segment, and make space for the root pointer:
+ _ <- newSegment msg sizeHint
+ _ <- alloc msg 1
+ pure msg
+
+
+instance Thaw (Segment ConstMsg) where
+ type Mutable s (Segment ConstMsg) = Segment (MutMsg s)
+
+ thaw = thawSeg thaw
+ unsafeThaw = thawSeg unsafeThaw
+ freeze = freezeSeg freeze
+ unsafeFreeze = freezeSeg unsafeFreeze
+
+-- Helpers for @Segment ConstMsg@'s Thaw instance.
+thawSeg
+ :: (PrimMonad m, s ~ PrimState m)
+ => (AppendVec.FrozenAppendVec SV.Vector Word64 -> m (AppendVec SMV.MVector s Word64))
+ -> Segment ConstMsg
+ -> m (Segment (MutMsg s))
+thawSeg thaw (ConstSegment vec) =
+ MutSegment <$> thaw (AppendVec.FrozenAppendVec vec)
+
+freezeSeg
+ :: (PrimMonad m, s ~ PrimState m)
+ => (AppendVec SMV.MVector s Word64 -> m (AppendVec.FrozenAppendVec SV.Vector Word64))
+ -> Segment (MutMsg s)
+ -> m (Segment ConstMsg)
+freezeSeg freeze (MutSegment mvec) =
+ ConstSegment . AppendVec.getFrozenVector <$> freeze mvec
+
+instance Thaw ConstMsg where
+ type Mutable s ConstMsg = MutMsg s
+
+ thaw = thawMsg thaw V.thaw
+ unsafeThaw = thawMsg unsafeThaw V.unsafeThaw
+ freeze = freezeMsg freeze V.freeze
+ unsafeFreeze = freezeMsg unsafeFreeze V.unsafeFreeze
+
+-- Helpers for ConstMsg's Thaw instance.
+thawMsg :: (PrimMonad m, s ~ PrimState m)
+ => (Segment ConstMsg -> m (Segment (MutMsg s)))
+ -> (V.Vector Client -> m (MV.MVector s Client))
+ -> ConstMsg
+ -> m (MutMsg s)
+thawMsg thawSeg thawCaps ConstMsg{constSegs, constCaps}= do
+ mutSegs <- newMutVar . AppendVec.fromVector =<< (V.mapM thawSeg constSegs >>= V.unsafeThaw)
+ mutCaps <- newMutVar . AppendVec.fromVector =<< thawCaps constCaps
+ pure MutMsg{mutSegs, mutCaps}
+freezeMsg :: (PrimMonad m, s ~ PrimState m)
+ => (Segment (MutMsg s) -> m (Segment ConstMsg))
+ -> (MV.MVector s Client -> m (V.Vector Client))
+ -> MutMsg s
+ -> m ConstMsg
+freezeMsg freezeSeg freezeCaps msg@MutMsg{mutCaps} = do
+ len <- numSegs msg
+ constSegs <- V.generateM len (internalGetSeg msg >=> freezeSeg)
+ constCaps <- freezeCaps . AppendVec.getVector =<< readMutVar mutCaps
+ pure ConstMsg{constSegs, constCaps}
+
+-- | @'checkIndex' index length@ checkes that 'index' is in the range
+-- [0, length), throwing a 'BoundsError' if not.
+checkIndex :: (Integral a, MonadThrow m) => a -> a -> m ()
+checkIndex i len =
+ when (i < 0 || i >= len) $
+ throwM E.BoundsError
+ { E.index = fromIntegral i
+ , E.maxIndex = fromIntegral len
+ }
diff --git a/lib/Capnp/Pointer.hs b/lib/Capnp/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Pointer.hs
@@ -0,0 +1,156 @@
+{- |
+Module: Capnp.Pointer
+Description: Support for parsing/serializing capnproto pointers
+
+This module provides support for parsing and serializing capnproto pointers.
+This is a low-level module; most users will not need to call it directly.
+-}
+module Capnp.Pointer
+ ( Ptr(..)
+ , ElementSize(..)
+ , EltSpec(..)
+ , parsePtr
+ , parsePtr'
+ , serializePtr
+ , serializePtr'
+ , parseEltSpec
+ , serializeEltSpec
+ )
+ where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+
+import 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 p = Just (parsePtr' p)
+
+-- | @'parsePtr'' word@ parses @word@ as a capnproto pointer. It ignores
+-- nulls, returning them the same as @(StructPtr 0 0 0)@.
+parsePtr' :: Word64 -> Ptr
+parsePtr' word =
+ case bitRange word 0 2 :: Word64 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 (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 (Just p) =
+ serializePtr' p
+
+-- | @'serializePtr'' ptr@ serializes the pointer as a Word64.
+--
+-- Unlike 'serializePtr', this results in a null pointer on the input
+-- @(StructPtr 0 0 0)@, rather than adjusting the offset.
+serializePtr' :: Ptr -> Word64
+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/Capnp/Rpc.hs b/lib/Capnp/Rpc.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc.hs
@@ -0,0 +1,58 @@
+-- |
+-- Module: Capnp.Rpc
+-- Description: Cap'n Proto RPC system
+--
+-- This module exposes the most commonly used parts of the RPC subsystem.
+module Capnp.Rpc
+ (
+ -- * Establishing connections
+ handleConn
+ , ConnConfig(..)
+
+ -- * Calling methods
+ , (?)
+
+ -- * Handling method calls
+ , MethodHandler
+ , pureHandler
+ , rawHandler
+ , rawAsyncHandler
+ , methodUnimplemented
+ , methodThrow
+
+ -- * throwing errors
+ , throwFailed
+
+ -- * Transmitting messages
+ , Transport(..)
+ , socketTransport
+ , handleTransport
+ , tracingTransport
+
+ -- * Promises
+ , module Capnp.Rpc.Promise
+
+ -- * Clients
+ , Client
+ , IsClient(..)
+
+ -- * Supervisors
+ , module Supervisors
+ ) where
+
+import Supervisors
+
+import Capnp.Rpc.Errors (throwFailed)
+import Capnp.Rpc.Invoke ((?))
+import Capnp.Rpc.Promise
+import Capnp.Rpc.Server
+ ( MethodHandler
+ , methodThrow
+ , methodUnimplemented
+ , pureHandler
+ , rawAsyncHandler
+ , rawHandler
+ )
+import Capnp.Rpc.Transport
+ (Transport(..), handleTransport, socketTransport, tracingTransport)
+import Capnp.Rpc.Untyped (Client, ConnConfig(..), IsClient(..), handleConn)
diff --git a/lib/Capnp/Rpc/Errors.hs b/lib/Capnp/Rpc/Errors.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Errors.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module: Capnp.Rpc.Errors
+Description: helpers for working with capnproto exceptions.
+
+In addition to the values exposed in the API, this module also
+defines an instance of Haskell's 'E.Exception' type class, for
+Cap'n Proto's 'Exception'.
+-}
+module Capnp.Rpc.Errors
+ (
+ -- * Converting arbitrary exceptions to capnproto exceptions
+ wrapException
+ -- * Helpers for constructing exceptions
+ , eMethodUnimplemented
+ , eUnimplemented
+ , eDisconnected
+ , eFailed
+ , throwFailed
+ ) where
+
+import Data.Default (Default(def))
+import Data.Maybe (fromMaybe)
+import Data.String (fromString)
+import Data.Text (Text)
+
+import qualified Control.Exception.Safe as E
+
+import Capnp.Gen.Capnp.Rpc.Pure (Exception(..), Exception'Type(..))
+
+-- | Construct an exception with a type field of failed and the
+-- given text as its reason.
+eFailed :: Text -> Exception
+eFailed reason = def
+ { type_ = Exception'Type'failed
+ , reason = reason
+ }
+
+-- | An exception with type = disconnected
+eDisconnected :: Exception
+eDisconnected = def
+ { type_ = Exception'Type'disconnected
+ , reason = "Disconnected"
+ }
+
+-- | An exception indicating an unimplemented method.
+eMethodUnimplemented :: Exception
+eMethodUnimplemented =
+ eUnimplemented "Method unimplemented"
+
+-- | An @unimplemented@ exception with a custom reason message.
+eUnimplemented :: Text -> Exception
+eUnimplemented reason = def
+ { type_ = Exception'Type'unimplemented
+ , reason = reason
+ }
+
+instance E.Exception Exception
+
+-- | @'wrapException' debugMode e@ converts an arbitrary haskell exception
+-- @e@ into an rpc exception, which can be communicated to a remote vat.
+-- If @debugMode@ is true, the returned exception's reason field will include
+-- the text of @show e@.
+wrapException :: Bool -> E.SomeException -> Exception
+wrapException debugMode e = fromMaybe
+ def { type_ = Exception'Type'failed
+ , reason =
+ if debugMode then
+ "Unhandled exception: " <> fromString (show e)
+ else
+ "Unhandled exception"
+ }
+ (E.fromException e)
+
+-- | Throw an exception with a type field of 'Exception'Type'failed' and
+-- the argument as a reason.
+throwFailed :: E.MonadThrow m => Text -> m a
+throwFailed = E.throwM . eFailed
diff --git a/lib/Capnp/Rpc/Invoke.hs b/lib/Capnp/Rpc/Invoke.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Invoke.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |
+-- Module: Capnp.Rpc.Invoke
+-- Description: Invoke remote methods
+--
+-- Support for invoking 'Server.MethodHandler's
+module Capnp.Rpc.Invoke
+ (
+ -- * Using high-level representations
+ invokePurePromise
+ , (?)
+ , invokePure
+ , InvokePureCtx
+
+ -- * Using low level representations
+ , invokeRaw
+ ) where
+
+
+import Control.Concurrent.STM (atomically)
+import Control.Monad.Catch (MonadThrow)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Primitive (PrimMonad, PrimState)
+
+import Capnp.Classes
+ ( Cerialize(cerialize)
+ , Decerialize(Cerial, decerialize)
+ , FromPtr(fromPtr)
+ , ToStruct(toStruct)
+ )
+import Capnp.TraversalLimit (defaultLimit, evalLimitT)
+import Data.Mutable (freeze)
+
+import qualified Capnp.Message as M
+import qualified Capnp.Rpc.Promise as Promise
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.Untyped as U
+
+-- | Invoke a method by passing it the low-level representation of its parameter,
+-- and a 'Fulfiller' that can be used to supply (the low-level representation of)
+-- its return value.
+invokeRaw ::
+ ( MonadThrow m
+ , MonadIO m
+ , PrimMonad m
+ , Decerialize r
+ , Decerialize p
+ , ToStruct M.ConstMsg (Cerial M.ConstMsg p)
+ , FromPtr M.ConstMsg (Cerial M.ConstMsg r)
+ ) =>
+ Server.MethodHandler m p r
+ -> Cerial M.ConstMsg p
+ -> Promise.Fulfiller (Cerial M.ConstMsg r)
+ -> m ()
+invokeRaw method params typedFulfiller = do
+ (_, untypedFulfiller) <- liftIO $ atomically $ Promise.newPromiseWithCallbackSTM $ \case
+ Left e -> Promise.breakPromiseSTM typedFulfiller e
+ Right v -> evalLimitT defaultLimit (fromPtr M.empty v) >>= Promise.fulfillSTM typedFulfiller
+ Server.invokeIO
+ (Server.toUntypedHandler method)
+ (Just (U.PtrStruct (toStruct params)))
+ untypedFulfiller
+
+-- | Shorthand for class contstraints needed to invoke a method using
+-- the high-level API.
+type InvokePureCtx m p r =
+ ( MonadThrow m
+ , MonadIO m
+ , PrimMonad m
+ , Decerialize r
+ , ToStruct M.ConstMsg (Cerial M.ConstMsg p)
+ , ToStruct (M.MutMsg (PrimState m)) (Cerial (M.MutMsg (PrimState m)) p)
+ , Cerialize p
+ , FromPtr M.ConstMsg (Cerial M.ConstMsg r)
+ )
+
+-- | Like 'invokeRaw', but uses the high-level representations of the data
+-- types.
+invokePure
+ :: InvokePureCtx m p r
+ => Server.MethodHandler m p r
+ -> p
+ -> Promise.Fulfiller r
+ -> m ()
+invokePure method params pureFulfiller = do
+ struct <- evalLimitT defaultLimit $ do
+ msg <- M.newMessage Nothing
+ (toStruct <$> cerialize msg params) >>= freeze
+ (_, untypedFulfiller) <- liftIO $ atomically $ Promise.newPromiseWithCallbackSTM $ \case
+ Left e -> Promise.breakPromiseSTM pureFulfiller e
+ Right v ->
+ evalLimitT defaultLimit (fromPtr M.empty v >>= decerialize)
+ >>= Promise.fulfillSTM pureFulfiller
+ Server.invokeIO
+ (Server.toUntypedHandler method)
+ (Just (U.PtrStruct struct))
+ untypedFulfiller
+
+-- | Like 'invokePure', but returns a promise instead of accepting a fulfiller.
+invokePurePromise
+ :: InvokePureCtx m p r
+ => Server.MethodHandler m p r
+ -> p
+ -> m (Promise.Promise r)
+invokePurePromise method params = do
+ (promise, fulfiller) <- Promise.newPromise
+ invokePure method params fulfiller
+ pure promise
+
+-- | Alias for 'invokePurePromise'
+(?) :: InvokePureCtx m p r
+ => Server.MethodHandler m p r
+ -> p
+ -> m (Promise.Promise r)
+(?) = invokePurePromise
diff --git a/lib/Capnp/Rpc/Promise.hs b/lib/Capnp/Rpc/Promise.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Promise.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+-- |
+-- Module: Capnp.Rpc.Promise
+-- Description: Promises
+--
+-- This module defines a 'Promise' type, represents a value which is not yet
+-- available, and related utilities.
+module Capnp.Rpc.Promise
+ ( Promise
+ , Fulfiller
+
+ -- * Creating promises
+ , newPromise
+ , newPromiseSTM
+ , newPromiseWithCallback
+ , newPromiseWithCallbackSTM
+ , newCallback
+ , newCallbackSTM
+
+ -- * Fulfilling or breaking promises
+ , fulfill
+ , fulfillSTM
+ , breakPromise
+ , breakPromiseSTM
+ , ErrAlreadyResolved(..)
+
+ -- * Getting the value of a promise
+ , wait
+ , waitSTM
+ ) where
+
+import Control.Concurrent.STM
+import Control.Monad.IO.Class (MonadIO, liftIO)
+
+import qualified Control.Exception.Safe as HsExn
+
+import Capnp.Gen.Capnp.Rpc.Pure
+-- For exception instance:
+import Capnp.Rpc.Errors ()
+
+-- | An exception thrown if 'breakPromise' or 'fulfill' is called on an
+-- already-resolved fulfiller.
+data ErrAlreadyResolved = ErrAlreadyResolved deriving(Show)
+instance HsExn.Exception ErrAlreadyResolved
+
+-- | A 'Fulfiller' is used to fulfill a promise.
+newtype Fulfiller a = Fulfiller
+ { callback :: Either Exception a -> STM ()
+ }
+
+-- | Like 'fulfill', but in 'STM'
+fulfillSTM :: Fulfiller a -> a -> STM ()
+fulfillSTM Fulfiller{callback} val = callback (Right val)
+
+-- | Fulfill a promise by supplying the specified value. It is an error to
+-- call 'fulfill' if the promise has already been fulfilled (or broken).
+fulfill :: MonadIO m => Fulfiller a -> a -> m ()
+fulfill fulfiller = liftIO . atomically . fulfillSTM fulfiller
+
+-- | Like 'breakPromise', but in 'STM'.
+breakPromiseSTM :: Fulfiller a -> Exception -> STM ()
+breakPromiseSTM Fulfiller{callback} exn = callback (Left exn)
+
+-- | Break a promise. When the user of the promise executes 'wait', the
+-- specified exception will be raised. It is an error to call 'breakPromise'
+-- if the promise has already been fulfilled (or broken).
+breakPromise :: MonadIO m => Fulfiller a -> Exception -> m ()
+breakPromise fulfiller = liftIO . atomically . breakPromiseSTM fulfiller
+
+-- | Like 'wait', but runs in 'STM'.
+waitSTM :: Promise a -> STM a
+waitSTM Promise{var} = do
+ val <- readTVar var
+ case val of
+ Nothing ->
+ retry
+ Just (Right result) ->
+ pure result
+ Just (Left exn) ->
+ throwSTM exn
+
+-- | Wait for a promise to resolve, and return the result. If the promise
+-- is broken, this raises an exception instead (see 'breakPromise').
+wait :: MonadIO m => Promise a -> m a
+wait = liftIO . atomically . waitSTM
+
+-- | Like 'newPromise', but in 'STM'.
+newPromiseSTM :: STM (Promise a, Fulfiller a)
+newPromiseSTM = do
+ var <- newTVar Nothing
+ pure
+ ( Promise{var}
+ , Fulfiller
+ { callback = \result -> do
+ val <- readTVar var
+ case val of
+ Nothing ->
+ writeTVar var (Just result)
+ Just _ ->
+ throwSTM ErrAlreadyResolved
+ }
+ )
+
+-- | Like 'newPromiseWithCallbackSTM', but runs in 'STM'.
+newPromiseWithCallbackSTM :: (Either Exception a -> STM ()) -> STM (Promise a, Fulfiller a)
+newPromiseWithCallbackSTM callback = do
+ (promise, Fulfiller{callback=oldCallback}) <- newPromiseSTM
+ pure
+ ( promise
+ , Fulfiller
+ { callback = \result -> oldCallback result >> callback result
+ }
+ )
+
+-- | Create a new promise which also excecutes an STM action when it is resolved.
+newPromiseWithCallback :: MonadIO m => (Either Exception a -> STM ()) -> m (Promise a, Fulfiller a)
+newPromiseWithCallback = liftIO . atomically . newPromiseWithCallbackSTM
+
+-- | Like 'newCallback', but runs in 'STM'.
+newCallbackSTM :: (Either Exception a -> STM ()) -> STM (Fulfiller a)
+newCallbackSTM = fmap snd . newPromiseWithCallbackSTM
+
+-- | Like 'newPromiseWithCallback', but doesn't return the promise.
+newCallback :: MonadIO m => (Either Exception a -> STM ()) -> m (Fulfiller a)
+newCallback = liftIO . atomically . newCallbackSTM
+
+-- | Create a new promise and an associated fulfiller.
+newPromise :: MonadIO m => m (Promise a, Fulfiller a)
+newPromise = liftIO $ atomically newPromiseSTM
+
+-- | A promise is a value that may not be ready yet.
+newtype Promise a = Promise
+ { var :: TVar (Maybe (Either Exception a))
+ }
+ deriving(Eq)
diff --git a/lib/Capnp/Rpc/Server.hs b/lib/Capnp/Rpc/Server.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Server.hs
@@ -0,0 +1,257 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: Capnp.Rpc.Server
+Description: handlers for incoming method calls.
+
+The term server in this context refers to a thread that handles method calls for
+a particular capability (The capnproto rpc protocol itself has no concept of
+clients and servers).
+-}
+module Capnp.Rpc.Server
+ ( ServerOps(..)
+ , CallInfo(..)
+ , runServer
+
+ -- * Handling methods
+ , MethodHandler
+ -- ** Using high-level representations
+ , pureHandler
+ -- ** Using low-level representations
+ , rawHandler
+ , rawAsyncHandler
+ -- ** Always throwing exceptions
+ , methodThrow
+ , methodUnimplemented
+ -- ** Working with untyped data
+ , untypedHandler
+ , toUntypedHandler
+ , fromUntypedHandler
+
+ -- * Invoking methods
+ , invokeIO
+ ) where
+
+import Control.Concurrent.STM
+import Data.Word
+
+import Control.Exception.Safe (MonadCatch, finally, try)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Primitive (PrimMonad, PrimState)
+
+import Capnp.Classes
+ ( Cerialize
+ , Decerialize(Cerial, decerialize)
+ , FromPtr(fromPtr)
+ , ToStruct(toStruct)
+ )
+import Capnp.Convert (valueToMsg)
+import Capnp.Message (ConstMsg, MutMsg)
+import Capnp.Rpc.Errors (eMethodUnimplemented, wrapException)
+import Capnp.Rpc.Promise
+ ( Fulfiller
+ , breakPromise
+ , breakPromiseSTM
+ , fulfill
+ , fulfillSTM
+ , newCallback
+ )
+import Capnp.TraversalLimit (defaultLimit, evalLimitT)
+import Capnp.Untyped (Ptr)
+import Data.Mutable (freeze)
+
+import qualified Capnp.Gen.Capnp.Rpc.Pure as RpcGen
+import qualified Capnp.Message as Message
+import qualified Capnp.Untyped as Untyped
+import qualified Internal.TCloseQ as TCloseQ
+
+-- | a @'MethodHandler' m p r@ handles a method call with parameters @p@
+-- and return type @r@, in monad @m@.
+--
+-- The library represents method handlers via an abstract type
+-- 'MethodHandler', parametrized over parameter (@p@) and return (@r@)
+-- types, and the monadic context in which it runs (@m@). This allows us
+-- to provide different strategies for actually handling methods; there
+-- are various helper functions which construct these handlers.
+--
+-- At some point we will likely additionally provide handlers affording:
+--
+-- * Working directly with the low-level data types.
+-- * Replying to the method call asynchronously, allowing later method
+-- calls to be serviced before the current one is finished.
+newtype MethodHandler m p r = MethodHandler
+ { handleMethod
+ :: Maybe (Ptr ConstMsg)
+ -> Fulfiller (Maybe (Ptr ConstMsg))
+ -> m ()
+ }
+
+invokeIO
+ :: MonadIO m
+ => MethodHandler m (Maybe (Ptr ConstMsg)) (Maybe (Ptr ConstMsg))
+ -> Maybe (Ptr ConstMsg)
+ -> Fulfiller (Maybe (Ptr ConstMsg))
+ -> m ()
+invokeIO = handleMethod
+
+-- | @'pureHandler' f cap@ is a 'MethodHandler' which calls a function @f@
+-- that accepts the receiver and the parameter type as exposed by the
+-- high-level API, and returns the high-level API representation of the
+-- return type.
+pureHandler ::
+ ( MonadCatch m
+ , MonadIO m
+ , PrimMonad m
+ , s ~ PrimState m
+ , Decerialize p
+ , FromPtr ConstMsg (Cerial ConstMsg p)
+ , Cerialize r
+ , ToStruct (MutMsg s) (Cerial (MutMsg s) r)
+ ) =>
+ (cap -> p -> m r)
+ -> cap
+ -> MethodHandler m p r
+pureHandler f cap = MethodHandler
+ { handleMethod = \ptr reply -> do
+ param <- evalLimitT defaultLimit $
+ fromPtr Message.empty ptr >>= decerialize
+ result <- try $ f cap param
+ case result of
+ Right val -> do
+ struct <- evalLimitT defaultLimit $
+ valueToMsg val >>= freeze >>= Untyped.rootPtr
+ fulfill reply (Just (Untyped.PtrStruct struct))
+ Left e ->
+ -- TODO: find a way to get the connection config's debugMode
+ -- option to be accessible from here, so we can use it.
+ breakPromise reply (wrapException False e)
+ }
+
+-- | Like 'pureHandler', except that the parameter and return value use the
+-- low-level representation.
+rawHandler ::
+ ( MonadCatch m
+ , MonadIO m
+ , PrimMonad m
+ , s ~ PrimState m
+ , Decerialize p
+ , FromPtr ConstMsg (Cerial ConstMsg p)
+ , Decerialize r
+ , ToStruct ConstMsg (Cerial ConstMsg r)
+ ) =>
+ (cap -> Cerial ConstMsg p -> m (Cerial ConstMsg r))
+ -> cap
+ -> MethodHandler m p r
+rawHandler f cap = MethodHandler
+ { handleMethod = \ptr reply -> do
+ cerial <- evalLimitT defaultLimit $ fromPtr Message.empty ptr
+ result <- try $ f cap cerial
+ case result of
+ Right val -> fulfill reply (Just (Untyped.PtrStruct (toStruct val)))
+ Left e -> breakPromise reply (wrapException False e)
+ }
+
+-- | Like 'rawHandler', except that it takes a fulfiller for the result,
+-- instead of returning it. This allows the result to be supplied some time
+-- after the method returns, making it possible to service other method
+-- calls before the result is available.
+rawAsyncHandler ::
+ ( MonadCatch m
+ , MonadIO m
+ , PrimMonad m
+ , s ~ PrimState m
+ , Decerialize p
+ , FromPtr ConstMsg (Cerial ConstMsg p)
+ , Decerialize r
+ , ToStruct ConstMsg (Cerial ConstMsg r)
+ ) =>
+ (cap -> Cerial ConstMsg p -> Fulfiller (Cerial ConstMsg r) -> m ())
+ -> cap
+ -> MethodHandler m p r
+rawAsyncHandler f cap = MethodHandler
+ { handleMethod = \ptr reply -> do
+ fulfiller <- newCallback $ \case
+ Left e -> breakPromiseSTM reply e
+ Right v -> fulfillSTM reply $ Just (Untyped.PtrStruct (toStruct v))
+ cerial <- evalLimitT defaultLimit $ fromPtr Message.empty ptr
+ f cap cerial fulfiller
+ }
+
+-- | Convert a 'MethodHandler' for any parameter and return types into
+-- one that deals with untyped pointers.
+toUntypedHandler
+ :: MethodHandler m p r
+ -> MethodHandler m (Maybe (Ptr ConstMsg)) (Maybe (Ptr ConstMsg))
+toUntypedHandler MethodHandler{..} = MethodHandler{..}
+
+-- | Inverse of 'toUntypedHandler'
+fromUntypedHandler
+ :: MethodHandler m (Maybe (Ptr ConstMsg)) (Maybe (Ptr ConstMsg))
+ -> MethodHandler m p r
+fromUntypedHandler MethodHandler{..} = MethodHandler{..}
+
+-- | Construct a method handler from a function accepting an untyped
+-- pointer for the method's parameter, and a 'Fulfiller' which accepts
+-- an untyped pointer for the method's return value.
+untypedHandler
+ :: (Maybe (Ptr ConstMsg) -> Fulfiller (Maybe (Ptr ConstMsg)) -> m ())
+ -> MethodHandler m (Maybe (Ptr ConstMsg)) (Maybe (Ptr ConstMsg))
+untypedHandler = MethodHandler
+
+-- | @'methodThrow' exn@ is a 'MethodHandler' which always throws @exn@.
+methodThrow :: MonadIO m => RpcGen.Exception -> MethodHandler m p r
+methodThrow exn = MethodHandler
+ { handleMethod = \_ fulfiller -> liftIO $ breakPromise fulfiller exn
+ }
+
+-- | A 'MethodHandler' which always throws an @unimplemented@ exception.
+methodUnimplemented :: MonadIO m => MethodHandler m p r
+methodUnimplemented = methodThrow eMethodUnimplemented
+
+-- | The operations necessary to receive and handle method calls, i.e.
+-- to implement an object. It is parametrized over the monadic context
+-- in which methods are serviced.
+data ServerOps m = ServerOps
+ { handleCall
+ :: Word64
+ -> Word16
+ -> MethodHandler m (Maybe (Ptr ConstMsg)) (Maybe (Ptr ConstMsg))
+ -- ^ Handle a method call; takes the interface and method id and returns
+ -- a handler for the specific method.
+ , handleStop :: m ()
+ -- ^ Handle shutting-down the receiver; this is called when the last
+ -- reference to the capability is dropped.
+ }
+
+-- | A 'CallInfo' contains information about a method call.
+data CallInfo = CallInfo
+ { interfaceId :: !Word64
+ -- ^ The id of the interface whose method is being called.
+ , methodId :: !Word16
+ -- ^ The method id of the method being called.
+ , arguments :: Maybe (Ptr ConstMsg)
+ -- ^ The arguments to the method call.
+ , response :: Fulfiller (Maybe (Ptr ConstMsg))
+ -- ^ A 'Fulfiller' which accepts the method's return value.
+ }
+
+-- | Handle incoming messages for a given object.
+--
+-- Accepts a queue of messages to handle, and 'ServerOps' used to handle them.
+-- returns when it receives a 'Stop' message.
+runServer :: TCloseQ.Q CallInfo -> ServerOps IO -> IO ()
+runServer q ops = go `finally` handleStop ops
+ where
+ go = atomically (TCloseQ.read q) >>= \case
+ Nothing ->
+ pure ()
+ Just CallInfo{interfaceId, methodId, arguments, response} -> do
+ handleMethod
+ (handleCall ops interfaceId methodId)
+ arguments
+ response
+ go
diff --git a/lib/Capnp/Rpc/Transport.hs b/lib/Capnp/Rpc/Transport.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Transport.hs
@@ -0,0 +1,66 @@
+{-|
+Module: Capnp.Rpc.Transport
+Description: Support for exchanging messages with remote vats.
+
+This module provides a 'Transport' type, which provides operations
+used to transmit messages between vats in the RPC protocol.
+-}
+module Capnp.Rpc.Transport
+ ( Transport(..)
+ , handleTransport
+ , socketTransport
+ , tracingTransport
+ ) where
+
+import Network.Socket (Socket)
+import System.IO (Handle)
+
+import Capnp.Bits (WordCount)
+import Capnp.Convert (msgToValue)
+import Capnp.IO (hGetMsg, hPutMsg, sGetMsg, sPutMsg)
+import Capnp.Message (ConstMsg)
+import Text.Show.Pretty (ppShow)
+
+import qualified Capnp.Gen.Capnp.Rpc.Pure as R
+
+-- | A @'Transport'@ handles transmitting RPC messages.
+data Transport = Transport
+ { sendMsg :: ConstMsg -> IO ()
+ -- ^ Send a message
+ , recvMsg :: IO ConstMsg
+ -- ^ Receive a message
+ }
+
+-- | @'handleTransport' handle limit@ is a transport which reads and writes
+-- messages from/to @handle@. It uses @limit@ as the traversal limit when
+-- reading messages and decoding.
+handleTransport :: Handle -> WordCount -> Transport
+handleTransport handle limit = Transport
+ { sendMsg = hPutMsg handle
+ , recvMsg = hGetMsg handle limit
+ }
+
+-- | @'socketTransport' socket limit@ is a transport which reads and writes
+-- messages to/from a socket. It uses @limit@ as the traversal limit when
+-- reading messages and decoing.
+socketTransport :: Socket -> WordCount -> Transport
+socketTransport socket limit = Transport
+ { sendMsg = sPutMsg socket
+ , recvMsg = sGetMsg socket limit
+ }
+
+-- | @'tracingTransport' log trans@ wraps another transport @trans@, loging
+-- messages when they are sent or received (using the @log@ function). This
+-- can be useful for debugging.
+tracingTransport :: (String -> IO ()) -> Transport -> Transport
+tracingTransport log trans = Transport
+ { sendMsg = \msg -> do
+ rpcMsg <- msgToValue msg
+ log $ "sending message: " ++ ppShow (rpcMsg :: R.Message)
+ sendMsg trans msg
+ , recvMsg = do
+ msg <- recvMsg trans
+ rpcMsg <- msgToValue msg
+ log $ "received message: " ++ ppShow (rpcMsg :: R.Message)
+ pure msg
+ }
diff --git a/lib/Capnp/Rpc/Untyped.hs b/lib/Capnp/Rpc/Untyped.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Untyped.hs
@@ -0,0 +1,1945 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module: Capnp.Rpc.Untyped
+-- Description: Core of the RPC subsystem.
+--
+-- This module does not deal with schema-level concepts; all capabilities,
+-- methods etc. as used here are untyped.
+module Capnp.Rpc.Untyped
+ (
+ -- * Connections to other vats
+ ConnConfig(..)
+ , handleConn
+
+ -- * Clients for capabilities
+ , Client
+ , call
+ , nullClient
+
+ , IsClient(..)
+
+ -- * Exporting local objects
+ , export
+ , clientMethodHandler
+
+ -- * Errors
+ , RpcError(..)
+ , R.Exception(..)
+ , R.Exception'Type(..)
+
+ -- * Shutting down the connection
+ ) where
+
+import Control.Concurrent.STM
+import Data.Word
+
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (concurrently_, race_)
+import Control.Concurrent.MVar (MVar, newEmptyMVar)
+import Control.Exception.Safe (Exception, bracket, throwIO, try)
+import Control.Monad (forever, void, when)
+import Data.Default (Default(def))
+import Data.Foldable (for_, toList, traverse_)
+import Data.Hashable (Hashable, hash, hashWithSalt)
+import Data.Maybe (catMaybes)
+import Data.String (fromString)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Supervisors (Supervisor, superviseSTM, withSupervisor)
+import System.Mem.StableName (StableName, hashStableName, makeStableName)
+import System.Timeout (timeout)
+
+import qualified Data.Vector as V
+import qualified Focus
+import qualified ListT
+import qualified StmContainers.Map as M
+
+import Capnp.Classes (cerialize, decerialize)
+import Capnp.Convert (msgToValue, valueToMsg)
+import Capnp.Message (ConstMsg)
+import Capnp.Rpc.Errors
+ ( eDisconnected
+ , eFailed
+ , eMethodUnimplemented
+ , eUnimplemented
+ , wrapException
+ )
+import Capnp.Rpc.Promise
+ (Fulfiller, breakPromiseSTM, fulfillSTM, newCallbackSTM)
+import Capnp.Rpc.Transport (Transport(recvMsg, sendMsg))
+import Capnp.TraversalLimit (defaultLimit, evalLimitT)
+import Internal.BuildPure (createPure)
+import Internal.Rc (Rc)
+import Internal.SnocList (SnocList)
+
+import qualified Capnp.Gen.Capnp.Rpc.Pure as R
+import qualified Capnp.Message as Message
+import qualified Capnp.Rpc.Server as Server
+import qualified Capnp.Untyped as UntypedRaw
+import qualified Capnp.Untyped.Pure as Untyped
+import qualified Internal.Finalizer as Fin
+import qualified Internal.Rc as Rc
+import qualified Internal.SnocList as SnocList
+import qualified Internal.TCloseQ as TCloseQ
+
+-- Note [Organization]
+-- ===================
+--
+-- As much as possible, the logic in this module is centralized according to
+-- type types of objects it concerns.
+--
+-- As an example, consider how we handle embargos: The 'Conn' type's 'embargos'
+-- table has values that are just 'Fulfiller's. This allows the code which triggers
+-- sending embargoes to have full control over what happens when they return,
+-- while the code that routes incoming messages (in 'coordinator') doesn't need
+-- to concern itself with the details of embargos -- it just needs to route them
+-- to the right place.
+--
+-- This approach generally results in better separation of concerns.
+
+-- Note [Level 3]
+--
+-- This is currently a level 1 implementation, so use of most level 3 features
+-- results in sending abort messages. However, to make adding this support
+-- easier later, we mark such places with a cross-reference back to this note.
+--
+-- In addition to filling in those spots, the following will need to be dealt
+-- with:
+--
+-- * The "Tribble 4-way Race Condition" as documented in rpc.capnp. This
+-- doesn't affect level 1 implementations, but right now we shorten N-hop
+-- paths of promises to 1-hop, (calls on Ready PromiseClients just
+-- immediately call the target), which is unsafe in a level 3
+-- implementation. See the protocol documentation for more info.
+
+-- | We use this type often enough that the types get noisy without a shorthand:
+type MPtr = Maybe Untyped.Ptr
+-- | Less often, but still helpful:
+type RawMPtr = Maybe (UntypedRaw.Ptr ConstMsg)
+
+
+-- | Errors which can be thrown by the rpc system.
+data RpcError
+ = ReceivedAbort R.Exception
+ -- ^ The remote vat sent us an abort message.
+ | SentAbort R.Exception
+ -- ^ We sent an abort to the remote vat.
+ deriving(Show, Eq, Generic)
+
+instance Exception RpcError
+
+newtype EmbargoId = EmbargoId { embargoWord :: Word32 } deriving(Eq, Hashable)
+newtype QAId = QAId { qaWord :: Word32 } deriving(Eq, Hashable)
+newtype IEId = IEId { ieWord :: Word32 } deriving(Eq, Hashable)
+
+-- We define these to just show the number; the derived instances would include
+-- data constructors, which is a bit weird since these show up in output that
+-- is sometimes show to users.
+instance Show QAId where
+ show = show . qaWord
+instance Show IEId where
+ show = show . ieWord
+
+-- | A connection to a remote vat
+data Conn = Conn
+ { stableName :: StableName (MVar ())
+ -- So we can use the connection as a map key. The MVar used to create
+ -- this is just an arbitrary value; the only property we care about
+ -- is that it is distinct for each 'Conn', so we use something with
+ -- reference semantics to guarantee this.
+
+ , debugMode :: !Bool
+ -- whether to include extra (possibly sensitive) info in error messages.
+
+ , liveState :: TVar LiveState
+ }
+
+data LiveState
+ = Live Conn'
+ | Dead
+
+data Conn' = Conn'
+ { sendQ :: TBQueue ConstMsg
+ , recvQ :: TBQueue ConstMsg
+ -- queues of messages to send and receive; each of these has a dedicated
+ -- thread doing the IO (see 'sendLoop' and 'recvLoop'):
+
+ , supervisor :: Supervisor
+ -- Supervisor managing the lifetimes of threads bound to this connection.
+
+ , questionIdPool :: IdPool
+ , exportIdPool :: IdPool
+ -- Pools of identifiers for new questions and exports
+
+ , questions :: M.Map QAId EntryQA
+ , answers :: M.Map QAId EntryQA
+ , exports :: M.Map IEId EntryE
+ , imports :: M.Map IEId EntryI
+
+ , embargos :: M.Map EmbargoId (Fulfiller ())
+ -- Outstanding embargos. When we receive a 'Disembargo' message with its
+ -- context field set to receiverLoopback, we look up the embargo id in
+ -- this table, and fulfill the promise.
+
+ , pendingCallbacks :: TQueue (IO ())
+ -- See Note [callbacks]
+
+ , bootstrap :: Maybe Client
+ -- The capability which should be served as this connection's bootstrap
+ -- interface (if any).
+ }
+
+instance Eq Conn where
+ x == y = stableName x == stableName y
+
+instance Hashable Conn where
+ hash Conn{stableName} = hashStableName stableName
+ hashWithSalt _ = hash
+
+-- | Configuration information for a connection.
+data ConnConfig = ConnConfig
+ { maxQuestions :: !Word32
+ -- ^ The maximum number of simultanious outstanding requests to the peer
+ -- vat. Once this limit is reached, further questsions will block until
+ -- some of the existing questions have been answered.
+ --
+ -- Defaults to 128.
+
+ , maxExports :: !Word32
+ -- ^ The maximum number of objects which may be exported on this connection.
+ --
+ -- Defaults to 8192.
+
+ , debugMode :: !Bool
+ -- ^ In debug mode, errors reported by the RPC system to its peers will
+ -- contain extra information. This should not be used in production, as
+ -- it is possible for these messages to contain sensitive information,
+ -- but it can be useful for debugging.
+ --
+ -- Defaults to 'False'.
+
+ , getBootstrap :: Supervisor -> STM (Maybe Client)
+ -- ^ Get the bootstrap interface we should serve for this connection.
+ -- the argument is a supervisor whose lifetime is bound to the
+ -- connection. If 'getBootstrap' returns 'Nothing', we will respond
+ -- to bootstrap messages with an exception.
+ --
+ -- The default always returns 'Nothing'.
+
+ , withBootstrap :: Maybe (Supervisor -> Client -> IO ())
+ -- ^ An action to perform with access to the remote vat's bootstrap
+ -- interface. The supervisor argument is bound to the lifetime of the
+ -- connection. If this is 'Nothing' (the default), the bootstrap
+ -- interface will not be requested.
+ }
+
+instance Default ConnConfig where
+ def = ConnConfig
+ { maxQuestions = 128
+ , maxExports = 8192
+ , debugMode = False
+ , getBootstrap = \_ -> pure Nothing
+ , withBootstrap = Nothing
+ }
+
+-- | Queue an IO action to be run some time after this transaction commits.
+-- See Note [callbacks].
+queueIO :: Conn' -> IO () -> STM ()
+queueIO Conn'{pendingCallbacks} = writeTQueue pendingCallbacks
+
+-- | Queue another transaction to be run some time after this transaction
+-- commits, in a thread bound to the lifetime of the connection. If this is
+-- called multiple times within the same transaction, each of the
+-- transactions will be run separately, in the order they were queued.
+--
+-- See Note [callbacks]
+queueSTM :: Conn' -> STM () -> STM ()
+queueSTM conn = queueIO conn . atomically
+
+-- | @'mapQueueSTM' conn fs val@ queues the list of transactions obtained
+-- by applying each element of @fs@ to @val@.
+mapQueueSTM :: Conn' -> SnocList (a -> STM ()) -> a -> STM ()
+mapQueueSTM conn fs x = traverse_ (\f -> queueSTM conn (f x)) fs
+
+-- Note [callbacks]
+-- ================
+--
+-- There are many places where we want to register some code to run after
+-- some later event has happened -- for exmaple:
+--
+-- * We send a Call to the remote vat, and when a corresponding Return message
+-- is received, we want to fulfill (or break) the local promise for the
+-- result.
+-- * We send a Disembargo (with senderLoopback set), and want to actually lift
+-- the embargo when the corresponding (receiverLoopback) message arrives.
+--
+-- Keeping the two parts of these patterns together tends to result in better
+-- separation of concerns, and is easier to maintain.
+--
+-- To achieve this, the four tables and other connection state have fields in
+-- which callbacks can be registered -- for example, an outstanding question has
+-- fields containing transactions to run when the return and/or finish messages
+-- arrive.
+--
+-- When it is time to actually run these, we want to make sure that each of them
+-- runs as their own transaction. If, for example, when registering a callback to
+-- run when a return message is received, we find that the return message is
+-- already available, it might be tempting to just run the transaction immediately.
+-- But this means that the synchronization semantics are totally different from the
+-- case where the callback really does get run later!
+--
+-- In addition, we sometimes want to register a finalizer inside a transaction,
+-- but this can only be done in IO.
+--
+-- To solve these issues, the connection maintains a queue of all callback actions
+-- that are ready to run, and when the event a callback is waiting for occurs, we
+-- simply move the callback to the queue, using 'queueIO' or 'queueSTM'. When the
+-- connection starts up, it creates a thread running 'callbacksLoop', which just
+-- continually flushes the queue, running the actions in the queue.
+
+-- | Get a new question id. retries if we are out of available question ids.
+newQuestion :: Conn' -> STM QAId
+newQuestion = fmap QAId . newId . questionIdPool
+
+-- | Return a question id to the pool of available ids.
+freeQuestion :: Conn' -> QAId -> STM ()
+freeQuestion conn = freeId (questionIdPool conn) . qaWord
+
+-- | Get a new export id. retries if we are out of available export ids.
+newExport :: Conn' -> STM IEId
+newExport = fmap IEId . newId . exportIdPool
+
+-- | Return a export id to the pool of available ids.
+freeExport :: Conn' -> IEId -> STM ()
+freeExport conn = freeId (exportIdPool conn) . ieWord
+
+-- | Get a new embargo id. This shares the same pool as questions.
+newEmbargo :: Conn' -> STM EmbargoId
+newEmbargo = fmap EmbargoId . newId . questionIdPool
+
+-- | Return an embargo id. to the available pool.
+freeEmbargo :: Conn' -> EmbargoId -> STM ()
+freeEmbargo conn = freeId (exportIdPool conn) . embargoWord
+
+-- | Handle a connection to another vat. Returns when the connection is closed.
+handleConn :: Transport -> ConnConfig -> IO ()
+handleConn
+ transport
+ cfg@ConnConfig
+ { maxQuestions
+ , maxExports
+ , withBootstrap
+ , debugMode
+ }
+ = withSupervisor $ \sup ->
+ bracket
+ (newConn sup)
+ stopConn
+ runConn
+ where
+ newConn sup = do
+ stableName <- makeStableName =<< newEmptyMVar
+ atomically $ do
+ bootstrap <- getBootstrap cfg sup
+ questionIdPool <- newIdPool maxQuestions
+ exportIdPool <- newIdPool maxExports
+
+ sendQ <- newTBQueue $ fromIntegral maxQuestions
+ recvQ <- newTBQueue $ fromIntegral maxQuestions
+
+ questions <- M.new
+ answers <- M.new
+ exports <- M.new
+ imports <- M.new
+
+ embargos <- M.new
+ pendingCallbacks <- newTQueue
+
+ let conn' = Conn'
+ { supervisor = sup
+ , questionIdPool
+ , exportIdPool
+ , recvQ
+ , sendQ
+ , questions
+ , answers
+ , exports
+ , imports
+ , embargos
+ , pendingCallbacks
+ , bootstrap
+ }
+ liveState <- newTVar (Live conn')
+ let conn = Conn
+ { stableName
+ , debugMode
+ , liveState
+ }
+ pure (conn, conn')
+ runConn (conn, conn') = do
+ result <- try $
+ ( coordinator conn
+ `concurrently_` sendLoop transport conn'
+ `concurrently_` recvLoop transport conn'
+ `concurrently_` callbacksLoop conn'
+ ) `race_`
+ useBootstrap conn conn'
+ case result of
+ Left (SentAbort e) -> do
+ -- We need to actually send it:
+ rawMsg <- createPure maxBound $ valueToMsg $ R.Message'abort e
+ void $ timeout 1000000 $ sendMsg transport rawMsg
+ throwIO $ SentAbort e
+ Left e ->
+ throwIO e
+ Right _ ->
+ pure ()
+ stopConn
+ ( conn@Conn{liveState}
+ , conn'@Conn'{questions, exports, embargos}
+ ) = do
+ atomically $ do
+ let walk table = flip ListT.traverse_ (M.listT table)
+ -- drop the bootstrap interface:
+ case bootstrap conn' of
+ Just (Client (Just client')) -> dropConnExport conn client'
+ _ -> pure ()
+ -- Remove everything from the exports table:
+ walk exports $ \(_, EntryE{client}) ->
+ dropConnExport conn client
+ -- Outstanding questions should all throw disconnected:
+ walk questions $ \(QAId qid, entry) ->
+ let raiseDisconnected onReturn =
+ mapQueueSTM conn' onReturn $ R.Return
+ { answerId = qid
+ , releaseParamCaps = False
+ , union' = R.Return'exception eDisconnected
+ }
+ in case entry of
+ NewQA{onReturn} -> raiseDisconnected onReturn
+ HaveFinish{onReturn} -> raiseDisconnected onReturn
+ _ -> pure ()
+ -- same thing with embargos:
+ walk embargos $ \(_, fulfiller) ->
+ breakPromiseSTM fulfiller eDisconnected
+ -- mark the connection as dead, making the live state inaccessible:
+ writeTVar liveState Dead
+ -- Make sure any pending callbacks get run. This is important, since
+ -- some of these do things like raise disconnected exceptions.
+ --
+ -- FIXME: there's a race condition that we're not dealing with:
+ -- if the callbacks loop is killed between dequeuing an action and
+ -- performing it that action will be lost.
+ flushCallbacks conn'
+ useBootstrap conn conn' = case withBootstrap of
+ Nothing ->
+ forever $ threadDelay maxBound
+ Just f ->
+ atomically (requestBootstrap conn) >>= f (supervisor conn')
+
+
+-- | A pool of ids; used when choosing identifiers for questions and exports.
+newtype IdPool = IdPool (TVar [Word32])
+
+-- | @'newIdPool' size@ creates a new pool of ids, with @size@ available ids.
+newIdPool :: Word32 -> STM IdPool
+newIdPool size = IdPool <$> newTVar [0..size-1]
+
+-- | Get a new id from the pool. Retries if the pool is empty.
+newId :: IdPool -> STM Word32
+newId (IdPool pool) = readTVar pool >>= \case
+ [] -> retry
+ (id:ids) -> do
+ writeTVar pool $! ids
+ pure id
+
+-- | Return an id to the pool.
+freeId :: IdPool -> Word32 -> STM ()
+freeId (IdPool pool) id = modifyTVar' pool (id:)
+
+-- | An entry in our questions or answers table.
+data EntryQA
+ -- | An entry for which we have neither sent/received a finish, nor
+ -- a return. Contains two sets of callbacks, to invoke on each type
+ -- of message.
+ = NewQA
+ { onFinish :: SnocList (R.Finish -> STM ())
+ , onReturn :: SnocList (R.Return -> STM ())
+ }
+ -- | An entry for which we've sent/received a return, but not a finish.
+ -- Contains the return message, and a set of callbacks to invoke on the
+ -- finish.
+ | HaveReturn
+ { returnMsg :: R.Return
+ , onFinish :: SnocList (R.Finish -> STM ())
+ }
+ -- | An entry for which we've sent/received a finish, but not a return.
+ -- Contains the finish message, and a set of callbacks to invoke on the
+ -- return.
+ | HaveFinish
+ { finishMsg :: R.Finish
+ , onReturn :: SnocList (R.Return -> STM ())
+ }
+
+
+-- | An entry in our imports table.
+data EntryI = EntryI
+ { localRc :: Rc ()
+ -- ^ A refcount cell with a finalizer attached to it; when the finalizer
+ -- runs it will remove this entry from the table and send a release
+ -- message to the remote vat.
+ , remoteRc :: !Word32
+ -- ^ The reference count for this object as understood by the remote
+ -- vat. This tells us what to send in the release message's count field.
+ , proxies :: ExportMap
+ -- ^ See Note [proxies]
+ --
+ , promiseState :: Maybe
+ ( TVar PromiseState
+ , TmpDest -- origTarget field. TODO(cleanup): clean this up a bit.
+ )
+ -- ^ If this entry is a promise, this will contain the state of that
+ -- promise, so that it may be used to create PromiseClients and
+ -- update the promise when it resolves.
+ }
+
+-- | An entry in our exports table.
+data EntryE = EntryE
+ { client :: Client'
+ -- ^ The client. We cache it in the table so there's only one object
+ -- floating around, which lets us attach a finalizer without worrying
+ -- about it being run more than once.
+ , refCount :: !Word32
+ -- ^ The refcount for this entry. This lets us know when we can drop
+ -- the entry from the table.
+ }
+
+-- | Types which may be converted to and from 'Client's. Typically these
+-- will be simple type wrappers for capabilities.
+class IsClient a where
+ -- | Convert a value to a client.
+ toClient :: a -> Client
+ -- | Convert a client to a value.
+ fromClient :: Client -> a
+
+instance Show Client where
+ show (Client Nothing) = "nullClient"
+ show _ = "({- capability; not statically representable -})"
+
+-- | A reference to a capability, which may be live either in the current vat
+-- or elsewhere. Holding a client affords making method calls on a capability
+-- or modifying the local vat's reference count to it.
+newtype Client =
+ -- We wrap the real client in a Maybe, with Nothing representing a 'null'
+ -- capability.
+ Client (Maybe Client')
+ deriving(Eq)
+
+-- | A non-null client.
+data Client'
+ -- | A client pointing at a capability local to our own vat.
+ = LocalClient
+ { exportMap :: ExportMap
+ -- ^ Record of what export IDs this client has on different remote
+ -- connections.
+ , qCall :: Rc (Server.CallInfo -> STM ())
+ -- ^ Queue a call for the local capability to handle. This is wrapped
+ -- in a reference counted cell, whose finalizer stops the server.
+ , finalizerKey :: Fin.Cell ()
+ -- ^ Finalizer key; when this is collected, qCall will be released.
+ }
+ -- | A client which will resolve to some other capability at
+ -- some point.
+ | PromiseClient
+ { pState :: TVar PromiseState
+ -- ^ The current state of the promise; the indirection allows
+ -- the promise to be updated.
+ , exportMap :: ExportMap
+
+ , origTarget :: TmpDest
+ -- ^ The original target of this promise, before it was resolved.
+ -- (if it is still in the pending state, it will match the TmpDest
+ -- stored there).
+ --
+ -- FIXME: if this is an ImportDest, by holding on to this we actually
+ -- leak the cap.
+ }
+ -- | A client which points to a (resolved) capability in a remote vat.
+ | ImportClient (Fin.Cell ImportRef)
+
+-- | The current state of a 'PromiseClient'.
+data PromiseState
+ -- | The promise is fully resolved.
+ = Ready
+ { target :: Client
+ -- ^ Capability to which the promise resolved.
+ }
+ -- | The promise has resolved, but is waiting on a Disembargo message
+ -- before it is safe to send it messages.
+ | Embargo
+ { callBuffer :: TQueue Server.CallInfo
+ -- ^ A queue in which to buffer calls while waiting for the
+ -- disembargo.
+ }
+ -- | The promise has not yet resolved.
+ | Pending
+ { tmpDest :: TmpDest
+ -- ^ A temporary destination to send calls, while we wait for the
+ -- promise to resolve.
+ }
+ -- | The promise resolved to an exception.
+ | Error R.Exception
+
+-- | A temporary destination for calls on an unresolved promise.
+data TmpDest
+ -- | A destination that is local to this vat.
+ = LocalDest LocalDest
+ -- | A destination in another vat.
+ | RemoteDest RemoteDest
+
+newtype LocalDest
+ -- | Queue the calls in a buffer.
+ = LocalBuffer { callBuffer :: TQueue Server.CallInfo }
+
+data RemoteDest
+ -- | Send call messages to a remote vat, targeting the results
+ -- of an outstanding question.
+ = AnswerDest
+ { conn :: Conn
+ -- ^ The connection to the remote vat.
+ , answer :: PromisedAnswer
+ -- ^ The answer to target.
+ }
+ -- | Send call messages to a remote vat, targeting an entry in our
+ -- imports table.
+ | ImportDest (Fin.Cell ImportRef)
+
+-- | A reference to a capability in our import table/a remote vat's export
+-- table.
+data ImportRef = ImportRef
+ { conn :: Conn
+ -- ^ The connection to the remote vat.
+ , importId :: !IEId
+ -- ^ The import id for this capability.
+ , proxies :: ExportMap
+ -- ^ Export ids to use when this client is passed to a vat other than
+ -- the one identified by 'conn'. See Note [proxies]
+ }
+
+-- Ideally we could just derive these, but stm-containers doesn't have Eq
+-- instances, so neither does ExportMap. not all of the fields are actually
+-- necessary to check equality though. See also
+-- https://github.com/nikita-volkov/stm-hamt/pull/1
+instance Eq ImportRef where
+ ImportRef { conn=cx, importId=ix } == ImportRef { conn=cy, importId=iy } =
+ cx == cy && ix == iy
+instance Eq Client' where
+ LocalClient { qCall = x } == LocalClient { qCall = y } =
+ x == y
+ PromiseClient { pState = x } == PromiseClient { pState = y } =
+ x == y
+ ImportClient x == ImportClient y =
+ x == y
+ _ == _ =
+ False
+
+
+-- | an 'ExportMap' tracks a mapping from connections to export IDs; it is
+-- used to ensure that we re-use export IDs for capabilities when passing
+-- them to remote vats. This used for locally hosted capabilities, but also
+-- by proxied imports (see Note [proxies]).
+newtype ExportMap = ExportMap (M.Map Conn IEId)
+
+-- MsgTarget and PromisedAnswer correspond to the similarly named types in
+-- rpc.capnp, except:
+--
+-- * They use our newtype wrappers for ids
+-- * They don't have unknown variants
+-- * PromisedAnswer's transform field is just a list of pointer offsets,
+-- rather than a union with no other actually-useful variants.
+-- * PromisedAnswer's transform field is a SnocList, efficient appending.
+data MsgTarget
+ = ImportTgt !IEId
+ | AnswerTgt PromisedAnswer
+data PromisedAnswer = PromisedAnswer
+ { answerId :: !QAId
+ , transform :: SnocList Word16
+ }
+
+-- Note [proxies]
+-- ==============
+--
+-- It is possible to have multiple connections open at once, and pass around
+-- clients freely between them. Without level 3 support, this means that when
+-- we pass a capability pointing into Vat A to another Vat B, we must proxy it.
+--
+-- To achieve this, capabilities pointing into a remote vat hold an 'ExportMap',
+-- which tracks which export IDs we should be using to proxy the client on each
+-- connection.
+
+-- | Queue a call on a client.
+call :: Server.CallInfo -> Client -> STM ()
+call Server.CallInfo { response } (Client Nothing) =
+ breakPromiseSTM response eMethodUnimplemented
+call info@Server.CallInfo { response } (Client (Just client')) = case client' of
+ LocalClient { qCall } -> Rc.get qCall >>= \case
+ Just q ->
+ q info
+ Nothing ->
+ breakPromiseSTM response eDisconnected
+
+ PromiseClient { pState } -> readTVar pState >>= \case
+ Ready { target } ->
+ call info target
+
+ Embargo { callBuffer } ->
+ writeTQueue callBuffer info
+
+ Pending { tmpDest } -> case tmpDest of
+ LocalDest LocalBuffer { callBuffer } ->
+ writeTQueue callBuffer info
+
+ RemoteDest AnswerDest { conn, answer } ->
+ callRemote conn info $ AnswerTgt answer
+
+ RemoteDest (ImportDest (Fin.get -> ImportRef { conn, importId })) ->
+ callRemote conn info (ImportTgt importId)
+
+ Error exn ->
+ breakPromiseSTM response exn
+
+ ImportClient (Fin.get -> ImportRef { conn, importId }) ->
+ callRemote conn info (ImportTgt importId)
+
+-- | Send a call to a remote capability.
+callRemote :: Conn -> Server.CallInfo -> MsgTarget -> STM ()
+callRemote
+ conn
+ Server.CallInfo{ interfaceId, methodId, arguments, response }
+ target = do
+ conn'@Conn'{questions} <- getLive conn
+ qid <- newQuestion conn'
+ payload@R.Payload{capTable} <- makeOutgoingPayload conn arguments
+ sendPureMsg conn' $ R.Message'call def
+ { R.questionId = qaWord qid
+ , R.target = marshalMsgTarget target
+ , R.params = payload
+ , R.interfaceId = interfaceId
+ , R.methodId = methodId
+ }
+ -- save these in case the callee sends back releaseParamCaps = True in the return
+ -- message:
+ let paramCaps = catMaybes $ flip map (V.toList capTable) $ \case
+ R.CapDescriptor'senderHosted eid -> Just (IEId eid)
+ R.CapDescriptor'senderPromise eid -> Just (IEId eid)
+ _ -> Nothing
+ M.insert
+ NewQA
+ { onReturn = SnocList.singleton $ cbCallReturn paramCaps conn response
+ , onFinish = SnocList.empty
+ }
+ qid
+ questions
+
+-- | Callback to run when a return comes in that corresponds to a call
+-- we sent. Registered in callRemote. The first argument is a list of
+-- export IDs to release if the return message has releaseParamCaps = true.
+cbCallReturn :: [IEId] -> Conn -> Fulfiller RawMPtr -> R.Return -> STM ()
+cbCallReturn
+ paramCaps
+ conn
+ response
+ R.Return{ answerId, union', releaseParamCaps } = do
+ conn'@Conn'{answers} <- getLive conn
+ when releaseParamCaps $
+ traverse_ (releaseExport conn 1) paramCaps
+ case union' of
+ R.Return'exception exn ->
+ breakPromiseSTM response exn
+ R.Return'results R.Payload{ content } -> do
+ rawPtr <- createPure defaultLimit $ do
+ msg <- Message.newMessage Nothing
+ cerialize msg content
+ fulfillSTM response rawPtr
+ R.Return'canceled ->
+ breakPromiseSTM response $ eFailed "Canceled"
+
+ R.Return'resultsSentElsewhere ->
+ -- This should never happen, since we always set
+ -- sendResultsTo = caller
+ abortConn conn' $ eFailed $ mconcat
+ [ "Received Return.resultsSentElswhere for a call "
+ , "with sendResultsTo = caller."
+ ]
+
+ R.Return'takeFromOtherQuestion (QAId -> qid) ->
+ -- TODO(cleanup): we should be a little stricter; the protocol
+ -- requires that (1) each answer is only used this way once, and
+ -- (2) The question was sent with sendResultsTo set to 'yourself',
+ -- but we don't enforce either of these requirements.
+ subscribeReturn "answer" conn' answers qid $
+ cbCallReturn [] conn response
+
+ R.Return'acceptFromThirdParty _ ->
+ -- Note [Level 3]
+ abortConn conn' $ eUnimplemented
+ "This vat does not support level 3."
+ R.Return'unknown' ordinal ->
+ abortConn conn' $ eUnimplemented $
+ "Unknown return variant #" <> fromString (show ordinal)
+ finishQuestion conn' def
+ { R.questionId = answerId
+ , R.releaseResultCaps = False
+ }
+
+
+marshalMsgTarget :: MsgTarget -> R.MessageTarget
+marshalMsgTarget = \case
+ ImportTgt importId ->
+ R.MessageTarget'importedCap (ieWord importId)
+ AnswerTgt tgt ->
+ R.MessageTarget'promisedAnswer $ marshalPromisedAnswer tgt
+
+marshalPromisedAnswer :: PromisedAnswer -> R.PromisedAnswer
+marshalPromisedAnswer PromisedAnswer{ answerId, transform } =
+ R.PromisedAnswer
+ { R.questionId = qaWord answerId
+ , R.transform =
+ V.fromList $
+ map R.PromisedAnswer'Op'getPointerField $
+ toList transform
+ }
+
+unmarshalPromisedAnswer :: R.PromisedAnswer -> Either R.Exception PromisedAnswer
+unmarshalPromisedAnswer R.PromisedAnswer { questionId, transform } = do
+ idxes <- unmarshalOps (toList transform)
+ pure PromisedAnswer
+ { answerId = QAId questionId
+ , transform = SnocList.fromList idxes
+ }
+
+unmarshalOps :: [R.PromisedAnswer'Op] -> Either R.Exception [Word16]
+unmarshalOps [] = Right []
+unmarshalOps (R.PromisedAnswer'Op'noop:ops) =
+ unmarshalOps ops
+unmarshalOps (R.PromisedAnswer'Op'getPointerField i:ops) =
+ (i:) <$> unmarshalOps ops
+unmarshalOps (R.PromisedAnswer'Op'unknown' tag:_) =
+ Left $ eFailed $ "Unknown PromisedAnswer.Op: " <> fromString (show tag)
+
+
+-- | A null client. This is the only client value that can be represented
+-- statically. Throws exceptions in response to all method calls.
+nullClient :: Client
+nullClient = Client Nothing
+
+-- | Spawn a local server with its lifetime bound to the supervisor,
+-- and return a client for it. When the client is garbage collected,
+-- the server will be stopped (if it is still running).
+export :: Supervisor -> Server.ServerOps IO -> STM Client
+export sup ops = do
+ q <- TCloseQ.new
+ qCall <- Rc.new (TCloseQ.write q) (TCloseQ.close q)
+ exportMap <- ExportMap <$> M.new
+ finalizerKey <- Fin.newCell ()
+ let client' = LocalClient
+ { qCall
+ , exportMap
+ , finalizerKey
+ }
+ superviseSTM sup $ do
+ Fin.addFinalizer finalizerKey $ atomically $ Rc.release qCall
+ Server.runServer q ops
+ pure $ Client (Just client')
+
+clientMethodHandler :: Word64 -> Word16 -> Client -> Server.MethodHandler IO p r
+clientMethodHandler interfaceId methodId client =
+ Server.fromUntypedHandler $ Server.untypedHandler $
+ \arguments response -> atomically $ call Server.CallInfo{..} client
+
+-- | See Note [callbacks]
+callbacksLoop :: Conn' -> IO ()
+callbacksLoop Conn'{pendingCallbacks} = forever $ do
+ cbs <- atomically $ flushTQueue pendingCallbacks >>= \case
+ -- We need to make sure to block if there weren't any jobs, since
+ -- otherwise we'll busy loop, pegging the CPU.
+ [] -> retry
+ cbs -> pure cbs
+ sequence_ cbs
+
+-- Run the one iteration of the callbacks loop, without blocking.
+flushCallbacks :: Conn' -> IO ()
+flushCallbacks Conn'{pendingCallbacks} =
+ atomically (flushTQueue pendingCallbacks) >>= sequence_
+
+-- | 'sendLoop' shunts messages from the send queue into the transport.
+sendLoop :: Transport -> Conn' -> IO ()
+sendLoop transport Conn'{sendQ} =
+ forever $ atomically (readTBQueue sendQ) >>= sendMsg transport
+
+-- | 'recvLoop' shunts messages from the transport into the receive queue.
+recvLoop :: Transport -> Conn' -> IO ()
+recvLoop transport Conn'{recvQ} =
+ forever $ recvMsg transport >>= atomically . writeTBQueue recvQ
+
+-- | The coordinator processes incoming messages.
+coordinator :: Conn -> IO ()
+-- The logic here mostly routes messages to other parts of the code that know
+-- more about the objects in question; See Note [Organization] for more info.
+coordinator conn@Conn{debugMode} = forever $ atomically $ do
+ conn'@Conn'{recvQ} <- getLive conn
+ msg <- (readTBQueue recvQ >>= parseWithCaps conn)
+ `catchSTM`
+ (abortConn conn' . wrapException debugMode)
+ case msg of
+ R.Message'abort exn ->
+ handleAbortMsg conn exn
+ R.Message'unimplemented oldMsg ->
+ handleUnimplementedMsg conn oldMsg
+ R.Message'bootstrap bs ->
+ handleBootstrapMsg conn bs
+ R.Message'call call ->
+ handleCallMsg conn call
+ R.Message'return ret ->
+ handleReturnMsg conn ret
+ R.Message'finish finish ->
+ handleFinishMsg conn finish
+ R.Message'resolve res ->
+ handleResolveMsg conn res
+ R.Message'release release ->
+ handleReleaseMsg conn release
+ R.Message'disembargo disembargo ->
+ handleDisembargoMsg conn disembargo
+ _ ->
+ sendPureMsg conn' $ R.Message'unimplemented msg
+
+-- | 'parseWithCaps' parses a message, making sure to interpret its capability
+-- table. The latter bit is the difference between this and just calling
+-- 'msgToValue'; 'msgToValue' will leave all of the clients in the message
+-- null.
+parseWithCaps :: Conn -> ConstMsg -> STM R.Message
+parseWithCaps conn msg = do
+ pureMsg <- msgToValue msg
+ case pureMsg of
+ -- capabilities only appear in call and return messages, and in the
+ -- latter only in the 'results' variant. In the other cases we can
+ -- just leave the result alone.
+ R.Message'call R.Call{params=R.Payload{capTable}} ->
+ fixCapTable capTable conn msg >>= msgToValue
+ R.Message'return R.Return{union'=R.Return'results R.Payload{capTable}} ->
+ fixCapTable capTable conn msg >>= msgToValue
+ _ ->
+ pure pureMsg
+
+-- Each function handle*Msg handles a message of a particular type;
+-- 'coordinator' dispatches to these.
+
+handleAbortMsg :: Conn -> R.Exception -> STM ()
+handleAbortMsg _ exn =
+ throwSTM (ReceivedAbort exn)
+
+handleUnimplementedMsg :: Conn -> R.Message -> STM ()
+handleUnimplementedMsg conn msg = getLive conn >>= \conn' -> case msg of
+ R.Message'unimplemented _ ->
+ -- If the client itself doesn't handle unimplemented messages, that's
+ -- weird, but ultimately their problem.
+ pure ()
+ R.Message'abort _ ->
+ abortConn conn' $ eFailed $
+ "Your vat sent an 'unimplemented' message for an abort message " <>
+ "that its remote peer never sent. This is likely a bug in your " <>
+ "capnproto library."
+ _ ->
+ abortConn conn' $
+ eFailed "Received unimplemented response for required message."
+
+handleBootstrapMsg :: Conn -> R.Bootstrap -> STM ()
+handleBootstrapMsg conn R.Bootstrap{ questionId } = getLive conn >>= \conn' -> do
+ ret <- case bootstrap conn' of
+ Nothing ->
+ pure $ R.Return
+ { R.answerId = questionId
+ , R.releaseParamCaps = True -- Not really meaningful for bootstrap, but...
+ , R.union' =
+ R.Return'exception $
+ eFailed "No bootstrap interface for this connection."
+ }
+ Just client -> do
+ capDesc <- emitCap conn client
+ pure $ R.Return
+ { R.answerId = questionId
+ , R.releaseParamCaps = True -- Not really meaningful for bootstrap, but...
+ , R.union' =
+ R.Return'results R.Payload
+ -- XXX: this is a bit fragile; we're relying on
+ -- the encode step to pick the right index for
+ -- our capability.
+ { content = Just (Untyped.PtrCap client)
+ , capTable = V.singleton capDesc
+ }
+ }
+ M.focus
+ (Focus.alterM $ insertBootstrap conn' ret)
+ (QAId questionId)
+ (answers conn')
+ sendPureMsg conn' $ R.Message'return ret
+ where
+ insertBootstrap _ ret Nothing =
+ pure $ Just HaveReturn
+ { returnMsg = ret
+ , onFinish = SnocList.fromList
+ [ \R.Finish{releaseResultCaps} ->
+ case ret of
+ R.Return
+ { union' = R.Return'results R.Payload
+ { capTable = (V.toList -> [ R.CapDescriptor'receiverHosted (IEId -> eid)])
+ }
+ } ->
+ when releaseResultCaps $
+ releaseExport conn 1 eid
+ _ ->
+ pure ()
+ ]
+
+ }
+ insertBootstrap conn' _ (Just _) =
+ abortConn conn' $ eFailed "Duplicate question ID"
+
+handleCallMsg :: Conn -> R.Call -> STM ()
+handleCallMsg
+ conn
+ R.Call
+ { questionId
+ , target
+ , interfaceId
+ , methodId
+ , params=R.Payload{content, capTable}
+ }
+ = getLive conn >>= \conn'@Conn'{exports, answers} -> do
+ -- First, add an entry in our answers table:
+ insertNewAbort
+ "answer"
+ conn'
+ (QAId questionId)
+ NewQA
+ { onReturn = SnocList.empty
+ , onFinish = SnocList.fromList
+ [ \R.Finish{releaseResultCaps} ->
+ when releaseResultCaps $
+ for_ capTable $ \case
+ R.CapDescriptor'receiverHosted (IEId -> importId) ->
+ releaseExport conn 1 importId
+ _ ->
+ pure ()
+ ]
+ }
+ answers
+
+ -- Marshal the parameters to the call back into the low-level form:
+ callParams <- createPure defaultLimit $ do
+ msg <- Message.newMessage Nothing
+ cerialize msg content
+
+ -- Set up a callback for when the call is finished, to
+ -- send the return message:
+ fulfiller <- newCallbackSTM $ \case
+ Left e ->
+ returnAnswer conn' def
+ { R.answerId = questionId
+ , R.releaseParamCaps = False
+ , R.union' = R.Return'exception e
+ }
+ Right v -> do
+ content <- evalLimitT defaultLimit (decerialize v)
+ capTable <- genSendableCapTable conn content
+ returnAnswer conn' def
+ { R.answerId = questionId
+ , R.releaseParamCaps = False
+ , R.union' = R.Return'results def
+ { R.content = content
+ , R.capTable = capTable
+ }
+ }
+ -- Package up the info for the call:
+ let callInfo = Server.CallInfo
+ { interfaceId
+ , methodId
+ , arguments = callParams
+ , response = fulfiller
+ }
+ -- Finally, figure out where to send it:
+ case target of
+ R.MessageTarget'importedCap exportId ->
+ lookupAbort "export" conn' exports (IEId exportId) $
+ \EntryE{client} -> call callInfo $ Client $ Just client
+ R.MessageTarget'promisedAnswer R.PromisedAnswer { questionId = targetQid, transform } ->
+ let onReturn ret@R.Return{union'} =
+ case union' of
+ R.Return'exception _ ->
+ returnAnswer conn' ret { R.answerId = questionId }
+ R.Return'canceled ->
+ returnAnswer conn' ret { R.answerId = questionId }
+ R.Return'results R.Payload{content} ->
+ transformClient transform content conn' >>= call callInfo
+ R.Return'resultsSentElsewhere ->
+ -- our implementation should never actually do this, but
+ -- this way we don't have to change this if/when we
+ -- support the feature:
+ abortConn conn' $ eFailed $
+ "Tried to call a method on a promised answer that " <>
+ "returned resultsSentElsewhere"
+ R.Return'takeFromOtherQuestion otherQid ->
+ subscribeReturn "answer" conn' answers (QAId otherQid) onReturn
+ R.Return'acceptFromThirdParty _ ->
+ -- Note [Level 3]
+ error "BUG: our implementation unexpectedly used a level 3 feature"
+ R.Return'unknown' tag ->
+ error $
+ "BUG: our implemented unexpectedly returned unknown " ++
+ "result variant #" ++ show tag
+ in
+ subscribeReturn "answer" conn' answers (QAId targetQid) onReturn
+ R.MessageTarget'unknown' ordinal ->
+ abortConn conn' $ eUnimplemented $
+ "Unknown MessageTarget ordinal #" <> fromString (show ordinal)
+
+transformClient :: V.Vector R.PromisedAnswer'Op -> MPtr -> Conn' -> STM Client
+transformClient transform ptr conn =
+ case unmarshalOps (V.toList transform) >>= flip followPtrs ptr of
+ Left e ->
+ abortConn conn e
+ Right Nothing ->
+ pure nullClient
+ Right (Just (Untyped.PtrCap client)) ->
+ pure client
+ Right (Just _) ->
+ abortConn conn $ eFailed "Tried to call method on non-capability."
+
+-- | Follow a series of pointer indicies, returning the final value, or 'Left'
+-- with an error if any of the pointers in the chain (except the last one) is
+-- a non-null non struct.
+followPtrs :: [Word16] -> MPtr -> Either R.Exception MPtr
+followPtrs [] ptr =
+ Right ptr
+followPtrs (_:_) Nothing =
+ Right Nothing
+followPtrs (i:is) (Just (Untyped.PtrStruct (Untyped.Struct _ ptrs))) =
+ followPtrs is (Untyped.sliceIndex (fromIntegral i) ptrs)
+followPtrs (_:_) (Just _) =
+ Left (eFailed "Tried to access pointer field of non-struct.")
+
+handleReturnMsg :: Conn -> R.Return -> STM ()
+handleReturnMsg conn ret = getLive conn >>= \conn'@Conn'{questions} ->
+ updateQAReturn conn' questions "question" ret
+
+handleFinishMsg :: Conn -> R.Finish -> STM ()
+handleFinishMsg conn finish = getLive conn >>= \conn'@Conn'{answers} ->
+ updateQAFinish conn' answers "answer" finish
+
+handleResolveMsg :: Conn -> R.Resolve -> STM ()
+handleResolveMsg conn R.Resolve{promiseId, union'} =
+ getLive conn >>= \conn'@Conn'{imports} -> do
+ entry <- M.lookup (IEId promiseId) imports
+ case entry of
+ Nothing ->
+ -- This can happen if we dropped the promise, but the release
+ -- message is still in flight when the resolve message is sent.
+ case union' of
+ R.Resolve'cap (R.CapDescriptor'receiverHosted importId) ->
+ -- Send a release message for the resolved cap, since
+ -- we're not going to use it:
+ sendPureMsg conn' $ R.Message'release def
+ { R.id = importId
+ , R.referenceCount = 1
+ }
+ -- Note [Level 3]: do we need to do something with
+ -- thirdPartyHosted here?
+ _ -> pure ()
+ Just EntryI{ promiseState = Nothing } ->
+ -- This wasn't a promise! The remote vat has done something wrong;
+ -- abort the connection.
+ abortConn conn' $ eFailed $ mconcat
+ [ "Received a resolve message for export id #", fromString (show promiseId)
+ , ", but that capability is not a promise!"
+ ]
+ Just EntryI { promiseState = Just (tvar, tmpDest) } ->
+ case union' of
+ R.Resolve'cap cap -> do
+ client <- acceptCap conn cap
+ resolveClientClient tmpDest (writeTVar tvar) client
+ R.Resolve'exception exn ->
+ resolveClientExn tmpDest (writeTVar tvar) exn
+ R.Resolve'unknown' tag ->
+ abortConn conn' $ eUnimplemented $ mconcat
+ [ "Resolve variant #"
+ , fromString (show tag)
+ , " not understood"
+ ]
+
+handleReleaseMsg :: Conn -> R.Release -> STM ()
+handleReleaseMsg
+ conn
+ R.Release
+ { id=(IEId -> eid)
+ , referenceCount=refCountDiff
+ } =
+ releaseExport conn refCountDiff eid
+
+releaseExport :: Conn -> Word32 -> IEId -> STM ()
+releaseExport conn refCountDiff eid =
+ getLive conn >>= \conn'@Conn'{exports} ->
+ lookupAbort "export" conn' exports eid $
+ \EntryE{client, refCount=oldRefCount} ->
+ case compare oldRefCount refCountDiff of
+ LT ->
+ abortConn conn' $ eFailed $
+ "Received release for export with referenceCount " <>
+ "greater than our recorded total ref count."
+ EQ ->
+ dropConnExport conn client
+ GT ->
+ M.insert
+ EntryE
+ { client
+ , refCount = oldRefCount - refCountDiff
+ }
+ eid
+ exports
+
+handleDisembargoMsg :: Conn -> R.Disembargo -> STM ()
+handleDisembargoMsg conn d = getLive conn >>= go d
+ where
+ go
+ R.Disembargo { context=R.Disembargo'context'receiverLoopback (EmbargoId -> eid) }
+ conn'@Conn'{embargos}
+ = do
+ result <- M.lookup eid embargos
+ case result of
+ Nothing ->
+ abortConn conn' $ eFailed $
+ "No such embargo: " <> fromString (show $ embargoWord eid)
+ Just fulfiller -> do
+ queueSTM conn' (fulfillSTM fulfiller ())
+ M.delete eid embargos
+ freeEmbargo conn' eid
+ go
+ R.Disembargo{ target, context=R.Disembargo'context'senderLoopback embargoId }
+ conn'@Conn'{exports, answers}
+ = case target of
+ R.MessageTarget'importedCap exportId ->
+ lookupAbort "export" conn' exports (IEId exportId) $ \EntryE{ client } ->
+ disembargoPromise client
+ R.MessageTarget'promisedAnswer R.PromisedAnswer{ questionId, transform } ->
+ lookupAbort "answer" conn' answers (QAId questionId) $ \case
+ HaveReturn { returnMsg=R.Return{union'=R.Return'results R.Payload{content} } } ->
+ transformClient transform content conn' >>= \case
+ Client (Just client') -> disembargoClient client'
+ Client Nothing -> abortDisembargo "targets a null capability"
+ _ ->
+ abortDisembargo $
+ "does not target an answer which has resolved to a value hosted by"
+ <> " the sender."
+ R.MessageTarget'unknown' ordinal ->
+ abortConn conn' $ eUnimplemented $
+ "Unknown MessageTarget ordinal #" <> fromString (show ordinal)
+ where
+ disembargoPromise PromiseClient{ pState } = readTVar pState >>= \case
+ Ready (Client (Just client)) ->
+ disembargoClient client
+ Ready (Client Nothing) ->
+ abortDisembargo "targets a promise which resolved to null."
+ _ ->
+ abortDisembargo "targets a promise which has not resolved."
+ disembargoPromise _ =
+ abortDisembargo "targets something that is not a promise."
+
+ disembargoClient (ImportClient (Fin.get -> ImportRef {conn=targetConn, importId}))
+ | conn == targetConn =
+ sendPureMsg conn' $ R.Message'disembargo R.Disembargo
+ { context = R.Disembargo'context'receiverLoopback embargoId
+ , target = R.MessageTarget'importedCap (ieWord importId)
+ }
+ disembargoClient _ =
+ abortDisembargo $
+ "targets a promise which has not resolved to a capability"
+ <> " hosted by the sender."
+
+ abortDisembargo info =
+ abortConn conn' $ eFailed $ mconcat
+ [ "Disembargo #"
+ , fromString (show embargoId)
+ , " with context = senderLoopback "
+ , info
+ ]
+-- Note [Level 3]
+ go d conn' =
+ sendPureMsg conn' $ R.Message'unimplemented $ R.Message'disembargo d
+
+
+
+-- | Interpret the list of cap descriptors, and replace the message's capability
+-- table with the result.
+fixCapTable :: V.Vector R.CapDescriptor -> Conn -> ConstMsg -> STM ConstMsg
+fixCapTable capDescs conn msg = do
+ clients <- traverse (acceptCap conn) capDescs
+ pure $ Message.withCapTable clients msg
+
+lookupAbort
+ :: (Eq k, Hashable k, Show k)
+ => Text -> Conn' -> M.Map k v -> k -> (v -> STM a) -> STM a
+lookupAbort keyTypeName conn m key f = do
+ result <- M.lookup key m
+ case result of
+ Just val ->
+ f val
+ Nothing ->
+ abortConn conn $ eFailed $ mconcat
+ [ "No such "
+ , keyTypeName
+ , ": "
+ , fromString (show key)
+ ]
+
+-- | @'insertNewAbort' keyTypeName conn key value stmMap@ inserts a key into a
+-- map, aborting the connection if it is already present. @keyTypeName@ will be
+-- used in the error message sent to the remote vat.
+insertNewAbort :: (Eq k, Hashable k) => Text -> Conn' -> k -> v -> M.Map k v -> STM ()
+insertNewAbort keyTypeName conn key value =
+ M.focus
+ (Focus.alterM $ \case
+ Just _ ->
+ abortConn conn $ eFailed $
+ "duplicate entry in " <> keyTypeName <> " table."
+ Nothing ->
+ pure (Just value)
+ )
+ key
+
+-- | Generate a cap table describing the capabilities reachable from the given
+-- pointer. The capability table will be correct for any message where all of
+-- the capabilities are within the subtree under the pointer.
+--
+-- XXX: it's kinda gross that we're serializing the pointer just to collect
+-- this, then decerializing to put it in the larger adt, then reserializing
+-- again... at some point we'll probably want to overhaul much of this module
+-- for performance. This kind of thing is the motivation for #52.
+genSendableCapTable :: Conn -> MPtr -> STM (V.Vector R.CapDescriptor)
+genSendableCapTable conn ptr = do
+ rawPtr <- createPure defaultLimit $ do
+ msg <- Message.newMessage Nothing
+ cerialize msg ptr
+ genSendableCapTableRaw conn rawPtr
+
+genSendableCapTableRaw
+ :: Conn
+ -> Maybe (UntypedRaw.Ptr ConstMsg)
+ -> STM (V.Vector R.CapDescriptor)
+genSendableCapTableRaw _ Nothing = pure V.empty
+genSendableCapTableRaw conn (Just ptr) =
+ traverse
+ (emitCap conn)
+ (Message.getCapTable (UntypedRaw.message ptr))
+
+-- | Convert the pointer into a Payload, including a capability table for
+-- the clients in the pointer's cap table.
+makeOutgoingPayload :: Conn -> RawMPtr -> STM R.Payload
+makeOutgoingPayload conn rawContent = do
+ capTable <- genSendableCapTableRaw conn rawContent
+ content <- evalLimitT defaultLimit (decerialize rawContent)
+ pure R.Payload { content, capTable }
+
+sendPureMsg :: Conn' -> R.Message -> STM ()
+sendPureMsg Conn'{sendQ} msg =
+ createPure maxBound (valueToMsg msg) >>= writeTBQueue sendQ
+
+-- | Send a finish message, updating connection state and triggering
+-- callbacks as necessary.
+finishQuestion :: Conn' -> R.Finish -> STM ()
+finishQuestion conn@Conn'{questions} finish@R.Finish{questionId} = do
+ -- arrange for the question ID to be returned to the pool once
+ -- the return has also been received:
+ subscribeReturn "question" conn questions (QAId questionId) $ \_ ->
+ freeQuestion conn (QAId questionId)
+ sendPureMsg conn $ R.Message'finish finish
+ updateQAFinish conn questions "question" finish
+
+-- | Send a return message, update the corresponding entry in our
+-- answers table, and queue any registered callbacks. Calls 'error'
+-- if the answerId is not in the table, or if we've already sent a
+-- return for this answer.
+returnAnswer :: Conn' -> R.Return -> STM ()
+returnAnswer conn@Conn'{answers} ret = do
+ sendPureMsg conn $ R.Message'return ret
+ updateQAReturn conn answers "answer" ret
+
+-- TODO(cleanup): updateQAReturn/Finish have a lot in common; can we refactor?
+
+updateQAReturn :: Conn' -> M.Map QAId EntryQA -> Text -> R.Return -> STM ()
+updateQAReturn conn table tableName ret@R.Return{answerId} =
+ lookupAbort tableName conn table (QAId answerId) $ \case
+ NewQA{onFinish, onReturn} -> do
+ mapQueueSTM conn onReturn ret
+ M.insert
+ HaveReturn
+ { returnMsg = ret
+ , onFinish
+ }
+ (QAId answerId)
+ table
+ HaveFinish{onReturn} -> do
+ mapQueueSTM conn onReturn ret
+ M.delete (QAId answerId) table
+ HaveReturn{} ->
+ abortConn conn $ eFailed $
+ "Duplicate return message for " <> tableName <> " #"
+ <> fromString (show answerId)
+
+updateQAFinish :: Conn' -> M.Map QAId EntryQA -> Text -> R.Finish -> STM ()
+updateQAFinish conn table tableName finish@R.Finish{questionId} =
+ lookupAbort tableName conn table (QAId questionId) $ \case
+ NewQA{onFinish, onReturn} -> do
+ mapQueueSTM conn onFinish finish
+ M.insert
+ HaveFinish
+ { finishMsg = finish
+ , onReturn
+ }
+ (QAId questionId)
+ table
+ HaveReturn{onFinish} -> do
+ mapQueueSTM conn onFinish finish
+ M.delete (QAId questionId) table
+ HaveFinish{} ->
+ abortConn conn $ eFailed $
+ "Duplicate finish message for " <> tableName <> " #"
+ <> fromString (show questionId)
+
+-- | Update an entry in the questions or answers table to queue the given
+-- callback when the return message for that answer comes in. If the return
+-- has already arrived, the callback is queued immediately.
+--
+-- If the entry already has other callbacks registered, this callback is
+-- run *after* the others (see Note [callbacks]). Note that this is an
+-- important property, as it is necessary to preserve E-order if the
+-- callbacks are successive method calls on the returned object.
+subscribeReturn :: Text -> Conn' -> M.Map QAId EntryQA -> QAId -> (R.Return -> STM ()) -> STM ()
+subscribeReturn tableName conn table qaId onRet =
+ lookupAbort tableName conn table qaId $ \qa -> do
+ new <- go qa
+ M.insert new qaId table
+ where
+ go = \case
+ NewQA{onFinish, onReturn} ->
+ pure NewQA
+ { onFinish
+ , onReturn = SnocList.snoc onReturn onRet
+ }
+
+ HaveFinish{finishMsg, onReturn} ->
+ pure HaveFinish
+ { finishMsg
+ , onReturn = SnocList.snoc onReturn onRet
+ }
+
+ val@HaveReturn{returnMsg} -> do
+ queueSTM conn (onRet returnMsg)
+ pure val
+
+-- | Abort the connection, sending an abort message. This is only safe to call
+-- from within either the thread running the coordinator or the callback loop.
+abortConn :: Conn' -> R.Exception -> STM a
+abortConn _ e = throwSTM (SentAbort e)
+
+-- | Gets the live connection state, or throws disconnected if it is not live.
+getLive :: Conn -> STM Conn'
+getLive Conn{liveState} = readTVar liveState >>= \case
+ Live conn' -> pure conn'
+ Dead -> throwSTM eDisconnected
+
+-- | Performs an action with the live connection state. Does nothing if the
+-- connection is dead.
+whenLive :: Conn -> (Conn' -> STM ()) -> STM ()
+whenLive Conn{liveState} f = readTVar liveState >>= \case
+ Live conn' -> f conn'
+ Dead -> pure ()
+
+-- | Request the remote vat's bootstrap interface.
+requestBootstrap :: Conn -> STM Client
+requestBootstrap conn@Conn{liveState} = readTVar liveState >>= \case
+ Dead ->
+ pure nullClient
+ Live conn'@Conn'{questions} -> do
+ qid <- newQuestion conn'
+ let tmpDest = RemoteDest AnswerDest
+ { conn
+ , answer = PromisedAnswer
+ { answerId = qid
+ , transform = SnocList.empty
+ }
+ }
+ pState <- newTVar Pending { tmpDest }
+ sendPureMsg conn' $
+ R.Message'bootstrap def { R.questionId = qaWord qid }
+ M.insert
+ NewQA
+ { onReturn = SnocList.singleton $
+ resolveClientReturn tmpDest (writeTVar pState) conn' []
+ , onFinish = SnocList.empty
+ }
+ qid
+ questions
+ exportMap <- ExportMap <$> M.new
+ pure $ Client $ Just PromiseClient
+ { pState
+ , exportMap
+ , origTarget = tmpDest
+ }
+
+-- Note [resolveClient]
+-- ====================
+--
+-- There are several functions resolveClient*, each of which resolves a
+-- 'PromiseClient', which will previously have been in the 'Pending' state.
+-- Each function accepts three parameters: the 'TmpDest' that the
+-- pending promise had been targeting, a function for setting the new state,
+-- and a thing to resolve the promise to. The type of the latter is specific
+-- to each function.
+
+-- | Resolve a promised client to an exception. See Note [resolveClient]
+resolveClientExn :: TmpDest -> (PromiseState -> STM ()) -> R.Exception -> STM ()
+resolveClientExn tmpDest resolve exn = do
+ case tmpDest of
+ LocalDest LocalBuffer { callBuffer } -> do
+ calls <- flushTQueue callBuffer
+ traverse_
+ (\Server.CallInfo{response} ->
+ breakPromiseSTM response exn)
+ calls
+ RemoteDest AnswerDest {} ->
+ pure ()
+ RemoteDest (ImportDest _) ->
+ pure ()
+ resolve $ Error exn
+
+-- Resolve a promised client to a pointer. If it is a non-null non-capability
+-- pointer, it resolves to an exception. See Note [resolveClient]
+resolveClientPtr :: TmpDest -> (PromiseState -> STM ()) -> MPtr -> STM ()
+resolveClientPtr tmpDest resolve ptr = case ptr of
+ Nothing ->
+ resolveClientClient tmpDest resolve nullClient
+ Just (Untyped.PtrCap c) ->
+ resolveClientClient tmpDest resolve c
+ Just _ ->
+ resolveClientExn tmpDest resolve $
+ eFailed "Promise resolved to non-capability pointer"
+
+-- | Resolve a promised client to another client. See Note [resolveClient]
+resolveClientClient :: TmpDest -> (PromiseState -> STM ()) -> Client -> STM ()
+resolveClientClient tmpDest resolve (Client client) =
+ case (client, tmpDest) of
+ -- Remote resolved to local; we need to embargo:
+ ( Just LocalClient{}, RemoteDest dest ) ->
+ disembargoAndResolve dest
+ ( Just PromiseClient { origTarget=LocalDest _ }, RemoteDest dest) ->
+ disembargoAndResolve dest
+ ( Nothing, RemoteDest dest ) ->
+ -- It's not clear to me what we should actually do if the promise
+ -- resolves to nullClient, but this can be encoded at the protocol
+ -- level, so we have to deal with it. Possible options:
+ --
+ -- 1. Perhaps this is simply illegal, and we should send an abort?
+ -- 2. Treat it as resolving to a local promise, in which case we
+ -- need to send a disembargo as above.
+ -- 3. Treat is as resolving to a remote promise, in which case we
+ -- can't send an embargo.
+ --
+ -- (3) doesn't seem possible to implement quite correctly, since
+ -- if we just resolve to nullClient right away, further calls will
+ -- start returning exceptions before outstanding calls return -- we
+ -- really do want to send a disembargo, but we can't because the
+ -- protocol insists that we don't if the promise resolves to a
+ -- remote cap.
+ --
+ -- What we currently do is (2); I(zenhack) intend to ask for
+ -- clarification on the mailing list.
+ disembargoAndResolve dest
+
+ -- These cases are slightly subtle; despite resolving to a
+ -- client that points at a "remote" target, if it points into a
+ -- _different_ connection, we must be proxying it, so we treat
+ -- it as local and do a disembargo like above. We may need to
+ -- change this when we implement level 3, since third-party
+ -- handoff is a possibility; see Note [Level 3].
+ --
+ -- If it's pointing into the same connection, we don't need to
+ -- do a disembargo.
+ ( Just PromiseClient { origTarget=RemoteDest newDest }, RemoteDest oldDest )
+ | destConn newDest /= destConn oldDest ->
+ disembargoAndResolve oldDest
+ | otherwise ->
+ releaseAndResolve
+ ( Just (ImportClient (Fin.get -> ImportRef { conn=newConn })), RemoteDest oldDest )
+ | newConn /= destConn oldDest ->
+ disembargoAndResolve oldDest
+ | otherwise ->
+ releaseAndResolve
+
+ -- Local promises never need embargos; we can just forward:
+ ( _, LocalDest LocalBuffer { callBuffer } ) ->
+ flushAndResolve callBuffer
+ where
+ destConn AnswerDest { conn } = conn
+ destConn (ImportDest (Fin.get -> ImportRef { conn })) = conn
+ destTarget AnswerDest { answer } = AnswerTgt answer
+ destTarget (ImportDest (Fin.get -> ImportRef { importId })) = ImportTgt importId
+
+ releaseAndResolve = do
+ releaseTmpDest tmpDest
+ resolve $ Ready (Client client)
+
+ -- Flush the call buffer into the client's queue, and then pass the client
+ -- to resolve.
+ flushAndResolve callBuffer = do
+ flushTQueue callBuffer >>= traverse_ (`call` Client client)
+ resolve $ Ready (Client client)
+ flushAndRaise callBuffer e =
+ flushTQueue callBuffer >>=
+ traverse_ (\Server.CallInfo{response} -> breakPromiseSTM response e)
+ disembargoAndResolve dest@(destConn -> Conn{liveState}) =
+ readTVar liveState >>= \case
+ Live conn' -> do
+ callBuffer <- newTQueue
+ disembargo conn' (destTarget dest) $ \case
+ Right () ->
+ flushAndResolve callBuffer
+ Left e ->
+ flushAndRaise callBuffer e
+ resolve $ Embargo { callBuffer }
+ Dead ->
+ resolveClientExn tmpDest resolve eDisconnected
+
+-- | Send a (senderLoopback) disembargo to the given message target, and
+-- register the transaction to run when the corresponding receiverLoopback
+-- message is received.
+--
+-- The callback may be handed a 'Left' with a disconnected exception if
+-- the connection is dropped before the disembargo is echoed.
+disembargo :: Conn' -> MsgTarget -> (Either R.Exception () -> STM ()) -> STM ()
+disembargo conn@Conn'{embargos} tgt onEcho = do
+ callback <- newCallbackSTM onEcho
+ eid <- newEmbargo conn
+ M.insert callback eid embargos
+ sendPureMsg conn $ R.Message'disembargo R.Disembargo
+ { target = marshalMsgTarget tgt
+ , context = R.Disembargo'context'senderLoopback (embargoWord eid)
+ }
+
+-- Do any cleanup of a TmpDest; this should be called after resolving a
+-- pending promise.
+releaseTmpDest :: TmpDest -> STM ()
+releaseTmpDest (LocalDest LocalBuffer{}) = pure ()
+releaseTmpDest (RemoteDest AnswerDest { conn, answer=PromisedAnswer{ answerId } }) =
+ whenLive conn $ \conn' ->
+ finishQuestion conn' def
+ { R.questionId = qaWord answerId
+ , R.releaseResultCaps = False
+ }
+releaseTmpDest (RemoteDest (ImportDest _)) = pure ()
+
+-- | Resolve a promised client to the result of a return. See Note [resolveClient]
+--
+-- The [Word16] is a list of pointer indexes to follow from the result.
+resolveClientReturn :: TmpDest -> (PromiseState -> STM ()) -> Conn' -> [Word16] -> R.Return -> STM ()
+resolveClientReturn tmpDest resolve conn@Conn'{answers} transform R.Return { union' } = case union' of
+ -- TODO(cleanup) there is a lot of redundency betwen this and cbCallReturn; can
+ -- we refactor?
+ R.Return'exception exn ->
+ resolveClientExn tmpDest resolve exn
+ R.Return'results R.Payload{ content } ->
+ case followPtrs transform content of
+ Right v ->
+ resolveClientPtr tmpDest resolve v
+ Left e ->
+ resolveClientExn tmpDest resolve e
+
+ R.Return'canceled ->
+ resolveClientExn tmpDest resolve $ eFailed "Canceled"
+
+ R.Return'resultsSentElsewhere ->
+ -- Should never happen; we don't set sendResultsTo to anything other than
+ -- caller.
+ abortConn conn $ eFailed $ mconcat
+ [ "Received Return.resultsSentElsewhere for a call "
+ , "with sendResultsTo = caller."
+ ]
+
+ R.Return'takeFromOtherQuestion (QAId -> qid) ->
+ subscribeReturn "answer" conn answers qid $
+ resolveClientReturn tmpDest resolve conn transform
+
+ R.Return'acceptFromThirdParty _ ->
+ -- Note [Level 3]
+ abortConn conn $ eUnimplemented
+ "This vat does not support level 3."
+
+ R.Return'unknown' ordinal ->
+ abortConn conn $ eUnimplemented $
+ "Unknown return variant #" <> fromString (show ordinal)
+
+-- | Get the client's export ID for this connection, or allocate a new one if needed.
+-- If this is the first time this client has been exported on this connection,
+-- bump the refcount.
+getConnExport :: Conn -> Client' -> STM IEId
+getConnExport conn client = getLive conn >>= \conn'@Conn'{exports} -> do
+ let ExportMap m = clientExportMap client
+ val <- M.lookup conn m
+ case val of
+ Just eid -> do
+ addBumpExport eid client exports
+ pure eid
+
+ Nothing -> do
+ eid <- newExport conn'
+ addBumpExport eid client exports
+ M.insert eid conn m
+ pure eid
+
+-- | Remove export of the client on the connection. This entails removing it
+-- from the export id, removing the connection from the client's ExportMap,
+-- freeing the export id, and dropping the client's refcount.
+dropConnExport :: Conn -> Client' -> STM ()
+dropConnExport conn client' = do
+ let ExportMap eMap = clientExportMap client'
+ val <- M.lookup conn eMap
+ case val of
+ Just eid -> do
+ M.delete conn eMap
+ whenLive conn $ \conn'@Conn'{exports} -> do
+ M.delete eid exports
+ freeExport conn' eid
+ Nothing ->
+ error "BUG: tried to drop an export that doesn't exist."
+
+clientExportMap :: Client' -> ExportMap
+clientExportMap LocalClient{exportMap} = exportMap
+clientExportMap PromiseClient{exportMap} = exportMap
+clientExportMap (ImportClient (Fin.get -> ImportRef{proxies})) = proxies
+
+-- | insert the client into the exports table, bumping the refcount if it is
+-- already there. If a different client is already in the table at the same
+-- id, call 'error'.
+addBumpExport :: IEId -> Client' -> M.Map IEId EntryE -> STM ()
+addBumpExport exportId client =
+ M.focus (Focus.alter go) exportId
+ where
+ go Nothing = Just EntryE { client, refCount = 1 }
+ go (Just EntryE{ client = oldClient, refCount } )
+ | client /= oldClient =
+ error $
+ "BUG: addExportRef called with a client that is different " ++
+ "from what is already in our exports table."
+ | otherwise =
+ Just EntryE { client, refCount = refCount + 1 }
+
+-- | Generate a CapDescriptor, which we can sent to the connection's remote
+-- vat to identify client. In the process, this may allocate export ids, update
+-- reference counts, and so forth.
+emitCap :: Conn -> Client -> STM R.CapDescriptor
+emitCap _targetConn (Client Nothing) =
+ pure R.CapDescriptor'none
+emitCap targetConn (Client (Just client')) = case client' of
+ LocalClient{} ->
+ R.CapDescriptor'senderHosted . ieWord <$> getConnExport targetConn client'
+ PromiseClient{ pState } -> readTVar pState >>= \case
+ Pending { tmpDest = RemoteDest AnswerDest { conn, answer } }
+ | conn == targetConn ->
+ pure $ R.CapDescriptor'receiverAnswer (marshalPromisedAnswer answer)
+ Pending { tmpDest = RemoteDest (ImportDest (Fin.get -> ImportRef { conn, importId = IEId iid })) }
+ | conn == targetConn ->
+ pure $ R.CapDescriptor'receiverHosted iid
+ _ ->
+ R.CapDescriptor'senderPromise . ieWord <$> getConnExport targetConn client'
+ ImportClient (Fin.get -> ImportRef { conn=hostConn, importId })
+ | hostConn == targetConn ->
+ pure (R.CapDescriptor'receiverHosted (ieWord importId))
+ | otherwise ->
+ R.CapDescriptor'senderHosted . ieWord <$> getConnExport targetConn client'
+
+-- | 'acceptCap' is a dual of 'emitCap'; it derives a Client from a CapDescriptor
+-- received via the connection. May update connection state as necessary.
+acceptCap :: Conn -> R.CapDescriptor -> STM Client
+acceptCap conn cap = getLive conn >>= \conn' -> go conn' cap
+ where
+ go _ R.CapDescriptor'none = pure (Client Nothing)
+ go conn'@Conn'{imports} (R.CapDescriptor'senderHosted (IEId -> importId)) = do
+ entry <- M.lookup importId imports
+ case entry of
+ Just EntryI{ promiseState=Just _ } ->
+ let imp = fromString (show importId)
+ in abortConn conn' $ eFailed $
+ "received senderHosted capability #" <> imp <>
+ ", but the imports table says #" <> imp <> " is senderPromise."
+ Just ent@EntryI{ localRc, remoteRc, proxies } -> do
+ Rc.incr localRc
+ M.insert ent { localRc, remoteRc = remoteRc + 1 } importId imports
+ cell <- Fin.newCell ImportRef
+ { conn
+ , importId
+ , proxies
+ }
+ queueIO conn' $ Fin.addFinalizer cell $ atomically (Rc.decr localRc)
+ pure $ Client $ Just $ ImportClient cell
+
+ Nothing ->
+ Client . Just . ImportClient <$> newImport importId conn Nothing
+ go conn'@Conn'{imports} (R.CapDescriptor'senderPromise (IEId -> importId)) = do
+ entry <- M.lookup importId imports
+ case entry of
+ Just EntryI { promiseState=Nothing } ->
+ let imp = fromString (show importId)
+ in abortConn conn' $ eFailed $
+ "received senderPromise capability #" <> imp <>
+ ", but the imports table says #" <> imp <> " is senderHosted."
+ Just ent@EntryI { remoteRc, proxies, promiseState=Just (pState, origTarget) } -> do
+ M.insert ent { remoteRc = remoteRc + 1 } importId imports
+ pure $ Client $ Just PromiseClient
+ { pState
+ , exportMap = proxies
+ , origTarget
+ }
+ Nothing -> do
+ rec imp@(Fin.get -> ImportRef{proxies}) <- newImport importId conn (Just (pState, tmpDest))
+ let tmpDest = RemoteDest (ImportDest imp)
+ pState <- newTVar Pending { tmpDest }
+ pure $ Client $ Just PromiseClient
+ { pState
+ , exportMap = proxies
+ , origTarget = tmpDest
+ }
+ go conn'@Conn'{exports} (R.CapDescriptor'receiverHosted exportId) =
+ lookupAbort "export" conn' exports (IEId exportId) $
+ \EntryE{client} ->
+ pure $ Client $ Just client
+ go conn' (R.CapDescriptor'receiverAnswer pa) =
+ case unmarshalPromisedAnswer pa of
+ Left e ->
+ abortConn conn' e
+ Right pa ->
+ newLocalAnswerClient conn' pa
+ go conn' (R.CapDescriptor'thirdPartyHosted _) =
+ -- Note [Level 3]
+ abortConn conn' $ eUnimplemented
+ "thirdPartyHosted unimplemented; level 3 is not supported."
+ go conn' (R.CapDescriptor'unknown' tag) =
+ abortConn conn' $ eUnimplemented $
+ "Unimplemented CapDescriptor variant #" <> fromString (show tag)
+
+-- | Create a new entry in the imports table, with the given import id and
+-- 'promiseState', and return a corresponding ImportRef. When the ImportRef is
+-- garbage collected, the refcount in the table will be decremented.
+newImport :: IEId -> Conn -> Maybe (TVar PromiseState, TmpDest) -> STM (Fin.Cell ImportRef)
+newImport importId conn promiseState = getLive conn >>= \conn'@Conn'{imports} -> do
+ localRc <- Rc.new () $ releaseImport importId conn'
+ proxies <- ExportMap <$> M.new
+ let importRef = ImportRef
+ { conn
+ , importId
+ , proxies
+ }
+ M.insert EntryI
+ { localRc
+ , remoteRc = 1
+ , proxies
+ , promiseState
+ }
+ importId
+ imports
+ cell <- Fin.newCell importRef
+ queueIO conn' $ Fin.addFinalizer cell $ atomically (Rc.decr localRc)
+ pure cell
+
+-- | Release the identified import. Removes it from the table and sends a release
+-- message with the correct count.
+releaseImport :: IEId -> Conn' -> STM ()
+releaseImport importId conn'@Conn'{imports} = do
+ lookupAbort "imports" conn' imports importId $ \EntryI { remoteRc } ->
+ sendPureMsg conn' $ R.Message'release
+ R.Release
+ { id = ieWord importId
+ , referenceCount = remoteRc
+ }
+ M.delete importId imports
+
+-- | Create a new client targeting an object in our answers table.
+-- Important: in this case the 'PromisedAnswer' refers to a question we
+-- have recevied, not sent.
+newLocalAnswerClient :: Conn' -> PromisedAnswer -> STM Client
+newLocalAnswerClient conn@Conn'{answers} PromisedAnswer{ answerId, transform } = do
+ callBuffer <- newTQueue
+ let tmpDest = LocalDest $ LocalBuffer { callBuffer }
+ pState <- newTVar Pending { tmpDest }
+ subscribeReturn "answer" conn answers answerId $
+ resolveClientReturn
+ tmpDest
+ (writeTVar pState)
+ conn
+ (toList transform)
+ exportMap <- ExportMap <$> M.new
+ pure $ Client $ Just PromiseClient
+ { pState
+ , exportMap
+ , origTarget = tmpDest
+ }
+
+
+-- Note [Limiting resource usage]
+-- ==============================
+--
+-- N.B. much of this Note is future tense; the library is not yet robust against
+-- resource useage attacks.
+--
+-- We employ various strategies to prevent remote vats from causing excessive
+-- resource usage. In particular:
+--
+-- * We set a maximum size for incoming messages; this is in keeping with how
+-- we mitigate these concerns when dealing with plain capnp data (i.e. not
+-- rpc).
+-- * We set a limit on the total *size* of all messages from the remote vat that
+-- are currently being serviced. For example, if a Call message comes in,
+-- we note its size, and deduct it from the quota. Once we have sent a return
+-- and received a finish for this call, and thus can safely forget about it,
+-- we remove it from our answers table, and add its size back to the available
+-- quota.
+--
+-- Still TBD:
+--
+-- * We should come up with some way of guarding against too many intra-vat calls;
+-- depending on the object graph, it may be possible for an attacker to get us
+-- to "eat our own tail" so to speak.
+--
+-- Ideas:
+-- * Per-object bounded queues for messages
+-- * Global limit on intra-vat calls.
+--
+-- Right now I(zenhack) am more fond of the former.
+--
+-- * What should we actually do when limits are exceeded?
+--
+-- Possible strategies:
+-- * Block
+-- * Throw an 'overloaded' exception
+-- * Some combination of the two; block with a timeout, then throw.
+--
+-- If we just block, we need to make sure this doesn't hang the vat;
+-- we probably need a timeout at some level.
diff --git a/lib/Capnp/Rpc/Untyped.hs-boot b/lib/Capnp/Rpc/Untyped.hs-boot
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Rpc/Untyped.hs-boot
@@ -0,0 +1,8 @@
+module Capnp.Rpc.Untyped where
+
+data Client
+
+nullClient :: Client
+
+instance Eq Client
+instance Show Client
diff --git a/lib/Capnp/TraversalLimit.hs b/lib/Capnp/TraversalLimit.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/TraversalLimit.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{- |
+Module: 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 Capnp.TraversalLimit
+ ( MonadLimit(..)
+ , LimitT
+ , runLimitT
+ , evalLimitT
+ , execLimitT
+ , defaultLimit
+ ) where
+
+import Prelude hiding (fail)
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadThrow(throwM))
+import Control.Monad.Fail (MonadFail(..))
+import Control.Monad.IO.Class (MonadIO(..))
+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 Capnp.Bits (WordCount)
+import 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 :: WordCount -> 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 WordCount m a)
+ deriving(Functor, Applicative, Monad)
+
+-- | Run a 'LimitT', returning the value from the computation and the remaining
+-- traversal limit.
+runLimitT :: MonadThrow m => WordCount -> LimitT m a -> m (a, WordCount)
+runLimitT limit (LimitT stateT) = runStateT stateT limit
+
+-- | Run a 'LimitT', returning the value from the computation.
+evalLimitT :: MonadThrow m => WordCount -> LimitT m a -> m a
+evalLimitT limit (LimitT stateT) = evalStateT stateT limit
+
+-- | Run a 'LimitT', returning the remaining traversal limit.
+execLimitT :: MonadThrow m => WordCount -> LimitT m a -> m WordCount
+execLimitT limit (LimitT stateT) = execStateT stateT limit
+
+-- | A sensible default traversal limit. Currently 64 MiB.
+defaultLimit :: WordCount
+defaultLimit = (64 * 1024 * 1024) `div` 8
+
+------ 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
+
+instance MonadFail m => MonadFail (LimitT m) where
+ fail = lift . fail
+
+instance MonadIO m => MonadIO (LimitT m) where
+ liftIO = lift . liftIO
+
+------ 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/Capnp/Tutorial.hs b/lib/Capnp/Tutorial.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Tutorial.hs
@@ -0,0 +1,624 @@
+-- |
+-- Module: 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.
+--
+-- Each of the example programs described here can also be found in the @examples/@
+-- subdirectory in the source repository.
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+module Capnp.Tutorial (
+ -- * Overview
+ -- $overview
+
+ -- * Serialization
+ -- $serialization
+
+ -- ** High Level API
+ -- $highlevel
+
+ -- *** Example
+ -- $highlevel-example
+
+ -- *** Code Generation Rules
+ -- $highlevel-codegen-rules
+
+ -- ** Low Level API
+ -- $lowlevel
+
+ -- *** Example
+ -- $lowlevel-example
+
+ -- *** Write Support
+ -- $lowlevel-write
+
+ -- * RPC
+ -- $rpc
+ ) where
+
+-- So haddock references work:
+import System.IO (stdout)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+import Capnp
+
+import Capnp.Classes (FromStruct)
+
+-- $overview
+--
+-- This module provides an overview of the capnp library.
+
+-- $serialization
+--
+-- The serialization 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\/Gen\/Addressbook.hs
+-- * Capnp\/Gen\/Addressbook\/Pure.hs
+-- * Capnp\/Gen\/ById\/Xcd6db6afb4a0cf5c/Pure.hs
+-- * Capnp\/Gen\/ById\/Xcd6db6afb4a0cf5c.hs
+--
+-- The modules under @ById@ are an implementation detail.
+-- @Capnp\/Gen\/Addressbook.hs@ is generated code for use with the low level API.
+-- @Capnp\/Gen\/Addressbook\/Pure.hs@ is generated code for use with the high
+-- level API. The latter will export the following data declarations (cleaned up
+-- for readability).
+--
+-- > module Capnp.Gen.Addressbook.Pure 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 "Capnp" exposes the most frequently used
+-- functionality from the capnp package. We can write an address book
+-- message to standard output using the high-level API like so:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > -- Note that DuplicateRecordFields is usually needed, as the generated
+-- > -- code relys on it to resolve collisions in capnproto struct field
+-- > -- names:
+-- > {-# LANGUAGE DuplicateRecordFields #-}
+-- > import Capnp.Gen.Addressbook.Pure
+-- >
+-- > -- Note that Capnp re-exports `def`, as a convienence
+-- > import Capnp (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 Capnp (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
+-- "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
+-- "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.
+-- * Groups are treated mostly like structs, except that the data constructor
+-- (but not the type constructor) has an extra trailing single-quote. This
+-- is to avoid name collisions that would otherwise be possible.
+-- * 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
+-- @Capnp.Untyped.Pure@.
+-- * Interfaces generated associated type classes and client types; see
+-- the section on 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 "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.Gen.Addressbook
+-- > import 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:
+--
+-- > import Capnp.Gen.Addressbook
+-- >
+-- > import Capnp
+-- > ( MutMsg
+-- > , PureBuilder
+-- > , cerialize
+-- > , createPure
+-- > , defaultLimit
+-- > , index
+-- > , newMessage
+-- > , newRoot
+-- > , putMsg
+-- > )
+-- >
+-- > import qualified Data.Text as T
+-- >
+-- > main =
+-- > let Right msg = createPure defaultLimit buildMsg
+-- > in putMsg msg
+-- >
+-- > buildMsg :: PureBuilder s (MutMsg s)
+-- > 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
+-- >
+-- > pure msg
+
+-- $rpc
+--
+-- This package supports level 1 Cap'n Proto RPC. The tuotrial will demonstrate the most
+-- basic features of the RPC system with example: an echo server & client. For a larger
+-- example which demos more of the protocol's capabilities, see the calculator example
+-- in the source repository's @examples/@ directory.
+--
+-- Given the schema:
+--
+-- > @0xd0a87f36fa0182f5;
+-- >
+-- > interface Echo {
+-- > echo @0 (query :Text) -> (reply :Text);
+-- > }
+--
+-- In the low level module, the code generator generates a newtype wrapper called @Echo@
+-- around a capability.
+--
+-- Most of the interesting stuff is in the high-level module (but note that you can still
+-- do RPC using low-level serialization APIs). The code generator will create an API like
+-- (after a bit of cleanup):
+--
+-- > newtype Echo = Echo Client
+-- >
+-- > class MonadIO m => Echo'server_ m cap where
+-- > echo'echo :: cap -> Server.MethodHandler m Echo'echo'params Echo'echo'results
+-- >
+-- > instance Echo'server_ IO Echo
+-- >
+-- > export_Echo :: Echo'server_ IO a => Supervisors -> a -> STM Echo
+--
+-- The type @Echo@ is a handle to an object (possibly remote), which can be used to
+-- make method calls. It is a newtype wrapper around a 'Client', which provides
+-- similar facilities, but doesn't know about the schema.
+--
+-- To provide an implementation of the @Echo@ interface, you need an instance of the
+-- @Echo'server_@ type class. The @export_Echo@ function is used to convert such an
+-- instance into a handle to the object that can be passed around.
+--
+-- Each time you call @export_Function@, it creates a thread that handles incoming
+-- messages in sequence.
+--
+-- Note that capnproto does not have a notion of "clients" and "servers" in the
+-- traditional networking sense; the two sides of a connection are symmetric. In
+-- capnproto terminology, a "client" is a handle for calling methods, and a "server"
+-- is an object that handles methods -- but there may be many of either or both of
+-- these on each side of a connection.
+--
+-- Here is an an echo (networking) server using this interface:
+--
+-- > {-# LANGUAGE MultiParamTypeClasses #-}
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > import Network.Simple.TCP (serve)
+-- >
+-- > import Capnp (def, defaultLimit)
+-- > -- 'Capnp.Rpc' exposes the most commonly used parts of the RPC system:
+-- > import Capnp.Rpc
+-- > (ConnConfig(..), handleConn, pureHandler, socketTransport, toClient)
+-- >
+-- > import Capnp.Gen.Echo.Pure
+-- >
+-- > -- | A type to declare an instance on:
+-- > data MyEchoServer = MyEchoServer
+-- >
+-- > -- The main logic of an echo server:
+-- > instance Echo'server_ IO MyEchoServer where
+-- > -- Each method of an interface generates a corresponding
+-- > -- method in its type class. The name of the method is prefixed
+-- > -- with the name of the interface, so method bar on interface
+-- > -- Foo will be called foo'bar.
+-- > --
+-- > -- The type of a method is left abstract, and functions like
+-- > -- 'pureHandler' are used to construct method handlers; see the
+-- > -- "Handling method calls" section in the docs for 'Capnp.Rpc'.
+-- > echo'echo = pureHandler $ \MyEchoServer params ->
+-- > pure def { reply = query params }
+-- >
+-- > main :: IO ()
+-- > main = serve "localhost" "4000" $ \(sock, _addr) ->
+-- > -- once we get a network connection, we use 'handleConn' to start
+-- > -- the rpc subsystem on that connection. It takes a transport with
+-- > -- which to send messages, and a config.
+-- > handleConn (socketTransport sock defaultLimit) def
+-- > { getBootstrap = \sup ->
+-- > -- The only setting we override in this example is our
+-- > -- bootstrap interface. The bootstrap interface is a "default"
+-- > -- object that clients can request on startup. By default
+-- > -- there is none, here we provide a client for our echo server.
+-- > Just . toClient <$> export_Echo sup MyEchoServer
+-- > }
+--
+-- The echo client looks like:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > module Examples.Rpc.EchoClient (main) where
+-- >
+-- > import Network.Simple.TCP (connect)
+-- >
+-- > import Capnp (def, defaultLimit)
+-- > import Capnp.Rpc (ConnConfig(..), handleConn, socketTransport, wait, (?))
+-- >
+-- > import Capnp.Gen.Echo.Pure
+-- >
+-- > main :: IO ()
+-- > main = connect "localhost" "4000" $ \(sock, _addr) ->
+-- > handleConn (socketTransport sock defaultLimit) def
+-- > -- In this case, we leave 'getBootstrap' empty and set
+-- > -- 'withBootstrap', which will request the other side's
+-- > -- bootstrap interface. If a non-Nothing value is supplied for
+-- > -- 'withBootstrap', 'handleConn' will exit (and disconnect)
+-- > -- when it completes.
+-- > { withBootstrap = Just $ \_sup client ->
+-- > -- Clients also have instances of their server_ classes, so
+-- > -- can use these instances to call methods on the remote
+-- > -- object. The '?' is the message send operator.
+-- > --
+-- > -- The method call _immediately_ returns, yielding a promise
+-- > -- that will be fulfilled when the results of the call actually
+-- > -- arive. We use 'wait' to wait for the promise to resolve,
+-- > -- display the result to the user, and then exit.
+-- > echo'echo (Echo client) ? def { query = "Hello, World!" }
+-- > >>= wait
+-- > >>= print
+-- > }
diff --git a/lib/Capnp/Untyped.hs b/lib/Capnp/Untyped.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Untyped.hs
@@ -0,0 +1,926 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-|
+Module: 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 "Capnp.Message"), used as the underlying storage.
+-}
+module Capnp.Untyped
+ ( Ptr(..), List(..), Struct, ListOf, Cap
+ , dataSection, ptrSection
+ , getData, getPtr
+ , setData, setPtr
+ , copyStruct
+ , getClient
+ , get, index, length
+ , setIndex
+ , take
+ , rootPtr
+ , setRoot
+ , rawBytes
+ , ReadCtx
+ , RWCtx
+ , HasMessage(..), MessageDefault(..)
+ , allocStruct
+ , allocCompositeList
+ , allocList0
+ , allocList1
+ , allocList8
+ , allocList16
+ , allocList32
+ , allocList64
+ , allocListPtr
+ , appendCap
+
+ , TraverseMsg(..)
+ )
+ 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 Capnp.Address (OffsetError(..), WordAddr(..), pointerFrom)
+import Capnp.Bits
+ ( BitCount(..)
+ , ByteCount(..)
+ , Word1(..)
+ , WordCount(..)
+ , bitsToBytesCeil
+ , bytesToWordsCeil
+ , replaceBits
+ , wordsToBytes
+ )
+import Capnp.Pointer (ElementSize(..))
+import Capnp.TraversalLimit (MonadLimit(invoice))
+import Data.Mutable (Thaw(..))
+
+import qualified Capnp.Errors as E
+import qualified Capnp.Message as M
+import qualified 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 (Cap msg)
+ | 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 Capability in a message.
+data Cap msg = Cap msg !Word32
+
+-- | A struct value in a message.
+data Struct msg
+ = Struct
+ msg
+ !WordAddr -- Start of struct
+ !Word16 -- Data section size.
+ !Word16 -- Pointer section size.
+
+-- | 'TraverseMsg' is basically 'Traversable' from the prelude, but
+-- the intent is that rather than conceptually being a "container",
+-- the instance is a value backed by a message, and the point of the
+-- type class is to be able to apply transformations to the underlying
+-- message.
+--
+-- We don't just use 'Traversable' for this because while algebraically
+-- it makes sense, it would be very unintuitive to e.g. have the
+-- 'Traversable' instance for 'List' not traverse over the *elements*
+-- of the list.
+class TraverseMsg f where
+ tMsg :: Applicative m => (msgA -> m msgB) -> f msgA -> m (f msgB)
+
+instance TraverseMsg Ptr where
+ tMsg f = \case
+ PtrCap cap ->
+ PtrCap <$> tMsg f cap
+ PtrList l ->
+ PtrList <$> tMsg f l
+ PtrStruct s ->
+ PtrStruct <$> tMsg f s
+
+instance TraverseMsg Cap where
+ tMsg f (Cap msg n) = Cap <$> f msg <*> pure n
+
+instance TraverseMsg Struct where
+ tMsg f (Struct msg addr dataSz ptrSz) = Struct
+ <$> f msg
+ <*> pure addr
+ <*> pure dataSz
+ <*> pure ptrSz
+
+instance TraverseMsg List where
+ tMsg f = \case
+ List0 l -> List0 . unflip <$> tMsg f (FlipList l)
+ List1 l -> List1 . unflip <$> tMsg f (FlipList l)
+ List8 l -> List8 . unflip <$> tMsg f (FlipList l)
+ List16 l -> List16 . unflip <$> tMsg f (FlipList l)
+ List32 l -> List32 . unflip <$> tMsg f (FlipList l)
+ List64 l -> List64 . unflip <$> tMsg f (FlipList l)
+ ListPtr l -> ListPtr . unflipP <$> tMsg f (FlipListP l)
+ ListStruct l -> ListStruct . unflipS <$> tMsg f (FlipListS l)
+
+instance TraverseMsg NormalList where
+ tMsg f NormalList{..} = do
+ msg <- f nMsg
+ pure NormalList { nMsg = msg, .. }
+
+-------------------------------------------------------------------------------
+-- newtype wrappers for the purpose of implementing 'TraverseMsg'; these adjust
+-- the shape of 'ListOf' so that we can define an instance. We need a couple
+-- different wrappers depending on the shape of the element type.
+-------------------------------------------------------------------------------
+
+-- 'FlipList' wraps a @ListOf msg a@ where 'a' is of kind @*@.
+newtype FlipList a msg = FlipList { unflip :: ListOf msg a }
+
+-- 'FlipListS' wraps a @ListOf msg (Struct msg)@. We can't use 'FlipList' for
+-- our instances, because we need both instances of the 'msg' parameter to stay
+-- equal.
+newtype FlipListS msg = FlipListS { unflipS :: ListOf msg (Struct msg) }
+
+-- 'FlipListP' wraps a @ListOf msg (Maybe (Ptr msg))@. Pointers can't use
+-- 'FlipList' for the same reason as structs.
+newtype FlipListP msg = FlipListP { unflipP :: ListOf msg (Maybe (Ptr msg)) }
+
+-------------------------------------------------------------------------------
+-- 'TraverseMsg' instances for 'FlipList'
+-------------------------------------------------------------------------------
+
+instance TraverseMsg (FlipList ()) where
+ tMsg f (FlipList (ListOfVoid msg len)) = FlipList <$> (ListOfVoid <$> f msg <*> pure len)
+
+instance TraverseMsg (FlipList Bool) where
+ tMsg f (FlipList (ListOfBool nlist)) = FlipList . ListOfBool <$> tMsg f nlist
+
+instance TraverseMsg (FlipList Word8) where
+ tMsg f (FlipList (ListOfWord8 nlist)) = FlipList . ListOfWord8 <$> tMsg f nlist
+
+instance TraverseMsg (FlipList Word16) where
+ tMsg f (FlipList (ListOfWord16 nlist)) = FlipList . ListOfWord16 <$> tMsg f nlist
+
+instance TraverseMsg (FlipList Word32) where
+ tMsg f (FlipList (ListOfWord32 nlist)) = FlipList . ListOfWord32 <$> tMsg f nlist
+
+instance TraverseMsg (FlipList Word64) where
+ tMsg f (FlipList (ListOfWord64 nlist)) = FlipList . ListOfWord64 <$> tMsg f nlist
+
+-------------------------------------------------------------------------------
+-- 'TraverseMsg' instances for struct and pointer lists.
+-------------------------------------------------------------------------------
+
+instance TraverseMsg FlipListP where
+ tMsg f (FlipListP (ListOfPtr nlist)) = FlipListP . ListOfPtr <$> tMsg f nlist
+
+instance TraverseMsg FlipListS where
+ tMsg f (FlipListS (ListOfStruct tag size)) =
+ FlipListS <$> (ListOfStruct <$> tMsg f tag <*> pure size)
+
+-- helpers for applying tMsg to a @ListOf@.
+tFlip :: (TraverseMsg (FlipList a), Applicative m) => (msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
+tFlipS :: Applicative m => (msgA -> m msg) -> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
+tFlipP :: Applicative m => (msgA -> m msg) -> ListOf msgA (Maybe (Ptr msgA)) -> m (ListOf msg (Maybe (Ptr msg)))
+tFlip f list = unflip <$> tMsg f (FlipList list)
+tFlipS f list = unflipS <$> tMsg f (FlipListS list)
+tFlipP f list = unflipP <$> tMsg f (FlipListP list)
+
+-------------------------------------------------------------------------------
+-- Boilerplate 'Thaw' instances.
+--
+-- These all just call the underlying methods on the message, using 'TraverseMsg'.
+-------------------------------------------------------------------------------
+
+instance Thaw a => Thaw (Maybe a) where
+ type Mutable s (Maybe a) = Maybe (Mutable s a)
+
+ thaw = traverse thaw
+ freeze = traverse freeze
+ unsafeThaw = traverse unsafeThaw
+ unsafeFreeze = traverse unsafeFreeze
+
+instance Thaw msg => Thaw (Ptr msg) where
+ type Mutable s (Ptr msg) = Ptr (Mutable s msg)
+
+ thaw = tMsg thaw
+ freeze = tMsg freeze
+ unsafeThaw = tMsg unsafeThaw
+ unsafeFreeze = tMsg unsafeFreeze
+
+instance Thaw msg => Thaw (List msg) where
+ type Mutable s (List msg) = List (Mutable s msg)
+
+ thaw = tMsg thaw
+ freeze = tMsg freeze
+ unsafeThaw = tMsg unsafeThaw
+ unsafeFreeze = tMsg unsafeFreeze
+
+instance Thaw msg => Thaw (NormalList msg) where
+ type Mutable s (NormalList msg) = NormalList (Mutable s msg)
+
+ thaw = tMsg thaw
+ freeze = tMsg freeze
+ unsafeThaw = tMsg unsafeThaw
+ unsafeFreeze = tMsg unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg ()) where
+ type Mutable s (ListOf msg ()) = ListOf (Mutable s msg) ()
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg Bool) where
+ type Mutable s (ListOf msg Bool) = ListOf (Mutable s msg) Bool
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg Word8) where
+ type Mutable s (ListOf msg Word8) = ListOf (Mutable s msg) Word8
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg Word16) where
+ type Mutable s (ListOf msg Word16) = ListOf (Mutable s msg) Word16
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg Word32) where
+ type Mutable s (ListOf msg Word32) = ListOf (Mutable s msg) Word32
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg Word64) where
+ type Mutable s (ListOf msg Word64) = ListOf (Mutable s msg) Word64
+
+ thaw = tFlip thaw
+ freeze = tFlip freeze
+ unsafeThaw = tFlip unsafeThaw
+ unsafeFreeze = tFlip unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg (Struct msg)) where
+ type Mutable s (ListOf msg (Struct msg)) = ListOf (Mutable s msg) (Struct (Mutable s msg))
+
+ thaw = tFlipS thaw
+ freeze = tFlipS freeze
+ unsafeThaw = tFlipS unsafeThaw
+ unsafeFreeze = tFlipS unsafeFreeze
+
+instance Thaw msg => Thaw (ListOf msg (Maybe (Ptr msg))) where
+ type Mutable s (ListOf msg (Maybe (Ptr msg))) =
+ ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg)))
+
+ thaw = tFlipP thaw
+ freeze = tFlipP freeze
+ unsafeThaw = tFlipP unsafeThaw
+ unsafeFreeze = tFlipP unsafeFreeze
+
+instance Thaw msg => Thaw (Struct msg) where
+ type Mutable s (Struct msg) = Struct (Mutable s msg)
+
+ thaw = tMsg thaw
+ freeze = tMsg freeze
+ unsafeThaw = tMsg unsafeThaw
+ unsafeFreeze = tMsg unsafeFreeze
+
+-------------------------------------------------------------------------------
+
+-- | Types @a@ whose storage is owned by a message..
+class HasMessage a where
+ -- | The type of the messages containing @a@s.
+ type InMessage a
+
+ -- | Get the message in which the @a@ is stored.
+ message :: a -> InMessage a
+
+-- | 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 => MessageDefault a where
+ messageDefault :: InMessage a -> a
+
+instance HasMessage (Ptr msg) where
+ type InMessage (Ptr msg) = msg
+
+ message (PtrCap cap) = message cap
+ message (PtrList list) = message list
+ message (PtrStruct struct) = message struct
+
+instance HasMessage (Cap msg) where
+ type InMessage (Cap msg) = msg
+
+ message (Cap msg _) = msg
+
+instance HasMessage (Struct msg) where
+ type InMessage (Struct msg) = msg
+
+ message (Struct msg _ _ _) = msg
+
+instance MessageDefault (Struct msg) where
+ messageDefault msg = Struct msg (WordAt 0 0) 0 0
+
+instance HasMessage (List msg) where
+ type InMessage (List msg) = msg
+
+ message (List0 list) = message list
+ message (List1 list) = message list
+ message (List8 list) = message list
+ 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) where
+ type InMessage (ListOf msg a) = msg
+
+ 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 ()) where
+ messageDefault msg = ListOfVoid msg 0
+instance MessageDefault (ListOf msg (Struct msg)) where
+ messageDefault msg = ListOfStruct (messageDefault msg) 0
+instance MessageDefault (ListOf msg Bool) where
+ messageDefault msg = ListOfBool (messageDefault msg)
+instance MessageDefault (ListOf msg Word8) where
+ messageDefault msg = ListOfWord8 (messageDefault msg)
+instance MessageDefault (ListOf msg Word16) where
+ messageDefault msg = ListOfWord16 (messageDefault msg)
+instance MessageDefault (ListOf msg Word32) where
+ messageDefault msg = ListOfWord32 (messageDefault msg)
+instance MessageDefault (ListOf msg Word64) where
+ messageDefault msg = ListOfWord64 (messageDefault msg)
+instance MessageDefault (ListOf msg (Maybe (Ptr msg))) where
+ messageDefault msg = ListOfPtr (messageDefault msg)
+
+instance HasMessage (NormalList msg) where
+ type InMessage (NormalList msg) = msg
+
+ message = nMsg
+
+instance MessageDefault (NormalList msg) where
+ messageDefault msg = NormalList msg (WordAt 0 0) 0
+
+getClient :: ReadCtx m msg => Cap msg -> m M.Client
+getClient (Cap msg idx) = M.getCap msg (fromIntegral idx)
+
+-- | @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 (Cap 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 (Cap 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
+ 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 _ _ 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 :: RWCtx m s => a -> Int -> ListOf (M.MutMsg s) a -> m ()
+setIndex _ 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
+ Just p | message p /= message list -> do
+ newPtr <- copyPtr (message list) value
+ setIndex newPtr i list
+ Nothing -> setNIndex nlist 1 (P.serializePtr Nothing)
+ Just (PtrCap (Cap _ 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 _ _ 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 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."
+
+copyCap :: RWCtx m s => M.MutMsg s -> Cap (M.MutMsg s) -> m (Cap (M.MutMsg s))
+copyCap dest cap = getClient cap >>= appendCap dest
+
+copyPtr :: RWCtx m s => M.MutMsg s -> Maybe (Ptr (M.MutMsg s)) -> m (Maybe (Ptr (M.MutMsg s)))
+copyPtr _ Nothing = pure Nothing
+copyPtr dest (Just (PtrCap cap)) = Just . PtrCap <$> copyCap dest cap
+copyPtr dest (Just (PtrList src)) = Just . PtrList <$> copyList dest src
+copyPtr dest (Just (PtrStruct src)) = Just . PtrStruct <$> do
+ destStruct <- allocStruct
+ dest
+ (fromIntegral $ length (dataSection src))
+ (fromIntegral $ length (ptrSection src))
+ copyStruct destStruct src
+ pure destStruct
+
+copyList :: RWCtx m s => M.MutMsg s -> List (M.MutMsg s) -> m (List (M.MutMsg s))
+copyList dest src = case src of
+ List0 src -> List0 <$> allocList0 dest (length src)
+ List1 src -> List1 <$> copyNewListOf dest src allocList1
+ List8 src -> List8 <$> copyNewListOf dest src allocList8
+ List16 src -> List16 <$> copyNewListOf dest src allocList16
+ List32 src -> List32 <$> copyNewListOf dest src allocList32
+ List64 src -> List64 <$> copyNewListOf dest src allocList64
+ ListPtr src -> ListPtr <$> copyNewListOf dest src allocListPtr
+ ListStruct src -> ListStruct <$> do
+ destList <- allocCompositeList
+ dest
+ (structListDataCount src)
+ (structListPtrCount src)
+ (length src)
+ copyListOf destList src
+ pure destList
+
+copyNewListOf
+ :: RWCtx m s
+ => M.MutMsg s
+ -> ListOf (M.MutMsg s) a
+ -> (M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) a))
+ -> m (ListOf (M.MutMsg s) a)
+copyNewListOf destMsg src new = do
+ dest <- new destMsg (length src)
+ copyListOf dest src
+ pure dest
+
+
+copyListOf :: RWCtx m s => ListOf (M.MutMsg s) a -> ListOf (M.MutMsg s) a -> m ()
+copyListOf dest src =
+ forM_ [0..length src - 1] $ \i -> do
+ value <- index i src
+ setIndex value i dest
+
+-- | @'copyStruct' dest src@ copies the source struct to the destination struct.
+copyStruct :: RWCtx m s => Struct (M.MutMsg s) -> Struct (M.MutMsg s) -> m ()
+copyStruct dest src = do
+ -- We copy both the data and pointer sections from src to dest,
+ -- padding the tail of the destination section with zeros/null
+ -- 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:
+ copyListOf dest src
+ -- 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)
+
+-- | Get the size (in words) of a struct's data section.
+structDataCount :: Struct msg -> Word16
+structDataCount = fromIntegral . length . dataSection
+
+-- | Get the size of a struct's pointer section.
+structPtrCount :: Struct msg -> Word16
+structPtrCount = fromIntegral . length . ptrSection
+
+-- | Get the size (in words) of the data sections in a composite list.
+structListDataCount :: ListOf msg (Struct msg) -> Word16
+structListDataCount (ListOfStruct s _) = structDataCount s
+
+-- | Get the size of the pointer sections in a composite list.
+structListPtrCount :: ListOf msg (Struct msg) -> Word16
+structListPtrCount (ListOfStruct s _) = structPtrCount s
+
+-- | @'getData' i struct@ gets the @i@th word from the struct's data section,
+-- returning 0 if it is absent.
+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 $ fromIntegral $ bytesToWordsCeil (ByteCount 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' $ 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
+ }
+
+appendCap :: M.WriteCtx m s => M.MutMsg s -> M.Client -> m (Cap (M.MutMsg s))
+appendCap msg client = do
+ i <- M.appendCap msg client
+ pure $ Cap msg (fromIntegral i)
diff --git a/lib/Capnp/Untyped/Pure.hs b/lib/Capnp/Untyped/Pure.hs
new file mode 100644
--- /dev/null
+++ b/lib/Capnp/Untyped/Pure.hs
@@ -0,0 +1,225 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-|
+Module: Capnp.Untyped.Pure
+Description: high-level API for working with untyped Cap'N Proto values.
+
+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
+"Capnp.Untyped".
+-}
+module Capnp.Untyped.Pure
+ ( Slice(..)
+ , Ptr(..)
+ , 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 Capnp.Classes
+ (Cerialize(..), Decerialize(..), FromStruct(..), Marshal(..), ToPtr(..))
+import Internal.Gen.Instances ()
+
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
+import qualified Data.Vector as V
+
+-- | 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, Ord, Functor, Default, IsList)
+
+-- | A capnproto pointer type.
+data Ptr
+ = PtrStruct !Struct
+ | PtrList !List
+ | PtrCap !M.Client
+ deriving(Generic, Show, Eq)
+
+-- | A capnproto struct.
+data Struct = Struct
+ { structData :: Slice Word64
+ -- ^ The struct's data section
+ , structPtrs :: Slice (Maybe Ptr)
+ -- ^ The struct's pointer section
+ }
+ deriving(Generic, Show, 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 Ptr))
+ | ListStruct (ListOf Struct)
+ deriving(Generic, Show, 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
+
+-- | 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 FromStruct M.ConstMsg Struct where
+ fromStruct = decerialize
+
+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 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 Ptr) where
+ type Cerial msg (Maybe Ptr) = Maybe (U.Ptr msg)
+
+ decerialize Nothing = pure Nothing
+ decerialize (Just ptr) = Just <$> case ptr of
+ U.PtrCap cap -> PtrCap <$> U.getClient cap
+ U.PtrStruct struct -> PtrStruct <$> decerialize struct
+ U.PtrList list -> PtrList <$> decerialize list
+
+instance Cerialize (Maybe Ptr) where
+ cerialize _ Nothing = pure Nothing
+ cerialize msg (Just (PtrStruct struct)) = cerialize msg struct >>= toPtr msg
+ cerialize msg (Just (PtrList list)) = Just . U.PtrList <$> cerialize msg list
+ cerialize msg (Just (PtrCap cap)) = Just . U.PtrCap <$> U.appendCap msg cap
+
+-- | 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 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/Codec/Capnp.hs b/lib/Codec/Capnp.hs
--- a/lib/Codec/Capnp.hs
+++ b/lib/Codec/Capnp.hs
@@ -7,10 +7,10 @@
, getRoot
) where
-import Data.Capnp.Classes
+import Capnp.Classes
-import qualified Data.Capnp.Message as M
-import qualified Data.Capnp.Untyped as U
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
-- | 'newRoot' allocates and returns a new value inside the message, setting
-- it as the root object of the message.
diff --git a/lib/Data/Capnp.hs b/lib/Data/Capnp.hs
deleted file mode 100644
--- a/lib/Data/Capnp.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{- |
-Module: Data.Capnp
-Description: The most commonly used functionality in the capnp package.
-
-This module re-exports the most commonly used functionality from other modules in the
-library.
-
-Users getting acquainted with the library are *strongly* encouraged to read the
-"Data.Capnp.Tutorial" module before anything else.
--}
-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.MutMsg
- , Message.newMessage
-
- -- * Manipulating the root object of a message
- , Codec.getRoot
- , Codec.newRoot
- , Codec.setRoot
-
- -- * Marshalling data into and out of messages
- , Classes.Decerialize(..)
- , Classes.Cerialize(..)
-
- -- * IO
- , module Data.Capnp.IO
-
- -- * Type aliases for common contexts
- , Message.WriteCtx
- , Untyped.ReadCtx
- , Untyped.RWCtx
-
- -- * Converting between messages, Cap'N Proto values, and raw bytes
- , module Data.Capnp.Convert
-
- -- * Managing resource limits
- , module Data.Capnp.TraversalLimit
-
- -- * Freezing and thawing values
- , module Data.Mutable
-
- -- * Building messages in pure code
- , PureBuilder
- , createPure
-
- -- * Re-exported from "Data.Default", for convienence.
- , def
- ) where
-
-import Data.Default (def)
-
-import Data.Capnp.Convert
-import Data.Capnp.IO
-import Data.Capnp.TraversalLimit
-import Data.Mutable
-
-import Internal.BuildPure (PureBuilder, createPure)
-
-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
diff --git a/lib/Data/Capnp/Address.hs b/lib/Data/Capnp/Address.hs
deleted file mode 100644
--- a/lib/Data/Capnp/Address.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-|
-Module: Data.Capnp.Address
-Description: Utilities for manipulating addresses within capnproto messages.
-
-This module provides facilities for manipulating raw addresses within
-Cap'N Proto messages.
-
-This is a low level module that very few users will need to use directly.
--}
-{-# 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
- -- | The address of some data in the message.
- = WordAddr !WordAddr
- -- | The "address" of a capability.
- | 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
deleted file mode 100644
--- a/lib/Data/Capnp/Basics.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-|
-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).
-* Lists 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
deleted file mode 100644
--- a/lib/Data/Capnp/Basics/Pure.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/lib/Data/Capnp/Bits.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-{-|
-Module: Data.Capnp.Bits
-Description: Utilities for bitwhacking useful for capnproto.
-
-This module provides misc. utilities for bitwhacking that are useful
-in dealing with low-level details of the Cap'N Proto wire format.
-
-This is mostly an implementation detail; users are unlikely to need
-to use this module directly.
--}
-{-# 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
-
--- TODO: the only reason this module is in exposed-modules is so it can be
--- seen by the test suite. We should find a way to avoid this.
-
-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
deleted file mode 100644
--- a/lib/Data/Capnp/Classes.hs
+++ /dev/null
@@ -1,259 +0,0 @@
-{-# 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.
---
--- Anything that goes in the data section of a struct will have
--- an instance of this.
-class IsWord a where
- -- | Convert from a 64-bit words Truncates the word if the
- -- type has less than 64 bits.
- fromWord :: Word64 -> a
-
- -- | Convert to a 64-bit word.
- 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 marshaled 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 be 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/Convert.hs b/lib/Data/Capnp/Convert.hs
deleted file mode 100644
--- a/lib/Data/Capnp/Convert.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
-{-|
-Module: Data.Capnp.Convert
-Description: Convert between messages, typed capnproto values, and (lazy)bytestring(builders).
-
-This module provides various helper functions to convert between messages, types defined
-in capnproto schema (called "values" in the rest of this module's documentation),
-bytestrings (both lazy and strict), and bytestring builders.
-
-Note that not all conversions exist or necessarily make sense.
--}
-module Data.Capnp.Convert
- ( msgToBuilder
- , msgToLBS
- , msgToBS
- , msgToValue
- , bsToMsg
- , bsToValue
- , lbsToMsg
- , lbsToValue
- , valueToBuilder
- , valueToBS
- , valueToLBS
- , valueToMsg
- ) where
-
-import Control.Monad ((>=>))
-import Control.Monad.Catch (MonadThrow)
-import Data.Foldable (foldlM)
-import Data.Functor.Identity (runIdentity)
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Builder as BB
-import qualified Data.ByteString.Lazy as LBS
-
-import Data.Capnp.Classes
-
-import Codec.Capnp (getRoot, setRoot)
-import Data.Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT)
-import Data.Mutable (freeze)
-
-import qualified Data.Capnp.Message as M
-
--- | Compute a reasonable limit based on the size of a message. The limit
--- is the total number of words in all of the message's segments, multiplied
--- by 4 to provide provide a little slack for decoding default values.
-limitFromMsg :: (MonadThrow m, M.Message m msg) => msg -> m Int
-limitFromMsg msg = do
- messageWords <- countMessageWords
- pure (messageWords * 4)
- where
- countMessageWords = do
- segCount <- M.numSegs msg
- foldlM
- (\total i -> do
- words <- M.getSegment msg i >>= M.numWords
- pure (words + total)
- )
- 0
- [0..segCount - 1]
-
--- | Convert an immutable message to a bytestring 'BB.Builder'.
--- To convert a mutable message, 'freeze' it first.
-msgToBuilder :: M.ConstMsg -> BB.Builder
-msgToBuilder = runIdentity . M.encode
-
--- | Convert an immutable message to a lazy 'LBS.ByteString'.
--- To convert a mutable message, 'freeze' it first.
-msgToLBS :: M.ConstMsg -> LBS.ByteString
-msgToLBS = BB.toLazyByteString . msgToBuilder
-
--- | Convert an immutable message to a strict 'BS.ByteString'.
--- To convert a mutable message, 'freeze' it first.
-msgToBS :: M.ConstMsg -> BS.ByteString
-msgToBS = LBS.toStrict . msgToLBS
-
--- | Convert a message to a value.
-msgToValue :: (MonadThrow m, M.Message (LimitT m) msg, M.Message m msg, FromStruct msg a) => msg -> m a
-msgToValue msg = do
- limit <- limitFromMsg msg
- evalLimitT limit (getRoot msg)
-
--- | Convert a strict 'BS.ByteString' to a message.
-bsToMsg :: MonadThrow m => BS.ByteString -> m M.ConstMsg
-bsToMsg = M.decode
-
--- | Convert a strict 'BS.ByteString' to a value.
-bsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => BS.ByteString -> m a
-bsToValue = bsToMsg >=> msgToValue
-
--- | Convert a lazy 'LBS.ByteString' to a message.
-lbsToMsg :: MonadThrow m => LBS.ByteString -> m M.ConstMsg
-lbsToMsg = bsToMsg . LBS.toStrict
-
--- | Convert a lazy 'LBS.ByteString' to a value.
-lbsToValue :: (MonadThrow m, FromStruct M.ConstMsg a) => LBS.ByteString -> m a
-lbsToValue = bsToValue . LBS.toStrict
-
--- | Convert a value to a 'BS.Builder'.
-valueToBuilder :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BB.Builder
-valueToBuilder val = msgToBuilder <$> (valueToMsg val >>= freeze)
-
--- | Convert a value to a strict 'BS.ByteString'.
-valueToBS :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m BS.ByteString
-valueToBS = fmap LBS.toStrict . valueToLBS
-
--- | Convert a value to a lazy 'LBS.ByteString'.
-valueToLBS :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m LBS.ByteString
-valueToLBS = fmap BB.toLazyByteString . valueToBuilder
-
--- | Convert a value to a message.
-valueToMsg :: (MonadLimit m, M.WriteCtx m s, Cerialize s a, ToStruct (M.MutMsg s) (Cerial (M.MutMsg s) a)) => a -> m (M.MutMsg s)
-valueToMsg val = do
- msg <- M.newMessage
- ret <- cerialize msg val
- setRoot ret
- pure msg
diff --git a/lib/Data/Capnp/Errors.hs b/lib/Data/Capnp/Errors.hs
deleted file mode 100644
--- a/lib/Data/Capnp/Errors.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-|
-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
deleted file mode 100644
--- a/lib/Data/Capnp/GenHelpers.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{- |
-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 #-}
-{-# OPTIONS_HADDOCK hide #-}
-module Data.Capnp.GenHelpers where
-
-import Data.Bits
-import Data.Word
-
-import Data.Maybe (fromJust)
-
-import qualified Data.ByteString as BS
-
-import Data.Capnp.Bits
-
-import Data.Capnp (bsToMsg, evalLimitT)
-
-import qualified Data.Capnp.Classes as C
-import qualified Data.Capnp.Message as M
-import qualified Data.Capnp.Untyped as U
-
--- | @'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
-
--- | Get a pointer from a ByteString, where the root object is a struct with
--- one pointer, which is the pointer we will retrieve. This is only safe for
--- trusted inputs; it reads the message with a traversal limit of 'maxBound'
--- (and so is suseptable to denial of service attacks), and it calls 'error'
--- if decoding is not successful.
---
--- The purpose of this is for defining constants of pointer type from a schema.
-getPtrConst :: C.IsPtr M.ConstMsg a => BS.ByteString -> a
-getPtrConst bytes = fromJust $ do
- msg <- bsToMsg bytes
- evalLimitT maxBound $ U.rootPtr msg >>= U.getPtr 0 >>= C.fromPtr msg
diff --git a/lib/Data/Capnp/GenHelpers/Pure.hs b/lib/Data/Capnp/GenHelpers/Pure.hs
deleted file mode 100644
--- a/lib/Data/Capnp/GenHelpers/Pure.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_HADDOCK hide #-}
-{- |
-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 Data.Maybe (fromJust)
-
-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.Default' for any type that meets
--- the given constraints.
-defaultStruct :: (C.Decerialize a, C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg a)) => a
-defaultStruct =
- fromJust $
- evalLimitT maxBound $
- U.rootPtr M.empty >>= C.fromStruct >>= C.decerialize
-
-
--- | Convert a low-level constant to a high-level constant. This trusts the
--- input, using maxBound as the traversal limit and calling 'error' on
--- decoding failures. It's purpose is defining constants the high-level
--- modules.
-toPurePtrConst :: C.Decerialize a => C.Cerial M.ConstMsg a -> a
-toPurePtrConst = fromJust . evalLimitT maxBound . C.decerialize
diff --git a/lib/Data/Capnp/IO.hs b/lib/Data/Capnp/IO.hs
deleted file mode 100644
--- a/lib/Data/Capnp/IO.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{- |
-Module: Data.Capnp.IO
-Description: Utilities for reading and writing values to handles.
-
-This module provides utilities for reading and writing values to and
-from file 'Handle's.
--}
-{-# LANGUAGE FlexibleContexts #-}
-module Data.Capnp.IO
- ( hGetValue
- , getValue
- , hPutValue
- , putValue
- , M.hGetMsg
- , M.getMsg
- , M.hPutMsg
- , M.putMsg
- ) 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 Data.Mutable (Thaw(..))
-
-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.
---
--- It may throw a 'Data.Capnp.Errors.Error' if there is a problem decoding the message,
--- or an 'IOError' raised by the underlying IO libraries.
-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. If it throws an exception, it will be an 'IOError' raised by the
--- underlying IO libraries.
-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 <- 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
deleted file mode 100644
--- a/lib/Data/Capnp/Message.hs
+++ /dev/null
@@ -1,417 +0,0 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TypeFamilies #-}
-{-|
-Module: Data.Capnp.Message
-Description: Cap'N Proto messages
-
-This module provides support for working directly with Cap'N Proto messages.
--}
-module Data.Capnp.Message (
- -- * Reading and writing messages
- hPutMsg
- , hGetMsg
- , putMsg
- , getMsg
-
- -- * Limits on message size
- , maxSegmentSize
- , maxSegments
-
- -- * Converting between messages and 'ByteString's
- , encode
- , decode
-
- -- * Message type class
- , Message(..)
-
- -- * Immutable messages
- , empty
- , ConstMsg
-
- -- * Reading data from messages
- , getSegment
- , getWord
-
- -- * Mutable Messages
- , MutMsg
- , newMessage
-
- -- ** Allocating space in messages
- , alloc
- , allocInSeg
- , newSegment
-
- -- ** Modifying messages
- , setWord
- , setSegment
-
- , WriteCtx(..)
- ) 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.Maybe (fromJust)
-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.Generic.Mutable as GMV
-import qualified Data.Vector.Mutable as MV
-import qualified Data.Vector.Storable as SV
-import qualified Data.Vector.Storable.Mutable as SMV
-
-import Data.Capnp.Address (WordAddr(..))
-import Data.Capnp.Bits (WordCount(..), hi, lo)
-import Data.Capnp.TraversalLimit (LimitT, MonadLimit(invoice), evalLimitT)
-import Data.Mutable (Mutable(..))
-import Internal.AppendVec (AppendVec)
-import Internal.Util (checkIndex)
-
-import qualified Internal.AppendVec as AppendVec
-
-
--- | The maximum size of a segment supported by this libarary, in words.
-maxSegmentSize :: Int
-maxSegmentSize = 1 `shiftL` 28 -- 2 GiB.
-
--- | 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
-
--- | @'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 Monad m => Message m ConstMsg where
- newtype Segment ConstMsg = ConstSegment { constSegToVec :: SV.Vector Word64 }
-
- numSegs (ConstMsg vec) = pure $ V.length vec
- internalGetSeg (ConstMsg vec) i = 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 :: Monad m => ConstMsg -> m BB.Builder
-encode msg =
- -- We use Maybe as the MonadThrow instance required by
- -- writeMessage/toByteString, but we know this can't actually fail,
- -- so we ignore errors. TODO: we should get rid of the Monad constraint
- -- on this function and just have the tyep be ConstMsg -> BB.Builder,
- -- but that will have some cascading api effects, so we're deferring
- -- that for a bit.
- pure $ fromJust $ execWriterT $ writeMessage
- msg
- (tell . BB.word32LE)
- (toByteString >=> tell . BB.byteString)
-
--- | 'decodeSeg' decodes a message from a segment, treating the segment as if
--- it were raw bytes.
---
--- 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 traversal limit to avoid needing to do bounds checking
- -- here; since readMessage invoices the limit before reading, we can rely
- -- on it not to read past the end of the blob.
- --
- -- TODO: while this works, it means that we throw 'TraversalLimitError'
- -- on failure, which makes for a confusing API.
- 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@. If there is an exception,
--- it will be an 'IOError' raised by the underlying IO libraries.
-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.
-newtype MutMsg s = MutMsg (MutVar s (AppendVec MV.MVector s (Segment (MutMsg s))))
- deriving(Eq)
-
--- | 'WriteCtx' is the context needed for most write operations.
-type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m)
-
-instance (PrimMonad m, s ~ PrimState m) => Message m (MutMsg s) where
- newtype Segment (MutMsg s) = MutSegment (AppendVec SMV.MVector s Word64)
-
- numWords (MutSegment mseg) = pure $ GMV.length (AppendVec.getVector mseg)
- slice start len (MutSegment mseg) =
- pure $ MutSegment $ AppendVec.fromVector $
- SMV.slice start len (AppendVec.getVector mseg)
- read (MutSegment mseg) i = fromLE64 <$> SMV.read (AppendVec.getVector mseg) i
- fromByteString bytes = do
- vec <- constSegToVec <$> fromByteString bytes
- MutSegment . AppendVec.fromVector <$> SV.thaw vec
- toByteString mseg = do
- seg <- freeze mseg
- toByteString (seg :: Segment ConstMsg)
-
- numSegs (MutMsg segVar) = GMV.length . AppendVec.getVector <$> readMutVar segVar
- internalGetSeg (MutMsg segVar) i = do
- segs <- AppendVec.getVector <$> readMutVar segVar
- 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 segVar) segIndex seg = do
- segs <- AppendVec.getVector <$> readMutVar segVar
- MV.write segs segIndex seg
-
--- | @'write' segment index value@ writes a value to the 64-bit word
--- at the provided index. Consider using 'setWord' on the message,
--- instead of calling this directly.
-write :: WriteCtx m s => Segment (MutMsg s) -> Int -> Word64 -> m ()
-write (MutSegment seg) i val =
- SMV.write (AppendVec.getVector seg) i (toLE64 val)
-
--- | @'grow' segment amount@ grows the segment by the specified number
--- of 64-bit words. The original segment should not be used afterwards.
-grow :: WriteCtx m s => Segment (MutMsg s) -> Int -> m (Segment (MutMsg s))
-grow (MutSegment vec) amount =
- MutSegment <$> AppendVec.grow vec amount maxSegmentSize
-
--- | @'newSegment' msg sizeHint@ allocates a new, initially empty segment in
--- @msg@ with a capacity of @sizeHint@. It returns the a pair of the segment
--- number and the segment itself. Amortized O(1).
-newSegment :: WriteCtx m s => MutMsg s -> Int -> m (Int, Segment (MutMsg s))
-newSegment msg@(MutMsg segVar) sizeHint = do
- -- the next segment number will be equal to the *current* number of
- -- segments:
- segIndex <- numSegs msg
-
- -- make space for th new segment
- segs <- readMutVar segVar
- segs <- AppendVec.grow segs 1 maxSegments
- writeMutVar segVar segs
-
- newSeg <- MutSegment . AppendVec.makeEmpty <$> SMV.new sizeHint
- setSegment msg segIndex newSeg
- pure (segIndex, newSeg)
-
--- | 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 vec) <- getSegment msg segIndex
- let ret = WordAt
- { segIndex
- , wordIndex = WordCount $ GMV.length $ AppendVec.getVector vec
- }
- newSeg <- grow oldSeg size
- setSegment msg segIndex newSeg
- pure ret
-
--- | @'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 Thaw (Segment ConstMsg) where
- type Mutable s (Segment ConstMsg) = Segment (MutMsg s)
-
- thaw = thawSeg thaw
- unsafeThaw = thawSeg unsafeThaw
- freeze = freezeSeg freeze
- unsafeFreeze = freezeSeg unsafeFreeze
-
--- Helpers for @Segment ConstMsg@'s Thaw instance.
-thawSeg thaw (ConstSegment vec) =
- MutSegment <$> thaw (AppendVec.FrozenAppendVec vec)
-freezeSeg freeze (MutSegment mvec) =
- ConstSegment . AppendVec.getFrozenVector <$> freeze mvec
-
-instance Thaw ConstMsg where
- type Mutable s ConstMsg = MutMsg s
-
- thaw = thawMsg thaw
- unsafeThaw = thawMsg unsafeThaw
- freeze = freezeMsg freeze
- unsafeFreeze = freezeMsg unsafeFreeze
-
--- Helpers for ConstMsg's Thaw instance.
-thawMsg thaw (ConstMsg vec) = do
- segments <- V.mapM thaw vec >>= V.unsafeThaw
- MutMsg <$> newMutVar (AppendVec.fromVector segments)
-freezeMsg freeze msg = do
- len <- numSegs msg
- ConstMsg <$> V.generateM len (internalGetSeg msg >=> freeze)
diff --git a/lib/Data/Capnp/Pointer.hs b/lib/Data/Capnp/Pointer.hs
deleted file mode 100644
--- a/lib/Data/Capnp/Pointer.hs
+++ /dev/null
@@ -1,143 +0,0 @@
-{- |
-Module: Data.Capnp.Pointer
-Description: Support for parsing/serializing capnproto pointers
-
-This module provides support for parsing and serializing capnproto pointers.
-This is a low-level module; most users will not need to call it directly.
--}
-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/TraversalLimit.hs b/lib/Data/Capnp/TraversalLimit.hs
deleted file mode 100644
--- a/lib/Data/Capnp/TraversalLimit.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/lib/Data/Capnp/Tutorial.hs
+++ /dev/null
@@ -1,495 +0,0 @@
-{- |
-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 (stdout)
-
-import qualified Data.ByteString as BS
-import qualified Data.Text as T
-
-import Data.Capnp
-
-import Data.Capnp.Classes (FromStruct)
-
-{- $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" exposes the most frequently used
-functionality from the capnp package. We can write an address book
-message to standard output using the high-level API like so:
-
-> {-# LANGUAGE OverloadedStrings #-}
-> -- Note that DuplicateRecordFields is usually needed, as the generated
-> -- code relys on it to resolve collisions in capnproto struct field
-> -- names:
-> {-# LANGUAGE DuplicateRecordFields #-}
-> import Capnp.Addressbook.Pure
->
-> -- Note that Data.Capnp re-exports `def`, as a convienence
-> import Data.Capnp (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 (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:
-
-> import Capnp.Addressbook
->
-> import Data.Capnp
-> ( MutMsg
-> , PureBuilder
-> , cerialize
-> , createPure
-> , defaultLimit
-> , index
-> , newMessage
-> , newRoot
-> , putMsg
-> )
->
-> import qualified Data.Text as T
->
-> main =
-> let Right msg = createPure defaultLimit buildMsg
-> in putMsg msg
->
-> buildMsg :: PureBuilder s (MutMsg s)
-> 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
->
-> pure msg
--}
diff --git a/lib/Data/Capnp/Untyped.hs b/lib/Data/Capnp/Untyped.hs
deleted file mode 100644
--- a/lib/Data/Capnp/Untyped.hs
+++ /dev/null
@@ -1,893 +0,0 @@
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# 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 Data.Mutable (Thaw(..))
-
-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.
-
--- | 'TraverseMsg' is basically 'Traversable' from the prelude, but
--- the intent is that rather than conceptually being a "container",
--- the instance is a value backed by a message, and the point of the
--- type class is to be able to apply transformations to the underlying
--- message.
---
--- We don't just use 'Traversable' for this because while algebraically
--- it makes sense, it would be very surprising to users to e.g.
--- have the 'Traversable' instance for 'List' not traverse over the
--- *elements* of the list.
---
--- We also don't export this; it is mainly an implementation detail for
--- the 'Thaw' instances for these data types, which all just that/freeze
--- the underlying message.
-class TraverseMsg f where
- tMsg :: Applicative m => (msgA -> m msgB) -> f msgA -> m (f msgB)
-
-instance TraverseMsg Ptr where
- tMsg f = \case
- PtrCap msgA n ->
- PtrCap <$> f msgA <*> pure n
- PtrList l ->
- PtrList <$> tMsg f l
- PtrStruct s ->
- PtrStruct <$> tMsg f s
-
-instance TraverseMsg Struct where
- tMsg f (Struct msg addr dataSz ptrSz) = Struct
- <$> f msg
- <*> pure addr
- <*> pure dataSz
- <*> pure ptrSz
-
-instance TraverseMsg List where
- tMsg f = \case
- List0 l -> List0 . unflip <$> tMsg f (FlipList l)
- List1 l -> List1 . unflip <$> tMsg f (FlipList l)
- List8 l -> List8 . unflip <$> tMsg f (FlipList l)
- List16 l -> List16 . unflip <$> tMsg f (FlipList l)
- List32 l -> List32 . unflip <$> tMsg f (FlipList l)
- List64 l -> List64 . unflip <$> tMsg f (FlipList l)
- ListPtr l -> ListPtr . unflipP <$> tMsg f (FlipListP l)
- ListStruct l -> ListStruct . unflipS <$> tMsg f (FlipListS l)
-
-instance TraverseMsg NormalList where
- tMsg f NormalList{..} = do
- msg <- f nMsg
- pure NormalList { nMsg = msg, .. }
-
--------------------------------------------------------------------------------
--- newtype wrappers for the purpose of implementing 'TraverseMsg'; these adjust
--- the shape of 'ListOf' so that we can define an instance. We need a couple
--- different wrappers depending on the shape of the element type.
--------------------------------------------------------------------------------
-
--- 'FlipList' wraps a @ListOf msg a@ where 'a' is of kind @*@.
-newtype FlipList a msg = FlipList { unflip :: ListOf msg a }
-
--- 'FlipListS' wraps a @ListOf msg (Struct msg)@. We can't use 'FlipList' for
--- our instances, because we need both instances of the 'msg' parameter to stay
--- equal.
-newtype FlipListS msg = FlipListS { unflipS :: ListOf msg (Struct msg) }
-
--- 'FlipListP' wraps a @ListOf msg (Maybe (Ptr msg))@. Pointers can't use
--- 'FlipList' for the same reason as structs.
-newtype FlipListP msg = FlipListP { unflipP :: ListOf msg (Maybe (Ptr msg)) }
-
--------------------------------------------------------------------------------
--- 'TraverseMsg' instances for 'FlipList'
--------------------------------------------------------------------------------
-
-instance TraverseMsg (FlipList ()) where
- tMsg f (FlipList (ListOfVoid msg len)) = FlipList <$> (ListOfVoid <$> f msg <*> pure len)
-
-instance TraverseMsg (FlipList Bool) where
- tMsg f (FlipList (ListOfBool nlist)) = FlipList . ListOfBool <$> tMsg f nlist
-
-instance TraverseMsg (FlipList Word8) where
- tMsg f (FlipList (ListOfWord8 nlist)) = FlipList . ListOfWord8 <$> tMsg f nlist
-
-instance TraverseMsg (FlipList Word16) where
- tMsg f (FlipList (ListOfWord16 nlist)) = FlipList . ListOfWord16 <$> tMsg f nlist
-
-instance TraverseMsg (FlipList Word32) where
- tMsg f (FlipList (ListOfWord32 nlist)) = FlipList . ListOfWord32 <$> tMsg f nlist
-
-instance TraverseMsg (FlipList Word64) where
- tMsg f (FlipList (ListOfWord64 nlist)) = FlipList . ListOfWord64 <$> tMsg f nlist
-
--------------------------------------------------------------------------------
--- 'TraverseMsg' instances for struct and pointer lists.
--------------------------------------------------------------------------------
-
-instance TraverseMsg FlipListP where
- tMsg f (FlipListP (ListOfPtr nlist)) = FlipListP . ListOfPtr <$> tMsg f nlist
-
-instance TraverseMsg FlipListS where
- tMsg f (FlipListS (ListOfStruct tag size)) =
- FlipListS <$> (ListOfStruct <$> tMsg f tag <*> pure size)
-
--- helpers for applying tMsg to a @ListOf@.
-tFlip f list = unflip <$> tMsg f (FlipList list)
-tFlipS f list = unflipS <$> tMsg f (FlipListS list)
-tFlipP f list = unflipP <$> tMsg f (FlipListP list)
-
--------------------------------------------------------------------------------
--- Boilerplate 'Thaw' instances.
---
--- These all just call the underlying methods on the message, using 'TraverseMsg'.
--------------------------------------------------------------------------------
-
-instance Thaw msg => Thaw (Ptr msg) where
- type Mutable s (Ptr msg) = Ptr (Mutable s msg)
-
- thaw = tMsg thaw
- freeze = tMsg freeze
- unsafeThaw = tMsg unsafeThaw
- unsafeFreeze = tMsg unsafeFreeze
-
-instance Thaw msg => Thaw (List msg) where
- type Mutable s (List msg) = List (Mutable s msg)
-
- thaw = tMsg thaw
- freeze = tMsg freeze
- unsafeThaw = tMsg unsafeThaw
- unsafeFreeze = tMsg unsafeFreeze
-
-instance Thaw msg => Thaw (NormalList msg) where
- type Mutable s (NormalList msg) = NormalList (Mutable s msg)
-
- thaw = tMsg thaw
- freeze = tMsg freeze
- unsafeThaw = tMsg unsafeThaw
- unsafeFreeze = tMsg unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg ()) where
- type Mutable s (ListOf msg ()) = ListOf (Mutable s msg) ()
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg Bool) where
- type Mutable s (ListOf msg Bool) = ListOf (Mutable s msg) Bool
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg Word8) where
- type Mutable s (ListOf msg Word8) = ListOf (Mutable s msg) Word8
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg Word16) where
- type Mutable s (ListOf msg Word16) = ListOf (Mutable s msg) Word16
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg Word32) where
- type Mutable s (ListOf msg Word32) = ListOf (Mutable s msg) Word32
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg Word64) where
- type Mutable s (ListOf msg Word64) = ListOf (Mutable s msg) Word64
-
- thaw = tFlip thaw
- freeze = tFlip freeze
- unsafeThaw = tFlip unsafeThaw
- unsafeFreeze = tFlip unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg (Struct msg)) where
- type Mutable s (ListOf msg (Struct msg)) = ListOf (Mutable s msg) (Struct (Mutable s msg))
-
- thaw = tFlipS thaw
- freeze = tFlipS freeze
- unsafeThaw = tFlipS unsafeThaw
- unsafeFreeze = tFlipS unsafeFreeze
-
-instance Thaw msg => Thaw (ListOf msg (Maybe (Ptr msg))) where
- type Mutable s (ListOf msg (Maybe (Ptr msg))) =
- ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg)))
-
- thaw = tFlipP thaw
- freeze = tFlipP freeze
- unsafeThaw = tFlipP unsafeThaw
- unsafeFreeze = tFlipP unsafeFreeze
-
-instance Thaw msg => Thaw (Struct msg) where
- type Mutable s (Struct msg) = Struct (Mutable s msg)
-
- thaw = tMsg thaw
- freeze = tMsg freeze
- unsafeThaw = tMsg unsafeThaw
- unsafeFreeze = tMsg unsafeFreeze
-
--------------------------------------------------------------------------------
-
--- | Types @a@ whose storage is owned by a message..
-class HasMessage a where
- -- | The type of the messages containing @a@s.
- type InMessage a
-
- -- | Get the message in which the @a@ is stored.
- message :: a -> InMessage a
-
--- | 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 => MessageDefault a where
- messageDefault :: InMessage a -> a
-
-instance HasMessage (Ptr msg) where
- type InMessage (Ptr msg) = msg
-
- message (PtrCap msg _) = msg
- message (PtrList list) = message list
- message (PtrStruct struct) = message struct
-
-instance HasMessage (Struct msg) where
- type InMessage (Struct msg) = msg
-
- message (Struct msg _ _ _) = msg
-
-instance MessageDefault (Struct msg) where
- messageDefault msg = Struct msg (WordAt 0 0) 0 0
-
-instance HasMessage (List msg) where
- type InMessage (List msg) = msg
-
- message (List0 list) = message list
- message (List1 list) = message list
- message (List8 list) = message list
- 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) where
- type InMessage (ListOf msg a) = msg
-
- 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 ()) where
- messageDefault msg = ListOfVoid msg 0
-instance MessageDefault (ListOf msg (Struct msg)) where
- messageDefault msg = ListOfStruct (messageDefault msg) 0
-instance MessageDefault (ListOf msg Bool) where
- messageDefault msg = ListOfBool (messageDefault msg)
-instance MessageDefault (ListOf msg Word8) where
- messageDefault msg = ListOfWord8 (messageDefault msg)
-instance MessageDefault (ListOf msg Word16) where
- messageDefault msg = ListOfWord16 (messageDefault msg)
-instance MessageDefault (ListOf msg Word32) where
- messageDefault msg = ListOfWord32 (messageDefault msg)
-instance MessageDefault (ListOf msg Word64) where
- messageDefault msg = ListOfWord64 (messageDefault msg)
-instance MessageDefault (ListOf msg (Maybe (Ptr msg))) where
- messageDefault msg = ListOfPtr (messageDefault msg)
-
-instance HasMessage (NormalList msg) where
- type InMessage (NormalList msg) = msg
-
- message = nMsg
-
-instance MessageDefault (NormalList 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 :: RWCtx m s => a -> Int -> ListOf (M.MutMsg s) a -> m ()
-setIndex value i list | length list <= i =
- throwM E.BoundsError { E.index = i, E.maxIndex = length list }
-setIndex value i list = case list of
- 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
- Just p | message p /= message list -> do
- newPtr <- copyPtr (message list) value
- setIndex newPtr i list
- Nothing -> setNIndex nlist 1 (P.serializePtr Nothing)
- Just (PtrCap _ cap) -> setNIndex nlist 1 (P.serializePtr (Just (P.CapPtr cap)))
- Just p@(PtrList ptrList) ->
- 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."
-
-copyPtr :: RWCtx m s => M.MutMsg s -> Maybe (Ptr (M.MutMsg s)) -> m (Maybe (Ptr (M.MutMsg s)))
-copyPtr dest Nothing = pure Nothing
-copyPtr dest (Just (PtrCap _ n)) = pure $ Just (PtrCap dest n)
-copyPtr dest (Just (PtrList src)) = Just . PtrList <$> copyList dest src
-copyPtr dest (Just (PtrStruct src)) = Just . PtrStruct <$> do
- destStruct <- allocStruct
- dest
- (fromIntegral $ length (dataSection src))
- (fromIntegral $ length (ptrSection src))
- copyStruct destStruct src
- pure destStruct
-
-copyList :: RWCtx m s => M.MutMsg s -> List (M.MutMsg s) -> m (List (M.MutMsg s))
-copyList dest src = case src of
- List0 src -> List0 <$> allocList0 dest (length src)
- List1 src -> List1 <$> copyNewListOf dest src allocList1
- List8 src -> List8 <$> copyNewListOf dest src allocList8
- List16 src -> List16 <$> copyNewListOf dest src allocList16
- List32 src -> List32 <$> copyNewListOf dest src allocList32
- List64 src -> List64 <$> copyNewListOf dest src allocList64
- ListPtr src -> ListPtr <$> copyNewListOf dest src allocListPtr
- ListStruct src -> ListStruct <$> do
- destList <- allocCompositeList
- dest
- (structListDataCount src)
- (structListPtrCount src)
- (length src)
- copyListOf destList src
- pure destList
-
-copyNewListOf
- :: RWCtx m s
- => M.MutMsg s
- -> ListOf (M.MutMsg s) a
- -> (M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) a))
- -> m (ListOf (M.MutMsg s) a)
-copyNewListOf destMsg src new = do
- dest <- new destMsg (length src)
- copyListOf dest src
- pure dest
-
-
-copyListOf :: RWCtx m s => ListOf (M.MutMsg s) a -> ListOf (M.MutMsg s) a -> m ()
-copyListOf dest src =
- forM_ [0..length src - 1] $ \i -> do
- value <- index i src
- setIndex value i dest
-
--- | @'copyStruct' dest src@ copies the source struct to the destination struct.
-copyStruct :: RWCtx m s => Struct (M.MutMsg s) -> Struct (M.MutMsg s) -> m ()
-copyStruct dest src = do
- -- We copy both the data and pointer sections from src to dest,
- -- padding the tail of the destination section with zeros/null
- -- 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:
- copyListOf dest src
- -- 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)
-
--- | Get the size (in words) of a struct's data section.
-structDataCount :: Struct msg -> Word16
-structDataCount = fromIntegral . length . dataSection
-
--- | Get the size of a struct's pointer section.
-structPtrCount :: Struct msg -> Word16
-structPtrCount = fromIntegral . length . ptrSection
-
--- | Get the size (in words) of the data sections in a composite list.
-structListDataCount :: ListOf msg (Struct msg) -> Word16
-structListDataCount (ListOfStruct s _) = structDataCount s
-
--- | Get the size of the pointer sections in a composite list.
-structListPtrCount :: ListOf msg (Struct msg) -> Word16
-structListPtrCount (ListOfStruct s _) = structPtrCount s
-
--- | @'getData' i struct@ gets the @i@th word from the struct's data section,
--- returning 0 if it is absent.
-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
deleted file mode 100644
--- a/lib/Data/Capnp/Untyped/Pure.hs
+++ /dev/null
@@ -1,247 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-|
-Module: Data.Capnp.Untyped.Pure
-Description: high-level API for working with untyped Cap'N Proto values.
-
-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/AppendVec.hs b/lib/Internal/AppendVec.hs
--- a/lib/Internal/AppendVec.hs
+++ b/lib/Internal/AppendVec.hs
@@ -9,8 +9,10 @@
, fromVector
, makeEmpty
, getVector
+ , getCapacity
, FrozenAppendVec(..)
, grow
+ , canGrowWithoutCopy
) where
import Control.Monad (when)
@@ -20,8 +22,8 @@
import qualified Data.Vector.Generic as GV
import qualified Data.Vector.Generic.Mutable as GMV
-import Data.Capnp.Errors (Error(SizeError))
-import Data.Mutable (Thaw(..))
+import Capnp.Errors (Error(SizeError))
+import Data.Mutable (Thaw(..))
-- | 'AppendVec' wraps a mutable vector, and affords amortized O(1) appending.
data AppendVec v s a = AppendVec
@@ -49,6 +51,9 @@
getVector :: GMV.MVector v a => AppendVec v s a -> v s a
getVector AppendVec{mutVec, mutVecLen} = GMV.slice 0 mutVecLen mutVec
+getCapacity :: GMV.MVector v a => AppendVec v s a -> Int
+getCapacity AppendVec{mutVec} = GMV.length mutVec
+
-- | immutable version of 'AppendVec'; this is defined for the purpose of
-- implementing 'Thaw'.
newtype FrozenAppendVec v a = FrozenAppendVec { getFrozenVector :: v a }
@@ -77,11 +82,11 @@
-- If the result does exceed @maxSize@, throws 'SizeError'.
grow :: (MonadThrow m, PrimMonad m, s ~ PrimState m, GMV.MVector v a)
=> AppendVec v s a -> Int -> Int -> m (AppendVec v s a)
-grow AppendVec{mutVec,mutVecLen} amount maxSize = do
+grow vec@AppendVec{mutVec,mutVecLen} amount maxSize = do
when (maxSize - amount < mutVecLen) $
throwM SizeError
mutVec <-
- if mutVecLen + amount <= GMV.length mutVec then
+ if canGrowWithoutCopy vec amount then
-- we have enough un-allocated space already; leave the vector
-- itself alone.
pure mutVec
@@ -95,3 +100,7 @@
{ mutVec = mutVec
, mutVecLen = mutVecLen + amount
}
+
+canGrowWithoutCopy :: (GMV.MVector v a) => AppendVec v s a -> Int -> Bool
+canGrowWithoutCopy AppendVec{mutVec,mutVecLen} amount =
+ mutVecLen + amount <= GMV.length mutVec
diff --git a/lib/Internal/BuildPure.hs b/lib/Internal/BuildPure.hs
--- a/lib/Internal/BuildPure.hs
+++ b/lib/Internal/BuildPure.hs
@@ -13,14 +13,15 @@
, createPure
) where
-import Control.Monad.Catch (MonadThrow(..), SomeException)
+import Control.Monad.Catch (Exception, MonadThrow(..), SomeException)
import Control.Monad.Catch.Pure (CatchT, runCatchT)
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.ST (ST)
import Control.Monad.Trans (MonadTrans(..))
-import Data.Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT)
-import Data.Mutable (Thaw(..), createT)
+import Capnp.Bits (WordCount)
+import Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT)
+import Data.Mutable (Thaw(..), createT)
-- | 'PureBuilder' is a monad transformer stack with the instnaces needed
-- manipulate mutable messages. @'PureBuilder' s a@ is morally equivalent
@@ -32,14 +33,20 @@
type PrimState (PureBuilder s) = s
primitive = PureBuilder . primitive
-runPureBuilder :: Int -> PureBuilder s a -> ST s (Either SomeException a)
+runPureBuilder :: WordCount -> PureBuilder s a -> ST s (Either SomeException a)
runPureBuilder limit (PureBuilder m) = runPrimCatchT $ evalLimitT limit m
-- | @'createPure' limit m@ creates a capnproto value in pure code according
-- to @m@, then freezes it without copying. If @m@ calls 'throwM' then
--- 'createPure' returns a 'Left' with the exception.
-createPure :: Thaw a => Int -> (forall s. PureBuilder s (Mutable s a)) -> Either SomeException a
-createPure limit m = createT (runPureBuilder limit m)
+-- 'createPure' rethrows the exception in the specified monad.
+createPure :: (MonadThrow m, Thaw a) => WordCount -> (forall s. PureBuilder s (Mutable s a)) -> m a
+createPure limit m = throwLeft $ createT (runPureBuilder limit m)
+ where
+ -- I(zenhack) am surprised not to have found this in one of the various
+ -- exception packages:
+ throwLeft :: (Exception e, MonadThrow m) => Either e a -> m a
+ throwLeft (Left e) = throwM e
+ throwLeft (Right a) = pure a
-- | 'PrimCatchT' is a trivial wrapper around 'CatchT', which implements
-- 'PrimMonad'. This is a temporary workaround for:
diff --git a/lib/Internal/Finalizer.hs b/lib/Internal/Finalizer.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/Finalizer.hs
@@ -0,0 +1,67 @@
+{-|
+Module: Internal.Finalizer
+Description: Make resource-safe wrappers for values, with finalizers
+
+This module wrappers for values to which finalizers can safely be
+attached, without worrying that they may be collected early. It is
+useful when the natural thing to attach a finalizer to is a simple
+datatype.
+
+From the docs for the 'Weak' type:
+
+> WARNING: weak pointers to ordinary non-primitive Haskell types
+> are particularly fragile, because the compiler is free to optimise
+> away or duplicate the underlying data structure. Therefore
+> attempting to place a finalizer on an ordinary Haskell type may
+> well result in the finalizer running earlier than you expected.
+>
+> [...]
+>
+> Finalizers can be used reliably for types that are created
+> explicitly and have identity, such as IORef and MVar. [...]
+
+So instead, we provide a 'Cell' type, which:
+
+* Wraps simple value
+* Can be created inside STM, and
+* May safely have finalizers, using the 'addFinalizer' function in
+ this module.
+
+Note that it is *not* safe to use the primitives from "Sys.Mem.Weak" to
+add finalizers.
+
+-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Internal.Finalizer (Cell, get, newCell, addFinalizer) where
+
+import Control.Concurrent.MVar (MVar, mkWeakMVar, newEmptyMVar)
+import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar', newTVar)
+
+-- | A cell, containing a value and possibly finalizers.
+data Cell a = Cell
+ { value :: a
+ -- ^ The value wrapped by the cell.
+ , finalizers :: TVar [MVar ()]
+ -- ^ Experimentally, TVars appear not to be safe for finalizers, so
+ -- instead we create MVars for the finalizers, and store them this
+ -- list so that we maintain a reference to them.
+ }
+ deriving(Eq)
+
+-- | Get the value from a cell
+get :: Cell a -> a
+get = value
+
+-- Create a new cell, initially with no finalizers.
+newCell :: a -> STM (Cell a)
+newCell value = do
+ finalizers <- newTVar []
+ pure Cell { value, finalizers }
+
+-- Add a new finalizer to the cell. Cells may have many finalizers
+-- attached.
+addFinalizer :: Cell a -> IO () -> IO ()
+addFinalizer Cell{finalizers} fin = do
+ mvar <- newEmptyMVar
+ _ <- mkWeakMVar mvar fin
+ atomically $ modifyTVar' finalizers (mvar:)
diff --git a/lib/Internal/Gen/Instances.hs b/lib/Internal/Gen/Instances.hs
deleted file mode 100644
--- a/lib/Internal/Gen/Instances.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-{-# 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(..)
- , Decerialize(..)
- )
-
-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 Decerialize Int8 where
- type Cerial msg Int8 = Int8
- decerialize val = pure val
-instance ListElem msg Int16 where
- newtype List msg Int16 = ListInt16 (U.ListOf msg Word16)
- length (ListInt16 l) = U.length l
- 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 Decerialize Int16 where
- type Cerial msg Int16 = Int16
- decerialize val = pure val
-instance ListElem msg Int32 where
- newtype List msg Int32 = ListInt32 (U.ListOf msg Word32)
- length (ListInt32 l) = U.length l
- 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 Decerialize Int32 where
- type Cerial msg Int32 = Int32
- decerialize val = pure val
-instance ListElem msg Int64 where
- newtype List msg Int64 = ListInt64 (U.ListOf msg Word64)
- length (ListInt64 l) = U.length l
- 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 Decerialize Int64 where
- type Cerial msg Int64 = Int64
- decerialize val = pure val
-instance ListElem msg Word8 where
- newtype List msg Word8 = ListWord8 (U.ListOf msg Word8)
- length (ListWord8 l) = U.length l
- 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 Decerialize Word8 where
- type Cerial msg Word8 = Word8
- decerialize val = pure val
-instance ListElem msg Word16 where
- newtype List msg Word16 = ListWord16 (U.ListOf msg Word16)
- length (ListWord16 l) = U.length l
- 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 Decerialize Word16 where
- type Cerial msg Word16 = Word16
- decerialize val = pure val
-instance ListElem msg Word32 where
- newtype List msg Word32 = ListWord32 (U.ListOf msg Word32)
- length (ListWord32 l) = U.length l
- 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 Decerialize Word32 where
- type Cerial msg Word32 = Word32
- decerialize val = pure val
-instance ListElem msg Word64 where
- newtype List msg Word64 = ListWord64 (U.ListOf msg Word64)
- length (ListWord64 l) = U.length l
- 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 Decerialize Word64 where
- type Cerial msg Word64 = Word64
- decerialize val = pure val
-instance ListElem msg Float where
- newtype List msg Float = ListFloat (U.ListOf msg Word32)
- length (ListFloat l) = U.length l
- 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 Decerialize Float where
- type Cerial msg Float = Float
- decerialize val = pure val
-instance ListElem msg Double where
- newtype List msg Double = ListDouble (U.ListOf msg Word64)
- length (ListDouble l) = U.length l
- 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 Decerialize Double where
- type Cerial msg Double = Double
- decerialize val = pure val
-instance ListElem msg Bool where
- newtype List msg Bool = ListBool (U.ListOf msg Bool)
- length (ListBool l) = U.length l
- 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))
-instance Decerialize Bool where
- type Cerial msg Bool = Bool
- decerialize val = pure val
diff --git a/lib/Internal/Rc.hs b/lib/Internal/Rc.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/Rc.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-|
+Module: Internal.Rc
+Description: Reference counted boxes.
+
+This module provides a reference-counted cell type 'Rc', which contains a
+value and a finalizer. When the reference count reaches zero, the value is
+dropped and the finalizer is run.
+-}
+module Internal.Rc
+ ( Rc
+ , new
+ , get
+ , incr
+ , decr
+ , release
+ ) where
+
+import Control.Concurrent.STM
+
+-- | A reference-counted container for a value of type @a@.
+newtype Rc a
+ = Rc (TVar (Maybe (RcState a)))
+ deriving(Eq)
+
+data RcState a = RcState
+ { refCount :: !Int
+ , value :: a
+ , finalizer :: STM ()
+ }
+
+-- | @'new' val finalizer@ creates a new 'Rc' containing the value @val@, with
+-- an initial reference count of 1. When the reference count drops to zero, the
+-- finalizer will be run.
+new :: a -> STM () -> STM (Rc a)
+new value finalizer = fmap Rc $ newTVar $ Just RcState
+ { refCount = 1
+ , value
+ , finalizer
+ }
+
+-- | Increment the reference count.
+incr :: Rc a -> STM ()
+incr (Rc tv) = modifyTVar' tv $
+ fmap $ \s@RcState{refCount} -> s { refCount = refCount + 1 }
+
+-- | Decrement the reference count. If this brings the count to zero, run the
+-- finalizer and release the value.
+decr :: Rc a -> STM ()
+decr (Rc tv) = readTVar tv >>= \case
+ Nothing ->
+ pure ()
+ Just RcState{refCount=1, finalizer} -> do
+ writeTVar tv Nothing
+ finalizer
+ Just s@RcState{refCount} ->
+ writeTVar tv $ Just s { refCount = refCount - 1 }
+
+-- | Release the value immediately, and run the finalizer, regardless of the
+-- current reference count.
+release :: Rc a -> STM ()
+release (Rc tv) = readTVar tv >>= \case
+ Nothing ->
+ pure ()
+ Just RcState{finalizer} -> do
+ finalizer
+ writeTVar tv Nothing
+
+-- | Fetch the value, or 'Nothing' if it has been released.
+get :: Rc a -> STM (Maybe a)
+get (Rc tv) = fmap value <$> readTVar tv
diff --git a/lib/Internal/SnocList.hs b/lib/Internal/SnocList.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/SnocList.hs
@@ -0,0 +1,39 @@
+module Internal.SnocList
+ ( SnocList
+ , fromList
+ , empty
+ , snoc
+ , singleton
+ ) where
+
+import Data.Foldable
+
+-- | A 'SnocList' is just a list, but with efficient appending instead of
+-- prepending. The indended use case is when you want to append a bunch of
+-- things to a list, and then get the final list to work with.
+--
+-- A standard trick for this is to cons each element onto the *front* of
+-- the list, and then reverse the list before processing. A SnocList
+-- just packages up this trick so you can't forget to do the reverse.
+newtype SnocList a = SnocList [a]
+
+-- | Convert a list to a 'SnocList'. O(n)
+fromList :: [a] -> SnocList a
+fromList = SnocList . reverse
+
+-- | A one-element 'SnocList'.
+singleton :: a -> SnocList a
+singleton x = SnocList [x]
+
+-- | The empty 'SnocList'.
+empty :: SnocList a
+empty = SnocList []
+
+-- | Append a value to the 'SnocList'. A note on the name: 'snoc' is @cons@
+-- backwards.
+snoc :: SnocList a -> a -> SnocList a
+snoc (SnocList xs) x = SnocList (x:xs)
+
+instance Foldable SnocList where
+ foldMap f = foldMap f . toList
+ toList (SnocList xs) = reverse xs
diff --git a/lib/Internal/TCloseQ.hs b/lib/Internal/TCloseQ.hs
new file mode 100644
--- /dev/null
+++ b/lib/Internal/TCloseQ.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-|
+Module: Internal.TCloseQ
+Description: Transactional queues with a close operation.
+
+This module provides a thin layer over 'TQueue', which affords "closing"
+queues. Reading from a closed queue returns 'Nothing'.
+-}
+module Internal.TCloseQ
+ ( Q
+ , ErrClosed(..)
+ , new
+ , read
+ , write
+ , close
+ ) where
+
+import Prelude hiding (read)
+
+import Control.Concurrent.STM
+
+import Control.Exception (Exception)
+import Control.Monad (unless, when)
+import Data.Maybe (isNothing)
+
+-- | A Queue with a close operation, with element type @a@.
+data Q a = Q
+ { q :: TQueue (Maybe a)
+ , isClosed :: TVar Bool
+ }
+
+-- | An exception which is thrown if a caller tries to write to a closed queue.
+data ErrClosed = ErrClosed
+ deriving(Show)
+instance Exception ErrClosed
+
+-- | Create a new empty queue.
+new :: STM (Q a)
+new = do
+ q <- newTQueue
+ isClosed <- newTVar False
+ pure Q{..}
+
+-- | Read a value from the queue. Returns Nothing if the queue is closed.
+read :: Q a -> STM (Maybe a)
+read Q{q} = do
+ ret <- readTQueue q
+ when (isNothing ret) $
+ -- put it back in, so future reads also return nothing:
+ writeTQueue q ret
+ pure ret
+
+-- | Write a value to the queue, which must not be closed. If it is closed,
+-- this will throw 'ErrClosed'.
+write :: Q a -> a -> STM ()
+write Q{q, isClosed} v = do
+ c <- readTVar isClosed
+ when c $ throwSTM ErrClosed
+ writeTQueue q (Just v)
+
+-- | Close a queue. It is safe to close a queue more than once; subsequent
+-- closes will have no effect.
+close :: Q a -> STM ()
+close Q{q, isClosed} = do
+ c <- readTVar isClosed
+ unless c $ do
+ writeTVar isClosed True
+ writeTQueue q Nothing
diff --git a/lib/Internal/Util.hs b/lib/Internal/Util.hs
deleted file mode 100644
--- a/lib/Internal/Util.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-|
-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
--- a/scripts/README.md
+++ b/scripts/README.md
@@ -6,5 +6,5 @@
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.
+* `gen-basic-instances.hs` generates the module
+ `Internal.Gen.Instances`, which contains a lot of boilerplate.
diff --git a/scripts/format.sh b/scripts/format.sh
--- a/scripts/format.sh
+++ b/scripts/format.sh
@@ -3,6 +3,4 @@
# 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)
+stylish-haskell -i $(find lib examples cmd tests scripts -name '*.hs' | grep -v /gen/)
diff --git a/scripts/gen-basic-instances.hs b/scripts/gen-basic-instances.hs
--- a/scripts/gen-basic-instances.hs
+++ b/scripts/gen-basic-instances.hs
@@ -14,14 +14,17 @@
, "import Data.ReinterpretCast"
, "import Data.Word"
, ""
- , "import Data.Capnp.Classes"
+ , "import Capnp.Classes"
, " ( ListElem(..)"
, " , MutListElem(..)"
- , " , IsPtr(..)"
+ , " , FromPtr(..)"
, " , Decerialize(..)"
+ , " , Cerialize(..)"
+ , " , cerializeBasicVec"
, " )"
, ""
- , "import qualified Data.Capnp.Untyped as U"
+ , "import qualified Capnp.Untyped as U"
+ , "import qualified Data.Vector as V"
, ""
]
@@ -33,22 +36,27 @@
, listSuffix :: String
}
-
-genInstance P{..} = concat
+genInstance P{..} = concat $
[ "instance ListElem msg ", typed, " where\n"
, " newtype List msg ", typed, " = List", typed, " (U.ListOf msg ", untyped, ")\n"
+ , " listFromPtr msg ptr = List", typed, " <$> fromPtr msg ptr\n"
+ , " toUntypedList (List", typed, " l) = U.List", listSuffix, " l\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"
, "instance Decerialize ", typed, " where\n"
, " type Cerial msg ", typed, " = ", typed, "\n"
, " decerialize val = pure val\n"
+ , "instance Cerialize ", typed, " where\n"
+ , " cerialize _ val = pure val\n"
]
+ ++
+ [ "instance Cerialize (V.Vector " ++ t ++ ") where\n" ++
+ " cerialize = cerializeBasicVec\n"
+ | t <- take 6 $ iterate (\t -> "(V.Vector " ++ t ++ ")") typed
+ ]
where
dataCon = "List" ++ typed
@@ -93,5 +101,5 @@
}
]
-main = writeFile "lib/Internal/Gen/Instances.hs" $
+main = writeFile "gen/lib/Internal/Gen/Instances.hs" $
header ++ concatMap genInstance instances
diff --git a/scripts/hlint.sh b/scripts/hlint.sh
--- a/scripts/hlint.sh
+++ b/scripts/hlint.sh
@@ -5,6 +5,4 @@
# 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)
+exec hlint $(find lib examples cmd tests scripts -name '*.hs' | grep -v /gen/)
diff --git a/scripts/regen.sh b/scripts/regen.sh
--- a/scripts/regen.sh
+++ b/scripts/regen.sh
@@ -1,6 +1,6 @@
#!/usr/bin/env sh
#
-# Regenerate modules for the core capnproto schema.
+# Regenerate generated modules.
set -e
# Some helpers for reporting info to the caller:
@@ -13,19 +13,25 @@
exit 1
}
-# First make sure the compiler plugin is up to date.
+repo_root="$(realpath $(dirname $0)/..)"
+cd "$repo_root"
+
+# First, make sure our non-schema generated modules are up to date.
+log "Generating Internal.Gen"
+runhaskell scripts/gen-basic-instances.hs
+
+# 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
+# We run the code generator from inside gen/lib/, so that it outputs
# modules to the right locations:
-cd lib
+cd "$repo_root/gen/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)"
+exe="$(find $repo_root/dist-newstyle -type f -name capnpc-haskell)"
# Make sure we only found one file:
argslen() {
@@ -37,10 +43,32 @@
*) err "Error: more than one capnpc-haskell executable found in dist-newstyle." ;;
esac
+core_inc=$repo_root/core-schema/
+
# Ok -- do the codegen. Add the compiler plugin to our path and invoke
# capnp compile.
-log "Generating schema modules..."
+log "Generating schema modules for main library..."
export PATH="$(dirname $exe):$PATH"
-capnp compile -I ../core-schema --src-prefix=../core-schema/ -ohaskell ../core-schema/capnp/*.capnp
+capnp compile \
+ -I $core_inc \
+ --src-prefix=$core_inc/ \
+ -ohaskell \
+ $core_inc/capnp/*.capnp
+
+log "Generating schema modules for aircraft.capnp (test suite)..."
+cd "$repo_root/gen/tests"
+capnp compile \
+ -I $core_inc \
+ --src-prefix=../../tests/data/ \
+ -ohaskell \
+ ../../tests/data/aircraft.capnp
+
+log "Generating schema modules for echo.capnp (examples)..."
+cd "$repo_root/examples/gen/lib"
+capnp compile \
+ -I $core_inc \
+ --src-prefix=../../ \
+ -ohaskell \
+ ../../*.capnp
# vim: set ts=2 sw=2 noet :
diff --git a/tests/CalculatorExample.hs b/tests/CalculatorExample.hs
new file mode 100644
--- /dev/null
+++ b/tests/CalculatorExample.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module CalculatorExample (tests) where
+
+import Data.Word
+import Test.Hspec
+
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (race_)
+import Control.Exception.Safe (throwIO, try)
+import Data.Default (def)
+import Data.Foldable (for_)
+import Data.String (fromString)
+import Network.Simple.TCP (connect, serve)
+import System.Environment (getEnv)
+import System.Exit (ExitCode(ExitSuccess))
+import System.IO.Error (isDoesNotExistError)
+import System.Process (callProcess, readProcessWithExitCode)
+
+import Capnp.Rpc.Transport (socketTransport)
+import Capnp.Rpc.Untyped (ConnConfig(..), handleConn)
+import Capnp.TraversalLimit (defaultLimit)
+
+import qualified Examples.Rpc.CalculatorClient
+import qualified Examples.Rpc.CalculatorServer
+
+getExe :: String -> IO (Maybe FilePath)
+getExe varName =
+ try (getEnv varName) >>= \case
+ Left e
+ | isDoesNotExistError e -> do
+ putStrLn $ varName ++ " not set; skipping."
+ pure Nothing
+ | otherwise ->
+ throwIO e
+ Right path ->
+ pure (Just path)
+
+tests :: Spec
+tests = describe "Check our example against the C++ implementation" $ do
+ clientPath <- runIO $ getExe "CXX_CALCULATOR_CLIENT"
+ serverPath <- runIO $ getExe "CXX_CALCULATOR_SERVER"
+ for_ clientPath $ \clientPath ->
+ it "Should pass when run against our server" $
+ Examples.Rpc.CalculatorServer.main
+ `race_` (waitForServer >> cxxClient clientPath 4000)
+ for_ serverPath $ \serverPath ->
+ it "Should pass when run against our client" $
+ cxxServer serverPath 4000
+ `race_` (waitForServer >> Examples.Rpc.CalculatorClient.main)
+ for_ ((,) <$> clientPath <*> serverPath) $ \(clientPath, serverPath) ->
+ it "Should pass when run aginst the C++ server, proxied through us." $
+ cxxServer serverPath 4000
+ `race_` (waitForServer >> runProxy 4000 6000)
+ -- we wait twice, so that the proxy also has time to start:
+ `race_` (waitForServer >> waitForServer >> cxxClient clientPath 6000)
+ where
+ -- | Give the server a bit of time to start up.
+ waitForServer :: IO ()
+ waitForServer = threadDelay 100000
+
+ cxxServer :: FilePath -> Word16 -> IO ()
+ cxxServer path port =
+ callProcess path ["localhost:" ++ show port]
+ cxxClient :: FilePath -> Word16 -> IO ()
+ cxxClient path port = do
+ (eStatus, out, err) <- readProcessWithExitCode path ["localhost:" ++ show port] ""
+ (eStatus, out, err)
+ `shouldBe`
+ ( ExitSuccess
+ , unlines
+ [ "Evaluating a literal... PASS"
+ , "Using add and subtract... PASS"
+ , "Pipelining eval() calls... PASS"
+ , "Defining functions... PASS"
+ , "Using a callback... PASS"
+ ]
+ , ""
+ )
+
+-- | @'runProxy' serverPort clientPort@ connects to the server listening at
+-- localhost:serverPort, requests its bootstrap interface, and then listens
+-- on clientPort, offering a proxy of the server's bootstrap interface as our
+-- own.
+runProxy :: Word16 -> Word16 -> IO ()
+runProxy serverPort clientPort =
+ connect "localhost" (fromString $ show serverPort) $ \(serverSock, _addr) ->
+ handleConn (socketTransport serverSock defaultLimit) def
+ { debugMode = True
+ , withBootstrap = Just $ \_sup client ->
+ serve "localhost" (fromString $ show clientPort) $ \(clientSock, _addr) ->
+ handleConn (socketTransport clientSock defaultLimit) def
+ { getBootstrap = \_sup -> pure $ Just client
+ , debugMode = True
+ }
+ }
diff --git a/tests/Instances.hs b/tests/Instances.hs
--- a/tests/Instances.hs
+++ b/tests/Instances.hs
@@ -4,8 +4,8 @@
In particular, stuff from:
-* "Data.Capnp.Untyped.Pure"
-* "Capnp.Capnp.Schema.Pure"
+* "Capnp.Untyped.Pure"
+* "Capnp.Gen.Capnp.Schema.Pure"
-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
@@ -18,9 +18,9 @@
import qualified Data.Vector as V
-import Capnp.Capnp.Schema.Pure
+import Capnp.Gen.Capnp.Schema.Pure
-import qualified Data.Capnp.Untyped.Pure as PU
+import qualified Capnp.Untyped.Pure as PU
-- Generate an arbitrary "unknown" tag, i.e. one with a value unassigned
-- by the schema. The parameter is the number of tags assigned by the schema.
@@ -41,40 +41,72 @@
union' <- arbitrary
pure Node{..}
+instance Arbitrary Node'SourceInfo where
+ shrink = genericShrink
+ arbitrary = do
+ id <- arbitrary
+ docComment <- arbitrary
+ members <- arbitrarySmallerVec
+ pure Node'SourceInfo{..}
+
+instance Arbitrary Node'SourceInfo'Member where
+ shrink = genericShrink
+ arbitrary = Node'SourceInfo'Member <$> arbitrary
+
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'struct <$> arbitrary
+ , Node'enum <$> arbitrary
+ , Node'interface <$> arbitrary
+ , Node'const <$> arbitrary
+ , Node'annotation <$> arbitrary
, Node'unknown' <$> arbitraryTag 6
]
+instance Arbitrary Node'enum where
+ shrink = genericShrink
+ arbitrary = Node'enum' <$> arbitrarySmallerVec
+
+instance Arbitrary Node'struct where
+ shrink = genericShrink
+ arbitrary = do
+ dataWordCount <- arbitrary
+ pointerCount <- arbitrary
+ preferredListEncoding <- arbitrary
+ isGroup <- arbitrary
+ discriminantCount <- arbitrary
+ discriminantOffset <- arbitrary
+ fields <- arbitrarySmallerVec
+ pure Node'struct'{..}
+
+instance Arbitrary Node'interface where
+ shrink = genericShrink
+ arbitrary = Node'interface' <$> arbitrarySmallerVec <*> arbitrarySmallerVec
+
+instance Arbitrary Node'const where
+ shrink = genericShrink
+ arbitrary = Node'const' <$> arbitrary <*> arbitrary
+
+instance Arbitrary Node'annotation where
+ shrink = genericShrink
+ 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'{..}
+
instance Arbitrary Node'NestedNode where
shrink = genericShrink
arbitrary = Node'NestedNode
@@ -95,15 +127,23 @@
instance Arbitrary Field' where
shrink = genericShrink
arbitrary = oneof
- [ do
- offset <- arbitrary
- type_ <- arbitrary
- defaultValue <- arbitrary
- hadExplicitDefault <- arbitrary
- pure Field'slot{..}
+ [ Field'slot <$> arbitrary
, Field'group <$> arbitrary
]
+instance Arbitrary Field'slot where
+ shrink = genericShrink
+ arbitrary = do
+ offset <- arbitrary
+ type_ <- arbitrary
+ defaultValue <- arbitrary
+ hadExplicitDefault <- arbitrary
+ pure Field'slot'{..}
+
+instance Arbitrary Field'group where
+ shrink = genericShrink
+ arbitrary = Field'group' <$> arbitrary
+
instance Arbitrary Field'ordinal where
shrink = genericShrink
arbitrary = oneof
@@ -224,7 +264,7 @@
shrink = genericShrink
arbitrary = oneof
[ Type'anyPointer'unconstrained <$> arbitrary
- , Type'anyPointer'parameter <$> arbitrary <*> arbitrary
+ , Type'anyPointer'parameter <$> arbitrary
, Type'anyPointer'implicitMethodParameter <$> arbitrary
]
@@ -237,6 +277,16 @@
, pure Type'anyPointer'unconstrained'capability
]
+instance Arbitrary Type'anyPointer'parameter where
+ shrink = genericShrink
+ arbitrary =
+ Type'anyPointer'parameter' <$> arbitrary <*> arbitrary
+
+instance Arbitrary Type'anyPointer'implicitMethodParameter where
+ shrink = genericShrink
+ arbitrary =
+ Type'anyPointer'implicitMethodParameter' <$> arbitrary
+
instance Arbitrary Type where
shrink = genericShrink
arbitrary = oneof
@@ -255,18 +305,36 @@
, pure Type'text
, pure Type'data_
, Type'list <$> arbitrary
- , Type'enum <$> arbitrary <*> arbitrary
- , Type'interface <$> arbitrary <*> arbitrary
+ , Type'enum <$> arbitrary
+ , Type'struct <$> arbitrary
+ , Type'interface <$> arbitrary
, Type'anyPointer <$> arbitrary
, Type'unknown' <$> arbitraryTag 21
]
+instance Arbitrary Type'list where
+ shrink = genericShrink
+ arbitrary = Type'list' <$> arbitrary
+
+instance Arbitrary Type'enum where
+ shrink = genericShrink
+ arbitrary = Type'enum' <$> arbitrary <*> arbitrary
+
+instance Arbitrary Type'struct where
+ shrink = genericShrink
+ arbitrary = Type'struct' <$> arbitrary <*> arbitrary
+
+instance Arbitrary Type'interface where
+ shrink = genericShrink
+ arbitrary = Type'interface' <$> arbitrary <*> arbitrary
+
instance Arbitrary CodeGeneratorRequest where
shrink = genericShrink
arbitrary = do
capnpVersion <- arbitrary
nodes <- arbitrarySmallerVec
requestedFiles <- arbitrarySmallerVec
+ sourceInfo <- arbitrarySmallerVec
pure CodeGeneratorRequest{..}
instance Arbitrary CodeGeneratorRequest'RequestedFile where
@@ -296,7 +364,7 @@
instance Arbitrary PU.Struct where
shrink = genericShrink
- arbitrary = sized $ \size -> PU.Struct
+ arbitrary = sized $ \_ -> PU.Struct
<$> arbitrary
<*> arbitrary
@@ -313,10 +381,13 @@
, PU.ListStruct <$> arbitrarySmallerVec
]
-instance Arbitrary PU.PtrType where
- shrink = genericShrink
+instance Arbitrary PU.Ptr where
+ shrink (PU.PtrStruct s) = PU.PtrStruct <$> shrink s
+ shrink (PU.PtrList l) = PU.PtrList <$> shrink l
+ shrink (PU.PtrCap _) = []
arbitrary = oneof
[ PU.PtrStruct <$> arbitrary
, PU.PtrList <$> arbitrary
- , PU.PtrCap <$> arbitrary
+ -- We never generate capabilites, as we can't marshal Clients back in,
+ -- so many of the invariants we check don't hold for caps.
]
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,23 +1,35 @@
module Main (main) where
-import Test.Framework (defaultMain)
+import Test.Hspec
-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)
+import Module.Capnp.Basics (basicsTests)
+import Module.Capnp.Bits (bitsTests)
+import Module.Capnp.Gen.Capnp.Schema (schemaTests)
+import Module.Capnp.Gen.Capnp.Schema.Pure (pureSchemaTests)
+import Module.Capnp.Pointer (ptrTests)
+import Module.Capnp.Rpc (rpcTests)
+import Module.Capnp.Untyped (untypedTests)
+import Module.Capnp.Untyped.Pure (pureUntypedTests)
+import Regression (regressionTests)
+import SchemaQuickCheck (schemaCGRQuickCheck)
+import WalkSchemaCodeGenRequest (walkSchemaCodeGenRequestTest)
+import qualified CalculatorExample
+
main :: IO ()
-main = defaultMain [ bitsTests
- , ptrTests
- , untypedTests
- , pureUntypedTests
- , walkSchemaCodeGenRequestTest
- , schemaCGRQuickCheck
- , schemaTests
- , pureSchemaTests
- ]
+main = hspec $ parallel $ do
+ describe "Tests for specific modules" $ do
+ describe "Capnp.Basics" basicsTests
+ describe "Capnp.Bits" bitsTests
+ describe "Capnp.Pointer" ptrTests
+ describe "Capnp.Rpc" rpcTests
+ describe "Capnp.Untyped" untypedTests
+ describe "Capnp.Untyped.Pure" pureUntypedTests
+ describe "Tests for generated output" $ do
+ describe "low-level output" schemaTests
+ describe "high-level output" pureSchemaTests
+ describe "Tests relate to schema" $ do
+ describe "tests using tests/data/schema-codegenreq" walkSchemaCodeGenRequestTest
+ describe "property tests for schema" schemaCGRQuickCheck
+ describe "Regression tests" regressionTests
+ CalculatorExample.tests
diff --git a/tests/Module/Capnp/Basics.hs b/tests/Module/Capnp/Basics.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Basics.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Module.Capnp.Basics (basicsTests) where
+
+import Test.Hspec
+import Test.QuickCheck
+
+import Control.Monad.IO.Class (liftIO)
+import Test.QuickCheck.Instances ()
+import Test.QuickCheck.IO (propertyIO)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+import Capnp.Basics
+
+import Capnp (cerialize, evalLimitT, newMessage)
+
+import qualified Capnp.Untyped as U
+
+basicsTests :: Spec
+basicsTests =
+ describe "textBuffer and textBytes agree" $
+ it "Should return the same number of bytes" $
+ property $ \(text :: T.Text) -> propertyIO $ evalLimitT maxBound $ do
+ msg <- newMessage Nothing
+ cerial <- cerialize msg text
+ buf <- textBuffer cerial
+ bytes <- textBytes cerial
+ liftIO $ BS.length bytes `shouldBe` U.length buf
diff --git a/tests/Module/Capnp/Bits.hs b/tests/Module/Capnp/Bits.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Bits.hs
@@ -0,0 +1,46 @@
+module Module.Capnp.Bits (bitsTests) where
+
+import Data.Bits
+import Data.Word
+import Test.Hspec
+
+import Data.Foldable (traverse_)
+
+import Capnp.Bits
+
+bitsTests :: Spec
+bitsTests = do
+ describe "bitRange" bitRangeExamples
+ describe "replaceBits" replaceBitsExamples
+
+bitRangeExamples :: Spec
+bitRangeExamples = do
+ it "Should get single bits correctly" $
+ traverse_ bitRangeTest ones
+ it "Should work on this extra example" $
+ bitRangeTest
+ (0x0000000200000000, 32, 48, 2)
+ where
+ bitRangeTest :: (Word64, Int, Int, Word64) -> IO ()
+ bitRangeTest (word, lo, hi, expected) =
+ bitRange word lo hi `shouldBe` expected
+ ones = map (\bit -> (1 `shiftL` bit, bit, bit + 1, 1)) [0..63]
+
+replaceBitsExamples :: Spec
+replaceBitsExamples =
+ it "Should work with several examples" $
+ sequence_
+ [ replaceTest (0xf :: Word8) 0 0 0xf
+ , replaceTest (0x1 :: Word8) 0xf 0 0x1
+ , replaceTest (0x2 :: Word8) 0x1 0 0x2
+ , replaceTest (0x1 :: Word8) 0xf 0 0x1
+ , replaceTest (0x2 :: Word8) 0x10 4 0x20
+ , replaceTest (0x1 :: Word8) 0x10 8 0x0110
+ , replaceTest (0xa :: Word8) 0xffff 8 0x0aff
+ , replaceTest (0x0 :: Word1) 0xff 4 0xef
+ ]
+ where
+ replaceTest :: (Bounded a, Integral a, Show a)
+ => a -> Word64 -> Int -> Word64 -> Expectation
+ replaceTest new orig shift expected =
+ replaceBits new orig shift `shouldBe` expected
diff --git a/tests/Module/Capnp/Gen/Capnp/Schema.hs b/tests/Module/Capnp/Gen/Capnp/Schema.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Gen/Capnp/Schema.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE RecordWildCards #-}
+module Module.Capnp.Gen.Capnp.Schema (schemaTests) where
+
+import Test.Hspec
+
+import Control.Monad.Primitive (RealWorld)
+import Data.Foldable (traverse_)
+
+import Capnp.Gen.Capnp.Schema
+
+import Capnp (newRoot)
+import Capnp.TraversalLimit (LimitT, evalLimitT)
+import Data.Mutable (Thaw(..))
+import Util (decodeValue, schemaSchemaSrc)
+
+import qualified Capnp.Message as M
+
+data BuildTest = BuildTest
+ { typeName :: String
+ , expected :: String
+ , builder :: M.MutMsg RealWorld -> LimitT IO ()
+ }
+
+schemaTests :: Spec
+schemaTests = describe "tests for typed setters" $ traverse_ 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
+ group <- set_Field'group field
+ set_Field'group'typeId group 322
+ ordinal <- get_Field'ordinal field
+ set_Field'ordinal'explicit ordinal 22
+ }
+ ]
+ where
+ testCase BuildTest{..} = it ("Should build " ++ expected) $ do
+ msg <- M.newMessage Nothing
+ evalLimitT maxBound $ builder msg
+ constMsg <- freeze msg
+ actual <- decodeValue schemaSchemaSrc typeName constMsg
+ actual `shouldBe` expected
diff --git a/tests/Module/Capnp/Gen/Capnp/Schema/Pure.hs b/tests/Module/Capnp/Gen/Capnp/Schema/Pure.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Gen/Capnp/Schema/Pure.hs
@@ -0,0 +1,512 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Module.Capnp.Gen.Capnp.Schema.Pure (pureSchemaTests) where
+
+import Data.Proxy
+import Test.Hspec
+
+import Control.Exception.Safe (bracket)
+import Control.Monad (when)
+import Control.Monad.Primitive (RealWorld)
+import Data.Default (Default(..))
+import Data.Foldable (traverse_)
+import System.Directory (removeFile)
+import System.IO
+ (IOMode(ReadMode, WriteMode), hClose, openBinaryTempFile, withBinaryFile)
+import Test.QuickCheck (Property, property)
+import Test.QuickCheck.Instances ()
+import Test.QuickCheck.IO (propertyIO)
+import Text.Heredoc (here)
+import Text.Show.Pretty (ppShow)
+
+import qualified Data.ByteString.Builder as BB
+import qualified Data.ByteString.Lazy as LBS
+
+import Capnp.Gen.Capnp.Schema.Pure
+import Util
+
+import Instances ()
+
+import Capnp (getRoot, hGetValue, hPutValue, setRoot)
+import Capnp.Classes
+ ( Allocate(..)
+ , Cerialize(..)
+ , Decerialize(..)
+ , FromStruct(..)
+ , ToStruct(..)
+ )
+import Capnp.TraversalLimit (defaultLimit, evalLimitT)
+import Data.Mutable (Thaw(..))
+
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
+
+pureSchemaTests :: Spec
+pureSchemaTests = describe "Tests for generated high-level modules." $ do
+ decodeTests
+ decodeDefaultTests
+ encodeTests
+ propTests
+
+encodeTests :: Spec
+encodeTests = describe "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 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) -> Spec
+ testCase (name, expectedValue, expectedText) = describe "cerialize" $
+ it ("Should agree with capnp decode (with name = " ++ name ++ ")") $ do
+ msg <- evalLimitT maxBound $ do
+ -- TODO: add some helpers for all this.
+ msg <- M.newMessage Nothing
+ cerialOut <- cerialize msg expectedValue
+ setRoot cerialOut
+ freeze msg
+ builder <- M.encode msg
+ actualText <- capnpDecode
+ (LBS.toStrict $ BB.toLazyByteString builder)
+ (MsgMetaData schemaSchemaSrc name)
+ actualText `shouldBe` expectedText
+ actualValue <- evalLimitT maxBound $ do
+ root <- U.rootPtr msg
+ cerialIn <- fromStruct root
+ decerialize cerialIn
+ actualValue `shouldBe` expectedValue
+
+decodeTests :: Spec
+decodeTests = describe "schema decode tests" $ sequence_ $
+ [ 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"]
+ ]
+ , sourceInfo = []
+ }
+ )
+ ]
+ , 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 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 $ Field'group' 4)
+ ]
+ }
+ )
+ , ( "enum = (enumerants = [(name = \"blue\", codeOrder = 2, annotations = [])])"
+ , Node'enum $ Node'enum' [ Enumerant "blue" 2 [] ]
+ )
+ , ( "interface = (methods = [], superclasses = [(id = 0, brand = (scopes = []))])"
+ , Node'interface $ Node'interface' [] [Superclass 0 (Brand [])]
+ )
+ , ( "const = (type = (bool = void), value = (bool = false))"
+ , Node'const $ 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 $ 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 $ 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 $ 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'list $ Type'list' Type'text
+ )
+ , ( "(enum = (typeId = 4, brand = (scopes = [])))"
+ , Type'enum $ Type'enum' 4 (Brand [])
+ )
+ , ( "(struct = (typeId = 7, brand = (scopes = [])))"
+ , Type'struct $ Type'struct' 7 (Brand [])
+ )
+ , ( "(interface = (typeId = 1, brand = (scopes = [])))"
+ , Type'interface $ 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 $ Type'anyPointer'parameter' 4 2
+ )
+ , ( "(anyPointer = (implicitMethodParameter = (parameterIndex = 7)))"
+ , Type'anyPointer $ Type'anyPointer'implicitMethodParameter $
+ 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
+ ]
+ ]
+ )
+ ]
+ ] `asProxyTypeOf` (Proxy :: Proxy [Spec])
+ where
+ -- TODO: rename this: it's confusing to have both the top level and helper
+ -- have the same name; not sure how that happened in the first place.
+ decodeTests ::
+ ( Eq a
+ , Show a
+ , Decerialize a
+ , FromStruct M.ConstMsg a
+ ) => String -> [(String, a)] -> Spec
+ decodeTests typename cases =
+ describe ("Decode " ++ typename) $ traverse_ (testCase typename) cases
+
+ testCase typename (capnpText, expected) =
+ specify ("should agree with `capnp encode` on " ++ capnpText) $ do
+ msg <- encodeValue schemaSchemaSrc typename capnpText
+ actual <- evalLimitT 128 $ getRoot msg
+ ppAssertEqual actual expected
+
+decodeDefaultTests :: Spec
+decodeDefaultTests = describe "Decoding default values" $ do
+ 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 a
+ , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
+ ) => String -> Proxy a -> Spec
+decodeDefault typename proxy =
+ specify ("The empty struct decodes to the default value for " ++ typename) $ 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 :: Spec
+propTests = describe "Various quickcheck properties" $ do
+ 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 = describe ("...for " ++ name) $ do
+ specify "cerialize and decerialize are inverses." $
+ property (prop_cerializeDecerializeInverses proxy)
+ specify "hPutValue and hGetValue are inverses." $
+ property (prop_hGetPutInverses proxy)
+
+prop_hGetPutInverses ::
+ ( Show a
+ , Eq a
+ , FromStruct M.ConstMsg a
+ , Cerialize a
+ , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
+ ) => Proxy a -> a -> Property
+prop_hGetPutInverses _proxy expected = propertyIO $ do
+ -- This is a little more complicated than I'd like due to resource
+ -- management issues. We create a temporary file, then immediately
+ -- close the handle to it, and open it again in a separate call to
+ -- bracket. This allows us to decouple the lifetimes of the file and
+ -- the handle.
+ actual <- bracket
+ (do
+ (filename, handle) <- openBinaryTempFile "/tmp" "hPutValue-output"
+ hClose handle
+ pure filename)
+ removeFile
+ (\filename -> do
+ withBinaryFile filename WriteMode
+ (`hPutValue` expected)
+ withBinaryFile filename ReadMode $ \h ->
+ hGetValue h defaultLimit)
+ ppAssertEqual actual expected
+
+prop_cerializeDecerializeInverses ::
+ ( Show a
+ , Eq a
+ , Cerialize 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 Nothing
+ cerialOut <- cerialize msg expected
+ setRoot cerialOut
+ constMsg :: M.ConstMsg <- freeze msg
+ root <- U.rootPtr constMsg
+ cerialIn <- fromStruct root
+ decerialize cerialIn
+ ppAssertEqual actual expected
diff --git a/tests/Module/Capnp/Pointer.hs b/tests/Module/Capnp/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Pointer.hs
@@ -0,0 +1,74 @@
+module Module.Capnp.Pointer (ptrTests) where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Test.Hspec
+import Test.QuickCheck
+
+import Capnp.Pointer
+
+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, arbitraryU29 :: Gen Word32
+arbitraryU32 = arbitrary
+arbitraryU29 = (`shiftR` 3) <$> arbitraryU32
+
+
+instance Arbitrary Ptr where
+ arbitrary = oneof [ StructPtr <$> arbitraryI30
+ <*> arbitrary
+ <*> arbitrary
+ , ListPtr <$> arbitraryI30
+ <*> arbitrary
+ , FarPtr <$> arbitrary
+ <*> arbitraryU29
+ <*> arbitrary
+ , CapPtr <$> arbitrary
+ ]
+
+ptrTests :: Spec
+ptrTests = do
+ ptrProps
+ parsePtrExamples
+
+ptrProps :: Spec
+ptrProps = describe "Pointer Properties" $ do
+ it "Should satisfy: parseEltSpec . serializeEltSpec == id" $
+ property $ \spec -> parseEltSpec (serializeEltSpec spec) == spec
+ it "Should satisfy: parsePtr . serializePtr == id" $
+ property $ \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 :: Spec
+parsePtrExamples = describe "parsePtr (examples)" $
+ it "Should parse this example correctly" $
+ parsePtr 0x0000000200000000 `shouldBe` (Just $ StructPtr 0 2 0)
diff --git a/tests/Module/Capnp/Rpc.hs b/tests/Module/Capnp/Rpc.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Rpc.hs
@@ -0,0 +1,440 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Module.Capnp.Rpc (rpcTests) where
+
+import Control.Concurrent.STM
+import Data.Word
+import Test.Hspec
+
+import Control.Concurrent.Async (concurrently_, race_)
+import Control.Exception.Safe (bracket, try)
+import Control.Monad (replicateM, void, (>=>))
+import Control.Monad.Catch (throwM)
+import Control.Monad.IO.Class (liftIO)
+import Data.Foldable (for_)
+import Data.Mutable (freeze)
+import Supervisors (Supervisor)
+import System.Timeout (timeout)
+
+import qualified Data.ByteString.Builder as BB
+import qualified Data.Text as T
+import qualified Network.Socket as Socket
+
+import Capnp
+ ( createPure
+ , def
+ , defaultLimit
+ , evalLimitT
+ , lbsToMsg
+ , msgToValue
+ , valueToMsg
+ )
+import Capnp.Bits (WordCount)
+import Capnp.Rpc.Errors (eFailed)
+import Capnp.Rpc.Promise (Promise, wait)
+import Capnp.Rpc.Server (pureHandler)
+import Capnp.Rpc.Transport (Transport(recvMsg, sendMsg), socketTransport)
+
+import Capnp.Gen.Aircraft.Pure hiding (Left, Right)
+import Capnp.Gen.Capnp.Rpc.Pure
+import Capnp.Rpc
+import Capnp.Rpc.Untyped
+
+import qualified Capnp.Gen.Echo.Pure as E
+import qualified Capnp.Pointer as P
+
+rpcTests :: Spec
+rpcTests = do
+ echoTests
+ aircraftTests
+ unusualTests
+
+-------------------------------------------------------------------------------
+-- Tests using echo.capnp.
+-------------------------------------------------------------------------------
+
+echoTests :: Spec
+echoTests = describe "Echo server & client" $
+ it "Should echo back the same message." $ runVatPair
+ (`E.export_Echo` TestEchoServer)
+ (\_sup echoSrv -> do
+ let msgs =
+ [ def { E.query = "Hello #1" }
+ , def { E.query = "Hello #2" }
+ ]
+ rets <- traverse ((E.echo'echo echoSrv ?) >=> wait) msgs
+ liftIO $ rets `shouldBe`
+ [ def { E.reply = "Hello #1" }
+ , def { E.reply = "Hello #2" }
+ ]
+ )
+
+data TestEchoServer = TestEchoServer
+
+instance E.Echo'server_ IO TestEchoServer where
+ echo'echo = pureHandler $ \_ params -> pure def { E.reply = E.query params }
+
+-------------------------------------------------------------------------------
+-- Tests using aircraft.capnp.
+--
+-- These use the 'CallSequence' interface as a counter.
+-------------------------------------------------------------------------------
+
+-- | Bump a counter n times, returning a list of the results.
+bumpN :: CallSequence -> Int -> IO [CallSequence'getNumber'results]
+bumpN ctr n = replicateM n (callSequence'getNumber ctr ? def) >>= traverse wait
+
+aircraftTests :: Spec
+aircraftTests = describe "aircraft.capnp rpc tests" $ do
+ it "Should propogate server-side exceptions to client method calls" $ runVatPair
+ (`export_CallSequence` ExnCtrServer)
+ (\_sup -> expectException
+ (\cap -> callSequence'getNumber cap ? def)
+ def
+ { type_ = Exception'Type'failed
+ , reason = "Something went sideways."
+ }
+ )
+ it "Should receive unimplemented when calling a method on a null cap." $ runVatPair
+ (\_sup -> pure $ CallSequence nullClient)
+ (\_sup -> expectException
+ (\cap -> callSequence'getNumber cap ? def)
+ def
+ { type_ = Exception'Type'unimplemented
+ , reason = "Method unimplemented"
+ }
+ )
+ it "Should throw an unimplemented exception if the server doesn't implement a method" $ runVatPair
+ (`export_CallSequence` NoImplServer)
+ (\_sup -> expectException
+ (\cap -> callSequence'getNumber cap ? def)
+ def
+ { type_ = Exception'Type'unimplemented
+ , reason = "Method unimplemented"
+ }
+ )
+ it "Should throw an opaque exception when the server throws a non-rpc exception" $ runVatPair
+ (`export_CallSequence` NonRpcExnServer)
+ (\_sup -> expectException
+ (\cap -> callSequence'getNumber cap ? def)
+ def
+ { type_ = Exception'Type'failed
+ , reason = "Unhandled exception"
+ }
+ )
+ it "A counter should maintain state" $ runVatPair
+ (\sup -> newTestCtr 0 >>= export_CallSequence sup)
+ (\_sup ctr -> do
+ results <- replicateM 4 (callSequence'getNumber ctr ? def)
+ >>= traverse wait
+ liftIO $ results `shouldBe`
+ [ def { n = 1 }
+ , def { n = 2 }
+ , def { n = 3 }
+ , def { n = 4 }
+ ]
+ )
+ it "Methods returning interfaces work" $ runVatPair
+ (\sup -> export_CounterFactory sup (TestCtrFactory sup))
+ (\_sup factory -> do
+ let newCounter start = do
+ CounterFactory'newCounter'results{counter} <-
+ counterFactory'newCounter factory ? def { start }
+ >>= wait
+ pure counter
+
+ ctrA <- newCounter 2
+ ctrB <- newCounter 0
+
+ r1 <- bumpN ctrA 4
+ liftIO $ r1 `shouldBe`
+ [ def { n = 3 }
+ , def { n = 4 }
+ , def { n = 5 }
+ , def { n = 6 }
+ ]
+
+ r2 <- bumpN ctrB 2
+ liftIO $ r2 `shouldBe`
+ [ def { n = 1 }
+ , def { n = 2 }
+ ]
+
+ ctrC <- newCounter 30
+
+ r3 <- bumpN ctrA 3
+ liftIO $ r3 `shouldBe`
+ [ def { n = 7 }
+ , def { n = 8 }
+ , def { n = 9 }
+ ]
+
+ r4 <- bumpN ctrC 1
+ liftIO $ r4 `shouldBe` [ def { n = 31 } ]
+ )
+ it "Methods with interface parameters work" $ do
+ ctrA <- atomically $ newTestCtr 2
+ ctrB <- atomically $ newTestCtr 0
+ ctrC <- atomically $ newTestCtr 30
+ runVatPair
+ (`export_CounterAcceptor` TestCtrAcceptor)
+ (\sup acceptor -> do
+ for_ [ctrA, ctrB, ctrC] $ \ctrSrv -> do
+ ctr <- atomically $ export_CallSequence sup ctrSrv
+ counterAcceptor'accept acceptor ? CounterAcceptor'accept'params { counter = ctr }
+ >>= wait
+ r <- traverse
+ (\(TestCtrServer var) -> liftIO $ readTVarIO var)
+ [ctrA, ctrB, ctrC]
+ liftIO $ r `shouldBe` [7, 5, 35]
+ )
+
+data TestCtrAcceptor = TestCtrAcceptor
+
+instance CounterAcceptor'server_ IO TestCtrAcceptor where
+ counterAcceptor'accept =
+ pureHandler $ \_ CounterAcceptor'accept'params{counter} -> do
+ [start] <- map n <$> bumpN counter 1
+ r <- bumpN counter 4
+ liftIO $ r `shouldBe`
+ [ def { n = start + 1 }
+ , def { n = start + 2 }
+ , def { n = start + 3 }
+ , def { n = start + 4 }
+ ]
+ pure def
+
+-------------------------------------------------------------------------------
+-- Implementations of various interfaces for testing purposes.
+-------------------------------------------------------------------------------
+
+newtype TestCtrFactory = TestCtrFactory { sup :: Supervisor }
+
+instance CounterFactory'server_ IO TestCtrFactory where
+ counterFactory'newCounter =
+ pureHandler $ \TestCtrFactory{sup} CounterFactory'newCounter'params{start} -> do
+ ctr <- atomically $ newTestCtr start >>= export_CallSequence sup
+ pure CounterFactory'newCounter'results { counter = ctr }
+
+newTestCtr :: Word32 -> STM TestCtrServer
+newTestCtr n = TestCtrServer <$> newTVar n
+
+newtype TestCtrServer = TestCtrServer (TVar Word32)
+
+instance CallSequence'server_ IO TestCtrServer where
+ callSequence'getNumber = pureHandler $ \(TestCtrServer tvar) _ -> do
+ ret <- liftIO $ atomically $ do
+ modifyTVar' tvar (+1)
+ readTVar tvar
+ pure def { n = ret }
+
+-- a 'CallSequence' which always throws an exception.
+data ExnCtrServer = ExnCtrServer
+
+instance CallSequence'server_ IO ExnCtrServer where
+ callSequence'getNumber = pureHandler $ \_ _ ->
+ throwM def
+ { type_ = Exception'Type'failed
+ , reason = "Something went sideways."
+ }
+
+-- a 'CallSequence' which doesn't implement its methods.
+data NoImplServer = NoImplServer
+
+instance CallSequence'server_ IO NoImplServer -- TODO: can we silence the warning somehow?
+
+-- Server that throws some non-rpc exception.
+data NonRpcExnServer = NonRpcExnServer
+
+instance CallSequence'server_ IO NonRpcExnServer where
+ callSequence'getNumber = pureHandler $ \_ _ -> error "OOPS"
+
+-------------------------------------------------------------------------------
+-- Tests for unusual patterns of messages .
+--
+-- Some of these will never come up when talking to a correct implementation of
+-- capnproto, and others just won't come up when talking to Haskell
+-- implementation. Accordingly, these tests start a vat in one thread and
+-- directly manipulate the transport in the other.
+-------------------------------------------------------------------------------
+
+unusualTests :: Spec
+unusualTests = describe "Tests for unusual message patterns" $ do
+ it "Should raise ReceivedAbort in response to an abort message." $ do
+ -- Send an abort message to the remote vat, and verify that
+ -- the vat actually aborts.
+ let exn = def
+ { type_ = Exception'Type'failed
+ , reason = "Testing abort"
+ }
+ withTransportPair $ \(vatTrans, probeTrans) -> do
+ ret <- try $ concurrently_
+ (handleConn (vatTrans defaultLimit) def { debugMode = True})
+ $ do
+ msg <- createPure maxBound $ valueToMsg $ Message'abort exn
+ sendMsg (probeTrans defaultLimit) msg
+ ret `shouldBe` Left (ReceivedAbort exn)
+ triggerAbort (Message'unimplemented $ Message'abort def) $
+ "Your vat sent an 'unimplemented' message for an abort message " <>
+ "that its remote peer never sent. This is likely a bug in your " <>
+ "capnproto library."
+ triggerAbort
+ (Message'call def
+ { target = MessageTarget'importedCap 443
+ }
+ )
+ "No such export: 443"
+ triggerAbort
+ (Message'call def
+ { target = MessageTarget'promisedAnswer def { questionId=300 }
+ }
+ )
+ "No such answer: 300"
+ triggerAbort
+ (Message'return def { answerId = 234 })
+ "No such question: 234"
+ it "Should respond with an abort if sent junk data" $ do
+ let wantAbortExn = def
+ { reason = "Unhandled exception: TraversalLimitError"
+ , type_ = Exception'Type'failed
+ }
+ withTransportPair $ \(vatTrans, probeTrans) ->
+ concurrently_
+ (do
+ Left (e :: RpcError) <- try $
+ handleConn (vatTrans defaultLimit) def { debugMode = True }
+ e `shouldBe` SentAbort wantAbortExn
+ )
+ (do
+ let bb = mconcat
+ [ BB.word32LE 0 -- 1 segment - 1 = 0
+ , BB.word32LE 2 -- 2 words in first segment
+ -- a pair of structs that point to each other:
+ , BB.word64LE (P.serializePtr (Just (P.StructPtr 0 0 1)))
+ , BB.word64LE (P.serializePtr (Just (P.StructPtr (-1) 0 1)))
+ ]
+ lbs = BB.toLazyByteString bb
+ msg <- lbsToMsg lbs
+ sendMsg (probeTrans defaultLimit) msg
+ msg' <- recvMsg (probeTrans defaultLimit)
+ resp <- msgToValue msg'
+ resp `shouldBe` Message'abort wantAbortExn
+ )
+ it "Should respond with an abort if erroneously sent return = resultsSentElsewhere" $
+
+ withTransportPair $ \(vatTrans, probeTrans) ->
+ let wantExn = eFailed $
+ "Received Return.resultsSentElswhere for a call "
+ <> "with sendResultsTo = caller."
+ in concurrently_
+ (do
+ Left (e :: RpcError) <- try $
+ handleConn (vatTrans defaultLimit) def
+ { debugMode = True
+ , withBootstrap = Just $ \_sup client ->
+ let ctr :: CallSequence = fromClient client
+ in void $ (callSequence'getNumber ctr ? def) >>= wait
+ }
+ e `shouldBe` SentAbort wantExn
+ )
+ (do
+ let send msg =
+ evalLimitT maxBound (valueToMsg msg >>= freeze)
+ >>= sendMsg (probeTrans defaultLimit)
+ recv = recvMsg (probeTrans defaultLimit) >>= msgToValue
+ Message'bootstrap Bootstrap{} <- recv
+ Message'call Call{questionId} <- recv
+ send $ Message'return def
+ { answerId = questionId
+ , union' = Return'resultsSentElsewhere
+ }
+ msg <- recv
+ msg `shouldBe` Message'abort wantExn
+ )
+ it "Should reply with unimplemented when sent a join (level 4 only)." $
+ withTransportPair $ \(vatTrans, probeTrans) ->
+ race_
+ (handleConn (vatTrans defaultLimit) def { debugMode = True })
+ $ do
+ msg <- createPure maxBound $ valueToMsg $ Message'join def
+ sendMsg (probeTrans defaultLimit) msg
+ msg' <- recvMsg (probeTrans defaultLimit) >>= msgToValue
+ msg' `shouldBe` Message'unimplemented (Message'join def)
+
+
+-- | Verify that the given message triggers an abort with the specified 'reason'
+-- field.
+triggerAbort :: Message -> T.Text -> Spec
+triggerAbort msg reason =
+ it ("Should abort when sent the message " ++ show msg ++ " on startup") $ do
+ let wantAbortExn = def
+ { reason = reason
+ , type_ = Exception'Type'failed
+ }
+ withTransportPair $ \(vatTrans, probeTrans) ->
+ concurrently_
+ (do
+ ret <- try $ handleConn (vatTrans defaultLimit) def { debugMode = True }
+ ret `shouldBe` Left (SentAbort wantAbortExn)
+ )
+ (do
+ rawMsg <- createPure maxBound $ valueToMsg msg
+ sendMsg (probeTrans defaultLimit) rawMsg
+ -- 4 second timeout. The remote vat's timeout before killing the
+ -- connection is one second, so if this happens we're never going
+ -- to receive the message. In theory this is possible, but if it
+ -- happens something is very wrong.
+ r <- timeout 4000000 $ recvMsg (probeTrans defaultLimit)
+ case r of
+ Nothing ->
+ error "Test timed out waiting on abort message."
+ Just rawResp -> do
+ resp <- msgToValue rawResp
+ resp `shouldBe` Message'abort wantAbortExn
+ )
+
+-------------------------------------------------------------------------------
+-- Utilties used by the tests.
+-------------------------------------------------------------------------------
+
+withSocketPair :: ((Socket.Socket, Socket.Socket) -> IO a) -> IO a
+withSocketPair =
+ bracket
+ (Socket.socketPair Socket.AF_UNIX Socket.Stream 0)
+ (\(x, y) -> Socket.close x >> Socket.close y)
+
+withTransportPair ::
+ ( ( WordCount -> Transport
+ , WordCount -> Transport
+ ) -> IO a
+ ) -> IO a
+withTransportPair f =
+ withSocketPair $ \(x, y) -> f (socketTransport x, socketTransport y)
+
+-- | @'runVatPair' server client@ runs a pair of vats connected to one another,
+-- using 'server' as the 'offerBootstrap' field in the one vat's config, and
+-- 'client' as the 'withBootstrap' field in the other's.
+runVatPair :: IsClient c => (Supervisor -> STM c) -> (Supervisor -> c -> IO ()) -> IO ()
+runVatPair getBootstrap withBootstrap = withTransportPair $ \(clientTrans, serverTrans) -> do
+ let runClient = handleConn (clientTrans defaultLimit) def
+ { debugMode = True
+ , withBootstrap = Just $ \sup -> withBootstrap sup . fromClient
+ }
+ runServer = handleConn (serverTrans defaultLimit) def
+ { debugMode = True
+ , getBootstrap = fmap (Just . toClient) . getBootstrap
+ }
+ race_ runServer runClient
+
+expectException :: Show a => (cap -> IO (Promise a)) -> Exception -> cap -> IO ()
+expectException callFn wantExn cap = do
+ ret <- try $ callFn cap >>= wait
+ case ret of
+ Left (e :: Exception) ->
+ liftIO $ e `shouldBe` wantExn
+ Right val ->
+ error $ "Should have received exn, but got " ++ show val
diff --git a/tests/Module/Capnp/Untyped.hs b/tests/Module/Capnp/Untyped.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Untyped.hs
@@ -0,0 +1,339 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Module.Capnp.Untyped (untypedTests) where
+
+import Prelude hiding (length)
+
+import Test.Hspec
+
+import Control.Monad (forM_, when)
+import Control.Monad.Primitive (RealWorld)
+import Data.Foldable (traverse_)
+import Data.ReinterpretCast (doubleToWord, wordToDouble)
+import Data.Text (Text)
+import Test.QuickCheck (property)
+import Test.QuickCheck.IO (propertyIO)
+import Text.Heredoc (here)
+
+import qualified Data.ByteString as BS
+import qualified Data.Vector as V
+
+import Capnp.Untyped
+import Util
+
+import Capnp (cerialize, createPure, def, getRoot, newRoot)
+import Capnp.TraversalLimit (LimitT, evalLimitT, execLimitT)
+import Data.Mutable (Thaw(..))
+
+import Instances ()
+
+import Capnp.Gen.Capnp.Schema.Pure (Brand, Method(..), Node'Parameter)
+
+import qualified Capnp.Classes as C
+import qualified Capnp.Message as M
+
+import qualified Capnp.Gen.Capnp.Schema as Schema
+
+untypedTests :: Spec
+untypedTests = describe "low-level untyped API tests" $ do
+ readTests
+ modifyTests
+ farPtrTest
+ otherMessageTest
+
+readTests :: Spec
+readTests = describe "read tests" $
+ it "Should agree with `capnp decode`" $ do
+ msg <- encodeValue
+ aircraftSchemaSrc
+ "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 ()
+ endQuota `shouldBe` 110
+
+data ModTest s = ModTest
+ { testIn :: String
+ , testMod :: Struct (M.MutMsg RealWorld) -> LimitT IO ()
+ , testOut :: String
+ , testType :: String
+ }
+
+modifyTests :: Spec
+modifyTests = describe "modification tests" $ traverse_ 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{..} =
+ it ("Should satisfy: " ++ show testIn ++ " : " ++ testType ++ " == " ++ show testOut) $ do
+ msg <- thaw =<< encodeValue aircraftSchemaSrc testType testIn
+ evalLimitT 128 $ rootPtr msg >>= testMod
+ actualOut <- decodeValue aircraftSchemaSrc testType =<< freeze msg
+ actualOut `shouldBe` testOut
+
+
+farPtrTest :: Spec
+farPtrTest = describe "Setting cross-segment pointers shouldn't crash" $ do
+ -- I(zenhack) am disappointed in hindsight that we only check for crashes
+ -- here; we should make these more thorough, actually checking validity
+ -- somehow.
+ it "Should work when setting the root pointer" $ do
+ pure () :: IO () -- Not sure why ghc needs this hint, but it does.
+ msg <- M.newMessage Nothing
+ -- 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 :: IO ()
+ it "Should work when setting a field in a struct" $ do
+ pure () :: IO () -- Not sure why ghc needs this hint, but it does.
+ evalLimitT maxBound $ do
+ msg <- M.newMessage Nothing
+ srcStruct <- allocStruct msg 4 4
+ (1, _) <- M.newSegment msg 10
+ dstStruct <- allocStruct msg 2 2
+ ptr <- C.toPtr msg dstStruct
+ setPtr ptr 0 srcStruct
+
+otherMessageTest :: Spec
+otherMessageTest = describe "Setting pointers in other messages" $
+ it "Should copy them if needed." $
+ property $ \(name :: Text) (params :: V.Vector Node'Parameter) (brand :: Brand) ->
+ propertyIO $ do
+ let expected = def
+ { name = name
+ , implicitParameters = params
+ , paramBrand = brand
+ }
+ msg :: M.ConstMsg <- createPure maxBound $ do
+ methodMsg <- M.newMessage Nothing
+ nameMsg <- M.newMessage Nothing
+ paramsMsg <- M.newMessage Nothing
+ brandMsg <- M.newMessage Nothing
+
+ methodCerial <- newRoot methodMsg
+ nameCerial <- cerialize nameMsg name
+ brandCerial <- cerialize brandMsg brand
+
+ -- We don't implement Cerialize for Vector, so we can't just
+ -- inject params directly. TODO: implement Cerialize for Vector.
+ wrapper <- cerialize paramsMsg expected
+ paramsCerial <- Schema.get_Method'implicitParameters wrapper
+
+ Schema.set_Method'name methodCerial nameCerial
+ Schema.set_Method'implicitParameters methodCerial paramsCerial
+ Schema.set_Method'paramBrand methodCerial brandCerial
+
+ pure methodMsg
+ actual <- evalLimitT maxBound $ getRoot msg >>= C.decerialize
+ actual `shouldBe` expected
diff --git a/tests/Module/Capnp/Untyped/Pure.hs b/tests/Module/Capnp/Untyped/Pure.hs
new file mode 100644
--- /dev/null
+++ b/tests/Module/Capnp/Untyped/Pure.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Module.Capnp.Untyped.Pure (pureUntypedTests) where
+
+import Test.Hspec
+
+import Data.ReinterpretCast (doubleToWord)
+import Text.Heredoc (here)
+
+import qualified Data.Vector as V
+
+import Capnp.Untyped.Pure
+import Util
+
+import Capnp.Classes (decerialize)
+import Capnp.TraversalLimit (LimitT, runLimitT)
+
+import qualified Capnp.Message as M
+import qualified Capnp.Untyped as U
+
+-- This is analogous to Tests.Module.Capnp.Untyped.untypedTests, but
+-- using the Pure module:
+pureUntypedTests :: Spec
+pureUntypedTests =
+ describe "high-level untyped decoding" $
+ it "Should agree with `capnp decode`" $ do
+ msg <- encodeValue
+ aircraftSchemaSrc
+ "Aircraft"
+ [here|(f16 = (base = (
+ name = "bob",
+ homes = [],
+ rating = 7,
+ canFly = true,
+ capacity = 5173,
+ maxSpeed = 12.0
+ )))|]
+ (actual, 110) <- runLimitT 128 $ U.rootPtr msg >>= readStruct
+ actual `shouldBe` 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 []
+ ]
+ ]
+ ]
+ where
+ readStruct :: U.Struct M.ConstMsg -> LimitT IO Struct
+ readStruct = decerialize
diff --git a/tests/Regression.hs b/tests/Regression.hs
new file mode 100644
--- /dev/null
+++ b/tests/Regression.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Regression (regressionTests) where
+
+import Test.Hspec
+
+import Capnp (bsToValue, def)
+
+import Capnp.Gen.Aircraft.Pure
+import Capnp.Gen.Capnp.Rpc.Pure
+
+regressionTests :: Spec
+regressionTests = describe "Regression tests" $ do
+ it "Should decode abort message successfully (issue #56)" $ do
+ let bytes =
+ "\NUL\NUL\NUL\NUL\ETB\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL" <>
+ "\SOH\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL" <>
+ "\SOH\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL" <>
+ "\NUL\NULz\EOT\NUL\NULYour vat sent an 'unimplemented' " <>
+ "message for an abort message that its remote peer never " <>
+ "sent. This is likely a bug in your capnproto library.\NUL\NUL"
+ msg <- bsToValue bytes
+ msg `shouldBe` Message'abort def
+ { reason =
+ "Your vat sent an 'unimplemented' message for an abort " <>
+ "message that its remote peer never sent. This is likely " <>
+ "a bug in your capnproto library."
+ , type_ = Exception'Type'failed
+ }
+ it "Should decode negative default values correctly (issue #55)" $ do
+ -- Note that this was never actually broken, but we were getting
+ -- a warning about a literal overflowing the bounds of its type.
+ -- It worked anyway, since it became the right value after casting,
+ -- but the warning has been fixed and this test makes sure it still
+ -- actually works.
+ let Defaults{int} = def
+ int `shouldBe` (-123)
diff --git a/tests/SchemaGeneration.hs b/tests/SchemaGeneration.hs
new file mode 100644
--- /dev/null
+++ b/tests/SchemaGeneration.hs
@@ -0,0 +1,182 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module 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
+ (_ :| (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/SchemaQuickCheck.hs b/tests/SchemaQuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/tests/SchemaQuickCheck.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module SchemaQuickCheck
+ (schemaCGRQuickCheck)
+ where
+
+import qualified Data.ByteString as BS
+
+import Capnp.Bits (WordCount)
+import Capnp.Classes (fromStruct)
+import Capnp.Errors (Error)
+import Capnp.Message as M
+import Capnp.TraversalLimit (LimitT, runLimitT)
+
+import qualified Capnp.Basics as Basics
+import qualified Capnp.Gen.Capnp.Schema as Schema
+import qualified Capnp.Untyped as Untyped
+
+-- Testing framework imports
+import Test.Hspec
+import Test.QuickCheck
+
+-- Schema generation imports
+import SchemaGeneration
+import 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 (WordCount, 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
+ _ <- 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 (WordCount, Int)) of
+ Left _ -> False
+ Right _ -> True
+
+schemaCGRQuickCheck :: Spec
+schemaCGRQuickCheck =
+ describe "generateCGR an decodeCGR agree" $
+ it "successfully decodes generated schema" $
+ property $ prop_schemaValid <$> genSchema
diff --git a/tests/Tests/Module/Capnp/Capnp/Schema.hs b/tests/Tests/Module/Capnp/Capnp/Schema.hs
deleted file mode 100644
--- a/tests/Tests/Module/Capnp/Capnp/Schema.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-module Tests.Module.Capnp.Capnp.Schema (schemaTests) where
-
-import Control.Monad (when)
-import Control.Monad.Primitive (RealWorld)
-import Text.Heredoc (there)
-
-import Capnp.Capnp.Schema
-
-import Data.Capnp (newRoot)
-import Data.Capnp.TraversalLimit (LimitT, evalLimitT)
-import Data.Mutable (Thaw(..))
-import Tests.Util (assertionsToTest, decodeValue)
-
-import qualified Data.Capnp.Message as M
-
-data BuildTest = BuildTest
- { typeName :: String
- , expected :: String
- , builder :: M.MutMsg RealWorld -> LimitT IO ()
- }
-
-schemaTests = assertionsToTest "Test typed setters" $ map testCase
- [ BuildTest
- { typeName = "Field"
- , expected = concat
- [ "( codeOrder = 4,\n"
- , " discriminantValue = 6,\n"
- , " group = (typeId = 322),\n"
- , " ordinal = (explicit = 22) )\n"
- ]
- , builder = \msg -> do
- field <- newRoot msg
- set_Field'codeOrder field 4
- set_Field'discriminantValue field 6
- union <- get_Field'union' field
- group <- set_Field'group union
- set_Field'group'typeId group 322
- ordinal <- get_Field'ordinal field
- set_Field'ordinal'explicit ordinal 22
- }
- ]
- where
- testCase BuildTest{..} = do
- msg <- M.newMessage
- evalLimitT maxBound $ builder msg
- constMsg <- freeze msg
- actual <- decodeValue schemaSchema typeName constMsg
- when (actual /= expected) $
- error $ "Expected:\n\n" ++ show expected ++ "\n\n...but got:\n\n" ++ show actual
-
-schemaSchema = [there|core-schema/capnp/schema.capnp|]
diff --git a/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs b/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs
deleted file mode 100644
--- a/tests/Tests/Module/Capnp/Capnp/Schema/Pure.hs
+++ /dev/null
@@ -1,505 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Tests.Module.Capnp.Capnp.Schema.Pure (pureSchemaTests) where
-
-import Data.Proxy
-
-import Control.Exception (bracket)
-import Control.Monad (when)
-import Control.Monad.Primitive (RealWorld)
-import Data.Default (Default(..))
-import System.Directory (removeFile)
-import System.IO
- (IOMode(ReadMode, WriteMode), hClose, openBinaryTempFile, withBinaryFile)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit.Lang (Assertion, assertEqual)
-import Test.QuickCheck (Property)
-import Test.QuickCheck.Instances ()
-import Test.QuickCheck.IO (propertyIO)
-import Text.Heredoc (here, there)
-import Text.Show.Pretty (ppShow)
-
-import qualified Data.ByteString.Builder as BB
-import qualified Data.ByteString.Lazy as LBS
-
-import Capnp.Capnp.Schema.Pure
-import Tests.Util
-
-import Instances ()
-
-import Data.Capnp (getRoot, hGetValue, hPutValue, setRoot)
-import Data.Capnp.Classes
- ( Allocate(..)
- , Cerialize(..)
- , Decerialize(..)
- , FromStruct(..)
- , ToStruct(..)
- )
-import Data.Capnp.TraversalLimit (defaultLimit, evalLimitT)
-import Data.Mutable (Thaw(..))
-
-import qualified Data.Capnp.Message as M
-import qualified Data.Capnp.Untyped as U
-
-schemaText = [there|tests/data/schema.capnp|]
-
-pureSchemaTests = testGroup "Tests for generated .Pure modules."
- [ decodeTests
- , decodeDefaultTests
- , encodeTests
- , propTests
- ]
-
-encodeTests = testGroup "schema encode tests"
- [ testCase
- ( "Node.Parameter"
- , Node'Parameter { name = "Bob" }
- , "(name = \"Bob\")\n"
- )
- ]
- where
- testCase ::
- -- TODO: the size of this context is *stupid*
- ( Show a
- , Eq a
- , Cerialize RealWorld a
- , FromStruct M.ConstMsg (Cerial M.ConstMsg a)
- , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
- , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a)
- ) => (String, a, String) -> Test
- testCase (name, expectedValue, expectedText) =
- assertionsToTest ("Check cerialize against capnp decode (" ++ name ++ ")") $ pure $ do
- msg <- evalLimitT maxBound $ do
- -- TODO: add some helpers for all this.
- msg <- M.newMessage
- cerialOut <- cerialize msg expectedValue
- setRoot cerialOut
- freeze msg
- builder <- M.encode msg
- actualText <- capnpDecode
- (LBS.toStrict $ BB.toLazyByteString builder)
- (MsgMetaData schemaText name)
- assertEqual ("Encode " ++ show expectedValue)
- expectedText
- actualText
- actualValue <- evalLimitT maxBound $ do
- root <- U.rootPtr msg
- cerialIn <- fromStruct root
- decerialize cerialIn
- assertEqual
- ("decerialize (cerialize " ++ show expectedValue ++ ") == " ++ show actualValue)
- expectedValue
- actualValue
-
-decodeTests = testGroup "schema decode tests"
- [ decodeTests "CodeGeneratorRequest"
- [ ( [here|
- ( capnpVersion = (major = 0, minor = 6, micro = 1)
- , nodes = []
- , requestedFiles =
- [ ( id = 4
- , filename = "hello.capnp"
- , imports =
- [ (id = 2, name = "std")
- ]
- )
- ]
- )
- |]
- , CodeGeneratorRequest
- { capnpVersion = CapnpVersion { major = 0, minor = 6, micro = 1 }
- , nodes = []
- , requestedFiles =
- [ CodeGeneratorRequest'RequestedFile
- 4
- "hello.capnp"
- [CodeGeneratorRequest'RequestedFile'Import 2 "std"]
- ]
- }
- )
- ]
- , decodeTests "Node"
- [ ( [here|
- ( id = 7
- , displayName = "foo:MyType"
- , displayNamePrefixLength = 4
- , scopeId = 2
- , parameters = [ (name = "theName") ]
- , isGeneric = true
- , nestedNodes = [(name = "theName", id = 321)]
- , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ]
- , |] ++ unionText ++ [here|
- )
- |]
- , Node
- 7
- "foo:MyType"
- 4
- 2
- [Node'NestedNode "theName" 321]
- [Annotation 2 (Value'bool True) (Brand [])]
- [Node'Parameter "theName" ]
- True
- unionVal
- )
- | (unionText, unionVal) <-
- [ ("file = void", Node'file)
- , ( [here| struct =
- ( dataWordCount = 3
- , pointerCount = 2
- , preferredListEncoding = inlineComposite
- , isGroup = false
- , discriminantCount = 4
- , discriminantOffset = 2
- , fields =
- [ ( name = "fieldName"
- , codeOrder = 3
- , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ]
- , discriminantValue = 7
- , group = (typeId = 4)
- , ordinal = (implicit = void)
- )
- ]
- )
- |]
- , Node'struct
- { dataWordCount = 3
- , pointerCount = 2
- , preferredListEncoding = ElementSize'inlineComposite
- , isGroup = False
- , discriminantCount = 4
- , discriminantOffset = 2
- , fields =
- [ Field
- "fieldName"
- 3
- [ Annotation
- 2
- (Value'bool True)
- (Brand [])
- ]
- 7
- Field'ordinal'implicit
- (Field'group 4)
- ]
- }
- )
- , ( "enum = (enumerants = [(name = \"blue\", codeOrder = 2, annotations = [])])"
- , Node'enum [ Enumerant "blue" 2 [] ]
- )
- , ( "interface = (methods = [], superclasses = [(id = 0, brand = (scopes = []))])"
- , Node'interface [] [Superclass 0 (Brand [])]
- )
- , ( "const = (type = (bool = void), value = (bool = false))"
- , Node'const Type'bool (Value'bool False)
- )
- , ( [here| annotation =
- ( type = (bool = void)
- , targetsFile = true
- , targetsConst = false
- , targetsEnum = false
- , targetsEnumerant = true
- , targetsStruct = true
- , targetsField = true
- , targetsUnion = false
- , targetsGroup = false
- , targetsInterface = true
- , targetsMethod = false
- , targetsParam = true
- , targetsAnnotation = false
- )
- |]
- , Node'annotation
- Type'bool
- True
- False
- False
- True
- True
- True
- False
- False
- True
- False
- True
- False
- )
- ]
- ]
- , decodeTests "Node.Parameter"
- [ ("(name = \"theName\")", Node'Parameter "theName" )
- ]
- , decodeTests "Node.NestedNode"
- [ ("(name = \"theName\", id = 321)", Node'NestedNode "theName" 321)
- ]
- , decodeTests "Value"
- [ ("(bool = true)", Value'bool True)
- , ("(bool = false)", Value'bool False)
- , ("(int8 = -4)", Value'int8 (-4))
- , ("(int8 = -128)", Value'int8 (-128))
- , ("(int8 = 127)", Value'int8 127)
- , ("(uint8 = 23)", Value'uint8 23)
- , ("(uint8 = 255)", Value'uint8 255)
- , ("(int16 = 1012)", Value'int16 1012)
- , ("(uint16 = 40000)", Value'uint16 40000)
- , ("(uint32 = 1000100)", Value'uint32 1000100)
- , ("(int32 = 1000100)", Value'int32 1000100)
- , ("(uint64 = 1234567890123456)", Value'uint64 1234567890123456)
- , ("(int64 = 12345678901234567)", Value'int64 12345678901234567)
- , ("(float32 = 17.32)", Value'float32 17.32)
- , ("(float64 = 13.99)", Value'float64 13.99)
- , ("(data = \"beep boop.\")", Value'data_ "beep boop.")
- , ("(text = \"Hello, World!\")", Value'text "Hello, World!")
- , ("(enum = 2313)", Value'enum 2313)
- , ("(interface = void)", Value'interface)
- -- TODO: It would be nice to test list, struct, and anyPointer
- -- variants, but I(zenhack) haven't figured out how to specify
- -- an AnyPointer in the input to capnp encode. Maybe capnp eval
- -- can do something like this? will have to investigate.
- ]
- , decodeTests "Annotation"
- [ ( "(id = 323, brand = (scopes = []), value = (bool = true))"
- , Annotation 323 (Value'bool True) (Brand [])
- )
- ]
- , decodeTests "CapnpVersion"
- [ ("(major = 0, minor = 5, micro = 3)", CapnpVersion 0 5 3)
- , ("(major = 1, minor = 0, micro = 2)", CapnpVersion 1 0 2)
- ]
- , decodeTests "Field"
- [ ( [here|
- ( name = "fieldName"
- , codeOrder = 3
- , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ]
- , discriminantValue = 3
- , group = (typeId = 4)
- , ordinal = (implicit = void)
- )
- |]
- , Field
- "fieldName"
- 3
- [Annotation 2 (Value'bool True) (Brand [])]
- 3
- Field'ordinal'implicit
- (Field'group 4)
- )
- , ( [here|
- ( name = "fieldName"
- , codeOrder = 3
- , annotations = [ (id = 2, brand = (scopes = []), value = (bool = true)) ]
- , discriminantValue = 3
- , slot =
- ( offset = 3
- , type = (bool = void)
- , defaultValue = (bool = false)
- , hadExplicitDefault = true
- )
- , ordinal = (explicit = 7)
- )
- |]
- , Field
- "fieldName"
- 3
- [Annotation 2 (Value'bool True) (Brand [])]
- 3
- (Field'ordinal'explicit 7)
- (Field'slot
- 3
- Type'bool
- (Value'bool False)
- True)
- )
- ]
- , decodeTests "Enumerant"
- [ ( [here|
- ( name = "red"
- , codeOrder = 4
- , annotations =
- [ (id = 23, brand = (scopes = []), value = (uint8 = 3))
- ]
- )
- |]
- , Enumerant "red" 4 [Annotation 23 (Value'uint8 3) (Brand [])]
- )
- ]
- , decodeTests "Superclass"
- [ ("(id = 34, brand = (scopes = []))", Superclass 34 (Brand []))
- ]
- , decodeTests "Type"
- [ ("(bool = void)", Type'bool)
- , ("(int8 = void)", Type'int8)
- , ("(int16 = void)", Type'int16)
- , ("(int32 = void)", Type'int32)
- , ("(int64 = void)", Type'int64)
- , ("(uint8 = void)", Type'uint8)
- , ("(uint16 = void)", Type'uint16)
- , ("(uint32 = void)", Type'uint32)
- , ("(uint64 = void)", Type'uint64)
- , ("(float32 = void)", Type'float32)
- , ("(float64 = void)", Type'float64)
- , ("(text = void)", Type'text)
- , ("(data = void)", Type'data_)
- , ( "(list = (elementType = (list = (elementType = (text = void)))))"
- , Type'list $ Type'list Type'text
- )
- , ( "(enum = (typeId = 4, brand = (scopes = [])))"
- , Type'enum 4 (Brand [])
- )
- , ( "(struct = (typeId = 7, brand = (scopes = [])))"
- , Type'struct 7 (Brand [])
- )
- , ( "(interface = (typeId = 1, brand = (scopes = [])))"
- , Type'interface 1 (Brand [])
- )
- , ( "(anyPointer = (unconstrained = (anyKind = void)))"
- , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'anyKind
- )
- , ( "(anyPointer = (unconstrained = (struct = void)))"
- , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'struct
- )
- , ( "(anyPointer = (unconstrained = (list = void)))"
- , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'list
- )
- , ( "(anyPointer = (unconstrained = (capability = void)))"
- , Type'anyPointer $ Type'anyPointer'unconstrained Type'anyPointer'unconstrained'capability
- )
- , ( "(anyPointer = (parameter = (scopeId = 4, parameterIndex = 2)))"
- , Type'anyPointer $ Type'anyPointer'parameter 4 2
- )
- , ( "(anyPointer = (implicitMethodParameter = (parameterIndex = 7)))"
- , Type'anyPointer $ Type'anyPointer'implicitMethodParameter 7
- )
- ]
- , decodeTests "Brand"
- [ ("(scopes = [])", Brand [])
- , ( [here|
- ( scopes =
- [ (scopeId = 32, inherit = void)
- , (scopeId = 23, bind =
- [ (unbound = void)
- , (type = (bool = void))
- ]
- )
- ]
- )
- |]
- , Brand
- [ Brand'Scope 32 Brand'Scope'inherit
- , Brand'Scope 23 $ Brand'Scope'bind
- [ Brand'Binding'unbound
- , Brand'Binding'type_ Type'bool
- ]
- ]
- )
- ]
- ]
- where
- -- decodeTests :: Decerialize Struct a => String -> [(String, a)] -> IO ()
- decodeTests typename cases =
- assertionsToTest ("Decode " ++ typename) $ map (testCase typename) cases
- testCase typename (capnpText, expected) = do
- msg <- encodeValue schemaText typename capnpText
- actual <- evalLimitT 128 $ getRoot msg
- ppAssertEqual actual expected
-
-decodeDefaultTests = assertionsToTest
- "Check that the empty struct decodes to the default value"
- [ decodeDefault "Type" (Proxy :: Proxy Type)
- , decodeDefault "Value" (Proxy :: Proxy Value)
- , decodeDefault "Node" (Proxy :: Proxy Node)
- ]
-
-decodeDefault ::
- ( Show a
- , Eq a
- , Default a
- , FromStruct M.ConstMsg a
- , Cerialize RealWorld a
- , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
- ) => String -> Proxy a -> Assertion
-decodeDefault typename proxy = do
- actual <- evalLimitT defaultLimit (getRoot M.empty)
- ppAssertEqual (actual `asProxyTypeOf` proxy) def
-
-ppAssertEqual :: (Show a, Eq a) => a -> a -> IO ()
-ppAssertEqual actual expected =
- when (actual /= expected) $ error $
- "Expected:\n\n" ++ ppShow expected ++ "\n\nbut got:\n\n" ++ ppShow actual
-
-propTests = testGroup "Various quickcheck properties"
- [ propCase "Node" (Proxy :: Proxy Node)
- , propCase "Node.Parameter" (Proxy :: Proxy Node'Parameter)
- , propCase "Node.NestedNode" (Proxy :: Proxy Node'NestedNode)
- , propCase "Field" (Proxy :: Proxy Field)
- , propCase "Enumerant" (Proxy :: Proxy Enumerant)
- , propCase "Superclass" (Proxy :: Proxy Superclass)
- , propCase "Method" (Proxy :: Proxy Method)
- , propCase "Type" (Proxy :: Proxy Type)
- , propCase "Brand" (Proxy :: Proxy Brand)
- , propCase "Brand.Scope" (Proxy :: Proxy Brand'Scope)
- , propCase "Brand.Binding" (Proxy :: Proxy Brand'Binding)
- , propCase "Value" (Proxy :: Proxy Value)
- , propCase "Annotation" (Proxy :: Proxy Annotation)
- , propCase "CapnpVersion" (Proxy :: Proxy CapnpVersion)
- , propCase "CodeGeneratorRequest" (Proxy :: Proxy CodeGeneratorRequest)
- , propCase "CodeGeneratorRequest.RequestedFile"
- (Proxy :: Proxy CodeGeneratorRequest'RequestedFile)
- , propCase "CodeGeneratorRequest.RequestedFile.Import"
- (Proxy :: Proxy CodeGeneratorRequest'RequestedFile'Import)
- ]
-
-propCase name proxy = testGroup ("...for " ++ name)
- [ testProperty "check that cerialize and decerialize are inverses." (prop_cerializeDecerializeInverses proxy)
- , testProperty "check that hPutValue and hGetValue are inverses." (prop_hGetPutInverses proxy)
- ]
-
-prop_hGetPutInverses ::
- ( Show a
- , Eq a
- , FromStruct M.ConstMsg a
- , Cerialize RealWorld a
- , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
- ) => Proxy a -> a -> Property
-prop_hGetPutInverses proxy expected = propertyIO $ do
- -- This is a little more complicated than I'd like due to resource
- -- management issues. We create a temporary file, then immediately
- -- close the handle to it, and open it again in a separate call to
- -- bracket. This allows us to decouple the lifetimes of the file and
- -- the handle.
- actual <- bracket
- (do
- (filename, handle) <- openBinaryTempFile "/tmp" "hPutValue-output"
- hClose handle
- pure filename)
- removeFile
- (\filename -> do
- withBinaryFile filename WriteMode
- (`hPutValue` expected)
- withBinaryFile filename ReadMode $ \h ->
- hGetValue h defaultLimit)
- ppAssertEqual actual expected
-prop_cerializeDecerializeInverses ::
- ( Show a
- , Eq a
- , Cerialize RealWorld a
- , FromStruct M.ConstMsg (Cerial M.ConstMsg a)
- , ToStruct (M.MutMsg RealWorld) (Cerial (M.MutMsg RealWorld) a)
- , Allocate RealWorld (Cerial (M.MutMsg RealWorld) a)
- ) => Proxy a -> a -> Property
-prop_cerializeDecerializeInverses _proxy expected = propertyIO $ do
- actual <- evalLimitT maxBound $ do
- -- TODO: add some helpers for all this.
- msg <- M.newMessage
- cerialOut <- cerialize msg expected
- setRoot cerialOut
- constMsg :: M.ConstMsg <- freeze msg
- root <- U.rootPtr constMsg
- cerialIn <- fromStruct root
- decerialize cerialIn
- ppAssertEqual actual expected
diff --git a/tests/Tests/Module/Data/Capnp/Bits.hs b/tests/Tests/Module/Data/Capnp/Bits.hs
deleted file mode 100644
--- a/tests/Tests/Module/Data/Capnp/Bits.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-module Tests.Module.Data.Capnp.Bits (bitsTests) where
-
-import Data.Bits
-import Data.Word
-
-import Test.Framework (testGroup)
-import Test.HUnit (Assertion, assertEqual)
-import Tests.Util (assertionsToTest)
-
-import Data.Capnp.Bits
-
-
-bitsTests = testGroup "bits tests" [bitRangeExamples, replaceBitsExamples]
-
-bitRangeExamples = assertionsToTest "bitRange examples" $
- map bitRangeTest $
- ones ++
- [ (0x0000000200000000, 32, 48, 2)
- ]
- where
- bitRangeTest (word, lo, hi, expected) =
- assertEqual
- (concat [ "bitRange ", show word, " ", show lo, " ", show hi
- , " == "
- , show expected
- ])
- expected
- (bitRange word lo hi)
- ones = map (\bit -> (1 `shiftL` bit, bit, bit + 1, 1)) [0..63]
-
-replaceBitsExamples = assertionsToTest "replaceBits"
- [ replaceTest 8 (0xf :: Word8) 0 0 0xf
- , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1
- , replaceTest 8 (0x2 :: Word8) 0x1 0 0x2
- , replaceTest 8 (0x1 :: Word8) 0xf 0 0x1
- , replaceTest 8 (0x2 :: Word8) 0x10 4 0x20
- , replaceTest 8 (0x1 :: Word8) 0x10 8 0x0110
- , replaceTest 8 (0xa :: Word8) 0xffff 8 0x0aff
- , replaceTest 1 (0x0 :: Word1) 0xff 4 0xef
- ]
- where
- replaceTest :: (Bounded a, Integral a, Show a)
- => Int -> a -> Word64 -> Int -> Word64 -> Assertion
- replaceTest len new orig shift expected =
- assertEqual (concat [ "replaceBits (", show new, " :: Word", show len, ") "
- , show orig, " ", show shift
- , " == "
- , show expected
- ])
- expected
- (replaceBits new orig shift)
diff --git a/tests/Tests/Module/Data/Capnp/Pointer.hs b/tests/Tests/Module/Data/Capnp/Pointer.hs
deleted file mode 100644
--- a/tests/Tests/Module/Data/Capnp/Pointer.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-module Tests.Module.Data.Capnp.Pointer (ptrTests) where
-
-import Data.Bits
-import Data.Int
-import Data.Word
-
-import Test.Framework (testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (assertEqual)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import Test.QuickCheck.Gen (Gen, oneof)
-
-import Data.Capnp.Pointer
-
-import Tests.Util (assertionsToTest)
-
-instance Arbitrary EltSpec where
- arbitrary = oneof [ EltNormal <$> arbitrary <*> arbitraryU29
- , EltComposite <$> arbitraryI29
- ]
-
-instance Arbitrary ElementSize where
- arbitrary = oneof $ map return [ Sz0
- , Sz1
- , Sz8
- , Sz16
- , Sz32
- , Sz64
- , SzPtr
- ]
-
-
--- | arbitraryIN is an arbitrary N bit signed integer as an Int32.
-arbitraryI32, arbitraryI30, arbitraryI29 :: Gen Int32
-arbitraryI32 = arbitrary
-arbitraryI30 = (`shiftR` 2) <$> arbitraryI32
-arbitraryI29 = (`shiftR` 3) <$> arbitraryI32
--- | arbitraryUN is an arbitrary N bit unsigned integer as a Word32.
-arbitraryU32, arbitraryU30, arbitraryU29 :: Gen Word32
-arbitraryU32 = arbitrary
-arbitraryU30 = (`shiftR` 2) <$> arbitraryU32
-arbitraryU29 = (`shiftR` 3) <$> arbitraryU32
-
-
-instance Arbitrary Ptr where
- arbitrary = oneof [ StructPtr <$> arbitraryI30
- <*> arbitrary
- <*> arbitrary
- , ListPtr <$> arbitraryI30
- <*> arbitrary
- , FarPtr <$> arbitrary
- <*> arbitraryU29
- <*> arbitrary
- , CapPtr <$> arbitrary
- ]
-
-ptrTests = testGroup "Pointer Tests" [ptrProps, parsePtrExamples]
-
-ptrProps = testGroup "Pointer Properties"
- [ testProperty "parseEltSpec . serializeEltSpec == id"
- (\spec -> parseEltSpec (serializeEltSpec spec) == spec)
- , testProperty "parsePtr . serializePtr == id" $ \ptr ->
- case ptr of
- (Just (StructPtr 0 0 0)) -> True -- we skip this one, since it's
- -- the same bits as a null, so this
- -- shouldn't hold. TODO: the name
- -- of this test is a bit misleading
- -- because of this case; should fix
- -- that.
- _ -> parsePtr (serializePtr ptr) == ptr
- ]
-
-
-parsePtrExamples = assertionsToTest "parsePtr Examples" $
- map parseExample
- [ (0x0000000200000000, Just $ StructPtr 0 2 0)
- ]
- where
- parseExample (word, expected) =
- assertEqual
- (concat ["parsePtr ", show word, " == ", show expected])
- expected
- (parsePtr word)
diff --git a/tests/Tests/Module/Data/Capnp/Untyped.hs b/tests/Tests/Module/Data/Capnp/Untyped.hs
deleted file mode 100644
--- a/tests/Tests/Module/Data/Capnp/Untyped.hs
+++ /dev/null
@@ -1,343 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Tests.Module.Data.Capnp.Untyped (untypedTests) where
-
-import Prelude hiding (length)
-
-import Control.Monad (forM_, when)
-import Control.Monad.Catch (MonadThrow(throwM))
-import Control.Monad.Primitive (RealWorld)
-import Data.ReinterpretCast (doubleToWord, wordToDouble)
-import Data.Text (Text)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (assertEqual)
-import Test.QuickCheck (Property)
-import Test.QuickCheck.IO (propertyIO)
-import Text.Heredoc (here, there)
-
-import qualified Data.ByteString as BS
-import qualified Data.Vector as V
-
-import Data.Capnp.Untyped
-import Tests.Util
-
-import Data.Capnp (cerialize, createPure, def, getRoot, newRoot)
-import Data.Capnp.TraversalLimit (LimitT, evalLimitT, execLimitT)
-import Data.Mutable (Thaw(..))
-
-import Instances ()
-
-import Capnp.Capnp.Schema.Pure (Brand, Method(..), Node'Parameter)
-
-import qualified Data.Capnp.Classes as C
-import qualified Data.Capnp.Message as M
-
-import qualified Capnp.Capnp.Schema as Schema
-
-untypedTests = testGroup "Untyped Tests"
- [ readTests
- , modifyTests
- , farPtrTest
- , otherMessageTest
- ]
-
-readTests :: Test
-readTests = assertionsToTest "read tests"
- [ do
- msg <- encodeValue
- [there|tests/data/aircraft.capnp|]
- "Aircraft"
- [here|(f16 = (base = (
- name = "bob",
- homes = [],
- rating = 7,
- canFly = true,
- capacity = 5173,
- maxSpeed = 12.0
- )))|]
- endQuota <- execLimitT 128 $ do
- root <- rootPtr msg
- let aircraftWords = dataSection root
- -- Aircraft just has the union tag, nothing else in it's data
- -- section.
- let 1 = length aircraftWords
- 3 <- index 0 aircraftWords -- tag for F16
- let 1 = length (ptrSection root)
- Just (PtrStruct f16) <- getPtr 0 root
- let 0 = length (dataSection f16)
- let 1 = length (ptrSection f16)
- Just (PtrStruct base) <- getPtr 0 f16
- let 4 = length (dataSection base) -- Except canFly, each field is 1 word, and
- -- canFly is aligned such that it ends up
- -- consuming a whole word.
- let 2 = length (ptrSection base) -- name, homes
-
- -- Walk the data section:
- 7 <- getData 0 base -- rating
- 1 <- getData 1 base -- canFly
- 5173 <- getData 2 base -- capacity
- 12.0 <- wordToDouble <$> getData 3 base
-
- -- ...and the pointer section:
- Just (PtrList (List8 name)) <- getPtr 0 base
- -- Text values have a NUL terminator, which is included in the
- -- length on the wire. The spec says that this shouldn't be
- -- included in the length reported to the caller, but that needs
- -- to be dealt with by schema-aware code, so this is the length of
- -- "bob\0"
- let 4 = length name
-
- forM_ (zip [0..3] (BS.unpack "bob\0")) $ \(i, c) -> do
- c' <- index i name
- when (c /= c') $
- error ("index " ++ show i ++ ": " ++ show c ++ " /= " ++ show c')
- Just (PtrList (List16 homes)) <- getPtr 1 base
- let 0 = length homes
- return ()
- assertEqual "endQuota == 110" 110 endQuota
- ]
-
-data ModTest s = ModTest
- { testIn :: String
- , testMod :: Struct (M.MutMsg RealWorld) -> LimitT IO ()
- , testOut :: String
- , testType :: String
- }
-
-modifyTests :: Test
-modifyTests = testGroup "Test modification" $ map testCase
- -- tests for setIndex
- [ ModTest
- { testIn = "(year = 2018, month = 6, day = 20)\n"
- , testType = "Zdate"
- , testOut = "(year = 0, month = 0, day = 0)\n"
- , testMod = setIndex 0 0 . dataSection
- }
- , ModTest
- { testIn = "(text = \"Hello, World!\")\n"
- , testType = "Z"
- , testOut = "(text = \"hEllo, world!\")\n"
- , testMod = \struct -> do
- Just (PtrList (List8 list)) <- index 0 (ptrSection struct)
- setIndex (fromIntegral (fromEnum 'h')) 0 list
- setIndex (fromIntegral (fromEnum 'E')) 1 list
- setIndex (fromIntegral (fromEnum 'w')) 7 list
- }
- , ModTest
- { testIn = "(boolvec = [true, true, false, true])\n"
- , testType = "Z"
- , testOut = "( boolvec = [false, true, true, false] )\n"
- , testMod = \struct -> do
- Just (PtrList (List1 list)) <- index 0 (ptrSection struct)
- setIndex False 0 list
- setIndex True 2 list
- setIndex False 3 list
- }
- , ModTest
- { testIn = "(f64 = 2.0)\n"
- , testType = "Z"
- , testOut = "(f64 = 7.2)\n"
- , testMod = setIndex (doubleToWord 7.2) 1 . dataSection
- }
- , ModTest
- { testIn = unlines
- [ "( size = 4,"
- , " words = \"Hello, World!\","
- , " wordlist = [\"apples\", \"oranges\"] )"
- ]
- , testType = "Counter"
- , testOut = unlines
- [ "( size = 4,"
- , " words = \"oranges\","
- , " wordlist = [\"apples\", \"Hello, World!\"] )"
- ]
- , testMod = \struct -> do
- Just (PtrList (ListPtr list)) <- index 1 (ptrSection struct)
- helloWorld <- index 0 (ptrSection struct)
- oranges <- index 1 list
- setIndex oranges 0 (ptrSection struct)
- setIndex helloWorld 1 list
- }
- , ModTest
- { testIn = unlines
- [ "( aircraftvec = ["
- , " ( f16 = ("
- , " base = ("
- , " name = \"alice\","
- , " homes = [],"
- , " rating = 7,"
- , " canFly = true,"
- , " capacity = 4,"
- , " maxSpeed = 100 ) ) ),"
- , " ( b737 = ("
- , " base = ("
- , " name = \"bob\","
- , " homes = [],"
- , " rating = 2,"
- , " canFly = false,"
- , " capacity = 9,"
- , " maxSpeed = 50 ) ) ) ] )"
- ]
- , testType = "Z"
- , testOut = unlines
- [ "( aircraftvec = ["
- , " ( f16 = ("
- , " base = ("
- , " name = \"alice\","
- , " homes = [],"
- , " rating = 7,"
- , " canFly = true,"
- , " capacity = 4,"
- , " maxSpeed = 100 ) ) ),"
- , " ( f16 = ("
- , " base = ("
- , " name = \"alice\","
- , " homes = [],"
- , " rating = 7,"
- , " canFly = true,"
- , " capacity = 4,"
- , " maxSpeed = 100 ) ) ) ] )"
- ]
- , testMod = \struct -> do
- Just (PtrList (ListStruct list)) <- getPtr 0 struct
- src <- index 0 list
- setIndex src 1 list
- }
- -- tests for allocation functions
- , ModTest
- { testIn = "()"
- , testType = "StackingRoot"
- , testOut = "( aWithDefault = (num = 6400),\n a = (num = 65, b = (num = 90000)) )\n"
-
- , testMod = \struct -> do
- when (length (ptrSection struct) /= 2) $
- error "struct's pointer section is unexpedly small"
-
- let msg = message struct
- a <- allocStruct msg 1 1
- aWithDefault <- allocStruct msg 1 1
- b <- allocStruct msg 1 0
- setPtr (Just (PtrStruct b)) 0 a
- setPtr (Just (PtrStruct aWithDefault)) 0 struct
- setPtr (Just (PtrStruct a)) 1 struct
- setData 65 0 a
- setData 6400 0 aWithDefault
- setData 90000 0 b
- }
- , ModTest
- { testIn = "()"
- , testType = "HoldsVerTwoTwoList"
- , testOut = "( mylist = [(val = 0, duo = 70), (val = 0, duo = 71), (val = 0, duo = 72), (val = 0, duo = 73)] )\n"
- , testMod = \struct -> do
- mylist <- allocCompositeList (message struct) 2 2 4
- forM_ [0..3] $ \i ->
- index i mylist >>= setData (70 + fromIntegral i) 1
- setPtr (Just $ PtrList $ ListStruct mylist) 0 struct
- }
- , allocNormalListTest "u64vec" 21 allocList64 List64
- , allocNormalListTest "u32vec" 22 allocList32 List32
- , allocNormalListTest "u16vec" 23 allocList16 List16
- , allocNormalListTest "u8vec" 24 allocList8 List8
- , ModTest
- { testIn = "()"
- , testType = "Z"
- , testOut = "( boolvec = [true, false, true] )\n"
- , testMod = \struct -> do
- setData 39 0 struct -- Set the union tag.
- boolvec <- allocList1 (message struct) 3
- forM_ [0..2] $ \i ->
- setIndex (even i) i boolvec
- setPtr (Just $ PtrList $ List1 boolvec) 0 struct
- }
- ]
- where
- -- generate a ModTest for a (normal) list allocation function.
- --
- -- parameters:
- --
- -- * tagname - the name of the union variant
- -- * tagvalue - the numeric value of the tag for this variant
- -- * allocList - the allocation function
- -- * dataCon - the data constructor for 'List' to use.
- allocNormalListTest tagname tagvalue allocList dataCon =
- ModTest
- { testIn = "()"
- , testType = "Z"
- , testOut = "(" ++ tagname ++ " = [0, 1, 2, 3, 4])\n"
- , testMod = \struct -> do
- setData tagvalue 0 struct
- vec <- allocList (message struct) 5
- forM_ [0..4] $ \i -> setIndex (fromIntegral i) i vec
- setPtr (Just $ PtrList $ dataCon vec) 0 struct
- }
- testCase ModTest{..} = assertionsToTest
- (show testIn ++ " : " ++ testType ++ " == " ++ show testOut) $
- pure $ do
- msg <- thaw =<< encodeValue schemaText testType testIn
- evalLimitT 128 $ rootPtr msg >>= testMod
- actualOut <- decodeValue schemaText testType =<< freeze msg
- assertEqual ( actualOut ++ " == " ++ testOut) actualOut testOut
- schemaText = [there|tests/data/aircraft.capnp|]
-
-
-farPtrTest = assertionsToTest
- "Setting cross-segment pointers should work."
- [ do
- msg <- M.newMessage
- -- The allocator always allocates new objects in the last segment, so
- -- if we create a new segment, the call to allocStruct below should
- -- allocate there:
- (1, _) <- M.newSegment msg 16
- struct <- allocStruct msg 3 4
- setRoot struct
- , evalLimitT maxBound $ do
- msg <- M.newMessage
- srcStruct <- allocStruct msg 4 4
- (1, _) <- M.newSegment msg 10
- dstStruct <- allocStruct msg 2 2
- setPtr (C.toPtr dstStruct) 0 srcStruct
- ]
-
-otherMessageTest :: Test
-otherMessageTest = testProperty
- "Setting pointers to values in other messages copies them if needed."
- otherMessageTest'
-
-otherMessageTest' :: Text -> V.Vector Node'Parameter -> Brand -> Property
-otherMessageTest' name params brand = propertyIO $ do
- let expected = def
- { name = name
- , implicitParameters = params
- , paramBrand = brand
- }
- let result = createPure maxBound $ do
- methodMsg <- M.newMessage
- nameMsg <- M.newMessage
- paramsMsg <- M.newMessage
- brandMsg <- M.newMessage
-
- methodCerial <- newRoot methodMsg
- nameCerial <- cerialize nameMsg name
- brandCerial <- cerialize brandMsg brand
-
- -- We don't implement Cerialize for Vector, so we can't just
- -- inject params directly. TODO: implement Cerialize for Vector.
- wrapper <- cerialize paramsMsg expected
- paramsCerial <- Schema.get_Method'implicitParameters wrapper
-
- Schema.set_Method'name methodCerial nameCerial
- Schema.set_Method'implicitParameters methodCerial paramsCerial
- Schema.set_Method'paramBrand methodCerial brandCerial
-
- pure methodMsg
- case result of
- Left e ->
- throwM e
- Right (msg :: M.ConstMsg) -> do
- actual <- evalLimitT maxBound $ getRoot msg >>= C.decerialize
- assertEqual (show actual ++ " == " ++ show expected) actual expected
diff --git a/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs b/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs
deleted file mode 100644
--- a/tests/Tests/Module/Data/Capnp/Untyped/Pure.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Tests.Module.Data.Capnp.Untyped.Pure (pureUntypedTests) where
-
-import Data.ReinterpretCast (doubleToWord)
-import Test.Framework (Test)
-import Test.HUnit (assertEqual)
-import Text.Heredoc (here, there)
-
-import qualified Data.Vector as V
-
-import Data.Capnp.Untyped.Pure
-import Tests.Util
-
-import Data.Capnp.Classes (decerialize)
-import Data.Capnp.TraversalLimit (LimitT, runLimitT)
-
-import qualified Data.Capnp.Message as M
-import qualified Data.Capnp.Untyped as U
-
--- This is analogous to Tests.Module.Data.Capnp.Untyped.untypedTests, but
--- using the Pure module:
-pureUntypedTests :: Test
-pureUntypedTests = assertionsToTest "Untyped ADT Tests"
- [ do
- msg <- encodeValue
- [there|tests/data/aircraft.capnp|]
- "Aircraft"
- [here|(f16 = (base = (
- name = "bob",
- homes = [],
- rating = 7,
- canFly = true,
- capacity = 5173,
- maxSpeed = 12.0
- )))|]
- (actual, 110) <- runLimitT 128 $ U.rootPtr msg >>= readStruct
- assertEqual
- "Untyped ADT test (assertEqual)"
- (Struct
- [3]
- [ Just $ PtrStruct $ Struct
- []
- [ Just $ PtrStruct $ Struct
- [ 7
- , 1
- , 5173
- , doubleToWord 12.0
- ]
- [ Just $ PtrList $ List8 $ V.fromList $ map (fromIntegral . fromEnum) "bob\0"
- , Just $ PtrList $ List16 []
- ]
- ]
- ])
- actual
- ]
- where
- readStruct :: U.Struct M.ConstMsg -> LimitT IO Struct
- readStruct = decerialize
diff --git a/tests/Tests/SchemaGeneration.hs b/tests/Tests/SchemaGeneration.hs
deleted file mode 100644
--- a/tests/Tests/SchemaGeneration.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Tests.SchemaGeneration
- ( Schema (..), genSchema
- ) where
-
-import Control.Monad.State.Strict
-
-import Control.Monad (replicateM)
-import Data.List.NonEmpty (NonEmpty((:|)))
-
-import qualified Data.List.NonEmpty as NE
-import qualified Test.QuickCheck as QC
-
--- Definitions
-
-newtype FieldName
- = FieldName String
-
-instance Show FieldName where
- show (FieldName fn) = fn
-
-newtype StructName
- = StructName String
-
-instance Show StructName where
- show (StructName fn) = fn
-
-data Field
- = FieldDef FieldName Int FieldType
- | StructDef StructName [Field]
-
-data BuiltIn
- = Void
- | Bool
- | Int8
- | Int16
- | Int32
- | Int64
- | UInt8
- | UInt16
- | UInt32
- | UInt64
- | Float32
- | Float64
- | Text
- | Data
- deriving (Show, Enum)
-
-data FieldType
- = BasicType BuiltIn
- | ListType FieldType
- | StructType StructName
-
-instance Show FieldType where
- show (BasicType bi) = show bi
- show (ListType ft) = "List(" ++ show ft ++ ")"
- show (StructType sn) = show sn
-
-instance Show Field where
- show (FieldDef name order entryType) = concat
- [ show name, " @", show order, " :"
- , show entryType, ";\n"
- ]
- show (StructDef name content) = concat
- [ "struct ", show name, " {\n"
- , concatMap (('\t':) . show) content
- , "}\n\n"
- ]
-
-data Schema = Schema
- { schemaId :: String
- , schemaContent :: [Field]
- }
-
-instance Show Schema where
- show s = concat
- [ "@0x", schemaId s, ";\n\n"
- , concatMap show (schemaContent s)
- ]
-
--- Helper generators
-
-genSafeLCChar :: QC.Gen Char
-genSafeLCChar = QC.elements ['a'..'z']
-
-genSafeUCChar :: QC.Gen Char
-genSafeUCChar = QC.elements ['A'..'Z']
-
-genSafeHexChar :: QC.Gen Char
-genSafeHexChar = QC.elements (['0'..'9'] ++ ['a'..'f'])
-
-newtype FieldGen a
- = FieldGen (StateT (NonEmpty (Int, Int)) QC.Gen a)
- deriving (Functor, Applicative, Monad)
-
-liftGen :: QC.Gen a -> FieldGen a
-liftGen m = FieldGen (lift m)
-
-runFieldGen :: FieldGen a -> QC.Gen a
-runFieldGen (FieldGen m) = fst <$> runStateT m ((0, 0) :| [])
-
-pushFieldGen :: FieldGen ()
-pushFieldGen = FieldGen $ modify (NE.cons (0, 0))
-
-popFieldGen :: FieldGen ()
-popFieldGen = FieldGen $ do
- original <- get
- case original of
- (x :| (y : rest)) -> put (y :| rest)
- (x :| []) -> put (x :| [])
-
-getStructOrder :: FieldGen Int
-getStructOrder = FieldGen $ do
- current <- get
- let (result, _) = NE.head current
- case current of
- ((x, y) :| rest) -> put ((x + 1, y) :| rest)
- return result
-
-getOrder :: FieldGen Int
-getOrder = FieldGen $ do
- current <- get
- let (_, result) = NE.head current
- case current of
- ((x, y) :| rest) -> put ((x + 1, y + 1) :| rest)
- return result
-
--- Field types
-
--- need to enumerate each field; this will be performed during struct
--- generation where the number of fields is known (numberDefs)
-genFieldDef :: [FieldType] -> FieldGen Field
-genFieldDef structTypes = do
- order <- getOrder
- fieldName <- do
- str <- liftGen $ QC.listOf1 genSafeLCChar
- return $ FieldName (str ++ show order)
- fieldType <- liftGen $ QC.elements (map BasicType [Bool ..] ++ structTypes)
- return $ FieldDef fieldName order fieldType
-
--- Struct type
-
--- like fields, we enumerate each struct during generation for uniqueness
-genStructDef :: Int -> FieldGen Field
-genStructDef depth = do
- order <- getStructOrder
-
- pushFieldGen
-
- -- generate the struct's name
- structName <- do
- fc <- liftGen genSafeUCChar
- rest <- liftGen (QC.listOf genSafeLCChar)
- return $ StructName ((fc:rest) ++ show order)
-
- -- generate the nested structs
- structNum <- if depth <= 0
- then pure 0
- else liftGen (QC.choose (0, 3))
- structDefs <- replicateM structNum (genStructDef (depth - 1))
-
- -- extract the available struct types
- let structTypes = map (\(StructDef sn _) -> (StructType sn)) structDefs
-
- -- generate the fields using available struct types
- fieldNum <- liftGen (QC.sized (\n -> QC.choose (1, 1 `max` n)))
- fieldDefs <- replicateM fieldNum (genFieldDef structTypes)
-
- popFieldGen
-
- return $ StructDef structName (fieldDefs ++ structDefs)
-
-
--- Schema type
-genSchema :: QC.Gen Schema
-genSchema = do
- id1st <- QC.elements ['a'..'f']
- idrest <- QC.vectorOf 15 genSafeHexChar
- -- multiple structs make tests take too long
- content <- runFieldGen (genStructDef 3)
- return $ Schema (id1st:idrest) [content]
diff --git a/tests/Tests/SchemaQuickCheck.hs b/tests/Tests/SchemaQuickCheck.hs
deleted file mode 100644
--- a/tests/Tests/SchemaQuickCheck.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module Tests.SchemaQuickCheck
- (schemaCGRQuickCheck)
- where
-
-import qualified Data.ByteString as BS
-
-import Data.Capnp.Classes (fromStruct)
-import Data.Capnp.Errors (Error)
-import Data.Capnp.Message as M
-import Data.Capnp.TraversalLimit (LimitT, runLimitT)
-
-import qualified Capnp.Capnp.Schema as Schema
-import qualified Data.Capnp.Basics as Basics
-import qualified Data.Capnp.Untyped as Untyped
-
--- Testing framework imports
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck
-
--- Schema generation imports
-import Tests.SchemaGeneration
-import Tests.Util
-
--- Schema validation imports
-import Control.Monad.Catch as C
-
--- Functions to generate valid CGRs
-
-generateCGR :: Schema -> IO BS.ByteString
-generateCGR schema = capnpCompile (show schema) "-"
-
--- Functions to validate CGRs
-
-decodeCGR :: BS.ByteString -> IO (Int, Int)
-decodeCGR bytes = do
- let reader :: Untyped.Struct M.ConstMsg -> LimitT IO Int
- reader struct = do
- req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct struct
- nodes <- Schema.get_CodeGeneratorRequest'nodes req
- requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req
- return (Basics.length nodes)
- msg <- M.decode bytes
- (numNodes, endQuota) <- runLimitT 1024 (Untyped.rootPtr msg >>= reader)
- return (endQuota, numNodes)
-
--- QuickCheck properties
-
-prop_schemaValid :: Schema -> Property
-prop_schemaValid schema = ioProperty $ do
- compiled <- generateCGR schema
- decoded <- try $ decodeCGR compiled
- return $ case (decoded :: Either Error (Int, Int)) of
- Left _ -> False
- Right _ -> True
-
-schemaCGRQuickCheck = testProperty "valid schema QuickCheck"
- (prop_schemaValid <$> genSchema)
diff --git a/tests/Tests/Util.hs b/tests/Tests/Util.hs
deleted file mode 100644
--- a/tests/Tests/Util.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-module Tests.Util
- ( MsgMetaData(..)
- , capnpEncode, capnpDecode, capnpCompile
- , decodeValue
- , encodeValue
- , assertionsToTest
- )
- where
-
-import System.Process hiding (readCreateProcessWithExitCode)
-
-import System.IO
-
-import Control.Monad.Trans (lift)
-import Control.Monad.Trans.Resource (ResourceT, allocate, runResourceT)
-import System.Directory (removeFile)
-import System.Exit (ExitCode(..))
-import System.Process.ByteString.Lazy (readCreateProcessWithExitCode)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (hUnitTestToTests)
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Builder as BB
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy.Char8 as LBSC8
-import qualified Test.HUnit as H
-
-import qualified Data.Capnp.Message as M
-
--- | Information about the contents of a capnp message. This is enough
--- to encode/decode both textual and binary forms.
-data MsgMetaData = MsgMetaData
- { msgSchema :: String -- ^ The source of the schema
- , msgType :: String -- ^ The name of the root struct's type
- } deriving(Show)
-
--- | @capnpEncode msg meta@ runs @capnp encode@ on the message, providing
--- the needed metadata and returning the output
-capnpEncode :: String -> MsgMetaData -> IO BS.ByteString
-capnpEncode msgValue meta = do
- (exitStatus, stdOut, stdErr) <- runResourceT $
- interactCapnpWithSchema "encode" (msgSchema meta) (LBSC8.pack msgValue) [msgType meta]
- case exitStatus of
- ExitSuccess -> return (LBS.toStrict stdOut)
- ExitFailure code -> fail ("`capnp encode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr)
-
--- | @capnpDecode msg meta@ runs @capnp decode@ on the message, providing
--- the needed metadata and returning the output
-capnpDecode :: BS.ByteString -> MsgMetaData -> IO String
-capnpDecode encodedMsg meta = do
- (exitStatus, stdOut, stdErr) <- runResourceT $
- interactCapnpWithSchema "decode" (msgSchema meta) (LBS.fromStrict encodedMsg) [msgType meta]
- case exitStatus of
- ExitSuccess -> return (LBSC8.unpack stdOut)
- ExitFailure code -> fail ("`capnp decode` failed with exit code " ++ show code ++ ":\n" ++ show stdErr)
-
--- | @capnpCompile msg meta@ runs @capnp compile@ on the schema, providing
--- the needed metadata and returning the output
-capnpCompile :: String -> String -> IO BS.ByteString
-capnpCompile msgSchema outputArg = do
- (exitStatus, stdOut, stdErr) <- runResourceT $
- interactCapnpWithSchema "compile" msgSchema LBSC8.empty ["-o", outputArg]
- case exitStatus of
- ExitSuccess -> return (LBS.toStrict stdOut)
- ExitFailure code -> fail ("`capnp compile` failed with exit code " ++ show code ++ ":\n" ++ show stdErr)
-
--- | A helper for @capnpEncode@ and @capnpDecode@. Launches the capnp command
--- with the given subcommand (either "encode" or "decode") and metadata,
--- returning handles to its standard in and standard out. This runs inside
--- ResourceT, and sets the handles up to be closed and the process to be reaped
--- when the ResourceT exits.
-interactCapnpWithSchema :: String -> String -> LBS.ByteString -> [String] -> ResourceT IO (ExitCode, LBS.ByteString, LBS.ByteString)
-interactCapnpWithSchema subCommand msgSchema stdInBytes args = do
- let writeTempFile = runResourceT $ do
- (_, (path, hndl)) <- allocate
- (openTempFile "/tmp" "schema.capnp")
- (\(_, hndl) -> hClose hndl)
- lift $ hPutStr hndl msgSchema
- return path
- let saveTmpSchema msgSchema = snd <$> allocate writeTempFile removeFile
- schemaFile <- saveTmpSchema msgSchema
- lift $ readCreateProcessWithExitCode (proc "capnp" ([subCommand, schemaFile] ++ args)) stdInBytes
-
--- | Convert a list of 'Assertion's to a test group with the given name.
-assertionsToTest :: String -> [H.Assertion] -> Test
-assertionsToTest name =
- testGroup name . hUnitTestToTests . H.TestList . map H.TestCase
-
--- | @'decodeValue' schema typename message@ decodes the value at the root of
--- the message and converts it to text. This is a thin wrapper around
--- 'capnpDecode'.
-decodeValue :: String -> String -> M.ConstMsg -> IO String
-decodeValue schema typename msg = do
- bytes <- M.encode msg
- capnpDecode
- (LBS.toStrict $ BB.toLazyByteString bytes)
- (MsgMetaData schema typename)
-
--- | @'encodeValue' schema typename value@ encodes the textual value @value@
--- as a capnp message. This is a thin wrapper around 'capnpEncode'.
-encodeValue :: String -> String -> String -> IO M.ConstMsg
-encodeValue schema typename value =
- let meta = MsgMetaData schema typename
- in capnpEncode value meta >>= M.decode
diff --git a/tests/Tests/WalkSchemaCodeGenRequest.hs b/tests/Tests/WalkSchemaCodeGenRequest.hs
deleted file mode 100644
--- a/tests/Tests/WalkSchemaCodeGenRequest.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- | This module defines a test that tries to walk over the
--- CodeGeneratorRequest in `tests/data/schema-codegenreq`,
--- failing if any of the data is not as expected.
-module Tests.WalkSchemaCodeGenRequest
- (walkSchemaCodeGenRequestTest)
- where
-
-import Prelude hiding (length)
-
-import Control.Monad (mapM_, when)
-import Test.Framework (Test)
-import Test.HUnit (Assertion, assertEqual)
-
-import qualified Data.ByteString as BS
-import qualified Prelude
-
-import Data.Capnp.Untyped hiding (index, length)
-
-import Tests.Util
-
-import Data.Capnp.Basics (index, length, textBytes)
-import Data.Capnp.Classes (fromStruct)
-import Data.Capnp.TraversalLimit (LimitT, execLimitT)
-
-import qualified Capnp.Capnp.Schema as Schema
-import qualified Data.Capnp.Message as M
-
-
--- | TODO: make this an array; we're doing random access to it below.
--- I(@zenhack) am waiting on this, since at the time of writing @taktoa
--- is working on some array utilities that will get merged soonish, so
--- it probably makes sense to just wait for that.
-nodeNames :: [BS.ByteString]
-nodeNames =
- [ "Import"
- , "annotation"
- , "Value"
- , "Type"
- ]
-
--- TODO: This contains a bit of copypasta from some of the untyped tests; should
--- factor that out.
-theAssert :: Assertion
-theAssert = do
- bytes <- BS.readFile "tests/data/schema-codegenreq"
- msg <- M.decode bytes
- endQuota <- execLimitT 4096 (rootPtr msg >>= reader)
- assertEqual "Correct remaining quota" 2036 endQuota
- where
- reader :: Struct M.ConstMsg -> LimitT IO ()
- reader root = do
- req :: Schema.CodeGeneratorRequest M.ConstMsg <- fromStruct root
- nodes <- Schema.get_CodeGeneratorRequest'nodes req
- requestedFiles <- Schema.get_CodeGeneratorRequest'requestedFiles req
- let 37 = length nodes
- let 1 = length requestedFiles
- mapM_ (walkNode nodes) [0,1..36]
- walkNode nodes i = do
- node <- index i nodes
- -- None of the nodes in the schema have parameters:
- False <- Schema.has_Node'parameters node
- -- And none of them are generic:
- False <- Schema.get_Node'isGeneric node
-
- nameList <- Schema.get_Node'displayName node
- name <- textBytes nameList
- prefixLen <- Schema.get_Node'displayNamePrefixLength node
- let baseName = BS.drop (fromIntegral prefixLen) name
-
- when (i < Prelude.length nodeNames && baseName /= (nodeNames !! i)) $
- error "Incorrect name."
-
- has <- Schema.has_Node'annotations node
-
- -- there are two annotations in all of the nodes, at these indicies:
- case (has, i `elem` [4, 9]) of
- (False, False) -> return ()
- (True, True) -> do
- 1 <- length <$> Schema.get_Node'annotations node
- return ()
- (False, True) ->
- error $ "Node at index " ++ show i ++ " should have had" ++
- "an annotation."
- (True, False) ->
- error $ "Node at index " ++ show i ++ " should not " ++
- "have had an annotation."
-
-walkSchemaCodeGenRequestTest :: Test
-walkSchemaCodeGenRequestTest =
- assertionsToTest "walk schema CodeGenerationRequest" [theAssert]
diff --git a/tests/Util.hs b/tests/Util.hs
new file mode 100644
--- /dev/null
+++ b/tests/Util.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
+module Util
+ ( MsgMetaData(..)
+ , capnpEncode, capnpDecode, capnpCompile
+ , decodeValue
+ , encodeValue
+ , aircraftSchemaSrc
+ , schemaSchemaSrc
+ )
+ 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 Text.Heredoc (there)
+
+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 Capnp.Message as M
+
+aircraftSchemaSrc, schemaSchemaSrc :: String
+aircraftSchemaSrc = [there|tests/data/aircraft.capnp|]
+schemaSchemaSrc = [there|tests/data/schema.capnp|]
+
+-- | 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
+ schemaFile <- snd <$> allocate writeTempFile removeFile
+ lift $ readCreateProcessWithExitCode (proc "capnp" ([subCommand, schemaFile] ++ args)) stdInBytes
+
+-- | @'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/WalkSchemaCodeGenRequest.hs b/tests/WalkSchemaCodeGenRequest.hs
new file mode 100644
--- /dev/null
+++ b/tests/WalkSchemaCodeGenRequest.hs
@@ -0,0 +1,98 @@
+{-# 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 WalkSchemaCodeGenRequest
+ (walkSchemaCodeGenRequestTest)
+ where
+
+import Prelude hiding (length)
+
+import Test.Hspec
+
+import Control.Monad (mapM_, when)
+import Control.Monad.Trans.Class (lift)
+
+import qualified Data.ByteString as BS
+import qualified Prelude
+
+import Capnp.Untyped hiding (index, length)
+
+import Capnp.Basics (index, length, textBytes)
+import Capnp.Classes (fromStruct)
+import Capnp.TraversalLimit (LimitT, execLimitT)
+
+import qualified Capnp.Gen.Capnp.Schema as Schema
+import qualified 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.
+walkSchemaCodeGenRequestTest :: Spec
+walkSchemaCodeGenRequestTest =
+ describe "Various sanity checks on a known schema CodeGeneratorRequest" $
+ it "Should match misc. expectations" $ do
+ -- TODO: the above description betrays that this test isn't
+ -- especially well defined at a granularity that I(zenhack)
+ -- know how to tell hspec about, because there are data
+ -- dependencies between conceptual tests (we walk over the
+ -- data checking various things as we go).
+ --
+ -- It would be nice if we could mark off individual checks for
+ -- hspec's reporting somehow.
+ bytes <- BS.readFile "tests/data/schema-codegenreq"
+ msg <- M.decode bytes
+ endQuota <- execLimitT 4096 (rootPtr msg >>= reader)
+ endQuota `shouldBe` 3452
+ 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
+ lift $ length nodes `shouldBe` 37
+ lift $ length requestedFiles `shouldBe` 1
+ 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."