{-# language DataKinds             #-}
{-# language DeriveAnyClass        #-}
{-# language DeriveGeneric         #-}
{-# language DerivingVia           #-}
{-# 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 #-}
{-|
Description : Examples for service and server definitions

Look at the source code of this module.
-}
module Mu.Rpc.Examples where

import qualified Data.Aeson               as J
import           Data.Conduit
import           Data.Conduit.Combinators as C
import qualified Data.Text                as T
import           GHC.Generics
import           GHC.TypeLits

import           Mu.Adapter.Json          ()
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
  = ('Package ('Just "helloworld")
      '[ 'Service "Greeter"
        '[ 'Method "SayHello"
          '[ 'ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest") ]
            ('RetSingle ('SchemaRef QuickstartSchema "HelloResponse"))
        , 'Method "SayHi"
          '[ 'ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HiRequest")]
            ('RetStream ('SchemaRef QuickstartSchema "HelloResponse"))
        , 'Method "SayManyHellos"
          '[ 'ArgStream ('Nothing :: Maybe Symbol) ('SchemaRef QuickstartSchema "HelloRequest")]
                ('RetStream ('SchemaRef QuickstartSchema "HelloResponse")) ] ] :: Package')

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" )
  deriving ([HelloRequest] -> Encoding
[HelloRequest] -> Value
HelloRequest -> Encoding
HelloRequest -> Value
(HelloRequest -> Value)
-> (HelloRequest -> Encoding)
-> ([HelloRequest] -> Value)
-> ([HelloRequest] -> Encoding)
-> ToJSON HelloRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HelloRequest] -> Encoding
$ctoEncodingList :: [HelloRequest] -> Encoding
toJSONList :: [HelloRequest] -> Value
$ctoJSONList :: [HelloRequest] -> Value
toEncoding :: HelloRequest -> Encoding
$ctoEncoding :: HelloRequest -> Encoding
toJSON :: HelloRequest -> Value
$ctoJSON :: HelloRequest -> Value
J.ToJSON, Value -> Parser [HelloRequest]
Value -> Parser HelloRequest
(Value -> Parser HelloRequest)
-> (Value -> Parser [HelloRequest]) -> FromJSON HelloRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HelloRequest]
$cparseJSONList :: Value -> Parser [HelloRequest]
parseJSON :: Value -> Parser HelloRequest
$cparseJSON :: Value -> Parser HelloRequest
J.FromJSON)
    via (WithSchema QuickstartSchema "HelloRequest" 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" )
  deriving ([HelloResponse] -> Encoding
[HelloResponse] -> Value
HelloResponse -> Encoding
HelloResponse -> Value
(HelloResponse -> Value)
-> (HelloResponse -> Encoding)
-> ([HelloResponse] -> Value)
-> ([HelloResponse] -> Encoding)
-> ToJSON HelloResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HelloResponse] -> Encoding
$ctoEncodingList :: [HelloResponse] -> Encoding
toJSONList :: [HelloResponse] -> Value
$ctoJSONList :: [HelloResponse] -> Value
toEncoding :: HelloResponse -> Encoding
$ctoEncoding :: HelloResponse -> Encoding
toJSON :: HelloResponse -> Value
$ctoJSON :: HelloResponse -> Value
J.ToJSON, Value -> Parser [HelloResponse]
Value -> Parser HelloResponse
(Value -> Parser HelloResponse)
-> (Value -> Parser [HelloResponse]) -> FromJSON HelloResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HelloResponse]
$cparseJSONList :: Value -> Parser [HelloResponse]
parseJSON :: Value -> Parser HelloResponse
$cparseJSON :: Value -> Parser HelloResponse
J.FromJSON)
    via (WithSchema QuickstartSchema "HelloResponse" 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" )
  deriving ([HiRequest] -> Encoding
[HiRequest] -> Value
HiRequest -> Encoding
HiRequest -> Value
(HiRequest -> Value)
-> (HiRequest -> Encoding)
-> ([HiRequest] -> Value)
-> ([HiRequest] -> Encoding)
-> ToJSON HiRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HiRequest] -> Encoding
$ctoEncodingList :: [HiRequest] -> Encoding
toJSONList :: [HiRequest] -> Value
$ctoJSONList :: [HiRequest] -> Value
toEncoding :: HiRequest -> Encoding
$ctoEncoding :: HiRequest -> Encoding
toJSON :: HiRequest -> Value
$ctoJSON :: HiRequest -> Value
J.ToJSON, Value -> Parser [HiRequest]
Value -> Parser HiRequest
(Value -> Parser HiRequest)
-> (Value -> Parser [HiRequest]) -> FromJSON HiRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HiRequest]
$cparseJSONList :: Value -> Parser [HiRequest]
parseJSON :: Value -> Parser HiRequest
$cparseJSON :: Value -> Parser HiRequest
J.FromJSON)
    via (WithSchema QuickstartSchema "HiRequest" HiRequest)

quickstartServer :: forall m i. (MonadServer m)
                 => ServerT '[] i QuickStartService m _
quickstartServer :: ServerT
  '[]
  i
  QuickStartService
  m
  '[ '[HelloRequest -> m HelloResponse,
       HiRequest -> ConduitT HelloResponse Void m () -> m (),
       ConduitT () HelloRequest m ()
       -> ConduitT HelloResponse Void m () -> m ()]]
quickstartServer
  -- = Server (sayHello :<|>: sayHi :<|>: sayManyHellos :<|>: H0)
  = (Named
   "SayHello" (RpcInfo i -> () -> HelloRequest -> m HelloResponse),
 Named
   "SayManyHellos"
   (RpcInfo i
    -> ()
    -> ConduitT () HelloRequest m ()
    -> ConduitT HelloResponse Void m ()
    -> m ()),
 Named
   "SayHi"
   (RpcInfo i
    -> () -> HiRequest -> ConduitT HelloResponse Void m () -> m ()))
-> ServerT
     '[]
     i
     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) info
       (methods :: [Method serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [*]) (sname :: serviceName)
       (pname :: Maybe serviceName).
(ToNamedList p nl, ToHandlers chn info () methods m hs nl,
 MappingRight chn sname ~ ()) =>
p
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
singleService ( (HelloRequest -> m HelloResponse)
-> Named
     "SayHello" (RpcInfo i -> () -> HelloRequest -> m HelloResponse)
forall k (n :: k) a p. p -> Named n (a -> () -> p)
method @"SayHello" HelloRequest -> m HelloResponse
sayHello
                  , (ConduitT () HelloRequest m ()
 -> ConduitT HelloResponse Void m () -> m ())
-> Named
     "SayManyHellos"
     (RpcInfo i
      -> ()
      -> ConduitT () HelloRequest m ()
      -> ConduitT HelloResponse Void m ()
      -> m ())
forall k (n :: k) a p. p -> Named n (a -> () -> p)
method @"SayManyHellos" ConduitT () HelloRequest m ()
-> ConduitT HelloResponse Void m () -> m ()
sayManyHellos
                  , (HiRequest -> ConduitT HelloResponse Void m () -> m ())
-> Named
     "SayHi"
     (RpcInfo i
      -> () -> HiRequest -> ConduitT HelloResponse Void m () -> m ())
forall k (n :: k) a p. p -> Named n (a -> () -> p)
method @"SayHi" HiRequest -> ConduitT HelloResponse Void m () -> m ()
sayHi )
  where
    sayHello :: HelloRequest -> m HelloResponse
    sayHello :: HelloRequest -> m HelloResponse
sayHello (HelloRequest 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
$ Text
"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 Int
n) 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 Text
"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 ConduitT () HelloRequest m ()
source 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

-- From https://www.apollographql.com/docs/apollo-server/schema/schema/
type ApolloService
  = 'Package ('Just "apollo")
      '[ Object "Book"
         '[ ObjectField "title" '[] ('RetSingle ('PrimitiveRef String))
          , ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))
          ]
      ,  Object "Paper"
         '[ ObjectField "title" '[] ('RetSingle ('PrimitiveRef String))
          , ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))
          ]
      ,  Union "Writing" ["Book", "Paper"]
      ,  Object "Author"
         '[ ObjectField "name" '[] ('RetSingle ('PrimitiveRef String))
          , ObjectField "writings" '[] ('RetSingle ('ListRef ('ObjectRef "Writing")))
          ]
      ]

type ApolloBookAuthor = '[
    "Book"    ':-> (String, Integer)
  , "Paper"   ':-> (String, Integer)
  , "Writing" ':-> Either (String, Integer) (String, Integer)
  , "Author"  ':-> Integer
  ]

apolloServer :: forall m i. (MonadServer m)
             => ServerT ApolloBookAuthor i ApolloService m _
apolloServer :: ServerT
  ApolloBookAuthor
  i
  ApolloService
  m
  '[ '[m String, m Integer], '[m String, m Integer], '[],
     '[m String, m [Either (String, Integer) (String, Integer)]]]
apolloServer
  = (Named
   "Author"
   (HandlersT
      ApolloBookAuthor
      i
      Integer
      '[ObjectField "name" '[] ('RetSingle ('PrimitiveRef String)),
        ObjectField
          "writings" '[] ('RetSingle ('ListRef ('ObjectRef "Writing")))]
      m
      '[m String, m [Either (String, Integer) (String, Integer)]]),
 Named
   "Book"
   (HandlersT
      ApolloBookAuthor
      i
      (String, Integer)
      '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)),
        ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))]
      m
      '[m String, m Integer]),
 Named
   "Paper"
   (HandlersT
      ApolloBookAuthor
      i
      (String, Integer)
      '[ObjectField "title" '[] ('RetSingle ('PrimitiveRef String)),
        ObjectField "author" '[] ('RetSingle ('ObjectRef "Author"))]
      m
      '[m String, m Integer]),
 Named
   "Writing"
   (Either (String, Integer) (String, Integer)
    -> m (UnionChoice ApolloBookAuthor '["Book", "Paper"])))
-> ServerT
     ApolloBookAuthor
     i
     ApolloService
     m
     '[ '[m String, m Integer], '[m String, m Integer], '[],
        '[m String, m [Either (String, Integer) (String, Integer)]]]
forall serviceName mnm anm p (nl :: [(Symbol, *)])
       (chn :: ServiceChain serviceName) info
       (ss :: [Service serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [[*]]) (pname :: Maybe serviceName).
(ToNamedList p nl, ToServices chn info ss m hs nl) =>
p -> ServerT chn info ('Package pname ss) m hs
resolver
      ( (Named "name" (RpcInfo i -> Integer -> m String),
 Named
   "writings"
   (RpcInfo i
    -> Integer -> m [Either (String, Integer) (String, Integer)]))
-> Named
     "Author"
     (HandlersT
        ApolloBookAuthor
        i
        (MappingRight ApolloBookAuthor "Author")
        '[ObjectField "name" '[] ('RetSingle ('PrimitiveRef String)),
          ObjectField
            "writings" '[] ('RetSingle ('ListRef ('ObjectRef "Writing")))]
        m
        '[m String, m [Either (String, Integer) (String, Integer)]])
forall a mnm anm (sname :: a) p (nl :: [(Symbol, *)])
       (chn :: ServiceChain a) info (ms :: [Method a mnm anm (TypeRef a)])
       (m :: * -> *) (hs :: [*]).
(ToNamedList p nl,
 ToHandlers chn info (MappingRight chn sname) ms m hs nl) =>
p
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
object @"Author" ( (Integer -> m String)
-> Named "name" (RpcInfo i -> Integer -> m String)
forall k (n :: k) h info. h -> Named n (RpcInfo info -> h)
field @"name"     Integer -> m String
authorName
                         , (Integer -> m [Either (String, Integer) (String, Integer)])
-> Named
     "writings"
     (RpcInfo i
      -> Integer -> m [Either (String, Integer) (String, Integer)])
forall k (n :: k) h info. h -> Named n (RpcInfo info -> h)
field @"writings" Integer -> m [Either (String, Integer) (String, Integer)]
authorWrs )
      , (Named "author" (RpcInfo i -> (String, Integer) -> m Integer),
 Named "title" (RpcInfo i -> (String, Integer) -> m String))
-> Named
     "Book"
     (HandlersT
        ApolloBookAuthor
        i
        (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) info (ms :: [Method a mnm anm (TypeRef a)])
       (m :: * -> *) (hs :: [*]).
(ToNamedList p nl,
 ToHandlers chn info (MappingRight chn sname) ms m hs nl) =>
p
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
object @"Book"   ( ((String, Integer) -> m Integer)
-> Named "author" (RpcInfo i -> (String, Integer) -> m Integer)
forall k (n :: k) h info. h -> Named n (RpcInfo info -> 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" (RpcInfo i -> (String, Integer) -> m String)
forall k (n :: k) h info. h -> Named n (RpcInfo info -> 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) )
      , (Named "author" (RpcInfo i -> (String, Integer) -> m Integer),
 Named "title" (RpcInfo i -> (String, Integer) -> m String))
-> Named
     "Paper"
     (HandlersT
        ApolloBookAuthor
        i
        (MappingRight ApolloBookAuthor "Paper")
        '[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) info (ms :: [Method a mnm anm (TypeRef a)])
       (m :: * -> *) (hs :: [*]).
(ToNamedList p nl,
 ToHandlers chn info (MappingRight chn sname) ms m hs nl) =>
p
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
object @"Paper"  ( ((String, Integer) -> m Integer)
-> Named "author" (RpcInfo i -> (String, Integer) -> m Integer)
forall k (n :: k) h info. h -> Named n (RpcInfo info -> 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" (RpcInfo i -> (String, Integer) -> m String)
forall k (n :: k) h info. h -> Named n (RpcInfo info -> 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) )
      , (MappingRight ApolloBookAuthor "Writing"
 -> m (UnionChoice ApolloBookAuthor '["Book", "Paper"]))
-> Named
     "Writing"
     (MappingRight ApolloBookAuthor "Writing"
      -> m (UnionChoice ApolloBookAuthor '["Book", "Paper"]))
forall a (sname :: a) (chn :: Mappings a *) (m :: * -> *)
       (elts :: [a]).
(MappingRight chn sname -> m (UnionChoice chn elts))
-> Named sname (MappingRight chn sname -> m (UnionChoice chn elts))
union @"Writing" MappingRight ApolloBookAuthor "Writing"
-> m (UnionChoice ApolloBookAuthor '["Book", "Paper"])
forall (elts :: [Symbol]) (f :: * -> *) (chn :: Mappings Symbol *).
(InUnion "Book" elts, InUnion "Paper" elts, Applicative f) =>
Either (MappingRight chn "Book") (MappingRight chn "Paper")
-> f (UnionChoice chn elts)
writing )
  where
    authorName :: Integer -> m String
    authorName :: Integer -> m String
authorName Integer
_ = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"alex"  -- this would run in the DB
    authorWrs :: Integer -> m [Either (String, Integer) (String, Integer)]
    authorWrs :: Integer -> m [Either (String, Integer) (String, Integer)]
authorWrs Integer
_ = [Either (String, Integer) (String, Integer)]
-> m [Either (String, Integer) (String, Integer)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    writing :: Either (MappingRight chn "Book") (MappingRight chn "Paper")
-> f (UnionChoice chn elts)
writing (Left  MappingRight chn "Book"
c) = UnionChoice chn elts -> f (UnionChoice chn elts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionChoice chn elts -> f (UnionChoice chn elts))
-> UnionChoice chn elts -> f (UnionChoice chn elts)
forall a b. (a -> b) -> a -> b
$ MappingRight chn "Book" -> UnionChoice chn elts
forall a (elt :: a) (elts :: [a]) (chn :: Mappings a *).
(InUnion elt elts, Typeable elt) =>
MappingRight chn elt -> UnionChoice chn elts
unionChoice @"Book" MappingRight chn "Book"
c
    writing (Right MappingRight chn "Paper"
c) = UnionChoice chn elts -> f (UnionChoice chn elts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionChoice chn elts -> f (UnionChoice chn elts))
-> UnionChoice chn elts -> f (UnionChoice chn elts)
forall a b. (a -> b) -> a -> b
$ MappingRight chn "Paper" -> UnionChoice chn elts
forall a (elt :: a) (elts :: [a]) (chn :: Mappings a *).
(InUnion elt elts, Typeable elt) =>
MappingRight chn elt -> UnionChoice chn elts
unionChoice @"Paper" MappingRight chn "Paper"
c