Add methodOptions to HasMethodImpl to provide custom method options.

proto-lens-protoc/Changelog.md

@@ -5,6 +5,7 @@
 ### Breaking Changes
 - Reexport transitive definitions from modules generated for `.proto` files
   with `import public` statements (#329).
+- Add `methodOptions` to `HasMethodImpl` to provide custom method options.
 
 ### Backwards-Compatible Changes
 - Fix a potential naming conflict when message types and enum values

proto-lens-protoc/package.yaml

@@ -18,6 +18,7 @@ extra-source-files:
 
 dependencies:
   - base >= 4.9 && < 4.13
+  - bytestring == 0.10.*
   - containers >= 0.5 && < 0.7
   - lens-family == 1.2.*
   - proto-lens == 0.5.*
@@ -41,5 +42,4 @@ executables:
     main: protoc-gen-haskell.hs
     source-dirs: app
     dependencies:
-      - bytestring == 0.10.*
       - proto-lens-protoc

proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs

@@ -70,6 +70,7 @@ import Proto.Google.Protobuf.Descriptor
     , FieldDescriptorProto'Type(..)
     , FileDescriptorProto
     , MethodDescriptorProto
+    , MethodOptions
     , ServiceDescriptorProto
     )
 import Proto.Google.Protobuf.Descriptor_Fields
@@ -160,6 +161,7 @@ data MethodInfo = MethodInfo
     , methodOutput :: Text
     , methodClientStreaming :: Bool
     , methodServerStreaming :: Bool
+    , methodOptions :: MethodOptions
     }
 
 -- | Information about a single field of a proto message,
@@ -352,6 +354,7 @@ collectServices fd = fmap (toServiceInfo $ fd ^. package) $ fd ^. service
             , methodOutput = fromString . T.unpack $ md ^. outputType
             , methodClientStreaming = md ^. clientStreaming
             , methodServerStreaming = md ^. serverStreaming
+            , methodOptions = md ^. options
             }
 
 messageAndEnumDefs ::

proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs

@@ -16,12 +16,14 @@ module Data.ProtoLens.Compiler.Generate(
 
 
 import Control.Arrow (second)
+import qualified Data.ByteString.Char8 as B
 import qualified Data.Foldable as F
 import qualified Data.List as List
 import qualified Data.Map as Map
 import Data.Maybe (isJust)
 import Data.Monoid ((<>))
 import Data.Ord (comparing)
+import Data.ProtoLens (encodeMessage)
 import qualified Data.Set as Set
 import Data.String (fromString)
 import Data.Text (unpack)
@@ -263,6 +265,14 @@ generateServiceDecls env si =
                      (True,  False) -> "Data.ProtoLens.Service.Types.ClientStreaming"
                      (False, True)  -> "Data.ProtoLens.Service.Types.ServerStreaming"
                      (True,  True)  -> "Data.ProtoLens.Service.Types.BiDiStreaming"
+        -- methodOptions _ _ = decodeMessageOrDie (pack "...")
+        -- (where "..." is the encoded version of the proto message).
+        , instMatch
+            [ match "methodOptions" [pWildCard, pWildCard]
+                $ "Data.ProtoLens.decodeMessageOrDie"
+                      @@ ("Data.ByteString.Char8.pack"
+                            @@ stringExp (B.unpack $ encodeMessage $ methodOptions m))
+            ]
         ]
     | m <- serviceMethods si
     , let instanceHead = tyPromotedString (T.unpack $ methodIdent m)

proto-lens-tests/tests/service.proto

@@ -17,5 +17,9 @@ service TestService {
   rpc ClientStreaming (stream Foo) returns (Bar);
   rpc ServerStreaming (Foo)        returns (stream Bar);
   rpc BiDiStreaming   (stream Foo) returns (stream Bar);
+  // Test that we pass method options through the API:
+  rpc Deprecated      (Foo)        returns (Bar) {
+    option deprecated = true;
+  }
 }
 

proto-lens-tests/tests/service_test.hs

@@ -6,87 +6,112 @@
 
 module Main (main) where
 
+import Control.Exception (evaluate)
+import Control.Monad (void)
+import Data.ProtoLens (defMessage)
 import Data.Proxy (Proxy (..))
+import Lens.Family2 (set)
+import Test.Framework (testGroup, Test)
 import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@=?))
 import Proto.Service
 import Data.ProtoLens.Service.Types
 import Data.ProtoLens.TestUtil (testMain)
+import Proto.Google.Protobuf.Descriptor_Fields (deprecated)
 
 
--- This module will fail to compile due to @-fwarn-overlapping-patterns@ and
--- @-Werror@ if any of the constraints on the definitions below is incorrect.
 main :: IO ()
 main = testMain
-    [ testCase "module compiles" $ return ()
+    [ testCase "module compiles" $ do
+        -- Use these variables in a monomorphic context to verify that
+        -- their contexts are all correct.
+        void $ evaluate serviceMetadataTest
+        void $ evaluate normalMethodMetadataTest
+        void $ evaluate clientStreamingMethodMetadataTest
+        void $ evaluate serverStreamingMethodMetadataTest
+        void $ evaluate bidiStreamingMethodMetadataTest
+        void $ evaluate revMessagesMetadataTest
+    , testMethodOption
     ]
 
 
-_serviceMetadataTest
+serviceMetadataTest
     :: ( s ~ TestService
        , Service s
        , ServicePackage s ~ "test.service"
        -- proto-lens generates this list in alphabetical order.
        , ServiceMethods s ~ '[ "biDiStreaming"
                              , "clientStreaming"
+                             , "deprecated"
                              , "normal"
                              , "revMessages"
                              , "serverStreaming"
                              ]
        ) => Proxy m
-_serviceMetadataTest = Proxy
+serviceMetadataTest = Proxy
 
 
-_normalMethodMetadataTest
+normalMethodMetadataTest
     :: ( s ~ TestService
        , m ~ "normal"
        , HasMethod s m
        , MethodInput  s m ~ Foo
        , MethodOutput s m ~ Bar
        , MethodStreamingType s m ~ 'NonStreaming
        ) => Proxy m
-_normalMethodMetadataTest = Proxy
+normalMethodMetadataTest = Proxy
 
 
-_clientStreamingMethodMetadataTest
+clientStreamingMethodMetadataTest
     :: ( s ~ TestService
        , m ~ "clientStreaming"
        , HasMethod s m
        , MethodInput  s m ~ Foo
        , MethodOutput s m ~ Bar
        , MethodStreamingType s m ~ 'ClientStreaming
        ) => Proxy m
-_clientStreamingMethodMetadataTest = Proxy
+clientStreamingMethodMetadataTest = Proxy
 
 
-_serverStreamingMethodMetadataTest
+serverStreamingMethodMetadataTest
     :: ( s ~ TestService
        , m ~ "serverStreaming"
        , HasMethod s m
        , MethodInput  s m ~ Foo
        , MethodOutput s m ~ Bar
        , MethodStreamingType s m ~ 'ServerStreaming
        ) => Proxy m
-_serverStreamingMethodMetadataTest = Proxy
+serverStreamingMethodMetadataTest = Proxy
 
 
-_bidiStreamingMethodMetadataTest
+bidiStreamingMethodMetadataTest
     :: ( s ~ TestService
-       , m ~ "bidiStreaming"
+       , m ~ "biDiStreaming"
        , HasMethod s m
        , MethodInput  s m ~ Foo
        , MethodOutput s m ~ Bar
        , MethodStreamingType s m ~ 'BiDiStreaming
        ) => Proxy m
-_bidiStreamingMethodMetadataTest = Proxy
+bidiStreamingMethodMetadataTest = Proxy
 
 
-_revMessagesMetadataTest
+revMessagesMetadataTest
     :: ( s ~ TestService
        , m ~ "revMessages"
        , HasMethod s m
        , MethodInput  s m ~ Bar
        , MethodOutput s m ~ Foo
        , MethodStreamingType s m ~ 'NonStreaming
        ) => Proxy m
-_revMessagesMetadataTest = Proxy
+revMessagesMetadataTest = Proxy
+
+testMethodOption :: Test
+testMethodOption = testGroup "methodOption"
+    [ testCase "default" $
+        defMessage
+            @=? methodOptions TestService (Proxy :: Proxy "normal")
+    , testCase "deprecated" $
+        set deprecated True defMessage
+            @=? methodOptions TestService (Proxy :: Proxy "deprecated")
+    ]
 

proto-lens/Changelog.md

@@ -1,5 +1,12 @@
 # Changelog for `proto-lens`
 
+## Pending
+
+### Breaking Changes
+- Add `methodOptions` to `HasMethodImpl` to provide custom method options.
+
+### Backwards-Compatible Changes
+
 ## v0.5.1.0
 - Add `decodeMessageDelimitedH` to decode delimited messages from a file handle
   (#61).

proto-lens/src/Data/ProtoLens/Service/Types.hs

@@ -25,7 +25,9 @@ module Data.ProtoLens.Service.Types
 
 import Data.Kind (Constraint)
 import Data.ProtoLens.Message (Message)
+import {-# SOURCE #-} Proto.Google.Protobuf.Descriptor (MethodOptions)
 import GHC.TypeLits
+import Data.Proxy (Proxy)
 
 
 -- | Reifies the fact that there is a 'HasMethod' instance for every symbol
@@ -85,6 +87,7 @@ class ( KnownSymbol m
   type MethodInput         s m :: *
   type MethodOutput        s m :: *
   type MethodStreamingType s m :: StreamingType
+  methodOptions :: s -> Proxy m -> MethodOptions
 
 
 -- | Helper constraint that expands to a user-friendly error message when 'm'

proto-lens/src/Proto/Google/Protobuf/Descriptor.hs-boot

@@ -0,0 +1,3 @@
+module Proto.Google.Protobuf.Descriptor where
+
+data MethodOptions