hwm-0.4.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, existsEnviroment, 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 <- existsEnviroment envName
  if exists
    then do
      printEnvironments Nothing
      throwError $ fromString $ "Environment '" <> toString envName <> "' already exists."
    else section "new environment" $ do
      uiRow minRowSize "name" envName
      updateConfig
        ( \cfg@Config {..} -> do
            uiRow minRowSize "ghc" (format envGHC)
            pure cfg {cfgEnvironments = addProfile envName (mkEnvironment envGHC) cfgEnvironments}
        )
        (pure ())