gRPC-haskell/examples/tutorial/Arithmetic.hs

209 lines
9.5 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-- | Generated by Haskell protocol buffer compiler. DO NOT EDIT!
module Arithmetic where
import qualified Prelude as Hs
import qualified Proto3.Suite.DotProto as HsProtobuf
import qualified Proto3.Suite.Types as HsProtobuf
import qualified Proto3.Suite.Class as HsProtobuf
import qualified Proto3.Suite.JSONPB as HsJSONPB
import Proto3.Suite.JSONPB ((.=), (.:))
import qualified Proto3.Wire as HsProtobuf
import Control.Applicative ((<*>), (<|>), (<$>))
import qualified Control.Applicative as Hs
import qualified Control.Monad as Hs
import qualified Data.Text.Lazy as Hs (Text)
import qualified Data.ByteString as Hs
import qualified Data.String as Hs (fromString)
import qualified Data.Vector as Hs (Vector)
import qualified Data.Int as Hs (Int16, Int32, Int64)
import qualified Data.Word as Hs (Word16, Word32, Word64)
import qualified Data.Proxy as Proxy
import qualified GHC.Generics as Hs
import qualified GHC.Enum as Hs
import Network.GRPC.HighLevel.Generated as HsGRPC
import Network.GRPC.HighLevel.Client as HsGRPC
import Network.GRPC.HighLevel.Server as HsGRPC hiding (serverLoop)
import Network.GRPC.HighLevel.Server.Unregistered as HsGRPC
(serverLoop)
2019-06-18 21:51:25 +02:00
data Arithmetic request response = Arithmetic{arithmeticAdd ::
request 'HsGRPC.Normal Arithmetic.TwoInts
Arithmetic.OneInt
->
Hs.IO (response 'HsGRPC.Normal Arithmetic.OneInt),
arithmeticRunningSum ::
request 'HsGRPC.ClientStreaming Arithmetic.OneInt
Arithmetic.OneInt
->
Hs.IO
(response 'HsGRPC.ClientStreaming
Arithmetic.OneInt)}
deriving Hs.Generic
2019-06-18 21:51:25 +02:00
arithmeticServer ::
Arithmetic HsGRPC.ServerRequest HsGRPC.ServerResponse ->
HsGRPC.ServiceOptions -> Hs.IO ()
arithmeticServer
Arithmetic{arithmeticAdd = arithmeticAdd,
arithmeticRunningSum = arithmeticRunningSum}
(ServiceOptions serverHost serverPort useCompression
userAgentPrefix userAgentSuffix initialMetadata sslConfig logger)
= (HsGRPC.serverLoop
HsGRPC.defaultOptions{HsGRPC.optNormalHandlers =
[(HsGRPC.UnaryHandler
(HsGRPC.MethodName "/arithmetic.Arithmetic/Add")
(HsGRPC.convertGeneratedServerHandler arithmeticAdd))],
HsGRPC.optClientStreamHandlers =
[(HsGRPC.ClientStreamHandler
(HsGRPC.MethodName "/arithmetic.Arithmetic/RunningSum")
(HsGRPC.convertGeneratedServerReaderHandler
arithmeticRunningSum))],
HsGRPC.optServerStreamHandlers = [],
HsGRPC.optBiDiStreamHandlers = [], optServerHost = serverHost,
optServerPort = serverPort, optUseCompression = useCompression,
optUserAgentPrefix = userAgentPrefix,
optUserAgentSuffix = userAgentSuffix,
optInitialMetadata = initialMetadata, optSSLConfig = sslConfig,
optLogger = logger})
2019-06-18 21:51:25 +02:00
arithmeticClient ::
HsGRPC.Client ->
Hs.IO (Arithmetic HsGRPC.ClientRequest HsGRPC.ClientResult)
arithmeticClient client
= (Hs.pure Arithmetic) <*>
((Hs.pure (HsGRPC.clientRequest client)) <*>
(HsGRPC.clientRegisterMethod client
(HsGRPC.MethodName "/arithmetic.Arithmetic/Add")))
<*>
((Hs.pure (HsGRPC.clientRequest client)) <*>
(HsGRPC.clientRegisterMethod client
(HsGRPC.MethodName "/arithmetic.Arithmetic/RunningSum")))
2019-06-18 21:51:25 +02:00
data TwoInts = TwoInts{twoIntsX :: Hs.Int32, twoIntsY :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
2019-06-18 21:51:25 +02:00
instance HsProtobuf.Named TwoInts where
nameOf _ = (Hs.fromString "TwoInts")
2019-06-18 21:51:25 +02:00
instance HsProtobuf.Message TwoInts where
encodeMessage _ TwoInts{twoIntsX = twoIntsX, twoIntsY = twoIntsY}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
twoIntsX),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
twoIntsY)])
decodeMessage _
= (Hs.pure TwoInts) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1))
<*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 2))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "x")
[]
2019-06-18 21:51:25 +02:00
""),
(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "y")
[]
2019-06-18 21:51:25 +02:00
"")]
instance HsJSONPB.ToJSONPB TwoInts where
toJSONPB (TwoInts f1 f2) = (HsJSONPB.object ["x" .= f1, "y" .= f2])
toEncodingPB (TwoInts f1 f2)
= (HsJSONPB.pairs ["x" .= f1, "y" .= f2])
2019-06-18 21:51:25 +02:00
instance HsJSONPB.FromJSONPB TwoInts where
parseJSONPB
= (HsJSONPB.withObject "TwoInts"
(\ obj -> (Hs.pure TwoInts) <*> obj .: "x" <*> obj .: "y"))
2019-06-18 21:51:25 +02:00
instance HsJSONPB.ToJSON TwoInts where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
2019-06-18 21:51:25 +02:00
instance HsJSONPB.FromJSON TwoInts where
parseJSON = HsJSONPB.parseJSONPB
2019-06-18 21:51:25 +02:00
instance HsJSONPB.ToSchema TwoInts where
declareNamedSchema _
= do let declare_x = HsJSONPB.declareSchemaRef
twoIntsX <- declare_x Proxy.Proxy
let declare_y = HsJSONPB.declareSchemaRef
twoIntsY <- declare_y Proxy.Proxy
let _ = Hs.pure TwoInts <*> HsJSONPB.asProxy declare_x <*>
HsJSONPB.asProxy declare_y
Hs.return
(HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName =
Hs.Just "TwoInts",
HsJSONPB._namedSchemaSchema =
Hs.mempty{HsJSONPB._schemaParamSchema =
Hs.mempty{HsJSONPB._paramSchemaType =
HsJSONPB.SwaggerObject},
HsJSONPB._schemaProperties =
HsJSONPB.insOrdFromList
[("x", twoIntsX), ("y", twoIntsY)]}})
2019-06-18 21:51:25 +02:00
data OneInt = OneInt{oneIntResult :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
2019-06-18 21:51:25 +02:00
instance HsProtobuf.Named OneInt where
nameOf _ = (Hs.fromString "OneInt")
2019-06-18 21:51:25 +02:00
instance HsProtobuf.Message OneInt where
encodeMessage _ OneInt{oneIntResult = oneIntResult}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
oneIntResult)])
decodeMessage _
= (Hs.pure OneInt) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "result")
[]
2019-06-18 21:51:25 +02:00
"")]
instance HsJSONPB.ToJSONPB OneInt where
toJSONPB (OneInt f1) = (HsJSONPB.object ["result" .= f1])
toEncodingPB (OneInt f1) = (HsJSONPB.pairs ["result" .= f1])
2019-06-18 21:51:25 +02:00
instance HsJSONPB.FromJSONPB OneInt where
parseJSONPB
= (HsJSONPB.withObject "OneInt"
(\ obj -> (Hs.pure OneInt) <*> obj .: "result"))
2019-06-18 21:51:25 +02:00
instance HsJSONPB.ToJSON OneInt where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
2019-06-18 21:51:25 +02:00
instance HsJSONPB.FromJSON OneInt where
parseJSON = HsJSONPB.parseJSONPB
2019-06-18 21:51:25 +02:00
instance HsJSONPB.ToSchema OneInt where
declareNamedSchema _
= do let declare_result = HsJSONPB.declareSchemaRef
oneIntResult <- declare_result Proxy.Proxy
let _ = Hs.pure OneInt <*> HsJSONPB.asProxy declare_result
Hs.return
(HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName = Hs.Just "OneInt",
HsJSONPB._namedSchemaSchema =
Hs.mempty{HsJSONPB._schemaParamSchema =
Hs.mempty{HsJSONPB._paramSchemaType =
HsJSONPB.SwaggerObject},
HsJSONPB._schemaProperties =
HsJSONPB.insOrdFromList
2019-06-18 21:51:25 +02:00
[("result", oneIntResult)]}})