diff --git a/plugins/hls-stan-plugin/hls-stan-plugin.cabal b/plugins/hls-stan-plugin/hls-stan-plugin.cabal index 4d440767f55..0cd236f734e 100644 --- a/plugins/hls-stan-plugin/hls-stan-plugin.cabal +++ b/plugins/hls-stan-plugin/hls-stan-plugin.cabal @@ -47,6 +47,8 @@ library , transformers , unordered-containers , stan >= 0.1.1.0 + , trial + , directory default-language: Haskell2010 default-extensions: diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index f45a604a678..02e4f9ad663 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -1,18 +1,22 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Stan (descriptor, Log) where -import Compat.HieTypes (HieASTs, HieFile) +import Compat.HieTypes (HieASTs, HieFile (..)) import Control.DeepSeq (NFData) -import Control.Monad (void) +import Control.Monad (void, when) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Data.Default import Data.Foldable (toList) import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM +import Data.HashSet (HashSet) +import qualified Data.HashSet as HS import qualified Data.Map as Map -import Data.Maybe (fromJust, mapMaybe) +import Data.Maybe (fromJust, mapMaybe, + maybeToList) +import Data.String (IsString (fromString)) import qualified Data.Text as T import Development.IDE import Development.IDE (Diagnostic (_codeDescription)) @@ -21,6 +25,7 @@ import Development.IDE.Core.Rules (getHieFile, import Development.IDE.Core.RuleTypes (HieAstResult (..)) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat (HieASTs (HieASTs), + HieFile (hie_hs_file), RealSrcSpan (..), mkHieFile', mkRealSrcLoc, mkRealSrcSpan, runHsc, srcSpanEndCol, @@ -29,20 +34,40 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs), srcSpanStartLine, tcg_exports) import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic) -import Ide.Plugin.Config +import Ide.Plugin.Config (PluginConfig (plcDiagnosticsOn)) import Ide.Types (PluginDescriptor (..), PluginId, configHasDiagnostics, defaultConfigDescriptor, defaultPluginDescriptor, pluginEnabledConfig) import qualified Language.LSP.Protocol.Types as LSP +import Stan (createCabalExtensionsMap, + getStanConfig) import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Category (Category (..)) +import Stan.Cli (StanArgs (..)) +import Stan.Config (Config, ConfigP (..), + applyConfig, defaultConfig) +import Stan.Config.Pretty (ConfigAction, configToTriples, + prettyConfigAction, + prettyConfigNoFormat) import Stan.Core.Id (Id (..)) +import Stan.EnvVars (EnvVars (..), envVarsToText) import Stan.Inspection (Inspection (..)) import Stan.Inspection.All (inspectionsIds, inspectionsMap) import Stan.Observation (Observation (..)) - +import Stan.Report.Settings (OutputSettings (..), + ToggleSolution (..), + Verbosity (..)) +import Stan.Toml (usedTomlFiles) +import System.Directory (makeRelativeToCurrentDirectory) +import Trial (Fatality, Trial, + fiasco, + pattern FiascoL, + pattern ResultL, + prettyTrialNoColour, + prettyTrialWithNoColour, + ) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginRules = rules recorder plId @@ -53,11 +78,33 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) where desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan -newtype Log = LogShake Shake.Log deriving (Show) +data Log = LogShake !Shake.Log + | LogWarnConf ![(Fatality, T.Text)] + | LogDebugStanConfigResult ![FilePath] !(Trial T.Text Config) + | LogDebugStanEnvVars !EnvVars + | LogDebugStanCheckMap !(HM.HashMap FilePath (HashSet (Id Inspection))) + +renderId :: Id a -> T.Text +renderId (Id t) = "Id = " <> t instance Pretty Log where pretty = \case LogShake log -> pretty log + LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:" + <> line <> (pretty $ show errs) + LogDebugStanConfigResult fps t -> "Config result using: " + <> pretty fps <> line <> pretty (prettyTrialWithNoColour (T.unpack . prettyConfigNoFormat) t) + LogDebugStanEnvVars envVars -> "EnvVars " <> + case envVars of + EnvVars trial@(FiascoL xs) -> pretty (prettyTrialNoColour trial) + + -- if the envVars are not set, 'envVarsToText returns an empty string' + _ -> "found: " <> (pretty $ envVarsToText envVars) + LogDebugStanCheckMap hm -> "Checks per file: " <> + case HM.toList hm of + [(fp, hashSetInspections )] -> "Inspections set for " <> pretty fp <> line <> (pretty $ fmap renderId $ HS.toList hashSetInspections) + -- This case should not happen. Only one file is used in each analysis. + _-> pretty $ show hm data GetStanDiagnostics = GetStanDiagnostics deriving (Eq, Show, Generic) @@ -72,15 +119,58 @@ rules :: Recorder (WithPriority Log) -> PluginId -> Rules () rules recorder plId = do define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics file -> do - config <- getPluginConfigAction plId - if pluginEnabledConfig plcDiagnosticsOn config then do + plugConfig <- getPluginConfigAction plId + if pluginEnabledConfig plcDiagnosticsOn plugConfig then do maybeHie <- getHieFile file case maybeHie of Nothing -> return ([], Nothing) Just hie -> do - let enabledInspections = HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)] - -- This should use Cabal config for extensions and Stan config for inspection preferences is the future - let analysis = runAnalysis Map.empty enabledInspections [] [hie] + let isLoud = False -- in Stan: notJson = not isLoud + let stanArgs = + StanArgs + { stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files + , stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files. + , stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report + -- doesnt matter, because it is silenced by isLoud + , stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings + , stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file + , stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file. + , stanArgsConfig = ConfigP + { configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks" + , configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove" + , configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore" + } + -- if they are not fiascos, .stan.toml's aren't taken into account + ,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead. + } + + (configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud + seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) + logWith recorder Debug (LogDebugStanConfigResult seTomlFiles configTrial) + + -- If envVar is set to 'False', stan will ignore all local and global .stan.toml files + logWith recorder Debug (LogDebugStanEnvVars env) + seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) + + (cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of + FiascoL es -> do + logWith recorder Development.IDE.Warning (LogWarnConf es) + pure (Map.empty, + HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)], + []) + ResultL warnings stanConfig -> do + let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie + currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs + cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie] + + -- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative + -- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths. + let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig + logWith recorder Debug (LogDebugStanCheckMap checksMap) + + let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie] + pure (cabalExtensionsMap, checksMap, configIgnored stanConfig) + let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie] return (analysisToDiagnostics file analysis, Just ()) else return ([], Nothing)