Change refine imports behaviour for qualified imports (#3806)

Author: joyfulmantis

plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

@@ -29,7 +29,7 @@ import qualified Data.IntMap                          as IM (IntMap, elems,
                                                              fromList, (!?))
 import           Data.IORef                           (readIORef)
 import qualified Data.Map.Strict                      as Map
-import           Data.Maybe                           (mapMaybe)
+import           Data.Maybe                           (isNothing, mapMaybe)
 import qualified Data.Set                             as S
 import           Data.String                          (fromString)
 import qualified Data.Text                            as T
@@ -316,42 +316,32 @@ minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogSha
         return $ mi_exports $ hirModIface imp_hir
 
   -- Use the GHC api to extract the "minimal" imports
-  (imports, mbMinImports) <- MaybeT $ liftIO $ extractMinimalImports hsc tmr
+  locationImportWithMinimal <- MaybeT $ liftIO $ extractMinimalImports hsc tmr
 
-  let importsMap =
-        Map.fromList
-          [ (realSrcSpanStart l, printOutputable i)
-            | L (locA -> RealSrcSpan l _) i <- mbMinImports
-          ]
-      minimalImportsResult =
-        [ (range, (minImport, ExplicitImport))
-          | imp@(L _ impDecl) <- imports
+  let minimalImportsResult =
+        [ (range, (printOutputable minImport, ExplicitImport))
+          | (location, impDecl, minImport) <- locationImportWithMinimal
           , not (isQualifiedImport impDecl)
           , not (isExplicitImport impDecl)
           , let L _ moduleName = ideclName impDecl
           , modFilter moduleName
-          , RealSrcSpan location _ <- [getLoc imp]
-          , let range = realSrcSpanToRange location
-          , Just minImport <- [Map.lookup (realSrcSpanStart location) importsMap]
-        ]
+          , let range = realSrcSpanToRange location]
+
       refineImportsResult =
         [ (range, (T.intercalate "\n"
-                . map (printOutputable . constructImport i)
+                . map (printOutputable . constructImport origImport minImport)
                 . Map.toList
                 $ filteredInnerImports, RefineImport))
         -- for every minimal imports
-        | minImports <- [mbMinImports]
-        , i@(L _ ImportDecl{ideclName = L _ mn}) <- minImports
+        | (location, origImport, minImport@(ImportDecl{ideclName = L _ mn})) <- locationImportWithMinimal
         -- (almost) no one wants to see an refine import list for Prelude
         , mn /= moduleName pRELUDE
         -- we check for the inner imports
         , Just innerImports <- [Map.lookup mn import2Map]
         -- and only get those symbols used
-        , Just filteredInnerImports <- [filterByImport i innerImports]
+        , Just filteredInnerImports <- [filterByImport minImport innerImports]
         -- if no symbols from this modules then don't need to generate new import
         , not $ null filteredInnerImports
-        -- get the location
-        , RealSrcSpan location _ <- [getLoc i]
         -- and then convert that to a Range
         , let range = realSrcSpanToRange location
         ]
@@ -370,7 +360,7 @@ minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogSha
 extractMinimalImports ::
   HscEnvEq ->
   TcModuleResult ->
-  IO (Maybe ([LImportDecl GhcRn], [LImportDecl GhcRn]))
+  IO (Maybe [(RealSrcSpan, ImportDecl GhcRn, ImportDecl GhcRn)])
 extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do
   -- extract the original imports and the typechecking environment
   let tcEnv = tmrTypechecked
@@ -391,8 +381,17 @@ extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do
   (_, Just minimalImports) <- liftIO $
     initTcWithGbl (hscEnv hsc) tcEnv srcSpan $ getMinimalImports usage
 
+  let minimalImportsMap =
+        Map.fromList
+          [ (realSrcSpanStart l, impDecl)
+            | L (locA -> RealSrcSpan l _) impDecl <- minimalImports
+          ]
+      results =
+          [ (location, imp, minImport)
+          | L (locA -> RealSrcSpan location _) imp <- imports
+          , Just minImport <- [Map.lookup (realSrcSpanStart location) minimalImportsMap]]
   -- return both the original imports and the computed minimal ones
-  return (imports, minimalImports)
+  return results
   where
       notExported :: [String] -> LImportDecl GhcRn -> Bool
       notExported []  _ = True
@@ -451,11 +450,11 @@ abbreviateImportTitle input =
 --------------------------------------------------------------------------------
 
 
-filterByImport :: LImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo])
+filterByImport :: ImportDecl GhcRn -> Map.Map ModuleName [AvailInfo] -> Maybe (Map.Map ModuleName [AvailInfo])
 #if MIN_VERSION_ghc(9,5,0)
-filterByImport (L _ ImportDecl{ideclImportList = Just (_, L _ names)})
+filterByImport (ImportDecl{ideclImportList = Just (_, L _ names)})
 #else
-filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)})
+filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)})
 #endif
   avails =
       -- if there is a function defined in the current module and is used
@@ -474,18 +473,22 @@ filterByImport (L _ ImportDecl{ideclHiding = Just (_, L _ names)})
           $ Map.elems res
 filterByImport _ _ = Nothing
 
-constructImport :: LImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> LImportDecl GhcRn
+constructImport :: ImportDecl GhcRn -> ImportDecl GhcRn -> (ModuleName, [AvailInfo]) -> ImportDecl GhcRn
 #if MIN_VERSION_ghc(9,5,0)
-constructImport (L lim imd@ImportDecl {ideclName = L _ _, ideclImportList = Just (hiding, L _ names)})
+constructImport ImportDecl{ideclQualified = qualified, ideclImportList = origHiding} imd@ImportDecl{ideclImportList = Just (hiding, L _ names)}
 #else
-constructImport (L lim imd@ImportDecl{ideclName = L _ _, ideclHiding = Just (hiding, L _ names)})
+constructImport ImportDecl{ideclQualified = qualified, ideclHiding = origHiding} imd@ImportDecl{ideclHiding = Just (hiding, L _ names)}
 #endif
-  (newModuleName, avails) = L lim imd
+  (newModuleName, avails) = imd
     { ideclName = noLocA newModuleName
 #if MIN_VERSION_ghc(9,5,0)
-    , ideclImportList = Just (hiding, noLocA newNames)
+    , ideclImportList = if isNothing origHiding && qualified /= NotQualified
+                        then Nothing
+                        else Just (hiding, noLocA newNames)
 #else
-    , ideclHiding = Just (hiding, noLocA newNames)
+    , ideclHiding = if isNothing origHiding && qualified /= NotQualified
+                        then Nothing
+                        else Just (hiding, noLocA newNames)
 #endif
     }
     where newNames = filter (\n -> any (n `containsAvail`) avails) names
@@ -495,4 +498,4 @@ constructImport (L lim imd@ImportDecl{ideclName = L _ _, ideclHiding = Just (hid
             any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name))
               $ availNamesWithSelectors avail
 
-constructImport lim _ = lim
+constructImport _ lim _ = lim

plugins/hls-explicit-imports-plugin/test/Main.hs

@@ -31,6 +31,8 @@ main = defaultTestRunner $ testGroup "import-actions"
     "Refine Imports"
     [ codeActionGoldenTest "RefineWithOverride" 3 1
     , codeLensGoldenTest isRefineImports "RefineUsualCase" 1
+    , codeLensGoldenTest isRefineImports "RefineQualified" 0
+    , codeLensGoldenTest isRefineImports "RefineQualifiedExplicit" 0
     ],
   testGroup
     "Make imports explicit"

plugins/hls-explicit-imports-plugin/test/testdata/RefineQualified.expected.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import qualified RefineB as RA
+import qualified RefineC as RA
+import RefineD
+import Data.List (intercalate)
+
+main :: IO ()
+main = putStrLn 
+     $ "hello " 
+    <> intercalate ", " [RA.b1, RA.c1, e2]

plugins/hls-explicit-imports-plugin/test/testdata/RefineQualified.hs

@@ -0,0 +1,10 @@
+module Main where
+
+import qualified RefineA as RA
+import RefineD
+import Data.List (intercalate)
+
+main :: IO ()
+main = putStrLn 
+     $ "hello " 
+    <> intercalate ", " [RA.b1, RA.c1, e2]

plugins/hls-explicit-imports-plugin/test/testdata/RefineQualifiedExplicit.expected.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import qualified RefineB as RA ( b1 )
+import qualified RefineC as RA ( c1 )
+import RefineD
+import Data.List (intercalate)
+
+main :: IO ()
+main = putStrLn 
+     $ "hello " 
+    <> intercalate ", " [RA.b1, RA.c1, e2]

plugins/hls-explicit-imports-plugin/test/testdata/RefineQualifiedExplicit.hs

@@ -0,0 +1,10 @@
+module Main where
+
+import qualified RefineA as RA (b1, c1)
+import RefineD
+import Data.List (intercalate)
+
+main :: IO ()
+main = putStrLn 
+     $ "hello " 
+    <> intercalate ", " [RA.b1, RA.c1, e2]

plugins/hls-explicit-imports-plugin/test/testdata/hie.yaml

@@ -1,4 +1,3 @@
-
 cradle:
   direct:
     arguments:
@@ -9,6 +8,8 @@ cradle:
     - ExplicitA.hs
     - ExplicitB.hs
     - RefineUsualCase.hs
+    - RefineQualified.hs
+    - RefineQualifiedExplicit.hs
     - RefineWithOverride.hs
     - RefineA.hs
     - RefineB.hs