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

module HWM.CLI.Command.Status (showStatus) where

import HWM.Core.Formatting (Color (..), Format (..), chalk, genMaxLen, monadStatus, padDots, statusIcon, subPathSign)
import HWM.Core.Pkg (Pkg (..))
import qualified HWM.Domain.Config as C
import HWM.Domain.ConfigT (ConfigT, config)
import HWM.Domain.Matrix (getBuildEnvironment, getBuildEnvroments, printEnvironments)
import HWM.Domain.Workspace (memberPkgs, pkgGroupName)
import HWM.Integrations.Toolchain.Package (validatePackage)
import HWM.Runtime.UI (putLine, sectionTableM, sectionWorkspace)
import Relude

-- | Main status command - displays project info and package statuses
showStatus :: ConfigT ()
showStatus :: ConfigT ()
showStatus = do
  Config
cfg <- (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
  BuildEnvironment
active <- Maybe Text -> ConfigT BuildEnvironment
forall env (m :: * -> *).
(MonadReader env m, Has env Matrix, Has env [WorkspaceGroup],
 Has env Cache, MonadIO m, MonadError Issue m) =>
Maybe Text -> m BuildEnvironment
getBuildEnvironment Maybe Text
forall a. Maybe a
Nothing
  [BuildEnvironment]
environments <- ConfigT [BuildEnvironment]
forall env (m :: * -> *).
(MonadReader env m, Has env Matrix, Has env [WorkspaceGroup],
 MonadIO m, MonadError Issue m) =>
m [BuildEnvironment]
getBuildEnvroments
  Int -> Text -> [(Text, ConfigT Text)] -> ConfigT ()
forall (m :: * -> *).
MonadUI m =>
Int -> Text -> [(Text, m Text)] -> m ()
sectionTableM
    Int
0
    Text
"project"
    [ (Text
"name", 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
Magenta (Config -> Text
C.name Config
cfg)),
      (Text
"version", 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 (Version -> Text
forall a. Format a => a -> Text
format (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ Config -> Version
C.version Config
cfg))
    ]
  BuildEnvironment -> [BuildEnvironment] -> ConfigT ()
forall (m :: * -> *).
MonadUI m =>
BuildEnvironment -> [BuildEnvironment] -> m ()
printEnvironments BuildEnvironment
active [BuildEnvironment]
environments
  ConfigT () -> ConfigT ()
forall (m :: * -> *) a. MonadUI m => m a -> m ()
sectionWorkspace
    (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ [WorkspaceGroup] -> (WorkspaceGroup -> ConfigT ()) -> ConfigT ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Config -> [WorkspaceGroup]
C.workspace Config
cfg)
    ((WorkspaceGroup -> ConfigT ()) -> ConfigT ())
-> (WorkspaceGroup -> ConfigT ()) -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceGroup
g -> do
      Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine Text
""
      Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text -> ConfigT ()) -> Text -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Text
"• " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Bold (WorkspaceGroup -> Text
pkgGroupName WorkspaceGroup
g)
      [Pkg]
pkgs <- WorkspaceGroup -> ConfigT [Pkg]
forall (m :: * -> *).
(MonadIO m, MonadError Issue m) =>
WorkspaceGroup -> m [Pkg]
memberPkgs WorkspaceGroup
g
      let maxLen :: Int
maxLen = [Text] -> Int
genMaxLen ((Pkg -> Text) -> [Pkg] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Pkg -> Text
pkgMemberId [Pkg]
pkgs)
      [Pkg] -> (Pkg -> ConfigT ()) -> ConfigT ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Pkg]
pkgs ((Pkg -> ConfigT ()) -> ConfigT ())
-> (Pkg -> ConfigT ()) -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ \Pkg
pkg -> do
        Status
status <- ConfigT () -> ConfigT Status
forall (m :: * -> *) b.
(Functor m, MonadIssue m) =>
m b -> m Status
monadStatus (Pkg -> ConfigT ()
validatePackage Pkg
pkg)
        Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text -> ConfigT ()) -> Text -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Text
subPathSign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
padDots Int
maxLen (Pkg -> Text
pkgMemberId Pkg
pkg) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Status -> Text
statusIcon Status
status