{-# 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'
, setupGrpcClientZipkin
  -- * 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'])
                (ms :: [Method']).
                ( pkg ~ 'Package ('Just pkgName) ss
                , LookupService ss s ~ 'Service s ms
                , Generic t
                , BuildService pro pkgName s p ms (Rep t) )
             => GrpcClient -> t
buildService :: GrpcClient -> t
buildService 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' Proxy pro
_ Proxy pkg
_ Proxy s
_ Proxy p
_ Proxy ms
_ GrpcClient
_ = 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' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms 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' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms 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 [Char]
"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' Proxy pro
ppro Proxy pkg
ppkg Proxy s
ps Proxy p
ppr Proxy ms
pms 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' Proxy pro
ppro Proxy pkg
ppkg Proxy sname
ps Proxy p
_ Proxy ms
_ 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 (TypeRef snm)) 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 [Char]
newRecordName [Char]
fieldsPrefix Namer
tNamer Name
serviceTyName
  = do let serviceTy :: Type
serviceTy = Name -> Type
ConT Name
serviceTyName
       Maybe (Service [Char] [Char] [Char] (TypeRef Any))
srvDef <- Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef Any)))
forall snm.
Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm)))
typeToServiceDef Type
serviceTy
       case Maybe (Service [Char] [Char] [Char] (TypeRef Any))
srvDef of
         Maybe (Service [Char] [Char] [Char] (TypeRef Any))
Nothing -> [Char] -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"service definition cannot be parsed"
         Just Service [Char] [Char] [Char] (TypeRef Any)
sd -> Name
-> [Char]
-> [Char]
-> Namer
-> Service [Char] [Char] [Char] (TypeRef Any)
-> Q [Dec]
forall snm.
Name
-> [Char]
-> [Char]
-> Namer
-> Service [Char] [Char] [Char] (TypeRef snm)
-> Q [Dec]
serviceDefToDecl Name
serviceTyName [Char]
newRecordName [Char]
fieldsPrefix Namer
tNamer Service [Char] [Char] [Char] (TypeRef Any)
sd

type Namer = String -> String

serviceDefToDecl :: Name -> String -> String -> Namer
                 -> Service String String String (TypeRef snm)
                 -> Q [Dec]
serviceDefToDecl :: Name
-> [Char]
-> [Char]
-> Namer
-> Service [Char] [Char] [Char] (TypeRef snm)
-> Q [Dec]
serviceDefToDecl Name
serviceTyName [Char]
complete [Char]
fieldsPrefix Namer
tNamer (Service [Char]
_ [Method [Char] [Char] [Char] (TypeRef snm)]
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] (TypeRef snm) -> Q VarBangType)
-> [Method [Char] [Char] [Char] (TypeRef snm)] -> 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] (TypeRef snm)
-> Q VarBangType
forall snm.
[Char]
-> Namer
-> Method [Char] [Char] [Char] (TypeRef snm)
-> Q VarBangType
methodToDecl [Char]
fieldsPrefix Namer
tNamer) [Method [Char] [Char] [Char] (TypeRef snm)]
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 ([Char]
"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 [] (Body -> [Dec] -> Clause) -> Q Body -> Q ([Dec] -> Clause)
forall (f :: * -> *) a b. Functor 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 @ $(conT serviceTyName)
                                                       @ $(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 (TypeRef snm)
             -> Q (Name, Bang, Type)
methodToDecl :: [Char]
-> Namer
-> Method [Char] [Char] [Char] (TypeRef snm)
-> Q VarBangType
methodToDecl [Char]
fieldsPrefix Namer
tNamer (Method [Char]
mName [Argument [Char] [Char] (TypeRef snm)]
args Return [Char] (TypeRef snm)
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] (TypeRef snm)]
-> Return [Char] (TypeRef snm)
-> Q Type
forall snm.
Namer
-> [Argument [Char] [Char] (TypeRef snm)]
-> Return [Char] (TypeRef snm)
-> Q Type
computeMethodType Namer
tNamer [Argument [Char] [Char] (TypeRef snm)]
args Return [Char] (TypeRef snm)
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 (TypeRef snm)]
                  -> Return String (TypeRef snm)
                  -> Q Type
computeMethodType :: Namer
-> [Argument [Char] [Char] (TypeRef snm)]
-> Return [Char] (TypeRef snm)
-> Q Type
computeMethodType Namer
_ [] Return [Char] (TypeRef snm)
RetNothing
  = [t|IO (GRpcReply ())|]
computeMethodType Namer
n [] (RetSingle TypeRef snm
r)
  = [t|IO (GRpcReply $(typeRefToType n r))|]
computeMethodType Namer
n [ArgSingle Maybe [Char]
_ TypeRef snm
v] Return [Char] (TypeRef snm)
RetNothing
  = [t|$(typeRefToType n v) -> IO (GRpcReply ())|]
computeMethodType Namer
n [ArgSingle Maybe [Char]
_ TypeRef snm
v] (RetSingle TypeRef snm
r)
  = [t|$(typeRefToType n v) -> IO (GRpcReply $(typeRefToType n r))|]
computeMethodType Namer
n [ArgStream Maybe [Char]
_ TypeRef snm
v] (RetSingle TypeRef snm
r)
  = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) Void IO (GRpcReply $(typeRefToType n r)))|]
computeMethodType Namer
n [ArgSingle Maybe [Char]
_ TypeRef snm
v] (RetStream TypeRef snm
r)
  = [t|$(typeRefToType n v) -> IO (ConduitT () (GRpcReply $(typeRefToType n r)) IO ())|]
computeMethodType Namer
n [ArgStream Maybe [Char]
_ TypeRef snm
v] (RetStream TypeRef snm
r)
  = [t|CompressMode -> IO (ConduitT $(typeRefToType n v) (GRpcReply $(typeRefToType n r)) IO ())|]
computeMethodType Namer
_ [Argument [Char] [Char] (TypeRef snm)]
_ Return [Char] (TypeRef snm)
_ = [Char] -> Q Type
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"method signature not supported"

typeRefToType :: Namer -> TypeRef snm -> Q Type
typeRefToType :: Namer -> TypeRef snm -> Q Type
typeRefToType Namer
tNamer (THRef (LitT (StrTyLit [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 Namer
_tNamer (THRef Type
ty)
  = Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ty
typeRefToType Namer
_ TypeRef snm
_ = [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"this should never happen"

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

firstUpper :: String -> String
firstUpper :: Namer
firstUpper []       = Namer
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty names are not allowed"
firstUpper (Char
x:[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 [Char]
"Empty names are not allowed"
firstLower (Char
x:[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 (TypeRef snm)))
typeToServiceDef :: Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm)))
typeToServiceDef Type
toplevelty
  = Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm))
forall snm.
Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm))
typeToServiceDef' (Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm)))
-> Q Type -> Q (Maybe (Service [Char] [Char] [Char] (TypeRef snm)))
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 (TypeRef snm))
    typeToServiceDef' :: Type -> Maybe (Service [Char] [Char] [Char] (TypeRef snm))
typeToServiceDef' Type
expanded
      = do (Type
sn, Type
_, 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] (TypeRef snm)]
-> Service [Char] [Char] [Char] (TypeRef snm)
forall serviceName methodName argName tyRef.
serviceName
-> [Method serviceName methodName argName tyRef]
-> Service serviceName methodName argName tyRef
Service ([Char]
 -> [Method [Char] [Char] [Char] (TypeRef snm)]
 -> Service [Char] [Char] [Char] (TypeRef snm))
-> Maybe [Char]
-> Maybe
     ([Method [Char] [Char] [Char] (TypeRef snm)]
      -> Service [Char] [Char] [Char] (TypeRef snm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
sn
                   Maybe
  ([Method [Char] [Char] [Char] (TypeRef snm)]
   -> Service [Char] [Char] [Char] (TypeRef snm))
-> Maybe [Method [Char] [Char] [Char] (TypeRef snm)]
-> Maybe (Service [Char] [Char] [Char] (TypeRef snm))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm)))
-> [Type] -> Maybe [Method [Char] [Char] [Char] (TypeRef snm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm))
forall snm.
Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm))
typeToMethodDef [Type]
methods'

    typeToMethodDef :: Type -> Maybe (Method String String String (TypeRef snm))
    typeToMethodDef :: Type -> Maybe (Method [Char] [Char] [Char] (TypeRef snm))
typeToMethodDef Type
ty
      = do (Type
mn, Type
_, Type
args, 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] (TypeRef snm)]
-> Return [Char] (TypeRef snm)
-> Method [Char] [Char] [Char] (TypeRef snm)
forall k (serviceName :: k) methodName argName tyRef.
methodName
-> [Argument serviceName argName tyRef]
-> Return serviceName tyRef
-> Method serviceName methodName argName tyRef
Method ([Char]
 -> [Argument [Char] [Char] (TypeRef snm)]
 -> Return [Char] (TypeRef snm)
 -> Method [Char] [Char] [Char] (TypeRef snm))
-> Maybe [Char]
-> Maybe
     ([Argument [Char] [Char] (TypeRef snm)]
      -> Return [Char] (TypeRef snm)
      -> Method [Char] [Char] [Char] (TypeRef snm))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
mn
                  Maybe
  ([Argument [Char] [Char] (TypeRef snm)]
   -> Return [Char] (TypeRef snm)
   -> Method [Char] [Char] [Char] (TypeRef snm))
-> Maybe [Argument [Char] [Char] (TypeRef snm)]
-> Maybe
     (Return [Char] (TypeRef snm)
      -> Method [Char] [Char] [Char] (TypeRef snm))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe (Argument [Char] [Char] (TypeRef snm)))
-> [Type] -> Maybe [Argument [Char] [Char] (TypeRef snm)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Argument [Char] [Char] (TypeRef snm))
forall snm. Type -> Maybe (Argument [Char] [Char] (TypeRef snm))
typeToArgDef [Type]
args'
                  Maybe
  (Return [Char] (TypeRef snm)
   -> Method [Char] [Char] [Char] (TypeRef snm))
-> Maybe (Return [Char] (TypeRef snm))
-> Maybe (Method [Char] [Char] [Char] (TypeRef snm))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe (Return [Char] (TypeRef snm))
forall snm. Type -> Maybe (Return [Char] (TypeRef snm))
typeToRetDef Type
ret

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

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

    typeToTypeRef :: Type -> Maybe (TypeRef snm)
    typeToTypeRef :: Type -> Maybe (TypeRef snm)
typeToTypeRef Type
ty
      =   (do (Type
_,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 (Type
_,Type
innerTy,Type
_) <- 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 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 Name
c) 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 Type
_
  = Maybe (Maybe [Char])
forall a. Maybe a
Nothing

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

tyList :: Type -> Maybe [Type]
tyList :: Type -> Maybe [Type]
tyList (SigT Type
t Type
_)
  = Type -> Maybe [Type]
tyList Type
t
tyList Type
PromotedNilT
  = [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just []
tyList (AppT (AppT Type
PromotedConsT Type
ty) 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 Type
_ = Maybe [Type]
forall a. Maybe a
Nothing

tyD0 :: Name -> Type -> Maybe ()
tyD0 :: Name -> Type -> Maybe ()
tyD0 Name
name (SigT Type
t Type
_) = Name -> Type -> Maybe ()
tyD0 Name
name Type
t
tyD0 Name
name (PromotedT 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 Name
_ Type
_ = Maybe ()
forall a. Maybe a
Nothing

tyD1 :: Name -> Type -> Maybe Type
tyD1 :: Name -> Type -> Maybe Type
tyD1 Name
name (SigT Type
t Type
_) = Name -> Type -> Maybe Type
tyD1 Name
name Type
t
tyD1 Name
name (AppT (PromotedT Name
c) 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 Name
_ Type
_ = Maybe Type
forall a. Maybe a
Nothing

tyD2 :: Name -> Type -> Maybe (Type, Type)
tyD2 :: Name -> Type -> Maybe (Type, Type)
tyD2 Name
name (SigT Type
t Type
_) = Name -> Type -> Maybe (Type, Type)
tyD2 Name
name Type
t
tyD2 Name
name (AppT (AppT (PromotedT Name
c) Type
x) 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 Name
_ Type
_ = 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 (SigT Type
t Type
_) = Name -> Type -> Maybe (Type, Type, Type)
tyD3 Name
name Type
t
tyD3 Name
name (AppT (AppT (AppT (PromotedT Name
c) Type
x) Type
y) 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 Name
_ Type
_ = 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 (SigT Type
t Type
_) = Name -> Type -> Maybe (Type, Type, Type, Type)
tyD4 Name
name Type
t
tyD4 Name
name (AppT (AppT (AppT (AppT (PromotedT Name
c) Type
x) Type
y) Type
z) 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 Name
_ Type
_ = Maybe (Type, Type, Type, Type)
forall a. Maybe a
Nothing