Skip to content

Commit

Permalink
Squashed commit of the following:
Browse files Browse the repository at this point in the history 
commit 2fe2d70
Merge: 034b33e bea1fed
Author: fendor <[email protected]>
Date:   Thu Jan 11 16:05:34 2024 +0100

    Merge pull request haskell#3941 from fendor/enhance/cabal-no-diags-if-disabled

    Don't produce diagnostics if plugin is turned off

commit bea1fed
Merge: e9aab3c 034b33e
Author: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
Date:   Thu Jan 11 13:54:12 2024 +0000

    Merge branch 'master' into enhance/cabal-no-diags-if-disabled

commit e9aab3c
Author: Fendor <[email protected]>
Date:   Wed Jan 10 17:18:39 2024 +0100

    Don't produce diagnostics if plugin is turned off

commit 034b33e
Author: 0rphee <[email protected]>
Date:   Thu Jan 11 02:53:11 2024 -0600

    Use stan config files for stan plugin (haskell#3904) (haskell#3914)

    * Bump stan

    Needed in order to get the functions for getting the config, etc.

    * Use stan config files for stan plugin (haskell#3904)

    * Add test case for .stan.toml configuration

    * Fix windows tests

    See kowainik/stan#531

    ---------

    Co-authored-by: Michael Peyton Jones <[email protected]>
  • Loading branch information
@soulomoon
soulomoon committed Jan 12, 2024
1 parent 38c339e commit 5091256
Show file tree
Hide file tree
Showing 10 changed files with 188 additions and 44 deletions.
2 changes: 1 addition & 1 deletion cabal.project
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ packages:
./plugins/hls-overloaded-record-dot-plugin
./plugins/hls-semantic-tokens-plugin

index-state: 2023-12-13T00:00:00Z
index-state: 2024-01-05T19:06:05Z

tests: True
test-show-details: direct
Expand Down
52 changes: 28 additions & 24 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ instance Pretty Log where
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId =
(defaultCabalPluginDescriptor plId "Provides a variety of IDE features in cabal files")
{ pluginRules = cabalRules recorder
{ pluginRules = cabalRules recorder plId
, pluginHandlers =
mconcat
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
Expand Down Expand Up @@ -139,31 +139,35 @@ restartCabalShakeSession shakeExtras vfs file actionMsg = do
-- Plugin Rules
-- ----------------------------------------------------------------

cabalRules :: Recorder (WithPriority Log) -> Rules ()
cabalRules recorder = do
cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
cabalRules recorder plId = do
-- Make sure we initialise the cabal files-of-interest.
ofInterestRules recorder
-- Rule to produce diagnostics for cabal files.
define (cmapWithPrio LogShake recorder) $ \Types.ParseCabal file -> do
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
-- we rerun this rule because this rule *depends* on GetModificationTime.
(t, mCabalSource) <- use_ GetFileContents file
log' Debug $ LogModificationTime file t
contents <- case mCabalSource of
Just sources ->
pure $ Encoding.encodeUtf8 sources
Nothing -> do
liftIO $ BS.readFile $ fromNormalizedFilePath file
define (cmapWithPrio LogShake recorder) $ \Types.GetCabalDiagnostics file -> do
config <- getPluginConfigAction plId
if not (plcGlobalOn config && plcDiagnosticsOn config)
then pure ([], Nothing)
else do
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
-- we rerun this rule because this rule *depends* on GetModificationTime.
(t, mCabalSource) <- use_ GetFileContents file
log' Debug $ LogModificationTime file t
contents <- case mCabalSource of
Just sources ->
pure $ Encoding.encodeUtf8 sources
Nothing -> do
liftIO $ BS.readFile $ fromNormalizedFilePath file

(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
case pm of
Left (_cabalVersion, pErrorNE) -> do
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
allDiags = errorDiags <> warningDiags
pure (allDiags, Nothing)
Right gpd -> do
pure (warningDiags, Just gpd)
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
case pm of
Left (_cabalVersion, pErrorNE) -> do
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
allDiags = errorDiags <> warningDiags
pure (allDiags, Nothing)
Right gpd -> do
pure (warningDiags, Just gpd)

action $ do
-- Run the cabal kick. This code always runs when 'shakeRestart' is run.
Expand All @@ -183,7 +187,7 @@ function invocation.
kick :: Action ()
kick = do
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
void $ uses Types.ParseCabal files
void $ uses Types.GetCabalDiagnostics files

-- ----------------------------------------------------------------
-- Code Actions
Expand Down Expand Up @@ -292,7 +296,7 @@ completion recorder ide _ complParams = do
let completer = Completions.contextToCompleter ctx
let completerData = CompleterTypes.CompleterData
{ getLatestGPD = do
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.ParseCabal $ toNormalizedFilePath fp
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
pure $ fmap fst mGPD
, cabalPrefixInfo = prefInfo
, stanzaName =
Expand Down
8 changes: 4 additions & 4 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,14 +37,14 @@ instance Pretty Log where
LogUseWithStaleFastNoResult -> "Package description couldn't be read"
LogMapLookUpOfKnownKeyFailed key -> "Lookup of key in map failed even though it should exist" <+> pretty key

type instance RuleResult ParseCabal = Parse.GenericPackageDescription
type instance RuleResult GetCabalDiagnostics = Parse.GenericPackageDescription

data ParseCabal = ParseCabal
data GetCabalDiagnostics = GetCabalDiagnostics
deriving (Eq, Show, Typeable, Generic)

instance Hashable ParseCabal
instance Hashable GetCabalDiagnostics

instance NFData ParseCabal
instance NFData GetCabalDiagnostics

-- | The context a cursor can be in within a cabal file.
--
Expand Down
4 changes: 3 additions & 1 deletion plugins/hls-stan-plugin/hls-stan-plugin.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,9 @@ library
, text
, transformers
, unordered-containers
, stan >= 0.1.1.0
, stan >= 0.1.2.0
, trial
, directory

default-language: Haskell2010
default-extensions:
Expand Down
119 changes: 107 additions & 12 deletions plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs
View file
Original file line number Diff line number Diff line change
@@ -1,26 +1,30 @@
{-# LANGUAGE CPP #-}
{-# 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,
Expand All @@ -29,20 +33,37 @@ import Development.IDE.GHC.Compat (HieASTs (HieASTs),
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)
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 desc)
{ pluginRules = rules recorder plId
Expand All @@ -59,11 +80,43 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc)
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)
Expand All @@ -84,9 +137,51 @@ rules recorder plId = do
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)

Expand Down
6 changes: 6 additions & 0 deletions plugins/hls-stan-plugin/test/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,12 @@ tests =
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
Expand Down
32 changes: 32 additions & 0 deletions plugins/hls-stan-plugin/test/testdata/.stan.toml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
# See https://github.com/kowainik/stan/issues/531
# Unix
[[check]]
type = "Exclude"
id = "STAN-0206"
scope = "all"

[[check]]
type = "Exclude"
id = "STAN-0103"
file = "dir/configTest.hs"

[[check]]
type = "Exclude"
id = "STAN-0212"
directory = "dir/"

# Windows
[[check]]
type = "Exclude"
id = "STAN-0206"
scope = "all"

[[check]]
type = "Exclude"
id = "STAN-0103"
file = "dir\\configTest.hs"

[[check]]
type = "Exclude"
id = "STAN-0212"
directory = "dir\\"
5 changes: 5 additions & 0 deletions plugins/hls-stan-plugin/test/testdata/dir/configTest.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
data A = A Int Int

a = length [1..]

b = undefined
2 changes: 1 addition & 1 deletion stack-lts21.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ extra-deps:
- lsp-types-2.1.0.0

# stan dependencies not found in the stackage snapshot
- stan-0.1.0.2
- stan-0.1.2.0
- clay-0.14.0
- dir-traverse-0.2.3.0
- extensions-0.1.0.0
Expand Down
2 changes: 1 addition & 1 deletion stack.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ extra-deps:
- optparse-applicative-0.17.1.0

# stan and friends
- stan-0.1.1.0
- stan-0.1.2.0
- clay-0.14.0
- colourista-0.1.0.2
- dir-traverse-0.2.3.0
Expand Down

0 comments on commit 5091256

Please sign in to comment.