Add code action to remove redundant qualified in imports

ChangeLog.md

@@ -17,6 +17,7 @@
   - Improved limited cross-module renaming
 - Improvements to `hls-refactor-plugin`
   - Code action to delete all unused bindings, including `let` bindings
+  - Code action to remove a redundant `qualified` from an import
 - Improvements to `hls-eval-plugin`
   - Capture `stdout` and `stderr` from evaluated expressions
 - Improvements to `hls-splice-plugin`

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -177,6 +177,7 @@ iePluginDescriptor recorder plId =
   let old =
         mkGhcideCAsPlugin
           [ wrap suggestModuleTypo
+          , wrap suggestRemoveDuplicateQualified
           , wrap suggestFixConstructorImport
           , wrap suggestExtendImport
           , wrap suggestImportDisambiguation
@@ -987,6 +988,67 @@ suggestModuleTypo Diagnostic{_range=_range,..}
         [modul, "(from", _] -> Just modul
         _                   -> Nothing
 
+suggestRemoveDuplicateQualified :: Maybe DynFlags -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
+suggestRemoveDuplicateQualified mbDf contents' Diagnostic{_range=_range, _message}
+    | "Multiple occurrences of 'qualified'" `T.isInfixOf` _message
+    , Just contents <- contents'
+    , Just edit <- redundantQualifiedEdit contents
+    = [("Remove redundant 'qualified'", [edit])]
+    | otherwise = []
+  where
+    usePost = case mbDf of
+      Just df -> xopt Lang.ImportQualifiedPost df
+      -- The module could not be parsed and no DynFlags were available, so
+      -- fall back to the LANGUAGE/OPTIONS_GHC pragmas in the file itself.
+      Nothing -> maybe False importQualifiedPostFromPragmas contents'
+    redundantQualifiedEdit contents = do
+      let Position startLine _ = _start _range
+      line <- listToMaybe $ drop (fromIntegral startLine) $ T.lines contents
+      (preQual, postQual) <- case qualifiedOccurrences line of
+        a : b : _ -> Just (a, b)
+        _         -> Nothing
+      let (colStart, colEnd)
+            | usePost  = preQual
+            | otherwise = postQual
+          baseRange = Range (Position startLine (fromIntegral colStart)) (Position startLine (fromIntegral colEnd))
+          trailing = T.takeWhile isSpace (T.drop colEnd line)
+          leading  = T.takeWhileEnd isSpace (T.take colStart line)
+          editRange
+            | usePost   = baseRange { _end = Position startLine (fromIntegral (colEnd + T.length trailing)) }
+            | otherwise = baseRange { _start = Position startLine (fromIntegral (colStart - T.length leading)) }
+      pure $ TextEdit editRange ""
+importQualifiedPostFromPragmas :: T.Text -> Bool
+importQualifiedPostFromPragmas contents =
+    case enabledStates of
+        []     -> False
+        states -> last states
+  where
+    enabledStates =
+        [ token /= "NoImportQualifiedPost"
+        | line <- T.lines contents
+        , "{-# LANGUAGE" `T.isInfixOf` line || "{-# OPTIONS_GHC" `T.isInfixOf` line
+        , token <- map T.unpack $ extensionsIn line
+        , token == "ImportQualifiedPost" || token == "NoImportQualifiedPost"
+        ]
+    extensionsIn =
+        T.split (\c -> not (isAlphaNum c || c == '_' || c == '-')) . T.replace "-X" ""
+
+qualifiedOccurrences :: T.Text -> [(Int, Int)]
+qualifiedOccurrences = go 0
+  where
+    kw = "qualified"
+    kwLen = T.length kw
+    go off t = case T.breakOn kw t of
+      (_, rest) | T.null rest -> []
+      (pre, rest) ->
+        let start = off + T.length pre
+            after = T.drop kwLen rest
+            boundedBefore = T.null pre || not (isIdentChar (T.last pre))
+            boundedAfter  = T.null after || not (isIdentChar (T.head after))
+            found = if boundedBefore && boundedAfter then ((start, start + kwLen) :) else id
+        in found (go (start + kwLen) after)
+    isIdentChar c = isAlphaNum c || c == '_'
+
 suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, CodeActionPreferred, Rewrite)]
 suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}
     | Just [binding, mod, srcspan] <-

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs

@@ -68,12 +68,21 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra
                 _ -> pure mempty
         caaIdeOptions <- onceIO $ runAction "GhcideCodeActions.getIdeOptions" state getIdeOptions
         caaParsedModule <- onceIO $ runRule GetParsedModuleWithComments
+        caaModSummary <- onceIO $ runRule GetModSummary
         caaContents <-
             onceIO $
             runRule GetFileContents <&> \case
                 Just (_, mbContents) -> fmap Rope.toText mbContents
                 Nothing       -> Nothing
-        caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule
+        caaDf <- onceIO $ do
+            mbParsedModule <- caaParsedModule
+            case mbParsedModule of
+                Just pm -> pure $ Just (ms_hspp_opts (pm_mod_summary pm))
+                -- The module may fail to parse (e.g. malformed imports). In
+                -- that case use the flags from the module summary, which are
+                -- computed without parsing the module.
+                Nothing ->
+                    fmap (ms_hspp_opts . msrModSummary) <$> caaModSummary
         caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource
         caaTmr <- onceIO $ runRule TypeCheck
         caaHar <- onceIO $ runRule GetHieAst
@@ -143,6 +152,7 @@ data CodeActionArgs = CodeActionArgs
     caaGhcSession   :: IO (Maybe HscEnvEq),
     caaIdeOptions   :: IO IdeOptions,
     caaParsedModule :: IO (Maybe ParsedModule),
+    caaModSummary   :: IO (Maybe ModSummaryResult),
     caaContents     :: IO (Maybe T.Text),
     caaDf           :: IO (Maybe DynFlags),
     caaAnnSource    :: IO (Maybe ParsedSource),

plugins/hls-refactor-plugin/test/Main.hs

@@ -308,6 +308,7 @@ codeActionTests = testGroup "code actions"
   , suggestHideShadowTests
   , fixConstructorImportTests
   , fixModuleImportTypoTests
+  , removeDuplicateQualifiedTests
   , importRenameActionTests
   , fillTypedHoleTests
   , addSigActionTests
@@ -1701,6 +1702,40 @@ fixModuleImportTypoTests = testGroup "fix module import typo"
         liftIO $ contentAfterAction @?= "import Data.Eq"
     ]
 
+removeDuplicateQualifiedTests :: TestTree
+removeDuplicateQualifiedTests = testGroup "multiple occurrences of qualified in import"
+    [ testSession "removes prepositive qualified when ImportQualifiedPost is enabled" $ do
+        doc <- createDoc "A.hs" "haskell" $ T.unlines
+            [ "{-# LANGUAGE ImportQualifiedPost #-}"
+            , "module A where"
+            , "import qualified Data.List qualified"
+            ]
+        _ <- waitForDiagnostics
+        action <- pickActionWithTitle "Remove redundant 'qualified'" =<< getCodeActions doc (R 2 0 2 36)
+        executeCodeAction action
+        contentAfterAction <- documentContents doc
+        liftIO $ contentAfterAction @?= T.unlines
+            [ "{-# LANGUAGE ImportQualifiedPost #-}"
+            , "module A where"
+            , "import Data.List qualified"
+            ]
+    , testSession "removes postpositive qualified without ImportQualifiedPost" $ do
+        doc <- createDoc "A.hs" "haskell" $ T.unlines
+            [ "{-# LANGUAGE NoImportQualifiedPost #-}"
+            , "module A where"
+            , "import qualified Data.List qualified"
+            ]
+        _ <- waitForDiagnostics
+        action <- pickActionWithTitle "Remove redundant 'qualified'" =<< getCodeActions doc (R 2 0 2 36)
+        executeCodeAction action
+        contentAfterAction <- documentContents doc
+        liftIO $ contentAfterAction @?= T.unlines
+            [ "{-# LANGUAGE NoImportQualifiedPost #-}"
+            , "module A where"
+            , "import qualified Data.List"
+            ]
+    ]
+
 suggestImportClassMethodTests :: TestTree
 suggestImportClassMethodTests =
   testGroup