@@ -30,6 +30,8 @@ import Data.Char
3030import Data.Maybe
3131import Data.List.Extra
3232import qualified Data.Text as T
33+import Text.Regex.TDFA ((=~), (=~~))
34+import Text.Regex.TDFA.Text()
3335
3436-- | Generate code actions.
3537codeAction
@@ -85,14 +87,18 @@ executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
8587
8688suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
8789suggestAction contents diag@Diagnostic{_range=_range@Range{..},..}
90+-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
91+ | Just [_, bindings] <- matchRegex _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
92+ , Just c <- contents
93+ , importLine <- textInRange _range c
94+ = [( "Remove " <> bindings <> " from import"
95+ , [TextEdit _range (dropBindingsFromImportLine (T.splitOn "," bindings) importLine)])]
8896
8997-- File.hs:16:1: warning:
9098-- The import of `Data.List' is redundant
9199-- except perhaps to import instances from `Data.List'
92100-- To import instances alone, use: import Data.List()
93− | "The import of " `T.isInfixOf` _message
94− || "The qualified import of " `T.isInfixOf` _message
95− , " is redundant" `T.isInfixOf` _message
101+ | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String)
96102 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]
97103
98104-- File.hs:52:41: error:
@@ -293,6 +299,51 @@ textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
293299 where
294300 linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
295301
302+-- | Drop all occurrences of a binding in an import line.
303+-- Preserves well-formedness but not whitespace between bindings.
304+--
305+-- >>> dropBindingsFromImportLine ["bA", "bC"] "import A(bA, bB,bC ,bA)"
306+-- "import A(bB)"
307+--
308+-- >>> dropBindingsFromImportLine ["+"] "import "P" qualified A as B ((+))"
309+-- "import "P" qualified A() as B hiding (bB)"
310+dropBindingsFromImportLine :: [T.Text] -> T.Text -> T.Text
311+dropBindingsFromImportLine bindings_ importLine =
312+ importPre <> "(" <> importRest'
313+ where
314+ bindings = map (wrapOperatorInParens . removeQualified) bindings_
315+
316+ (importPre, importRest) = T.breakOn "(" importLine
317+
318+ wrapOperatorInParens x = if isAlpha (T.head x) then x else "(" <> x <> ")"
319+
320+ removeQualified x = case T.breakOn "." x of
321+ (_qualifier, T.uncons -> Just (_, unqualified)) -> unqualified
322+ _ -> x
323+
324+ importRest' = case T.uncons importRest of
325+ Just (_, x) ->
326+ T.intercalate ","
327+ $ joinCloseParens
328+ $ mapMaybe (filtering . T.strip)
329+ $ T.splitOn "," x
330+ Nothing -> importRest
331+
332+ filtering x = case () of
333+ () | x `elem` bindings -> Nothing
334+ () | x `elem` map (<> ")") bindings -> Just ")"
335+ _ -> Just x
336+
337+ joinCloseParens (x : ")" : rest) = (x <> ")") : joinCloseParens rest
338+ joinCloseParens (x : rest) = x : joinCloseParens rest
339+ joinCloseParens [] = []
340+
341+-- | Returns Just (the submatches) for the first capture, or Nothing.
342+matchRegex :: T.Text -> T.Text -> Maybe [T.Text]
343+matchRegex message regex = case message =~~ regex of
344+ Just (_ :: T.Text, _ :: T.Text, _ :: T.Text, bindings) -> Just bindings
345+ Nothing -> Nothing
346+
296347setHandlersCodeAction :: PartialHandlers
297348setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
298349 LSP.codeActionHandler = withResponse RspCodeAction codeAction