{-# 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) (s :: Service') (p :: Symbol) t
(nm :: Symbol) (anns :: [ServiceAnnotation]) (ms :: [Method Symbol]).
(s ~ 'Service nm anns ms, Generic t, BuildService pro 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 s -> Proxy p -> Proxy ms -> GrpcClient -> Rep t Any
forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol)
(ms :: [Method Symbol]) (f :: * -> *) a.
BuildService pro s p ms f =>
Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' (Proxy pro
forall k (t :: k). Proxy t
Proxy @pro) (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) (s :: Service')
(p :: Symbol) (ms :: [Method Symbol]) (f :: * -> *) where
buildService' :: Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
instance BuildService pro s p ms U1 where
buildService' :: Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> U1 a
buildService' _ _ _ _ _ = U1 a
forall k (p :: k). U1 p
U1
instance BuildService pro s p ms f => BuildService pro s p ms (D1 meta f) where
buildService' :: Proxy pro
-> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> D1 meta f a
buildService' ppro :: Proxy pro
ppro 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 s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol)
(ms :: [Method Symbol]) (f :: * -> *) a.
BuildService pro s p ms f =>
Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client)
instance BuildService pro s p ms f => BuildService pro s p ms (C1 meta f) where
buildService' :: Proxy pro
-> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> C1 meta f a
buildService' ppro :: Proxy pro
ppro 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 s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol)
(ms :: [Method Symbol]) (f :: * -> *) a.
BuildService pro s p ms f =>
Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client)
instance TypeError ('Text "building a service from sums is not supported")
=> BuildService pro s p ms (f :+: g) where
buildService' :: Proxy pro
-> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> (:+:) f g a
buildService' = [Char]
-> Proxy pro
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> (:+:) f g a
forall a. HasCallStack => [Char] -> a
error "this should never happen"
instance (BuildService pro s p ms f, BuildService pro s p ms g)
=> BuildService pro s p ms (f :*: g) where
buildService' :: Proxy pro
-> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> (:*:) f g a
buildService' ppro :: Proxy pro
ppro ps :: Proxy s
ps ppr :: Proxy p
ppr pms :: Proxy ms
pms client :: GrpcClient
client
= Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol)
(ms :: [Method Symbol]) (f :: * -> *) a.
BuildService pro s p ms f =>
Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro 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 s -> Proxy p -> Proxy ms -> GrpcClient -> g a
forall (pro :: GRpcMessageProtocol) (s :: Service') (p :: Symbol)
(ms :: [Method Symbol]) (f :: * -> *) a.
BuildService pro s p ms f =>
Proxy pro -> Proxy s -> Proxy p -> Proxy ms -> GrpcClient -> f a
buildService' Proxy pro
ppro Proxy s
ps Proxy p
ppr Proxy ms
pms GrpcClient
client
instance (m ~ AppendSymbol p x, GRpcServiceMethodCall pro s (s :-->: x) h)
=> BuildService pro s p ms (S1 ('MetaSel ('Just m) u ss ds) (K1 i h)) where
buildService' :: Proxy pro
-> Proxy s
-> Proxy p
-> Proxy ms
-> GrpcClient
-> S1 ('MetaSel ('Just m) u ss ds) (K1 i h) a
buildService' ppro :: Proxy pro
ppro ps :: Proxy s
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 s -> Proxy (s :-->: x) -> GrpcClient -> h
forall snm mnm (p :: GRpcMessageProtocol) (s :: Service snm mnm)
(m :: Method mnm) h.
GRpcServiceMethodCall p s m h =>
Proxy p -> Proxy s -> Proxy m -> GrpcClient -> h
gRpcServiceMethodCall Proxy pro
ppro Proxy s
ps (Proxy (s :-->: x)
forall k (t :: k). Proxy t
Proxy @(s :-->: 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])
srvDef <- Type -> Q (Maybe (Service [Char] [Char]))
typeToServiceDef Type
serviceTy
case Maybe (Service [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]
sd -> Name
-> [Char] -> [Char] -> Namer -> Service [Char] [Char] -> Q [Dec]
serviceDefToDecl Name
serviceTyName [Char]
newRecordName [Char]
fieldsPrefix Namer
tNamer Service [Char] [Char]
sd
type Namer = String -> String
serviceDefToDecl :: Name -> String -> String -> Namer -> Service String String -> Q [Dec]
serviceDefToDecl :: Name
-> [Char] -> [Char] -> Namer -> Service [Char] [Char] -> Q [Dec]
serviceDefToDecl serviceTyName :: Name
serviceTyName complete :: [Char]
complete fieldsPrefix :: [Char]
fieldsPrefix tNamer :: Namer
tNamer (Service _ _ methods :: [Method [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] -> Q VarBangType)
-> [Method [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] -> Q VarBangType
methodToDecl [Char]
fieldsPrefix Namer
tNamer) [Method [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 -> $(return (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 @($(return $ ConT serviceTyName))
@($(return $ 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 (m :: * -> *) a. Monad m => a -> m a
return [Dec
d, Dec
s, Name -> [Clause] -> Dec
FunD Name
buildName [Clause
c]]
methodToDecl :: String -> Namer -> Method String -> Q (Name, Bang, Type)
methodToDecl :: [Char] -> Namer -> Method [Char] -> Q VarBangType
methodToDecl fieldsPrefix :: [Char]
fieldsPrefix tNamer :: Namer
tNamer (Method mName :: [Char]
mName _ args :: [Argument]
args ret :: Return
ret)
= do let nm :: [Char]
nm = Namer
firstLower ([Char]
fieldsPrefix [Char] -> Namer
forall a. [a] -> [a] -> [a]
++ [Char]
mName)
Type
ty <- Namer -> [Argument] -> Return -> Q Type
computeMethodType Namer
tNamer [Argument]
args Return
ret
VarBangType -> Q VarBangType
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Char] -> Name
mkName [Char]
nm, SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Type
ty )
computeMethodType :: Namer -> [Argument] -> Return -> Q Type
computeMethodType :: Namer -> [Argument] -> Return -> Q Type
computeMethodType _ [] RetNothing
= [t|IO (GRpcReply ())|]
computeMethodType n :: Namer
n [] (RetSingle r :: TypeRef
r)
= [t|IO (GRpcReply $(typeRefToType n r))|]
computeMethodType n :: Namer
n [ArgSingle v :: TypeRef
v] RetNothing
= [t|$(typeRefToType n v) -> IO (GRpcReply ())|]
computeMethodType n :: Namer
n [ArgSingle v :: TypeRef
v] (RetSingle r :: TypeRef
r)
= [t|$(typeRefToType n v) -> IO (GRpcReply $(typeRefToType n r))|]
computeMethodType n :: Namer
n [ArgStream v :: TypeRef
v] (RetSingle r :: TypeRef
r)
= [t|CompressMode -> IO (ConduitT $(typeRefToType n v) Void IO (GRpcReply $(typeRefToType n r)))|]
computeMethodType n :: Namer
n [ArgSingle v :: TypeRef
v] (RetStream r :: TypeRef
r)
= [t|$(typeRefToType n v) -> IO (ConduitT () (GRpcReply $(typeRefToType n r)) IO ())|]
computeMethodType n :: Namer
n [ArgStream v :: TypeRef
v] (RetStream r :: TypeRef
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 -> Q Type
typeRefToType :: Namer -> TypeRef -> Q Type
typeRefToType tNamer :: Namer
tNamer (ViaTH (LitT (StrTyLit s :: [Char]
s)))
= Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (ViaTH ty :: Type
ty)
= Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return 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))
typeToServiceDef :: Type -> Q (Maybe (Service [Char] [Char]))
typeToServiceDef toplevelty :: Type
toplevelty
= Type -> Maybe (Service [Char] [Char])
typeToServiceDef' (Type -> Maybe (Service [Char] [Char]))
-> Q Type -> Q (Maybe (Service [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)
typeToServiceDef' :: Type -> Maybe (Service [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]] -> Service [Char] [Char]
forall serviceName methodName.
serviceName
-> [*] -> [Method methodName] -> Service serviceName methodName
Service ([Char] -> [*] -> [Method [Char]] -> Service [Char] [Char])
-> Maybe [Char]
-> Maybe ([*] -> [Method [Char]] -> Service [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
sn
Maybe ([*] -> [Method [Char]] -> Service [Char] [Char])
-> Maybe [*] -> Maybe ([Method [Char]] -> Service [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]] -> Service [Char] [Char])
-> Maybe [Method [Char]] -> Maybe (Service [Char] [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe (Method [Char])) -> [Type] -> Maybe [Method [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Method [Char])
typeToMethodDef [Type]
methods'
typeToMethodDef :: Type -> Maybe (Method String)
typeToMethodDef :: Type -> Maybe (Method [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] -> Return -> Method [Char]
forall methodName.
methodName -> [*] -> [Argument] -> Return -> Method methodName
Method ([Char] -> [*] -> [Argument] -> Return -> Method [Char])
-> Maybe [Char]
-> Maybe ([*] -> [Argument] -> Return -> Method [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe [Char]
tyString Type
mn
Maybe ([*] -> [Argument] -> Return -> Method [Char])
-> Maybe [*] -> Maybe ([Argument] -> Return -> Method [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] -> Return -> Method [Char])
-> Maybe [Argument] -> Maybe (Return -> Method [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> Maybe Argument) -> [Type] -> Maybe [Argument]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe Argument
typeToArgDef [Type]
args'
Maybe (Return -> Method [Char])
-> Maybe Return -> Maybe (Method [Char])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe Return
typeToRetDef Type
ret
typeToArgDef :: Type -> Maybe Argument
typeToArgDef :: Type -> Maybe Argument
typeToArgDef ty :: Type
ty
= TypeRef -> Argument
ArgSingle (TypeRef -> Argument) -> Maybe TypeRef -> Maybe Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Type -> Maybe Type
tyD1 'ArgSingle Type
ty Maybe Type -> (Type -> Maybe TypeRef) -> Maybe TypeRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe TypeRef
typeToTypeRef)
Maybe Argument -> Maybe Argument -> Maybe Argument
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeRef -> Argument
ArgStream (TypeRef -> Argument) -> Maybe TypeRef -> Maybe Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Type -> Maybe Type
tyD1 'ArgStream Type
ty Maybe Type -> (Type -> Maybe TypeRef) -> Maybe TypeRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe TypeRef
typeToTypeRef)
typeToRetDef :: Type -> Maybe Return
typeToRetDef :: Type -> Maybe Return
typeToRetDef ty :: Type
ty
= Return
RetNothing Return -> Maybe () -> Maybe Return
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name -> Type -> Maybe ()
tyD0 'RetNothing Type
ty
Maybe Return -> Maybe Return -> Maybe Return
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeRef -> Return
RetSingle (TypeRef -> Return) -> Maybe TypeRef -> Maybe Return
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) -> Maybe TypeRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe TypeRef
typeToTypeRef)
Maybe Return -> Maybe Return -> Maybe Return
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 -> TypeRef -> Return
RetThrows (TypeRef -> TypeRef -> Return)
-> Maybe TypeRef -> Maybe (TypeRef -> Return)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe TypeRef
typeToTypeRef Type
e Maybe (TypeRef -> Return) -> Maybe TypeRef -> Maybe Return
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Maybe TypeRef
typeToTypeRef Type
v)
Maybe Return -> Maybe Return -> Maybe Return
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeRef -> Return
RetStream (TypeRef -> Return) -> Maybe TypeRef -> Maybe Return
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) -> Maybe TypeRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Maybe TypeRef
typeToTypeRef)
typeToTypeRef :: Type -> Maybe TypeRef
typeToTypeRef :: Type -> Maybe TypeRef
typeToTypeRef ty :: Type
ty
= (do (_,innerTy :: Type
innerTy) <- Name -> Type -> Maybe (Type, Type)
tyD2 'ViaSchema Type
ty
TypeRef -> Maybe TypeRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TypeRef
ViaTH Type
innerTy))
Maybe TypeRef -> Maybe TypeRef -> Maybe TypeRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do (_,innerTy :: Type
innerTy,_) <- Name -> Type -> Maybe (Type, Type, Type)
tyD3 'ViaRegistry Type
ty
TypeRef -> Maybe TypeRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> TypeRef
ViaTH Type
innerTy))
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