{-# LANGUAGE QuasiQuotes #-}

{- |
Module      : Main
Description : Entry point for hcovguard executable
Copyright   : (c) Trevis Elser, 2026
License     : MIT
Maintainer  : oss@treviselser.com
-}
module Main
  ( main
  ) where

import qualified Control.Monad as Monad
import qualified Data.Foldable as Foldable
import qualified Data.IntSet as IntSet
import qualified Data.String.Interpolate as Interpolate
import qualified Data.Text as Text
import qualified Data.Text.IO as TextIO
import qualified System.Exit as Exit
import qualified System.IO as IO
import qualified Trace.Hpc.Tix as HpcTix

import qualified HCovGuard.Checks as Checks
import qualified HCovGuard.Config as Config
import qualified HCovGuard.Coverage as Coverage
import qualified Options

main :: IO ()
main = do
  optsResult <- Options.parseOptions
  case optsResult of
    Left err -> do
      printError $ Options.showOptionsError err
      Exit.exitFailure
    Right opts ->
      case Options.runMode opts of
        Options.RunCheck -> runChecks opts
        Options.RunBaseline -> runBaseline opts
        Options.RunDryRun -> runDryRun opts

runChecks :: Options.Options -> IO ()
runChecks opts = do
  configResult <- Config.loadConfig (Options.configPath opts)
  case configResult of
    Left configErr -> do
      printError $ Config.showConfigError configErr
      Exit.exitFailure
    Right config -> do
      tixResult <- Coverage.loadTix (Options.tixPath opts)
      case tixResult of
        Left err -> do
          printError $ Coverage.showLoadError err
          Exit.exitFailure
        Right (HpcTix.Tix tixModules) -> do
          moduleResults <- traverse (checkModule opts config) tixModules

          case sequenceA moduleResults of
            Left loadErr -> do
              printError $ Coverage.showLoadError loadErr
              Exit.exitFailure
            Right resultsWithMatches -> do
              let results = fmap Checks.checkResult resultsWithMatches
                  matchedIndices =
                    IntSet.fromList
                      [ idx
                      | r <- resultsWithMatches
                      , Just idx <- [Checks.matchedPatternIndex r]
                      ]

              warnUnmatchedPatterns config matchedIndices

              if any Checks.isFailure results
                then Exit.exitFailure
                else Exit.exitSuccess

checkModule ::
  Options.Options
  -> Config.Config
  -> HpcTix.TixModule
  -> IO (Either Coverage.LoadError Checks.CheckResultWithMatch)
checkModule opts config tixMod = do
  let mixDirs = Options.mixDirs opts
  mixResult <- Coverage.loadMix mixDirs tixMod

  case mixResult of
    Left err -> pure (Left err)
    Right mix -> do
      let modCov = Coverage.calculateModuleCoverage tixMod mix
          cleanModName = Coverage.moduleName modCov
          resultWithMatch = Checks.checkModuleCoverage config cleanModName modCov
          result = Checks.checkResult resultWithMatch

      Monad.when (Options.verbosity opts >= 2) $
        TextIO.putStr (Coverage.showModuleCoverage modCov)

      case result of
        Checks.CheckFailed failures -> do
          TextIO.putStr (Checks.showGroupedFailures cleanModName failures)
          pure (Right resultWithMatch)
        Checks.CheckIgnored -> do
          Monad.when (Options.verbosity opts >= 2) . TextIO.putStrLn $
            [Interpolate.i|  [IGNORED] |] <> Coverage.moduleName modCov
          pure (Right resultWithMatch)
        Checks.CheckPassed -> do
          Monad.when (Options.verbosity opts >= 2) . TextIO.putStrLn $
            [Interpolate.i|  [PASSED] |] <> Coverage.moduleName modCov
          pure (Right resultWithMatch)

warnUnmatchedPatterns :: Config.Config -> IntSet.IntSet -> IO ()
warnUnmatchedPatterns config matchedIndices =
  let specs = Config.forSpecifiedModules config
      totalPatterns = length specs
      allIndices = IntSet.fromList [0 .. totalPatterns - 1]
      unmatchedIndices = IntSet.difference allIndices matchedIndices
   in Foldable.traverse_ (warnUnmatchedIndex specs) (IntSet.toList unmatchedIndices)

warnUnmatchedIndex :: [Config.ForSpecifiedModule] -> Int -> IO ()
warnUnmatchedIndex specs idx =
  case drop idx specs of
    (spec : _) -> printWarning $ showUnmatchedWarning spec
    [] -> pure ()

showUnmatchedWarning :: Config.ForSpecifiedModule -> Text.Text
showUnmatchedWarning spec =
  let selector = Config.showModuleSelector (Config.specifiedModuleSelector spec)
   in Text.unlines
        [ [Interpolate.i|Warning: [Hcovguard-8451] Pattern matched no modules|]
        , [Interpolate.i|  |] <> selector
        ]

printWarning :: Text.Text -> IO ()
printWarning = TextIO.hPutStrLn IO.stderr

printError :: Text.Text -> IO ()
printError = TextIO.hPutStrLn IO.stderr

-- | Generate a baseline config from current coverage
runBaseline :: Options.Options -> IO ()
runBaseline opts = do
  tixResult <- Coverage.loadTix (Options.tixPath opts)
  case tixResult of
    Left err -> do
      printError $ Coverage.showLoadError err
      Exit.exitFailure
    Right (HpcTix.Tix tixModules) -> do
      coverageResults <- traverse (loadModuleCoverage opts) tixModules
      case sequenceA coverageResults of
        Left loadErr -> do
          printError $ Coverage.showLoadError loadErr
          Exit.exitFailure
        Right coverages -> do
          TextIO.putStrLn (generateBaselineConfig coverages)
          Exit.exitSuccess

-- | Load coverage data for a single module
loadModuleCoverage ::
  Options.Options
  -> HpcTix.TixModule
  -> IO (Either Coverage.LoadError Coverage.ModuleCoverage)
loadModuleCoverage opts tixMod =
  fmap (fmap (Coverage.calculateModuleCoverage tixMod)) $
    Coverage.loadMix (Options.mixDirs opts) tixMod

-- | Generate TOML config from coverage data
generateBaselineConfig :: [Coverage.ModuleCoverage] -> Text.Text
generateBaselineConfig coverages =
  Text.unlines $
    [ [Interpolate.i|\# Generated by hcovguard --baseline|]
    , [Interpolate.i|\# Thresholds set to current coverage counts|]
    , [Interpolate.i||]
    , [Interpolate.i|[forAnyModule]|]
    , [Interpolate.i|\# No default thresholds - each module has explicit config below|]
    , [Interpolate.i||]
    ]
      <> concatMap generateModuleConfig coverages

-- | Generate TOML config for a single module
generateModuleConfig :: Coverage.ModuleCoverage -> [Text.Text]
generateModuleConfig modCov =
  let name = Coverage.moduleName modCov
      stats = Coverage.moduleStats modCov
      exprCovered = Coverage.countsCovered (Coverage.expressionCoverage stats)
      topCovered = Coverage.countsCovered (Coverage.topLevelCoverage stats)
      altCovered = Coverage.countsCovered (Coverage.alternativeCoverage stats)
      localCovered = Coverage.countsCovered (Coverage.localCoverage stats)
   in [ [Interpolate.i|[[forSpecifiedModules]]|]
      , [Interpolate.i|module = "#{name}"|]
      , [Interpolate.i||]
      , [Interpolate.i|[forSpecifiedModules.expression]|]
      , [Interpolate.i|minimumCovered = #{exprCovered}|]
      , [Interpolate.i||]
      , [Interpolate.i|[forSpecifiedModules.topLevel]|]
      , [Interpolate.i|minimumCovered = #{topCovered}|]
      , [Interpolate.i||]
      , [Interpolate.i|[forSpecifiedModules.alternative]|]
      , [Interpolate.i|minimumCovered = #{altCovered}|]
      , [Interpolate.i||]
      , [Interpolate.i|[forSpecifiedModules.local]|]
      , [Interpolate.i|minimumCovered = #{localCovered}|]
      , [Interpolate.i||]
      ]

-- | Show which modules match which patterns without running checks
runDryRun :: Options.Options -> IO ()
runDryRun opts = do
  configResult <- Config.loadConfig (Options.configPath opts)
  case configResult of
    Left configErr -> do
      printError $ Config.showConfigError configErr
      Exit.exitFailure
    Right config -> do
      tixResult <- Coverage.loadTix (Options.tixPath opts)
      case tixResult of
        Left err -> do
          printError $ Coverage.showLoadError err
          Exit.exitFailure
        Right (HpcTix.Tix tixModules) -> do
          moduleResults <- traverse (dryRunModule opts config) tixModules
          case sequenceA moduleResults of
            Left loadErr -> do
              printError $ Coverage.showLoadError loadErr
              Exit.exitFailure
            Right _ -> Exit.exitSuccess

-- | Show pattern match info for a single module
dryRunModule ::
  Options.Options
  -> Config.Config
  -> HpcTix.TixModule
  -> IO (Either Coverage.LoadError ())
dryRunModule opts config tixMod = do
  let mixDirs = Options.mixDirs opts
  mixResult <- Coverage.loadMix mixDirs tixMod
  case mixResult of
    Left err -> pure (Left err)
    Right mix -> do
      let modCov = Coverage.calculateModuleCoverage tixMod mix
          modName = Coverage.moduleName modCov
          specs = Config.forSpecifiedModules config
          matchResult = Config.moduleMatchesPatternWithIndex modName specs
      TextIO.putStrLn $ formatDryRunResult modName matchResult
      pure (Right ())

-- | Format the dry-run output for a module
formatDryRunResult :: Text.Text -> Maybe (Int, Config.ForSpecifiedModule) -> Text.Text
formatDryRunResult modName Nothing =
  [Interpolate.i|#{modName}: using [forAnyModule] defaults|]
formatDryRunResult modName (Just (idx, spec)) =
  let selector = Config.showModuleSelector (Config.specifiedModuleSelector spec)
      ignored :: Text.Text
      ignored = if Config.specifiedIgnore spec then [Interpolate.i| (ignored)|] else [Interpolate.i||]
      ruleNum = idx + 1
   in [Interpolate.i|#{modName}: matched rule \##{ruleNum} (#{selector})#{ignored}|]