Config.hs

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
  { required_version :: Maybe RequiredVersion
  , defaults :: Maybe Defaults
  }
  deriving stock Generic
  deriving anyclass FromJSON

configParameters :: Config -> Maybe ParametersYaml
configParameters = parameters <=< defaults

configTags :: Config -> Maybe TagsYaml
configTags = tags <=< defaults

emptyConfig :: Config
emptyConfig = Config Nothing Nothing

data Defaults = Defaults
  { parameters :: Maybe ParametersYaml
  , tags :: Maybe TagsYaml
  }
  deriving stock Generic
  deriving anyclass FromJSON

class HasConfig env where
  configL :: Lens' env Config

instance HasConfig Config where
  configL = id

data ConfigError
  = ConfigInvalidYaml Yaml.ParseException
  | ConfigInvalid (NonEmpty Text)
  | ConfigVersionNotSatisfied RequiredVersion Version
  deriving stock Show

configErrorMessage :: ConfigError -> Message
configErrorMessage = \case
  ConfigInvalidYaml ex ->
    "Configuration is not valid Yaml"
      :# ["error" .= Yaml.prettyPrintParseException ex]
  ConfigInvalid errs -> "Invalid configuration" :# ["errors" .= errs]
  ConfigVersionNotSatisfied rv v ->
    "Incompatible Stackctl version" :# ["current" .= v, "required" .= show rv]

loadConfigOrExit :: (MonadIO m, MonadLogger m) => m Config
loadConfigOrExit = either die pure =<< loadConfig
 where
  die e = do
    logError $ configErrorMessage e
    exitFailure

loadConfig :: MonadIO m => m (Either ConfigError Config)
loadConfig = runExceptT $ getConfigFile >>= \case
  Nothing -> pure emptyConfig
  Just cf -> loadConfigFrom cf

loadConfigFrom :: (MonadIO m, MonadError ConfigError m) => FilePath -> m Config
loadConfigFrom path = loadConfigFromBytes =<< liftIO (readFileBinary path)

loadConfigFromBytes :: MonadError ConfigError m => ByteString -> m Config
loadConfigFromBytes bs = do
  config <- either (throwError . ConfigInvalidYaml) pure $ Yaml.decodeEither' bs
  config <$ traverse_ checkRequiredVersion (required_version config)
 where
  checkRequiredVersion rv =
    unless (isRequiredVersionSatisfied rv Paths.version)
      $ throwError
      $ ConfigVersionNotSatisfied rv Paths.version

applyConfig :: Config -> StackSpecYaml -> StackSpecYaml
applyConfig config ss@StackSpecYaml {..} = ss
  { ssyParameters = configParameters config <> ssyParameters
  , ssyTags = configTags config <> ssyTags
  }

getConfigFile :: MonadIO m => m (Maybe FilePath)
getConfigFile = listToMaybe <$> filterM
  doesFileExist
  [ ".stackctl" </> "config" <.> "yaml"
  , ".stackctl" </> "config" <.> "yml"
  , ".stackctl" <.> "yaml"
  , ".stackctl" <.> "yml"
  ]