diff --git a/plugins/hls-hlint-plugin/README.md b/plugins/hls-hlint-plugin/README.md new file mode 100644 index 0000000000..fa775a35ca --- /dev/null +++ b/plugins/hls-hlint-plugin/README.md @@ -0,0 +1,7 @@ +# HLint Plugin for the [Haskell Language Server](https://github.com/haskell/haskell-language-server#readme) + +## Configuration + +This is typically done through an [HLint configuration file](https://github.com/ndmitchell/hlint#customizing-the-hints). +You can also change the behavior of HLint by adding a list of flags to `haskell.plugin.hlint.config.flags` +if your configuration is in a non-standard location or you want to change settings globally. diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 993c889775..40f4a272fb 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -33,9 +34,11 @@ import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Typeable -import Development.IDE +import Development.IDE hiding + (Error) import Development.IDE.Core.Rules (defineNoFile, - getParsedModuleWithComments) + getParsedModuleWithComments, + usePropertyAction) import Development.IDE.Core.Shake (getDiagnostics) import Refact.Apply @@ -70,10 +73,13 @@ import Language.Haskell.GHC.ExactPrint.Types (Rigidity (. #endif import Ide.Logger -import Ide.Plugin.Config +import Ide.Plugin.Config hiding + (Config) +import Ide.Plugin.Properties import Ide.PluginUtils import Ide.Types -import Language.Haskell.HLint as Hlint +import Language.Haskell.HLint as Hlint hiding + (Error) import Language.LSP.Server (ProgressCancellable (Cancellable), sendRequest, withIndefiniteProgress) @@ -95,8 +101,11 @@ descriptor plId = (defaultPluginDescriptor plId) [ PluginCommand "applyOne" "Apply a single hint" applyOneCmd , PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd ] - , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider - , pluginConfigDescriptor = defaultConfigDescriptor {configHasDiagnostics = True} + , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider + , pluginConfigDescriptor = defaultConfigDescriptor + { configHasDiagnostics = True + , configCustomConfig = mkCustomConfig properties + } } -- This rule only exists for generating file diagnostics @@ -126,7 +135,9 @@ rules plugin = do ideas <- if hlintOn' then getIdeas file else return (Right []) return (diagnostics file ideas, Just ()) - getHlintSettingsRule (HlintEnabled []) + defineNoFile $ \GetHlintSettings -> do + (Config flags) <- getHlintConfig plugin + liftIO $ argsSettings flags action $ do files <- getFilesOfInterest @@ -241,11 +252,6 @@ getExtensions pflags nfp = do -- --------------------------------------------------------------------- -data HlintUsage - = HlintEnabled { cmdArgs :: [String] } - | HlintDisabled - deriving Show - data GetHlintSettings = GetHlintSettings deriving (Eq, Show, Typeable, Generic) instance Hashable GetHlintSettings @@ -259,15 +265,22 @@ instance Binary GetHlintSettings type instance RuleResult GetHlintSettings = (ParseFlags, [Classify], Hint) -getHlintSettingsRule :: HlintUsage -> Rules () -getHlintSettingsRule usage = - defineNoFile $ \GetHlintSettings -> - liftIO $ case usage of - HlintEnabled cmdArgs -> argsSettings cmdArgs - HlintDisabled -> fail "hlint configuration unspecified" - -- --------------------------------------------------------------------- +newtype Config = Config [String] + +properties :: Properties '[ 'PropertyKey "flags" ('TArray String)] +properties = emptyProperties + & defineArrayProperty #flags + "Flags used by hlint" [] + +-- | Get the plugin config +getHlintConfig :: PluginId -> Action Config +getHlintConfig pId = + Config + <$> usePropertyAction #flags pId properties + +-- --------------------------------------------------------------------- codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right . LSP.List . map InR <$> liftIO getCodeActions where diff --git a/test/functional/Config.hs b/test/functional/Config.hs index b6623ed9ea..6965ffb017 100644 --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -2,12 +2,13 @@ module Config (tests) where -import Control.Lens hiding (List) +import Control.Lens hiding (List, (.=)) import Control.Monad import Data.Aeson import qualified Data.Map as Map import qualified Data.Text as T import Ide.Plugin.Config +import qualified Ide.Plugin.Config as Plugin import Language.LSP.Test as Test import qualified Language.LSP.Types.Lens as L import System.FilePath (()) @@ -55,6 +56,38 @@ hlintTests = testGroup "hlint plugin enables" [ liftIO $ noHlintDiagnostics diags' + , testCase "adding hlint flags to plugin configuration removes hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = hlintConfigWithFlags ["--ignore=Redundant id", "--hint=test-hlint-config.yaml"] + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFrom doc + + liftIO $ noHlintDiagnostics diags' + + , testCase "adding hlint flags to plugin configuration adds hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact7.hs" "haskell" + + expectNoMoreDiagnostics 3 doc "hlint" + + let config' = hlintConfigWithFlags ["--with-group=generalise"] + sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFromSource doc "hlint" + d <- liftIO $ inspectDiagnostic diags' ["Use <>"] + + liftIO $ do + length diags' @?= 1 + d ^. L.range @?= Range (Position 1 10) (Position 1 21) + d ^. L.severity @?= Just DsInfo ] where runHlintSession :: FilePath -> Session a -> IO a @@ -94,3 +127,14 @@ pluginGlobalOn config pid state = config' where pluginConfig = def { plcGlobalOn = state } config' = def { plugins = Map.insert pid pluginConfig (plugins config) } + +hlintConfigWithFlags :: [T.Text] -> Config +hlintConfigWithFlags flags = + def + { hlintOn = True + , Plugin.plugins = Map.fromList [("hlint", + def { Plugin.plcConfig = unObject $ object ["flags" .= flags] } + )] } + where + unObject (Object obj) = obj + unObject _ = undefined diff --git a/test/testdata/hlint/ApplyRefact7.hs b/test/testdata/hlint/ApplyRefact7.hs new file mode 100644 index 0000000000..eefcc77013 --- /dev/null +++ b/test/testdata/hlint/ApplyRefact7.hs @@ -0,0 +1,2 @@ +main = undefined +foo x y = [x, x] ++ y diff --git a/test/testdata/hlint/test-hlint-config.yaml b/test/testdata/hlint/test-hlint-config.yaml new file mode 100644 index 0000000000..23b72d5fad --- /dev/null +++ b/test/testdata/hlint/test-hlint-config.yaml @@ -0,0 +1 @@ +- ignore: { name: Eta reduce }