From 034b33ebd522e1d6826a2e7ba3df34b59b69180c Mon Sep 17 00:00:00 2001 From: 0rphee <0rph3e@proton.me> Date: Thu, 11 Jan 2024 02:53:11 -0600 Subject: [PATCH] Use stan config files for stan plugin (#3904) (#3914) * Bump stan Needed in order to get the functions for getting the config, etc. * Use stan config files for stan plugin (#3904) * Add test case for .stan.toml configuration * Fix windows tests See https://github.com/kowainik/stan/issues/531 --------- Co-authored-by: Michael Peyton Jones --- cabal.project | 2 +- plugins/hls-stan-plugin/hls-stan-plugin.cabal | 4 +- .../hls-stan-plugin/src/Ide/Plugin/Stan.hs | 119 ++++++++++++++++-- plugins/hls-stan-plugin/test/Main.hs | 6 + .../hls-stan-plugin/test/testdata/.stan.toml | 32 +++++ .../test/testdata/dir/configTest.hs | 5 + stack-lts21.yaml | 2 +- stack.yaml | 2 +- 8 files changed, 156 insertions(+), 16 deletions(-) create mode 100644 plugins/hls-stan-plugin/test/testdata/.stan.toml create mode 100644 plugins/hls-stan-plugin/test/testdata/dir/configTest.hs diff --git a/cabal.project b/cabal.project index a12e78a84a..f8d1ab6a77 100644 --- a/cabal.project +++ b/cabal.project @@ -36,7 +36,7 @@ packages: ./plugins/hls-overloaded-record-dot-plugin ./plugins/hls-semantic-tokens-plugin -index-state: 2023-12-13T00:00:00Z +index-state: 2024-01-05T19:06:05Z tests: True test-show-details: direct diff --git a/plugins/hls-stan-plugin/hls-stan-plugin.cabal b/plugins/hls-stan-plugin/hls-stan-plugin.cabal index 4d440767f5..bfeca41c68 100644 --- a/plugins/hls-stan-plugin/hls-stan-plugin.cabal +++ b/plugins/hls-stan-plugin/hls-stan-plugin.cabal @@ -46,7 +46,9 @@ library , text , transformers , unordered-containers - , stan >= 0.1.1.0 + , stan >= 0.1.2.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 576cbe9c5d..6389bfb790 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -1,26 +1,30 @@ -{-# 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)) import Development.IDE.Core.Rules (getHieFile, getSourceFileSource) 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 +33,37 @@ 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 (..)) import Ide.Types (PluginDescriptor (..), PluginId, configHasDiagnostics, configInitialGenericConfig, defaultConfigDescriptor, defaultPluginDescriptor) 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, + prettyConfigCli) 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, prettyTrial, + prettyTrialWith) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginRules = rules recorder plId @@ -59,11 +80,43 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) defConfigDescriptor = defaultConfigDescriptor 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 + +-- We use this function to remove the terminal escape sequences emmited by Trial pretty printing functions. +-- See https://github.com/kowainik/trial/pull/73#issuecomment-1868233235 +stripModifiers :: T.Text -> T.Text +stripModifiers = go "" + where + go acc txt = + case T.findIndex (== '\x1B') txt of + Nothing -> acc <> txt + Just index -> let (beforeEsc, afterEsc) = T.splitAt index txt + in go (acc <> beforeEsc) (consumeEscapeSequence afterEsc) + consumeEscapeSequence :: T.Text -> T.Text + consumeEscapeSequence txt = + case T.findIndex (== 'm') txt of + Nothing -> txt + Just index -> T.drop (index + 1) txt + +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 (stripModifiers $ prettyTrialWith (T.unpack . prettyConfigCli) t) + LogDebugStanEnvVars envVars -> "EnvVars " <> + case envVars of + EnvVars trial@(FiascoL _) -> pretty (stripModifiers $ prettyTrial trial) + + -- if the envVars are not set, 'envVarsToText returns an empty string' + _ -> "found: " <> (pretty $ envVarsToText envVars) data GetStanDiagnostics = GetStanDiagnostics deriving (Eq, Show, Generic) @@ -84,9 +137,51 @@ rules recorder plId = do 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 + + 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) diff --git a/plugins/hls-stan-plugin/test/Main.hs b/plugins/hls-stan-plugin/test/Main.hs index 81d23ec928..7b668ea250 100644 --- a/plugins/hls-stan-plugin/test/Main.hs +++ b/plugins/hls-stan-plugin/test/Main.hs @@ -34,6 +34,12 @@ tests = assertBool "" $ T.isPrefixOf expectedPrefix (reduceDiag ^. L.message) reduceDiag ^. L.source @?= Just "stan" return () + , testCase "ignores diagnostics from .stan.toml" $ + runStanSession "" $ do + doc <- openDoc "dir/configTest.hs" "haskell" + diags <- waitForDiagnosticsFromSource doc "stan" + liftIO $ length diags @?= 0 + return () ] testDir :: FilePath diff --git a/plugins/hls-stan-plugin/test/testdata/.stan.toml b/plugins/hls-stan-plugin/test/testdata/.stan.toml new file mode 100644 index 0000000000..faff35467a --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/.stan.toml @@ -0,0 +1,32 @@ +# See https://github.com/kowainik/stan/issues/531 +# Unix +[[check]] +type = "Exclude" +id = "STAN-0206" +scope = "all" + +[[check]] +type = "Exclude" +id = "STAN-0103" +file = "dir/configTest.hs" + +[[check]] +type = "Exclude" +id = "STAN-0212" +directory = "dir/" + +# Windows +[[check]] +type = "Exclude" +id = "STAN-0206" +scope = "all" + +[[check]] +type = "Exclude" +id = "STAN-0103" +file = "dir\\configTest.hs" + +[[check]] +type = "Exclude" +id = "STAN-0212" +directory = "dir\\" diff --git a/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs b/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs new file mode 100644 index 0000000000..b2ed26a745 --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs @@ -0,0 +1,5 @@ +data A = A Int Int + +a = length [1..] + +b = undefined diff --git a/stack-lts21.yaml b/stack-lts21.yaml index 55ea89b301..b114550a17 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -56,7 +56,7 @@ extra-deps: - lsp-types-2.1.0.0 # stan dependencies not found in the stackage snapshot -- stan-0.1.0.2 +- stan-0.1.2.0 - clay-0.14.0 - dir-traverse-0.2.3.0 - extensions-0.1.0.0 diff --git a/stack.yaml b/stack.yaml index 0c927eb542..6eae9d00dd 100644 --- a/stack.yaml +++ b/stack.yaml @@ -59,7 +59,7 @@ extra-deps: - optparse-applicative-0.17.1.0 # stan and friends -- stan-0.1.1.0 +- stan-0.1.2.0 - clay-0.14.0 - colourista-0.1.0.2 - dir-traverse-0.2.3.0