diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index 6389bfb790..b902218a38 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -2,68 +2,47 @@ {-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Stan (descriptor, Log) where -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 Data.HashSet (HashSet) -import qualified Data.HashSet as HS -import qualified Data.Map as Map -import Data.Maybe (fromJust, mapMaybe, - maybeToList) -import Data.String (IsString (fromString)) -import qualified Data.Text as T +import Compat.HieTypes (HieFile (..)) +import Control.DeepSeq (NFData) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Data.Foldable (toList) +import Data.Hashable (Hashable) +import qualified Data.HashMap.Strict as HM +import Data.Maybe (mapMaybe) +import qualified Data.Text as T import Development.IDE -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, - srcSpanEndLine, - srcSpanStartCol, - srcSpanStartLine, tcg_exports) -import Development.IDE.GHC.Error (realSrcSpanToRange) -import GHC.Generics (Generic) -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) +import Development.IDE.Core.Rules (getHieFile) +import qualified Development.IDE.Core.Shake as Shake +import GHC.Generics (Generic) +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) +import Stan.Config.Pretty (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 @@ -164,24 +143,25 @@ rules recorder plId = do logWith recorder Debug (LogDebugStanEnvVars env) seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) - (cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of + -- Note that Stan works in terms of relative paths, but the HIE come in as absolute. Without + -- making its path relative, the file name(s) won't line up with the associated Map keys. + relativeHsFilePath <- liftIO $ makeRelativeToCurrentDirectory $ fromNormalizedFilePath file + let hieRelative = hie{hie_hs_file=relativeHsFilePath} + + (checksMap, ignoredObservations) <- 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] + -- If we can't read the config file, default to using all inspections: + let allInspections = HM.fromList [(relativeHsFilePath, inspectionsIds)] + pure (allInspections, []) + ResultL _warnings stanConfig -> do + -- HashMap of *relative* file paths to info about enabled checks for those file paths. + let checksMap = applyConfig [relativeHsFilePath] stanConfig + pure (checksMap, configIgnored stanConfig) + + -- A Map from *relative* file paths (just one, in this case) to language extension info: + cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hieRelative] + let analysis = runAnalysis cabalExtensionsMap checksMap ignoredObservations [hieRelative] 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 5388fd44d7..650760c9dc 100644 --- a/plugins/hls-stan-plugin/test/Main.hs +++ b/plugins/hls-stan-plugin/test/Main.hs @@ -4,11 +4,7 @@ module Main where import Control.Lens ((^.)) -import Control.Monad (void) -import Data.List (find) -import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T import qualified Ide.Plugin.Stan as Stan import Ide.Types import qualified Language.LSP.Protocol.Lens as L @@ -36,14 +32,30 @@ tests = return () , testCase "ignores diagnostics from .stan.toml" $ runStanSession "" $ do - doc <- openDoc "dir/configTest.hs" "haskell" + doc <- openDoc ("dir" "configTest.hs") "haskell" diags <- waitForDiagnosticsFromSource doc "stan" liftIO $ length diags @?= 0 return () + , testCase "respects LANGUAGE pragmas in the source file" $ + runStanSession "" $ do + doc <- openDoc ("extensions-language-pragma" "LanguagePragmaTest.hs") "haskell" + diags <- waitForDiagnosticsFromSource doc "stan" + -- We must include at least one valid diagnostic in our test file to avoid + -- the false-positive case where Stan finds no analyses to perform due to a + -- bad mapping, which would also lead to zero diagnostics being returned. + liftIO $ length diags @?= 1 + return () + , testCase "respects language extensions defined in the .cabal file" $ + runStanSession "" $ do + doc <- openDoc ("extensions-cabal-file" "CabalFileTest.hs") "haskell" + diags <- waitForDiagnosticsFromSource doc "stan" + -- We need at least one valid diagnostic here too, for the same reason as above. + liftIO $ length diags @?= 1 + return () ] testDir :: FilePath -testDir = "plugins/hls-stan-plugin/test/testdata" +testDir = "plugins" "hls-stan-plugin" "test" "testdata" stanPlugin :: PluginTestDescriptor Stan.Log stanPlugin = mkPluginTestDescriptor enabledStanDescriptor "stan" diff --git a/plugins/hls-stan-plugin/test/testdata/.stan.toml b/plugins/hls-stan-plugin/test/testdata/.stan.toml index faff35467a..ce73b7f29c 100644 --- a/plugins/hls-stan-plugin/test/testdata/.stan.toml +++ b/plugins/hls-stan-plugin/test/testdata/.stan.toml @@ -1,10 +1,5 @@ # See https://github.com/kowainik/stan/issues/531 # Unix -[[check]] -type = "Exclude" -id = "STAN-0206" -scope = "all" - [[check]] type = "Exclude" id = "STAN-0103" @@ -16,11 +11,6 @@ id = "STAN-0212" directory = "dir/" # Windows -[[check]] -type = "Exclude" -id = "STAN-0206" -scope = "all" - [[check]] type = "Exclude" id = "STAN-0103" diff --git a/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs b/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs index b2ed26a745..add256058b 100644 --- a/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs +++ b/plugins/hls-stan-plugin/test/testdata/dir/configTest.hs @@ -1,5 +1,3 @@ -data A = A Int Int - a = length [1..] b = undefined diff --git a/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/CabalFileTest.hs b/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/CabalFileTest.hs new file mode 100644 index 0000000000..77b6dc3845 --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/CabalFileTest.hs @@ -0,0 +1,7 @@ +module CabalFileTest () where + +-- With `StrictData` enabled in the `.cabal` file, Stan shouldn't complain here: +data A = A Int Int + +-- ...but it should still complain here! +kewlFunc = undefined diff --git a/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/cabal-file-test.cabal b/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/cabal-file-test.cabal new file mode 100644 index 0000000000..094f06d1dd --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/extensions-cabal-file/cabal-file-test.cabal @@ -0,0 +1,9 @@ +cabal-version: 3.0 +name: cabal-file-test +version: 0.0.0.0 + +library + exposed-modules: CabalFileTest + hs-source-dirs: extensions-cabal-file + -- Specifically, we're testing that Stan respects the following extension definition: + default-extensions: StrictData diff --git a/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/LanguagePragmaTest.hs b/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/LanguagePragmaTest.hs new file mode 100644 index 0000000000..6f5631ac8c --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/LanguagePragmaTest.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE StrictData #-} + +module LanguagePragmaTest () where + +-- With the above `StrictData` language pragma, Stan shouldn't complain here: +data A = A Int Int + +-- ...but it should still complain here! +kewlFunc = undefined diff --git a/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/language-pragma-test.cabal b/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/language-pragma-test.cabal new file mode 100644 index 0000000000..336388d4fa --- /dev/null +++ b/plugins/hls-stan-plugin/test/testdata/extensions-language-pragma/language-pragma-test.cabal @@ -0,0 +1,11 @@ +cabal-version: 3.0 +name: language-pragma-test +version: 0.0.0.0 + +-- Without at least a minimal valid `.cabal` file, Stan won't bother building its +-- map of language extensions. This means it also won't detect LANGUAGE pragmas +-- without this file. + +library + exposed-modules: LanguagePragmaTest + hs-source-dirs: extensions-language-pragma