{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DeriveGeneric #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language PartialTypeSignatures #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module Mu.Rpc.Examples where
import Data.Conduit
import Data.Conduit.Combinators as C
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
= 'Package ('Just "helloworld")
'[ 'Service "Greeter" '[]
'[ 'Method "SayHello" '[]
'[ 'ArgSingle 'Nothing '[] ('SchemaRef QuickstartSchema "HelloRequest") ]
('RetSingle ('SchemaRef QuickstartSchema "HelloResponse"))
, 'Method "SayHi" '[]
'[ 'ArgSingle 'Nothing '[] ('SchemaRef QuickstartSchema "HiRequest")]
('RetStream ('SchemaRef QuickstartSchema "HelloResponse"))
, 'Method "SayManyHellos" '[]
'[ 'ArgStream 'Nothing '[] ('SchemaRef QuickstartSchema "HelloRequest")]
('RetStream ('SchemaRef QuickstartSchema "HelloResponse")) ] ]
newtype HelloRequest = HelloRequest { HelloRequest -> Text
name :: T.Text }
deriving ( Int -> HelloRequest -> ShowS
[HelloRequest] -> ShowS
HelloRequest -> String
(Int -> HelloRequest -> ShowS)
-> (HelloRequest -> String)
-> ([HelloRequest] -> ShowS)
-> Show HelloRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelloRequest] -> ShowS
$cshowList :: [HelloRequest] -> ShowS
show :: HelloRequest -> String
$cshow :: HelloRequest -> String
showsPrec :: Int -> HelloRequest -> ShowS
$cshowsPrec :: Int -> HelloRequest -> ShowS
Show, HelloRequest -> HelloRequest -> Bool
(HelloRequest -> HelloRequest -> Bool)
-> (HelloRequest -> HelloRequest -> Bool) -> Eq HelloRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelloRequest -> HelloRequest -> Bool
$c/= :: HelloRequest -> HelloRequest -> Bool
== :: HelloRequest -> HelloRequest -> Bool
$c== :: HelloRequest -> HelloRequest -> Bool
Eq, (forall x. HelloRequest -> Rep HelloRequest x)
-> (forall x. Rep HelloRequest x -> HelloRequest)
-> Generic HelloRequest
forall x. Rep HelloRequest x -> HelloRequest
forall x. HelloRequest -> Rep HelloRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HelloRequest x -> HelloRequest
$cfrom :: forall x. HelloRequest -> Rep HelloRequest x
Generic
, ToSchema QuickstartSchema "HelloRequest"
, FromSchema QuickstartSchema "HelloRequest" )
newtype HelloResponse = HelloResponse { HelloResponse -> Text
message :: T.Text }
deriving ( Int -> HelloResponse -> ShowS
[HelloResponse] -> ShowS
HelloResponse -> String
(Int -> HelloResponse -> ShowS)
-> (HelloResponse -> String)
-> ([HelloResponse] -> ShowS)
-> Show HelloResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelloResponse] -> ShowS
$cshowList :: [HelloResponse] -> ShowS
show :: HelloResponse -> String
$cshow :: HelloResponse -> String
showsPrec :: Int -> HelloResponse -> ShowS
$cshowsPrec :: Int -> HelloResponse -> ShowS
Show, HelloResponse -> HelloResponse -> Bool
(HelloResponse -> HelloResponse -> Bool)
-> (HelloResponse -> HelloResponse -> Bool) -> Eq HelloResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelloResponse -> HelloResponse -> Bool
$c/= :: HelloResponse -> HelloResponse -> Bool
== :: HelloResponse -> HelloResponse -> Bool
$c== :: HelloResponse -> HelloResponse -> Bool
Eq, (forall x. HelloResponse -> Rep HelloResponse x)
-> (forall x. Rep HelloResponse x -> HelloResponse)
-> Generic HelloResponse
forall x. Rep HelloResponse x -> HelloResponse
forall x. HelloResponse -> Rep HelloResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HelloResponse x -> HelloResponse
$cfrom :: forall x. HelloResponse -> Rep HelloResponse x
Generic
, ToSchema QuickstartSchema "HelloResponse"
, FromSchema QuickstartSchema "HelloResponse" )
newtype HiRequest = HiRequest { HiRequest -> Int
number :: Int }
deriving ( Int -> HiRequest -> ShowS
[HiRequest] -> ShowS
HiRequest -> String
(Int -> HiRequest -> ShowS)
-> (HiRequest -> String)
-> ([HiRequest] -> ShowS)
-> Show HiRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HiRequest] -> ShowS
$cshowList :: [HiRequest] -> ShowS
show :: HiRequest -> String
$cshow :: HiRequest -> String
showsPrec :: Int -> HiRequest -> ShowS
$cshowsPrec :: Int -> HiRequest -> ShowS
Show, HiRequest -> HiRequest -> Bool
(HiRequest -> HiRequest -> Bool)
-> (HiRequest -> HiRequest -> Bool) -> Eq HiRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HiRequest -> HiRequest -> Bool
$c/= :: HiRequest -> HiRequest -> Bool
== :: HiRequest -> HiRequest -> Bool
$c== :: HiRequest -> HiRequest -> Bool
Eq, (forall x. HiRequest -> Rep HiRequest x)
-> (forall x. Rep HiRequest x -> HiRequest) -> Generic HiRequest
forall x. Rep HiRequest x -> HiRequest
forall x. HiRequest -> Rep HiRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HiRequest x -> HiRequest
$cfrom :: forall x. HiRequest -> Rep HiRequest x
Generic
, ToSchema QuickstartSchema "HiRequest"
, FromSchema QuickstartSchema "HiRequest" )
quickstartServer :: forall m. (MonadServer m)
=> ServerT '[] QuickStartService m _
quickstartServer :: ServerT
'[]
QuickStartService
m
'[ '[HelloRequest -> m HelloResponse,
HiRequest -> ConduitT HelloResponse Void m () -> m (),
ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ()]]
quickstartServer
= (Named "SayHello" (() -> HelloRequest -> m HelloResponse),
Named
"SayManyHellos"
(()
-> ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m ()
-> m ()),
Named
"SayHi"
(() -> HiRequest -> ConduitT HelloResponse Void m () -> m ()))
-> ServerT
'[]
QuickStartService
m
'[ '[HelloRequest -> m HelloResponse,
HiRequest -> ConduitT HelloResponse Void m () -> m (),
ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ()]]
forall serviceName mnm anm p (nl :: [(Symbol, *)])
(chn :: ServiceChain serviceName)
(methods :: [Method serviceName mnm anm]) (m :: * -> *) (hs :: [*])
(sname :: serviceName) (pname :: Maybe serviceName) (sanns :: [*]).
(ToNamedList p nl, ToHandlers chn () methods m hs nl,
MappingRight chn sname ~ ()) =>
p
-> ServerT
chn ('Package pname '[ 'Service sname sanns methods]) m '[hs]
singleService ( (HelloRequest -> m HelloResponse)
-> Named "SayHello" (() -> HelloRequest -> m HelloResponse)
forall k (n :: k) p. p -> Named n (() -> p)
method @"SayHello" HelloRequest -> m HelloResponse
sayHello
, (ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ())
-> Named
"SayManyHellos"
(()
-> ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m ()
-> m ())
forall k (n :: k) p. p -> Named n (() -> p)
method @"SayManyHellos" ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ()
sayManyHellos
, (HiRequest -> ConduitT HelloResponse Void m () -> m ())
-> Named
"SayHi"
(() -> HiRequest -> ConduitT HelloResponse Void m () -> m ())
forall k (n :: k) p. p -> Named n (() -> p)
method @"SayHi" HiRequest -> ConduitT HelloResponse Void m () -> m ()
sayHi )
where
sayHello :: HelloRequest -> m HelloResponse
sayHello :: HelloRequest -> m HelloResponse
sayHello (HelloRequest nm :: Text
nm)
= HelloResponse -> m HelloResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HelloResponse -> m HelloResponse)
-> HelloResponse -> m HelloResponse
forall a b. (a -> b) -> a -> b
$ Text -> HelloResponse
HelloResponse (Text -> HelloResponse) -> Text -> HelloResponse
forall a b. (a -> b) -> a -> b
$ "hi, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm
sayHi :: HiRequest
-> ConduitT HelloResponse Void m ()
-> m ()
sayHi :: HiRequest -> ConduitT HelloResponse Void m () -> m ()
sayHi (HiRequest n :: Int
n) sink :: ConduitT HelloResponse 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 -> ConduitT () HelloResponse m ()
forall (m :: * -> *) a i. Monad m => Int -> a -> ConduitT i a m ()
C.replicate Int
n (Text -> HelloResponse
HelloResponse "hi!") ConduitT () HelloResponse m ()
-> ConduitT HelloResponse 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 Void m ()
sink
sayManyHellos :: ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m ()
-> m ()
sayManyHellos :: ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ()
sayManyHellos source :: ConduitT () HelloRequest m ()
source sink :: ConduitT HelloResponse 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 m ()
source ConduitT () HelloRequest m ()
-> ConduitM HelloRequest 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 -> m HelloResponse)
-> ConduitT HelloRequest HelloResponse m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapM HelloRequest -> m HelloResponse
sayHello ConduitT HelloRequest HelloResponse m ()
-> ConduitT HelloResponse Void m ()
-> ConduitM HelloRequest 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 Void m ()
sink
type ApolloService
= 'Package ('Just "apollo")
'[ Object "Book" '[]
'[ ObjectField "title" '[] '[] ('RetSingle ('PrimitiveRef String))
, ObjectField "author" '[] '[] ('RetSingle ('ObjectRef "Author"))
]
, Object "Author" '[]
'[ ObjectField "name" '[] '[] ('RetSingle ('PrimitiveRef String))
, ObjectField "books" '[] '[] ('RetSingle ('ListRef ('ObjectRef "Book")))
]
]
type ApolloBookAuthor = '[
"Book" ':-> (String, Integer)
, "Author" ':-> Integer
]
apolloServer :: forall m. (MonadServer m) => ServerT ApolloBookAuthor ApolloService m _
apolloServer :: ServerT
ApolloBookAuthor
ApolloService
m
'[ '[m String, m Integer], '[m String, m [(String, Integer)]]]
apolloServer
= (Named
"Author"
(HandlersT
ApolloBookAuthor
Integer
'[ObjectField "name" '[] '[] ('RetSingle ('PrimitiveRef String)),
ObjectField
"books" '[] '[] ('RetSingle ('ListRef ('ObjectRef "Book")))]
m
'[m String, m [(String, Integer)]]),
Named
"Book"
(HandlersT
ApolloBookAuthor
(String, Integer)
'[ObjectField "title" '[] '[] ('RetSingle ('PrimitiveRef String)),
ObjectField "author" '[] '[] ('RetSingle ('ObjectRef "Author"))]
m
'[m String, m Integer]))
-> ServerT
ApolloBookAuthor
ApolloService
m
'[ '[m String, m Integer], '[m String, m [(String, Integer)]]]
forall serviceName mnm anm p (nl :: [(Symbol, *)])
(chn :: ServiceChain serviceName)
(ss :: [Service serviceName mnm anm]) (m :: * -> *) (hs :: [[*]])
(pname :: Maybe serviceName).
(ToNamedList p nl, ToServices chn ss m hs nl) =>
p -> ServerT chn ('Package pname ss) m hs
resolver
( (Named "name" (Integer -> m String),
Named "books" (Integer -> m [(String, Integer)]))
-> Named
"Author"
(HandlersT
ApolloBookAuthor
(MappingRight ApolloBookAuthor "Author")
'[ObjectField "name" '[] '[] ('RetSingle ('PrimitiveRef String)),
ObjectField
"books" '[] '[] ('RetSingle ('ListRef ('ObjectRef "Book")))]
m
'[m String, m [(String, Integer)]])
forall a mnm anm (sname :: a) p (nl :: [(Symbol, *)])
(chn :: ServiceChain a) (ms :: [Method a mnm anm]) (m :: * -> *)
(hs :: [*]).
(ToNamedList p nl,
ToHandlers chn (MappingRight chn sname) ms m hs nl) =>
p -> Named sname (HandlersT chn (MappingRight chn sname) ms m hs)
object @"Author" ( (Integer -> m String) -> Named "name" (Integer -> m String)
forall k (n :: k) h. h -> Named n h
field @"name" Integer -> m String
authorName
, (Integer -> m [(String, Integer)])
-> Named "books" (Integer -> m [(String, Integer)])
forall k (n :: k) h. h -> Named n h
field @"books" Integer -> m [(String, Integer)]
authorBooks )
, (Named "author" ((String, Integer) -> m Integer),
Named "title" ((String, Integer) -> m String))
-> Named
"Book"
(HandlersT
ApolloBookAuthor
(MappingRight ApolloBookAuthor "Book")
'[ObjectField "title" '[] '[] ('RetSingle ('PrimitiveRef String)),
ObjectField "author" '[] '[] ('RetSingle ('ObjectRef "Author"))]
m
'[m String, m Integer])
forall a mnm anm (sname :: a) p (nl :: [(Symbol, *)])
(chn :: ServiceChain a) (ms :: [Method a mnm anm]) (m :: * -> *)
(hs :: [*]).
(ToNamedList p nl,
ToHandlers chn (MappingRight chn sname) ms m hs nl) =>
p -> Named sname (HandlersT chn (MappingRight chn sname) ms m hs)
object @"Book" ( ((String, Integer) -> m Integer)
-> Named "author" ((String, Integer) -> m Integer)
forall k (n :: k) h. h -> Named n h
field @"author" (Integer -> m Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer)
-> ((String, Integer) -> Integer) -> (String, Integer) -> m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> Integer
forall a b. (a, b) -> b
snd)
, ((String, Integer) -> m String)
-> Named "title" ((String, Integer) -> m String)
forall k (n :: k) h. h -> Named n h
field @"title" (String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String)
-> ((String, Integer) -> String) -> (String, Integer) -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> String
forall a b. (a, b) -> a
fst) ) )
where
authorName :: Integer -> m String
authorName :: Integer -> m String
authorName _ = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure "alex"
authorBooks :: Integer -> m [(String, Integer)]
authorBooks :: Integer -> m [(String, Integer)]
authorBooks _ = [(String, Integer)] -> m [(String, Integer)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []