Refactor getCompletions function

- add some documentation comments
- add type signatures fo easier overview
- remove superfluous IO signature
- remove outer let - move to where
- remove multiway if, use guards directly

Author: xsebek

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -150,7 +150,7 @@ getCompletionsLSP ide plId
               (Just pfix', _) -> do
                 let clientCaps = clientCapabilities $ shakeExtras ide
                 config <- getCompletionsConfig plId
-                allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports
+                let allCompletions = getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports
                 pure $ InL (List $ orderedCompletions allCompletions)
               _ -> return (InL $ List [])
           _ -> return (InL $ List [])

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -560,24 +560,74 @@ getCompletions
     -> ClientCapabilities
     -> CompletionsConfig
     -> HM.HashMap T.Text (HashSet.HashSet IdentInfo)
-    -> IO [Scored CompletionItem]
-getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
-               maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do
-  let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
-      enteredQual = if T.null prefixModule then "" else prefixModule <> "."
+    -> [Scored CompletionItem]
+getCompletions
+    plId
+    ideOpts
+    CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
+    maybe_parsed
+    (localBindings, bmapping)
+    VFS.PosPrefixInfo {fullLine, prefixModule, prefixText, cursorPos}
+    caps
+    config
+    moduleExportsMap
+    -- ------------------------------------------------------------------------
+    -- IMPORT MODULENAME (NAM|)
+    | Just (ImportListContext moduleName) <- maybeContext
+    = moduleImportListCompletions moduleName
+
+    | Just (ImportHidingContext moduleName) <- maybeContext
+    = moduleImportListCompletions moduleName
+
+    -- TODO: Is manual parsing ever needed or is context always present for module?
+    -- If possible only keep the above.
+    | "import " `T.isPrefixOf` fullLine
+    , Just moduleName <- getModuleName fullLine
+    , "(" `T.isInfixOf` fullLine
+    = moduleImportListCompletions $ T.unpack moduleName
+
+    -- ------------------------------------------------------------------------
+    -- IMPORT MODULENAM|
+    | Just (ImportContext _moduleName) <- maybeContext
+    = filtImportCompls
+
+    -- TODO: Can we avoid this manual parsing?
+    -- If possible only keep the above.
+    | "import " `T.isPrefixOf` fullLine
+    = 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 plId ideOpts) uniqueFiltCompls
+        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
+      -- construct the qualified completion (do not confuse with qualified import)
+      enteredQual :: T.Text
+      enteredQual = if qual then prefixModule <> "." else ""
+      fullPrefix :: T.Text
       fullPrefix  = enteredQual <> prefixText
 
       -- Boolean labels to tag suggestions as qualified (or not)
-      qual = not(T.null prefixModule)
+      qual, notQual :: Bool
+      qual = not (T.null prefixModule)
       notQual = False
 
-      {- correct the position by moving 'foo :: Int -> String ->    '
-                                                                    ^
-          to                             'foo :: Int -> String ->    '
-                                                              ^
-      -}
-      pos = VFS.cursorPos prefixInfo
-
+      maxC :: Int
       maxC = maxCompletions config
 
       filtModNameCompls :: [Scored CompletionItem]
@@ -587,15 +637,29 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
           $ (if T.null enteredQual then id else mapMaybe (T.stripPrefix enteredQual))
             allModNamesAsNS
 
+      -- ----------------------------------------
+      -- Note: correct the cursorPos by moving
+      --
+      --   'foo :: Int -> String ->    '
+      --                               ^
+      -- to
+      --
+      --   'foo :: Int -> String ->    '
+      --                        ^
+      -- ----------------------------------------
+
+      -- 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
-                  position' = fromDelta pDelta pos
+                  position' = fromDelta pDelta cursorPos
                   lpos = lowerRange position'
                   hpos = upperRange position'
               in getCContext lpos pm <|> getCContext hpos pm
 
+      filtCompls :: [Scored (Bool, CompItem)]
       filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls (label . snd)
         where
           -- completions specific to the current context
@@ -608,10 +672,10 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
           ctxCompls = (fmap.fmap) (\comp -> toggleAutoExtend config $ comp { isInfix = infixCompls }) ctxCompls'
 
           infixCompls :: Maybe Backtick
-          infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos
+          infixCompls = isUsedAsInfix fullLine prefixModule prefixText cursorPos
 
           PositionMapping bDelta = bmapping
-          oldPos = fromDelta bDelta $ VFS.cursorPos prefixInfo
+          oldPos = fromDelta bDelta cursorPos
           startLoc = lowerRange oldPos
           endLoc = upperRange oldPos
           localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc
@@ -629,6 +693,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
             else ((qual,) <$> Map.findWithDefault [] prefixModule (getQualCompls qualCompls))
                  ++ ((notQual,) . ($ Just prefixModule) <$> anyQualCompls)
 
+      filtListWith :: (T.Text -> CompletionItem) -> [T.Text] -> [Scored CompletionItem]
       filtListWith f list =
         [ fmap f label
         | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix list
@@ -643,64 +708,31 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
         in filterModuleExports moduleName $ map T.pack funs
 
       -- manually parse in case we don't have completion context ("import [qualified ]ModuleName")
+      getModuleName :: T.Text -> Maybe T.Text
       getModuleName line = filter (/= "qualified") (T.words line) !? 1
+
+      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 prefixModule = filtListWith mkExtCompl (optKeywords ideOpts)
           | otherwise = []
 
-  if
-    -- TODO: handle multiline imports
-    | Just (ImportListContext moduleName) <- maybeContext
-    -> pure $ moduleImportListCompletions moduleName
-
-    | Just (ImportHidingContext moduleName) <- maybeContext
-    -> pure $ moduleImportListCompletions moduleName
-
-    -- TODO: Is manual parsing ever needed or is context always present for module?
-    -- If possible only keep the above.
-    | "import " `T.isPrefixOf` fullLine
-    , Just moduleName <- getModuleName fullLine
-    , "(" `T.isInfixOf` fullLine
-    -> pure $ moduleImportListCompletions $ T.unpack moduleName
-
-    | Just (ImportContext _moduleName) <- maybeContext
-    -> return filtImportCompls
-
-    -- TODO: Can we avoid this manual parsing?
-    -- If possible only keep the above.
-    | "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 plId ideOpts) uniqueFiltCompls
-        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} =
+      -- 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 :: Scored (a, CompletionItem) -> (Down a, Down Int, Down Bool, T.Text, Maybe T.Text)
+      lexicographicOrdering Fuzzy.Scored{score, original} =
           case original of
-            (isQual, CompletionItem{_label,_detail}) -> do
+          (isQual, CompletionItem{_label,_detail}) -> do
               let isLocal = maybe False (":" `T.isPrefixOf`) _detail
               (Down isQual, Down score, Down isLocal, _label, _detail)