HLint: Pass options through user config (#1724)

* Get flags for hlint through user config

* Add test case for hlint flags

* Add documentation for hlint configuration

* Fix build after merging master

* Remove unnecessary functions from hlint plugin

* Add test case that adds hints based on flags

* Fix build after merging master

* Add configHasDiagnostics back in

Co-authored-by: Javier Neira <atreyu.bbb@gmail.com>

Author: rmehri01

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.

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

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

test/testdata/hlint/ApplyRefact7.hs

@@ -0,0 +1,2 @@
+main = undefined
+foo x y = [x, x] ++ y

test/testdata/hlint/test-hlint-config.yaml

@@ -0,0 +1 @@
+- ignore: { name: Eta reduce }