Merge branch 'feature/skip_parse_without_haddock_ghc90' of ssh://github.com/yoshitsugu/haskell-language-server into feature/skip_parse_without_haddock_ghc90

Author: yoshitsugu

.github/workflows/bench.yml

@@ -159,7 +159,7 @@ jobs:
            ghcide/bench-results/**/*.eventlog
            ghcide/bench-results/**/*.hp
 
-  post_job:
+  bench_post_job:
     if: always()
     runs-on: ubuntu-latest
     needs: [pre_job, bench_init, bench_example]

.github/workflows/nix.yml

@@ -107,7 +107,7 @@ jobs:
       if: ${{ env.HAS_TOKEN == 'true' }}
       run: nix path-info --json | jq -r '.[].path' | cachix push haskell-language-server
 
-  post_job:
+  nix_post_job:
     if: always()
     runs-on: ubuntu-latest
     needs: [pre_job, develop, build]

.github/workflows/test.yml

@@ -224,7 +224,7 @@ jobs:
         name: Test hls-hlint-plugin test suite
         run: cabal test hls-hlint-plugin --test-options="-j1 --rerun-update" || cabal test hls-hlint-plugin --test-options="-j1 --rerun" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="-j1 --rerun"
 
-  post_job:
+  test_post_job:
     if: always()
     runs-on: ubuntu-latest
     needs: [pre_job, test]

ghcide/src/Development/IDE/GHC/Compat/Core.hs

@@ -190,7 +190,8 @@ module Development.IDE.GHC.Compat.Core (
     SrcLoc.RealSrcSpan,
     pattern RealSrcSpan,
     SrcLoc.RealSrcLoc,
-    SrcLoc.SrcLoc(..),
+    pattern RealSrcLoc,
+    SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc),
     BufSpan,
     SrcLoc.leftmost_smallest,
     SrcLoc.containsSpan,
@@ -511,7 +512,7 @@ import           GHC.Types.TyThing.Ppr
 #else
 import           GHC.Types.Name.Set
 #endif
-import           GHC.Types.SrcLoc           (BufSpan, SrcSpan (UnhelpfulSpan))
+import           GHC.Types.SrcLoc           (BufPos, BufSpan, SrcSpan (UnhelpfulSpan), SrcLoc(UnhelpfulLoc))
 import qualified GHC.Types.SrcLoc           as SrcLoc
 import           GHC.Types.Unique.Supply
 import           GHC.Types.Var              (Var (varName), setTyVarUnique,
@@ -637,10 +638,11 @@ import           Var                        (Var (varName), setTyVarUnique,
 #if MIN_VERSION_ghc(8,10,0)
 import           Coercion                   (coercionKind)
 import           Predicate
-import           SrcLoc                     (SrcSpan (UnhelpfulSpan))
+import           SrcLoc                     (SrcSpan (UnhelpfulSpan), SrcLoc (UnhelpfulLoc))
 #else
 import           SrcLoc                     (RealLocated,
-                                             SrcSpan (UnhelpfulSpan))
+                                             SrcSpan (UnhelpfulSpan),
+                                             SrcLoc (UnhelpfulLoc))
 #endif
 #endif
 
@@ -651,6 +653,7 @@ import           System.FilePath
 
 #if !MIN_VERSION_ghc(9,0,0)
 type BufSpan = ()
+type BufPos = ()
 #endif
 
 pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
@@ -662,6 +665,15 @@ pattern RealSrcSpan x y <- ((,Nothing) -> (SrcLoc.RealSrcSpan x, y)) where
 #endif
 {-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
 
+pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Maybe BufPos-> SrcLoc.SrcLoc
+#if MIN_VERSION_ghc(9,0,0)
+pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y
+#else
+pattern RealSrcLoc x y <- ((,Nothing) -> (SrcLoc.RealSrcLoc x, y)) where
+    RealSrcLoc x _ = SrcLoc.RealSrcLoc x
+#endif
+{-# COMPLETE RealSrcLoc, UnhelpfulLoc #-}
+
 
 pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
 #if __GLASGOW_HASKELL__ >= 902

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

@@ -30,7 +30,6 @@ import           Development.IDE.GHC.ExactPrint               (Annotated (annsA)
 import           Development.IDE.GHC.Util                     (prettyPrint)
 import           Development.IDE.Graph
 import           Development.IDE.Graph.Classes
-import qualified Development.IDE.Types.KnownTargets           as KT
 import           Development.IDE.Plugin.CodeAction            (newImport,
                                                                newImportToEdit)
 import           Development.IDE.Plugin.CodeAction.ExactPrint
@@ -39,6 +38,7 @@ import           Development.IDE.Plugin.Completions.Types
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.HscEnvEq               (HscEnvEq (envPackageExports),
                                                                hscEnv)
+import qualified Development.IDE.Types.KnownTargets           as KT
 import           Development.IDE.Types.Location
 import           GHC.Exts                                     (fromList, toList)
 import           GHC.Generics
@@ -47,6 +47,7 @@ import           Ide.Types
 import qualified Language.LSP.Server                          as LSP
 import           Language.LSP.Types
 import qualified Language.LSP.VFS                             as VFS
+import           Text.Fuzzy.Parallel                          (Scored (..))
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId = (defaultPluginDescriptor plId)
@@ -156,17 +157,50 @@ getCompletionsLSP ide plId
                 let clientCaps = clientCapabilities $ shakeExtras ide
                 config <- getCompletionsConfig plId
                 allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports
-                pure $ InL (List allCompletions)
+                pure $ InL (List $ orderedCompletions allCompletions)
               _ -> return (InL $ List [])
           _ -> return (InL $ List [])
       _ -> return (InL $ List [])
 
+{- COMPLETION SORTING
+   We return an ordered set of completions (local -> nonlocal -> global).
+   Ordering is important because local/nonlocal are import aware, whereas
+   global are not and will always insert import statements, potentially redundant.
+
+   Moreover, the order prioritizes qualifiers, for instance, given:
+
+   import qualified MyModule
+   foo = MyModule.<complete>
+
+   The identifiers defined in MyModule will be listed first, followed by other
+   identifiers in importable modules.
+
+   According to the LSP specification, if no sortText is provided, the label is used
+   to sort alphabetically. Alphabetical ordering is almost never what we want,
+   so we force the LSP client to respect our ordering by using a numbered sequence.
+-}
+
+orderedCompletions :: [Scored CompletionItem] -> [CompletionItem]
+orderedCompletions [] = []
+orderedCompletions xx = zipWith addOrder [0..] xx
+    where
+    lxx = digits $ Prelude.length xx
+    digits = Prelude.length . show
+
+    addOrder :: Int -> Scored CompletionItem -> CompletionItem
+    addOrder n Scored{original = it@CompletionItem{_label,_sortText}} =
+        it{_sortText = Just $
+                T.pack(pad lxx n)
+                }
+
+    pad n x = let sx = show x in replicate (n - Prelude.length sx) '0' <> sx
+
 ----------------------------------------------------------------------------------------------------
 
 toModueNameText :: KT.Target -> T.Text
 toModueNameText target = case target of
-  KT.TargetModule m  -> T.pack $ moduleNameString m
-  _ -> T.empty
+  KT.TargetModule m -> T.pack $ moduleNameString m
+  _                 -> T.empty
 
 extendImportCommand :: PluginCommand IdeState
 extendImportCommand =