Skip to content

Commit 5091256

Browse files
soulomoonsoulomoon
committed
Squashed commit of the following:
commit 2fe2d70 Merge: 034b33e bea1fed Author: fendor <fendor@users.noreply.github.com> Date: Thu Jan 11 16:05:34 2024 +0100 Merge pull request #3941 from fendor/enhance/cabal-no-diags-if-disabled Don't produce diagnostics if plugin is turned off commit bea1fed Merge: e9aab3c 034b33e Author: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> Date: Thu Jan 11 13:54:12 2024 +0000 Merge branch 'master' into enhance/cabal-no-diags-if-disabled commit e9aab3c Author: Fendor <power.walross@gmail.com> Date: Wed Jan 10 17:18:39 2024 +0100 Don't produce diagnostics if plugin is turned off commit 034b33e Author: 0rphee <0rph3e@proton.me> Date: Thu Jan 11 02:53:11 2024 -0600 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 kowainik/stan#531 --------- Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
1 parent 38c339e commit 5091256

File tree

10 files changed

+188
-44
lines changed

10 files changed

+188
-44
lines changed

‎cabal.project

+1-1
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ packages:
3636
./plugins/hls-overloaded-record-dot-plugin
3737
./plugins/hls-semantic-tokens-plugin
3838

39-
index-state: 2023-12-13T00:00:00Z
39+
index-state: 2024-01-05T19:06:05Z
4040

4141
tests: True
4242
test-show-details: direct

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

+28-24
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,7 @@ instance Pretty Log where
8181
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
8282
descriptor recorder plId =
8383
(defaultCabalPluginDescriptor plId "Provides a variety of IDE features in cabal files")
84-
{ pluginRules = cabalRules recorder
84+
{ pluginRules = cabalRules recorder plId
8585
, pluginHandlers =
8686
mconcat
8787
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
@@ -139,31 +139,35 @@ restartCabalShakeSession shakeExtras vfs file actionMsg = do
139139
-- Plugin Rules
140140
-- ----------------------------------------------------------------
141141

142-
cabalRules :: Recorder (WithPriority Log) -> Rules ()
143-
cabalRules recorder = do
142+
cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
143+
cabalRules recorder plId = do
144144
-- Make sure we initialise the cabal files-of-interest.
145145
ofInterestRules recorder
146146
-- Rule to produce diagnostics for cabal files.
147-
define (cmapWithPrio LogShake recorder) $ \Types.ParseCabal file -> do
148-
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
149-
-- we rerun this rule because this rule *depends* on GetModificationTime.
150-
(t, mCabalSource) <- use_ GetFileContents file
151-
log' Debug $ LogModificationTime file t
152-
contents <- case mCabalSource of
153-
Just sources ->
154-
pure $ Encoding.encodeUtf8 sources
155-
Nothing -> do
156-
liftIO $ BS.readFile $ fromNormalizedFilePath file
147+
define (cmapWithPrio LogShake recorder) $ \Types.GetCabalDiagnostics file -> do
148+
config <- getPluginConfigAction plId
149+
if not (plcGlobalOn config && plcDiagnosticsOn config)
150+
then pure ([], Nothing)
151+
else do
152+
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
153+
-- we rerun this rule because this rule *depends* on GetModificationTime.
154+
(t, mCabalSource) <- use_ GetFileContents file
155+
log' Debug $ LogModificationTime file t
156+
contents <- case mCabalSource of
157+
Just sources ->
158+
pure $ Encoding.encodeUtf8 sources
159+
Nothing -> do
160+
liftIO $ BS.readFile $ fromNormalizedFilePath file
157161

158-
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
159-
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
160-
case pm of
161-
Left (_cabalVersion, pErrorNE) -> do
162-
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
163-
allDiags = errorDiags <> warningDiags
164-
pure (allDiags, Nothing)
165-
Right gpd -> do
166-
pure (warningDiags, Just gpd)
162+
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
163+
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
164+
case pm of
165+
Left (_cabalVersion, pErrorNE) -> do
166+
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
167+
allDiags = errorDiags <> warningDiags
168+
pure (allDiags, Nothing)
169+
Right gpd -> do
170+
pure (warningDiags, Just gpd)
167171

168172
action $ do
169173
-- Run the cabal kick. This code always runs when 'shakeRestart' is run.
@@ -183,7 +187,7 @@ function invocation.
183187
kick :: Action ()
184188
kick = do
185189
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
186-
void $ uses Types.ParseCabal files
190+
void $ uses Types.GetCabalDiagnostics files
187191

188192
-- ----------------------------------------------------------------
189193
-- Code Actions
@@ -292,7 +296,7 @@ completion recorder ide _ complParams = do
292296
let completer = Completions.contextToCompleter ctx
293297
let completerData = CompleterTypes.CompleterData
294298
{ getLatestGPD = do
295-
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.ParseCabal $ toNormalizedFilePath fp
299+
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
296300
pure $ fmap fst mGPD
297301
, cabalPrefixInfo = prefInfo
298302
, stanzaName =

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -37,14 +37,14 @@ instance Pretty Log where
3737
LogUseWithStaleFastNoResult -> "Package description couldn't be read"
3838
LogMapLookUpOfKnownKeyFailed key -> "Lookup of key in map failed even though it should exist" <+> pretty key
3939

40-
type instance RuleResult ParseCabal = Parse.GenericPackageDescription
40+
type instance RuleResult GetCabalDiagnostics = Parse.GenericPackageDescription
4141

42-
data ParseCabal = ParseCabal
42+
data GetCabalDiagnostics = GetCabalDiagnostics
4343
deriving (Eq, Show, Typeable, Generic)
4444

45-
instance Hashable ParseCabal
45+
instance Hashable GetCabalDiagnostics
4646

47-
instance NFData ParseCabal
47+
instance NFData GetCabalDiagnostics
4848

4949
-- | The context a cursor can be in within a cabal file.
5050
--

‎plugins/hls-stan-plugin/hls-stan-plugin.cabal

+3-1
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,9 @@ library
4646
, text
4747
, transformers
4848
, unordered-containers
49-
, stan >= 0.1.1.0
49+
, stan >= 0.1.2.0
50+
, trial
51+
, directory
5052

5153
default-language: Haskell2010
5254
default-extensions:

‎plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs

+107-12
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,30 @@
1-
{-# LANGUAGE CPP #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE PatternSynonyms #-}
23
module Ide.Plugin.Stan (descriptor, Log) where
34

4-
import Compat.HieTypes (HieASTs, HieFile)
5+
import Compat.HieTypes (HieASTs, HieFile (..))
56
import Control.DeepSeq (NFData)
6-
import Control.Monad (void)
7+
import Control.Monad (void, when)
78
import Control.Monad.IO.Class (liftIO)
8-
import Control.Monad.Trans.Class (lift)
99
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
1010
import Data.Default
1111
import Data.Foldable (toList)
1212
import Data.Hashable (Hashable)
1313
import qualified Data.HashMap.Strict as HM
14+
import Data.HashSet (HashSet)
15+
import qualified Data.HashSet as HS
1416
import qualified Data.Map as Map
15-
import Data.Maybe (fromJust, mapMaybe)
17+
import Data.Maybe (fromJust, mapMaybe,
18+
maybeToList)
19+
import Data.String (IsString (fromString))
1620
import qualified Data.Text as T
1721
import Development.IDE
18-
import Development.IDE (Diagnostic (_codeDescription))
1922
import Development.IDE.Core.Rules (getHieFile,
2023
getSourceFileSource)
2124
import Development.IDE.Core.RuleTypes (HieAstResult (..))
2225
import qualified Development.IDE.Core.Shake as Shake
2326
import Development.IDE.GHC.Compat (HieASTs (HieASTs),
27+
HieFile (hie_hs_file),
2428
RealSrcSpan (..), mkHieFile',
2529
mkRealSrcLoc, mkRealSrcSpan,
2630
runHsc, srcSpanEndCol,
@@ -29,20 +33,37 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs),
2933
srcSpanStartLine, tcg_exports)
3034
import Development.IDE.GHC.Error (realSrcSpanToRange)
3135
import GHC.Generics (Generic)
32-
import Ide.Plugin.Config
36+
import Ide.Plugin.Config (PluginConfig (..))
3337
import Ide.Types (PluginDescriptor (..),
3438
PluginId, configHasDiagnostics,
3539
configInitialGenericConfig,
3640
defaultConfigDescriptor,
3741
defaultPluginDescriptor)
3842
import qualified Language.LSP.Protocol.Types as LSP
43+
import Stan (createCabalExtensionsMap,
44+
getStanConfig)
3945
import Stan.Analysis (Analysis (..), runAnalysis)
4046
import Stan.Category (Category (..))
47+
import Stan.Cli (StanArgs (..))
48+
import Stan.Config (Config, ConfigP (..),
49+
applyConfig, defaultConfig)
50+
import Stan.Config.Pretty (ConfigAction, configToTriples,
51+
prettyConfigAction,
52+
prettyConfigCli)
4153
import Stan.Core.Id (Id (..))
54+
import Stan.EnvVars (EnvVars (..), envVarsToText)
4255
import Stan.Inspection (Inspection (..))
4356
import Stan.Inspection.All (inspectionsIds, inspectionsMap)
4457
import Stan.Observation (Observation (..))
45-
58+
import Stan.Report.Settings (OutputSettings (..),
59+
ToggleSolution (..),
60+
Verbosity (..))
61+
import Stan.Toml (usedTomlFiles)
62+
import System.Directory (makeRelativeToCurrentDirectory)
63+
import Trial (Fatality, Trial (..), fiasco,
64+
pattern FiascoL,
65+
pattern ResultL, prettyTrial,
66+
prettyTrialWith)
4667
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
4768
descriptor recorder plId = (defaultPluginDescriptor plId desc)
4869
{ pluginRules = rules recorder plId
@@ -59,11 +80,43 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc)
5980
defConfigDescriptor = defaultConfigDescriptor
6081
desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan
6182

62-
newtype Log = LogShake Shake.Log deriving (Show)
83+
data Log = LogShake !Shake.Log
84+
| LogWarnConf ![(Fatality, T.Text)]
85+
| LogDebugStanConfigResult ![FilePath] !(Trial T.Text Config)
86+
| LogDebugStanEnvVars !EnvVars
87+
88+
-- We use this function to remove the terminal escape sequences emmited by Trial pretty printing functions.
89+
-- See https://github.com/kowainik/trial/pull/73#issuecomment-1868233235
90+
stripModifiers :: T.Text -> T.Text
91+
stripModifiers = go ""
92+
where
93+
go acc txt =
94+
case T.findIndex (== '\x1B') txt of
95+
Nothing -> acc <> txt
96+
Just index -> let (beforeEsc, afterEsc) = T.splitAt index txt
97+
in go (acc <> beforeEsc) (consumeEscapeSequence afterEsc)
98+
consumeEscapeSequence :: T.Text -> T.Text
99+
consumeEscapeSequence txt =
100+
case T.findIndex (== 'm') txt of
101+
Nothing -> txt
102+
Just index -> T.drop (index + 1) txt
103+
104+
renderId :: Id a -> T.Text
105+
renderId (Id t) = "Id = " <> t
63106

64107
instance Pretty Log where
65108
pretty = \case
66109
LogShake log -> pretty log
110+
LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:"
111+
<> line <> (pretty $ show errs)
112+
LogDebugStanConfigResult fps t -> "Config result using: "
113+
<> pretty fps <> line <> pretty (stripModifiers $ prettyTrialWith (T.unpack . prettyConfigCli) t)
114+
LogDebugStanEnvVars envVars -> "EnvVars " <>
115+
case envVars of
116+
EnvVars trial@(FiascoL _) -> pretty (stripModifiers $ prettyTrial trial)
117+
118+
-- if the envVars are not set, 'envVarsToText returns an empty string'
119+
_ -> "found: " <> (pretty $ envVarsToText envVars)
67120

68121
data GetStanDiagnostics = GetStanDiagnostics
69122
deriving (Eq, Show, Generic)
@@ -84,9 +137,51 @@ rules recorder plId = do
84137
case maybeHie of
85138
Nothing -> return ([], Nothing)
86139
Just hie -> do
87-
let enabledInspections = HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)]
88-
-- This should use Cabal config for extensions and Stan config for inspection preferences is the future
89-
let analysis = runAnalysis Map.empty enabledInspections [] [hie]
140+
let isLoud = False -- in Stan: notJson = not isLoud
141+
let stanArgs =
142+
StanArgs
143+
{ stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files
144+
, stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files.
145+
, stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report
146+
-- doesnt matter, because it is silenced by isLoud
147+
, stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings
148+
, stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file
149+
, stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file.
150+
, stanArgsConfig = ConfigP
151+
{ configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks"
152+
, configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove"
153+
, configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore"
154+
}
155+
-- if they are not fiascos, .stan.toml's aren't taken into account
156+
,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead.
157+
}
158+
159+
(configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud
160+
seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)
161+
logWith recorder Debug (LogDebugStanConfigResult seTomlFiles configTrial)
162+
163+
-- If envVar is set to 'False', stan will ignore all local and global .stan.toml files
164+
logWith recorder Debug (LogDebugStanEnvVars env)
165+
seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)
166+
167+
(cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of
168+
FiascoL es -> do
169+
logWith recorder Development.IDE.Warning (LogWarnConf es)
170+
pure (Map.empty,
171+
HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)],
172+
[])
173+
ResultL warnings stanConfig -> do
174+
let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie
175+
currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs
176+
cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie]
177+
178+
-- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative
179+
-- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths.
180+
let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig
181+
182+
let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie]
183+
pure (cabalExtensionsMap, checksMap, configIgnored stanConfig)
184+
let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie]
90185
return (analysisToDiagnostics file analysis, Just ())
91186
else return ([], Nothing)
92187

‎plugins/hls-stan-plugin/test/Main.hs

+6
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,12 @@ tests =
3434
assertBool "" $ T.isPrefixOf expectedPrefix (reduceDiag ^. L.message)
3535
reduceDiag ^. L.source @?= Just "stan"
3636
return ()
37+
, testCase "ignores diagnostics from .stan.toml" $
38+
runStanSession "" $ do
39+
doc <- openDoc "dir/configTest.hs" "haskell"
40+
diags <- waitForDiagnosticsFromSource doc "stan"
41+
liftIO $ length diags @?= 0
42+
return ()
3743
]
3844

3945
testDir :: FilePath

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

+32
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
# See https://github.com/kowainik/stan/issues/531
2+
# Unix
3+
[[check]]
4+
type = "Exclude"
5+
id = "STAN-0206"
6+
scope = "all"
7+
8+
[[check]]
9+
type = "Exclude"
10+
id = "STAN-0103"
11+
file = "dir/configTest.hs"
12+
13+
[[check]]
14+
type = "Exclude"
15+
id = "STAN-0212"
16+
directory = "dir/"
17+
18+
# Windows
19+
[[check]]
20+
type = "Exclude"
21+
id = "STAN-0206"
22+
scope = "all"
23+
24+
[[check]]
25+
type = "Exclude"
26+
id = "STAN-0103"
27+
file = "dir\\configTest.hs"
28+
29+
[[check]]
30+
type = "Exclude"
31+
id = "STAN-0212"
32+
directory = "dir\\"

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

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
data A = A Int Int
2+
3+
a = length [1..]
4+
5+
b = undefined

‎stack-lts21.yaml

+1-1
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ extra-deps:
5656
- lsp-types-2.1.0.0
5757

5858
# stan dependencies not found in the stackage snapshot
59-
- stan-0.1.0.2
59+
- stan-0.1.2.0
6060
- clay-0.14.0
6161
- dir-traverse-0.2.3.0
6262
- extensions-0.1.0.0

‎stack.yaml

+1-1
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ extra-deps:
5959
- optparse-applicative-0.17.1.0
6060

6161
# stan and friends
62-
- stan-0.1.1.0
62+
- stan-0.1.2.0
6363
- clay-0.14.0
6464
- colourista-0.1.0.2
6565
- dir-traverse-0.2.3.0

0 commit comments

Comments
 (0)