Skip to content

HLint: Pass options through user config #1724

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 11 commits into from
Apr 21, 2021
7 changes: 7 additions & 0 deletions plugins/hls-hlint-plugin/README.md
Original file line number Diff line number Diff line change
@@ -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.
51 changes: 32 additions & 19 deletions plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
46 changes: 45 additions & 1 deletion test/functional/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ((</>))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
2 changes: 2 additions & 0 deletions test/testdata/hlint/ApplyRefact7.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
main = undefined
foo x y = [x, x] ++ y
1 change: 1 addition & 0 deletions test/testdata/hlint/test-hlint-config.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
- ignore: { name: Eta reduce }