{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DeriveGeneric #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language PartialTypeSignatures #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module Mu.Rpc.Examples where
import Data.Conduit
import Data.Conduit.Combinators as C
import Data.Functor.MaybeLike
import qualified Data.Text as T
import GHC.Generics
import Mu.Rpc
import Mu.Schema
import Mu.Server
type QuickstartSchema
= '[ 'DRecord "HelloRequest"
'[ 'FieldDef "name" ('TPrimitive T.Text) ]
, 'DRecord "HelloResponse"
'[ 'FieldDef "message" ('TPrimitive T.Text) ]
, 'DRecord "HiRequest"
'[ 'FieldDef "number" ('TPrimitive Int) ]
]
type QuickStartService
= 'Service "Greeter" '[Package "helloworld"]
'[ 'Method "SayHello" '[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HelloRequest") ]
('RetSingle ('ViaSchema QuickstartSchema "HelloResponse"))
, 'Method "SayHi" '[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HiRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))
, 'Method "SayManyHellos" '[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse")) ]
newtype HelloRequest f = HelloRequest { HelloRequest f -> f Text
name :: f T.Text } deriving ((forall x. HelloRequest f -> Rep (HelloRequest f) x)
-> (forall x. Rep (HelloRequest f) x -> HelloRequest f)
-> Generic (HelloRequest f)
forall x. Rep (HelloRequest f) x -> HelloRequest f
forall x. HelloRequest f -> Rep (HelloRequest f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (HelloRequest f) x -> HelloRequest f
forall (f :: * -> *) x. HelloRequest f -> Rep (HelloRequest f) x
$cto :: forall (f :: * -> *) x. Rep (HelloRequest f) x -> HelloRequest f
$cfrom :: forall (f :: * -> *) x. HelloRequest f -> Rep (HelloRequest f) x
Generic)
deriving instance Functor f => ToSchema f QuickstartSchema "HelloRequest" (HelloRequest f)
deriving instance Functor f => FromSchema f QuickstartSchema "HelloRequest" (HelloRequest f)
newtype HelloResponse f = HelloResponse { HelloResponse f -> f Text
message :: f T.Text } deriving ((forall x. HelloResponse f -> Rep (HelloResponse f) x)
-> (forall x. Rep (HelloResponse f) x -> HelloResponse f)
-> Generic (HelloResponse f)
forall x. Rep (HelloResponse f) x -> HelloResponse f
forall x. HelloResponse f -> Rep (HelloResponse f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (HelloResponse f) x -> HelloResponse f
forall (f :: * -> *) x. HelloResponse f -> Rep (HelloResponse f) x
$cto :: forall (f :: * -> *) x. Rep (HelloResponse f) x -> HelloResponse f
$cfrom :: forall (f :: * -> *) x. HelloResponse f -> Rep (HelloResponse f) x
Generic)
deriving instance Functor f => ToSchema f QuickstartSchema "HelloResponse" (HelloResponse f)
deriving instance Functor f => FromSchema f QuickstartSchema "HelloResponse" (HelloResponse f)
newtype HiRequest f = HiRequest { HiRequest f -> f Int
number :: f Int } deriving ((forall x. HiRequest f -> Rep (HiRequest f) x)
-> (forall x. Rep (HiRequest f) x -> HiRequest f)
-> Generic (HiRequest f)
forall x. Rep (HiRequest f) x -> HiRequest f
forall x. HiRequest f -> Rep (HiRequest f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (HiRequest f) x -> HiRequest f
forall (f :: * -> *) x. HiRequest f -> Rep (HiRequest f) x
$cto :: forall (f :: * -> *) x. Rep (HiRequest f) x -> HiRequest f
$cfrom :: forall (f :: * -> *) x. HiRequest f -> Rep (HiRequest f) x
Generic)
deriving instance Functor f => ToSchema f QuickstartSchema "HiRequest" (HiRequest f)
deriving instance Functor f => FromSchema f QuickstartSchema "HiRequest" (HiRequest f)
quickstartServer :: forall m f.
(MonadServer m, Applicative f, MaybeLike f)
=> ServerT f QuickStartService m _
quickstartServer :: ServerT
f
QuickStartService
m
'[HelloRequest f -> m (HelloResponse f),
HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
quickstartServer
= HandlersT
f
'[ 'Method
"SayHello"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HelloRequest")]
('RetSingle ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayHi"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HiRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[HelloRequest f -> m (HelloResponse f),
HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
-> ServerT
f
QuickStartService
m
'[HelloRequest f -> m (HelloResponse f),
HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
forall mnm snm (w :: * -> *) (methods :: [Method mnm])
(m :: * -> *) (hs :: [*]) (sname :: snm) (anns :: [*]).
HandlersT w methods m hs
-> ServerT w ('Service sname anns methods) m hs
Server (HelloRequest f -> m (HelloResponse f)
sayHello (HelloRequest f -> m (HelloResponse f))
-> HandlersT
f
'[ 'Method
"SayHi"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HiRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
-> HandlersT
f
'[ 'Method
"SayHello"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HelloRequest")]
('RetSingle ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayHi"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HiRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[HelloRequest f -> m (HelloResponse f),
HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
forall mnm (w :: * -> *) (args :: [Argument]) (ret :: Return)
(m :: * -> *) h (ms :: [Method mnm]) (hs :: [*]) (name :: mnm)
(anns :: [*]).
Handles w args ret m h =>
h
-> HandlersT w ms m hs
-> HandlersT w ('Method name anns args ret : ms) m (h : hs)
:<|>: HiRequest f -> ConduitT (HelloResponse f) Void m () -> m ()
sayHi (HiRequest f -> ConduitT (HelloResponse f) Void m () -> m ())
-> HandlersT
f
'[ 'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
-> HandlersT
f
'[ 'Method
"SayHi"
'[]
'[ 'ArgSingle ('ViaSchema QuickstartSchema "HiRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse")),
'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[HiRequest f -> ConduitT (HelloResponse f) Void m () -> m (),
ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
forall mnm (w :: * -> *) (args :: [Argument]) (ret :: Return)
(m :: * -> *) h (ms :: [Method mnm]) (hs :: [*]) (name :: mnm)
(anns :: [*]).
Handles w args ret m h =>
h
-> HandlersT w ms m hs
-> HandlersT w ('Method name anns args ret : ms) m (h : hs)
:<|>: ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()
sayManyHellos (ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ())
-> HandlersT f '[] m '[]
-> HandlersT
f
'[ 'Method
"SayManyHellos"
'[]
'[ 'ArgStream ('ViaSchema QuickstartSchema "HelloRequest")]
('RetStream ('ViaSchema QuickstartSchema "HelloResponse"))]
m
'[ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()]
forall mnm (w :: * -> *) (args :: [Argument]) (ret :: Return)
(m :: * -> *) h (ms :: [Method mnm]) (hs :: [*]) (name :: mnm)
(anns :: [*]).
Handles w args ret m h =>
h
-> HandlersT w ms m hs
-> HandlersT w ('Method name anns args ret : ms) m (h : hs)
:<|>: HandlersT f '[] m '[]
forall mnm (w :: * -> *) (m :: * -> *). HandlersT w '[] m '[]
H0)
where sayHello :: HelloRequest f -> m (HelloResponse f)
sayHello :: HelloRequest f -> m (HelloResponse f)
sayHello (HelloRequest nm :: f Text
nm)
= HelloResponse f -> m (HelloResponse f)
forall (m :: * -> *) a. Monad m => a -> m a
return (f Text -> HelloResponse f
forall (f :: * -> *). f Text -> HelloResponse f
HelloResponse (("hi, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
nm))
sayHi :: HiRequest f
-> ConduitT (HelloResponse f) Void m ()
-> m ()
sayHi :: HiRequest f -> ConduitT (HelloResponse f) Void m () -> m ()
sayHi (HiRequest (f Int -> Maybe Int
forall (f :: * -> *) a. MaybeLike f => f a -> Maybe a
likeMaybe -> Just n :: Int
n)) sink :: ConduitT (HelloResponse f) Void m ()
sink
= ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> HelloResponse f -> ConduitT () (HelloResponse f) m ()
forall (m :: * -> *) a i. Monad m => Int -> a -> ConduitT i a m ()
C.replicate Int
n (f Text -> HelloResponse f
forall (f :: * -> *). f Text -> HelloResponse f
HelloResponse (f Text -> HelloResponse f) -> f Text -> HelloResponse f
forall a b. (a -> b) -> a -> b
$ Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure "hi!") ConduitT () (HelloResponse f) m ()
-> ConduitT (HelloResponse f) Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT (HelloResponse f) Void m ()
sink
sayHi (HiRequest _) sink :: ConduitT (HelloResponse f) Void m ()
sink
= ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> ConduitT () (HelloResponse f) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ConduitT () (HelloResponse f) m ()
-> ConduitT (HelloResponse f) Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT (HelloResponse f) Void m ()
sink
sayManyHellos :: ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m ()
-> m ()
sayManyHellos :: ConduitT () (HelloRequest f) m ()
-> ConduitT (HelloResponse f) Void m () -> m ()
sayManyHellos source :: ConduitT () (HelloRequest f) m ()
source sink :: ConduitT (HelloResponse f) Void m ()
sink
= ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ ConduitT () (HelloRequest f) m ()
source ConduitT () (HelloRequest f) m ()
-> ConduitM (HelloRequest f) Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (HelloRequest f -> m (HelloResponse f))
-> ConduitT (HelloRequest f) (HelloResponse f) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapM HelloRequest f -> m (HelloResponse f)
sayHello ConduitT (HelloRequest f) (HelloResponse f) m ()
-> ConduitT (HelloResponse f) Void m ()
-> ConduitM (HelloRequest f) Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT (HelloResponse f) Void m ()
sink