Merge branch 'master' into wip/multi-reexport

Author: mergify[bot]

.github/actions/setup-build/action.yml

@@ -31,7 +31,7 @@ runs:
         sudo chown -R $USER /usr/local/.ghcup
       shell: bash
 
-    - uses: haskell/actions/setup@v2.4.7
+    - uses: haskell-actions/setup@v2.6.0
       id: HaskEnvSetup
       with:
         ghc-version  : ${{ inputs.ghc   }}

CODEOWNERS

@@ -2,49 +2,57 @@
 /ghcide @pepeiborra
 /ghcide/session-loader @pepeiborra @fendor
 /hls-graph @pepeiborra
-/hls-plugin-api @berberman
+/hls-plugin-api @michaelpj @fendor
 /hls-test-utils @fendor
+/hie-compat @wz1000
+
+# HLS main
+/src @fendor
+/exe @fendor
 /test @fendor
-/hie-compat
 
 # Plugins
 /plugins/hls-alternate-number-format-plugin @drsooch
-/plugins/hls-cabal-plugin @fendor
 /plugins/hls-cabal-fmt-plugin @VeryMilkyJoe @fendor
+/plugins/hls-cabal-plugin @fendor
 /plugins/hls-call-hierarchy-plugin @July541
-/plugins/hls-class-plugin @Ailrun
+/plugins/hls-change-type-signature-plugin
+/plugins/hls-class-plugin 
+/plugins/hls-code-range-plugin @kokobd
 /plugins/hls-eval-plugin
+/plugins/hls-explicit-fixity-plugin
 /plugins/hls-explicit-imports-plugin @pepeiborra
-/plugins/hls-floskell-plugin @Ailrun
+/plugins/hls-explicit-record-fields-plugin @ozkutuk
+/plugins/hls-floskell-plugin @peterbecich
 /plugins/hls-fourmolu-plugin @georgefst
 /plugins/hls-gadt-plugin @July541
 /plugins/hls-hlint-plugin @eddiemundo
 /plugins/hls-module-name-plugin
 /plugins/hls-ormolu-plugin @georgefst
-/plugins/hls-pragmas-plugin @berberman @Ailrun @eddiemundo
+/plugins/hls-overloaded-record-dot-plugin @joyfulmantis
+/plugins/hls-pragmas-plugin @eddiemundo
 /plugins/hls-qualify-imported-names-plugin @eddiemundo
-/plugins/hls-rename-plugin @OliverMadine
 /plugins/hls-refactor-plugin @santiweight
+/plugins/hls-rename-plugin 
 /plugins/hls-retrie-plugin @pepeiborra
-/plugins/hls-code-range-plugin @kokobd
+/plugins/hls-semantic-tokens-plugin @soulomoon
 /plugins/hls-splice-plugin @konn
-/plugins/hls-stylish-haskell-plugin @Ailrun
 /plugins/hls-stan-plugin @0rphee
-/plugins/hls-explicit-record-fields-plugin @ozkutuk
-/plugins/hls-overloaded-record-dot-plugin @joyfulmantis
+/plugins/hls-stylish-haskell-plugin @michaelpj
 
 # Benchmarking
 /shake-bench @pepeiborra
+/bench @pepeiborra
 
 # Docs
 /docs @michaelpj
 
 # CI
-/.circleci @Anton-Latukha
-/.github @Anton-Latukha @Ailrun
-/.gitlab @hasufell
+/.circleci 
+/.github @michaelpj @fendor
 
 # Build
 *.nix @berberman @michaelpj @guibou
-*.project
+*.project @michaelpj
+*.stack* @michaelpj
 .gitpod.* @kokobd

cabal.project

@@ -34,6 +34,7 @@ packages:
          ./plugins/hls-explicit-record-fields-plugin
          ./plugins/hls-refactor-plugin
          ./plugins/hls-overloaded-record-dot-plugin
+         ./plugins/hls-semantic-tokens-plugin
 
 index-state: 2023-12-13T00:00:00Z
 
@@ -55,8 +56,8 @@ constraints:
   text -simdutf,
   ghc-check -ghc-check-use-package-abis,
   ghc-lib-parser-ex -auto,
-  -- This is only present in some versions, and it's on by default since 
-  -- 0.14.5.0, but there are some versions we allow that need this 
+  -- This is only present in some versions, and it's on by default since
+  -- 0.14.5.0, but there are some versions we allow that need this
   -- setting
   stylish-haskell +ghc-lib,
   -- Centos 7 comes with an old gcc version that doesn't know about
@@ -79,8 +80,8 @@ source-repository-package
 -- END DELETE
 
 if impl(ghc >= 9.1)
-  -- ekg packagess are old and unmaintained, but we 
-  -- don't rely on them for the mainline build, so 
+  -- ekg packagess are old and unmaintained, but we
+  -- don't rely on them for the mainline build, so
   -- this is okay
   allow-newer:
     ekg-json:base,

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -238,14 +238,14 @@ type instance RuleResult GetHieAst = HieAstResult
 -- | A IntervalMap telling us what is in scope at each point
 type instance RuleResult GetBindings = Bindings
 
-data DocAndKindMap = DKMap {getDocMap :: !DocMap, getKindMap :: !KindMap}
-instance NFData DocAndKindMap where
+data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap}
+instance NFData DocAndTyThingMap where
     rnf (DKMap a b) = rwhnf a `seq` rwhnf b
 
-instance Show DocAndKindMap where
+instance Show DocAndTyThingMap where
     show = const "docmap"
 
-type instance RuleResult GetDocMap = DocAndKindMap
+type instance RuleResult GetDocMap = DocAndTyThingMap
 
 -- | A GHC session that we reuse.
 type instance RuleResult GhcSession = HscEnvEq

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

@@ -407,6 +407,7 @@ module Development.IDE.GHC.Compat.Core (
     field_label,
 #endif
     groupOrigin,
+    isVisibleFunArg,
     ) where
 
 import qualified GHC
@@ -431,13 +432,13 @@ import           GHC.Core.DataCon             hiding (dataConExTyCoVars)
 import qualified GHC.Core.DataCon             as DataCon
 import           GHC.Core.FamInstEnv          hiding (pprFamInst)
 import           GHC.Core.InstEnv
-import           GHC.Types.Unique.FM 
+import           GHC.Types.Unique.FM
 import           GHC.Core.PatSyn
 import           GHC.Core.Predicate
 import           GHC.Core.TyCo.Ppr
 import qualified GHC.Core.TyCo.Rep            as TyCoRep
 import           GHC.Core.TyCon
-import           GHC.Core.Type                
+import           GHC.Core.Type
 import           GHC.Core.Unify
 import           GHC.Core.Utils
 import           GHC.Driver.CmdLine           (Warn (..))
@@ -489,6 +490,8 @@ import qualified GHC.Types.SrcLoc             as SrcLoc
 import           GHC.Types.Unique.Supply
 import           GHC.Types.Var                (Var (varName), setTyVarUnique,
                                                setVarUnique)
+
+import qualified GHC.Types.Var                as TypesVar
 import           GHC.Unit.Info                (PackageName (..))
 import           GHC.Unit.Module              hiding (ModLocation (..), UnitId,
                                                moduleUnit,
@@ -597,7 +600,7 @@ pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y
 pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
 #if __GLASGOW_HASKELL__ >= 907
 pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces))
-#else 
+#else
 pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of
       Avail.NormalGreName name -> (name: names, pieces)
       Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces))
@@ -606,14 +609,14 @@ pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names,
 pattern AvailName :: Name -> Avail.AvailInfo
 #if __GLASGOW_HASKELL__ >= 907
 pattern AvailName n <- Avail.Avail n
-#else 
+#else
 pattern AvailName n <- Avail.Avail (Avail.NormalGreName n)
 #endif
 
 pattern AvailFL :: FieldLabel -> Avail.AvailInfo
 #if __GLASGOW_HASKELL__ >= 907
 pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7
-#else 
+#else
 pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl)
 #endif
 
@@ -630,8 +633,17 @@ pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
 pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr
 #endif
 
-pattern FunTy :: Type -> Type -> Type
-pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res}
+#if __GLASGOW_HASKELL__ >= 906
+isVisibleFunArg = TypesVar.isVisibleFunArg
+type FunTyFlag = TypesVar.FunTyFlag
+#else
+isVisibleFunArg VisArg = True
+isVisibleFunArg _ = False
+type FunTyFlag = TypesVar.AnonArgFlag
+#endif
+pattern FunTy :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Type -> Type -> Type
+pattern FunTy af arg res <- TyCoRep.FunTy {ft_af = af, ft_arg = arg, ft_res = res}
+
 
 -- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x)
 -- type HasSrcSpan x = () :: Constraint

ghcide/src/Development/IDE/GHC/Error.hs

@@ -17,6 +17,8 @@ module Development.IDE.GHC.Error
   , realSrcSpanToRange
   , realSrcLocToPosition
   , realSrcSpanToLocation
+  , realSrcSpanToCodePointRange
+  , realSrcLocToCodePointPosition
   , srcSpanToFilename
   , rangeToSrcSpan
   , rangeToRealSrcSpan
@@ -45,6 +47,8 @@ import           Development.IDE.Types.Diagnostics as D
 import           Development.IDE.Types.Location
 import           GHC
 import           Language.LSP.Protocol.Types       (isSubrangeOf)
+import           Language.LSP.VFS                  (CodePointPosition (CodePointPosition),
+                                                    CodePointRange (CodePointRange))
 
 
 diagFromText :: T.Text -> D.DiagnosticSeverity -> SrcSpan -> T.Text -> FileDiagnostic
@@ -86,6 +90,28 @@ realSrcLocToPosition :: RealSrcLoc -> Position
 realSrcLocToPosition real =
   Position (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
 
+-- Note [Unicode support]
+-- the current situation is:
+-- LSP Positions use UTF-16 code units(Unicode may count as variable columns);
+-- GHC use Unicode code points(Unicode count as one column).
+-- To support unicode, ideally range should be in lsp standard,
+-- and codePoint should be in ghc standard.
+-- see https://github.com/haskell/lsp/pull/407
+
+-- | Convert a GHC SrcSpan to CodePointRange
+-- see Note [Unicode support]
+realSrcSpanToCodePointRange :: RealSrcSpan -> CodePointRange
+realSrcSpanToCodePointRange real =
+  CodePointRange
+    (realSrcLocToCodePointPosition $ Compat.realSrcSpanStart real)
+    (realSrcLocToCodePointPosition $ Compat.realSrcSpanEnd real)
+
+-- | Convert a GHC RealSrcLoc to CodePointPosition
+-- see Note [Unicode support]
+realSrcLocToCodePointPosition :: RealSrcLoc -> CodePointPosition
+realSrcLocToCodePointPosition real =
+  CodePointPosition (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1)
+
 -- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
 -- FIXME This may not be an _absolute_ file name, needs fixing.
 srcSpanToFilename :: SrcSpan -> Maybe FilePath

ghcide/src/Development/IDE/Import/FindImports.hs

@@ -238,7 +238,11 @@ notFoundErr env modName reason =
              }
         LookupUnusable unusable ->
           let unusables' = map get_unusable unusable
+#if MIN_VERSION_ghc(9,6,4) && !MIN_VERSION_ghc(9,8,1)
+              get_unusable (m, ModUnusable r) = r
+#else
               get_unusable (m, ModUnusable r) = (moduleUnit m, r)
+#endif
               get_unusable (_, r) =
                 pprPanic "findLookupResult: unexpected origin" (ppr r)
            in notFound {fr_unusables = unusables'}

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

@@ -144,8 +144,8 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur
 #endif
     mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file
     let (dm,km) = case mdkm of
-          Just (DKMap docMap kindMap, _) -> (docMap,kindMap)
-          Nothing                        -> (mempty, mempty)
+          Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap)
+          Nothing                           -> (mempty, mempty)
     doc <- case lookupNameEnv dm name of
       Just doc -> pure $ spanDocToMarkdown doc
       Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -209,7 +209,7 @@ gotoDefinition withHieDb getHieFile ideOpts imports srcSpans pos
 atPoint
   :: IdeOptions
   -> HieAstResult
-  -> DocAndKindMap
+  -> DocAndTyThingMap
   -> HscEnv
   -> Position
   -> IO (Maybe (Maybe Range, [T.Text]))
@@ -346,7 +346,7 @@ namesInType (TyVarTy n)      = [varName n]
 namesInType (AppTy a b)      = getTypes [a,b]
 namesInType (TyConApp tc ts) = tyConName tc : getTypes ts
 namesInType (ForAllTy b t)   = varName (binderVar b) : namesInType t
-namesInType (FunTy a b)      = getTypes [a,b]
+namesInType (FunTy _ a b)    = getTypes [a,b]
 namesInType (CastTy t _)     = namesInType t
 namesInType (LitTy _)        = []
 namesInType _                = []

ghcide/src/Development/IDE/Spans/Common.hs

@@ -12,7 +12,7 @@ module Development.IDE.Spans.Common (
 , spanDocToMarkdown
 , spanDocToMarkdownForTest
 , DocMap
-, KindMap
+, TyThingMap
 ) where
 
 import           Control.DeepSeq
@@ -31,7 +31,7 @@ import qualified Documentation.Haddock.Parser as H
 import qualified Documentation.Haddock.Types  as H
 
 type DocMap = NameEnv SpanDoc
-type KindMap = NameEnv TyThing
+type TyThingMap = NameEnv TyThing
 
 -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier.
 #if MIN_VERSION_ghc(9,5,0)

ghcide/src/Development/IDE/Spans/Documentation.hs

@@ -39,7 +39,7 @@ mkDocMap
   :: HscEnv
   -> RefMap a
   -> TcGblEnv
-  -> IO DocAndKindMap
+  -> IO DocAndTyThingMap
 mkDocMap env rm this_mod =
   do
 #if MIN_VERSION_ghc(9,3,0)
@@ -61,8 +61,7 @@ mkDocMap env rm this_mod =
       doc <- getDocumentationTryGhc env n
       pure $ extendNameEnv nameMap n doc
     getType n nameMap
-      | isTcOcc $ occName n
-      , Nothing <- lookupNameEnv nameMap n
+      | Nothing <- lookupNameEnv nameMap n
       = do kind <- lookupKind env n
            pure $ maybe nameMap (extendNameEnv nameMap n) kind
       | otherwise = pure nameMap

haskell-language-server.cabal

@@ -164,6 +164,11 @@ flag overloadedRecordDot
   default:     True
   manual:      True
 
+flag semanticTokens
+  description: Enable semantic tokens plugin
+  default:     True
+  manual:      True
+
 -- formatters
 
 flag floskell
@@ -333,6 +338,12 @@ common refactor
     build-depends: hls-refactor-plugin == 2.5.0.0
     cpp-options: -Dhls_refactor
 
+common semanticTokens
+  if flag(semanticTokens)
+    build-depends: hls-semantic-tokens-plugin == 2.5.0.0
+    cpp-options: -Dhls_semanticTokens
+
+
 library
   import:           common-deps
                     -- configuration
@@ -365,6 +376,7 @@ library
                   , stylishHaskell
                   , refactor
                   , overloadedRecordDot
+                  , semanticTokens
 
   exposed-modules:
     Ide.Arguments

hls-plugin-api/src/Ide/Plugin/Config.hs

@@ -66,6 +66,7 @@ parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig
 parsePluginConfig def = A.withObject "PluginConfig" $ \o  -> PluginConfig
       <$> o .:? "globalOn"         .!= plcGlobalOn def
       <*> o .:? "callHierarchyOn"  .!= plcCallHierarchyOn def
+      <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def
       <*> o .:? "codeActionsOn"    .!= plcCodeActionsOn def
       <*> o .:? "codeLensOn"       .!= plcCodeLensOn    def
       <*> o .:? "diagnosticsOn"    .!= plcDiagnosticsOn def -- AZ

hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs

@@ -93,6 +93,7 @@ pluginsToDefaultConfig IdePlugins {..} =
           SMethod_TextDocumentDocumentSymbol       -> ["symbolsOn" A..= plcSymbolsOn]
           SMethod_TextDocumentCompletion           -> ["completionOn" A..= plcCompletionOn]
           SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn]
+          SMethod_TextDocumentSemanticTokensFull   -> ["semanticTokensOn" A..= plcSemanticTokensOn]
           _                                 -> []
 
 -- | Generates json schema used in haskell vscode extension
@@ -123,6 +124,7 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
           SMethod_TextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols"]
           SMethod_TextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions"]
           SMethod_TextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy"]
+          SMethod_TextDocumentSemanticTokensFull -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens"]
           _ -> []
         schemaEntry desc =
           A.object