{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.AWS.Easy.TH
( wrapAWSService
) where
import Language.Haskell.TH
import Network.AWS (Service)
import Network.AWS.Easy.Classes
import Network.AWS.Easy.Types
wrapAWSService ::
Name
-> String
-> String
-> Q [Dec]
wrapAWSService :: Name -> String -> String -> Q [Dec]
wrapAWSService Name
varN String
serviceTypeName String
sessionTypeName = do
Name
serviceVarN <- String -> Q Name
newName String
"x"
Name
sessionVarN <- String -> Q Name
newName String
"x"
let serviceN :: Name
serviceN = String -> Name
mkName String
serviceTypeName
sessionN :: Name
sessionN = String -> Name
mkName String
sessionTypeName
wrappedVarN :: Name
wrappedVarN = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
varN String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Service"
serviceD :: Dec
serviceD = Cxt
-> Name
-> [TyVarBndr]
-> Maybe Kind
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
serviceN [] Maybe Kind
forall a. Maybe a
Nothing [Name -> [BangType] -> Con
NormalC Name
serviceN [(SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Name -> Kind
ConT ''Service)]] []
sessionD :: Dec
sessionD = Cxt
-> Name
-> [TyVarBndr]
-> Maybe Kind
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
sessionN [] Maybe Kind
forall a. Maybe a
Nothing [Name -> [BangType] -> Con
NormalC Name
sessionN [(SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness SourceStrictness
NoSourceStrictness, Name -> Kind
ConT ''Session)]] []
serviceInst :: Dec
serviceInst = Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
InstanceD
Maybe Overlap
forall a. Maybe a
Nothing
[]
(Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''ServiceClass) (Name -> Kind
ConT Name
serviceN))
[ Name -> Name -> Dec
mkTySynInstD Name
serviceN Name
sessionN
, Name -> [Clause] -> Dec
FunD 'rawService [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
ConP Name
serviceN [Name -> Pat
VarP Name
serviceVarN]] (Exp -> Body
NormalB (Name -> Exp
VarE Name
serviceVarN)) []]
, Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP 'wrappedSession) (Exp -> Body
NormalB (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
sessionTypeName)) []
]
sessionInst :: Dec
sessionInst = Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
InstanceD
Maybe Overlap
forall a. Maybe a
Nothing
[]
(Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''SessionClass) (Name -> Kind
ConT Name
sessionN))
[ Name -> [Clause] -> Dec
FunD 'rawSession [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
ConP Name
sessionN [Name -> Pat
VarP Name
sessionVarN]] (Exp -> Body
NormalB (Name -> Exp
VarE Name
sessionVarN)) []]
]
sig :: Dec
sig = Name -> Kind -> Dec
SigD Name
wrappedVarN (Name -> Kind
ConT Name
serviceN)
var :: Dec
var = Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
wrappedVarN) (Exp -> Body
NormalB (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE Name
serviceN) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ Name
varN))) []
[Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ Dec
serviceD
, Dec
sessionD
, Dec
serviceInst
, Dec
sessionInst
, Dec
sig
, Dec
var
]
mkTySynInstD :: Name -> Name -> Dec
#if __GLASGOW_HASKELL__ >= 810
mkTySynInstD :: Name -> Name -> Dec
mkTySynInstD Name
serviceN Name
sessionN = TySynEqn -> Dec
TySynInstD (Maybe [TyVarBndr] -> Kind -> Kind -> TySynEqn
TySynEqn Maybe [TyVarBndr]
forall a. Maybe a
Nothing (Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''TypedSession) (Name -> Kind
ConT Name
serviceN)) (Name -> Kind
ConT Name
sessionN))
#else
mkTySynInstD serviceN sessionN = TySynInstD ''TypedSession (TySynEqn [ConT serviceN] (ConT sessionN))
#endif