content: {- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io>
   -
   - SPDX-License-Identifier: MPL-2.0
   -}
  
  module Xrefcheck.Command
    ( defaultAction
    ) where
  
  import Universum
  
  import Data.Reflection (Given, give)
  import Data.Yaml (decodeFileEither, prettyPrintParseException)
  import Fmt (build, fmt, fmtLn)
  import System.Console.Pretty (supportsPretty)
  import System.Directory (doesFileExist)
  import Text.Interpolation.Nyan
  
  import Xrefcheck.CLI (Options (..), addExclusionOptions, addNetworkingOptions, defaultConfigPaths)
  import Xrefcheck.Config
    (Config, Config' (..), ScannersConfig, ScannersConfig' (..), defConfig, overrideConfig)
  import Xrefcheck.Core (Flavor (..))
  import Xrefcheck.Progress (allowRewrite)
  import Xrefcheck.Scan
  import Xrefcheck.Scanners.Markdown (markdownSupport)
  import Xrefcheck.Scanners.Symlink (symlinkSupport)
  import Xrefcheck.System (PrintUnixPaths (..), askWithinCI)
  import Xrefcheck.Util
  import Xrefcheck.Verify (reportVerifyErrs, verifyErrors, verifyRepo)
  
  readConfig :: FilePath -> IO Config
  readConfig path = fmap overrideConfig do
    decodeFileEither path
      >>= either (error . toText . prettyPrintParseException) pure
  
  configuredFileSupport :: Given PrintUnixPaths => ScannersConfig -> FileSupport
  configuredFileSupport ScannersConfig{..} = firstFileSupport
      [ markdownSupport scMarkdown
      , symlinkSupport
      ]
  
  findFirstExistingFile :: [FilePath] -> IO (Maybe FilePath)
  findFirstExistingFile = \case
    [] -> pure Nothing
    (file : files) -> do
      exists <- doesFileExist file
      if exists then pure (Just file) else findFirstExistingFile files
  
  defaultAction :: Options -> IO ()
  defaultAction Options{..} = do
    withinCI <- askWithinCI
    coloringSupported <- supportsPretty
    let colorMode = oColorMode ?:
          if withinCI || coloringSupported
          then WithColors
          else WithoutColors
  
    give oPrintUnixPaths $ give colorMode $ do
      config <- case oConfigPath of
        Just configPath -> readConfig configPath
        Nothing -> do
          mConfigPath <- findFirstExistingFile defaultConfigPaths
          case mConfigPath of
            Just configPath -> readConfig configPath
            Nothing -> do
              hPutStrLn @Text stderr
                [int||
                Configuration file not found, using default config \
                for GitHub repositories
                |]
              pure $ defConfig GitHub
  
      let showProgressBar = oShowProgressBar ?: not withinCI
  
      (ScanResult scanErrs repoInfo) <- allowRewrite showProgressBar $ \rw -> do
        let fullConfig = addExclusionOptions (cExclusions config) oExclusionOptions
            fileSupport = configuredFileSupport $ cScanners config
        scanRepo oScanPolicy rw fileSupport fullConfig oRoot
  
      when oVerbose $
        fmt [int||
        === Repository data ===
  
        #{interpolateIndentF 2 (build repoInfo)}
        |]
  
      whenJust (nonEmpty $ sortBy (compare `on` seFile) scanErrs) reportScanErrs
  
      verifyRes <- allowRewrite showProgressBar $ \rw -> do
        let fullConfig = config
              { cNetworking = addNetworkingOptions (cNetworking config) oNetworkingOptions }
        verifyRepo rw fullConfig oMode repoInfo
  
      case verifyErrors verifyRes of
        Nothing | null scanErrs ->
          fmtLn $ colorIfNeeded Green "All repository links are valid."
        Nothing -> exitFailure
        Just verifyErrs -> do
          unless (null scanErrs) $ fmt "\n"
          reportVerifyErrs verifyErrs
          exitFailure
  