capnp 0.12.0.0 → 0.12.1.0

raw patch · 13 files changed

+127/−30 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• capnp.cabal +1/−1
• cmd/capnpc-haskell/Trans/NewToHaskell.hs +20/−5
• examples/gen/lib/Capnp/Gen/Calculator/New.hs +11/−1
• examples/gen/lib/Capnp/Gen/Echo/New.hs +2/−0
• gen/lib/Capnp/Gen/Capnp/Persistent/New.hs +5/−0
• gen/lib/Capnp/Gen/Capnp/Rpc/New.hs +3/−1
• gen/lib/Capnp/Gen/Capnp/RpcTwoparty/New.hs +3/−1
• gen/lib/Capnp/Gen/Capnp/Schema/New.hs +3/−1
• gen/tests/Capnp/Gen/Aircraft/New.hs +19/−1
• gen/tests/Capnp/Gen/Generics/New.hs +2/−0
• lib/Capnp/New/Basics.hs +39/−7
• lib/Capnp/New/Rpc/Server.hs +15/−12

@@ -1,3 +1,7 @@+# 0.12.1.0++This release backports some fixes and minor features in the new API.+ # 0.12.0.0  * The 0.12.x series is the last major version that will support the old

@@ -1,6 +1,6 @@ cabal-version:            2.2 name:                     capnp-version:                  0.12.0.0+version:                  0.12.1.0 category:                 Data, Serialization, Network, Rpc copyright:                2016-2021 haskell-capnp contributors (see CONTRIBUTORS file). author:                   Ian Denhardt

@@ -102,7 +102,7 @@                         _ -> []                 , derives =                     case extraTypeInfo of-                        Just New.EnumTypeInfo {} -> [ "Std_.Eq", "Std_.Show" ]+                        Just New.EnumTypeInfo {} -> [ "Std_.Eq", "Std_.Show", "Generics.Generic" ]                         _                        -> []                 , dataNewtype = False                 , dataInstance = False@@ -948,13 +948,19 @@         , params = map (Name.UnQ . Name.typeVarName) typeParams ++ ["s_"]         , funDeps = []         , decls =-            map (defineIfaceClassMethod thisMod typeName) methods+            Hs.CdMinimal+                [ mkMethodName typeName methodName+                | New.MethodInfo{methodName} <- methods+                ]+            : concatMap (defineIfaceClassMethod thisMod typeName) methods         }     ] defineIfaceClassMethod thisMod typeName New.MethodInfo{methodName, paramType, resultType} =-    let mkType t = typeToType thisMod (C.CompositeType t) in-    Hs.CdValueDecl-        (Name.valueName (Name.mkSub typeName methodName))+    let mkType t = typeToType thisMod (C.CompositeType t)+        name = mkMethodName typeName methodName+    in+    [ Hs.CdValueDecl+        name         (Hs.TFn             [ Hs.TVar "s_"             , Hs.TApp@@ -964,6 +970,15 @@                 ]             ]         )+    , Hs.CdValueDef Hs.DfValue+        { name+        , params = [Hs.PVar "_"]+        , value = egName ["GH"] "methodUnimplemented"+        }+    ]++mkMethodName typeName methodName =+    Name.valueName (Name.mkSub typeName methodName)  emitMarshalField :: Name.UnQ -> C.FieldLocType New.Brand Name.CapnpQ -> Hs.Exp emitMarshalField name (C.HereField _) =

@@ -45,9 +45,13 @@                                                                             ,(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) instance (GH.HasMethod "defFunction" Calculator Calculator'defFunction'params Calculator'defFunction'results) where@@ -379,7 +383,9 @@     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 @@ -448,7 +454,9 @@     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 @@ -517,7 +525,9 @@     | Operator'multiply      | Operator'divide      | Operator'unknown' Std_.Word16-    deriving(Std_.Eq,Std_.Show)+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic) type instance (R.ReprFor Operator) = (R.Data R.Sz16) instance (C.HasTypeId Operator) where     typeId  = 9769222902479511526

@@ -43,7 +43,9 @@     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 

@@ -45,7 +45,9 @@     type Server (Persistent sturdyRef owner) = (Persistent'server_ sturdyRef owner)     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @((Persistent sturdyRef owner))) [(GH.toUntypedMethodHandler ((persistent'save @(sturdyRef) @(owner)) s_))] []) class (Persistent'server_ sturdyRef owner s_) where+    {-# MINIMAL persistent'save #-}     persistent'save :: s_ -> (GH.MethodHandler (Persistent'SaveParams sturdyRef owner) (Persistent'SaveResults sturdyRef owner))+    persistent'save _ = GH.methodUnimplemented instance ((GH.TypeParam sturdyRef)          ,(GH.TypeParam owner)) => (GH.HasMethod "save" (Persistent sturdyRef owner) (Persistent'SaveParams sturdyRef owner) (Persistent'SaveResults sturdyRef owner)) where     methodByLabel  = (GH.Method 14468694717054801553 0)@@ -147,8 +149,11 @@     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @((RealmGateway internalRef externalRef internalOwner externalOwner))) [(GH.toUntypedMethodHandler ((realmGateway'import_ @(internalRef) @(externalRef) @(internalOwner) @(externalOwner)) s_))                                                                                                                                     ,(GH.toUntypedMethodHandler ((realmGateway'export @(internalRef) @(externalRef) @(internalOwner) @(externalOwner)) s_))] []) class (RealmGateway'server_ internalRef externalRef internalOwner externalOwner s_) where+    {-# MINIMAL realmGateway'import_,realmGateway'export #-}     realmGateway'import_ :: s_ -> (GH.MethodHandler (RealmGateway'import'params internalRef externalRef internalOwner externalOwner) (Persistent'SaveResults internalRef internalOwner))+    realmGateway'import_ _ = GH.methodUnimplemented     realmGateway'export :: s_ -> (GH.MethodHandler (RealmGateway'export'params internalRef externalRef internalOwner externalOwner) (Persistent'SaveResults externalRef externalOwner))+    realmGateway'export _ = GH.methodUnimplemented instance ((GH.TypeParam internalRef)          ,(GH.TypeParam externalRef)          ,(GH.TypeParam internalOwner)

@@ -1332,7 +1332,9 @@     | Exception'Type'disconnected      | Exception'Type'unimplemented      | Exception'Type'unknown' Std_.Word16-    deriving(Std_.Eq,Std_.Show)+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic) type instance (R.ReprFor Exception'Type) = (R.Data R.Sz16) instance (C.HasTypeId Exception'Type) where     typeId  = 12865824133959433560

@@ -36,7 +36,9 @@     = Side'server      | Side'client      | Side'unknown' Std_.Word16-    deriving(Std_.Eq,Std_.Show)+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic) type instance (R.ReprFor Side) = (R.Data R.Sz16) instance (C.HasTypeId Side) where     typeId  = 11517567629614739868

@@ -2081,7 +2081,9 @@     | ElementSize'pointer      | ElementSize'inlineComposite      | ElementSize'unknown' Std_.Word16-    deriving(Std_.Eq,Std_.Show)+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic) type instance (R.ReprFor ElementSize) = (R.Data R.Sz16) instance (C.HasTypeId ElementSize) where     typeId  = 15102134695616452902

@@ -117,7 +117,9 @@     | Airport'dfw      | Airport'test      | Airport'unknown' Std_.Word16-    deriving(Std_.Eq,Std_.Show)+    deriving(Std_.Eq+            ,Std_.Show+            ,Generics.Generic) type instance (R.ReprFor Airport) = (R.Data R.Sz16) instance (C.HasTypeId Airport) where     typeId  = 16527513525367090977@@ -1897,7 +1899,9 @@     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 10255578992688506164 0) data Echo'echo'params @@ -2161,7 +2165,9 @@     type Server CallSequence = CallSequence'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(CallSequence)) [(GH.toUntypedMethodHandler ((callSequence'getNumber) s_))] []) class (CallSequence'server_ s_) where+    {-# MINIMAL callSequence'getNumber #-}     callSequence'getNumber :: s_ -> (GH.MethodHandler CallSequence'getNumber'params CallSequence'getNumber'results)+    callSequence'getNumber _ = GH.methodUnimplemented instance (GH.HasMethod "getNumber" CallSequence CallSequence'getNumber'params CallSequence'getNumber'results) where     methodByLabel  = (GH.Method 12371070827563042848 0) data CallSequence'getNumber'params @@ -2230,7 +2236,9 @@     type Server CounterFactory = CounterFactory'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(CounterFactory)) [(GH.toUntypedMethodHandler ((counterFactory'newCounter) s_))] []) class (CounterFactory'server_ s_) where+    {-# MINIMAL counterFactory'newCounter #-}     counterFactory'newCounter :: s_ -> (GH.MethodHandler CounterFactory'newCounter'params CounterFactory'newCounter'results)+    counterFactory'newCounter _ = GH.methodUnimplemented instance (GH.HasMethod "newCounter" CounterFactory CounterFactory'newCounter'params CounterFactory'newCounter'results) where     methodByLabel  = (GH.Method 15610220054254702620 0) data CounterFactory'newCounter'params @@ -2304,7 +2312,9 @@     type Server CounterAcceptor = CounterAcceptor'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(CounterAcceptor)) [(GH.toUntypedMethodHandler ((counterAcceptor'accept) s_))] []) class (CounterAcceptor'server_ s_) where+    {-# MINIMAL counterAcceptor'accept #-}     counterAcceptor'accept :: s_ -> (GH.MethodHandler CounterAcceptor'accept'params CounterAcceptor'accept'results)+    counterAcceptor'accept _ = GH.methodUnimplemented instance (GH.HasMethod "accept" CounterAcceptor CounterAcceptor'accept'params CounterAcceptor'accept'results) where     methodByLabel  = (GH.Method 14317498215560924065 0) data CounterAcceptor'accept'params @@ -2373,7 +2383,9 @@     type Server Top = Top'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Top)) [(GH.toUntypedMethodHandler ((top'top) s_))] []) class (Top'server_ s_) where+    {-# MINIMAL top'top #-}     top'top :: s_ -> (GH.MethodHandler Top'top'params Top'top'results)+    top'top _ = GH.methodUnimplemented instance (GH.HasMethod "top" Top Top'top'params Top'top'results) where     methodByLabel  = (GH.Method 17861645508359101525 0) data Top'top'params @@ -2437,7 +2449,9 @@     type Server Left = Left'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Left)) [(GH.toUntypedMethodHandler ((left'left) s_))] [(GH.methodHandlerTree (GH.Proxy @(Top)) s_)]) class ((GH.Server Top s_)) => (Left'server_ s_) where+    {-# MINIMAL left'left #-}     left'left :: s_ -> (GH.MethodHandler Left'left'params Left'left'results)+    left'left _ = GH.methodUnimplemented instance (C.Super Top Left) instance (GH.HasMethod "left" Left Left'left'params Left'left'results) where     methodByLabel  = (GH.Method 17679152961798450446 0)@@ -2502,7 +2516,9 @@     type Server Right = Right'server_     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @(Right)) [(GH.toUntypedMethodHandler ((right'right) s_))] [(GH.methodHandlerTree (GH.Proxy @(Top)) s_)]) class ((GH.Server Top s_)) => (Right'server_ s_) where+    {-# MINIMAL right'right #-}     right'right :: s_ -> (GH.MethodHandler Right'right'params Right'right'results)+    right'right _ = GH.methodUnimplemented instance (C.Super Top Right) instance (GH.HasMethod "right" Right Right'right'params Right'right'results) where     methodByLabel  = (GH.Method 14712639595305348988 0)@@ -2569,7 +2585,9 @@                                                                                                                            ,(GH.methodHandlerTree (GH.Proxy @(Right)) s_)]) class ((GH.Server Left s_)       ,(GH.Server Right s_)) => (Bottom'server_ s_) where+    {-# MINIMAL bottom'bottom #-}     bottom'bottom :: s_ -> (GH.MethodHandler Bottom'bottom'params Bottom'bottom'results)+    bottom'bottom _ = GH.methodUnimplemented instance (C.Super Left Bottom) instance (C.Super Right Bottom) instance (GH.HasMethod "bottom" Bottom Bottom'bottom'params Bottom'bottom'results) where

@@ -302,7 +302,9 @@     type Server (Nested'SomeInterface t) = (Nested'SomeInterface'server_ t)     methodHandlerTree _ s_ = (GH.MethodHandlerTree (C.typeId @((Nested'SomeInterface t))) [(GH.toUntypedMethodHandler ((nested'SomeInterface'method @(t)) s_))] []) class (Nested'SomeInterface'server_ t s_) where+    {-# MINIMAL nested'SomeInterface'method #-}     nested'SomeInterface'method :: s_ -> (GH.MethodHandler (Nested'SomeInterface'method'params t) (Nested'SomeInterface'method'results t))+    nested'SomeInterface'method _ = GH.methodUnimplemented instance ((GH.TypeParam t)) => (GH.HasMethod "method" (Nested'SomeInterface t) (Nested'SomeInterface'method'params t) (Nested'SomeInterface'method'results t)) where     methodByLabel  = (GH.Method 17400383877992806407 0) data Nested'SomeInterface'method'params t

@@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE EmptyDataDeriving     #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}@@ -27,13 +29,15 @@ import qualified Capnp.Repr          as R import qualified Capnp.Untyped       as U import           Control.Monad       (when)-import           Control.Monad.Catch (throwM)+import           Control.Monad.Catch (MonadThrow, throwM) import qualified Data.ByteString     as BS-import           Data.Foldable       (for_)+import           Data.Default        (Default(..))+import           Data.Foldable       (foldl', for_) import qualified Data.Text           as T import qualified Data.Text.Encoding  as TE import qualified Data.Vector         as V import           Data.Word+import           GHC.Generics        (Generic) import           GHC.Prim            (coerce)  -- | The Cap'n Proto @Text@ type.@@ -66,7 +70,7 @@     = PtrStruct (C.Parsed AnyStruct)     | PtrList (C.Parsed AnyList)     | PtrCap M.Client-    deriving(Show, Eq)+    deriving(Show, Eq, Generic)  instance C.Parse (Maybe AnyPointer) (Maybe (C.Parsed AnyPointer)) where     parse (R.Raw ptr) = case ptr of@@ -104,8 +108,24 @@     { structData :: V.Vector Word64     , structPtrs :: V.Vector (Maybe (C.Parsed AnyPointer))     }-    deriving(Show, Eq)+    deriving(Show, Generic) +instance Eq (C.Parsed AnyStruct) where+    -- We define equality specially (rather than just deriving), such that+    -- slices are padded out with the default values of their elements.+    (Struct dl pl) == (Struct dr pr) = sectionEq dl dr && sectionEq pl pr+      where+        sectionEq :: (Eq a, Default a) => V.Vector a -> V.Vector a -> Bool+        sectionEq l r = go 0+          where+            go i+                | i >= length = True+                | otherwise  = indexDef i l == indexDef i r && go (i+1)+            length = max (V.length l) (V.length r)+            indexDef i vec+                | i < V.length vec = vec V.! i+                | otherwise = def+ instance C.Parse AnyStruct (C.Parsed AnyStruct) where     parse (R.Raw s) = Struct         <$> V.generateM@@ -121,8 +141,8 @@ instance C.EstimateListAlloc AnyStruct (C.Parsed AnyStruct) where     estimateListAlloc structs =         let len = V.length structs-            nWords = maximum $ map (V.length . structData) $ V.toList structs-            nPtrs = maximum $ map (V.length . structPtrs) $ V.toList structs+            nWords = foldl' max 0 $ map (V.length . structData) $ V.toList structs+            nPtrs  = foldl' max 0 $ map (V.length . structPtrs) $ V.toList structs         in         (len, (fromIntegral nWords, fromIntegral nPtrs)) @@ -153,7 +173,7 @@     | List16 (ParsedList Word16)     | List32 (ParsedList Word32)     | List64 (ParsedList Word64)-    deriving(Show, Eq)+    deriving(Show, Eq, Generic)  instance C.Parse AnyList (C.Parsed AnyList) where     parse (R.Raw list) = case list of@@ -237,3 +257,15 @@ instance C.Allocate AnyStruct where     type AllocHint AnyStruct = (Word16, Word16)     new (nWords, nPtrs) msg = R.Raw <$> U.allocStruct msg nWords nPtrs++-- | Return the underlying buffer containing the text. This does not include the+-- null terminator.+textBuffer :: MonadThrow m => R.Raw mut Text -> m (R.Raw mut Data)+textBuffer (R.Raw list) = R.Raw <$> U.take (U.length list - 1) list++-- | Convert a 'Text' to a 'BS.ByteString', comprising the raw bytes of the text+-- (not counting the NUL terminator).+textBytes :: U.ReadCtx m 'M.Const => R.Raw 'M.Const Text -> m BS.ByteString+textBytes text = do+    R.Raw raw <- textBuffer text+    U.rawBytes raw

@@ -33,7 +33,8 @@ import qualified Capnp.New.Classes       as C import qualified Capnp.Repr              as R import           Capnp.Repr.Methods      (Client(..))-import           Capnp.Rpc.Errors        (eFailed, eMethodUnimplemented)+import           Capnp.Rpc.Errors+    (eFailed, eMethodUnimplemented, wrapException) import           Capnp.Rpc.Promise     (Fulfiller, breakPromise, fulfill, newCallback) import qualified Capnp.Rpc.Server        as Legacy@@ -185,24 +186,26 @@     ( C.Parse p pp, R.IsStruct p     , C.Parse r rr, R.IsStruct r     ) => (pp -> IO rr) -> MethodHandler p r-handleParsed handler =-    handleRaw $ \param -> 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-        pure (R.Raw struct)+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 'Const p -> IO (R.Raw 'Const r)) -> MethodHandler p r-handleRaw handler param f = do-    res <- handler param `withException` breakPromise f-    fulfill f res+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