From 8bbc2b7944db6dba28622ee29209f39af6b6e171 Mon Sep 17 00:00:00 2001 From: 0rphee <0rph3e@proton.me> Date: Mon, 18 Dec 2023 10:50:23 -0600 Subject: [PATCH] Use stan config files for stan plugin (#3904) --- plugins/hls-stan-plugin/hls-stan-plugin.cabal | 2 + .../hls-stan-plugin/src/Ide/Plugin/Stan.hs | 94 +++++++++++++++---- 2 files changed, 77 insertions(+), 19 deletions(-) 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..466e62492d8 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -1,19 +1,20 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Stan (descriptor, Log) where -import Compat.HieTypes (HieASTs, HieFile) -import Control.DeepSeq (NFData) -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) +import Compat.HieTypes (HieASTs, HieFile (..)) +import Control.DeepSeq (NFData) +import Control.Monad (void, when) +import Control.Monad.IO.Class (liftIO) +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 qualified Data.Map as Map -import Data.Maybe (fromJust, mapMaybe) -import qualified Data.Text as T +import Data.Foldable (toList) +import Data.Hashable (Hashable) +import qualified Data.HashMap.Strict as HM +import qualified Data.Map as Map +import Data.Maybe (fromJust, mapMaybe, + maybeToList) +import qualified Data.Text as T import Development.IDE import Development.IDE (Diagnostic (_codeDescription)) import Development.IDE.Core.Rules (getHieFile, @@ -26,7 +27,7 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs), runHsc, srcSpanEndCol, srcSpanEndLine, srcSpanStartCol, - srcSpanStartLine, tcg_exports) + srcSpanStartLine, tcg_exports, HieFile (hie_hs_file)) import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic) import Ide.Plugin.Config @@ -36,12 +37,20 @@ import Ide.Types (PluginDescriptor (..), defaultPluginDescriptor, pluginEnabledConfig) import qualified Language.LSP.Protocol.Types as LSP +import Stan (getStanConfig, createCabalExtensionsMap) import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Category (Category (..)) import Stan.Core.Id (Id (..)) import Stan.Inspection (Inspection (..)) import Stan.Inspection.All (inspectionsIds, inspectionsMap) import Stan.Observation (Observation (..)) +import System.Directory (makeRelativeToCurrentDirectory) +import Stan.Cli (StanArgs (..)) +import Trial (whenResult, fiasco, pattern FiascoL, pattern ResultL, Fatality, Trial, TaggedTrial) +import Stan.Report.Settings (ToggleSolution(..), Verbosity (..), OutputSettings (..)) +import Stan.Config (defaultConfig, ConfigP (..), applyConfig, Config) +import Stan.EnvVars (EnvVars(..)) +import Data.HashSet (HashSet) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId desc) @@ -53,11 +62,21 @@ 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 !(Trial T.Text Stan.Config.Config) + | LogDebugStanEnvVars !(TaggedTrial T.Text Bool) + | LogDebugStanCheckMap !(HM.HashMap FilePath (HashSet (Id Inspection))) + deriving (Show) 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 t -> "Config result: " <> (pretty $ show t) + LogDebugStanEnvVars t -> "Env vars: " <> (pretty $ show t) + LogDebugStanCheckMap hm -> "Map of checks per file: " <> (pretty $ show hm) data GetStanDiagnostics = GetStanDiagnostics deriving (Eq, Show, Generic) @@ -72,15 +91,52 @@ 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 "", + configRemoved = fiasco "", + configIgnored = fiasco ""} -- :: !PartialConfig + -- 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 + logWith recorder Debug (LogDebugStanConfigResult configTrial) + logWith recorder Debug (LogDebugStanEnvVars $ envVarsUseDefaultConfigFile env) + + (cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of + FiascoL es -> do + logWith recorder 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)