Skip to content

Commit 750fca7

Browse files
0rphee0rphee
committed
Use stan config files for stan plugin (#3904)
1 parent 744dfa5 commit 750fca7

File tree

1 file changed

+107
-12
lines changed
  • plugins/hls-stan-plugin/src/Ide/Plugin

1 file changed

+107
-12
lines changed

‎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

0 commit comments

Comments
 (0)