Support Inlay hints for record wildcards (#4351)

* Provide explicit import in inlay hints

* Filter explict imports inlay hints by visible range

* Update lsp dep by source-repository-package

to writing test before new release of haskell/lsp.

* Add test for hls-explicit-imports-plugin inlay hints

* Comment inlay hints start position

* Use `isSubrangeOf` to test if the range is visible

* Remove inlayHintsResolveProvider placeholder for now

* Use explicit InlayHintKind_Type

* Revert "Update lsp dep by source-repository-package"

This reverts commit 245049a.

* Combine InlayHints by sconcat them

and remove `instance PluginRequestMethod Method_InlayHintResolve`
since have not decide how to combine.

* compress multiple spaces in abbr import tilte

* update test to match inlay hints kind

* rename squashedAbbreviateImportTitle to abbreviateImportTitleWithoutModule

* Request inlay hints with testEdits

* ExplicitImports fallback to codelens when inlay hints not support

* fix explicitImports inlayHints test

* simplify isInlayHintsSupported

* comment fallback

* empty list instead of null codeLens

* clearify name `paddingLeft`

* fix clientCapabilities

* add test for inlay hints without its client caps

* use codeActionNoInlayHintsCaps to avoid error

* simplify isInlayHintSupported

* comment about paddingLeft

* use null as inlay hints kind

* add tooltip for explicit imports inlay hints to improve UX

* chore comments

* refactor

* comment InL [] to indicate no info

* ignore refine inlay hints

* add plcInlayHintsOn config

* update func-test

* keep order to make Parser works

* always provide refine in code lens

* init explicit record fields inlay hints

* dotdot location in label part

* update test for dotdot location in label part

* get(Type)Definition with its Identifier

* add flipped filterByRange

* filter label with name

* update test

* re-generate schema

* fix explict-record-fields plugin in GHC 910

* fix use correct currentPosition

* comment

* rename flippedFilterByRange to elementsInRange

* refactor: lift

* refactor: break pointfree

* refactor

* recover accidentally deleted macros

---------

Co-authored-by: Michael Peyton Jones <me@michaelpj.com>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: 3 people

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

@@ -66,56 +66,59 @@ getAtPoint file pos = runMaybeT $ do
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
   MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'
 
--- | For each Location, determine if we have the PositionMapping
--- for the correct file. If not, get the correct position mapping
--- and then apply the position mapping to the location.
-toCurrentLocations
+-- | Converts locations in the source code to their current positions,
+-- taking into account changes that may have occurred due to edits.
+toCurrentLocation
   :: PositionMapping
   -> NormalizedFilePath
-  -> [Location]
-  -> IdeAction [Location]
-toCurrentLocations mapping file = mapMaybeM go
+  -> Location
+  -> IdeAction (Maybe Location)
+toCurrentLocation mapping file (Location uri range) =
+  -- The Location we are going to might be in a different
+  -- file than the one we are calling gotoDefinition from.
+  -- So we check that the location file matches the file
+  -- we are in.
+  if nUri == normalizedFilePathToUri file
+  -- The Location matches the file, so use the PositionMapping
+  -- we have.
+  then pure $ Location uri <$> toCurrentRange mapping range
+  -- The Location does not match the file, so get the correct
+  -- PositionMapping and use that instead.
+  else do
+    otherLocationMapping <- fmap (fmap snd) $ runMaybeT $ do
+      otherLocationFile <- MaybeT $ pure $ uriToNormalizedFilePath nUri
+      useWithStaleFastMT GetHieAst otherLocationFile
+    pure $ Location uri <$> (flip toCurrentRange range =<< otherLocationMapping)
   where
-    go :: Location -> IdeAction (Maybe Location)
-    go (Location uri range) =
-      -- The Location we are going to might be in a different
-      -- file than the one we are calling gotoDefinition from.
-      -- So we check that the location file matches the file
-      -- we are in.
-      if nUri == normalizedFilePathToUri file
-      -- The Location matches the file, so use the PositionMapping
-      -- we have.
-      then pure $ Location uri <$> toCurrentRange mapping range
-      -- The Location does not match the file, so get the correct
-      -- PositionMapping and use that instead.
-      else do
-        otherLocationMapping <- fmap (fmap snd) $ runMaybeT $ do
-          otherLocationFile <- MaybeT $ pure $ uriToNormalizedFilePath nUri
-          useWithStaleFastMT GetHieAst otherLocationFile
-        pure $ Location uri <$> (flip toCurrentRange range =<< otherLocationMapping)
-      where
-        nUri :: NormalizedUri
-        nUri = toNormalizedUri uri
+    nUri :: NormalizedUri
+    nUri = toNormalizedUri uri
 
 -- | Goto Definition.
-getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
+getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [(Location, Identifier)])
 getDefinition file pos = runMaybeT $ do
     ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask
     opts <- liftIO $ getIdeOptionsIO ide
     (HAR _ hf _ _ _, mapping) <- useWithStaleFastMT GetHieAst file
     (ImportMap imports, _) <- useWithStaleFastMT GetImportMap file
     !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos)
-    locations <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos'
-    MaybeT $ Just <$> toCurrentLocations mapping file locations
+    locationsWithIdentifier <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos'
+    mapMaybeM (\(location, identifier) -> do
+      fixedLocation <- MaybeT $ toCurrentLocation mapping file location
+      pure $ Just (fixedLocation, identifier)
+      ) locationsWithIdentifier
 
-getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
+
+getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [(Location, Identifier)])
 getTypeDefinition file pos = runMaybeT $ do
     ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask
     opts <- liftIO $ getIdeOptionsIO ide
     (hf, mapping) <- useWithStaleFastMT GetHieAst file
     !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-    locations <- AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos'
-    MaybeT $ Just <$> toCurrentLocations mapping file locations
+    locationsWithIdentifier <- AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos'
+    mapMaybeM (\(location, identifier) -> do
+      fixedLocation <- MaybeT $ toCurrentLocation mapping file location
+      pure $ Just (fixedLocation, identifier)
+      ) locationsWithIdentifier
 
 highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
 highlightAtPoint file pos = runMaybeT $ do

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

@@ -633,6 +633,8 @@ instance HasSrcSpan (EpAnn a) where
 #if MIN_VERSION_ghc(9,9,0)
 instance HasSrcSpan (SrcLoc.GenLocated (EpAnn ann) a) where
   getLoc (L l _) = getLoc l
+instance HasSrcSpan (SrcLoc.GenLocated (GHC.EpaLocation) a) where
+  getLoc = GHC.getHasLoc
 #else
 instance HasSrcSpan (SrcSpanAnn' ann) where
   getLoc = GHC.locA

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

@@ -226,6 +226,12 @@ instance NFData (HsExpr (GhcPass Renamed)) where
 instance NFData (Pat (GhcPass Renamed)) where
     rnf = rwhnf
 
+instance NFData (HsExpr (GhcPass Typechecked)) where
+    rnf = rwhnf
+
+instance NFData (Pat (GhcPass Typechecked)) where
+    rnf = rwhnf
+
 instance NFData Extension where
   rnf = rwhnf
 

ghcide/src/Development/IDE/LSP/HoverDefinition.hs

@@ -47,8 +47,8 @@ gotoDefinition     :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPos
 hover              :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) (Hover |? Null)
 gotoTypeDefinition :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) (MessageResult Method_TextDocumentTypeDefinition)
 documentHighlight  :: Recorder (WithPriority Log) -> IdeState -> TextDocumentPositionParams -> ExceptT PluginError (HandlerM c) ([DocumentHighlight] |? Null)
-gotoDefinition = request "Definition" getDefinition (InR $ InR Null) (InL . Definition. InR)
-gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (InR $ InR Null) (InL . Definition. InR)
+gotoDefinition = request "Definition" getDefinition (InR $ InR Null) (InL . Definition. InR . map fst)
+gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (InR $ InR Null) (InL . Definition. InR . map fst)
 hover          = request "Hover"      getAtPoint     (InR Null)     foundHover
 documentHighlight = request "DocumentHighlight" highlightAtPoint (InR Null) InL
 

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

@@ -179,14 +179,15 @@ documentHighlight hf rf pos = pure highlights
         then DocumentHighlightKind_Write
         else DocumentHighlightKind_Read
 
+-- | Locate the type definition of the name at a given position.
 gotoTypeDefinition
   :: MonadIO m
   => WithHieDb
   -> LookupModule m
   -> IdeOptions
   -> HieAstResult
   -> Position
-  -> MaybeT m [Location]
+  -> MaybeT m [(Location, Identifier)]
 gotoTypeDefinition withHieDb lookupModule ideOpts srcSpans pos
   = lift $ typeLocationsAtPoint withHieDb lookupModule ideOpts pos srcSpans
 
@@ -199,7 +200,7 @@ gotoDefinition
   -> M.Map ModuleName NormalizedFilePath
   -> HieASTs a
   -> Position
-  -> MaybeT m [Location]
+  -> MaybeT m [(Location, Identifier)]
 gotoDefinition withHieDb getHieFile ideOpts imports srcSpans pos
   = lift $ locationsAtPoint withHieDb getHieFile ideOpts imports pos srcSpans
 
@@ -306,6 +307,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env
             UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing
             _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"
 
+-- | Find 'Location's of type definition at a specific point and return them along with their 'Identifier's.
 typeLocationsAtPoint
   :: forall m
    . MonadIO m
@@ -314,7 +316,7 @@ typeLocationsAtPoint
   -> IdeOptions
   -> Position
   -> HieAstResult
-  -> m [Location]
+  -> m [(Location, Identifier)]
 typeLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _ _ hieKind) =
   case hieKind of
     HieFromDisk hf ->
@@ -332,12 +334,12 @@ typeLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _ _ hieKi
             HQualTy a b -> getTypes' [a,b]
             HCastTy a -> getTypes' [a]
             _ -> []
-        in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation withHieDb lookupModule) (getTypes' ts)
+        in fmap nubOrd $ concatMapM (\n -> fmap (maybe [] (fmap (,Right n))) (nameToLocation withHieDb lookupModule n)) (getTypes' ts)
     HieFresh ->
       let ts = concat $ pointCommand ast pos getts
           getts x = nodeType ni  ++ (mapMaybe identType $ M.elems $ nodeIdentifiers ni)
             where ni = nodeInfo x
-        in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation withHieDb lookupModule) (getTypes ts)
+        in fmap nubOrd $ concatMapM (\n -> fmap (maybe [] (fmap (,Right n))) (nameToLocation withHieDb lookupModule n)) (getTypes ts)
 
 namesInType :: Type -> [Name]
 namesInType (TyVarTy n)      = [varName n]
@@ -352,6 +354,7 @@ namesInType _                = []
 getTypes :: [Type] -> [Name]
 getTypes ts = concatMap namesInType ts
 
+-- | Find 'Location's of definition at a specific point and return them along with their 'Identifier's.
 locationsAtPoint
   :: forall m a
    . MonadIO m
@@ -361,13 +364,16 @@ locationsAtPoint
   -> M.Map ModuleName NormalizedFilePath
   -> Position
   -> HieASTs a
-  -> m [Location]
+  -> m [(Location, Identifier)]
 locationsAtPoint withHieDb lookupModule _ideOptions imports pos ast =
   let ns = concat $ pointCommand ast pos (M.keys . getNodeIds)
       zeroPos = Position 0 0
       zeroRange = Range zeroPos zeroPos
-      modToLocation m = fmap (\fs -> pure $ Location (fromNormalizedUri $ filePathToUri' fs) zeroRange) $ M.lookup m imports
-    in fmap (nubOrd . concat) $ mapMaybeM (either (pure . modToLocation) $ nameToLocation withHieDb lookupModule) ns
+      modToLocation m = fmap (\fs -> pure (Location (fromNormalizedUri $ filePathToUri' fs) zeroRange)) $ M.lookup m imports
+   in fmap (nubOrd . concat) $ mapMaybeM
+        (either (\m -> pure ((fmap $ fmap (,Left m)) (modToLocation m)))
+                (\n -> fmap (fmap $ fmap (,Right n)) (nameToLocation withHieDb lookupModule n)))
+        ns
 
 -- | Given a 'Name' attempt to find the location where it is defined.
 nameToLocation :: MonadIO m => WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])

haskell-language-server.cabal

@@ -1360,6 +1360,7 @@ test-suite hls-explicit-record-fields-plugin-tests
     , base
     , filepath
     , text
+    , ghcide
     , haskell-language-server:hls-explicit-record-fields-plugin
     , hls-test-utils              == 2.9.0.1
 

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

@@ -13,6 +13,7 @@ module Ide.Plugin.RangeMap
     fromList,
     fromList',
     filterByRange,
+    elementsInRange,
   ) where
 
 import           Development.IDE.Graph.Classes            (NFData)
@@ -67,6 +68,14 @@ filterByRange range = map snd . IM.dominators (rangeToInterval range) . unRangeM
 filterByRange range = map snd . filter (isSubrangeOf range . fst) . unRangeMap
 #endif
 
+-- | Extracts all elements from a 'RangeMap' that fall within a given 'Range'.
+elementsInRange :: Range -> RangeMap a -> [a]
+#ifdef USE_FINGERTREE
+elementsInRange range = map snd . IM.intersections (rangeToInterval range) . unRangeMap
+#else
+elementsInRange range = map snd . filter (flip isSubrangeOf range . fst) . unRangeMap
+#endif
+
 #ifdef USE_FINGERTREE
 -- NOTE(ozkutuk): In itself, this conversion is wrong. As Michael put it:
 -- "LSP Ranges have exclusive upper bounds, whereas the intervals here are