hls-stan-plugin 2.5.0.0 → 2.6.0.0
raw patch · 3 files changed
+146/−20 lines, 3 filesdep +directorydep +trialdep ~hls-test-utilsdep ~stan
Dependencies added: directory, trial
Dependency ranges changed: hls-test-utils, stan
Files
- hls-stan-plugin.cabal +5/−3
- src/Ide/Plugin/Stan.hs +120/−16
- test/Main.hs +21/−1
hls-stan-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-stan-plugin-version: 2.5.0.0+version: 2.6.0.0 synopsis: Stan integration plugin with Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -46,7 +46,9 @@ , text , transformers , unordered-containers- , stan+ , stan >= 0.1.2.0+ , trial+ , directory default-language: Haskell2010 default-extensions:@@ -75,7 +77,7 @@ , filepath , hls-stan-plugin , hls-plugin-api- , hls-test-utils == 2.5.0.0+ , hls-test-utils == 2.6.0.0 , lens , lsp-types , text
src/Ide/Plugin/Stan.hs view
@@ -1,25 +1,30 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-} module Ide.Plugin.Stan (descriptor, Log) where -import Compat.HieTypes (HieASTs, HieFile)+import Compat.HieTypes (HieASTs, HieFile (..)) import Control.DeepSeq (NFData)-import Control.Monad (void)+import Control.Monad (void, when) import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Data.Default import Data.Foldable (toList) import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM+import Data.HashSet (HashSet)+import qualified Data.HashSet as HS import qualified Data.Map as Map-import Data.Maybe (fromJust, mapMaybe)+import Data.Maybe (fromJust, mapMaybe,+ maybeToList)+import Data.String (IsString (fromString)) import qualified Data.Text as T import Development.IDE-import Development.IDE (Diagnostic (_codeDescription)) import Development.IDE.Core.Rules (getHieFile, getSourceFileSource) import Development.IDE.Core.RuleTypes (HieAstResult (..)) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat (HieASTs (HieASTs),+ HieFile (hie_hs_file), RealSrcSpan (..), mkHieFile', mkRealSrcLoc, mkRealSrcSpan, runHsc, srcSpanEndCol,@@ -28,34 +33,91 @@ srcSpanStartLine, tcg_exports) import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic)-import Ide.Plugin.Config+import Ide.Plugin.Config (PluginConfig (..)) import Ide.Types (PluginDescriptor (..), PluginId, configHasDiagnostics,+ configInitialGenericConfig, defaultConfigDescriptor,- defaultPluginDescriptor,- pluginEnabledConfig)+ defaultPluginDescriptor) import qualified Language.LSP.Protocol.Types as LSP+import Stan (createCabalExtensionsMap,+ getStanConfig) import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Category (Category (..))+import Stan.Cli (StanArgs (..))+import Stan.Config (Config, ConfigP (..),+ applyConfig, defaultConfig)+import Stan.Config.Pretty (ConfigAction, configToTriples,+ prettyConfigAction,+ prettyConfigCli) import Stan.Core.Id (Id (..))+import Stan.EnvVars (EnvVars (..), envVarsToText) import Stan.Inspection (Inspection (..)) import Stan.Inspection.All (inspectionsIds, inspectionsMap) import Stan.Observation (Observation (..))-+import Stan.Report.Settings (OutputSettings (..),+ ToggleSolution (..),+ Verbosity (..))+import Stan.Toml (usedTomlFiles)+import System.Directory (makeRelativeToCurrentDirectory)+import Trial (Fatality, Trial (..), fiasco,+ pattern FiascoL,+ pattern ResultL, prettyTrial,+ prettyTrialWith) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState-descriptor recorder plId = (defaultPluginDescriptor plId)+descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginRules = rules recorder plId- , pluginConfigDescriptor = defaultConfigDescriptor+ , pluginConfigDescriptor = defConfigDescriptor { configHasDiagnostics = True+ -- We disable this plugin by default because users have been complaining about+ -- the diagnostics, see https://github.com/haskell/haskell-language-server/issues/3916+ , configInitialGenericConfig = (configInitialGenericConfig defConfigDescriptor)+ { plcGlobalOn = False+ } } }+ where+ defConfigDescriptor = defaultConfigDescriptor+ desc = "Provides stan diagnostics. Built with stan-" <> VERSION_stan -newtype Log = LogShake Shake.Log deriving (Show)+data Log = LogShake !Shake.Log+ | LogWarnConf ![(Fatality, T.Text)]+ | LogDebugStanConfigResult ![FilePath] !(Trial T.Text Config)+ | LogDebugStanEnvVars !EnvVars +-- We use this function to remove the terminal escape sequences emmited by Trial pretty printing functions.+-- See https://github.com/kowainik/trial/pull/73#issuecomment-1868233235+stripModifiers :: T.Text -> T.Text+stripModifiers = go ""+ where+ go acc txt =+ case T.findIndex (== '\x1B') txt of+ Nothing -> acc <> txt+ Just index -> let (beforeEsc, afterEsc) = T.splitAt index txt+ in go (acc <> beforeEsc) (consumeEscapeSequence afterEsc)+ consumeEscapeSequence :: T.Text -> T.Text+ consumeEscapeSequence txt =+ case T.findIndex (== 'm') txt of+ Nothing -> txt+ Just index -> T.drop (index + 1) txt++renderId :: Id a -> T.Text+renderId (Id t) = "Id = " <> t+ instance Pretty Log where pretty = \case LogShake log -> pretty log+ LogWarnConf errs -> "Fiasco encountered when trying to load stan configuration. Using default inspections:"+ <> line <> (pretty $ show errs)+ LogDebugStanConfigResult fps t -> "Config result using: "+ <> pretty fps <> line <> pretty (stripModifiers $ prettyTrialWith (T.unpack . prettyConfigCli) t)+ LogDebugStanEnvVars envVars -> "EnvVars " <>+ case envVars of+ EnvVars trial@(FiascoL _) -> pretty (stripModifiers $ prettyTrial trial) + -- if the envVars are not set, 'envVarsToText returns an empty string'+ _ -> "found: " <> (pretty $ envVarsToText envVars)+ data GetStanDiagnostics = GetStanDiagnostics deriving (Eq, Show, Generic) @@ -70,14 +132,56 @@ define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics file -> do config <- getPluginConfigAction plId- if pluginEnabledConfig plcDiagnosticsOn config then do+ if plcGlobalOn config && plcDiagnosticsOn config then do maybeHie <- getHieFile file case maybeHie of Nothing -> return ([], Nothing) Just hie -> do- let enabledInspections = HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)]- -- This should use Cabal config for extensions and Stan config for inspection preferences is the future- let analysis = runAnalysis Map.empty enabledInspections [] [hie]+ let isLoud = False -- in Stan: notJson = not isLoud+ let stanArgs =+ StanArgs+ { stanArgsHiedir = "" -- :: !FilePath -- ^ Directory with HIE files+ , stanArgsCabalFilePath = [] -- :: ![FilePath] -- ^ Path to @.cabal@ files.+ , stanArgsOutputSettings = OutputSettings NonVerbose ShowSolution -- :: !OutputSettings -- ^ Settings for output terminal report+ -- doesnt matter, because it is silenced by isLoud+ , stanArgsReport = Nothing -- :: !(Maybe ReportArgs) -- ^ @HTML@ report settings+ , stanArgsUseDefaultConfigFile = fiasco "" -- :: !(TaggedTrial Text Bool) -- ^ Use default @.stan.toml@ file+ , stanArgsConfigFile = Nothing -- :: !(Maybe FilePath) -- ^ Path to a custom configurations file.+ , stanArgsConfig = ConfigP+ { configChecks = fiasco "'hls-stan-plugin' doesn't receive CLI options for: checks"+ , configRemoved = fiasco "'hls-stan-plugin' doesn't receive CLI options for: remove"+ , configIgnored = fiasco "'hls-stan-plugin' doesn't receive CLI options for: ignore"+ }+ -- if they are not fiascos, .stan.toml's aren't taken into account+ ,stanArgsJsonOut = not isLoud -- :: !Bool -- ^ Output the machine-readable output in JSON format instead.+ }++ (configTrial, useDefConfig, env) <- liftIO $ getStanConfig stanArgs isLoud+ seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)+ logWith recorder Debug (LogDebugStanConfigResult seTomlFiles configTrial)++ -- If envVar is set to 'False', stan will ignore all local and global .stan.toml files+ logWith recorder Debug (LogDebugStanEnvVars env)+ seTomlFiles <- liftIO $ usedTomlFiles useDefConfig (stanArgsConfigFile stanArgs)++ (cabalExtensionsMap, checksMap, confIgnored) <- case configTrial of+ FiascoL es -> do+ logWith recorder Development.IDE.Warning (LogWarnConf es)+ pure (Map.empty,+ HM.fromList [(LSP.fromNormalizedFilePath file, inspectionsIds)],+ [])+ ResultL warnings stanConfig -> do+ let currentHSAbs = fromNormalizedFilePath file -- hie_hs_file hie+ currentHSRel <- liftIO $ makeRelativeToCurrentDirectory currentHSAbs+ cabalExtensionsMap <- liftIO $ createCabalExtensionsMap isLoud (stanArgsCabalFilePath stanArgs) [hie]++ -- Files (keys) in checksMap need to have an absolute path for the analysis, but applyConfig needs to receive relative+ -- filepaths to apply the config, because the toml config has relative paths. Stan itself seems to work only in terms of relative paths.+ let checksMap = HM.mapKeys (const currentHSAbs) $ applyConfig [currentHSRel] stanConfig++ let analysis = runAnalysis cabalExtensionsMap checksMap (configIgnored stanConfig) [hie]+ pure (cabalExtensionsMap, checksMap, configIgnored stanConfig)+ let analysis = runAnalysis cabalExtensionsMap checksMap confIgnored [hie] return (analysisToDiagnostics file analysis, Just ()) else return ([], Nothing)
test/Main.hs view
@@ -10,6 +10,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Ide.Plugin.Stan as Stan+import Ide.Types import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls@@ -33,13 +34,32 @@ assertBool "" $ T.isPrefixOf expectedPrefix (reduceDiag ^. L.message) reduceDiag ^. L.source @?= Just "stan" return ()+ , testCase "ignores diagnostics from .stan.toml" $+ runStanSession "" $ do+ doc <- openDoc "dir/configTest.hs" "haskell"+ diags <- waitForDiagnosticsFromSource doc "stan"+ liftIO $ length diags @?= 0+ return () ] testDir :: FilePath testDir = "test/testdata" stanPlugin :: PluginTestDescriptor Stan.Log-stanPlugin = mkPluginTestDescriptor Stan.descriptor "stan"+stanPlugin = mkPluginTestDescriptor enabledStanDescriptor "stan"+ where+ -- We have to explicitly enable the plugin as it is disabled by default as+ -- per request: https://github.com/haskell/haskell-language-server/issues/3916+ --+ enabledStanDescriptor recorder plId =+ let stanPluginDescriptor = Stan.descriptor recorder plId+ in stanPluginDescriptor+ { pluginConfigDescriptor = (pluginConfigDescriptor stanPluginDescriptor)+ { configInitialGenericConfig = (configInitialGenericConfig (pluginConfigDescriptor stanPluginDescriptor))+ { plcGlobalOn = True+ }+ }+ } runStanSession :: FilePath -> Session a -> IO a runStanSession subdir =