content: {- |
  Copyright: (c) 2020 Kowainik
  SPDX-License-Identifier: MPL-2.0
  Maintainer: Kowainik <xrom.xkov@gmail.com>
  
  Main running module.
  -}
  
  module Stan
      ( run
      , runStan
      , getAnalysis
      , getStanConfig
  
        -- ** Internal
      , createCabalExtensionsMap
      ) where
  
  import Colourista (errorMessage, formatWith, infoMessage, italic, successMessage, warningMessage)
  import Data.Aeson.Micro (encode)
  import System.Directory (doesFileExist, getCurrentDirectory)
  import System.FilePath (takeFileName)
  import Trial (Trial (..), prettyTaggedTrial, prettyTrial, prettyTrialWith, trialToMaybe,
                whenResult_)
  
  import Stan.Analysis (Analysis (..), runAnalysis)
  import Stan.Analysis.Pretty (prettyShowAnalysis)
  import Stan.Browse (openBrowser)
  import Stan.Cabal (createCabalExtensionsMap, usedCabalFiles)
  import Stan.Cli (CliToTomlArgs (..), InspectionArgs (..), ReportArgs (..), StanArgs (..),
                   StanCommand (..), TomlToCliArgs (..), runStanCli)
  import Stan.Config (ConfigP (..), applyConfig, configToCliCommand, defaultConfig, finaliseConfig, Config)
  import Stan.Config.Pretty (prettyConfigCli)
  import Stan.Core.Id (Id (..))
  import Stan.EnvVars (EnvVars (..), envVarsToText, getEnvVars)
  import Stan.Hie (readHieFiles)
  import Stan.Hie.Compat (HieFile (..))
  import Stan.Info (ProjectInfo (..), StanEnv (..))
  import Stan.Inspection (Inspection (..), inspectionsMd, prettyShowInspection,
                          prettyShowInspectionShort)
  import Stan.Inspection.All (getInspectionById, inspections, lookupInspectionById)
  import Stan.Observation (Observation (..), prettyShowIgnoredObservations)
  import Stan.Report (generateReport)
  import Stan.Severity (Severity (Error))
  import Stan.Toml (configCodec, getTomlConfig, usedTomlFiles)
  
  import qualified Toml
  
  
  run :: IO ()
  run = runStanCli >>= \case
      Stan stanArgs -> runStan stanArgs
      StanInspection inspectionArgs -> runInspection inspectionArgs
      StanTomlToCli tomlToCliArgs -> runTomlToCli tomlToCliArgs
      StanCliToToml cliToTomlArgs -> runCliToToml cliToTomlArgs
      StanInspectionsToMd -> putTextLn $ inspectionsMd inspections
  
  getStanConfig :: StanArgs -> Bool -> IO (Trial Text Config, Bool, EnvVars)
  getStanConfig StanArgs{..} notJson = do
      -- ENV vars
      env@EnvVars{..} <- getEnvVars
      let defConfTrial = envVarsUseDefaultConfigFile <> stanArgsUseDefaultConfigFile
      when notJson $ do
          infoMessage "Checking environment variables and CLI arguments for default configurations file usage..."
          putTextLn $ indent $ prettyTaggedTrial defConfTrial
      let useDefConfig = maybe True snd (trialToMaybe defConfTrial)
      -- config
      tomlConfig <- getTomlConfig notJson useDefConfig stanArgsConfigFile
      let configTrial = finaliseConfig $ defaultConfig <> tomlConfig <> stanArgsConfig
      when notJson $ do
          infoMessage "The following Configurations are used:\n"
          putTextLn $ indent $ prettyTrialWith (toString . prettyConfigCli) configTrial
      pure (configTrial, useDefConfig, env)
  
  getAnalysis :: StanArgs -> Bool -> Config -> [HieFile] -> IO Analysis
  getAnalysis StanArgs{..} notJson config hieFiles = do
      -- create cabal default extensions map
      cabalExtensionsMap <- createCabalExtensionsMap notJson stanArgsCabalFilePath hieFiles
      -- get checks for each file
      let checksMap = applyConfig (map hie_hs_file hieFiles) config
  
      let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored config) hieFiles
      -- show what observations are ignored
      pure analysis
  
  runStan :: StanArgs -> IO ()
  runStan stanArgs@StanArgs{..} = do
      let notJson = not stanArgsJsonOut
      (configTrial, useDefConfig, env) <- getStanConfig stanArgs notJson
      whenResult_ configTrial $ \warnings config -> do
          hieFiles <- readHieFiles stanArgsHiedir
          analysis <- getAnalysis stanArgs notJson config hieFiles
          -- show what observations are ignored
          when notJson $ putText $ indent $ prettyShowIgnoredObservations
              (configIgnored config)
              (analysisIgnoredObservations analysis)
          -- show the result
          let observations = analysisObservations analysis
          let isNullObs = null observations
          if notJson
          then do
              if isNullObs
              then successMessage "All clean! Stan did not find any observations at the moment."
              else warningMessage "Stan found the following observations for the project:\n"
              putTextLn $ prettyShowAnalysis analysis stanArgsOutputSettings
          else putLBSLn $ encode analysis
  
          -- report generation
          whenJust stanArgsReport $ \ReportArgs{..} -> do
              -- Project Info
              piName <- takeFileName <$> getCurrentDirectory
              piCabalFiles <- usedCabalFiles stanArgsCabalFilePath
              let piHieDir = stanArgsHiedir
              let piFileNumber = length hieFiles
              -- Stan Env Info
              seCliArgs <- getArgs
              seTomlFiles <- usedTomlFiles useDefConfig stanArgsConfigFile
              let stanEnv = StanEnv
                      { seEnvVars = envVarsToText env
                      , ..
                      }
              generateReport analysis config warnings stanEnv ProjectInfo{..}
              when notJson $ infoMessage "Report is generated here -> stan.html"
              when reportArgsBrowse $ openBrowser "stan.html"
  
          -- decide on exit status
          when
              (  not isNullObs
              && any ((>= Error) . getObservationSeverity) observations
              )
              exitFailure
    where
      getObservationSeverity :: Observation -> Severity
      getObservationSeverity = inspectionSeverity . getInspectionById . observationInspectionId
  
  indent :: Text -> Text
  indent = unlines . map ("    " <>) . lines
  
  runInspection :: InspectionArgs -> IO ()
  runInspection InspectionArgs{..} = case inspectionArgsId of
      Nothing  -> for_ inspections (putTextLn . prettyShowInspectionShort)
      Just insId -> case lookupInspectionById insId of
          Just ins -> putTextLn $ prettyShowInspection ins
          Nothing  -> do
              errorMessage $ "Inspection with such ID does not exist: " <> unId insId
              putTextLn $ " 💡 " <> formatWith [italic] "Use 'stan inspection' to see the list of all available inspections."
  
  runTomlToCli :: TomlToCliArgs -> IO ()
  runTomlToCli TomlToCliArgs{..} = do
      let useDefConfig = isNothing tomlToCliArgsFilePath
      partialConfig <- getTomlConfig True useDefConfig tomlToCliArgsFilePath
      case finaliseConfig partialConfig of
          Result _ res -> putTextLn $ configToCliCommand res
          fiasco -> do
              errorMessage "Could not get Configurations:"
              putTextLn $ prettyTrial fiasco
  
  runCliToToml :: CliToTomlArgs -> IO ()
  runCliToToml CliToTomlArgs{..} = do
      let toml = Toml.encode configCodec cliToTomlArgsConfig
      case cliToTomlArgsFilePath of
          Nothing -> do
              putTextLn toml
              infoMessage "Copy-paste the above TOML into .stan.toml and stan will pick up this file on the next run"
          Just path -> do
              isFile <- doesFileExist path
              if isFile
              then errorMessage $ "Aborting writing to file because it already exists: " <> toText path
              else do
                  writeFileText path toml
                  infoMessage $ "TOML configuration is written to file: " <> toText path
  