{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Main running module.
-}

module Stan
    ( run

      -- ** Internal
    , createCabalExtensionsMap
    ) where

import Colourista (errorMessage, formatWith, infoMessage, italic, successMessage, warningMessage)
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Environment (getArgs)
import System.FilePath (takeFileName)
import Trial (Trial (..), prettyTaggedTrial, prettyTrial, prettyTrialWith, trialToMaybe,
              whenResult_)

import Stan.Analysis (Analysis (..), runAnalysis)
import Stan.Analysis.Pretty (prettyShowAnalysis)
import Stan.Cabal (createCabalExtensionsMap, usedCabalFiles)
import Stan.Cli (CliToTomlArgs (..), InspectionArgs (..), StanArgs (..), StanCommand (..),
                 TomlToCliArgs (..), runStanCli)
import Stan.Config (ConfigP (..), applyConfig, configToCliCommand, defaultConfig, finaliseConfig)
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 :: IO ()
run = IO StanCommand
runStanCli IO StanCommand -> (StanCommand -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Stan stanArgs :: StanArgs
stanArgs -> StanArgs -> IO ()
runStan StanArgs
stanArgs
    StanInspection inspectionArgs :: InspectionArgs
inspectionArgs -> InspectionArgs -> IO ()
runInspection InspectionArgs
inspectionArgs
    StanTomlToCli tomlToCliArgs :: TomlToCliArgs
tomlToCliArgs -> TomlToCliArgs -> IO ()
runTomlToCli TomlToCliArgs
tomlToCliArgs
    StanCliToToml cliToTomlArgs :: CliToTomlArgs
cliToTomlArgs -> CliToTomlArgs -> IO ()
runCliToToml CliToTomlArgs
cliToTomlArgs
    StanInspectionsToMd -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Inspection] -> Text
inspectionsMd [Inspection]
inspections

runStan :: StanArgs -> IO ()
runStan :: StanArgs -> IO ()
runStan StanArgs{..} = do
    -- ENV vars
    env :: EnvVars
env@EnvVars{..} <- IO EnvVars
getEnvVars
    let defConfTrial :: TaggedTrial Text Bool
defConfTrial = TaggedTrial Text Bool
envVarsUseDefaultConfigFile TaggedTrial Text Bool
-> TaggedTrial Text Bool -> TaggedTrial Text Bool
forall a. Semigroup a => a -> a -> a
<> TaggedTrial Text Bool
stanArgsUseDefaultConfigFile
    Text -> IO ()
infoMessage "Checking environment variables and CLI arguments for default configurations file usage..."
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TaggedTrial Text Bool -> Text
forall a e.
(Show a, Semigroup e, IsString e) =>
TaggedTrial e a -> e
prettyTaggedTrial TaggedTrial Text Bool
defConfTrial
    let useDefConfig :: Bool
useDefConfig = Bool -> ((Text, Bool) -> Bool) -> Maybe (Text, Bool) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text, Bool) -> Bool
forall a b. (a, b) -> b
snd (TaggedTrial Text Bool -> Maybe (Text, Bool)
forall e a. Trial e a -> Maybe a
trialToMaybe TaggedTrial Text Bool
defConfTrial)
    -- config
    PartialConfig
tomlConfig <- Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig Bool
useDefConfig Maybe FilePath
stanArgsConfigFile
    let configTrial :: Trial Text Config
configTrial = PartialConfig -> Trial Text Config
finaliseConfig (PartialConfig -> Trial Text Config)
-> PartialConfig -> Trial Text Config
forall a b. (a -> b) -> a -> b
$ PartialConfig
defaultConfig PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<> PartialConfig
tomlConfig PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<> PartialConfig
stanArgsConfig
    Text -> IO ()
infoMessage "The following Configurations are used:\n"
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Config -> FilePath) -> Trial Text Config -> Text
forall e a.
(Semigroup e, IsString e) =>
(a -> FilePath) -> Trial e a -> e
prettyTrialWith (Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> (Config -> Text) -> Config -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
prettyConfigCli) Trial Text Config
configTrial
    Trial Text Config -> ([Text] -> Config -> IO ()) -> IO ()
forall (f :: * -> *) e a.
Applicative f =>
Trial e a -> ([e] -> a -> f ()) -> f ()
whenResult_ Trial Text Config
configTrial (([Text] -> Config -> IO ()) -> IO ())
-> ([Text] -> Config -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \warnings :: [Text]
warnings config :: Config
config -> do
        [HieFile]
hieFiles <- FilePath -> IO [HieFile]
readHieFiles FilePath
stanArgsHiedir
        -- create cabal default extensions map
        Map FilePath (Either ExtensionsError ParsedExtensions)
cabalExtensionsMap <- [FilePath]
-> [HieFile]
-> IO (Map FilePath (Either ExtensionsError ParsedExtensions))
createCabalExtensionsMap [FilePath]
stanArgsCabalFilePath [HieFile]
hieFiles
        -- get checks for each file
        let checksMap :: HashMap FilePath (HashSet (Id Inspection))
checksMap = [FilePath] -> Config -> HashMap FilePath (HashSet (Id Inspection))
applyConfig ((HieFile -> FilePath) -> [HieFile] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map HieFile -> FilePath
hie_hs_file [HieFile]
hieFiles) Config
config

        let analysis :: Analysis
analysis = Map FilePath (Either ExtensionsError ParsedExtensions)
-> HashMap FilePath (HashSet (Id Inspection))
-> [Id Observation]
-> [HieFile]
-> Analysis
runAnalysis Map FilePath (Either ExtensionsError ParsedExtensions)
cabalExtensionsMap HashMap FilePath (HashSet (Id Inspection))
checksMap (Config -> 'Final ::- [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored Config
config) [HieFile]
hieFiles
        -- show what observations are ignored
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
indent (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Id Observation] -> Observations -> Text
prettyShowIgnoredObservations
            (Config -> 'Final ::- [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored Config
config)
            (Analysis -> Observations
analysisIgnoredObservations Analysis
analysis)
        -- show the result
        let observations :: Observations
observations = Analysis -> Observations
analysisObservations Analysis
analysis
        let isNullObs :: Bool
isNullObs = Observations -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Observations
observations
        if Bool
isNullObs
        then Text -> IO ()
successMessage "All clean! Stan did not find any observations at the moment."
        else Text -> IO ()
warningMessage "Stan found the following observations for the project:\n"
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Analysis -> ReportSettings -> Text
prettyShowAnalysis Analysis
analysis ReportSettings
stanArgsReportSettings

        -- report generation
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
stanArgsReport (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            -- Project Info
            FilePath
piName <- FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
            [FilePath]
piCabalFiles <- [FilePath] -> IO [FilePath]
usedCabalFiles [FilePath]
stanArgsCabalFilePath
            let piHieDir :: FilePath
piHieDir = FilePath
stanArgsHiedir
            let piFileNumber :: Int
piFileNumber = [HieFile] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HieFile]
hieFiles
            -- Stan Env Info
            [FilePath]
seCliArgs <- IO [FilePath]
getArgs
            [FilePath]
seTomlFiles <- Bool -> Maybe FilePath -> IO [FilePath]
usedTomlFiles Bool
useDefConfig Maybe FilePath
stanArgsConfigFile
            let stanEnv :: StanEnv
stanEnv = $WStanEnv :: Text -> [FilePath] -> [FilePath] -> StanEnv
StanEnv
                    { seEnvVars :: Text
seEnvVars = EnvVars -> Text
envVarsToText EnvVars
env
                    , ..
                    }
            Analysis -> Config -> [Text] -> StanEnv -> ProjectInfo -> IO ()
generateReport Analysis
analysis Config
config [Text]
warnings StanEnv
stanEnv $WProjectInfo :: FilePath -> [FilePath] -> FilePath -> Int -> ProjectInfo
ProjectInfo{..}
            Text -> IO ()
infoMessage "Report is generated here -> stan.html"

        -- decide on exit status
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
            (  Bool -> Bool
not Bool
isNullObs
            Bool -> Bool -> Bool
&& (Observation -> Bool) -> Observations -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Severity -> Severity -> Bool
forall a. Ord a => a -> a -> Bool
>= Severity
Error) (Severity -> Bool)
-> (Observation -> Severity) -> Observation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Observation -> Severity
getObservationSeverity) Observations
observations
            )
            IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
  where
    getObservationSeverity :: Observation -> Severity
    getObservationSeverity :: Observation -> Severity
getObservationSeverity = Inspection -> Severity
inspectionSeverity (Inspection -> Severity)
-> (Observation -> Inspection) -> Observation -> Severity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id Inspection -> Inspection
getInspectionById (Id Inspection -> Inspection)
-> (Observation -> Id Inspection) -> Observation -> Inspection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Observation -> Id Inspection
observationInspectionId

    indent :: Text -> Text
    indent :: Text -> Text
indent = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall t. IsText t "lines" => t -> [t]
lines

runInspection :: InspectionArgs -> IO ()
runInspection :: InspectionArgs -> IO ()
runInspection InspectionArgs{..} = case Maybe (Id Inspection)
inspectionArgsId of
    Nothing  -> [Inspection] -> (Inspection -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Inspection]
inspections (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> (Inspection -> Text) -> Inspection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspection -> Text
prettyShowInspectionShort)
    Just insId :: Id Inspection
insId -> case Id Inspection -> Maybe Inspection
lookupInspectionById Id Inspection
insId of
        Just ins :: Inspection
ins -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Inspection -> Text
prettyShowInspection Inspection
ins
        Nothing  -> do
            Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Inspection with such ID does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
insId
            Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ " 💡 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
italic] "Use 'stan inspection' to see the list of all available inspections."

runTomlToCli :: TomlToCliArgs -> IO ()
runTomlToCli :: TomlToCliArgs -> IO ()
runTomlToCli TomlToCliArgs{..} = do
    let useDefConfig :: Bool
useDefConfig = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
tomlToCliArgsFilePath
    PartialConfig
partialConfig <- Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig Bool
useDefConfig Maybe FilePath
tomlToCliArgsFilePath
    case PartialConfig -> Trial Text Config
finaliseConfig PartialConfig
partialConfig of
        Result _ res :: Config
res -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Text
configToCliCommand Config
res
        fiasco :: Trial Text Config
fiasco -> do
            Text -> IO ()
errorMessage "Could not get Configurations:"
            Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Trial Text Config -> Text
forall a e. (Show a, Semigroup e, IsString e) => Trial e a -> e
prettyTrial Trial Text Config
fiasco

runCliToToml :: CliToTomlArgs -> IO ()
runCliToToml :: CliToTomlArgs -> IO ()
runCliToToml CliToTomlArgs{..} = do
    let toml :: Text
toml = TomlCodec PartialConfig -> PartialConfig -> Text
forall a. TomlCodec a -> a -> Text
Toml.encode TomlCodec PartialConfig
configCodec PartialConfig
cliToTomlArgsConfig
    case Maybe FilePath
cliToTomlArgsFilePath of
        Nothing -> do
            Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
toml
            Text -> IO ()
infoMessage "Copy-paste the above TOML into .stan.toml and stan will pick up this file on the next run"
        Just path :: FilePath
path -> do
            Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
path
            if Bool
isFile
            then Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Aborting writing to file because it already exists: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
path
            else do
                FilePath -> Text -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileText FilePath
path Text
toml
                Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "TOML configuration is written to file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
path