{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TemplateHaskell #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Mu.GRpc.Client.Record (
GrpcClient
, GrpcClientConfig
, grpcClientConfigSimple
, setupGrpcClient'
, 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
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
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
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