module Network.CloudSeeder.DSL
( DeploymentConfiguration(..)
, StackConfiguration(..)
, HasName(..)
, HasParameterSources(..)
, HasStacks(..)
, HasTagSet(..)
, deployment
, environment
, flag
, tags
, param
, stack_
, stack
) where
import Control.Lens ((%=))
import Control.Monad.State (StateT, execStateT, lift)
import Control.Lens.TH (makeFields)
import Data.Semigroup ((<>))
import qualified Data.Set as S
import qualified Data.Text as T
import Network.CloudSeeder.Types
data DeploymentConfiguration = DeploymentConfiguration
{ _deploymentConfigurationName :: T.Text
, _deploymentConfigurationTagSet :: S.Set (T.Text, T.Text)
, _deploymentConfigurationStacks :: [StackConfiguration]
, _deploymentConfigurationParameterSources :: S.Set (T.Text, ParameterSource)
} deriving (Eq, Show)
data StackConfiguration = StackConfiguration
{ _stackConfigurationName :: T.Text
, _stackConfigurationTagSet :: S.Set (T.Text, T.Text)
, _stackConfigurationParameterSources :: S.Set (T.Text, ParameterSource)
} deriving (Eq, Show)
makeFields ''DeploymentConfiguration
makeFields ''StackConfiguration
paramSource :: (Monad m, HasParameterSources a (S.Set (T.Text, ParameterSource)) ) => T.Text -> ParameterSource -> StateT a m ()
paramSource pName source = parameterSources %= S.insert (pName, source)
deployment :: Monad m => T.Text -> StateT DeploymentConfiguration m a -> m DeploymentConfiguration
deployment name' x =
let config = DeploymentConfiguration name' [] [] []
in execStateT x config
environment :: (Monad m, HasParameterSources a (S.Set (T.Text, ParameterSource))) => [T.Text] -> StateT a m ()
environment = mapM_ (flip paramSource Env)
flag :: (Monad m, HasParameterSources a (S.Set (T.Text, ParameterSource))) => T.Text -> StateT a m ()
flag pName = paramSource pName Flag
tags :: (Monad m, HasTagSet a (S.Set (T.Text, T.Text))) => [(T.Text, T.Text)] -> StateT a m ()
tags ts = tagSet %= (<> S.fromList ts)
param :: (Monad m, HasParameterSources a (S.Set (T.Text, ParameterSource)))
=> T.Text -> T.Text -> StateT a m ()
param key val = paramSource key (Constant val)
stack_ :: Monad m => T.Text -> StateT DeploymentConfiguration m ()
stack_ name' = stack name' $ return ()
stack :: Monad m => T.Text -> StateT StackConfiguration m a -> StateT DeploymentConfiguration m ()
stack name' x = do
let stackConfig = StackConfiguration name' [] []
stackConfig' <- lift $ execStateT x stackConfig
stacks %= (++ [stackConfig'])