Use relative file paths for HIE files and Stan's config maps (#4023)

* Use relative file paths for HIE files and Stan's config maps

Stan expects relative paths. Without this change, file names won't map
correctly to their associated language extension data, which means no
enabled extensions will be detected. This causes annoying false
positives with, e.g., the `StrictData` extension. (See issue #3174.)

* Un-exclude Stan diagnostics related to `StrictData`

We specifically want to test this diagnostic, so we need it to fire.

* Add tests to ensure the Stan plugin detects a module's language extensions

Includes test cases for both `LANGUAGE` pragmas and extensions enabled
in a project's `.cabal` file.

* Tighten up Stan plugin language extension test cases

These changes ensure that the tests will fail given bad mappings in
either the `cabalExtensionsMap` OR the `checksMap`. Either of these
could cause bad behavior as seen in issue #3174.

* Use correct extension/file mappings even in the case of a config fiasco

The Stan plugin will still operate as expected even if we can't load a
config -- it will simply default to showing all inspections.

* Remove a slew of unused imports

* Use OS-agnostic path separators in tests

* Run `stylish-haskell`

* Ensure `hs-source-dirs` in test cabal files don't contain path separators

 Related to (what I assume is) a bug in Stan, or its `extensions`
 library. Regardless of OS, the `hs-source-dirs` field is prepended
 as-is to the module name to create the file paths used in the cabal
 extensions map. This means the maps won't work in Windows if your cabal
 file contains `/` path separators. Working around the limitation here
 to ensure tests work on all platforms.

---------

Co-authored-by: Michael Peyton Jones <[email protected]>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

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)
 

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"

plugins/hls-stan-plugin/test/testdata/.stan.toml

@@ -1,10 +1,5 @@
 # See https:/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"

plugins/hls-stan-plugin/test/testdata/dir/configTest.hs

@@ -1,5 +1,3 @@
-data A = A Int Int
-
 a = length [1..]
 
 b = undefined

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

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

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

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