{-# 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 #-}
{-|
Description : Examples for service and server definitions

Look at the source code of this module.
-}
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

-- Defines the service from gRPC Quickstart
-- https://grpc.io/docs/quickstart/python/

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