capnp 0.17.0.0 → 0.18.0.0

raw patch · 38 files changed

+1365/−1666 lines, 38 filesdep ~bifunctorsdep ~ghc-primdep ~lifetimesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bifunctors, ghc-prim, lifetimes, primitive, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• README.md +8/−2
• capnp.cabal +12/−11
• cmd/capnpc-haskell/Check.hs +3/−4
• cmd/capnpc-haskell/IR/Common.hs +1/−2
• cmd/capnpc-haskell/IR/Stage1.hs +1/−2
• cmd/capnpc-haskell/Main.hs +12/−18
• cmd/capnpc-haskell/Trans/CgrToStage1.hs +15/−19
• cmd/capnpc-haskell/Trans/Stage1ToFlat.hs +2/−3
• examples/gen/lib/Capnp/Gen/ById/X85150b117366d14b.hs +6/−8
• examples/gen/lib/Capnp/Gen/ById/Xd0a87f36fa0182f5.hs +6/−8
• examples/gen/lib/Capnp/Gen/Calculator.hs +359/−586
• examples/gen/lib/Capnp/Gen/Echo.hs +61/−98
• examples/lib/Examples/Rpc/CalculatorClient.hs +52/−59
• examples/lib/Examples/Rpc/CalculatorServer.hs +24/−24
• lib/Capnp.hs +2/−1
• lib/Capnp/Basics.hs +11/−15
• lib/Capnp/Classes.hs +18/−15
• lib/Capnp/GenHelpers/Rpc.hs +2/−2
• lib/Capnp/Message.hs +3/−2
• lib/Capnp/New/Rpc/Server.hs +0/−254
• lib/Capnp/Repr/Parsed.hs +1/−2
• lib/Capnp/Rpc.hs +9/−1
• lib/Capnp/Rpc/Membrane.hs +17/−16
• lib/Capnp/Rpc/Promise.hs +5/−0
• lib/Capnp/Rpc/Revoke.hs +1/−1
• lib/Capnp/Rpc/Server.hs +207/−93
• lib/Capnp/Rpc/Untyped.hs +210/−193
• lib/Capnp/Tutorial.hs +174/−158
• lib/Internal/Rpc/Breaker.hs +13/−2
• lib/Internal/Rpc/Export.hs +17/−0
• tests/CalculatorExample.hs +10/−14
• tests/Constants.hs +38/−0
• tests/Instances.hs +28/−28
• tests/Main.hs +3/−1
• tests/Module/Capnp/Rpc.hs +15/−21
• tests/Module/Capnp/Untyped.hs +1/−1
• tests/Module/Capnp/Untyped/Pure.hs +1/−2

@@ -1,3 +1,20 @@+# 0.18.0.0++- The connection setup APIs have been slightly reworked.+  - The `getBootstrap` field of `ConnConfig` has been replaced with a+    `bootstrap` field that takes the capability itself, which must now+    be constructed before spawning the connection.+  - The `withBootstrarp` field in `ConnConfig` has been removed, Instead+    use the new `requestBootstrap` function to get the bootstrap+    interface, using a connection reference supplied by `withConn`+    or `acquireConn`.+- The high level API now maps Cap'n Proto lists to `[]`, rather than+  `Vector`.+- `Fulfiller` now has an instance of `Contravariant`.+- The Client type's Show instance now distinguishes between a null+  capability and a capability whose index was outside of a message's+  cap table's bounds when it was read.+ # 0.17.0.0  - Get rid of the New qualifier in module paths, now that the old

@@ -3,6 +3,12 @@ A Haskell library for the [Cap'N Proto][1] Cerialization and RPC protocol. +Note, this project's official home is [on+codeberg](https://codeberg.org/zenhack/haskell-capnp); if you're viewing+this elsewhere, this is a mirror. For trivial changes we'll still accept+patches here, but please file issues and submit more substantial changes+via codeberg.+ # Getting Started  There is a module `Capnp.Tutorial` which contains an introduction@@ -35,8 +41,8 @@ [1]: https://capnproto.org/ [2]: https://capnproto.org/language.html#evolving-your-protocol -[issue27]: https://github.com/zenhack/haskell-capnp/issues/27-[issue28]: https://github.com/zenhack/haskell-capnp/issues/28+[issue27]: https://codeberg.org/zenhack/haskell-capnp/issues/27+[issue28]: https://codeberg.org/zenhack/haskell-capnp/issues/28  [hackage-img]: https://img.shields.io/hackage/v/capnp.svg [hackage]: https://hackage.haskell.org/package/capnp

@@ -1,14 +1,14 @@ cabal-version:            2.2 name:                     capnp-version:                  0.17.0.0+version:                  0.18.0.0 category:                 Data, Serialization, Network, Rpc copyright:                2016-2023 haskell-capnp contributors (see CONTRIBUTORS file). author:                   Ian Denhardt maintainer:               ian@zenhack.net license:                  MIT license-file:             LICENSE.md-homepage:                 https://github.com/zenhack/haskell-capnp-bug-reports:              https://github.com/zenhack/haskell-capnp/issues+homepage:                 https://codeberg.org/zenhack/haskell-capnp+bug-reports:              https://codeberg.org/zenhack/haskell-capnp/issues synopsis:                 Cap'n Proto for Haskell description:   A native Haskell implementation of the Cap'N Proto cerialization format and@@ -46,7 +46,7 @@ source-repository head     type:                 git     branch:               master-    location:             https://github.com/zenhack/haskell-capnp.git+    location:             https://codeberg.org/zenhack/haskell-capnp.git  -------------------------------------------------------------------------------- @@ -58,9 +58,9 @@       , containers                        >= 0.5.9 && <0.7       , data-default                      ^>= 0.7.1       , exceptions                        ^>= 0.10.0-      , ghc-prim                          >= 0.6.1 && <0.10+      , ghc-prim                          >= 0.6.1 && <0.11       , mtl                               >= 2.2.2 && <2.4-      , primitive                         >= 0.6.3 && <0.8+      , primitive                         >= 0.6.3 && <0.9       , safe-exceptions                   ^>= 0.1.7       , text                              >= 1.2 && < 2.1       , transformers                      >= 0.5.2 && <0.7@@ -101,9 +101,8 @@       , Capnp.Constraints       , Capnp.Rpc.Common       , Capnp.Rpc.Membrane-      , Capnp.Rpc.Server       , Capnp.Rpc.Revoke-      , Capnp.New.Rpc.Server+      , Capnp.Rpc.Server       , Capnp.Convert       , Capnp.Errors       , Capnp.Fields@@ -155,6 +154,7 @@       , Internal.BuildPure       , Internal.STE       , Internal.Rpc.Breaker+      , Internal.Rpc.Export     -- other-extensions:     build-depends:         hashable                          >= 1.2.7 && <1.5@@ -167,9 +167,9 @@       , network-simple                    ^>= 0.4       , network                           >= 3 && <3.2       , supervisors                       ^>= 0.2.1-      , lifetimes                         ^>= 0.1+      , lifetimes                         ^>= 0.2       , pretty-show                       >= 1.9.5 && <1.11-      , template-haskell                  >=2.18 && <2.20+      , template-haskell                  >=2.18 && <2.21  -------------------------------------------------------------------------------- @@ -197,7 +197,7 @@     , wl-pprint-text ^>= 1.2     , filepath ^>= 1.4.2     , directory ^>= 1.3.0-    , bifunctors ^>= 5.5.8+    , bifunctors >= 5.5.8 && <5.7  -------------------------------------------------------------------------------- @@ -252,6 +252,7 @@       , WalkSchemaCodeGenRequest       , SchemaQuickCheck       , CalculatorExample+      , Constants       , Rpc.Unwrap     build-depends:         capnp

@@ -5,7 +5,6 @@  import Capnp.Gen.Capnp.Schema import Data.Foldable (for_)-import qualified Data.Vector as V import System.IO (hPutStrLn, stderr)  -- | Scan the code generator request for certain issues, and warn the user@@ -17,12 +16,12 @@ reportIssues CodeGeneratorRequest {nodes} =   let problemFields =         [ (displayName, name)-          | Node {displayName, union' = Node'struct Node'struct' {fields}} <- V.toList nodes,+          | Node {displayName, union' = Node'struct Node'struct' {fields}} <- nodes,             Field               { name,                 union' = Field'slot Field'slot' {hadExplicitDefault, defaultValue}               } <--              V.toList fields,+              fields,             hadExplicitDefault && isPtrValue defaultValue         ]    in for_ problemFields $ \(displayName, name) ->@@ -37,7 +36,7 @@               " 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",+              "https://codeberg.org/zenhack/haskell-capnp/issues/28\n",               "\n",               "for more information.\n"             ]

@@ -10,7 +10,6 @@ import Capnp.Repr.Parsed (Parsed) import Data.Bifunctor (Bifunctor (..)) import qualified Data.Map.Strict as M-import qualified Data.Vector as V import Data.Word import qualified IR.Name as Name @@ -66,7 +65,7 @@ instance Functor MapBrand where   fmap f (MapBrand m) = MapBrand $ fmap (fmap f) m -newtype BrandScope r = Bind (V.Vector (Binding r))+newtype BrandScope r = Bind [Binding r]   deriving (Show, Eq)  instance Functor BrandScope where

@@ -23,7 +23,6 @@   ) where -import qualified Data.Vector as V import Data.Word import qualified IR.Common as Common import qualified IR.Name as Name@@ -56,7 +55,7 @@   { nodeNested :: [(Name.UnQ, Node)],     nodeParent :: Maybe Node,     nodeId :: !Word64,-    nodeParams :: V.Vector Name.UnQ+    nodeParams :: [Name.UnQ]   }   deriving (Show, Eq) 

@@ -5,10 +5,10 @@ import Capnp (Parsed, defaultLimit, getParsed) import Capnp.Gen.Capnp.Schema (CodeGeneratorRequest) import qualified Check+import Control.Category ((>>>)) import Data.Foldable (for_) import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as TIO-import qualified IR.Flat as Flat import qualified IR.Haskell as Haskell import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory)@@ -30,20 +30,14 @@  -- | Convert a 'CodeGeneratorRequest' to a list of files to create. handleCGR :: Parsed CodeGeneratorRequest -> [(FilePath, LT.Text)]-handleCGR cgr =-  let flat =-        Trans.Stage1ToFlat.cgrToCgr $-          Trans.CgrToStage1.cgrToCgr cgr-      modules = handleFlatNew flat-   in map-        ( \mod ->-            ( Haskell.modFilePath mod,-              Trans.HaskellToText.moduleToText mod-            )-        )-        modules--handleFlatNew :: Flat.CodeGenReq -> [Haskell.Module]-handleFlatNew =-  concatMap Trans.AbstractOpToHaskell.fileToModules-    . Trans.FlatToAbstractOp.cgrToFiles+handleCGR =+  Trans.CgrToStage1.cgrToCgr+    >>> Trans.Stage1ToFlat.cgrToCgr+    >>> Trans.FlatToAbstractOp.cgrToFiles+    >>> concatMap Trans.AbstractOpToHaskell.fileToModules+    >>> map+      ( \mod ->+          ( Haskell.modFilePath mod,+            Trans.HaskellToText.moduleToText mod+          )+      )

@@ -17,7 +17,6 @@ import Data.Maybe (mapMaybe) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8)-import qualified Data.Vector as V import Data.Word import GHC.Float (castDoubleToWord64, castFloatToWord32) import qualified IR.Common as C@@ -38,7 +37,7 @@               { nodeId = id,                 nodeNested =                   [ (Name.UnQ name, node)-                    | Schema.Node'NestedNode {name, id} <- V.toList nestedNodes,+                    | Schema.Node'NestedNode {name, id} <- nestedNodes,                       Just node <- [M.lookup id outMap]                   ],                 nodeParent =@@ -46,14 +45,13 @@                     then Nothing                     else Just (outMap M.! id),                 nodeParams =-                  V.fromList-                    [ Name.UnQ name-                      | Schema.Node'Parameter {name} <- V.toList parameters-                    ]+                  [ Name.UnQ name+                    | Schema.Node'Parameter {name} <- parameters+                  ]               },           nodeUnion = case union' of             Schema.Node'enum Schema.Node'enum' {enumerants} ->-              Stage1.NodeEnum $ map enumerantToName $ V.toList enumerants+              Stage1.NodeEnum $ map enumerantToName enumerants             Schema.Node'struct               Schema.Node'struct'                 { dataWordCount,@@ -68,15 +66,15 @@                       pointerCount,                       isGroup,                       tagOffset = discriminantOffset,-                      fields = map (fieldToField outMap) (V.toList fields)+                      fields = map (fieldToField outMap) fields                     }             Schema.Node'interface Schema.Node'interface' {methods, superclasses} ->               Stage1.NodeInterface                 Stage1.Interface-                  { methods = map (methodToMethod outMap) (V.toList methods),+                  { methods = map (methodToMethod outMap) methods,                     supers =                       [ C.InterfaceType (outMap M.! id) (brandToBrand outMap brand)-                        | Schema.Superclass {id, brand} <- V.toList superclasses+                        | Schema.Superclass {id, brand} <- superclasses                       ]                   }             Schema.Node'const Schema.Node'const' {type_ = Schema.Type type_, value = Schema.Value value} ->@@ -115,14 +113,12 @@                                 encodeUtf8 v                                   & BS.unpack                                   & (++ [0])-                                  & V.fromList                       Schema.Value'data_ v ->                         C.PtrValue (C.PrimPtr C.PrimText) $                           Just $                             B.PtrList $                               B.List8 $                                 BS.unpack v-                                  & V.fromList                       Schema.Value'list v ->                         case type_ of                           Schema.Type'list (Schema.Type'list' (Schema.Type elementType)) ->@@ -169,7 +165,7 @@  brandToBrand :: NodeMap Stage1.Node -> Parsed Schema.Brand -> Stage1.Brand brandToBrand nodeMap Schema.Brand {scopes} =-  C.MapBrand $ M.fromList $ mapMaybe scopeToScope (V.toList scopes)+  C.MapBrand $ M.fromList $ mapMaybe scopeToScope scopes   where     scopeToScope Schema.Brand'Scope {scopeId, union'} = case union' of       Schema.Brand'Scope'unknown' _ -> Nothing@@ -179,7 +175,7 @@           ( scopeId,             C.Bind $               bindings-                & V.map+                & map                   ( \(Schema.Brand'Binding b) -> case b of                       Schema.Brand'Binding'type_ (Schema.Type typ) ->                         case typeToType nodeMap typ of@@ -307,12 +303,12 @@ 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+    nodeMap = nodesToNodes $ M.fromList [(id, node) | node@Schema.Node {id} <- nodes]+    reqFiles = map (reqFileToReqFile nodeMap) requestedFiles     allFiles =       [ let fileNodes =               [ (Name.UnQ name, nodeMap M.! id)-                | Schema.Node'NestedNode {name, id} <- V.toList nestedNodes,+                | Schema.Node'NestedNode {name, id} <- 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;@@ -320,7 +316,7 @@                   M.member id nodeMap               ]          in Stage1.File {fileId, fileNodes}-        | Schema.Node {union' = Schema.Node'file, id = fileId, nestedNodes} <- V.toList nodes+        | Schema.Node {union' = Schema.Node'file, id = fileId, nestedNodes} <- nodes       ]  structTypeToType ::@@ -366,7 +362,7 @@                 C.TypeParamRef                   { paramScope,                     paramIndex = fromIntegral parameterIndex,-                    paramName = Stage1.nodeParams (Stage1.nodeCommon paramScope) V.! fromIntegral parameterIndex+                    paramName = Stage1.nodeParams (Stage1.nodeCommon paramScope) !! fromIntegral parameterIndex                   }       Schema.Type'anyPointer'unconstrained         (Schema.Type'anyPointer'unconstrained' unconstrained) ->

@@ -9,7 +9,6 @@ module Trans.Stage1ToFlat (cgrToCgr) where  import qualified Data.Map as M-import qualified Data.Vector as V import Data.Word import qualified IR.Common as C import qualified IR.Flat as Flat@@ -74,7 +73,7 @@   case M.lookup nodeId m of     Nothing -> C.PtrParam param     Just (C.Bind bindings) ->-      let binding = bindings V.! paramIndex+      let binding = bindings !! paramIndex        in case binding of             C.Unbound -> C.PtrParam param             C.BoundType ty -> applyBrandPtrType ty@@ -130,7 +129,7 @@   typeParams =     mine ++ kids     where-      myParams = typeParams ++ paramsToParams nodeMap nodeId (V.toList nodeParams)+      myParams = typeParams ++ paramsToParams nodeMap nodeId nodeParams       kidsNS = Name.localQToNS localName       kids =         concatMap

@@ -1,14 +1,12 @@+{-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wno-dodgy-exports #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}--module Capnp.Gen.ById.X85150b117366d14b (module Capnp.Gen.Calculator) where-+{-# OPTIONS_GHC -Wno-name-shadowing #-}+module Capnp.Gen.ById.X85150b117366d14b(module Capnp.Gen.Calculator) where import Capnp.Gen.Calculator-import qualified Data.Int as Std_+import qualified Prelude as Std_ import qualified Data.Word as Std_+import qualified Data.Int as Std_ import Prelude ((<$>), (<*>), (>>=))-import qualified Prelude as Std_

@@ -1,14 +1,12 @@+{-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wno-dodgy-exports #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}--module Capnp.Gen.ById.Xd0a87f36fa0182f5 (module Capnp.Gen.Echo) where-+{-# OPTIONS_GHC -Wno-name-shadowing #-}+module Capnp.Gen.ById.Xd0a87f36fa0182f5(module Capnp.Gen.Echo) where import Capnp.Gen.Echo-import qualified Data.Int as Std_+import qualified Prelude as Std_ import qualified Data.Word as Std_+import qualified Data.Int as Std_ import Prelude ((<$>), (<*>), (>>=))-import qualified Prelude as Std_

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-}@@ -5,789 +6,561 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE UndecidableSuperClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wno-dodgy-exports #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}-+{-# OPTIONS_GHC -Wno-name-shadowing #-} module Capnp.Gen.Calculator where-+import qualified Capnp.Repr as R+import qualified Capnp.Repr.Parsed as RP import qualified Capnp.Basics as Basics-import qualified Capnp.Classes as C+import qualified GHC.OverloadedLabels as OL import qualified Capnp.GenHelpers as GH+import qualified Capnp.Classes as C+import qualified GHC.Generics as Generics import qualified Capnp.GenHelpers.Rpc as GH-import qualified Capnp.Repr as R-import qualified Capnp.Repr.Parsed as RP-import qualified Data.Int as Std_+import qualified Prelude as Std_ import qualified Data.Word as Std_-import qualified GHC.Generics as Generics-import qualified GHC.OverloadedLabels as OL+import qualified Data.Int as Std_ import Prelude ((<$>), (<*>), (>>=))-import qualified Prelude as Std_--data Calculator--type instance R.ReprFor Calculator = (R.Ptr (Std_.Just R.Cap))-+data Calculator +type instance (R.ReprFor Calculator) = (R.Ptr (Std_.Just R.Cap)) instance (C.HasTypeId Calculator) where-  typeId = 10923537602090224694-+    typeId  = 10923537602090224694 instance (C.Parse Calculator (GH.Client Calculator)) where-  parse = GH.parseCap-  encode = GH.encodeCap-+    parse  = GH.parseCap+    encode  = GH.encodeCap instance (GH.Export Calculator) where-  type Server Calculator = Calculator'server_-  methodHandlerTree _ s_ =-    ( GH.MethodHandlerTree-        (C.typeId @(Calculator))-        [ (GH.toUntypedMethodHandler ((calculator'evaluate) s_)),-          (GH.toUntypedMethodHandler ((calculator'defFunction) s_)),-          (GH.toUntypedMethodHandler ((calculator'getOperator) s_))-        ]-        []-    )--class Calculator'server_ s_ where-  {-# MINIMAL calculator'evaluate, calculator'defFunction, calculator'getOperator #-}-  calculator'evaluate :: s_ -> (GH.MethodHandler Calculator'evaluate'params Calculator'evaluate'results)-  calculator'evaluate _ = GH.methodUnimplemented-  calculator'defFunction :: s_ -> (GH.MethodHandler Calculator'defFunction'params Calculator'defFunction'results)-  calculator'defFunction _ = GH.methodUnimplemented-  calculator'getOperator :: s_ -> (GH.MethodHandler Calculator'getOperator'params Calculator'getOperator'results)-  calculator'getOperator _ = GH.methodUnimplemented-+    type Server Calculator = Calculator'server_+    methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Calculator)) [(GH.toUntypedMethodHandler ((calculator'evaluate) s_))+                                                                            ,(GH.toUntypedMethodHandler ((calculator'defFunction) s_))+                                                                            ,(GH.toUntypedMethodHandler ((calculator'getOperator) s_))] [])+class (Calculator'server_ s_) where+    {-# MINIMAL calculator'evaluate,calculator'defFunction,calculator'getOperator #-}+    calculator'evaluate :: s_ -> (GH.MethodHandler Calculator'evaluate'params Calculator'evaluate'results)+    calculator'evaluate _ = GH.methodUnimplemented+    calculator'defFunction :: s_ -> (GH.MethodHandler Calculator'defFunction'params Calculator'defFunction'results)+    calculator'defFunction _ = GH.methodUnimplemented+    calculator'getOperator :: s_ -> (GH.MethodHandler Calculator'getOperator'params Calculator'getOperator'results)+    calculator'getOperator _ = GH.methodUnimplemented instance (GH.HasMethod "evaluate" Calculator Calculator'evaluate'params Calculator'evaluate'results) where-  methodByLabel = (GH.Method 10923537602090224694 0)-+    methodByLabel  = (GH.Method 10923537602090224694 0) instance (GH.HasMethod "defFunction" Calculator Calculator'defFunction'params Calculator'defFunction'results) where-  methodByLabel = (GH.Method 10923537602090224694 1)-+    methodByLabel  = (GH.Method 10923537602090224694 1) instance (GH.HasMethod "getOperator" Calculator Calculator'getOperator'params Calculator'getOperator'results) where-  methodByLabel = (GH.Method 10923537602090224694 2)--data Calculator'evaluate'params--type instance R.ReprFor Calculator'evaluate'params = (R.Ptr (Std_.Just R.Struct))-+    methodByLabel  = (GH.Method 10923537602090224694 2)+data Calculator'evaluate'params +type instance (R.ReprFor Calculator'evaluate'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'evaluate'params) where-  typeId = 13478898619544909524-+    typeId  = 13478898619544909524 instance (C.TypedStruct Calculator'evaluate'params) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Calculator'evaluate'params) where-  type AllocHint Calculator'evaluate'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'evaluate'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'evaluate'params (C.Parsed Calculator'evaluate'params))- instance (C.AllocateList Calculator'evaluate'params) where-  type ListAllocHint Calculator'evaluate'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'evaluate'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'evaluate'params (C.Parsed Calculator'evaluate'params))--data instance C.Parsed Calculator'evaluate'params = Calculator'evaluate'params-  {expression :: (RP.Parsed Expression)}-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'evaluate'params+    = Calculator'evaluate'params +        {expression :: (RP.Parsed Expression)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'evaluate'params))- deriving instance (Std_.Eq (C.Parsed Calculator'evaluate'params))- instance (C.Parse Calculator'evaluate'params (C.Parsed Calculator'evaluate'params)) where-  parse raw_ = (Calculator'evaluate'params <$> (GH.parseField #expression raw_))-+    parse raw_ = (Calculator'evaluate'params <$> (GH.parseField #expression raw_)) instance (C.Marshal Calculator'evaluate'params (C.Parsed Calculator'evaluate'params)) where-  marshalInto raw_ Calculator'evaluate'params {..} =-    ( do+    marshalInto raw_ Calculator'evaluate'params{..} = (do         (GH.encodeField #expression expression raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "expression" GH.Slot Calculator'evaluate'params Expression) where-  fieldByLabel = (GH.ptrField 0)--data Calculator'evaluate'results--type instance R.ReprFor Calculator'evaluate'results = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Calculator'evaluate'results +type instance (R.ReprFor Calculator'evaluate'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'evaluate'results) where-  typeId = 9345430975918089745-+    typeId  = 9345430975918089745 instance (C.TypedStruct Calculator'evaluate'results) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Calculator'evaluate'results) where-  type AllocHint Calculator'evaluate'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'evaluate'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'evaluate'results (C.Parsed Calculator'evaluate'results))- instance (C.AllocateList Calculator'evaluate'results) where-  type ListAllocHint Calculator'evaluate'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'evaluate'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'evaluate'results (C.Parsed Calculator'evaluate'results))--data instance C.Parsed Calculator'evaluate'results = Calculator'evaluate'results-  {value :: (RP.Parsed Value)}-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'evaluate'results+    = Calculator'evaluate'results +        {value :: (RP.Parsed Value)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'evaluate'results))- deriving instance (Std_.Eq (C.Parsed Calculator'evaluate'results))- instance (C.Parse Calculator'evaluate'results (C.Parsed Calculator'evaluate'results)) where-  parse raw_ = (Calculator'evaluate'results <$> (GH.parseField #value raw_))-+    parse raw_ = (Calculator'evaluate'results <$> (GH.parseField #value raw_)) instance (C.Marshal Calculator'evaluate'results (C.Parsed Calculator'evaluate'results)) where-  marshalInto raw_ Calculator'evaluate'results {..} =-    ( do+    marshalInto raw_ Calculator'evaluate'results{..} = (do         (GH.encodeField #value value raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "value" GH.Slot Calculator'evaluate'results Value) where-  fieldByLabel = (GH.ptrField 0)--data Calculator'defFunction'params--type instance R.ReprFor Calculator'defFunction'params = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Calculator'defFunction'params +type instance (R.ReprFor Calculator'defFunction'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'defFunction'params) where-  typeId = 17476144387247758473-+    typeId  = 17476144387247758473 instance (C.TypedStruct Calculator'defFunction'params) where-  numStructWords = 1-  numStructPtrs = 1-+    numStructWords  = 1+    numStructPtrs  = 1 instance (C.Allocate Calculator'defFunction'params) where-  type AllocHint Calculator'defFunction'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'defFunction'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'defFunction'params (C.Parsed Calculator'defFunction'params))- instance (C.AllocateList Calculator'defFunction'params) where-  type ListAllocHint Calculator'defFunction'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'defFunction'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'defFunction'params (C.Parsed Calculator'defFunction'params))--data instance C.Parsed Calculator'defFunction'params = Calculator'defFunction'params-  { paramCount :: (RP.Parsed Std_.Int32),-    body :: (RP.Parsed Expression)-  }-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'defFunction'params+    = Calculator'defFunction'params +        {paramCount :: (RP.Parsed Std_.Int32)+        ,body :: (RP.Parsed Expression)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'defFunction'params))- deriving instance (Std_.Eq (C.Parsed Calculator'defFunction'params))- instance (C.Parse Calculator'defFunction'params (C.Parsed Calculator'defFunction'params)) where-  parse raw_ =-    ( Calculator'defFunction'params-        <$> (GH.parseField #paramCount raw_)-        <*> (GH.parseField #body raw_)-    )-+    parse raw_ = (Calculator'defFunction'params <$> (GH.parseField #paramCount raw_)+                                                <*> (GH.parseField #body raw_)) instance (C.Marshal Calculator'defFunction'params (C.Parsed Calculator'defFunction'params)) where-  marshalInto raw_ Calculator'defFunction'params {..} =-    ( do+    marshalInto raw_ Calculator'defFunction'params{..} = (do         (GH.encodeField #paramCount paramCount raw_)         (GH.encodeField #body body raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "paramCount" GH.Slot Calculator'defFunction'params Std_.Int32) where-  fieldByLabel = (GH.dataField 0 0 32 0)-+    fieldByLabel  = (GH.dataField 0 0 32 0) instance (GH.HasField "body" GH.Slot Calculator'defFunction'params Expression) where-  fieldByLabel = (GH.ptrField 0)--data Calculator'defFunction'results--type instance R.ReprFor Calculator'defFunction'results = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Calculator'defFunction'results +type instance (R.ReprFor Calculator'defFunction'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'defFunction'results) where-  typeId = 10170522573213587144-+    typeId  = 10170522573213587144 instance (C.TypedStruct Calculator'defFunction'results) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Calculator'defFunction'results) where-  type AllocHint Calculator'defFunction'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'defFunction'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'defFunction'results (C.Parsed Calculator'defFunction'results))- instance (C.AllocateList Calculator'defFunction'results) where-  type ListAllocHint Calculator'defFunction'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'defFunction'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'defFunction'results (C.Parsed Calculator'defFunction'results))--data instance C.Parsed Calculator'defFunction'results = Calculator'defFunction'results-  {func :: (RP.Parsed Function)}-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'defFunction'results+    = Calculator'defFunction'results +        {func :: (RP.Parsed Function)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'defFunction'results))- deriving instance (Std_.Eq (C.Parsed Calculator'defFunction'results))- instance (C.Parse Calculator'defFunction'results (C.Parsed Calculator'defFunction'results)) where-  parse raw_ = (Calculator'defFunction'results <$> (GH.parseField #func raw_))-+    parse raw_ = (Calculator'defFunction'results <$> (GH.parseField #func raw_)) instance (C.Marshal Calculator'defFunction'results (C.Parsed Calculator'defFunction'results)) where-  marshalInto raw_ Calculator'defFunction'results {..} =-    ( do+    marshalInto raw_ Calculator'defFunction'results{..} = (do         (GH.encodeField #func func raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "func" GH.Slot Calculator'defFunction'results Function) where-  fieldByLabel = (GH.ptrField 0)--data Calculator'getOperator'params--type instance R.ReprFor Calculator'getOperator'params = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Calculator'getOperator'params +type instance (R.ReprFor Calculator'getOperator'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'getOperator'params) where-  typeId = 9983863225544066352-+    typeId  = 9983863225544066352 instance (C.TypedStruct Calculator'getOperator'params) where-  numStructWords = 1-  numStructPtrs = 0-+    numStructWords  = 1+    numStructPtrs  = 0 instance (C.Allocate Calculator'getOperator'params) where-  type AllocHint Calculator'getOperator'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'getOperator'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'getOperator'params (C.Parsed Calculator'getOperator'params))- instance (C.AllocateList Calculator'getOperator'params) where-  type ListAllocHint Calculator'getOperator'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'getOperator'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'getOperator'params (C.Parsed Calculator'getOperator'params))--data instance C.Parsed Calculator'getOperator'params = Calculator'getOperator'params-  {op :: (RP.Parsed Operator)}-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'getOperator'params+    = Calculator'getOperator'params +        {op :: (RP.Parsed Operator)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'getOperator'params))- deriving instance (Std_.Eq (C.Parsed Calculator'getOperator'params))- instance (C.Parse Calculator'getOperator'params (C.Parsed Calculator'getOperator'params)) where-  parse raw_ = (Calculator'getOperator'params <$> (GH.parseField #op raw_))-+    parse raw_ = (Calculator'getOperator'params <$> (GH.parseField #op raw_)) instance (C.Marshal Calculator'getOperator'params (C.Parsed Calculator'getOperator'params)) where-  marshalInto raw_ Calculator'getOperator'params {..} =-    ( do+    marshalInto raw_ Calculator'getOperator'params{..} = (do         (GH.encodeField #op op raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "op" GH.Slot Calculator'getOperator'params Operator) where-  fieldByLabel = (GH.dataField 0 0 16 0)--data Calculator'getOperator'results--type instance R.ReprFor Calculator'getOperator'results = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.dataField 0 0 16 0)+data Calculator'getOperator'results +type instance (R.ReprFor Calculator'getOperator'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Calculator'getOperator'results) where-  typeId = 15100494197045627936-+    typeId  = 15100494197045627936 instance (C.TypedStruct Calculator'getOperator'results) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Calculator'getOperator'results) where-  type AllocHint Calculator'getOperator'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Calculator'getOperator'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Calculator'getOperator'results (C.Parsed Calculator'getOperator'results))- instance (C.AllocateList Calculator'getOperator'results) where-  type ListAllocHint Calculator'getOperator'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Calculator'getOperator'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Calculator'getOperator'results (C.Parsed Calculator'getOperator'results))--data instance C.Parsed Calculator'getOperator'results = Calculator'getOperator'results-  {func :: (RP.Parsed Function)}-  deriving (Generics.Generic)-+data instance C.Parsed Calculator'getOperator'results+    = Calculator'getOperator'results +        {func :: (RP.Parsed Function)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Calculator'getOperator'results))- deriving instance (Std_.Eq (C.Parsed Calculator'getOperator'results))- instance (C.Parse Calculator'getOperator'results (C.Parsed Calculator'getOperator'results)) where-  parse raw_ = (Calculator'getOperator'results <$> (GH.parseField #func raw_))-+    parse raw_ = (Calculator'getOperator'results <$> (GH.parseField #func raw_)) instance (C.Marshal Calculator'getOperator'results (C.Parsed Calculator'getOperator'results)) where-  marshalInto raw_ Calculator'getOperator'results {..} =-    ( do+    marshalInto raw_ Calculator'getOperator'results{..} = (do         (GH.encodeField #func func raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "func" GH.Slot Calculator'getOperator'results Function) where-  fieldByLabel = (GH.ptrField 0)--data Expression--type instance R.ReprFor Expression = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Expression +type instance (R.ReprFor Expression) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Expression) where-  typeId = 15292209801435843861-+    typeId  = 15292209801435843861 instance (C.TypedStruct Expression) where-  numStructWords = 2-  numStructPtrs = 2-+    numStructWords  = 2+    numStructPtrs  = 2 instance (C.Allocate Expression) where-  type AllocHint Expression = ()-  new _ = C.newTypedStruct-+    type AllocHint Expression = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Expression (C.Parsed Expression))- instance (C.AllocateList Expression) where-  type ListAllocHint Expression = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Expression = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Expression (C.Parsed Expression))--data instance C.Parsed Expression = Expression-  {union' :: (C.Parsed (GH.Which Expression))}-  deriving (Generics.Generic)-+data instance C.Parsed Expression+    = Expression +        {union' :: (C.Parsed (GH.Which Expression))}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Expression))- deriving instance (Std_.Eq (C.Parsed Expression))- instance (C.Parse Expression (C.Parsed Expression)) where-  parse raw_ = (Expression <$> (C.parse (GH.structUnion raw_)))-+    parse raw_ = (Expression <$> (C.parse (GH.structUnion raw_))) instance (C.Marshal Expression (C.Parsed Expression)) where-  marshalInto raw_ Expression {..} =-    ( do+    marshalInto raw_ Expression{..} = (do         (C.marshalInto (GH.structUnion raw_) union')-    )-+        ) instance (GH.HasUnion Expression) where-  unionField = (GH.dataField 0 1 16 0)-  data RawWhich Expression mut_-    = RW_Expression'literal (R.Raw Std_.Double mut_)-    | RW_Expression'previousResult (R.Raw Value mut_)-    | RW_Expression'parameter (R.Raw Std_.Word32 mut_)-    | RW_Expression'call (R.Raw Expression'call mut_)-    | RW_Expression'unknown' Std_.Word16-  internalWhich tag_ struct_ = case tag_ of-    0 ->-      (RW_Expression'literal <$> (GH.readVariant #literal struct_))-    1 ->-      (RW_Expression'previousResult <$> (GH.readVariant #previousResult struct_))-    2 ->-      (RW_Expression'parameter <$> (GH.readVariant #parameter struct_))-    3 ->-      (RW_Expression'call <$> (GH.readVariant #call struct_))-    _ ->-      (Std_.pure (RW_Expression'unknown' tag_))-  data Which Expression-+    unionField  = (GH.dataField 0 1 16 0)+    data RawWhich Expression mut_+        = RW_Expression'literal (R.Raw Std_.Double mut_)+        | RW_Expression'previousResult (R.Raw Value mut_)+        | RW_Expression'parameter (R.Raw Std_.Word32 mut_)+        | RW_Expression'call (R.Raw Expression'call mut_)+        | RW_Expression'unknown' Std_.Word16+    internalWhich tag_ struct_ = case tag_ of+        0 ->+            (RW_Expression'literal <$> (GH.readVariant #literal struct_))+        1 ->+            (RW_Expression'previousResult <$> (GH.readVariant #previousResult struct_))+        2 ->+            (RW_Expression'parameter <$> (GH.readVariant #parameter struct_))+        3 ->+            (RW_Expression'call <$> (GH.readVariant #call struct_))+        _ ->+            (Std_.pure (RW_Expression'unknown' tag_))+    data Which Expression instance (GH.HasVariant "literal" GH.Slot Expression Std_.Double) where-  variantByLabel = (GH.Variant (GH.dataField 0 0 64 0) 0)-+    variantByLabel  = (GH.Variant (GH.dataField 0 0 64 0) 0) instance (GH.HasVariant "previousResult" GH.Slot Expression Value) where-  variantByLabel = (GH.Variant (GH.ptrField 0) 1)-+    variantByLabel  = (GH.Variant (GH.ptrField 0) 1) instance (GH.HasVariant "parameter" GH.Slot Expression Std_.Word32) where-  variantByLabel = (GH.Variant (GH.dataField 0 0 32 0) 2)-+    variantByLabel  = (GH.Variant (GH.dataField 0 0 32 0) 2) instance (GH.HasVariant "call" GH.Group Expression Expression'call) where-  variantByLabel = (GH.Variant GH.groupField 3)-+    variantByLabel  = (GH.Variant GH.groupField 3) data instance C.Parsed (GH.Which Expression)-  = Expression'literal (RP.Parsed Std_.Double)-  | Expression'previousResult (RP.Parsed Value)-  | Expression'parameter (RP.Parsed Std_.Word32)-  | Expression'call (RP.Parsed Expression'call)-  | Expression'unknown' Std_.Word16-  deriving (Generics.Generic)-+    = Expression'literal (RP.Parsed Std_.Double)+    | Expression'previousResult (RP.Parsed Value)+    | Expression'parameter (RP.Parsed Std_.Word32)+    | Expression'call (RP.Parsed Expression'call)+    | Expression'unknown' Std_.Word16+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed (GH.Which Expression)))- deriving instance (Std_.Eq (C.Parsed (GH.Which Expression)))- instance (C.Parse (GH.Which Expression) (C.Parsed (GH.Which Expression))) where-  parse raw_ =-    ( do+    parse raw_ = (do         rawWhich_ <- (GH.unionWhich raw_)         case rawWhich_ of-          (RW_Expression'literal rawArg_) ->-            (Expression'literal <$> (C.parse rawArg_))-          (RW_Expression'previousResult rawArg_) ->-            (Expression'previousResult <$> (C.parse rawArg_))-          (RW_Expression'parameter rawArg_) ->-            (Expression'parameter <$> (C.parse rawArg_))-          (RW_Expression'call rawArg_) ->-            (Expression'call <$> (C.parse rawArg_))-          (RW_Expression'unknown' tag_) ->-            (Std_.pure (Expression'unknown' tag_))-    )-+            (RW_Expression'literal rawArg_) ->+                (Expression'literal <$> (C.parse rawArg_))+            (RW_Expression'previousResult rawArg_) ->+                (Expression'previousResult <$> (C.parse rawArg_))+            (RW_Expression'parameter rawArg_) ->+                (Expression'parameter <$> (C.parse rawArg_))+            (RW_Expression'call rawArg_) ->+                (Expression'call <$> (C.parse rawArg_))+            (RW_Expression'unknown' tag_) ->+                (Std_.pure (Expression'unknown' tag_))+        ) instance (C.Marshal (GH.Which Expression) (C.Parsed (GH.Which Expression))) where-  marshalInto raw_ parsed_ = case parsed_ of-    (Expression'literal arg_) ->-      (GH.encodeVariant #literal arg_ (GH.unionStruct raw_))-    (Expression'previousResult arg_) ->-      (GH.encodeVariant #previousResult arg_ (GH.unionStruct raw_))-    (Expression'parameter arg_) ->-      (GH.encodeVariant #parameter arg_ (GH.unionStruct raw_))-    (Expression'call arg_) ->-      ( do-          rawGroup_ <- (GH.initVariant #call (GH.unionStruct raw_))-          (C.marshalInto rawGroup_ arg_)-      )-    (Expression'unknown' tag_) ->-      (GH.encodeField GH.unionField tag_ (GH.unionStruct raw_))--data Expression'call--type instance R.ReprFor Expression'call = (R.Ptr (Std_.Just R.Struct))-+    marshalInto raw_ parsed_ = case parsed_ of+        (Expression'literal arg_) ->+            (GH.encodeVariant #literal arg_ (GH.unionStruct raw_))+        (Expression'previousResult arg_) ->+            (GH.encodeVariant #previousResult arg_ (GH.unionStruct raw_))+        (Expression'parameter arg_) ->+            (GH.encodeVariant #parameter arg_ (GH.unionStruct raw_))+        (Expression'call arg_) ->+            (do+                rawGroup_ <- (GH.initVariant #call (GH.unionStruct raw_))+                (C.marshalInto rawGroup_ arg_)+                )+        (Expression'unknown' tag_) ->+            (GH.encodeField GH.unionField tag_ (GH.unionStruct raw_))+data Expression'call +type instance (R.ReprFor Expression'call) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Expression'call) where-  typeId = 15678475764784139622-+    typeId  = 15678475764784139622 instance (C.TypedStruct Expression'call) where-  numStructWords = 2-  numStructPtrs = 2-+    numStructWords  = 2+    numStructPtrs  = 2 instance (C.Allocate Expression'call) where-  type AllocHint Expression'call = ()-  new _ = C.newTypedStruct-+    type AllocHint Expression'call = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Expression'call (C.Parsed Expression'call))- instance (C.AllocateList Expression'call) where-  type ListAllocHint Expression'call = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Expression'call = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Expression'call (C.Parsed Expression'call))--data instance C.Parsed Expression'call = Expression'call'-  { function :: (RP.Parsed Function),-    params :: (RP.Parsed (R.List Expression))-  }-  deriving (Generics.Generic)-+data instance C.Parsed Expression'call+    = Expression'call' +        {function :: (RP.Parsed Function)+        ,params :: (RP.Parsed (R.List Expression))}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Expression'call))- deriving instance (Std_.Eq (C.Parsed Expression'call))- instance (C.Parse Expression'call (C.Parsed Expression'call)) where-  parse raw_ =-    ( Expression'call'-        <$> (GH.parseField #function raw_)-        <*> (GH.parseField #params raw_)-    )-+    parse raw_ = (Expression'call' <$> (GH.parseField #function raw_)+                                   <*> (GH.parseField #params raw_)) instance (C.Marshal Expression'call (C.Parsed Expression'call)) where-  marshalInto raw_ Expression'call' {..} =-    ( do+    marshalInto raw_ Expression'call'{..} = (do         (GH.encodeField #function function raw_)         (GH.encodeField #params params raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "function" GH.Slot Expression'call Function) where-  fieldByLabel = (GH.ptrField 0)-+    fieldByLabel  = (GH.ptrField 0) instance (GH.HasField "params" GH.Slot Expression'call (R.List Expression)) where-  fieldByLabel = (GH.ptrField 1)--data Value--type instance R.ReprFor Value = (R.Ptr (Std_.Just R.Cap))-+    fieldByLabel  = (GH.ptrField 1)+data Value +type instance (R.ReprFor Value) = (R.Ptr (Std_.Just R.Cap)) instance (C.HasTypeId Value) where-  typeId = 14116142932258867410-+    typeId  = 14116142932258867410 instance (C.Parse Value (GH.Client Value)) where-  parse = GH.parseCap-  encode = GH.encodeCap-+    parse  = GH.parseCap+    encode  = GH.encodeCap instance (GH.Export Value) where-  type Server Value = Value'server_-  methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Value)) [(GH.toUntypedMethodHandler ((value'read) s_))] [])--class Value'server_ s_ where-  {-# MINIMAL value'read #-}-  value'read :: s_ -> (GH.MethodHandler Value'read'params Value'read'results)-  value'read _ = GH.methodUnimplemented-+    type Server Value = Value'server_+    methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Value)) [(GH.toUntypedMethodHandler ((value'read) s_))] [])+class (Value'server_ s_) where+    {-# MINIMAL value'read #-}+    value'read :: s_ -> (GH.MethodHandler Value'read'params Value'read'results)+    value'read _ = GH.methodUnimplemented instance (GH.HasMethod "read" Value Value'read'params Value'read'results) where-  methodByLabel = (GH.Method 14116142932258867410 0)--data Value'read'params--type instance R.ReprFor Value'read'params = (R.Ptr (Std_.Just R.Struct))-+    methodByLabel  = (GH.Method 14116142932258867410 0)+data Value'read'params +type instance (R.ReprFor Value'read'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Value'read'params) where-  typeId = 15227555948799047000-+    typeId  = 15227555948799047000 instance (C.TypedStruct Value'read'params) where-  numStructWords = 0-  numStructPtrs = 0-+    numStructWords  = 0+    numStructPtrs  = 0 instance (C.Allocate Value'read'params) where-  type AllocHint Value'read'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Value'read'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Value'read'params (C.Parsed Value'read'params))- instance (C.AllocateList Value'read'params) where-  type ListAllocHint Value'read'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Value'read'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Value'read'params (C.Parsed Value'read'params))--data instance C.Parsed Value'read'params = Value'read'params-  {}-  deriving (Generics.Generic)-+data instance C.Parsed Value'read'params+    = Value'read'params +        {}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Value'read'params))- deriving instance (Std_.Eq (C.Parsed Value'read'params))- instance (C.Parse Value'read'params (C.Parsed Value'read'params)) where-  parse raw_ = (Std_.pure Value'read'params)-+    parse raw_ = (Std_.pure Value'read'params) instance (C.Marshal Value'read'params (C.Parsed Value'read'params)) where-  marshalInto _raw (Value'read'params) = (Std_.pure ())--data Value'read'results--type instance R.ReprFor Value'read'results = (R.Ptr (Std_.Just R.Struct))-+    marshalInto _raw (Value'read'params) = (Std_.pure ())+data Value'read'results +type instance (R.ReprFor Value'read'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Value'read'results) where-  typeId = 16626840274624768034-+    typeId  = 16626840274624768034 instance (C.TypedStruct Value'read'results) where-  numStructWords = 1-  numStructPtrs = 0-+    numStructWords  = 1+    numStructPtrs  = 0 instance (C.Allocate Value'read'results) where-  type AllocHint Value'read'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Value'read'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Value'read'results (C.Parsed Value'read'results))- instance (C.AllocateList Value'read'results) where-  type ListAllocHint Value'read'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Value'read'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Value'read'results (C.Parsed Value'read'results))--data instance C.Parsed Value'read'results = Value'read'results-  {value :: (RP.Parsed Std_.Double)}-  deriving (Generics.Generic)-+data instance C.Parsed Value'read'results+    = Value'read'results +        {value :: (RP.Parsed Std_.Double)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Value'read'results))- deriving instance (Std_.Eq (C.Parsed Value'read'results))- instance (C.Parse Value'read'results (C.Parsed Value'read'results)) where-  parse raw_ = (Value'read'results <$> (GH.parseField #value raw_))-+    parse raw_ = (Value'read'results <$> (GH.parseField #value raw_)) instance (C.Marshal Value'read'results (C.Parsed Value'read'results)) where-  marshalInto raw_ Value'read'results {..} =-    ( do+    marshalInto raw_ Value'read'results{..} = (do         (GH.encodeField #value value raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "value" GH.Slot Value'read'results Std_.Double) where-  fieldByLabel = (GH.dataField 0 0 64 0)--data Function--type instance R.ReprFor Function = (R.Ptr (Std_.Just R.Cap))-+    fieldByLabel  = (GH.dataField 0 0 64 0)+data Function +type instance (R.ReprFor Function) = (R.Ptr (Std_.Just R.Cap)) instance (C.HasTypeId Function) where-  typeId = 17143016017778443156-+    typeId  = 17143016017778443156 instance (C.Parse Function (GH.Client Function)) where-  parse = GH.parseCap-  encode = GH.encodeCap-+    parse  = GH.parseCap+    encode  = GH.encodeCap instance (GH.Export Function) where-  type Server Function = Function'server_-  methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Function)) [(GH.toUntypedMethodHandler ((function'call) s_))] [])--class Function'server_ s_ where-  {-# MINIMAL function'call #-}-  function'call :: s_ -> (GH.MethodHandler Function'call'params Function'call'results)-  function'call _ = GH.methodUnimplemented-+    type Server Function = Function'server_+    methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Function)) [(GH.toUntypedMethodHandler ((function'call) s_))] [])+class (Function'server_ s_) where+    {-# MINIMAL function'call #-}+    function'call :: s_ -> (GH.MethodHandler Function'call'params Function'call'results)+    function'call _ = GH.methodUnimplemented instance (GH.HasMethod "call" Function Function'call'params Function'call'results) where-  methodByLabel = (GH.Method 17143016017778443156 0)--data Function'call'params--type instance R.ReprFor Function'call'params = (R.Ptr (Std_.Just R.Struct))-+    methodByLabel  = (GH.Method 17143016017778443156 0)+data Function'call'params +type instance (R.ReprFor Function'call'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Function'call'params) where-  typeId = 12795114529121400599-+    typeId  = 12795114529121400599 instance (C.TypedStruct Function'call'params) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Function'call'params) where-  type AllocHint Function'call'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Function'call'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Function'call'params (C.Parsed Function'call'params))- instance (C.AllocateList Function'call'params) where-  type ListAllocHint Function'call'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Function'call'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Function'call'params (C.Parsed Function'call'params))--data instance C.Parsed Function'call'params = Function'call'params-  {params :: (RP.Parsed (R.List Std_.Double))}-  deriving (Generics.Generic)-+data instance C.Parsed Function'call'params+    = Function'call'params +        {params :: (RP.Parsed (R.List Std_.Double))}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Function'call'params))- deriving instance (Std_.Eq (C.Parsed Function'call'params))- instance (C.Parse Function'call'params (C.Parsed Function'call'params)) where-  parse raw_ = (Function'call'params <$> (GH.parseField #params raw_))-+    parse raw_ = (Function'call'params <$> (GH.parseField #params raw_)) instance (C.Marshal Function'call'params (C.Parsed Function'call'params)) where-  marshalInto raw_ Function'call'params {..} =-    ( do+    marshalInto raw_ Function'call'params{..} = (do         (GH.encodeField #params params raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "params" GH.Slot Function'call'params (R.List Std_.Double)) where-  fieldByLabel = (GH.ptrField 0)--data Function'call'results--type instance R.ReprFor Function'call'results = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Function'call'results +type instance (R.ReprFor Function'call'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Function'call'results) where-  typeId = 13898297529173597869-+    typeId  = 13898297529173597869 instance (C.TypedStruct Function'call'results) where-  numStructWords = 1-  numStructPtrs = 0-+    numStructWords  = 1+    numStructPtrs  = 0 instance (C.Allocate Function'call'results) where-  type AllocHint Function'call'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Function'call'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Function'call'results (C.Parsed Function'call'results))- instance (C.AllocateList Function'call'results) where-  type ListAllocHint Function'call'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Function'call'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Function'call'results (C.Parsed Function'call'results))--data instance C.Parsed Function'call'results = Function'call'results-  {value :: (RP.Parsed Std_.Double)}-  deriving (Generics.Generic)-+data instance C.Parsed Function'call'results+    = Function'call'results +        {value :: (RP.Parsed Std_.Double)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Function'call'results))- deriving instance (Std_.Eq (C.Parsed Function'call'results))- instance (C.Parse Function'call'results (C.Parsed Function'call'results)) where-  parse raw_ = (Function'call'results <$> (GH.parseField #value raw_))-+    parse raw_ = (Function'call'results <$> (GH.parseField #value raw_)) instance (C.Marshal Function'call'results (C.Parsed Function'call'results)) where-  marshalInto raw_ Function'call'results {..} =-    ( do+    marshalInto raw_ Function'call'results{..} = (do         (GH.encodeField #value value raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "value" GH.Slot Function'call'results Std_.Double) where-  fieldByLabel = (GH.dataField 0 0 64 0)--data Operator-  = Operator'add-  | Operator'subtract-  | Operator'multiply-  | Operator'divide-  | Operator'unknown' Std_.Word16-  deriving-    ( Std_.Eq,-      Std_.Show,-      Generics.Generic-    )--type instance R.ReprFor Operator = (R.Data R.Sz16)-+    fieldByLabel  = (GH.dataField 0 0 64 0)+data Operator +    = Operator'add +    | Operator'subtract +    | Operator'multiply +    | Operator'divide +    | Operator'unknown' Std_.Word16+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic)+type instance (R.ReprFor Operator) = (R.Data R.Sz16) instance (C.HasTypeId Operator) where-  typeId = 9769222902479511526-+    typeId  = 9769222902479511526 instance (Std_.Enum Operator) where-  toEnum n_ = case n_ of-    0 ->-      Operator'add-    1 ->-      Operator'subtract-    2 ->-      Operator'multiply-    3 ->-      Operator'divide-    tag_ ->-      (Operator'unknown' (Std_.fromIntegral tag_))-  fromEnum value_ = case value_ of-    (Operator'add) ->-      0-    (Operator'subtract) ->-      1-    (Operator'multiply) ->-      2-    (Operator'divide) ->-      3-    (Operator'unknown' tag_) ->-      (Std_.fromIntegral tag_)-+    toEnum n_ = case n_ of+        0 ->+            Operator'add+        1 ->+            Operator'subtract+        2 ->+            Operator'multiply+        3 ->+            Operator'divide+        tag_ ->+            (Operator'unknown' (Std_.fromIntegral tag_))+    fromEnum value_ = case value_ of+        (Operator'add) ->+            0+        (Operator'subtract) ->+            1+        (Operator'multiply) ->+            2+        (Operator'divide) ->+            3+        (Operator'unknown' tag_) ->+            (Std_.fromIntegral tag_) instance (C.IsWord Operator) where-  fromWord w_ = (Std_.toEnum (Std_.fromIntegral w_))-  toWord v_ = (Std_.fromIntegral (Std_.fromEnum v_))-+    fromWord w_ = (Std_.toEnum (Std_.fromIntegral w_))+    toWord v_ = (Std_.fromIntegral (Std_.fromEnum v_)) instance (C.Parse Operator Operator) where-  parse = GH.parseEnum-  encode = GH.encodeEnum-+    parse  = GH.parseEnum+    encode  = GH.encodeEnum instance (C.AllocateList Operator) where-  type ListAllocHint Operator = Std_.Int-+    type ListAllocHint Operator = Std_.Int instance (C.EstimateListAlloc Operator Operator)

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-}@@ -5,144 +6,106 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE UndecidableSuperClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wno-dodgy-exports #-}-{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}-{-# OPTIONS_GHC -Wno-unused-matches #-}-+{-# OPTIONS_GHC -Wno-name-shadowing #-} module Capnp.Gen.Echo where-+import qualified Capnp.Repr as R+import qualified Capnp.Repr.Parsed as RP import qualified Capnp.Basics as Basics-import qualified Capnp.Classes as C+import qualified GHC.OverloadedLabels as OL import qualified Capnp.GenHelpers as GH+import qualified Capnp.Classes as C+import qualified GHC.Generics as Generics import qualified Capnp.GenHelpers.Rpc as GH-import qualified Capnp.Repr as R-import qualified Capnp.Repr.Parsed as RP-import qualified Data.Int as Std_+import qualified Prelude as Std_ import qualified Data.Word as Std_-import qualified GHC.Generics as Generics-import qualified GHC.OverloadedLabels as OL+import qualified Data.Int as Std_ import Prelude ((<$>), (<*>), (>>=))-import qualified Prelude as Std_--data Echo--type instance R.ReprFor Echo = (R.Ptr (Std_.Just R.Cap))-+data Echo +type instance (R.ReprFor Echo) = (R.Ptr (Std_.Just R.Cap)) instance (C.HasTypeId Echo) where-  typeId = 16940812395455687611-+    typeId  = 16940812395455687611 instance (C.Parse Echo (GH.Client Echo)) where-  parse = GH.parseCap-  encode = GH.encodeCap-+    parse  = GH.parseCap+    encode  = GH.encodeCap instance (GH.Export Echo) where-  type Server Echo = Echo'server_-  methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Echo)) [(GH.toUntypedMethodHandler ((echo'echo) s_))] [])--class Echo'server_ s_ where-  {-# MINIMAL echo'echo #-}-  echo'echo :: s_ -> (GH.MethodHandler Echo'echo'params Echo'echo'results)-  echo'echo _ = GH.methodUnimplemented-+    type Server Echo = Echo'server_+    methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Echo)) [(GH.toUntypedMethodHandler ((echo'echo) s_))] [])+class (Echo'server_ s_) where+    {-# MINIMAL echo'echo #-}+    echo'echo :: s_ -> (GH.MethodHandler Echo'echo'params Echo'echo'results)+    echo'echo _ = GH.methodUnimplemented instance (GH.HasMethod "echo" Echo Echo'echo'params Echo'echo'results) where-  methodByLabel = (GH.Method 16940812395455687611 0)--data Echo'echo'params--type instance R.ReprFor Echo'echo'params = (R.Ptr (Std_.Just R.Struct))-+    methodByLabel  = (GH.Method 16940812395455687611 0)+data Echo'echo'params +type instance (R.ReprFor Echo'echo'params) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Echo'echo'params) where-  typeId = 11805419372138457970-+    typeId  = 11805419372138457970 instance (C.TypedStruct Echo'echo'params) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Echo'echo'params) where-  type AllocHint Echo'echo'params = ()-  new _ = C.newTypedStruct-+    type AllocHint Echo'echo'params = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Echo'echo'params (C.Parsed Echo'echo'params))- instance (C.AllocateList Echo'echo'params) where-  type ListAllocHint Echo'echo'params = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Echo'echo'params = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Echo'echo'params (C.Parsed Echo'echo'params))--data instance C.Parsed Echo'echo'params = Echo'echo'params-  {query :: (RP.Parsed Basics.Text)}-  deriving (Generics.Generic)-+data instance C.Parsed Echo'echo'params+    = Echo'echo'params +        {query :: (RP.Parsed Basics.Text)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Echo'echo'params))- deriving instance (Std_.Eq (C.Parsed Echo'echo'params))- instance (C.Parse Echo'echo'params (C.Parsed Echo'echo'params)) where-  parse raw_ = (Echo'echo'params <$> (GH.parseField #query raw_))-+    parse raw_ = (Echo'echo'params <$> (GH.parseField #query raw_)) instance (C.Marshal Echo'echo'params (C.Parsed Echo'echo'params)) where-  marshalInto raw_ Echo'echo'params {..} =-    ( do+    marshalInto raw_ Echo'echo'params{..} = (do         (GH.encodeField #query query raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "query" GH.Slot Echo'echo'params Basics.Text) where-  fieldByLabel = (GH.ptrField 0)--data Echo'echo'results--type instance R.ReprFor Echo'echo'results = (R.Ptr (Std_.Just R.Struct))-+    fieldByLabel  = (GH.ptrField 0)+data Echo'echo'results +type instance (R.ReprFor Echo'echo'results) = (R.Ptr (Std_.Just R.Struct)) instance (C.HasTypeId Echo'echo'results) where-  typeId = 9634882973594762090-+    typeId  = 9634882973594762090 instance (C.TypedStruct Echo'echo'results) where-  numStructWords = 0-  numStructPtrs = 1-+    numStructWords  = 0+    numStructPtrs  = 1 instance (C.Allocate Echo'echo'results) where-  type AllocHint Echo'echo'results = ()-  new _ = C.newTypedStruct-+    type AllocHint Echo'echo'results = ()+    new _ = C.newTypedStruct instance (C.EstimateAlloc Echo'echo'results (C.Parsed Echo'echo'results))- instance (C.AllocateList Echo'echo'results) where-  type ListAllocHint Echo'echo'results = Std_.Int-  newList = C.newTypedStructList-+    type ListAllocHint Echo'echo'results = Std_.Int+    newList  = C.newTypedStructList instance (C.EstimateListAlloc Echo'echo'results (C.Parsed Echo'echo'results))--data instance C.Parsed Echo'echo'results = Echo'echo'results-  {reply :: (RP.Parsed Basics.Text)}-  deriving (Generics.Generic)-+data instance C.Parsed Echo'echo'results+    = Echo'echo'results +        {reply :: (RP.Parsed Basics.Text)}+    deriving(Generics.Generic) deriving instance (Std_.Show (C.Parsed Echo'echo'results))- deriving instance (Std_.Eq (C.Parsed Echo'echo'results))- instance (C.Parse Echo'echo'results (C.Parsed Echo'echo'results)) where-  parse raw_ = (Echo'echo'results <$> (GH.parseField #reply raw_))-+    parse raw_ = (Echo'echo'results <$> (GH.parseField #reply raw_)) instance (C.Marshal Echo'echo'results (C.Parsed Echo'echo'results)) where-  marshalInto raw_ Echo'echo'results {..} =-    ( do+    marshalInto raw_ Echo'echo'results{..} = (do         (GH.encodeField #reply reply raw_)         (Std_.pure ())-    )-+        ) instance (GH.HasField "reply" GH.Slot Echo'echo'results Basics.Text) where-  fieldByLabel = (GH.ptrField 0)+    fieldByLabel  = (GH.ptrField 0)

@@ -4,82 +4,75 @@  module Examples.Rpc.CalculatorClient (main) where -import Capnp.Gen.Calculator import qualified Capnp as C+import Capnp.Gen.Calculator import Capnp.Rpc   ( ConnConfig (..),     fromClient,-    handleConn,+    requestBootstrap,     socketTransport,+    withConn,   ) import Control.Monad (when) import Data.Function ((&)) import Data.Functor ((<&>))-import qualified Data.Vector as V import Network.Simple.TCP (connect)  main :: IO () main = connect "localhost" "4000" $ \(sock, _addr) ->-  handleConn-    (socketTransport sock C.defaultLimit)-    C.def-      { debugMode = True,-        withBootstrap = Just $ \_sup client -> do-          let calc :: C.Client Calculator-              calc = fromClient client--          value <--            calc-              & C.callP #evaluate C.def {expression = Expression $ Expression'literal 123}-              <&> C.pipe #value-              >>= C.callR #read C.def-              >>= C.waitPipeline-              >>= C.evalLimitT C.defaultLimit . C.parseField #value-          assertEq value 123+  withConn (socketTransport sock C.defaultLimit) C.def {debugMode = True} $ \conn -> do+    client <- requestBootstrap conn+    let calc :: C.Client Calculator+        calc = fromClient client -          let getOp op =-                calc-                  & C.callP #getOperator C.def {op}-                  <&> C.pipe #func-                  >>= C.asClient+    value <-+      calc+        & C.callP #evaluate C.def {expression = Expression $ Expression'literal 123}+        <&> C.pipe #value+        >>= C.callR #read C.def+        >>= C.waitPipeline+        >>= C.evalLimitT C.defaultLimit . C.parseField #value+    assertEq value 123 -          add <- getOp Operator'add-          subtract <- getOp Operator'subtract+    let getOp op =+          calc+            & C.callP #getOperator C.def {op}+            <&> C.pipe #func+            >>= C.asClient -          value <--            calc-              & C.callP-                #evaluate-                C.def-                  { expression =-                      Expression $-                        Expression'call-                          Expression'call'-                            { function = subtract,-                              params =-                                V.fromList-                                  [ Expression $-                                      Expression'call-                                        Expression'call'-                                          { function = add,-                                            params =-                                              V.fromList-                                                [ Expression $ Expression'literal 123,-                                                  Expression $ Expression'literal 45-                                                ]-                                          },-                                    Expression $ Expression'literal 67-                                  ]-                            }-                  }-              <&> C.pipe #value-              >>= C.callR #read C.def-              >>= C.waitPipeline-              >>= C.evalLimitT C.defaultLimit . C.parseField #value-          assertEq value 101+    add <- getOp Operator'add+    subtract <- getOp Operator'subtract -          putStrLn "PASS"-      }+    value <-+      calc+        & C.callP+          #evaluate+          C.def+            { expression =+                Expression $+                  Expression'call+                    Expression'call'+                      { function = subtract,+                        params =+                          [ Expression $+                              Expression'call+                                Expression'call'+                                  { function = add,+                                    params =+                                      [ Expression $ Expression'literal 123,+                                        Expression $ Expression'literal 45+                                      ]+                                  },+                            Expression $ Expression'literal 67+                          ]+                      }+            }+        <&> C.pipe #value+        >>= C.callR #read C.def+        >>= C.waitPipeline+        >>= C.evalLimitT C.defaultLimit . C.parseField #value+    assertEq value 101+    putStrLn "PASS"  assertEq :: (Show a, Eq a) => a -> a -> IO () assertEq got want =

@@ -8,7 +8,6 @@  module Examples.Rpc.CalculatorServer (main) where -import Capnp.Gen.Calculator import Capnp   ( Client,     Pipeline,@@ -21,6 +20,7 @@     handleParsed,     waitPipeline,   )+import Capnp.Gen.Calculator import Capnp.Rpc   ( ConnConfig (..),     handleConn,@@ -28,14 +28,13 @@     throwFailed,     toClient,   )-import Control.Concurrent.STM (STM, atomically)+import Control.Concurrent.STM (atomically) import Control.Monad (when) import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Int-import qualified Data.Vector as V import Network.Simple.TCP (serve)-import Supervisors (Supervisor)+import Supervisors (Supervisor, withSupervisor) import Prelude hiding (subtract)  newtype LitValue = LitValue Double@@ -51,13 +50,12 @@ instance SomeServer OpFunc  instance Function'server_ OpFunc where-  function'call (OpFunc op) = handleParsed $ \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)-        }+  function'call (OpFunc op) = handleParsed $ \Function'call'params {params} ->+    case params of+      [l, r] ->+        pure Function'call'results {value = l `op` r}+      _ ->+        throwFailed "Wrong number of parameters."  data ExprFunc = ExprFunc   { paramCount :: !Int32,@@ -69,7 +67,7 @@ instance Function'server_ ExprFunc where   function'call ExprFunc {..} =     handleParsed $ \Function'call'params {params} -> do-      when (fromIntegral (V.length params) /= paramCount) $+      when (fromIntegral (length params) /= paramCount) $         throwFailed "Wrong number of parameters."       eval params body         >>= waitResult@@ -88,7 +86,7 @@ instance Calculator'server_ MyCalc where   calculator'evaluate MyCalc {sup} =     handleParsed $ \Calculator'evaluate'params {expression} -> do-      eval V.empty expression+      eval [] expression         >>= waitResult         >>= export @Value sup . LitValue         <&> Calculator'evaluate'results@@ -108,7 +106,7 @@       Calculator'defFunction'results         <$> atomically (export @Function sup ExprFunc {..}) -newCalculator :: Supervisor -> STM (Client Calculator)+newCalculator :: Supervisor -> IO (Client Calculator) newCalculator sup = do   add <- export @Function sup $ OpFunc (+)   subtract <- export @Function sup $ OpFunc (-)@@ -126,7 +124,7 @@ waitResult (CallResult p) = getField #value <$> waitPipeline p waitResult (ReadResult p) = getField #value <$> waitPipeline p -eval :: V.Vector Double -> Parsed Expression -> IO EvalResult+eval :: [Double] -> Parsed Expression -> IO EvalResult eval outerParams (Expression exp) = go outerParams exp   where     go _ (Expression'literal lit) =@@ -136,10 +134,10 @@         & callP #read def         <&> ReadResult     go args (Expression'parameter idx)-      | fromIntegral idx >= V.length args =+      | fromIntegral idx >= length args =           throwFailed "Parameter index out of bounds"       | otherwise =-          pure $ Immediate $ args V.! fromIntegral idx+          pure $ Immediate $ args !! fromIntegral idx     go outerParams (Expression'call Expression'call' {function, params = innerParams}) = do       argPipelines <- traverse (eval outerParams) innerParams       argValues <- traverse waitResult argPipelines@@ -150,10 +148,12 @@       throwFailed "Unknown expression type"  main :: IO ()-main = serve "localhost" "4000" $ \(sock, _addr) ->-  handleConn-    (socketTransport sock defaultLimit)-    def-      { getBootstrap = fmap (Just . toClient) . newCalculator,-        debugMode = True-      }+main = withSupervisor $ \sup -> do+  boot <- newCalculator sup+  serve "localhost" "4000" $ \(sock, _addr) ->+    handleConn+      (socketTransport sock defaultLimit)+      def+        { debugMode = True,+          bootstrap = Just (toClient boot)+        }

@@ -67,10 +67,11 @@ import qualified Capnp.Fields as F import Capnp.IO as X import qualified Capnp.Message as Message-import Capnp.New.Rpc.Server import qualified Capnp.Repr as R import Capnp.Repr.Methods as X import Capnp.Repr.Parsed (Parsed)+import Capnp.Rpc.Server import Capnp.TraversalLimit as X import Data.Default (def) import Internal.BuildPure (PureBuilder, createPure)+import Internal.Rpc.Export (export)

@@ -151,9 +151,9 @@  instance C.EstimateListAlloc AnyStruct (C.Parsed AnyStruct) where   estimateListAlloc structs =-    let len = V.length structs-        !nWords = foldl' max 0 $ map (V.length . structData) $ V.toList structs-        !nPtrs = foldl' max 0 $ map (V.length . structPtrs) $ V.toList structs+    let len = length structs+        !nWords = foldl' max 0 $ map (V.length . structData) structs+        !nPtrs = foldl' max 0 $ map (V.length . structPtrs) structs      in (len, (fromIntegral nWords, fromIntegral nPtrs))  instance C.EstimateAlloc AnyStruct (C.Parsed AnyStruct) where@@ -170,19 +170,15 @@       R.Raw ptr <- C.encode (U.message @U.Struct raw) value       U.setPtr ptr i raw --- TODO(cleanup): It would be nice if we could reuse Capnp.Repr.Parsed.Parsed--- here, but that would cause a circular import dependency.-type ParsedList a = V.Vector a- data instance C.Parsed AnyList-  = ListPtr (ParsedList (Maybe (C.Parsed AnyPointer)))-  | ListStruct (ParsedList (C.Parsed AnyStruct))-  | List0 (ParsedList ())-  | List1 (ParsedList Bool)-  | List8 (ParsedList Word8)-  | List16 (ParsedList Word16)-  | List32 (ParsedList Word32)-  | List64 (ParsedList Word64)+  = ListPtr [Maybe (C.Parsed AnyPointer)]+  | ListStruct [C.Parsed AnyStruct]+  | List0 [()]+  | List1 [Bool]+  | List8 [Word8]+  | List16 [Word16]+  | List32 [Word32]+  | List64 [Word64]   deriving (Show, Eq, Generic)  instance C.Parse AnyList (C.Parsed AnyList) where

@@ -61,7 +61,6 @@ import Data.Default (Default (..)) import Data.Foldable (for_) import Data.Int-import qualified Data.Vector as V import Data.Word import qualified GHC.Float as F import qualified Language.Haskell.TH as TH@@ -165,10 +164,10 @@   type ListAllocHint (R.List a) = Int  instance-  ( Parse (R.List a) (V.Vector ap),+  ( Parse (R.List a) [ap],     Allocate (R.List a)   ) =>-  EstimateListAlloc (R.List a) (V.Vector ap)+  EstimateListAlloc (R.List a) [ap]  -- | Allocate a new typed struct. Mainly used as the value for 'new' for in generated -- instances of 'Allocate'.@@ -260,15 +259,19 @@   parse = pure . F.castWord64ToDouble . R.fromRaw   encode _ = pure . R.Raw . F.castDoubleToWord64 -instance MarshalElement a ap => Marshal (R.List a) (V.Vector ap) where+instance MarshalElement a ap => Marshal (R.List a) [ap] where   marshalInto raw value =-    for_ [0 .. V.length value - 1] $ \i ->-      marshalElement raw i (value V.! i)+    for_ (zip [0 ..] value) $ \(i, v) ->+      marshalElement raw i v -instance MarshalElement a ap => Parse (R.List a) (V.Vector ap) where-  parse rawV =-    V.generateM (R.length rawV) $ \i ->-      R.index i rawV >>= parse+instance MarshalElement a ap => Parse (R.List a) [ap] where+  parse rawV = go [] (R.length rawV - 1)+    where+      go acc i+        | i < 0 = pure acc+        | otherwise = do+            item <- R.index i rawV >>= parse+            go (item : acc) (i - 1)  -- | Type alias capturing the constraints on a type needed by -- 'marshalElement'@@ -338,12 +341,12 @@ marshalElement = marshalElementByRepr @(R.ListReprFor (R.ReprFor a))  class (Parse a ap, Allocate (R.List a)) => EstimateListAlloc a ap where-  estimateListAlloc :: V.Vector ap -> AllocHint (R.List a)-  default estimateListAlloc :: (AllocHint (R.List a) ~ Int) => V.Vector ap -> AllocHint (R.List a)-  estimateListAlloc = V.length+  estimateListAlloc :: [ap] -> AllocHint (R.List a)+  default estimateListAlloc :: (AllocHint (R.List a) ~ Int) => [ap] -> AllocHint (R.List a)+  estimateListAlloc = length   {-# INLINEABLE estimateListAlloc #-} -instance MarshalElement a ap => EstimateAlloc (R.List a) (V.Vector ap) where+instance MarshalElement a ap => EstimateAlloc (R.List a) [ap] where   estimateAlloc = estimateListAlloc @a   {-# INLINEABLE estimateAlloc #-} @@ -383,7 +386,7 @@             type ListAllocHint $ty = Int            instance EstimateListAlloc $ty $ty where-            estimateListAlloc = V.length+            estimateListAlloc = length             {-# INLINEABLE estimateListAlloc #-}           |] 

@@ -3,7 +3,7 @@ {-# LANGUAGE TypeFamilies #-}  module Capnp.GenHelpers.Rpc-  ( module Capnp.New.Rpc.Server,+  ( module Capnp.Rpc.Server,     module Capnp.Repr.Methods,     parseCap,     encodeCap,@@ -12,9 +12,9 @@  import Capnp.Message (Mutability (..)) import qualified Capnp.Message as M-import Capnp.New.Rpc.Server import qualified Capnp.Repr as R import Capnp.Repr.Methods+import Capnp.Rpc.Server import qualified Capnp.Untyped as U  parseCap :: (R.IsCap a, U.ReadCtx m 'Const) => R.Raw a 'Const -> m (Client a)

@@ -67,6 +67,7 @@     WriteCtx,     Client,     nullClient,+    invalidClient,     withCapTable,   ) where@@ -98,7 +99,7 @@ import GHC.ByteOrder (ByteOrder (..), targetByteOrder) import Internal.AppendVec (AppendVec) import qualified Internal.AppendVec as AppendVec-import Internal.Rpc.Breaker (Client, nullClient)+import Internal.Rpc.Breaker (Client, invalidClient, nullClient) import System.IO (Handle, stdin, stdout) import Prelude hiding (read) @@ -235,7 +236,7 @@ getCap msg i = do   ncaps <- numCaps msg   if i >= ncaps || i < 0-    then pure nullClient+    then pure (invalidClient $ "capability index out of bounds: " ++ show i)     else msg `internalGetCap` i  -- | @'setSegment' message index segment@ sets the segment at the given index

@@ -1,254 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}--module Capnp.New.Rpc.Server-  ( CallHandler,-    MethodHandler,-    UntypedMethodHandler,-    Export (..),-    export,-    findMethod,-    SomeServer (..),--    -- * Helpers for writing method handlers-    handleParsed,-    handleRaw,-    methodUnimplemented,-    toUntypedMethodHandler,--    -- * Internals; exposed only for use by generated code.-    MethodHandlerTree (..),-  )-where--import qualified Capnp.Basics as B-import qualified Capnp.Classes as C-import Capnp.Convert (parsedToRaw)-import Capnp.Message (Mutability (..))-import qualified Capnp.Repr as R-import Capnp.Repr.Methods (Client (..))-import Capnp.Rpc.Errors-  ( eFailed,-    eMethodUnimplemented,-    wrapException,-  )-import Capnp.Rpc.Promise-  ( Fulfiller,-    breakPromise,-    fulfill,-    newCallback,-  )-import qualified Capnp.Rpc.Server as Legacy-import qualified Capnp.Rpc.Untyped as URpc-import Capnp.TraversalLimit (defaultLimit, evalLimitT)-import qualified Capnp.Untyped as U-import Control.Exception.Safe (withException)-import Control.Monad.STM.Class (MonadSTM (..))-import Data.Function ((&))-import Data.Kind (Constraint, Type)-import qualified Data.Map.Strict as M-import Data.Maybe (fromMaybe)-import Data.Proxy (Proxy (..))-import Data.Typeable (Typeable)-import qualified Data.Vector as V-import Data.Word-import GHC.Prim (coerce)-import Internal.BuildPure (createPure)-import Supervisors (Supervisor)---- | A handler for arbitrary RPC calls. Maps (interfaceId, methodId) pairs to--- 'UntypedMethodHandler's.-type CallHandler = M.Map Word64 (V.Vector UntypedMethodHandler)---- | Type alias for a handler for a particular rpc method.-type MethodHandler p r =-  R.Raw p 'Const ->-  Fulfiller (R.Raw r 'Const) ->-  IO ()---- | Type alias for a handler for an untyped RPC method.-type UntypedMethodHandler = MethodHandler B.AnyStruct B.AnyStruct---- | Base class for things that can act as capnproto servers.-class SomeServer a where-  -- | Called when the last live reference to a server is dropped.-  shutdown :: a -> IO ()-  shutdown _ = pure ()--  -- | Try to extract a value of a given type. The default implementation-  -- always fails (returns 'Nothing'). If an instance chooses to implement-  -- this, it will be possible to use "reflection" on clients that point-  -- at local servers to dynamically unwrap the server value. A typical-  -- implementation will just call Typeable's @cast@ method, but this-  -- needn't be the case -- a server may wish to allow local peers to-  -- unwrap some value that is not exactly the data the server has access-  -- to.-  unwrap :: Typeable b => a -> Maybe b-  unwrap _ = Nothing---- | Generated interface types have instances of 'Export', which allows a server--- for that interface to be exported as a 'Client'.-class (R.IsCap i, C.HasTypeId i) => Export i where-  -- | The constraint needed for a server to implement an interface;-  -- if @'Server' i s@ is satisfied, @s@ is a server for interface @i@.-  -- The code generator generates a type class for each interface, and-  -- this will aways be an alias for that type class.-  type Server i :: Type -> Constraint--  -- | Convert the server to a 'MethodHandlerTree' populated with appropriate-  -- 'MethodHandler's for the interface. This is really only exported for use-  -- by generated code; users of the library will generally prefer to use-  -- 'export'.-  methodHandlerTree :: Server i s => Proxy i -> s -> MethodHandlerTree---- NB: the proxy helps disambiguate types; for some reason TypeApplications--- doesn't seem to be enough in the face of a type alias of kind 'Constraint'.--- the inconsistency is a bit ugly, but this method isn't intended to called--- by users directly, only by generated code and our helper in this module,--- so it's less of a big deal.---- | Lazily computed tree of the method handlers exposed by an interface. Only--- of interest to generated code.-data MethodHandlerTree = MethodHandlerTree-  { -- | type id for the primary interface-    mhtId :: Word64,-    -- | method handlers for methods of the primary interface.-    mhtHandlers :: [UntypedMethodHandler],-    -- | Trees for parent interfaces. In the case of diamond dependencies,-    -- there may be duplicates, which are eliminated by 'mhtToCallHandler'.-    mhtParents :: [MethodHandlerTree]-  }--mhtToCallHandler :: MethodHandlerTree -> CallHandler-mhtToCallHandler = go M.empty . pure-  where-    go accum [] = accum-    go accum (t : ts)-      | mhtId t `M.member` accum = go accum ts -- dedup diamond dependencies-      | otherwise =-          go (M.insert (mhtId t) (V.fromList (mhtHandlers t)) accum) (mhtParents t ++ ts)---- | Export the server as a client for interface @i@. Spawns a server thread--- with its lifetime bound to the supervisor.-export :: forall i s m. (MonadSTM m, Export i, Server i s, SomeServer s) => Supervisor -> s -> m (Client i)-export sup srv =-  let h = mhtToCallHandler (methodHandlerTree (Proxy @i) srv)-   in liftSTM $ Client <$> URpc.export sup (toLegacyServerOps srv h)---- | Look up a particlar 'MethodHandler' in the 'CallHandler'.-findMethod :: Word64 -> Word16 -> CallHandler -> Maybe UntypedMethodHandler-findMethod interfaceId methodId handler = do-  iface <- M.lookup interfaceId handler-  iface V.!? fromIntegral methodId--toLegacyCallHandler ::-  CallHandler ->-  Word64 ->-  Word16 ->-  Legacy.MethodHandler (Maybe (U.Ptr 'Const)) (Maybe (U.Ptr 'Const))-toLegacyCallHandler callHandler interfaceId methodId =-  findMethod interfaceId methodId callHandler-    & fromMaybe methodUnimplemented-    & toLegacyMethodHandler---- | Convert a typed method handler to an untyped one. Mostly intended for--- use by generated code.-toUntypedMethodHandler ::-  forall p r.-  (R.IsStruct p, R.IsStruct r) =>-  MethodHandler p r ->-  UntypedMethodHandler-toUntypedMethodHandler = coerce--toLegacyMethodHandler :: UntypedMethodHandler -> Legacy.MethodHandler (Maybe (U.Ptr 'Const)) (Maybe (U.Ptr 'Const))-toLegacyMethodHandler handler =-  Legacy.untypedHandler $ \args respond -> do-    respond' <- newCallback $ \case-      Left e ->-        breakPromise respond e-      Right (R.Raw s) ->-        fulfill respond (Just (U.PtrStruct s))-    case args of-      Just (U.PtrStruct argStruct) ->-        handler (R.Raw argStruct) respond'-      _ ->-        breakPromise respond $ eFailed "Argument was not a struct"--toLegacyServerOps :: SomeServer a => a -> CallHandler -> Legacy.ServerOps-toLegacyServerOps srv callHandler =-  Legacy.ServerOps-    { handleStop = shutdown srv,-      handleCast = unwrap srv,-      handleCall = toLegacyCallHandler callHandler-    }---- Helpers for writing method handlers---- | Handle a method, working with the parsed form of parameters and--- results.-handleParsed ::-  ( C.Parse p pp,-    R.IsStruct p,-    C.Parse r pr,-    R.IsStruct r-  ) =>-  (pp -> IO pr) ->-  MethodHandler p r-handleParsed handler param = propagateExceptions $ \f -> do-  p <- evalLimitT defaultLimit $ C.parse param-  r <- handler p-  -- TODO: Figure out how to add an instance of Thaw for-  -- Raw so we can skip the (un)wrapping here.-  struct <- createPure maxBound $ R.fromRaw <$> parsedToRaw r-  fulfill f (R.Raw struct)---- | Handle a method, working with the raw (unparsed) form of--- parameters and results.-handleRaw ::-  (R.IsStruct p, R.IsStruct r) =>-  (R.Raw p 'Const -> IO (R.Raw r 'Const)) ->-  MethodHandler p r-handleRaw handler param = propagateExceptions $ \f ->-  handler param >>= fulfill f---- Helper for handle*; breaks the promise if the handler throws.-propagateExceptions :: (Fulfiller a -> IO b) -> Fulfiller a -> IO b-propagateExceptions h f =-  h f `withException` (breakPromise f . wrapException False)---- | 'MethodHandler' that always throws unimplemented.-methodUnimplemented :: MethodHandler p r-methodUnimplemented _ f = breakPromise f eMethodUnimplemented--{--Sketch of future Async API, might take a bit of internals work to make-this possible:---- | Handle a method call asynchronously.------ When invoked, the handleer will be run synchronously, blocking further--- method calls until the 'IO' returns. The method call does not return--- until the 'Async' resolves, but further method calls can be serviced in--- the meantime.------ If a Finish message is received before the Async resolves, it will be--- 'cancel'ed.-handleRawAsync-    :: (R.IsStruct p, R.IsStruct r)-    => (R.Raw 'Const p -> IO (Async (R.Raw 'Const r)))-    -> MethodHandler IO p r---- | Like 'handleRawAsync', but accepts and returns parsed values.-handleParsedAsync  ::-    ( C.Parse p pp, R.IsStruct p-    , C.Parse r, rr, R.IsStruct r-    )-    => (pp -> IO (Async rr))-    -> MethodHandler IO p r--}

@@ -11,7 +11,6 @@ import qualified Data.ByteString as BS import Data.Kind (Type) import qualified Data.Text as T-import qualified Data.Vector as V  -- | @'Parsed' a@ is the high-level/ADT representation of the capnproto -- type @a@. For struct types this is equivalent to @'C.Parsed' a@, but@@ -25,6 +24,6 @@   ParsedByRepr ('Ptr ('Just 'Cap)) a = Client a   ParsedByRepr _ B.Data = BS.ByteString   ParsedByRepr _ B.Text = T.Text-  ParsedByRepr _ (List a) = V.Vector (Parsed a)+  ParsedByRepr _ (List a) = [Parsed a]   ParsedByRepr _ (Maybe B.AnyPointer) = Maybe (C.Parsed B.AnyPointer)   ParsedByRepr _ a = C.Parsed a

@@ -5,8 +5,12 @@ -- This module exposes the most commonly used parts of the RPC subsystem. module Capnp.Rpc   ( -- * Establishing connections-    handleConn,+    Conn,     ConnConfig (..),+    acquireConn,+    handleConn,+    withConn,+    requestBootstrap,      -- * throwing errors     throwFailed,@@ -46,11 +50,15 @@   ) import Capnp.Rpc.Untyped   ( Client,+    Conn,     ConnConfig (..),     IsClient (..),+    acquireConn,     handleConn,     newPromiseClient,+    requestBootstrap,     waitClient,+    withConn,   ) import qualified Capnp.Rpc.Untyped as Untyped import Supervisors

@@ -23,6 +23,7 @@  import qualified Capnp.Message as M import Capnp.Mutability (Mutability (..))+import qualified Capnp.Repr as R import Capnp.Rpc.Promise (breakOrFulfill, newCallback) import qualified Capnp.Rpc.Server as Server import qualified Capnp.Rpc.Untyped as URpc@@ -30,6 +31,7 @@ import Control.Concurrent.STM import Control.Monad (void) import Control.Monad.STM.Class+import Data.Functor.Contravariant (contramap) import Data.Typeable (Typeable, cast) import Data.Word import Supervisors (Supervisor)@@ -110,14 +112,14 @@   x == y = identity x == identity y  wrapHandler :: Side -> Supervisor -> Membrane -> Server.UntypedMethodHandler -> Server.UntypedMethodHandler-wrapHandler receiverSide sup mem handler = Server.untypedHandler $ \arguments response -> do+wrapHandler receiverSide sup mem handler = \(R.Raw arguments) response -> do   (args, resp) <- atomically $ do     args' <- passPtr receiverSide sup mem arguments     resp' <- newCallback $ \result ->       traverse (passPtr (flipDir receiverSide) sup mem) result-        >>= breakOrFulfill response+        >>= breakOrFulfill (contramap R.Raw response)     pure (args', resp')-  Server.handleUntypedMethod handler args resp+  handler (R.Raw args) (contramap R.fromRaw resp)  passPtr :: MonadSTM m => Direction -> Supervisor -> Membrane -> Maybe (U.Ptr 'Const) -> m (Maybe (U.Ptr 'Const)) passPtr dir sup mem = liftSTM . traverse (U.tMsg $ passMessage dir sup mem)@@ -146,19 +148,18 @@             -- and then the relevant shutdown logic will still be called.             -- This introduces latency unfortuantely, but nothing is broken.             Server.handleStop = pure (),-            Server.handleCall = \interfaceId methodId ->-              Server.untypedHandler $ \arguments response ->-                do-                  action <- atomically $ policy mem Call {interfaceId, methodId, direction = dir, target = inClient}-                  case action of-                    Handle h -> Server.handleUntypedMethod h arguments response-                    Forward ->-                      Server.handleUntypedMethod-                        ( wrapHandler dir sup mem $ Server.untypedHandler $ \arguments response ->-                            void $ URpc.call Server.CallInfo {..} inClient-                        )-                        arguments-                        response+            Server.handleCall = \interfaceId methodId arguments response ->+              do+                action <- atomically $ policy mem Call {interfaceId, methodId, direction = dir, target = inClient}+                case action of+                  Handle h -> h arguments response+                  Forward ->+                    ( wrapHandler dir sup mem $ \(R.Raw arguments) resp ->+                        let response = contramap R.Raw resp+                         in void $ URpc.call Server.CallInfo {..} inClient+                    )+                      arguments+                      response           }  onSide :: Direction -> MembraneWrapped -> Membrane -> Bool

@@ -34,6 +34,7 @@ import Control.Concurrent.STM import qualified Control.Exception.Safe as HsExn import Control.Monad.STM.Class+import Data.Functor.Contravariant (Contravariant (..))  -- | An exception thrown if 'breakPromise' or 'fulfill' is called on an -- already-resolved fulfiller.@@ -45,6 +46,10 @@ newtype Fulfiller a = Fulfiller   { callback :: Either (Parsed Exception) a -> STM ()   }++instance Contravariant Fulfiller where+  contramap f Fulfiller {callback} =+    Fulfiller {callback = callback . fmap f}  -- | Fulfill a promise by supplying the specified value. It is an error to -- call 'fulfill' if the promise has already been fulfilled (or broken).

@@ -39,4 +39,4 @@       else Membrane.Forward  revokedHandler :: Server.UntypedMethodHandler-revokedHandler = Server.untypedHandler $ \_ response -> breakPromise response (eFailed "revoked")+revokedHandler _ response = breakPromise response (eFailed "revoked")

@@ -1,93 +1,118 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# 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-  ( Server (..),-    ServerOps (..),+  ( CallHandler,+    MethodHandler,+    UntypedMethodHandler,     CallInfo (..),+    ServerOps (..),+    Export (..),+    exportToServerOps,+    findMethod,+    SomeServer (..),     runServer,+    castHandler, -    -- * Handling methods-    MethodHandler,-    UntypedMethodHandler,-    handleUntypedMethod,+    -- * Helpers for writing method handlers+    handleParsed,+    handleRaw,+    methodUnimplemented,+    toUntypedMethodHandler, -    -- ** Working with untyped data-    untypedHandler,-    toUntypedHandler,-    fromUntypedHandler,+    -- * Internals; exposed only for use by generated code.+    MethodHandlerTree (..),   ) where +import qualified Capnp.Basics as B+import qualified Capnp.Classes as C+import Capnp.Convert (parsedToRaw) import Capnp.Message (Mutability (..))-import Capnp.Rpc.Promise (Fulfiller)-import Capnp.Untyped (Ptr)-import Control.Concurrent.STM+import qualified Capnp.Repr as R+-- import Capnp.Repr.Methods (Client (..))+import Capnp.Rpc.Errors+  ( eFailed,+    eMethodUnimplemented,+    wrapException,+  )+import Capnp.Rpc.Promise+  ( Fulfiller,+    breakPromise,+    fulfill,+  )+import Capnp.TraversalLimit (defaultLimit, evalLimitT)+import qualified Capnp.Untyped as U+import Control.Concurrent.STM (atomically)+import Control.Exception.Safe (withException)+import Data.Function ((&))+import Data.Functor.Contravariant (contramap)+import Data.Kind (Constraint, Type)+import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy (..)) import Data.Typeable (Typeable)+import qualified Data.Vector as V import Data.Word+import GHC.Prim (coerce)+import Internal.BuildPure (createPure) import qualified Internal.TCloseQ as TCloseQ --- | a @'MethodHandler' p r@ handles a method call with parameters @p@--- and return type @r@.------ 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 p r = MethodHandler-  { handleMethod ::-      Maybe (Ptr 'Const) ->-      Fulfiller (Maybe (Ptr 'Const)) ->-      IO ()+-- | A 'CallInfo' contains information about a method call.+data CallInfo = CallInfo+  { -- | The id of the interface whose method is being called.+    interfaceId :: !Word64,+    -- | The method id of the method being called.+    methodId :: !Word16,+    -- | The arguments to the method call.+    arguments :: Maybe (U.Ptr 'Const),+    -- | A 'Fulfiller' which accepts the method's return value.+    response :: Fulfiller (Maybe (U.Ptr 'Const))   } --- | Alias for a 'MethodHandler' whose parameter and return types are--- untyped pointers.-type UntypedMethodHandler = MethodHandler (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))+-- | The operations necessary to receive and handle method calls, i.e.+-- to implement an object.+data ServerOps = ServerOps+  { -- | Handle a method call; takes the interface and method id and returns+    -- a handler for the specific method.+    handleCall :: Word64 -> Word16 -> UntypedMethodHandler,+    -- | Handle shutting-down the receiver; this is called when the last+    -- reference to the capability is dropped.+    handleStop :: IO (),+    -- | used to unwrap the server when reflecting on a local client.+    handleCast :: forall a. Typeable a => Maybe a+  } -handleUntypedMethod :: UntypedMethodHandler -> Maybe (Ptr 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> IO ()-handleUntypedMethod = handleMethod+-- | A handler for arbitrary RPC calls. Maps (interfaceId, methodId) pairs to+-- 'UntypedMethodHandler's.+type CallHandler = M.Map Word64 (V.Vector UntypedMethodHandler) --- | Convert a 'MethodHandler' for any parameter and return types into--- one that deals with untyped pointers.-toUntypedHandler :: MethodHandler p r -> UntypedMethodHandler-toUntypedHandler MethodHandler {..} = MethodHandler {..}+-- | Type alias for a handler for a particular rpc method.+type MethodHandler p r =+  R.Raw p 'Const ->+  Fulfiller (R.Raw r 'Const) ->+  IO () --- | Inverse of 'toUntypedHandler'-fromUntypedHandler :: UntypedMethodHandler -> MethodHandler p r-fromUntypedHandler MethodHandler {..} = MethodHandler {..}+castHandler ::+  forall p q r s.+  (R.ReprFor p ~ R.ReprFor q, R.ReprFor r ~ R.ReprFor s) =>+  MethodHandler p r ->+  MethodHandler q s+castHandler = coerce --- | 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 'Const) -> Fulfiller (Maybe (Ptr 'Const)) -> IO ()) ->-  MethodHandler (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const))-untypedHandler = MethodHandler+-- | Type alias for a handler for an untyped RPC method.+type UntypedMethodHandler = MethodHandler (Maybe B.AnyPointer) (Maybe B.AnyPointer)  -- | Base class for things that can act as capnproto servers.-class Server a where+class SomeServer a where   -- | Called when the last live reference to a server is dropped.   shutdown :: a -> IO ()   shutdown _ = pure ()@@ -103,35 +128,126 @@   unwrap :: Typeable b => a -> Maybe b   unwrap _ = Nothing --- | 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 = ServerOps-  { -- | Handle a method call; takes the interface and method id and returns-    -- a handler for the specific method.-    handleCall ::-      Word64 ->-      Word16 ->-      MethodHandler (Maybe (Ptr 'Const)) (Maybe (Ptr 'Const)),-    -- | Handle shutting-down the receiver; this is called when the last-    -- reference to the capability is dropped.-    handleStop :: IO (),-    -- | used to unwrap the server when reflecting on a local client.-    handleCast :: forall a. Typeable a => Maybe a-  }+-- | Generated interface types have instances of 'Export', which allows a server+-- for that interface to be exported as a 'Client'.+class (R.IsCap i, C.HasTypeId i) => Export i where+  -- | The constraint needed for a server to implement an interface;+  -- if @'Server' i s@ is satisfied, @s@ is a server for interface @i@.+  -- The code generator generates a type class for each interface, and+  -- this will aways be an alias for that type class.+  type Server i :: Type -> Constraint --- | A 'CallInfo' contains information about a method call.-data CallInfo = CallInfo-  { -- | The id of the interface whose method is being called.-    interfaceId :: !Word64,-    -- | The method id of the method being called.-    methodId :: !Word16,-    -- | The arguments to the method call.-    arguments :: Maybe (Ptr 'Const),-    -- | A 'Fulfiller' which accepts the method's return value.-    response :: Fulfiller (Maybe (Ptr 'Const))+  -- | Convert the server to a 'MethodHandlerTree' populated with appropriate+  -- 'MethodHandler's for the interface. This is really only exported for use+  -- by generated code; users of the library will generally prefer to use+  -- 'export'.+  methodHandlerTree :: Server i s => Proxy i -> s -> MethodHandlerTree++-- NB: the proxy helps disambiguate types; for some reason TypeApplications+-- doesn't seem to be enough in the face of a type alias of kind 'Constraint'.+-- the inconsistency is a bit ugly, but this method isn't intended to called+-- by users directly, only by generated code and our helper in this module,+-- so it's less of a big deal.++-- | Lazily computed tree of the method handlers exposed by an interface. Only+-- of interest to generated code.+data MethodHandlerTree = MethodHandlerTree+  { -- | type id for the primary interface+    mhtId :: Word64,+    -- | method handlers for methods of the primary interface.+    mhtHandlers :: [UntypedMethodHandler],+    -- | Trees for parent interfaces. In the case of diamond dependencies,+    -- there may be duplicates, which are eliminated by 'mhtToCallHandler'.+    mhtParents :: [MethodHandlerTree]   } +mhtToCallHandler :: MethodHandlerTree -> CallHandler+mhtToCallHandler = go M.empty . pure+  where+    go accum [] = accum+    go accum (t : ts)+      | mhtId t `M.member` accum = go accum ts -- dedup diamond dependencies+      | otherwise =+          go (M.insert (mhtId t) (V.fromList (mhtHandlers t)) accum) (mhtParents t ++ ts)++-- | Look up a particlar 'MethodHandler' in the 'CallHandler'.+findMethod :: Word64 -> Word16 -> CallHandler -> Maybe UntypedMethodHandler+findMethod interfaceId methodId handler = do+  iface <- M.lookup interfaceId handler+  iface V.!? fromIntegral methodId++-- | Convert a typed method handler to an untyped one. Mostly intended for+-- use by generated code.+toUntypedMethodHandler ::+  forall p r.+  (R.IsStruct p, R.IsStruct r) =>+  MethodHandler p r ->+  UntypedMethodHandler+toUntypedMethodHandler h =+  \case+    R.Raw (Just (U.PtrStruct param)) -> \ret ->+      h+        (R.Raw param)+        ( contramap+            (\(R.Raw s) -> R.Raw $ Just $ U.PtrStruct s)+            ret+        )+    _ ->+      \ret -> breakPromise ret (eFailed "Parameter was not a struct")++someServerToServerOps :: SomeServer a => a -> CallHandler -> ServerOps+someServerToServerOps srv callHandler =+  ServerOps+    { handleStop = shutdown srv,+      handleCast = unwrap srv,+      handleCall = \interfaceId methodId ->+        findMethod interfaceId methodId callHandler+          & fromMaybe methodUnimplemented+    }++exportToServerOps :: forall i s. (Export i, Server i s, SomeServer s) => Proxy i -> s -> ServerOps+exportToServerOps proxy srv =+  mhtToCallHandler (methodHandlerTree proxy srv)+    & someServerToServerOps srv++-- Helpers for writing method handlers++-- | Handle a method, working with the parsed form of parameters and+-- results.+handleParsed ::+  ( C.Parse p pp,+    R.IsStruct p,+    C.Parse r pr,+    R.IsStruct r+  ) =>+  (pp -> IO pr) ->+  MethodHandler p r+handleParsed handler param = propagateExceptions $ \f -> do+  p <- evalLimitT defaultLimit $ C.parse param+  r <- handler p+  -- TODO: Figure out how to add an instance of Thaw for+  -- Raw so we can skip the (un)wrapping here.+  struct <- createPure maxBound $ R.fromRaw <$> parsedToRaw r+  fulfill f (R.Raw struct)++-- | Handle a method, working with the raw (unparsed) form of+-- parameters and results.+handleRaw ::+  (R.IsStruct p, R.IsStruct r) =>+  (R.Raw p 'Const -> IO (R.Raw r 'Const)) ->+  MethodHandler p r+handleRaw handler param = propagateExceptions $ \f ->+  handler param >>= fulfill f++-- Helper for handle*; breaks the promise if the handler throws.+propagateExceptions :: (Fulfiller a -> IO b) -> Fulfiller a -> IO b+propagateExceptions h f =+  h f `withException` (breakPromise f . wrapException False)++-- | 'MethodHandler' that always throws unimplemented.+methodUnimplemented :: MethodHandler p r+methodUnimplemented _ f = breakPromise f eMethodUnimplemented+ -- | Handle incoming messages for a given object. -- -- Accepts a queue of messages to handle, and 'ServerOps' used to handle them.@@ -143,9 +259,7 @@       atomically (TCloseQ.read q) >>= \case         Nothing ->           pure ()-        Just CallInfo {interfaceId, methodId, arguments, response} -> do-          handleMethod-            (handleCall ops interfaceId methodId)-            arguments-            response-          go+        Just CallInfo {interfaceId, methodId, arguments, response} ->+          do+            handleCall ops interfaceId methodId (R.Raw arguments) (coerce response)+            go

@@ -23,8 +23,12 @@ -- methods etc. as used here are untyped. module Capnp.Rpc.Untyped   ( -- * Connections to other vats+    Conn,     ConnConfig (..),     handleConn,+    withConn,+    acquireConn,+    requestBootstrap,      -- * Clients for capabilities     Client,@@ -66,7 +70,7 @@ import Capnp.Message (Message) import qualified Capnp.Message as Message import Capnp.Mutability (Mutability (..), thaw)-import Capnp.Repr (Raw (..))+import Capnp.Repr (Raw (..), ReprFor) import Capnp.Rpc.Errors   ( eDisconnected,     eFailed,@@ -89,7 +93,7 @@ import Capnp.TraversalLimit (LimitT, defaultLimit, evalLimitT) import qualified Capnp.Untyped as UntypedRaw import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (concurrently_, race_)+import Control.Concurrent.Async (Async, cancel, concurrently_, race, race_, wait, withAsync) import Control.Concurrent.MVar (MVar, newEmptyMVar) import Control.Concurrent.STM import Control.Exception.Safe@@ -108,6 +112,7 @@ import Control.Monad.Trans.Class import Data.Default (Default (def)) import Data.Dynamic (fromDynamic)+import Data.Either (fromLeft) import Data.Foldable (for_, toList, traverse_) import Data.Function ((&)) import Data.Hashable (Hashable, hash, hashWithSalt)@@ -119,6 +124,7 @@ import Data.Word import qualified Focus import GHC.Generics (Generic)+import GHC.Prim (coerce) import Internal.BuildPure (createPure) import Internal.Rc (Rc) import qualified Internal.Rc as Rc@@ -126,6 +132,8 @@ import Internal.SnocList (SnocList) import qualified Internal.SnocList as SnocList import qualified Internal.TCloseQ as TCloseQ+import Lifetimes (Acquire, mkAcquire, withAcquire)+import Lifetimes.Async (acquireAsync) import qualified Lifetimes.Gc as Fin import qualified ListT import qualified StmContainers.Map as M@@ -252,6 +260,9 @@     debugMode :: !Bool,     -- whether to include extra (possibly sensitive) info in error messages. +    done :: Async (),+    -- finished when the connection is shut down. Note: this should not be used+    -- by most of the code within this module; see the implementation of acquireConn.     liveState :: TVar LiveState   } @@ -297,7 +308,7 @@     pendingCallbacks :: TQueue (IO ()),     -- See Note [callbacks] -    bootstrap :: Maybe Client+    myBootstrap :: Maybe Client     -- The capability which should be served as this connection's bootstrap     -- interface (if any).   }@@ -335,22 +346,10 @@     --     -- Defaults to 'False'.     debugMode :: !Bool,-    -- | 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'.-    ---    -- 'getBootstrap' MUST NOT block; the connection will not be serviced-    -- and 'withBootstrap' will not be run until this returns. If you need-    -- to supply the bootstrap interface later, use 'newPromiseClient'.-    getBootstrap :: Supervisor -> STM (Maybe Client),-    -- | 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.-    withBootstrap :: Maybe (Supervisor -> Client -> IO ())+    -- | The bootstrap interface we should serve for this connection.+    -- If 'bootstrap' is 'Nothing' (the default), we will respond to+    -- bootstrap messages with an exception.+    bootstrap :: Maybe Client   }  instance Default ConnConfig where@@ -360,8 +359,7 @@         maxExports = 8192,         maxCallWords = bytesToWordsFloor $ 32 * 1024 * 1024,         debugMode = False,-        getBootstrap = \_ -> pure Nothing,-        withBootstrap = Nothing+        bootstrap = Nothing       }  -- | Queue an IO action to be run some time after this transaction commits.@@ -447,119 +445,131 @@ freeEmbargo :: Conn' -> EmbargoId -> STM () freeEmbargo conn = freeId (exportIdPool conn) . embargoWord +-- | Wait until a connection has shut down, then re-throw the+-- exception that killed it, if any.+waitConn :: Conn -> IO ()+waitConn Conn {done} = wait done+ -- | Handle a connection to another vat. Returns when the connection is closed.-handleConn :: Transport -> ConnConfig -> IO ()-handleConn-  transport+handleConn ::+  Transport ->+  ConnConfig ->+  IO ()+handleConn transport cfg =+  withAcquire (acquireConn transport cfg) waitConn++-- | Run the function with access to a connection. Shut down the connection+-- when it returns.+withConn :: Transport -> ConnConfig -> (Conn -> IO a) -> IO a+withConn transport cfg f =+  withAcquire (acquireConn transport cfg) $ \conn -> do+    result <- f conn `race` waitConn conn+    case result of+      Left v -> pure v+      Right () ->+        error "BUG: waitConn returned normally"++acquireConn :: Transport -> ConnConfig -> Acquire Conn+acquireConn transport cfg = do+  (conn, conn') <- mkAcquire (newConn cfg) stopConn+  done <- acquireAsync $ runConn cfg transport (conn, conn')+  pure conn {done = done}++newConn   cfg@ConnConfig     { maxQuestions,       maxExports,       maxCallWords,-      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+    } = do+    stableName <- makeStableName =<< newEmptyMVar+    atomically $ do+      questionIdPool <- newIdPool maxQuestions+      exportIdPool <- newIdPool maxExports -          sendQ <- newTChan+      sendQ <- newTChan -          availableCallWords <- newTVar maxCallWords+      availableCallWords <- newTVar maxCallWords -          questions <- M.new-          answers <- M.new-          exports <- M.new-          imports <- M.new+      questions <- M.new+      answers <- M.new+      exports <- M.new+      imports <- M.new -          embargos <- M.new-          pendingCallbacks <- newTQueue+      embargos <- M.new+      pendingCallbacks <- newTQueue -          let conn' =-                Conn'-                  { supervisor = sup,-                    questionIdPool,-                    exportIdPool,-                    sendQ,-                    availableCallWords,-                    questions,-                    answers,-                    exports,-                    imports,-                    embargos,-                    pendingCallbacks,-                    bootstrap-                  }-          liveState <- newTVar (Live conn')-          let conn =-                Conn-                  { stableName,-                    debugMode,-                    liveState+      let conn' =+            Conn'+              { questionIdPool,+                exportIdPool,+                sendQ,+                availableCallWords,+                questions,+                answers,+                exports,+                imports,+                embargos,+                pendingCallbacks,+                myBootstrap = bootstrap cfg+              }+      liveState <- newTVar (Live conn')+      let conn =+            Conn+              { stableName,+                debugMode,+                liveState+              }+      pure (conn, conn')++runConn cfg transport (conn, conn') = do+  result <-+    try $+      recvLoop transport conn+        `concurrently_` sendLoop transport conn'+        `concurrently_` callbacksLoop conn'+  case result of+    Left (SentAbort e) -> do+      -- We need to actually send it:+      rawMsg <- createPure maxBound $ parsedToMsg $ 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 myBootstrap conn' of+        Just (unwrapClient -> 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 $ \(qid, entry) ->+        let raiseDisconnected onReturn =+              mapQueueSTM conn' onReturn $+                Return+                  { answerId = qid,+                    releaseParamCaps = False,+                    union' = Return'exception eDisconnected                   }-          pure (conn, conn')-      runConn (conn, conn') = do-        result <--          try $-            ( recvLoop transport conn-                `concurrently_` sendLoop 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 $ parsedToMsg $ 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 (unwrapClient -> Just client') -> dropConnExport conn client'+         in case entry of+              NewQA {onReturn} -> raiseDisconnected onReturn+              HaveFinish {onReturn} -> raiseDisconnected onReturn               _ -> pure ()-            -- Remove everything from the exports table:-            walk exports $ \(_, EntryE {client}) ->-              dropConnExport conn client-            -- Outstanding questions should all throw disconnected:-            walk questions $ \(qid, entry) ->-              let raiseDisconnected onReturn =-                    mapQueueSTM conn' onReturn $-                      Return-                        { answerId = qid,-                          releaseParamCaps = False,-                          union' = Return'exception eDisconnected-                        }-               in case entry of-                    NewQA {onReturn} -> raiseDisconnected onReturn-                    HaveFinish {onReturn} -> raiseDisconnected onReturn-                    _ -> pure ()-            -- same thing with embargos:-            walk embargos $ \(_, fulfiller) ->-              breakPromise fulfiller eDisconnected-            -- mark the connection as dead, making the live state inaccessible:-            writeTVar liveState Dead-      useBootstrap conn conn' = case withBootstrap of-        Nothing ->-          forever $ threadDelay maxBound-        Just f ->-          atomically (requestBootstrap conn) >>= f (supervisor conn')+      -- same thing with embargos:+      walk embargos $ \(_, fulfiller) ->+        breakPromise fulfiller eDisconnected+      -- mark the connection as dead, making the live state inaccessible:+      writeTVar liveState Dead  -- | A pool of ids; used when choosing identifiers for questions and exports. newtype IdPool = IdPool (TVar [Word32])@@ -930,7 +940,7 @@  data Payload = Payload   { content :: RawMPtr,-    capTable :: V.Vector (R.Parsed R.CapDescriptor)+    capTable :: [R.Parsed R.CapDescriptor]   }  -- Note [proxies]@@ -1010,7 +1020,7 @@     payload@Payload {capTable} <- makeOutgoingPayload conn arguments     -- save these in case the callee sends back releaseParamCaps = True in the return     -- message:-    let paramCaps = catMaybes $ flip map (V.toList capTable) $ \R.CapDescriptor {union'} -> case union' of+    let paramCaps = catMaybes $ flip map capTable $ \R.CapDescriptor {union'} -> case union' of           R.CapDescriptor'senderHosted eid -> Just (IEId eid)           R.CapDescriptor'senderPromise eid -> Just (IEId eid)           _ -> Nothing@@ -1115,10 +1125,9 @@   R.PromisedAnswer     { R.questionId = qaWord answerId,       R.transform =-        V.fromList $-          map-            (R.PromisedAnswer'Op . R.PromisedAnswer'Op'getPointerField)-            (toList transform)+        map+          (R.PromisedAnswer'Op . R.PromisedAnswer'Op'getPointerField)+          (toList transform)     }  unmarshalPromisedAnswer :: MonadThrow m => R.Parsed R.PromisedAnswer -> m PromisedAnswer@@ -1223,11 +1232,19 @@     )   pure $ wrapClient (Just client') -clientMethodHandler :: Word64 -> Word16 -> Client -> Server.MethodHandler p r+clientMethodHandler ::+  forall p r.+  ( ReprFor p ~ ReprFor (Maybe B.AnyPointer),+    ReprFor r ~ ReprFor (Maybe B.AnyPointer)+  ) =>+  Word64 ->+  Word16 ->+  Client ->+  Server.MethodHandler p r clientMethodHandler interfaceId methodId client =-  Server.fromUntypedHandler $-    Server.untypedHandler $-      \arguments response -> atomically $ void $ call Server.CallInfo {..} client+  Server.castHandler @(Maybe B.AnyPointer) @p @(Maybe B.AnyPointer) @r $+    \(Raw arguments) response ->+      atomically $ void $ call Server.CallInfo {response = coerce response, ..} client  -- | See Note [callbacks] callbacksLoop :: Conn' -> IO ()@@ -1328,7 +1345,7 @@ handleBootstrapMsg :: Conn -> R.Parsed R.Bootstrap -> STM () handleBootstrapMsg conn R.Bootstrap {questionId} =   getLive conn >>= \conn' -> do-    ret <- case bootstrap conn' of+    ret <- case myBootstrap conn' of       Nothing ->         pure           Return@@ -1352,8 +1369,7 @@                   Payload                     { content,                       capTable =-                        V.singleton-                          (def {R.union' = capDesc} :: R.Parsed R.CapDescriptor)+                        [def {R.union' = capDesc} :: R.Parsed R.CapDescriptor]                     }             }     M.focus@@ -1375,7 +1391,7 @@                           { union' =                               Return'results                                 Payload-                                  { capTable = (V.toList -> [R.CapDescriptor {union' = R.CapDescriptor'receiverHosted (IEId -> eid)}])+                                  { capTable = [R.CapDescriptor {union' = R.CapDescriptor'receiverHosted (IEId -> eid)}]                                   }                           } ->                             when releaseResultCaps $@@ -1466,7 +1482,7 @@             { interfaceId,               methodId,               arguments = callParams,-              response = fulfiller+              response = coerce fulfiller             }     -- Finally, figure out where to send it:     case target of@@ -1505,9 +1521,9 @@ ptrPathClient is ptr =   evalLimitT defaultLimit $ followPtrs is ptr >>= ptrClient -transformClient :: V.Vector (R.Parsed R.PromisedAnswer'Op) -> RawMPtr -> Conn' -> STM Client+transformClient :: [R.Parsed R.PromisedAnswer'Op] -> RawMPtr -> Conn' -> STM Client transformClient transform ptr conn =-  (unmarshalOps (V.toList transform) >>= flip ptrPathClient ptr)+  (unmarshalOps transform >>= flip ptrPathClient ptr)     `catchSTM` abortConn conn  ptrClient :: UntypedRaw.ReadCtx m 'Const => RawMPtr -> m Client@@ -1896,15 +1912,15 @@ genSendableCapTableRaw ::   Conn ->   Maybe (UntypedRaw.Ptr 'Const) ->-  STM (V.Vector (R.Parsed R.CapDescriptor))-genSendableCapTableRaw _ Nothing = pure V.empty+  STM [R.Parsed R.CapDescriptor]+genSendableCapTableRaw _ Nothing = pure [] genSendableCapTableRaw conn (Just ptr) =   traverse     ( \c -> do         union' <- emitCap conn c         pure (def :: R.Parsed R.CapDescriptor) {R.union' = union'}     )-    (Message.getCapTable (UntypedRaw.message @UntypedRaw.Ptr ptr))+    (V.toList $ Message.getCapTable (UntypedRaw.message @UntypedRaw.Ptr ptr))  -- | Convert the pointer into a Payload, including a capability table for -- the clients in the pointer's cap table.@@ -2039,60 +2055,61 @@     Dead -> pure ()  -- | Request the remote vat's bootstrap interface.-requestBootstrap :: Conn -> STM Client+requestBootstrap :: MonadSTM m => Conn -> m 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}+  liftSTM $+    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} -      -- Arguably, we should wait for this promise, since it's analagous-      -- to a call in terms of operation, but we only send one of these-      -- per connection, so whatever.-      (_, onSent) <- newPromise-      sendPureMsg-        conn'-        (R.Message'bootstrap (def {R.questionId = qaWord qid} :: R.Parsed R.Bootstrap))-        onSent+        -- Arguably, we should wait for this promise, since it's analagous+        -- to a call in terms of operation, but we only send one of these+        -- per connection, so whatever.+        (_, onSent) <- newPromise+        sendPureMsg+          conn'+          (R.Message'bootstrap (def {R.questionId = qaWord qid} :: R.Parsed R.Bootstrap))+          onSent -      M.insert-        NewQA-          { onReturn =-              SnocList.fromList-                [ resolveClientReturn tmpDest (writeTVar pState) conn' [],-                  \_ ->-                    finishQuestion-                      conn'-                      R.Finish-                        { questionId = qaWord qid,-                          releaseResultCaps = False-                        }-                ],-            onFinish = SnocList.empty-          }-        qid-        questions-      exportMap <- ExportMap <$> M.new-      pure $-        wrapClient $-          Just-            PromiseClient-              { pState,-                exportMap,-                origTarget = tmpDest-              }+        M.insert+          NewQA+            { onReturn =+                SnocList.fromList+                  [ resolveClientReturn tmpDest (writeTVar pState) conn' [],+                    \_ ->+                      finishQuestion+                        conn'+                        R.Finish+                          { questionId = qaWord qid,+                            releaseResultCaps = False+                          }+                  ],+              onFinish = SnocList.empty+            }+          qid+          questions+        exportMap <- ExportMap <$> M.new+        pure $+          wrapClient $+            Just+              PromiseClient+                { pState,+                  exportMap,+                  origTarget = tmpDest+                }  -- Note [resolveClient] -- ====================@@ -2358,7 +2375,7 @@ acceptPayload :: Conn -> Raw R.Payload 'Const -> LimitT STM Payload acceptPayload conn payload = do   capTable <- parseField #capTable payload-  clients <- lift $ traverse (\R.CapDescriptor {union'} -> acceptCap conn union') capTable+  clients <- lift $ V.fromList <$> traverse (\R.CapDescriptor {union'} -> acceptCap conn union') capTable   Raw rawContent <- readField #content payload   content <- traverse (UntypedRaw.tMsg (pure . Message.withCapTable clients)) rawContent   pure Payload {content, capTable}

@@ -151,7 +151,7 @@ -- and abbreviated for readability): -- -- > import qualified Capnp.Repr as R--- > import qualified Capnp.New.Classes as C+-- > import qualified Capnp.Classes as C -- > import qualified Capnp.Repr.Parsed as RP -- > import GHC.Generics (Generic) -- >@@ -263,54 +263,57 @@ -- Some additional things are generated for interfaces, but we cover those -- in the RPC section below. ----- The module "Capnp.New" exposes the most frequently used+-- 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.New+-- > {-# LANGUAGE OverloadedStrings #-} -- >--- > -- Note that Capnp.New re-exports `def`, as a convienence--- > import Capnp.New (putParsed, def)+-- > module Examples.Serialization.HighLevel.Write (main) where -- >--- > import qualified Data.Vector as V+-- > -- Note that Capnp re-exports `def`, as a convienence+-- > import Capnp (def, putParsed)+-- > import Capnp.Gen.Addressbook -- >--- > main = putParsed 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 $ 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 $ Person'employment'selfEmployed--- >             }--- >         ]--- >     }+-- > main :: IO ()+-- > main =+-- >   putParsed+-- >     AddressBook+-- >       { people =+-- >           [ Person+-- >               { id = 123,+-- >                 name = "Alice",+-- >                 email = "alice@example.com",+-- >                 phones =+-- >                   [ def+-- >                       { number = "555-1212",+-- >                         type_ = Person'PhoneNumber'Type'mobile+-- >                       }+-- >                   ],+-- >                 employment = Person'employment' $ Person'employment'school "MIT"+-- >               },+-- >             Person+-- >               { id = 456,+-- >                 name = "Bob",+-- >                 email = "bob@example.com",+-- >                 phones =+-- >                   [ def+-- >                       { number = "555-4567",+-- >                         type_ = Person'PhoneNumber'Type'home+-- >                       },+-- >                     def+-- >                       { number = "555-7654",+-- >                         type_ = Person'PhoneNumber'Type'work+-- >                       }+-- >                   ],+-- >                 employment = Person'employment' Person'employment'selfEmployed+-- >               }+-- >           ]+-- >       } -- -- 'putValue' is equivalent to @'hPutValue' 'stdout'@; 'hPutValue' may be used -- to write to an arbitrary handle.@@ -320,7 +323,7 @@ -- > -- ... -- > -- > {-# LANGUAGE TypeApplications #-}--- > import Capnp.New (getParsed, defaultLimit)+-- > import Capnp (getParsed, defaultLimit) -- > -- > -- ... -- >@@ -361,8 +364,8 @@ -- which accepts as type parameters the mutability of the underlying message, -- and a phantom type indicating the capnproto type. This second type parameter -- will be instantiated with the (for structs, uninhabited) type generated by--- the schema compiler plugin. The accessors in "Capnp.New.Accessors"--- (re-exported by "Capnp.New") are used to read and write the fields.+-- the schema compiler plugin. The accessors in "Capnp.Accessors"+-- (re-exported by "Capnp") are used to read and write 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@@ -382,112 +385,113 @@ -- > {-# LANGUAGE OverloadedLabels #-} -- > {-# LANGUAGE TypeApplications #-} -- >--- > import           Capnp.Gen.Addressbook.New--- > import qualified Capnp.New                 as C--- > import           Control.Monad             (forM_)--- > import           Control.Monad.Trans       (lift)--- > import           Data.Function             ((&))--- > import qualified Data.Text                 as T+-- > module Examples.Serialization.LowLevel.Read (main) where -- >+-- > import Capnp.Gen.Addressbook+-- > import qualified Capnp as C+-- > import Control.Monad (forM_)+-- > import Control.Monad.Trans (lift)+-- > import Data.Function ((&))+-- > import qualified Data.Text as T+-- > -- > main :: IO () -- > main = do--- >     addressbook <- C.getRaw @AddressBook C.defaultLimit--- >     C.evalLimitT C.defaultLimit $ do--- >         people <- C.readField #people addressbook--- >         forM_ [0..C.length people - 1] $ \i -> do--- >             people--- >                 & C.index i--- >                 >>= C.parseField #name--- >                 >>= lift . putStrLn . T.unpack+-- >   addressbook <- C.getRaw @AddressBook C.defaultLimit+-- >   C.evalLimitT C.defaultLimit $ do+-- >     people <- C.readField #people addressbook+-- >     forM_ [0 .. C.length people - 1] $ \i -> do+-- >       people+-- >         & C.index i+-- >         >>= C.parseField #name+-- >         >>= lift . putStrLn . T.unpack  -- $lowlevel-write -- -- Writing messages using the low-level API has a similarly imperative feel. -- The below constructs the same message as in our high-level example above: ----- > {-# LANGUAGE DataKinds        #-}+-- > {-# LANGUAGE DataKinds #-} -- > {-# LANGUAGE OverloadedLabels #-} -- > {-# LANGUAGE TypeApplications #-} -- >--- > import Data.Function ((&))--- >--- > import Capnp.Gen.Addressbook.New+-- > module Examples.Serialization.LowLevel.Write (main) where -- >--- > import qualified Capnp.New as C+-- > import Capnp.Gen.Addressbook+-- > import qualified Capnp as C+-- > import Data.Function ((&)) -- > import qualified Data.Text as T -- > -- > main :: IO () -- > main =--- >     let Right msg = C.createPure C.defaultLimit buildMsg--- >     in C.putMsg msg+-- >   let Right msg = C.createPure C.defaultLimit buildMsg+-- >    in C.putMsg msg -- > -- > buildMsg :: C.PureBuilder s (C.Message ('C.Mut s)) -- > buildMsg = do--- >     -- newMessage allocates a new, initially empty, mutable message. It--- >     -- takes an optional size hint:--- >     msg <- C.newMessage Nothing--- >--- >     -- newRoot allocates a new struct as the root object of the message.--- >     -- The unit argument is a hint to the allocator to determine the size--- >     -- of the object; for types whose size is not fixed (e.g. untyped structs,--- >     -- lists), this may be something more meaningful.--- >     addressbook <- C.newRoot @AddressBook () msg+-- >   -- newMessage allocates a new, initially empty, mutable message. It+-- >   -- takes an optional size hint:+-- >   msg <- C.newMessage Nothing -- >--- >     -- newField can be used to allocate the value of a field, for pointer--- >     -- types like lists. The number is the allocation hint, as used by newRoot.--- >     -- We can use the OverloadedLabels extension to pass in fields by name.--- >     people <- C.newField #people 2 addressbook+-- >   -- newRoot allocates a new struct as the root object of the message.+-- >   -- The unit argument is a hint to the allocator to determine the size+-- >   -- of the object; for types whose size is not fixed (e.g. untyped structs,+-- >   -- lists), this may be something more meaningful.+-- >   addressbook <- C.newRoot @AddressBook () msg -- >--- >     -- 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 <- C.index 0 people+-- >   -- newField can be used to allocate the value of a field, for pointer+-- >   -- types like lists. The number is the allocation hint, as used by newRoot.+-- >   -- We can use the OverloadedLabels extension to pass in fields by name.+-- >   people <- C.newField #people 2 addressbook -- >--- >     -- encodeField takes the parsed form of a value and marshals it into--- >     -- the specified field. For basic types like integers & booleans, this--- >     -- is almost always what you want. For larger values, you may want to--- >     -- use newField as above, or separately create the value and use setField,--- >     -- as shown below.--- >     C.encodeField #id 123 alice--- >     C.encodeField #name (T.pack "Alice") alice--- >     C.encodeField #email (T.pack "alice@example.com") alice+-- >   -- 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 <- C.index 0 people -- >--- >     -- We would probably use newField here, but to demonstrate, we can allocate--- >     -- the value separately with new, and then set it with setField.--- >     phones <- C.new @(C.List Person'PhoneNumber) 1 msg--- >     C.setField #phones phones alice+-- >   -- encodeField takes the parsed form of a value and marshals it into+-- >   -- the specified field. For basic types like integers & booleans, this+-- >   -- is almost always what you want. For larger values, you may want to+-- >   -- use newField as above, or separately create the value and use setField,+-- >   -- as shown below.+-- >   C.encodeField #id 123 alice+-- >   C.encodeField #name (T.pack "Alice") alice+-- >   C.encodeField #email (T.pack "alice@example.com") alice -- >--- >     mobilePhone <- C.index 0 phones--- >     -- It is sometimes more ergonomic to use (&) from Data.Function. You might--- >     -- ask why not just make the container the first argument, but it works--- >     -- out better this way for the read examples.--- >     mobilePhone & C.encodeField #number (T.pack "555-1212")--- >     mobilePhone & C.encodeField #type_ Person'PhoneNumber'Type'mobile+-- >   -- We would probably use newField here, but to demonstrate, we can allocate+-- >   -- the value separately with new, and then set it with setField.+-- >   phones <- C.new @(C.List Person'PhoneNumber) 1 msg+-- >   C.setField #phones phones alice -- >--- >     -- Since named unions act like unnamed unions inside a group, we first have--- >     -- to get the group field:--- >     employment <- C.readField #employment alice+-- >   mobilePhone <- C.index 0 phones+-- >   -- It is sometimes more ergonomic to use (&) from Data.Function. You might+-- >   -- ask why not just make the container the first argument, but it works+-- >   -- out better this way for the read examples.+-- >   mobilePhone & C.encodeField #number (T.pack "555-1212")+-- >   mobilePhone & C.encodeField #type_ Person'PhoneNumber'Type'mobile -- >--- >     -- Then, we can use encodeVariant to set both the tag of the union and the--- >     -- value:--- >     employment & C.encodeVariant #school (T.pack "MIT")+-- >   -- Since named unions act like unnamed unions inside a group, we first have+-- >   -- to get the group field:+-- >   employment <- C.readField #employment alice -- >--- >     bob <- C.index 1 people--- >     bob & C.encodeField #id 456--- >     bob & C.encodeField #name (T.pack "Bob")--- >     bob & C.encodeField #email (T.pack "bob@example.com")+-- >   -- Then, we can use encodeVariant to set both the tag of the union and the+-- >   -- value:+-- >   employment & C.encodeVariant #school (T.pack "MIT") -- >--- >     phones <- bob & C.newField #phones 2--- >     homePhone <- phones & C.index 0--- >     homePhone & C.encodeField #number (T.pack "555-4567")--- >     homePhone & C.encodeField #type_ Person'PhoneNumber'Type'home--- >     workPhone <- phones & C.index 1--- >     workPhone & C.encodeField #number (T.pack "555-7654")--- >     workPhone & C.encodeField #type_ Person'PhoneNumber'Type'work--- >     employment <- bob & C.readField #employment--- >     employment & C.encodeVariant #selfEmployed () -- Note the (), since selfEmploy is Void.+-- >   bob <- C.index 1 people+-- >   bob & C.encodeField #id 456+-- >   bob & C.encodeField #name (T.pack "Bob")+-- >   bob & C.encodeField #email (T.pack "bob@example.com") -- >--- >     pure msg+-- >   phones <- bob & C.newField #phones 2+-- >   homePhone <- phones & C.index 0+-- >   homePhone & C.encodeField #number (T.pack "555-4567")+-- >   homePhone & C.encodeField #type_ Person'PhoneNumber'Type'home+-- >   workPhone <- phones & C.index 1+-- >   workPhone & C.encodeField #number (T.pack "555-7654")+-- >   workPhone & C.encodeField #type_ Person'PhoneNumber'Type'work+-- >   employment <- bob & C.readField #employment+-- >   employment & C.encodeVariant #selfEmployed () -- Note the (), since selfEmploy is Void.+-- >   pure msg  -- $rpc --@@ -534,44 +538,51 @@ -- 'handleRaw' to construct these, which can be more ergonomic and less error -- prone. In particular, they prevent you from forgetting to use the 'Fulfiller'. ----- Once you have an instance of the server class, the 'Capnp.New.export' function+-- Once you have an instance of the server class, the 'Capnp.export' function -- is used to convert such an instance into a handle to the object that can be -- passed around. -- -- Here is an an echo (networking) server using this interface: ----- > {-# LANGUAGE MultiParamTypeClasses #-}--- > {-# LANGUAGE OverloadedStrings     #-}--- > {-# LANGUAGE TypeApplications      #-} -- >--- > import Network.Simple.TCP (serve)+-- > {-# LANGUAGE MultiParamTypeClasses #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE TypeApplications #-} -- >--- > import Capnp.New (SomeServer, def, defaultLimit, export, handleParsed)--- > import Capnp.Rpc (ConnConfig(..), handleConn, socketTransport, toClient)+-- > module Examples.Rpc.EchoServer (main) where -- >--- > import Capnp.Gen.Echo.New+-- > import Capnp (SomeServer, def, defaultLimit, export, handleParsed)+-- > import Capnp.Gen.Echo+-- > import Capnp.Rpc (ConnConfig (..), handleConn, socketTransport, toClient)+-- > import Network.Simple.TCP (serve)+-- > import Supervisors (withSupervisor) -- > -- > data MyEchoServer = MyEchoServer -- > -- > instance SomeServer MyEchoServer -- > -- > instance Echo'server_ MyEchoServer where--- >     echo'echo MyEchoServer = handleParsed $ \params ->--- >         pure def { reply = query params }+-- >   echo'echo MyEchoServer = handleParsed $ \params ->+-- >     pure def {reply = query params} -- > -- > main :: IO ()--- > main = serve "localhost" "4000" $ \(sock, _addr) ->--- >     handleConn (socketTransport sock defaultLimit) def--- >         { debugMode = True--- >         , getBootstrap = \sup -> Just . toClient <$> export @Echo sup MyEchoServer--- >         }+-- > main =+-- >   withSupervisor $ \sup -> do+-- >     boot <- export @Echo sup MyEchoServer+-- >     serve "localhost" "4000" $ \(sock, _addr) ->+-- >       handleConn+-- >         (socketTransport sock defaultLimit)+-- >         def+-- >           { debugMode = True,+-- >             bootstrap = Just (toClient boot)+-- >           } ----- For RPC clients, there is a 'Client' type exported by "Capnp.New", which is+-- For RPC clients, there is a 'Client' type exported by "Capnp", which is -- parametrized over a phantom type indicating the type of the remote capability. -- So a @'Client' Echo@ allows you to call methods on an @Echo@ interface. -- -- Actually invoking methods uses the functions in "Capnp.Repr.Methods",--- re-exported by "Capnp.New". 'callP', 'callB', and 'callR' provide different+-- re-exported by "Capnp". 'callP', 'callB', and 'callR' provide different -- ways of supplying arguments to a call, but all are intended to be used with -- the OverloadedLabels extension for specifying the method name. --@@ -579,32 +590,37 @@ -- 'waitPipeline' blocks until the result is available. -- -- Here is an an echo client using this interface:------ > {-# LANGUAGE OverloadedLabels  #-}++-- > {-# LANGUAGE OverloadedLabels #-} -- > {-# LANGUAGE OverloadedStrings #-} -- >--- > import Data.Function      ((&))--- > import Data.Functor       ((<&>))--- > import Network.Simple.TCP (connect)--- >--- > import qualified Capnp.New as C--- > import           Capnp.Rpc--- >     (ConnConfig(..), fromClient, handleConn, socketTransport)+-- > module Examples.Rpc.EchoClient (main) where -- >--- > import Capnp.Gen.Echo.New+-- > import qualified Capnp as C+-- > import Capnp.Gen.Echo+-- > import Capnp.Rpc+-- >   ( ConnConfig (..),+-- >     fromClient,+-- >     requestBootstrap,+-- >     socketTransport,+-- >     withConn,+-- >   )+-- > import Data.Function ((&))+-- > import Data.Functor ((<&>))+-- > import Network.Simple.TCP (connect) -- > -- > main :: IO () -- > main = connect "localhost" "4000" $ \(sock, _addr) ->--- >     handleConn (socketTransport sock C.defaultLimit) C.def--- >         { debugMode = True--- >         , withBootstrap = Just $ \_sup client ->--- >             let echoClient :: C.Client Echo--- >                 echoClient = fromClient client--- >             in--- >             echoClient--- >                 & C.callP #echo C.def { query = "Hello, World!" }--- >                 <&> C.pipe #reply--- >                 >>= C.waitPipeline--- >                 >>= C.evalLimitT C.defaultLimit . C.parse--- >                 >>= print--- >         }+-- >   withConn+-- >     (socketTransport sock C.defaultLimit)+-- >     (C.def {debugMode = True})+-- >     $ \conn -> do+-- >       client <- requestBootstrap conn+-- >       let echoClient :: C.Client Echo+-- >           echoClient = fromClient client+-- >       echoClient+-- >         & C.callP #echo C.def {query = "Hello, World!"}+-- >         <&> C.pipe #reply+-- >         >>= C.waitPipeline+-- >         >>= C.evalLimitT C.defaultLimit . C.parse+-- >         >>= print

@@ -7,6 +7,7 @@   ( Client (..),     Pipeline (..),     nullClient,+    invalidClient,     -- | ** Internals     Opaque,     makeOpaque,@@ -23,10 +24,12 @@   deriving (Eq)  instance Show Client where-  show client =+  show client@(Client opaque) =     if client == nullClient       then "nullClient"-      else "({- capability; not statically representable -})"+      else case fromDynamic (reflectOpaque opaque) of+        Just (InvalidClient errMsg) -> "(invalidClient" ++ show errMsg ++ ")"+        Nothing -> "({- capability; not statically representable -})"  -- | A 'Pipeline' is a reference to a value within a message that has not yet arrived. newtype Pipeline = Pipeline Opaque@@ -35,6 +38,14 @@ -- statically. Throws exceptions in response to all method calls. nullClient :: Client nullClient = Client $ makeOpaque ()++newtype InvalidClient = InvalidClient String+  deriving (Show, Read, Eq, Typeable)++-- | Returns a client which is "invalid;" it behaves like 'nullClient',+-- but can be given a custom error message that is displayed by 'show'.+invalidClient :: String -> Client+invalidClient = Client . makeOpaque . InvalidClient  data Opaque = Opaque   { opDyn :: Dynamic,

@@ -0,0 +1,17 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Internal.Rpc.Export (export) where++import Capnp.Rpc.Common (Client (..))+import Capnp.Rpc.Server+import qualified Capnp.Rpc.Untyped as URpc+import Control.Monad.STM.Class (MonadSTM (liftSTM))+import Data.Proxy (Proxy (..))+import Supervisors (Supervisor)++-- | Export the server as a client for interface @i@. Spawns a server thread+-- with its lifetime bound to the supervisor.+export :: forall i s m. (MonadSTM m, Export i, Server i s, SomeServer s) => Supervisor -> s -> m (Client i)+export sup srv = liftSTM $ Client <$> URpc.export sup (exportToServerOps (Proxy @i) srv)

@@ -4,8 +4,8 @@  module CalculatorExample (tests) where +import Capnp.Rpc (ConnConfig (..), handleConn, requestBootstrap, withConn) import Capnp.Rpc.Transport (socketTransport)-import Capnp.Rpc.Untyped (ConnConfig (..), handleConn) import Capnp.TraversalLimit (defaultLimit) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (race_)@@ -83,16 +83,12 @@ 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-                  }-        }+    withConn (socketTransport serverSock defaultLimit) def {debugMode = True} $ \conn -> do+      client <- requestBootstrap conn+      serve "localhost" (fromString $ show clientPort) $ \(clientSock, _addr) ->+        handleConn+          (socketTransport clientSock defaultLimit)+          def+            { bootstrap = Just client,+              debugMode = True+            }

@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}++module Constants (tests) where++import Capnp+import Capnp.Gen.Aircraft hiding (Parsed)+import Data.Default+import Test.Hspec++tests :: Spec+tests = do+  describe "parsing defaults" $ do+    defTest "structs" Zdate {year = 0, month = 0, day = 0}+    defTest "struct lists" ([] :: [Parsed Zdate])+    -- defTest "enums" Airport'none+    defTest "enum lists" ([] :: [Airport])+  describe "parsing constants" $ do+    it "should parse enums correctly" $+      constEnum `shouldBe` Airport'jfk+    constTest "structs" constDate Zdate {year = 2015, month = 8, day = 27}+    constTest+      "lists"+      constList+      [ Zdate {year = 2015, month = 8, day = 27},+        Zdate {year = 2015, month = 8, day = 28}+      ]++defTest :: (Default a, Eq a, Show a) => String -> a -> Spec+defTest name expected =+  it ("should parse the default for " ++ name ++ " correctly") $ do+    def `shouldBe` expected++constTest :: (Parse a (Parsed a), Show (Parsed a), Eq (Parsed a)) => String -> Raw a 'Const -> Parsed a -> Spec+constTest name input expected =+  it ("should parse " ++ name ++ " correctly") $ do+    actual <- evalLimitT maxBound $ parse input+    actual `shouldBe` expected

@@ -32,10 +32,10 @@     displayName <- arbitrary     displayNamePrefixLength <- arbitrary     scopeId <- arbitrary-    parameters <- arbitrarySmallerVec+    parameters <- arbitrarySmallerList     isGeneric <- arbitrary-    nestedNodes <- arbitrarySmallerVec-    annotations <- arbitrarySmallerVec+    nestedNodes <- arbitrarySmallerList+    annotations <- arbitrarySmallerList     union' <- arbitrary     pure Node {..} @@ -44,7 +44,7 @@   arbitrary = do     id <- arbitrary     docComment <- arbitrary-    members <- arbitrarySmallerVec+    members <- arbitrarySmallerList     pure Node'SourceInfo {..}  instance Arbitrary (Parsed Node'SourceInfo'Member) where@@ -66,7 +66,7 @@  instance Arbitrary (Parsed Node'enum) where   shrink = genericShrink-  arbitrary = Node'enum' <$> arbitrarySmallerVec+  arbitrary = Node'enum' <$> arbitrarySmallerList  instance Arbitrary (Parsed Node'struct) where   shrink = genericShrink@@ -77,12 +77,12 @@     isGroup <- arbitrary     discriminantCount <- arbitrary     discriminantOffset <- arbitrary-    fields <- arbitrarySmallerVec+    fields <- arbitrarySmallerList     pure Node'struct' {..}  instance Arbitrary (Parsed Node'interface) where   shrink = genericShrink-  arbitrary = Node'interface' <$> arbitrarySmallerVec <*> arbitrarySmallerVec+  arbitrary = Node'interface' <$> arbitrarySmallerList <*> arbitrarySmallerList  instance Arbitrary (Parsed Node'const) where   shrink = genericShrink@@ -163,7 +163,7 @@     Enumerant       <$> arbitrary       <*> arbitrary-      <*> arbitrarySmallerVec+      <*> arbitrarySmallerList  instance Arbitrary (Parsed Superclass) where   shrink = genericShrink@@ -199,7 +199,7 @@  instance Arbitrary (Parsed Brand) where   shrink = genericShrink-  arbitrary = Brand <$> arbitrarySmallerVec+  arbitrary = Brand <$> arbitrarySmallerList  instance Arbitrary (Parsed Brand'Scope) where   shrink = genericShrink@@ -212,7 +212,7 @@   shrink = genericShrink   arbitrary =     oneof-      [ Brand'Scope'bind <$> arbitrarySmallerVec,+      [ Brand'Scope'bind <$> arbitrarySmallerList,         pure Brand'Scope'inherit,         Brand'Scope'unknown' <$> arbitraryTag 2       ]@@ -370,9 +370,9 @@   shrink = genericShrink   arbitrary = do     capnpVersion <- arbitrary-    nodes <- arbitrarySmallerVec-    requestedFiles <- arbitrarySmallerVec-    sourceInfo <- arbitrarySmallerVec+    nodes <- arbitrarySmallerList+    requestedFiles <- arbitrarySmallerList+    sourceInfo <- arbitrarySmallerList     pure CodeGeneratorRequest {..}  instance Arbitrary (Parsed CodeGeneratorRequest'RequestedFile) where@@ -390,33 +390,33 @@       <$> arbitrary       <*> arbitrary -arbitrarySmallerVec :: Arbitrary a => Gen (V.Vector a)-arbitrarySmallerVec = sized $ \size -> do+arbitrarySmallerList :: Arbitrary a => Gen [a]+arbitrarySmallerList = sized $ \size -> do   -- Make sure the elements are scaled down relative to-  -- the size of the vector:-  vec <- arbitrary :: Gen (V.Vector ())-  let gen = resize (size `div` V.length vec) arbitrary+  -- the size of the list:+  vec <- arbitrary :: Gen [()]+  let gen = resize (size `div` length vec) arbitrary   traverse (const gen) vec  instance Arbitrary (Parsed B.AnyStruct) where   shrink = genericShrink   arbitrary = sized $ \_ ->     B.Struct-      <$> arbitrarySmallerVec-      <*> arbitrarySmallerVec+      <$> (V.fromList <$> arbitrarySmallerList)+      <*> (V.fromList <$> arbitrarySmallerList)  instance Arbitrary (Parsed B.AnyList) where   shrink = genericShrink   arbitrary =     oneof-      [ B.List0 <$> arbitrarySmallerVec,-        B.List1 <$> arbitrarySmallerVec,-        B.List8 <$> arbitrarySmallerVec,-        B.List16 <$> arbitrarySmallerVec,-        B.List32 <$> arbitrarySmallerVec,-        B.List64 <$> arbitrarySmallerVec,-        B.ListPtr <$> arbitrarySmallerVec,-        B.ListStruct <$> arbitrarySmallerVec+      [ B.List0 <$> arbitrarySmallerList,+        B.List1 <$> arbitrarySmallerList,+        B.List8 <$> arbitrarySmallerList,+        B.List16 <$> arbitrarySmallerList,+        B.List32 <$> arbitrarySmallerList,+        B.List64 <$> arbitrarySmallerList,+        B.ListPtr <$> arbitrarySmallerList,+        B.ListStruct <$> arbitrarySmallerList       ]  instance Arbitrary (Parsed B.AnyPointer) where

@@ -1,6 +1,7 @@ module Main (main) where  import qualified CalculatorExample+import qualified Constants import Module.Capnp.Basics (basicsTests) import Module.Capnp.Bits (bitsTests) import Module.Capnp.Canonicalize (canonicalizeTests)@@ -18,7 +19,7 @@ import WalkSchemaCodeGenRequest (walkSchemaCodeGenRequestTest)  main :: IO ()-main = hspec $ parallel $ do+main = hspec $ do   describe "Tests for specific modules" $ do     describe "Capnp.Basics" basicsTests     describe "Capnp.Bits" bitsTests@@ -36,4 +37,5 @@   describe "Regression tests" regressionTests   CalculatorExample.tests   PointerOOB.tests+  Constants.tests   describe "Tests for client unwrapping" unwrapTests

@@ -478,15 +478,10 @@        in concurrently_             ( do                 Left (e :: RpcError) <--                  try $-                    handleConn-                      (vatTrans defaultLimit)-                      def-                        { debugMode = True,-                          withBootstrap = Just $ \_sup client ->-                            let ctr :: Client CallSequence = fromClient client-                             in void $ (ctr & callR #getNumber def) >>= waitPipeline-                        }+                  try $ withConn (vatTrans defaultLimit) def {debugMode = True} $ \conn -> do+                    client <- requestBootstrap conn+                    let ctr :: Client CallSequence = fromClient client+                    void $ (ctr & callR #getNumber def) >>= waitPipeline                 e `shouldBe` SentAbort wantExn             )             ( do@@ -577,19 +572,18 @@ 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-            }+        withConn (clientTrans defaultLimit) def {debugMode = True} $ \conn -> do+          boot <- requestBootstrap conn+          withSupervisor $ \sup -> withBootstrap sup (fromClient boot)       runServer =-        handleConn-          (serverTrans defaultLimit)-          def-            { debugMode = True,-              getBootstrap = fmap (Just . toClient) . getBootstrap-            }+        withSupervisor $ \sup -> do+          boot <- atomically (getBootstrap sup)+          handleConn+            (serverTrans defaultLimit)+            def+              { debugMode = True,+                bootstrap = Just (toClient boot)+              }   race_ runServer runClient  expectException ::

@@ -334,7 +334,7 @@ otherMessageTest :: Spec otherMessageTest = describe "Setting pointers in other messages" $   it "Should copy them if needed." $-    property $ \(name :: Text) (params :: V.Vector (Parsed Node'Parameter)) (brand :: Parsed Brand) ->+    property $ \(name :: Text) (params :: [Parsed Node'Parameter]) (brand :: Parsed Brand) ->       propertyIO $ do         let expected =               def

@@ -10,7 +10,6 @@ import Capnp (msgToRaw, parse) import Capnp.Basics import Capnp.TraversalLimit (runLimitT)-import qualified Data.Vector as V import GHC.Float (castDoubleToWord64) import Test.Hspec import Text.Heredoc (here)@@ -50,7 +49,7 @@                             5173,                             castDoubleToWord64 12.0                           ]-                          [ Just $ PtrList $ List8 $ V.fromList $ map (fromIntegral . fromEnum) "bob\0",+                          [ Just $ PtrList $ List8 $ map (fromIntegral . fromEnum) "bob\0",                             Just $ PtrList $ List16 []                           ]                   ]