Skip to content

Commit 034b33e

Browse files
0rpheemichaelpj
0rphee
and
michaelpj
authored
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 ade0e85 commit 034b33e

File tree

8 files changed

+156
-16
lines changed

8 files changed

+156
-16
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-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)