{-|
Module      : Network.AWS.Easy.TH
Description : Template Haskell helpers for @Network.AWS.Easy@
Copyright   : (C) Richard Cook, 2018
License     : MIT
Maintainer  : rcook@rcook.org
Stability   : experimental
Portability : portable

This module provides Template Haskell helper functions for generating type-safe service/session wrappers for @amazonka@.
-}

{-# 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

-- |Generates type-safe AWS service and session wrapper types for use with
-- 'AWSViaHaskell.AWSService.connect' and 'AWSViaHaskell.AWSService.withAWS' functions
--
-- Example top-level invocation:
--
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
-- {-\# LANGUAGE TypeFamilies \#-}
--
-- module MyApp.Services
--     ( DynamoDBService
--     , DynamoDBSession
--     , dynamoDBService
--     ) where
--
-- import Network.AWS.DynamoDB (dynamoDB)
-- import Network.AWS.Easy (wrapAWSService)
--
-- wrapAWSService \'dynamoDB \"DynamoDBService\" \"DynamoDBSession\"
-- @
--
-- This will generate boilerplate like the following:
--
-- @
-- data DynamoDBService = DynamoDBService Service
--
-- data DynamoDBSession = DynamoDBSession Session
--
-- instance ServiceClass DynamoDBService where
--     type TypedSession DynamoDBService = DynamoDBSession
--     rawService (DynamoDBService x) = x
--     wrappedSession = DynamoDBSession
--
-- instance SessionClass DynamoDBSession where
--     rawSession (DynamoDBSession x) = x
--
-- dynamoDBService :: DynamoDBService
-- dynamoDBService = DynamoDBService dynamoDB
-- @
wrapAWSService ::
    Name        -- ^ Name of the amazonka 'Network.AWS.Types.Service' value to wrap
    -> String   -- ^ Name of the service type to generate
    -> String   -- ^ Name of the session type to generate
    -> Q [Dec]  -- ^ Declarations for splicing into source file
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