Fix completion for qualified import

- fix how we get the module name considering it can be preceded by `qualified` - use parsed context for import completions - add regression test for fixed multiline import - refactor `getCompletions` function
haskell · Oct 15, 2023 · cf6db6c · cf6db6c
1 parent 86446c7
commit cf6db6c
Show file tree

Hide file tree

Showing 2 changed files with 80 additions and 54 deletions.
diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs
@@ -221,7 +221,7 @@ getCompletionsLSP ide plId
                     plugins = idePlugins $ shakeExtras ide
                 config <- liftIO $ runAction "" ide $ getCompletionsConfig plId
 
-                allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri
+                let allCompletions = getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri
                 pure $ InL (orderedCompletions allCompletions)
           _ -> return (InL [])
       _ -> return (InL [])

diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -576,10 +576,54 @@ getCompletions
     -> CompletionsConfig
     -> ModuleNameEnv (HashSet.HashSet IdentInfo)
     -> Uri
-    -> IO [Scored CompletionItem]
-getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
-               maybe_parsed maybe_ast_res (localBindings, bmapping) prefixInfo caps config moduleExportsMap uri = do
-  let PosPrefixInfo { fullLine, prefixScope, prefixText } = prefixInfo
+    -> [Scored CompletionItem]
+getCompletions
+    plugins
+    ideOpts
+    CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
+    maybe_parsed
+    maybe_ast_res
+    (localBindings, bmapping)
+    prefixInfo@(PosPrefixInfo { fullLine, prefixScope, prefixText })
+    caps
+    config
+    moduleExportsMap
+    uri
+    -- ------------------------------------------------------------------------
+    -- IMPORT MODULENAME (NAM|)
+    | Just (ImportListContext moduleName) <- maybeContext
+    = moduleImportListCompletions moduleName
+
+    | Just (ImportHidingContext moduleName) <- maybeContext
+    = moduleImportListCompletions moduleName
+
+    -- ------------------------------------------------------------------------
+    -- IMPORT MODULENAM|
+    | Just (ImportContext _moduleName) <- maybeContext
+    = filtImportCompls
+
+    -- ------------------------------------------------------------------------
+    -- {-# LA| #-}
+    -- we leave this condition here to avoid duplications and return empty list
+    -- since HLS implements these completions (#haskell-language-server/pull/662)
+    | "{-# " `T.isPrefixOf` fullLine
+    = []
+
+    -- ------------------------------------------------------------------------
+    | otherwise =
+        -- assumes that nubOrdBy is stable
+        let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` snd . Fuzzy.original) filtCompls
+            compls = (fmap.fmap.fmap) (mkCompl pId ideOpts uri) uniqueFiltCompls
+            pId = lookupCommandProvider plugins (CommandId extendImportCommandId)
+        in
+          (fmap.fmap) snd $
+          sortBy (compare `on` lexicographicOrdering) $
+          mergeListsBy (flip compare `on` score)
+            [ (fmap.fmap) (notQual,) filtModNameCompls
+            , (fmap.fmap) (notQual,) filtKeywordCompls
+            , (fmap.fmap.fmap) (toggleSnippets caps config) compls
+            ]
+    where
       enteredQual = if T.null prefixScope then "" else prefixScope <> "."
       fullPrefix  = enteredQual <> prefixText
 
@@ -602,11 +646,9 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
           $ Fuzzy.simpleFilter chunkSize maxC fullPrefix
           $ (if T.null enteredQual then id else mapMaybe (T.stripPrefix enteredQual))
             allModNamesAsNS
-
-      filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls (label . snd)
-        where
-
-          mcc = case maybe_parsed of
+      -- If we have a parsed module, use it to determine which completion to show.
+      maybeContext :: Maybe Context
+      maybeContext = case maybe_parsed of
             Nothing -> Nothing
             Just (pm, pmapping) ->
               let PositionMapping pDelta = pmapping
@@ -615,7 +657,9 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
                   hpos = upperRange position'
               in getCContext lpos pm <|> getCContext hpos pm
 
-
+      filtCompls :: [Scored (Bool, CompItem)]
+      filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls (label . snd)
+        where
           -- We need the hieast to be "fresh". We can't get types from "stale" hie files, so hasfield won't work,
           -- since it gets the record fields from the types.
           -- Perhaps this could be fixed with a refactor to GHC's IfaceTyCon, to have it also contain record fields.
@@ -653,7 +697,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
                 })
 
           -- completions specific to the current context
-          ctxCompls' = case mcc of
+          ctxCompls' = case maybeContext of
                         Nothing           -> compls
                         Just TypeContext  -> filter ( isTypeCompl . snd) compls
                         Just ValueContext -> filter (not . isTypeCompl . snd) compls
@@ -694,54 +738,36 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls,
         , enteredQual `T.isPrefixOf` original label
         ]
 
+      moduleImportListCompletions :: String -> [Scored CompletionItem]
+      moduleImportListCompletions moduleNameS =
+        let moduleName = T.pack moduleNameS
+            funcs = lookupWithDefaultUFM moduleExportsMap HashSet.empty $ mkModuleName moduleNameS
+            funs = map (show . name) $ HashSet.toList funcs
+        in filterModuleExports moduleName $ map T.pack funs
+
+      filtImportCompls :: [Scored CompletionItem]
       filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules
+
+      filterModuleExports :: T.Text -> [T.Text] -> [Scored CompletionItem]
       filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName
+
+      filtKeywordCompls :: [Scored CompletionItem]
       filtKeywordCompls
           | T.null prefixScope = filtListWith mkExtCompl (optKeywords ideOpts)
           | otherwise = []
 
-  if
-    -- TODO: handle multiline imports
-    | "import " `T.isPrefixOf` fullLine
-      && (List.length (words (T.unpack fullLine)) >= 2)
-      && "(" `isInfixOf` T.unpack fullLine
-    -> do
-      let moduleName = words (T.unpack fullLine) !! 1
-          funcs = lookupWithDefaultUFM moduleExportsMap HashSet.empty $ mkModuleName moduleName
-          funs = map (renderOcc . name) $ HashSet.toList funcs
-      return $ filterModuleExports (T.pack moduleName) funs
-    | "import " `T.isPrefixOf` fullLine
-    -> return filtImportCompls
-    -- we leave this condition here to avoid duplications and return empty list
-    -- since HLS implements these completions (#haskell-language-server/pull/662)
-    | "{-# " `T.isPrefixOf` fullLine
-    -> return []
-    | otherwise -> do
-        -- assumes that nubOrdBy is stable
-        let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` snd . Fuzzy.original) filtCompls
-        let compls = (fmap.fmap.fmap) (mkCompl pId ideOpts uri) uniqueFiltCompls
-            pId = lookupCommandProvider plugins (CommandId extendImportCommandId)
-        return $
-          (fmap.fmap) snd $
-          sortBy (compare `on` lexicographicOrdering) $
-          mergeListsBy (flip compare `on` score)
-            [ (fmap.fmap) (notQual,) filtModNameCompls
-            , (fmap.fmap) (notQual,) filtKeywordCompls
-            , (fmap.fmap.fmap) (toggleSnippets caps config) compls
-            ]
-    where
-        -- We use this ordering to alphabetically sort suggestions while respecting
-        -- all the previously applied ordering sources. These are:
-        --  1. Qualified suggestions go first
-        --  2. Fuzzy score ranks next
-        --  3. In-scope completions rank next
-        --  4. label alphabetical ordering next
-        --  4. detail alphabetical ordering (proxy for module)
-        lexicographicOrdering Fuzzy.Scored{score, original} =
-          case original of
-            (isQual, CompletionItem{_label,_detail}) -> do
-              let isLocal = maybe False (":" `T.isPrefixOf`) _detail
-              (Down isQual, Down score, Down isLocal, _label, _detail)
+      -- We use this ordering to alphabetically sort suggestions while respecting
+      -- all the previously applied ordering sources. These are:
+      --  1. Qualified suggestions go first
+      --  2. Fuzzy score ranks next
+      --  3. In-scope completions rank next
+      --  4. label alphabetical ordering next
+      --  4. detail alphabetical ordering (proxy for module)
+      lexicographicOrdering Fuzzy.Scored{score, original} =
+        case original of
+          (isQual, CompletionItem{_label,_detail}) -> do
+            let isLocal = maybe False (":" `T.isPrefixOf`) _detail
+            (Down isQual, Down score, Down isLocal, _label, _detail)