hwm-0.5.0: src/HWM/CLI/Command/Environment/Add.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.CLI.Command.Environment.Add (EnvAddOptions, runEnvAdd) where

import Control.Monad.Except (throwError)
import HWM.Core.Common (Name)
import HWM.Core.Formatting (Format (..))
import HWM.Core.Parsing (Parse (..), ParseCLI (..))
import HWM.Core.Version (Version)
import HWM.Domain.Config (Config (..))
import HWM.Domain.ConfigT (ConfigT, updateConfig)
import HWM.Domain.Environments (addProfile, existsEnvironment, mkEnvironment, printEnvironments)
import HWM.Runtime.UI (minRowSize, section, uiRow)
import Options.Applicative (help, metavar, strArgument)
import Options.Applicative.Builder (argument, str)
import Relude

data EnvAddOptions = EnvAddOptions
  { envName :: Name,
    envGHC :: Version
  }
  deriving (Show)

instance ParseCLI EnvAddOptions where
  parseCLI =
    EnvAddOptions
      <$> strArgument (metavar "NAME" <> help "Name of the environment to add")
      <*> argument (str >>= parse) (metavar "GHC" <> help "GHC version (e.g. 8.10.7)")

runEnvAdd :: EnvAddOptions -> ConfigT ()
runEnvAdd EnvAddOptions {..} = do
  exists <- existsEnvironment envName
  if exists
    then do
      printEnvironments
      throwError $ fromString $ "Environment '" <> toString envName <> "' already exists."
    else do
      section "new environment" $ do
        uiRow minRowSize "name" envName
        uiRow minRowSize "ghc" (format envGHC)
      updateConfig
        (\cfg@Config {..} -> pure cfg {cfgEnvironments = addProfile envName (mkEnvironment envGHC) cfgEnvironments})
        (pure ())