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

module HWM.CLI.Command.Version
  ( runVersion,
  )
where

import HWM.Core.Formatting (Color (..), Format (..), chalk)
import HWM.Core.Version (Bump, nextVersion)
import HWM.Domain.Bounds (versionBounds)
import HWM.Domain.Config (Config (..))
import HWM.Domain.ConfigT (ConfigT, config, updateConfig)
import HWM.Integrations.Toolchain.Package (syncPackages)
import HWM.Runtime.UI (putLine, sectionConfig, sectionTableM)
import Relude

size :: Int
size :: Int
size = Int
16

bumpVersion :: Bump -> Config -> ConfigT Config
bumpVersion :: Bump -> Config -> ConfigT Config
bumpVersion Bump
bump Config {[WorkspaceGroup]
Map Text Text
Text
Version
Bounds
Dependencies
Matrix
name :: Text
version :: Version
bounds :: Bounds
workspace :: [WorkspaceGroup]
matrix :: Matrix
registry :: Dependencies
scripts :: Map Text Text
scripts :: Config -> Map Text Text
registry :: Config -> Dependencies
matrix :: Config -> Matrix
workspace :: Config -> [WorkspaceGroup]
bounds :: Config -> Bounds
version :: Config -> Version
name :: Config -> Text
..} = do
  let version' :: Version
version' = Bump -> Version -> Version
nextVersion Bump
bump Version
version
  Int -> Text -> [(Text, ConfigT Text)] -> ConfigT ()
forall (m :: * -> *).
MonadUI m =>
Int -> Text -> [(Text, m Text)] -> m ()
sectionTableM
    Int
size
    (Text
"bump version (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bump -> Text
forall a. Format a => a -> Text
format Bump
bump Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
    [ (Text
"from", Text -> ConfigT Text
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigT Text) -> Text -> ConfigT Text
forall a b. (a -> b) -> a -> b
$ Version -> Text
forall a. Format a => a -> Text
format Version
version),
      (Text
"to", Text -> ConfigT Text
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigT Text) -> Text -> ConfigT Text
forall a b. (a -> b) -> a -> b
$ Color -> Text -> Text
chalk Color
Cyan (Version -> Text
forall a. Format a => a -> Text
format Version
version'))
    ]

  let bounds' :: Bounds
bounds' = Version -> Bounds
versionBounds Version
version'
  Config -> ConfigT Config
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config {version :: Version
version = Version
version', bounds :: Bounds
bounds = Bounds
bounds', [WorkspaceGroup]
Map Text Text
Text
Dependencies
Matrix
name :: Text
workspace :: [WorkspaceGroup]
matrix :: Matrix
registry :: Dependencies
scripts :: Map Text Text
scripts :: Map Text Text
registry :: Dependencies
matrix :: Matrix
workspace :: [WorkspaceGroup]
name :: Text
..}

runVersion :: Maybe Bump -> ConfigT ()
runVersion :: Maybe Bump -> ConfigT ()
runVersion (Just Bump
bump) = (Bump -> Config -> ConfigT Config
bumpVersion Bump
bump (Config -> ConfigT Config) -> ConfigT () -> ConfigT ()
forall b. (Config -> ConfigT Config) -> ConfigT b -> ConfigT b
`updateConfig`) (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ do
  Int -> [(Text, ConfigT Text)] -> ConfigT ()
forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
sectionConfig Int
size [(Text
"hwm.yaml", Text -> ConfigT Text
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigT Text) -> Text -> ConfigT Text
forall a b. (a -> b) -> a -> b
$ Color -> Text -> Text
chalk Color
Green Text
"✓")]
  ConfigT ()
syncPackages
runVersion Maybe Bump
Nothing = do
  Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text -> ConfigT ()) -> (Config -> Text) -> Config -> ConfigT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
forall a. Format a => a -> Text
format (Version -> Text) -> (Config -> Version) -> Config -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Version
version (Config -> ConfigT ()) -> ConfigT Config -> ConfigT ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Env IO -> Config) -> ConfigT Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Config
forall (m :: * -> *). Env m -> Config
config
  ConfigT ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess