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

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://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"

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