packages feed

seihou-cli-0.4.0.0: src/Seihou/CLI/Style.hs

module Seihou.CLI.Style
  ( useColor,
    green,
    yellow,
    red,
    magenta,
    dim,
    bold,
    cyan,
    renderPreviewColor,
    renderReportColor,
    formatPlanViewColor,
  )
where

import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Seihou.Core.Types (DiffResult (..), Module (..), ModuleName (..), VarName (..), VarValue (..))
import Seihou.Engine.Preview
import Seihou.Engine.Validate
import Seihou.Prelude
import System.Console.ANSI
  ( Color (..),
    ColorIntensity (..),
    ConsoleIntensity (..),
    ConsoleLayer (..),
    SGR (..),
    hSupportsANSIColor,
    setSGRCode,
  )
import System.IO (stdout)

-- | Check whether stdout supports ANSI color output.
useColor :: IO Bool
useColor = hSupportsANSIColor stdout

-- | Wrap text in ANSI color codes.
withSGR :: [SGR] -> Text -> Text
withSGR codes t =
  T.pack (setSGRCode codes) <> t <> T.pack (setSGRCode [Reset])

green :: Text -> Text
green = withSGR [SetColor Foreground Dull Green]

yellow :: Text -> Text
yellow = withSGR [SetColor Foreground Dull Yellow]

red :: Text -> Text
red = withSGR [SetColor Foreground Vivid Red]

magenta :: Text -> Text
magenta = withSGR [SetColor Foreground Dull Magenta]

dim :: Text -> Text
dim = withSGR [SetConsoleIntensity FaintIntensity]

bold :: Text -> Text
bold = withSGR [SetConsoleIntensity BoldIntensity]

cyan :: Text -> Text
cyan = withSGR [SetColor Foreground Dull Cyan]

-- | Render preview lines with optional ANSI color.
-- When the first argument is False, falls back to plain text.
renderPreviewColor :: Bool -> [PreviewLine] -> Text
renderPreviewColor False lines' = renderPreviewPlain lines'
renderPreviewColor True lines' =
  if null lines'
    then "No operations to perform.\n"
    else T.unlines (map (renderColorLine maxPathLen) fileLines ++ map renderNonFileColor nonFileLines)
  where
    fileLines = [l | l@(FilePreview {}) <- lines']
    nonFileLines = [l | l <- lines', not (isFilePreview' l)]
    maxPathLen = maximum (0 : map (T.length . T.pack . (.previewPath)) fileLines)

renderColorLine :: Int -> PreviewLine -> Text
renderColorLine maxPath (FilePreview status path annotation mMod) =
  let (tag, colorFn) = statusStyleColor status
      pathText = T.pack path
      pathPad = T.replicate (maxPath - T.length pathText) " "
      modSuffix = case mMod of
        Just mn -> ", " <> mn.unModuleName
        Nothing -> ""
   in "    " <> tag <> "  " <> colorFn pathText <> pathPad <> "  " <> dim ("(" <> annotation <> modSuffix <> ")")
renderColorLine _ other = renderNonFileColor other

renderNonFileColor :: PreviewLine -> Text
renderNonFileColor (DirPreview path) =
  "    " <> cyan "mkdir" <> "  " <> cyan (T.pack path)
renderNonFileColor (CommandPreview cmd) =
  "    " <> dim "run" <> "    " <> dim cmd
renderNonFileColor (OrphanPreview path modName') =
  "    " <> magenta "[orphaned]" <> "  " <> magenta (T.pack path) <> "  " <> dim ("(orphaned from " <> modName'.unModuleName <> ")")
renderNonFileColor _ = ""

isFilePreview' :: PreviewLine -> Bool
isFilePreview' (FilePreview {}) = True
isFilePreview' _ = False

statusStyleColor :: FileStatus -> (Text, Text -> Text)
statusStyleColor FsNew = (green "[new]", green)
statusStyleColor FsModified = (yellow "[modified]", yellow)
statusStyleColor FsUnchanged = (dim "[unchanged]", dim)
statusStyleColor FsConflict = (bold (red "[conflict]"), bold . red)
statusStyleColor FsOrphaned = (magenta "[orphaned]", magenta)
statusStyleColor FsUnknown = ("[unknown]", id)

-- | Format a complete plan view with optional ANSI color.
formatPlanViewColor :: Bool -> [ModuleName] -> Map VarName VarValue -> [PreviewLine] -> DiffResult -> Text
formatPlanViewColor False modNames vars preview diff = formatPlanView modNames vars preview diff
formatPlanViewColor True modNames vars preview diff =
  T.unlines $
    [header, ""]
      ++ varsSection
      ++ ["  Operations:"]
      ++ map ("  " <>) (T.lines (renderPreviewColor True preview))
      ++ [""]
      ++ [summaryText']
  where
    header =
      bold
        ( "Generation Plan ("
            <> T.intercalate " + " (map (cyan . (.unModuleName)) modNames)
            <> "):"
        )

    varsSection =
      if Map.null vars
        then []
        else
          "  Variables:"
            : map formatVar' (Map.toAscList vars)
            ++ [""]

    maxVarLen = maximum (0 : map (\(VarName n, _) -> T.length n) (Map.toAscList vars))

    formatVar' (VarName name, val) =
      let namePad = T.replicate (maxVarLen - T.length name) " "
       in "    " <> name <> namePad <> " = " <> showVarValueColor val

    showVarValueColor (VText t) = cyan ("\"" <> t <> "\"")
    showVarValueColor (VBool True) = cyan "true"
    showVarValueColor (VBool False) = cyan "false"
    showVarValueColor (VInt n) = cyan (T.pack (show n))
    showVarValueColor (VList vs) = "[" <> T.intercalate ", " (map showVarValueColor vs) <> "]"

    nFiles = countNew preview + countMod preview
    nConflicts = countConf preview

    summaryText'
      | nConflicts > 0 =
          "  "
            <> T.pack (show nFiles)
            <> " files to write, "
            <> bold (red (T.pack (show nConflicts) <> " conflicts"))
      | otherwise =
          "  "
            <> T.pack (show nFiles)
            <> " files to write, "
            <> T.pack (show nConflicts)
            <> " conflicts"

    countNew = length . filter (\l -> case l of FilePreview FsNew _ _ _ -> True; _ -> False)
    countMod = length . filter (\l -> case l of FilePreview FsModified _ _ _ -> True; _ -> False)
    countConf = length . filter (\l -> case l of FilePreview FsConflict _ _ _ -> True; _ -> False)

-- | Render a validation report with optional ANSI color.
-- When the first argument is False, falls back to plain text.
renderReportColor :: Bool -> ValidateReport -> Text
renderReportColor False report = renderReportPlain report
renderReportColor True report =
  T.unlines $
    [ "Validating module at " <> T.pack report.reportPath <> "...",
      ""
    ]
      ++ dhallLine'
      ++ summaryLines'
      ++ checkLines'
      ++ [""]
      ++ [resultLine']
  where
    m = report.reportModule

    dhallLine' =
      if report.reportDhallOk
        then ["  " <> green "\x2713" <> " module.dhall evaluates successfully"]
        else
          ["  " <> bold (red "\x2717") <> " module.dhall failed to evaluate"]
            ++ case report.reportDhallError of
              Just errText -> ["      " <> dim errText]
              Nothing -> []

    summaryLines' =
      if report.reportDhallOk
        then
          [ "  " <> green "\x2713" <> " Module name: " <> cyan m.name.unModuleName,
            "  " <> green "\x2713" <> " " <> T.pack (show (length m.vars)) <> " variables declared",
            "  " <> green "\x2713" <> " " <> T.pack (show (length m.prompts)) <> " prompts defined",
            "  " <> green "\x2713" <> " " <> T.pack (show (length m.steps)) <> " steps defined"
          ]
        else []

    checkLines' = concatMap renderCheckColor (report.reportChecks)

    renderCheckColor c
      | null (c.diagDetails) =
          ["  " <> green "\x2713" <> " " <> c.diagLabel]
      | c.diagSeverity == DiagWarning =
          ("  " <> yellow "\x26A0" <> " " <> yellow (c.diagLabel))
            : map (\d -> "      " <> dim d) (c.diagDetails)
      | otherwise =
          ("  " <> bold (red "\x2717") <> " " <> red (c.diagLabel))
            : map (\d -> "      " <> dim d) (c.diagDetails)

    errorCount =
      length
        [ ()
        | c <- report.reportChecks,
          c.diagSeverity == DiagError,
          not (null (c.diagDetails))
        ]

    dhallFailed = not (report.reportDhallOk)
    totalErrors = errorCount + (if dhallFailed then 1 else 0)

    resultLine'
      | totalErrors > 0 =
          bold (red (T.pack (show totalErrors) <> " error(s) found.")) <> " Module is invalid."
      | otherwise =
          green ("Module '" <> m.name.unModuleName <> "' is valid.")