|
2 | 2 | {-# LANGUAGE PatternSynonyms #-} |
3 | 3 | module Ide.Plugin.Stan (descriptor, Log) where |
4 | 4 |
|
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) |
10 | | -import Data.Default |
11 | | -import Data.Foldable (toList) |
12 | | -import Data.Hashable (Hashable) |
13 | | -import qualified Data.HashMap.Strict as HM |
14 | | -import Data.HashSet (HashSet) |
15 | | -import qualified Data.HashSet as HS |
16 | | -import qualified Data.Map as Map |
17 | | -import Data.Maybe (fromJust, mapMaybe, |
18 | | - maybeToList) |
19 | | -import Data.String (IsString (fromString)) |
20 | | -import qualified Data.Text as T |
| 5 | +import Compat.HieTypes (HieFile (..)) |
| 6 | +import Control.DeepSeq (NFData) |
| 7 | +import Control.Monad (void) |
| 8 | +import Control.Monad.IO.Class (liftIO) |
| 9 | +import Data.Foldable (toList) |
| 10 | +import Data.Hashable (Hashable) |
| 11 | +import qualified Data.HashMap.Strict as HM |
| 12 | +import Data.Maybe (mapMaybe) |
| 13 | +import qualified Data.Text as T |
21 | 14 | import Development.IDE |
22 | | -import Development.IDE.Core.Rules (getHieFile, |
23 | | - getSourceFileSource) |
24 | | -import Development.IDE.Core.RuleTypes (HieAstResult (..)) |
25 | | -import qualified Development.IDE.Core.Shake as Shake |
26 | | -import Development.IDE.GHC.Compat (HieASTs (HieASTs), |
27 | | - HieFile (hie_hs_file), |
28 | | - RealSrcSpan (..), mkHieFile', |
29 | | - mkRealSrcLoc, mkRealSrcSpan, |
30 | | - runHsc, srcSpanEndCol, |
31 | | - srcSpanEndLine, |
32 | | - srcSpanStartCol, |
33 | | - srcSpanStartLine, tcg_exports) |
34 | | -import Development.IDE.GHC.Error (realSrcSpanToRange) |
35 | | -import GHC.Generics (Generic) |
36 | | -import Ide.Plugin.Config (PluginConfig (..)) |
37 | | -import Ide.Types (PluginDescriptor (..), |
38 | | - PluginId, configHasDiagnostics, |
39 | | - configInitialGenericConfig, |
40 | | - defaultConfigDescriptor, |
41 | | - defaultPluginDescriptor) |
42 | | -import qualified Language.LSP.Protocol.Types as LSP |
43 | | -import Stan (createCabalExtensionsMap, |
44 | | - getStanConfig) |
45 | | -import Stan.Analysis (Analysis (..), runAnalysis) |
46 | | -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) |
53 | | -import Stan.Core.Id (Id (..)) |
54 | | -import Stan.EnvVars (EnvVars (..), envVarsToText) |
55 | | -import Stan.Inspection (Inspection (..)) |
56 | | -import Stan.Inspection.All (inspectionsIds, inspectionsMap) |
57 | | -import Stan.Observation (Observation (..)) |
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) |
| 15 | +import Development.IDE.Core.Rules (getHieFile) |
| 16 | +import qualified Development.IDE.Core.Shake as Shake |
| 17 | +import GHC.Generics (Generic) |
| 18 | +import Ide.Plugin.Config (PluginConfig (..)) |
| 19 | +import Ide.Types (PluginDescriptor (..), PluginId, |
| 20 | + configHasDiagnostics, |
| 21 | + configInitialGenericConfig, |
| 22 | + defaultConfigDescriptor, |
| 23 | + defaultPluginDescriptor) |
| 24 | +import qualified Language.LSP.Protocol.Types as LSP |
| 25 | +import Stan (createCabalExtensionsMap, |
| 26 | + getStanConfig) |
| 27 | +import Stan.Analysis (Analysis (..), runAnalysis) |
| 28 | +import Stan.Category (Category (..)) |
| 29 | +import Stan.Cli (StanArgs (..)) |
| 30 | +import Stan.Config (Config, ConfigP (..), applyConfig) |
| 31 | +import Stan.Config.Pretty (prettyConfigCli) |
| 32 | +import Stan.Core.Id (Id (..)) |
| 33 | +import Stan.EnvVars (EnvVars (..), envVarsToText) |
| 34 | +import Stan.Inspection (Inspection (..)) |
| 35 | +import Stan.Inspection.All (inspectionsIds, inspectionsMap) |
| 36 | +import Stan.Observation (Observation (..)) |
| 37 | +import Stan.Report.Settings (OutputSettings (..), |
| 38 | + ToggleSolution (..), |
| 39 | + Verbosity (..)) |
| 40 | +import Stan.Toml (usedTomlFiles) |
| 41 | +import System.Directory (makeRelativeToCurrentDirectory) |
| 42 | +import Trial (Fatality, Trial (..), fiasco, |
| 43 | + pattern FiascoL, pattern ResultL, |
| 44 | + prettyTrial, prettyTrialWith) |
| 45 | + |
67 | 46 | descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState |
68 | 47 | descriptor recorder plId = (defaultPluginDescriptor plId desc) |
69 | 48 | { pluginRules = rules recorder plId |
@@ -164,24 +143,25 @@ rules recorder plId = do |
164 | 143 | logWith recorder Debug (LogDebugStanEnvVars env) |
165 | 144 | seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs) |
166 | 145 |
|
167 | | - (cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of |
| 146 | + -- Note that Stan works in terms of relative paths, but the HIE come in as absolute. Without |
| 147 | + -- making its path relative, the file name(s) won't line up with the associated Map keys. |
| 148 | + relativeHsFilePath <- liftIO $ makeRelativeToCurrentDirectory $ fromNormalizedFilePath file |
| 149 | + let hieRelative = hie{hie_hs_file=relativeHsFilePath} |
| 150 | + |
| 151 | + (checksMap, ignoredObservations) <- case configTrial of |
168 | 152 | FiascoL es -> do |
169 | 153 | 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] |
| 154 | + -- If we can't read the config file, default to using all inspections: |
| 155 | + let allInspections = HM.fromList [(relativeHsFilePath, inspectionsIds)] |
| 156 | + pure (allInspections, []) |
| 157 | + ResultL _warnings stanConfig -> do |
| 158 | + -- HashMap of *relative* file paths to info about enabled checks for those file paths. |
| 159 | + let checksMap = applyConfig [relativeHsFilePath] stanConfig |
| 160 | + pure (checksMap, configIgnored stanConfig) |
| 161 | + |
| 162 | + -- A Map from *relative* file paths (just one, in this case) to language extension info: |
| 163 | + cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hieRelative] |
| 164 | + let analysis = runAnalysis cabalExtensionsMap checksMap ignoredObservations [hieRelative] |
185 | 165 | return (analysisToDiagnostics file analysis, Just ()) |
186 | 166 | else return ([], Nothing) |
187 | 167 |
|
|
0 commit comments