Use stan config files for stan plugin (#3904)

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

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:

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)
 

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

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\\"

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

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

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

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