Skip to content

Commit da7d167

Browse files
0rphee0rphee
committed
Use stan config files for stan plugin (#3904)
Improve logging. Using changes in: * https://github.com/0rphee/trial/tree/pprint-no-colour * https://github.com/0rphee/stan/tree/main
1 parent 74466a9 commit da7d167

File tree

2 files changed

+105
-13
lines changed

2 files changed

+105
-13
lines changed

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

+2
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,8 @@ library
4747
, transformers
4848
, unordered-containers
4949
, stan >= 0.1.1.0
50+
, trial
51+
, directory
5052

5153
default-language: Haskell2010
5254
default-extensions:

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

+103-13
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,22 @@
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
1822
import Development.IDE (Diagnostic (_codeDescription))
@@ -21,6 +25,7 @@ import Development.IDE.Core.Rules (getHieFile,
2125
import Development.IDE.Core.RuleTypes (HieAstResult (..))
2226
import qualified Development.IDE.Core.Shake as Shake
2327
import Development.IDE.GHC.Compat (HieASTs (HieASTs),
28+
HieFile (hie_hs_file),
2429
RealSrcSpan (..), mkHieFile',
2530
mkRealSrcLoc, mkRealSrcSpan,
2631
runHsc, srcSpanEndCol,
@@ -29,20 +34,40 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs),
2934
srcSpanStartLine, tcg_exports)
3035
import Development.IDE.GHC.Error (realSrcSpanToRange)
3136
import GHC.Generics (Generic)
32-
import Ide.Plugin.Config
37+
import Ide.Plugin.Config (PluginConfig (plcDiagnosticsOn))
3338
import Ide.Types (PluginDescriptor (..),
3439
PluginId, configHasDiagnostics,
3540
defaultConfigDescriptor,
3641
defaultPluginDescriptor,
3742
pluginEnabledConfig)
3843
import qualified Language.LSP.Protocol.Types as LSP
44+
import Stan (createCabalExtensionsMap,
45+
getStanConfig)
3946
import Stan.Analysis (Analysis (..), runAnalysis)
4047
import Stan.Category (Category (..))
48+
import Stan.Cli (StanArgs (..))
49+
import Stan.Config (Config, ConfigP (..),
50+
applyConfig, defaultConfig)
51+
import Stan.Config.Pretty (ConfigAction, configToTriples,
52+
prettyConfigAction,
53+
prettyConfigNoFormat)
4154
import Stan.Core.Id (Id (..))
55+
import Stan.EnvVars (EnvVars (..), envVarsToText)
4256
import Stan.Inspection (Inspection (..))
4357
import Stan.Inspection.All (inspectionsIds, inspectionsMap)
4458
import Stan.Observation (Observation (..))
45-
59+
import Stan.Report.Settings (OutputSettings (..),
60+
ToggleSolution (..),
61+
Verbosity (..))
62+
import Stan.Toml (usedTomlFiles)
63+
import System.Directory (makeRelativeToCurrentDirectory)
64+
import Trial (Fatality, Trial,
65+
fiasco,
66+
pattern FiascoL,
67+
pattern ResultL,
68+
prettyTrialNoColour,
69+
prettyTrialWithNoColour,
70+
)
4671
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
4772
descriptor recorder plId = (defaultPluginDescriptor plId desc)
4873
{ pluginRules = rules recorder plId
@@ -53,11 +78,33 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc)
5378
where
5479
desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan
5580

56-
newtype Log = LogShake Shake.Log deriving (Show)
81+
data Log = LogShake !Shake.Log
82+
| LogWarnConf ![(Fatality, T.Text)]
83+
| LogDebugStanConfigResult ![FilePath] !(Trial T.Text Config)
84+
| LogDebugStanEnvVars !EnvVars
85+
| LogDebugStanCheckMap !(HM.HashMap FilePath (HashSet (Id Inspection)))
86+
87+
renderId :: Id a -> T.Text
88+
renderId (Id t) = "Id = " <> t
5789

5890
instance Pretty Log where
5991
pretty = \case
6092
LogShake log -> pretty log
93+
LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:"
94+
<> line <> (pretty $ show errs)
95+
LogDebugStanConfigResult fps t -> "Config result using: "
96+
<> pretty fps <> line <> pretty (prettyTrialWithNoColour (T.unpack . prettyConfigNoFormat) t)
97+
LogDebugStanEnvVars envVars -> "EnvVars " <>
98+
case envVars of
99+
EnvVars trial@(FiascoL xs) -> pretty (prettyTrialNoColour trial)
100+
101+
-- if the envVars are not set, 'envVarsToText returns an empty string'
102+
_ -> "found: " <> (pretty $ envVarsToText envVars)
103+
LogDebugStanCheckMap hm -> "Checks per file: " <>
104+
case HM.toList hm of
105+
[(fp, hashSetInspections )] -> "Inspections set for " <> pretty fp <> line <> (pretty $ fmap renderId $ HS.toList hashSetInspections)
106+
-- This case should not happen. Only one file is used in each analysis.
107+
_-> pretty $ show hm
61108

62109
data GetStanDiagnostics = GetStanDiagnostics
63110
deriving (Eq, Show, Generic)
@@ -72,15 +119,58 @@ rules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
72119
rules recorder plId = do
73120
define (cmapWithPrio LogShake recorder) $
74121
\GetStanDiagnostics file -> do
75-
config <- getPluginConfigAction plId
76-
if pluginEnabledConfig plcDiagnosticsOn config then do
122+
plugConfig <- getPluginConfigAction plId
123+
if pluginEnabledConfig plcDiagnosticsOn plugConfig then do
77124
maybeHie <- getHieFile file
78125
case maybeHie of
79126
Nothing -> return ([], Nothing)
80127
Just hie -> do
81-
let enabledInspections = HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)]
82-
-- This should use Cabal config for extensions and Stan config for inspection preferences is the future
83-
let analysis = runAnalysis Map.empty enabledInspections [] [hie]
128+
let isLoud = False -- in Stan: notJson = not isLoud
129+
let stanArgs =
130+
StanArgs
131+
{ stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files
132+
, stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files.
133+
, stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report
134+
-- doesnt matter, because it is silenced by isLoud
135+
, stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings
136+
, stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file
137+
, stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file.
138+
, stanArgsConfig = ConfigP
139+
{ configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks"
140+
, configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove"
141+
, configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore"
142+
}
143+
-- if they are not fiascos, .stan.toml's aren't taken into account
144+
,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead.
145+
}
146+
147+
(configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud
148+
seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)
149+
logWith recorder Debug (LogDebugStanConfigResult seTomlFiles configTrial)
150+
151+
-- If envVar is set to 'False', stan will ignore all local and global .stan.toml files
152+
logWith recorder Debug (LogDebugStanEnvVars env)
153+
seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)
154+
155+
(cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of
156+
FiascoL es -> do
157+
logWith recorder Development.IDE.Warning (LogWarnConf es)
158+
pure (Map.empty,
159+
HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)],
160+
[])
161+
ResultL warnings stanConfig -> do
162+
let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie
163+
currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs
164+
cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie]
165+
166+
-- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative
167+
-- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths.
168+
let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig
169+
logWith recorder Debug (LogDebugStanCheckMap checksMap)
170+
171+
let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie]
172+
pure (cabalExtensionsMap, checksMap, configIgnored stanConfig)
173+
let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie]
84174
return (analysisToDiagnostics file analysis, Just ())
85175
else return ([], Nothing)
86176

0 commit comments

Comments
 (0)