Audit.hs

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

module HWM.CLI.Command.Registry.Audit (runRegistryAudit, RegistryAuditOptions (..)) where

import HWM.Core.Formatting (Color (..), chalk)
import HWM.Core.Parsing (ParseCLI (..))
import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (..))
import HWM.Domain.Bounds (BoundCompliance (..), auditBounds, auditHasAny, formatAudit, updateDepBounds)
import HWM.Domain.Config (Config (..))
import HWM.Domain.ConfigT (ConfigT, updateConfig)
import HWM.Domain.Environments (getTestedRange)
import HWM.Domain.Registry (askRegistry, mapDeps, mapWithName)
import HWM.Integrations.Toolchain.Package (syncPackages)
import HWM.Runtime.UI (indent, printGenTable, putLine, section, sectionConfig, sectionTableM)
import Options.Applicative
import Relude

data RegistryAuditOptions = RegistryAuditOptions {auditFix :: Bool, auditForce :: Bool} deriving (Show)

instance ParseCLI RegistryAuditOptions where
  parseCLI =
    RegistryAuditOptions
      <$> switch (long "fix" <> help "Automatically fix issues")
      <*> switch (long "force" <> help "Force actions")

runRegistryAudit :: RegistryAuditOptions -> ConfigT ()
runRegistryAudit RegistryAuditOptions {..} = do
  originalRegistry <- askRegistry
  range <- getTestedRange
  sectionTableM "audit" [("mode", pure (if auditFix then if auditForce then chalk Yellow "fix (force)" else chalk Cyan "fix" else "check"))]

  let dependencyAudits = filter (auditHasAny (/= Valid)) $ mapWithName (auditBounds range) originalRegistry
  section "registry" $ printGenTable $ formatAudit <$> dependencyAudits
  let errorCount = length $ filter (auditHasAny (== Conflict)) dependencyAudits

  if null dependencyAudits
    then do
      indent 1 $ putLine "all dependencies are up to date."
    else do
      if auditFix
        then ((\cf -> pure $ cf {cfgRegistry = Just $ mapDeps (updateDepBounds auditForce range) originalRegistry}) `updateConfig`) $ do
          sectionConfig [("hwm.yaml", pure $ chalk Green "✓")]
          syncPackages
        else do
          injectIssue
            ( Issue
                { issueDetails = Nothing,
                  issueMessage = "Found " <> show (length dependencyAudits - errorCount) <> " outdated dependencies: Run 'hwm registry audit --fix --force' to update.",
                  issueTopic = "registry",
                  issueSeverity = SeverityWarning
                }
            )
          when (errorCount > 0)
            $ injectIssue
              ( Issue
                  { issueDetails = Nothing,
                    issueMessage = "Found " <> show errorCount <> " outdated dependencies: Run 'hwm registry audit --fix' to update.",
                    issueTopic = "registry",
                    issueSeverity = SeverityError
                  }
              )