Skip to content

Commit 8bbc2b7

Browse files
0rphee0rphee
committed
Use stan config files for stan plugin (#3904)
1 parent 74466a9 commit 8bbc2b7

File tree

2 files changed

+77
-19
lines changed

2 files changed

+77
-19
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

+75-19
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,20 @@
11
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE PatternSynonyms #-}
23
module Ide.Plugin.Stan (descriptor, Log) where
34

4-
import Compat.HieTypes (HieASTs, HieFile)
5-
import Control.DeepSeq (NFData)
6-
import Control.Monad (void)
7-
import Control.Monad.IO.Class (liftIO)
8-
import Control.Monad.Trans.Class (lift)
9-
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
5+
import Compat.HieTypes (HieASTs, HieFile (..))
6+
import Control.DeepSeq (NFData)
7+
import Control.Monad (void, when)
8+
import Control.Monad.IO.Class (liftIO)
9+
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
1010
import Data.Default
11-
import Data.Foldable (toList)
12-
import Data.Hashable (Hashable)
13-
import qualified Data.HashMap.Strict as HM
14-
import qualified Data.Map as Map
15-
import Data.Maybe (fromJust, mapMaybe)
16-
import qualified Data.Text as T
11+
import Data.Foldable (toList)
12+
import Data.Hashable (Hashable)
13+
import qualified Data.HashMap.Strict as HM
14+
import qualified Data.Map as Map
15+
import Data.Maybe (fromJust, mapMaybe,
16+
maybeToList)
17+
import qualified Data.Text as T
1718
import Development.IDE
1819
import Development.IDE (Diagnostic (_codeDescription))
1920
import Development.IDE.Core.Rules (getHieFile,
@@ -26,7 +27,7 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs),
2627
runHsc, srcSpanEndCol,
2728
srcSpanEndLine,
2829
srcSpanStartCol,
29-
srcSpanStartLine, tcg_exports)
30+
srcSpanStartLine, tcg_exports, HieFile (hie_hs_file))
3031
import Development.IDE.GHC.Error (realSrcSpanToRange)
3132
import GHC.Generics (Generic)
3233
import Ide.Plugin.Config
@@ -36,12 +37,20 @@ import Ide.Types (PluginDescriptor (..),
3637
defaultPluginDescriptor,
3738
pluginEnabledConfig)
3839
import qualified Language.LSP.Protocol.Types as LSP
40+
import Stan (getStanConfig, createCabalExtensionsMap)
3941
import Stan.Analysis (Analysis (..), runAnalysis)
4042
import Stan.Category (Category (..))
4143
import Stan.Core.Id (Id (..))
4244
import Stan.Inspection (Inspection (..))
4345
import Stan.Inspection.All (inspectionsIds, inspectionsMap)
4446
import Stan.Observation (Observation (..))
47+
import System.Directory (makeRelativeToCurrentDirectory)
48+
import Stan.Cli (StanArgs (..))
49+
import Trial (whenResult, fiasco, pattern FiascoL, pattern ResultL, Fatality, Trial, TaggedTrial)
50+
import Stan.Report.Settings (ToggleSolution(..), Verbosity (..), OutputSettings (..))
51+
import Stan.Config (defaultConfig, ConfigP (..), applyConfig, Config)
52+
import Stan.EnvVars (EnvVars(..))
53+
import Data.HashSet (HashSet)
4554

4655
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
4756
descriptor recorder plId = (defaultPluginDescriptor plId desc)
@@ -53,11 +62,21 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc)
5362
where
5463
desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan
5564

56-
newtype Log = LogShake Shake.Log deriving (Show)
65+
data Log = LogShake !Shake.Log
66+
| LogWarnConf ![(Fatality, T.Text)]
67+
| LogDebugStanConfigResult !(Trial T.Text Stan.Config.Config)
68+
| LogDebugStanEnvVars !(TaggedTrial T.Text Bool)
69+
| LogDebugStanCheckMap !(HM.HashMap FilePath (HashSet (Id Inspection)))
70+
deriving (Show)
5771

5872
instance Pretty Log where
5973
pretty = \case
6074
LogShake log -> pretty log
75+
LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:"
76+
<> line <> (pretty $ show errs)
77+
LogDebugStanConfigResult t -> "Config result: " <> (pretty $ show t)
78+
LogDebugStanEnvVars t -> "Env vars: " <> (pretty $ show t)
79+
LogDebugStanCheckMap hm -> "Map of checks per file: " <> (pretty $ show hm)
6180

6281
data GetStanDiagnostics = GetStanDiagnostics
6382
deriving (Eq, Show, Generic)
@@ -72,15 +91,52 @@ rules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
7291
rules recorder plId = do
7392
define (cmapWithPrio LogShake recorder) $
7493
\GetStanDiagnostics file -> do
75-
config <- getPluginConfigAction plId
76-
if pluginEnabledConfig plcDiagnosticsOn config then do
94+
plugConfig <- getPluginConfigAction plId
95+
if pluginEnabledConfig plcDiagnosticsOn plugConfig then do
7796
maybeHie <- getHieFile file
7897
case maybeHie of
7998
Nothing -> return ([], Nothing)
8099
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]
100+
let isLoud = False -- in Stan: notJson = not isLoud
101+
let stanArgs =
102+
StanArgs
103+
{ stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files
104+
, stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files.
105+
, stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report
106+
-- doesnt matter, because it is silenced by isLoud
107+
, stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings
108+
, stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file
109+
, stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file.
110+
, stanArgsConfig = ConfigP {configChecks = fiasco "",
111+
configRemoved = fiasco "",
112+
configIgnored = fiasco ""} -- :: !PartialConfig
113+
-- if they are not fiascos, .stan.toml's aren't taken into account
114+
,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead.
115+
}
116+
117+
(configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud
118+
logWith recorder Debug (LogDebugStanConfigResult configTrial)
119+
logWith recorder Debug (LogDebugStanEnvVars $ envVarsUseDefaultConfigFile env)
120+
121+
(cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of
122+
FiascoL es -> do
123+
logWith recorder Warning (LogWarnConf es)
124+
pure (Map.empty,
125+
HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)],
126+
[])
127+
ResultL warnings stanConfig -> do
128+
let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie
129+
currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs
130+
cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie]
131+
132+
-- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative
133+
-- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths.
134+
let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig
135+
logWith recorder Debug (LogDebugStanCheckMap checksMap)
136+
137+
let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie]
138+
pure (cabalExtensionsMap, checksMap, configIgnored stanConfig)
139+
let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie]
84140
return (analysisToDiagnostics file analysis, Just ())
85141
else return ([], Nothing)
86142

0 commit comments

Comments
 (0)