{-# language AllowAmbiguousTypes   #-}
{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds             #-}
{-# language ScopedTypeVariables   #-}
{-# language TemplateHaskell       #-}
{-# language TypeApplications      #-}
{-# language TypeFamilies          #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-|
Description : Client for gRPC services using plain Haskell records

For further information over initialization of the connection,
consult the <http://hackage.haskell.org/package/http2-client-grpc http2-client-grpc docs>.
-}
module Mu.GRpc.Client.Record (
  -- * Initialization of the gRPC client
  GrpcClient
, GrpcClientConfig
, grpcClientConfigSimple
, setupGrpcClient'
  -- * Fill and generate the Haskell record of functions
, buildService
, GRpcMessageProtocol(..)
, CompressMode(..)
, GRpcReply(..)
, generateRecordFromService
) where

import           Control.Applicative
import           Data.Char
import           Data.Conduit                 (ConduitT)
import           Data.Proxy
import           Data.Void
import           GHC.Generics                 hiding (NoSourceStrictness, NoSourceUnpackedness)
import           GHC.TypeLits
import           Language.Haskell.TH          hiding (ppr)
import           Language.Haskell.TH.Datatype

import           Network.GRPC.Client          (CompressMode (..))
import           Network.GRPC.Client.Helpers

import           Mu.GRpc.Bridge
import           Mu.GRpc.Client.Internal
import           Mu.Rpc

-- | Fills in a Haskell record of functions with the corresponding
--   calls to gRPC services from a Mu 'Service' declaration.
buildService :: forall (pro :: GRpcMessageProtocol)
                (pkg :: Package') (s :: Symbol) (p :: Symbol) t
                (pkgName :: Symbol) (ss :: [Service'])
                (anns :: [ServiceAnnotation]) (ms :: [Method']).
                ( pkg ~ 'Package ('Just pkgName) ss
                , LookupService ss s ~ 'Service s anns ms
                , Generic t
                , BuildService pro pkgName s p ms (Rep t) )
             => GrpcClient -> t
buildService :: GrpcClient -> t
buildService client :: GrpcClient
client
  = Rep t Any -> t
forall a x. Generic a => Rep a x -> a
to (Proxy pro
-> Proxy pkgName
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> Rep t Any
forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
       (p :: Symbol) (ms :: [Method']) (f :: * -> *) a.
BuildService pro pkg s p ms f =>
Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' (Proxy pro
forall k (t :: k). Proxy t
Proxy @pro) (Proxy pkgName
forall k (t :: k). Proxy t
Proxy @pkgName) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy ms
forall k (t :: k). Proxy t
Proxy @ms) GrpcClient
client)

class BuildService (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
                   (p :: Symbol) (ms :: [Method']) (f :: * -> *) where
  buildService' :: Proxy pro -> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a

instance BuildService pro pkg s p ms U1 where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> U1 a
buildService' _ _ _ _ _ _ = U1 a
forall k (p :: k). U1 p
U1
instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (D1 meta f) where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> D1 meta f a
buildService' ppro :: Proxy pro
ppro ppkg :: Proxy pkg
ppkg ps :: Proxy s
ps ppr :: Proxy p
ppr pms :: Proxy ms
pms client :: GrpcClient
client
    = f a -> D1 meta f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
       (p :: Symbol) (ms :: [Method']) (f :: * -> *) a.
BuildService pro pkg s p ms f =>
Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client)
instance BuildService pro pkg s p ms f => BuildService pro pkg s p ms (C1 meta f) where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> C1 meta f a
buildService' ppro :: Proxy pro
ppro ppkg :: Proxy pkg
ppkg ps :: Proxy s
ps ppr :: Proxy p
ppr pms :: Proxy ms
pms client :: GrpcClient
client
    = f a -> C1 meta f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
       (p :: Symbol) (ms :: [Method']) (f :: * -> *) a.
BuildService pro pkg s p ms f =>
Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client)
instance TypeError ('Text "building a service from sums is not supported")
         => BuildService pro pkg s p ms (f :+: g) where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> (:+:) f g a
buildService' = [Char]
-> Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> (:+:) f g a
forall a. HasCallStack => [Char] -> a
error "this should never happen"
instance (BuildService pro pkg s p ms f, BuildService pro pkg s p ms g)
         => BuildService pro pkg s p ms (f :*: g) where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> (:*:) f g a
buildService' ppro :: Proxy pro
ppro ppkg :: Proxy pkg
ppkg ps :: Proxy s
ps ppr :: Proxy p
ppr pms :: Proxy ms
pms client :: GrpcClient
client
    = Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
       (p :: Symbol) (ms :: [Method']) (f :: * -> *) a.
BuildService pro pkg s p ms f =>
Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> g a
forall (pro :: GRpcMessageProtocol) (pkg :: Symbol) (s :: Symbol)
       (p :: Symbol) (ms :: [Method']) (f :: * -> *) a.
BuildService pro pkg s p ms f =>
Proxy pro
-> Proxy pkg -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client
instance (m ~ AppendSymbol p x, GRpcServiceMethodCall pro pkg sname (LookupMethod ms x) h)
         => BuildService pro pkg sname p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where
  buildService' :: Proxy pro
-> Proxy pkg
-> Proxy sname
-> Proxy p
-> Proxy ms
-> GrpcClient
-> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a
buildService' ppro :: Proxy pro
ppro ppkg :: Proxy pkg
ppkg ps :: Proxy sname
ps _ _ client :: GrpcClient
client
    = K1 i h a -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i h a -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a)
-> K1 i h a -> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a
forall a b. (a -> b) -> a -> b
$ h -> K1 i h a
forall k i c (p :: k). c -> K1 i c p
K1 (h -> K1 i h a) -> h -> K1 i h a
forall a b. (a -> b) -> a -> b
$ Proxy pro
-> Proxy pkg
-> Proxy sname
-> Proxy (LookupMethod ms x)
-> GrpcClient
-> h
forall snm mnm anm (p :: GRpcMessageProtocol) (pkg :: snm)
       (s :: snm) (m :: Method snm mnm anm) h.
GRpcServiceMethodCall p pkg s m h =>
Proxy p -> Proxy pkg -> Proxy s -> Proxy m -> GrpcClient -> h
gRpcServiceMethodCall Proxy pro
ppro Proxy pkg
ppkg Proxy sname
ps (Proxy (LookupMethod ms x)
forall k (t :: k). Proxy t
Proxy @(LookupMethod ms x)) GrpcClient
client

-- TEMPLATE HASKELL
-- ================

-- | Generate the plain Haskell record corresponding to
--   a Mu 'Service' definition, and a concrete implementation
--   of 'buildService' for that record.
generateRecordFromService :: String -> String -> Namer -> Name -> Q [Dec]
generateRecordFromService :: [Char] -> [Char] -> Namer -> Name -> Q [Dec]
generateRecordFromService newRecordName :: [Char]
newRecordName fieldsPrefix :: [Char]
fieldsPrefix tNamer :: Namer
tNamer serviceTyName :: Name
serviceTyName
  = do let serviceTy :: Type
serviceTy = Name -> Type
ConT Name
serviceTyName
       Maybe (Service [Char] [Char] [Char])
srvDef <- Type -> Q (Maybe (Service [Char] [Char] [Char]))
typeToServiceDef Type
serviceTy
       case Maybe (Service [Char] [Char] [Char])
srvDef of
         Nothing -> [Char] -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "service definition cannot be parsed"
         Just sd :: Service [Char] [Char] [Char]
sd -> Name
-> [Char]
-> [Char]
-> Namer
-> Service [Char] [Char] [Char]
-> Q [Dec]
serviceDefToDecl Name
serviceTyName [Char]
newRecordName [Char]
fieldsPrefix Namer
tNamer Service [Char] [Char] [Char]
sd

type Namer = String -> String

serviceDefToDecl :: Name -> String -> String -> Namer -> Service String String String -> Q [Dec]
serviceDefToDecl :: Name
-> [Char]
-> [Char]
-> Namer
-> Service [Char] [Char] [Char]
-> Q [Dec]
serviceDefToDecl serviceTyName :: Name
serviceTyName complete :: [Char]
complete fieldsPrefix :: [Char]
fieldsPrefix tNamer :: Namer
tNamer (Service _ _ methods :: [Method [Char] [Char] [Char]]
methods)
  = do Dec
d <- CxtQ
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [ConQ]
-> [DerivClauseQ]
-> DecQ
dataD ([Type] -> CxtQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
                  ([Char] -> Name
mkName [Char]
complete)
                  []
                  Maybe Type
forall a. Maybe a
Nothing
                  [Name -> [VarBangType] -> Con
RecC ([Char] -> Name
mkName [Char]
complete) ([VarBangType] -> Con) -> Q [VarBangType] -> ConQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Method [Char] [Char] [Char] -> Q VarBangType)
-> [Method [Char] [Char] [Char]] -> Q [VarBangType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> Namer -> Method [Char] [Char] [Char] -> Q VarBangType
methodToDecl [Char]
fieldsPrefix Namer
tNamer) [Method [Char] [Char] [Char]]
methods]
                  [DerivClause -> DerivClauseQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DerivStrategy -> [Type] -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Type
ConT ''Generic])]
       let buildName :: Name
buildName = [Char] -> Name
mkName ("build" [Char] -> Namer
forall a. [a] -> [a] -> [a]
++ [Char]
complete)
       Dec
s <- Name -> Type -> Dec
SigD Name
buildName (Type -> Dec) -> Q Type -> DecQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [t|GrpcClient -> $(pure (ConT (mkName complete)))|]
       Clause
c <- [Pat] -> Body -> [Dec] -> Clause
Clause ([Pat] -> Body -> [Dec] -> Clause)
-> Q [Pat] -> Q (Body -> [Dec] -> Clause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pat] -> Q [Pat]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                   Q (Body -> [Dec] -> Clause) -> Q Body -> Q ([Dec] -> Clause)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Exp -> Body
NormalB (Exp -> Body) -> Q Exp -> Q Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e|buildService @($(pure $ ConT serviceTyName))
                                                    @($(pure $ LitT (StrTyLit fieldsPrefix)))|])
                   Q ([Dec] -> Clause) -> Q [Dec] -> Q Clause
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
       [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
d, Dec
s, Name -> [Clause] -> Dec
FunD Name
buildName [Clause
c]]

methodToDecl :: String -> Namer -> Method String String String -> Q (Name, Bang, Type)
methodToDecl :: [Char] -> Namer -> Method [Char] [Char] [Char] -> Q VarBangType
methodToDecl fieldsPrefix :: [Char]
fieldsPrefix tNamer :: Namer
tNamer (Method mName :: [Char]
mName _ args :: [Argument [Char] [Char]]
args ret :: Return [Char]
ret)
  = do let nm :: [Char]
nm = Namer
firstLower ([Char]
fieldsPrefix [Char] -> Namer
forall a. [a] -> [a] -> [a]
++ [Char]
mName)
       Type
ty <- Namer -> [Argument [Char] [Char]] -> Return [Char] -> Q Type
computeMethodType Namer
tNamer [Argument [Char] [Char]]
args Return [Char]
ret
       VarBangType -> Q VarBangType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( [Char] -> Name
mkName [Char]
nm, SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Type
ty )

computeMethodType :: Namer -> [Argument String String] -> Return String -> Q Type
computeMethodType :: Namer -> [Argument [Char] [Char]] -> Return [Char] -> Q Type
computeMethodType _ [] RetNothing
  = [t|IO (GRpcReply ())|]
computeMethodType n :: Namer
n [] (RetSingle r :: TypeRef [Char]
r)
  = [t|IO (GRpcReply $(typeRefToType n r))|]
computeMethodType n :: Namer
n [ArgSingle _ _ v :: TypeRef [Char]
v] RetNothing
  = [t|$(typeRefToType n v) -> IO (GRpcReply ())|]
computeMethodType n :: Namer
n [ArgSingle _ _ v :: TypeRef [Char]
v] (RetSingle r :: TypeRef [Char]
r)
  = [t|$(typeRefToType n v) -> IO (GRpcReply $(typeRefToType n r))|]
computeMethodType n :: Namer
n [ArgStream _ _ v :: TypeRef [Char]
v] (RetSingle r :: TypeRef [Char]
r)
  = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) Void IO (GRpcReply $(typeRefToType n r)))|]
computeMethodType n :: Namer
n [ArgSingle _ _ v :: TypeRef [Char]
v] (RetStream r :: TypeRef [Char]
r)
  = [t|$(typeRefToType n v) -> IO (ConduitT () (GRpcReply $(typeRefToType n r)) IO ())|]
computeMethodType n :: Namer
n [ArgStream _ _ v :: TypeRef [Char]
v] (RetStream r :: TypeRef [Char]
r)
  = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) (GRpcReply $(typeRefToType n r)) IO ())|]
computeMethodType _ _ _ = [Char] -> Q Type
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail "method signature not supported"

typeRefToType :: Namer -> TypeRef snm -> Q Type
typeRefToType :: Namer -> TypeRef snm -> Q Type
typeRefToType tNamer :: Namer
tNamer (THRef (LitT (StrTyLit s :: [Char]
s)))
  = Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ([Char] -> Name
mkName ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ Namer -> Namer
completeName Namer
tNamer [Char]
s)
typeRefToType _tNamer :: Namer
_tNamer (THRef ty :: Type
ty)
  = Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ty
typeRefToType _ _ = [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error "this should never happen"

completeName :: Namer -> String -> String
completeName :: Namer -> Namer
completeName namer :: Namer
namer name :: [Char]
name = Namer
firstUpper (Namer
namer (Namer
firstUpper [Char]
name))

firstUpper :: String -> String
firstUpper :: Namer
firstUpper []       = Namer
forall a. HasCallStack => [Char] -> a
error "Empty names are not allowed"
firstUpper (x :: Char
x:rest :: [Char]
rest) = Char -> Char
toUpper Char
x Char -> Namer
forall a. a -> [a] -> [a]
: [Char]
rest

firstLower :: String -> String
firstLower :: Namer
firstLower []       = Namer
forall a. HasCallStack => [Char] -> a
error "Empty names are not allowed"
firstLower (x :: Char
x:rest :: [Char]
rest) = Char -> Char
toLower Char
x Char -> Namer
forall a. a -> [a] -> [a]
: [Char]
rest

-- Parsing
-- =======

typeToServiceDef :: Type -> Q (Maybe (Service String String String))
typeToServiceDef :: Type -> Q (Maybe (Service [Char] [Char] [Char]))
typeToServiceDef toplevelty :: Type
toplevelty
  = Type -> Maybe (Service [Char] [Char] [Char])
typeToServiceDef' (Type -> Maybe (Service [Char] [Char] [Char]))
-> Q Type -> Q (Maybe (Service [Char] [Char] [Char]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Type
resolveTypeSynonyms Type
toplevelty
  where
    typeToServiceDef' :: Type -> Maybe (Service String String String)
    typeToServiceDef' :: Type -> Maybe (Service [Char] [Char] [Char])
typeToServiceDef' expanded :: Type
expanded
      = do (sn :: Type
sn, _, methods :: Type
methods) <- Name -> Type -> Maybe (Type, Type, Type)
tyD3 'Service Type
expanded
           [Type]
methods' <- Type -> Maybe [Type]
tyList Type
methods
           [Char]
-> [*]
-> [Method [Char] [Char] [Char]]
-> Service [Char] [Char] [Char]
forall serviceName methodName argName.
serviceName
-> [*]
-> [Method serviceName methodName argName]
-> Service serviceName methodName argName
Service ([Char]
 -> [*]
 -> [Method [Char] [Char] [Char]]
 -> Service [Char] [Char] [Char])
-> Maybe [Char]
-> Maybe
     ([*]
      -> [Method [Char] [Char] [Char]] -> Service [Char] [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
sn
                   Maybe
  ([*]
   -> [Method [Char] [Char] [Char]] -> Service [Char] [Char] [Char])
-> Maybe [*]
-> Maybe
     ([Method [Char] [Char] [Char]] -> Service [Char] [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [*] -> Maybe [*]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                   Maybe
  ([Method [Char] [Char] [Char]] -> Service [Char] [Char] [Char])
-> Maybe [Method [Char] [Char] [Char]]
-> Maybe (Service [Char] [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe (Method [Char] [Char] [Char]))
-> [Type] -> Maybe [Method [Char] [Char] [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Method [Char] [Char] [Char])
typeToMethodDef [Type]
methods'

    typeToMethodDef :: Type -> Maybe (Method String String String)
    typeToMethodDef :: Type -> Maybe (Method [Char] [Char] [Char])
typeToMethodDef ty :: Type
ty
      = do (mn :: Type
mn, _, args :: Type
args, ret :: Type
ret) <- Name -> Type -> Maybe (Type, Type, Type, Type)
tyD4 'Method Type
ty
           [Type]
args' <- Type -> Maybe [Type]
tyList Type
args
           [Char]
-> [*]
-> [Argument [Char] [Char]]
-> Return [Char]
-> Method [Char] [Char] [Char]
forall serviceName methodName argName.
methodName
-> [*]
-> [Argument serviceName argName]
-> Return serviceName
-> Method serviceName methodName argName
Method ([Char]
 -> [*]
 -> [Argument [Char] [Char]]
 -> Return [Char]
 -> Method [Char] [Char] [Char])
-> Maybe [Char]
-> Maybe
     ([*]
      -> [Argument [Char] [Char]]
      -> Return [Char]
      -> Method [Char] [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
mn
                  Maybe
  ([*]
   -> [Argument [Char] [Char]]
   -> Return [Char]
   -> Method [Char] [Char] [Char])
-> Maybe [*]
-> Maybe
     ([Argument [Char] [Char]]
      -> Return [Char] -> Method [Char] [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [*] -> Maybe [*]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                  Maybe
  ([Argument [Char] [Char]]
   -> Return [Char] -> Method [Char] [Char] [Char])
-> Maybe [Argument [Char] [Char]]
-> Maybe (Return [Char] -> Method [Char] [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe (Argument [Char] [Char]))
-> [Type] -> Maybe [Argument [Char] [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Argument [Char] [Char])
typeToArgDef [Type]
args'
                  Maybe (Return [Char] -> Method [Char] [Char] [Char])
-> Maybe (Return [Char]) -> Maybe (Method [Char] [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe (Return [Char])
typeToRetDef Type
ret

    typeToArgDef :: Type -> Maybe (Argument String String)
    typeToArgDef :: Type -> Maybe (Argument [Char] [Char])
typeToArgDef ty :: Type
ty
      =   (do (n :: Type
n, _, t :: Type
t) <- Name -> Type -> Maybe (Type, Type, Type)
tyD3 'ArgSingle Type
ty
              Maybe [Char] -> [*] -> TypeRef [Char] -> Argument [Char] [Char]
forall argName serviceName.
Maybe argName
-> [*] -> TypeRef serviceName -> Argument serviceName argName
ArgSingle (Maybe [Char] -> [*] -> TypeRef [Char] -> Argument [Char] [Char])
-> Maybe (Maybe [Char])
-> Maybe ([*] -> TypeRef [Char] -> Argument [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe (Maybe [Char])
tyMaybeString Type
n Maybe ([*] -> TypeRef [Char] -> Argument [Char] [Char])
-> Maybe [*] -> Maybe (TypeRef [Char] -> Argument [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [*] -> Maybe [*]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] Maybe (TypeRef [Char] -> Argument [Char] [Char])
-> Maybe (TypeRef [Char]) -> Maybe (Argument [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef Type
t)
      Maybe (Argument [Char] [Char])
-> Maybe (Argument [Char] [Char]) -> Maybe (Argument [Char] [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do (n :: Type
n, _, t :: Type
t) <- Name -> Type -> Maybe (Type, Type, Type)
tyD3 'ArgStream Type
ty
              Maybe [Char] -> [*] -> TypeRef [Char] -> Argument [Char] [Char]
forall argName serviceName.
Maybe argName
-> [*] -> TypeRef serviceName -> Argument serviceName argName
ArgStream (Maybe [Char] -> [*] -> TypeRef [Char] -> Argument [Char] [Char])
-> Maybe (Maybe [Char])
-> Maybe ([*] -> TypeRef [Char] -> Argument [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe (Maybe [Char])
tyMaybeString Type
n Maybe ([*] -> TypeRef [Char] -> Argument [Char] [Char])
-> Maybe [*] -> Maybe (TypeRef [Char] -> Argument [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [*] -> Maybe [*]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] Maybe (TypeRef [Char] -> Argument [Char] [Char])
-> Maybe (TypeRef [Char]) -> Maybe (Argument [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef Type
t)

    typeToRetDef :: Type -> Maybe (Return String)
    typeToRetDef :: Type -> Maybe (Return [Char])
typeToRetDef ty :: Type
ty
      =   Return [Char]
forall serviceName. Return serviceName
RetNothing Return [Char] -> Maybe () -> Maybe (Return [Char])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name -> Type -> Maybe ()
tyD0 'RetNothing Type
ty
      Maybe (Return [Char])
-> Maybe (Return [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeRef [Char] -> Return [Char]
forall serviceName. TypeRef serviceName -> Return serviceName
RetSingle (TypeRef [Char] -> Return [Char])
-> Maybe (TypeRef [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Type -> Maybe Type
tyD1 'RetSingle Type
ty Maybe Type
-> (Type -> Maybe (TypeRef [Char])) -> Maybe (TypeRef [Char])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef)
      Maybe (Return [Char])
-> Maybe (Return [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do (e :: Type
e, v :: Type
v) <- Name -> Type -> Maybe (Type, Type)
tyD2 'RetThrows Type
ty
              TypeRef [Char] -> TypeRef [Char] -> Return [Char]
forall serviceName.
TypeRef serviceName -> TypeRef serviceName -> Return serviceName
RetThrows (TypeRef [Char] -> TypeRef [Char] -> Return [Char])
-> Maybe (TypeRef [Char])
-> Maybe (TypeRef [Char] -> Return [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef Type
e Maybe (TypeRef [Char] -> Return [Char])
-> Maybe (TypeRef [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef Type
v)
      Maybe (Return [Char])
-> Maybe (Return [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeRef [Char] -> Return [Char]
forall serviceName. TypeRef serviceName -> Return serviceName
RetStream (TypeRef [Char] -> Return [Char])
-> Maybe (TypeRef [Char]) -> Maybe (Return [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Type -> Maybe Type
tyD1 'RetStream Type
ty Maybe Type
-> (Type -> Maybe (TypeRef [Char])) -> Maybe (TypeRef [Char])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe (TypeRef [Char])
forall snm. Type -> Maybe (TypeRef snm)
typeToTypeRef)

    typeToTypeRef :: Type -> Maybe (TypeRef snm)
    typeToTypeRef :: Type -> Maybe (TypeRef snm)
typeToTypeRef ty :: Type
ty
      =   (do (_,innerTy :: Type
innerTy) <- Name -> Type -> Maybe (Type, Type)
tyD2 'SchemaRef Type
ty
              TypeRef snm -> Maybe (TypeRef snm)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> TypeRef snm
forall serviceName. Type -> TypeRef serviceName
THRef Type
innerTy))
      Maybe (TypeRef snm) -> Maybe (TypeRef snm) -> Maybe (TypeRef snm)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do (_,innerTy :: Type
innerTy,_) <- Name -> Type -> Maybe (Type, Type, Type)
tyD3 'RegistryRef Type
ty
              TypeRef snm -> Maybe (TypeRef snm)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> TypeRef snm
forall serviceName. Type -> TypeRef serviceName
THRef Type
innerTy))

tyMaybeString :: Type -> Maybe (Maybe String)
tyMaybeString :: Type -> Maybe (Maybe [Char])
tyMaybeString (PromotedT c :: Name
c)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== 'Nothing
  = Maybe [Char] -> Maybe (Maybe [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
tyMaybeString (AppT (PromotedT c :: Name
c) r :: Type
r)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== 'Just
  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
r
tyMaybeString _
  = Maybe (Maybe [Char])
forall a. Maybe a
Nothing

tyString :: Type -> Maybe String
tyString :: Type -> Maybe [Char]
tyString (SigT t :: Type
t _)
  = Type -> Maybe [Char]
tyString Type
t
tyString (LitT (StrTyLit s :: [Char]
s))
  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
tyString _
  = Maybe [Char]
forall a. Maybe a
Nothing

tyList :: Type -> Maybe [Type]
tyList :: Type -> Maybe [Type]
tyList (SigT t :: Type
t _)
  = Type -> Maybe [Type]
tyList Type
t
tyList PromotedNilT
  = [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just []
tyList (AppT (AppT PromotedConsT ty :: Type
ty) rest :: Type
rest)
  = (Type
ty Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:) ([Type] -> [Type]) -> Maybe [Type] -> Maybe [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Type]
tyList Type
rest
tyList _ = Maybe [Type]
forall a. Maybe a
Nothing

tyD0 :: Name -> Type -> Maybe ()
tyD0 :: Name -> Type -> Maybe ()
tyD0 name :: Name
name (SigT t :: Type
t _) = Name -> Type -> Maybe ()
tyD0 Name
name Type
t
tyD0 name :: Name
name (PromotedT c :: Name
c)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  | Bool
otherwise = Maybe ()
forall a. Maybe a
Nothing
tyD0 _ _ = Maybe ()
forall a. Maybe a
Nothing

tyD1 :: Name -> Type -> Maybe Type
tyD1 :: Name -> Type -> Maybe Type
tyD1 name :: Name
name (SigT t :: Type
t _) = Name -> Type -> Maybe Type
tyD1 Name
name Type
t
tyD1 name :: Name
name (AppT (PromotedT c :: Name
c) x :: Type
x)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = Type -> Maybe Type
forall a. a -> Maybe a
Just Type
x
  | Bool
otherwise = Maybe Type
forall a. Maybe a
Nothing
tyD1 _ _ = Maybe Type
forall a. Maybe a
Nothing

tyD2 :: Name -> Type -> Maybe (Type, Type)
tyD2 :: Name -> Type -> Maybe (Type, Type)
tyD2 name :: Name
name (SigT t :: Type
t _) = Name -> Type -> Maybe (Type, Type)
tyD2 Name
name Type
t
tyD2 name :: Name
name (AppT (AppT (PromotedT c :: Name
c) x :: Type
x) y :: Type
y)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y)
  | Bool
otherwise = Maybe (Type, Type)
forall a. Maybe a
Nothing
tyD2 _ _ = Maybe (Type, Type)
forall a. Maybe a
Nothing

tyD3 :: Name -> Type -> Maybe (Type, Type, Type)
tyD3 :: Name -> Type -> Maybe (Type, Type, Type)
tyD3 name :: Name
name (SigT t :: Type
t _) = Name -> Type -> Maybe (Type, Type, Type)
tyD3 Name
name Type
t
tyD3 name :: Name
name (AppT (AppT (AppT (PromotedT c :: Name
c) x :: Type
x) y :: Type
y) z :: Type
z)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = (Type, Type, Type) -> Maybe (Type, Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y, Type
z)
  | Bool
otherwise = Maybe (Type, Type, Type)
forall a. Maybe a
Nothing
tyD3 _ _ = Maybe (Type, Type, Type)
forall a. Maybe a
Nothing

tyD4 :: Name -> Type -> Maybe (Type, Type, Type, Type)
tyD4 :: Name -> Type -> Maybe (Type, Type, Type, Type)
tyD4 name :: Name
name (SigT t :: Type
t _) = Name -> Type -> Maybe (Type, Type, Type, Type)
tyD4 Name
name Type
t
tyD4 name :: Name
name (AppT (AppT (AppT (AppT (PromotedT c :: Name
c) x :: Type
x) y :: Type
y) z :: Type
z) u :: Type
u)
  | Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = (Type, Type, Type, Type) -> Maybe (Type, Type, Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y, Type
z, Type
u)
  | Bool
otherwise = Maybe (Type, Type, Type, Type)
forall a. Maybe a
Nothing
tyD4 _ _ = Maybe (Type, Type, Type, Type)
forall a. Maybe a
Nothing