{-# LANGUAGE OverloadedStrings #-}

module Commands
  ( runCommand
  ) where

import Control.Monad (forM_, when)
import Data.List (sortBy)
import Data.Map.Strict qualified as Map
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Text qualified as T
import System.Console.ANSI
import System.Directory (makeAbsolute)
import Text.Printf (printf)
import Types
import Config
import CSV
import Git
import Analysis
import StackYaml
import ColorOption
import License (licenseText)
import XDG qualified

-- | Run a command
runCommand :: Options -> IO ()
runCommand :: Options -> IO ()
runCommand Options
opts = do
  useColor <- ColorWhen -> IO Bool
shouldUseColor (Options -> ColorWhen
optColor Options
opts)
  case optCommand opts of
    Command
Version -> IO ()
printVersion
    Command
NumericVersion -> [Char] -> IO ()
putStrLn [Char]
appVersion
    Command
PrintLicense -> [Char] -> IO ()
putStrLn [Char]
licenseText
    Command
Help -> do
      -- Manually render help text
      -- While not ideal, this ensures help works. The structure mirrors optparse-applicative's output.
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"stacker version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
appVersion
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
putStrLn [Char]
"Usage: stacker [COMMAND | (-V|--version) | --numeric-version |"
      [Char] -> IO ()
putStrLn [Char]
"                --license | (-h|--help)] [--color WHEN]"
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
putStrLn [Char]
"  A tool to bump snapshots (resolvers) in stack*.yaml files"
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
putStrLn [Char]
"Available options:"
      [Char] -> IO ()
putStrLn [Char]
"  -V,--version             Print version information"
      [Char] -> IO ()
putStrLn [Char]
"  --numeric-version        Print version number"
      [Char] -> IO ()
putStrLn [Char]
"  --license                Print license text"
      [Char] -> IO ()
putStrLn [Char]
"  -h,--help                Print help"
      [Char] -> IO ()
putStrLn [Char]
"  --color WHEN             Use colored output (always, never, auto)"
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
putStrLn [Char]
"Available commands:"
      [Char] -> IO ()
putStrLn [Char]
"  bump                     Update stack*.yaml files"
      [Char] -> IO ()
putStrLn [Char]
"  dry-run                  Show what would be updated (default)"
      [Char] -> IO ()
putStrLn [Char]
"  update                   Update stackage snapshots database"
      [Char] -> IO ()
putStrLn [Char]
"  info                     Print GHC version to snapshot mapping"
      [Char] -> IO ()
putStrLn [Char]
"  config                   Configure stacker"
      [Char] -> IO ()
putStrLn [Char]
"  version                  Print version information (also: -V, --version)"
      [Char] -> IO ()
putStrLn [Char]
"  numeric-version          Print version number (also: --numeric-version)"
      [Char] -> IO ()
putStrLn [Char]
"  license                  Print license text (also: --license)"
      [Char] -> IO ()
putStrLn [Char]
"  help                     Print this help (also: -h, --help)"
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
putStrLn [Char]
"For more information, see the README"
    Config ConfigCmd
configCmd -> ConfigCmd -> IO ()
runConfig ConfigCmd
configCmd  -- Handle config first!
    Command
cmd -> Bool -> Command -> IO ()
runEssentialCommand Bool
useColor Command
cmd

-- | Run an essential command (requires CSV files)
runEssentialCommand :: Bool -> Command -> IO ()
runEssentialCommand :: Bool -> Command -> IO ()
runEssentialCommand Bool
useColor Command
cmd = do
  -- Ensure CSV files exist (copy from data dir if needed)
  IO ()
ensureCSVFiles

  case Command
cmd of
    Command
DryRun -> Bool -> IO ()
runDryRun Bool
useColor
    Command
Bump -> IO ()
runBump
    Command
Update -> do
      -- Only for Update command, ensure repo exists and update it
      repoPath <- IO [Char]
getRepoPath
      ensureRepo repoPath
      runUpdate repoPath
    Command
Info -> do
      -- Info command shows the repo path
      repoPath <- IO [Char]
getRepoPath
      runInfo repoPath
    Command
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Print version information
printVersion :: IO ()
printVersion :: IO ()
printVersion = do
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
appName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
appVersion
  [Char] -> IO ()
putStrLn [Char]
copyright

-- | Print text with optional color formatting
withColor :: Bool -> [SGR] -> IO () -> IO ()
withColor :: Bool -> [SGR] -> IO () -> IO ()
withColor Bool
useColor [SGR]
sgr IO ()
action = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR]
sgr
  IO ()
action
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR
Reset]

-- | Run dry-run command
runDryRun :: Bool -> IO ()
runDryRun :: Bool -> IO ()
runDryRun Bool
useColor = do
  db <- IO SnapshotDB
loadSnapshotDB
  actions <- analyzeAllStackYamls db

  -- Sort actions by filename
  let sortedActions = (Action -> Action -> Ordering) -> [Action] -> [Action]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Action -> [Char]) -> Action -> Action -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Action -> [Char]
actionFile) [Action]
actions

  forM_ sortedActions $ \Action
action -> do
    Bool -> Action -> IO ()
printAction Bool
useColor Action
action

-- | Print an action
printAction :: Bool -> Action -> IO ()
printAction :: Bool -> Action -> IO ()
printAction Bool
useColor Action
action = do
  let file :: [Char]
file = Action -> [Char]
actionFile Action
action
  let oldSnap :: Text
oldSnap = Action -> Text
actionOldSnapshot Action
action
  let newSnap :: Maybe Text
newSnap = Action -> Maybe Text
actionNewSnapshot Action
action
  let symlinkTarget :: Maybe [Char]
symlinkTarget = Action -> Maybe [Char]
actionSymlinkTarget Action
action

  -- Print with proper alignment (file padded to 20 chars, oldSnap to 25 chars)
  Bool -> [SGR] -> IO () -> IO ()
withColor Bool
useColor [ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padRight Int
20 [Char]
file

  [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padRight Int
25 (Text -> [Char]
T.unpack Text
oldSnap)

  case Maybe [Char]
symlinkTarget of
    Just [Char]
target -> do
      -- This is a symlink to another stack*.yaml file
      Bool -> [SGR] -> IO () -> IO ()
withColor Bool
useColor [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
White] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> IO ()
putStr [Char]
"= symlink to "
        [Char] -> IO ()
putStr [Char]
target
    Maybe [Char]
Nothing ->
      case Maybe Text
newSnap of
        Maybe Text
Nothing -> do
          Bool -> [SGR] -> IO () -> IO ()
withColor Bool
useColor [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Green] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> IO ()
putStr [Char]
"✓ up to date"
        Just Text
new -> do
          Bool -> [SGR] -> IO () -> IO ()
withColor Bool
useColor [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Yellow] (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [Char] -> IO ()
putStr [Char]
"→ bump to "
            [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
new

  [Char] -> IO ()
putStrLn [Char]
""

-- | Pad string to the right
padRight :: Int -> String -> String
padRight :: Int -> [Char] -> [Char]
padRight Int
n [Char]
s = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
n ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. a -> [a]
repeat Char
' ')

-- | Run bump command
runBump :: IO ()
runBump :: IO ()
runBump = do
  db <- IO SnapshotDB
loadSnapshotDB
  actions <- analyzeAllStackYamls db
  mapM_ (applyAction True) actions

-- | Run update command
runUpdate :: FilePath -> IO ()
runUpdate :: [Char] -> IO ()
runUpdate [Char]
repoPath = do
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Repository: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
repoPath
  [Char] -> IO ()
updateRepo [Char]
repoPath
  [Char] -> IO ()
generateCSVs [Char]
repoPath

-- | Run info command
runInfo :: FilePath -> IO ()
runInfo :: [Char] -> IO ()
runInfo [Char]
repoPath = do
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"repo: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
repoPath
  db <- IO SnapshotDB
loadSnapshotDB
  putStrLn "snapshots:"

  let ghcEntries = Map GHCVersion Snapshot -> [(GHCVersion, Snapshot)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (SnapshotDB -> Map GHCVersion Snapshot
dbGHC SnapshotDB
db)
  forM_ ghcEntries $ \(GHCVersion
ghc, Snapshot
snapshot) -> do
    [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ GHCVersion -> [Char]
formatGHCVersionText GHCVersion
ghc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (Snapshot -> Text
formatSnapshotText Snapshot
snapshot)

-- | Format GHC version as text
formatGHCVersionText :: GHCVersion -> String
formatGHCVersionText :: GHCVersion -> [Char]
formatGHCVersionText (GHCVersion Int
maj1 Int
maj2 Int
minV) =
  Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maj1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maj2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minV

-- | Format snapshot as text
formatSnapshotText :: Snapshot -> Text
formatSnapshotText :: Snapshot -> Text
formatSnapshotText (LTS (LTSVersion Int
major Int
minor)) =
  Text
"lts-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
major) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minor)
formatSnapshotText (Nightly (NightlyVersion Int
year Int
month Int
day)) =
  [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"nightly-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Int -> Int -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d-%02d-%02d" Int
year Int
month Int
day

-- | Run config command
runConfig :: ConfigCmd -> IO ()
runConfig :: ConfigCmd -> IO ()
runConfig (SetRepo [Char]
path) = do
  absPath <- [Char] -> IO [Char]
makeAbsolute [Char]
path
  saveConfig $ AppConfig (Just absPath)
  putStrLn $ "Repository path set to: " ++ absPath
  configFile <- XDG.getConfigFile
  putStrLn $ "Configuration saved to: " ++ configFile