module Stackctl.Config
  ( Config (..)
  , configParameters
  , configTags
  , emptyConfig
  , HasConfig (..)
  , ConfigError (..)
  , loadConfigOrExit
  , loadConfigFromBytes
  , applyConfig
  ) where

import Stackctl.Prelude

import Control.Monad.Except
import Data.Aeson
import Data.Version
import qualified Data.Yaml as Yaml
import Paths_stackctl as Paths
import Stackctl.Config.RequiredVersion
import Stackctl.StackSpecYaml
import UnliftIO.Directory (doesFileExist)

data Config = Config
  { Config -> Maybe RequiredVersion
required_version :: Maybe RequiredVersion
  , Config -> Maybe Defaults
defaults :: Maybe Defaults
  }
  deriving stock (forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)
  deriving anyclass (Value -> Parser [Config]
Value -> Parser Config
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Config]
$cparseJSONList :: Value -> Parser [Config]
parseJSON :: Value -> Parser Config
$cparseJSON :: Value -> Parser Config
FromJSON)

configParameters :: Config -> Maybe ParametersYaml
configParameters :: Config -> Maybe ParametersYaml
configParameters = Defaults -> Maybe ParametersYaml
parameters forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> Maybe Defaults
defaults

configTags :: Config -> Maybe TagsYaml
configTags :: Config -> Maybe TagsYaml
configTags = Defaults -> Maybe TagsYaml
tags forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Config -> Maybe Defaults
defaults

emptyConfig :: Config
emptyConfig :: Config
emptyConfig = Maybe RequiredVersion -> Maybe Defaults -> Config
Config forall a. Maybe a
Nothing forall a. Maybe a
Nothing

data Defaults = Defaults
  { Defaults -> Maybe ParametersYaml
parameters :: Maybe ParametersYaml
  , Defaults -> Maybe TagsYaml
tags :: Maybe TagsYaml
  }
  deriving stock (forall x. Rep Defaults x -> Defaults
forall x. Defaults -> Rep Defaults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Defaults x -> Defaults
$cfrom :: forall x. Defaults -> Rep Defaults x
Generic)
  deriving anyclass (Value -> Parser [Defaults]
Value -> Parser Defaults
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Defaults]
$cparseJSONList :: Value -> Parser [Defaults]
parseJSON :: Value -> Parser Defaults
$cparseJSON :: Value -> Parser Defaults
FromJSON)

class HasConfig env where
  configL :: Lens' env Config

instance HasConfig Config where
  configL :: Lens' Config Config
configL = forall a. a -> a
id

data ConfigError
  = ConfigInvalidYaml Yaml.ParseException
  | ConfigInvalid (NonEmpty Text)
  | ConfigVersionNotSatisfied RequiredVersion Version
  deriving stock (Int -> ConfigError -> ShowS
[ConfigError] -> ShowS
ConfigError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigError] -> ShowS
$cshowList :: [ConfigError] -> ShowS
show :: ConfigError -> String
$cshow :: ConfigError -> String
showsPrec :: Int -> ConfigError -> ShowS
$cshowsPrec :: Int -> ConfigError -> ShowS
Show)

configErrorMessage :: ConfigError -> Message
configErrorMessage :: ConfigError -> Message
configErrorMessage = \case
  ConfigInvalidYaml ParseException
ex ->
    Text
"Configuration is not valid Yaml"
      Text -> [SeriesElem] -> Message
:# [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ParseException -> String
Yaml.prettyPrintParseException ParseException
ex]
  ConfigInvalid NonEmpty Text
errs -> Text
"Invalid configuration" Text -> [SeriesElem] -> Message
:# [Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty Text
errs]
  ConfigVersionNotSatisfied RequiredVersion
rv Version
v ->
    Text
"Incompatible Stackctl version" Text -> [SeriesElem] -> Message
:# [Key
"current" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Version
v, Key
"required" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show RequiredVersion
rv]

loadConfigOrExit :: (MonadIO m, MonadLogger m) => m Config
loadConfigOrExit :: forall (m :: * -> *). (MonadIO m, MonadLogger m) => m Config
loadConfigOrExit = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {b}.
(MonadLogger m, MonadIO m) =>
ConfigError -> m b
die forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m (Either ConfigError Config)
loadConfig
 where
  die :: ConfigError -> m b
die ConfigError
e = do
    forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ ConfigError -> Message
configErrorMessage ConfigError
e
    forall (m :: * -> *) a. MonadIO m => m a
exitFailure

loadConfig :: MonadIO m => m (Either ConfigError Config)
loadConfig :: forall (m :: * -> *). MonadIO m => m (Either ConfigError Config)
loadConfig =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => m (Maybe String)
getConfigFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
emptyConfig
    Just String
cf -> forall (m :: * -> *).
(MonadIO m, MonadError ConfigError m) =>
String -> m Config
loadConfigFrom String
cf

loadConfigFrom :: (MonadIO m, MonadError ConfigError m) => FilePath -> m Config
loadConfigFrom :: forall (m :: * -> *).
(MonadIO m, MonadError ConfigError m) =>
String -> m Config
loadConfigFrom String
path = forall (m :: * -> *).
MonadError ConfigError m =>
ByteString -> m Config
loadConfigFromBytes forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary String
path)

loadConfigFromBytes :: MonadError ConfigError m => ByteString -> m Config
loadConfigFromBytes :: forall (m :: * -> *).
MonadError ConfigError m =>
ByteString -> m Config
loadConfigFromBytes ByteString
bs = do
  Config
config <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> ConfigError
ConfigInvalidYaml) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' ByteString
bs
  Config
config forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall {f :: * -> *}.
MonadError ConfigError f =>
RequiredVersion -> f ()
checkRequiredVersion (Config -> Maybe RequiredVersion
required_version Config
config)
 where
  checkRequiredVersion :: RequiredVersion -> f ()
checkRequiredVersion RequiredVersion
rv =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RequiredVersion -> Version -> Bool
isRequiredVersionSatisfied RequiredVersion
rv Version
Paths.version)
      forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      forall a b. (a -> b) -> a -> b
$ RequiredVersion -> Version -> ConfigError
ConfigVersionNotSatisfied RequiredVersion
rv Version
Paths.version

applyConfig :: Config -> StackSpecYaml -> StackSpecYaml
applyConfig :: Config -> StackSpecYaml -> StackSpecYaml
applyConfig Config
config ss :: StackSpecYaml
ss@StackSpecYaml {String
Maybe [Capability]
Maybe [StackName]
Maybe [Action]
Maybe StackDescription
Maybe TagsYaml
Maybe ParametersYaml
ssyTags :: StackSpecYaml -> Maybe TagsYaml
ssyCapabilities :: StackSpecYaml -> Maybe [Capability]
ssyParameters :: StackSpecYaml -> Maybe ParametersYaml
ssyActions :: StackSpecYaml -> Maybe [Action]
ssyDepends :: StackSpecYaml -> Maybe [StackName]
ssyTemplate :: StackSpecYaml -> String
ssyDescription :: StackSpecYaml -> Maybe StackDescription
ssyTags :: Maybe TagsYaml
ssyCapabilities :: Maybe [Capability]
ssyParameters :: Maybe ParametersYaml
ssyActions :: Maybe [Action]
ssyDepends :: Maybe [StackName]
ssyTemplate :: String
ssyDescription :: Maybe StackDescription
..} =
  StackSpecYaml
ss
    { ssyParameters :: Maybe ParametersYaml
ssyParameters = Config -> Maybe ParametersYaml
configParameters Config
config forall a. Semigroup a => a -> a -> a
<> Maybe ParametersYaml
ssyParameters
    , ssyTags :: Maybe TagsYaml
ssyTags = Config -> Maybe TagsYaml
configTags Config
config forall a. Semigroup a => a -> a -> a
<> Maybe TagsYaml
ssyTags
    }

getConfigFile :: MonadIO m => m (Maybe FilePath)
getConfigFile :: forall (m :: * -> *). MonadIO m => m (Maybe String)
getConfigFile =
  forall a. [a] -> Maybe a
listToMaybe
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
      forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist
      [ String
".stackctl" String -> ShowS
</> String
"config" String -> ShowS
<.> String
"yaml"
      , String
".stackctl" String -> ShowS
</> String
"config" String -> ShowS
<.> String
"yml"
      , String
".stackctl" String -> ShowS
<.> String
"yaml"
      , String
".stackctl" String -> ShowS
<.> String
"yml"
      ]