Merge remote-tracking branch 'upstream/master' into inlay-hints-local-binding

Author: jetjinser

cabal.project

@@ -7,14 +7,8 @@ packages:
          ./hls-plugin-api
          ./hls-test-utils
 
--- Only keep this until https://github.com/Bodigrim/cabal-add/issues/7
--- is resolved
-source-repository-package
-    type: git
-    location: https://github.com/Bodigrim/cabal-add.git
-    tag: 8c004e2a4329232f9824425f5472b2d6d7958bbd
-
-index-state: 2024-06-29T00:00:00Z
+
+index-state:  2024-08-22T00:00:00Z
 
 tests: True
 test-show-details: direct

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

@@ -242,6 +242,7 @@ library hls-cabal-plugin
     Ide.Plugin.Cabal.Completion.Completions
     Ide.Plugin.Cabal.Completion.Data
     Ide.Plugin.Cabal.Completion.Types
+    Ide.Plugin.Cabal.Definition
     Ide.Plugin.Cabal.FieldSuggest
     Ide.Plugin.Cabal.LicenseSuggest
     Ide.Plugin.Cabal.CabalAdd
@@ -287,11 +288,12 @@ test-suite hls-cabal-plugin-tests
   hs-source-dirs:   plugins/hls-cabal-plugin/test
   main-is:          Main.hs
   other-modules:
+    CabalAdd
     Completer
     Context
-    Utils
+    Definition
     Outline
-    CabalAdd
+    Utils
   build-depends:
     , base
     , bytestring
@@ -1358,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

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

@@ -17,14 +17,12 @@ import qualified Data.ByteString                             as BS
 import           Data.Hashable
 import           Data.HashMap.Strict                         (HashMap)
 import qualified Data.HashMap.Strict                         as HashMap
-import           Data.List                                   (find)
 import qualified Data.List.NonEmpty                          as NE
 import qualified Data.Maybe                                  as Maybe
 import qualified Data.Text                                   as T
 import qualified Data.Text.Encoding                          as Encoding
 import           Data.Typeable
 import           Development.IDE                             as D
-import           Development.IDE.Core.PluginUtils
 import           Development.IDE.Core.Shake                  (restartShakeSession)
 import qualified Development.IDE.Core.Shake                  as Shake
 import           Development.IDE.Graph                       (Key, alwaysRerun)
@@ -33,20 +31,19 @@ import           Development.IDE.Types.Shake                 (toKey)
 import qualified Distribution.Fields                         as Syntax
 import qualified Distribution.Parsec.Position                as Syntax
 import           GHC.Generics
-import           Ide.Plugin.Cabal.Completion.CabalFields     as CabalFields
 import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
 import qualified Ide.Plugin.Cabal.Completion.Completions     as Completions
 import           Ide.Plugin.Cabal.Completion.Types           (ParseCabalCommonSections (ParseCabalCommonSections),
                                                               ParseCabalFields (..),
                                                               ParseCabalFile (..))
 import qualified Ide.Plugin.Cabal.Completion.Types           as Types
+import           Ide.Plugin.Cabal.Definition                 (gotoDefinition)
 import qualified Ide.Plugin.Cabal.Diagnostics                as Diagnostics
 import qualified Ide.Plugin.Cabal.FieldSuggest               as FieldSuggest
 import qualified Ide.Plugin.Cabal.LicenseSuggest             as LicenseSuggest
 import           Ide.Plugin.Cabal.Orphans                    ()
 import           Ide.Plugin.Cabal.Outline
 import qualified Ide.Plugin.Cabal.Parse                      as Parse
-import           Ide.Plugin.Error
 import           Ide.Types
 import qualified Language.LSP.Protocol.Lens                  as JL
 import qualified Language.LSP.Protocol.Message               as LSP
@@ -305,32 +302,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
       let completionTexts = fmap (^. JL.label) completions
       pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
 
--- | CodeActions for going to definitions.
---
--- Provides a CodeAction for going to a definition when clicking on an identifier.
--- The definition is found by traversing the sections and comparing their name to
--- the clicked identifier.
---
--- TODO: Support more definitions than sections.
-gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
-gotoDefinition ideState _ msgParam = do
-    nfp <- getNormalizedFilePathE uri
-    cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp
-    case CabalFields.findTextWord cursor cabalFields of
-      Nothing ->
-        pure $ InR $ InR Null
-      Just cursorText -> do
-        commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp
-        case find (isSectionArgName cursorText) commonSections of
-          Nothing ->
-            pure $ InR $ InR Null
-          Just commonSection -> do
-            pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
-    where
-      cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
-      uri = msgParam ^. JL.textDocument . JL.uri
-      isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
-      isSectionArgName _ _ = False
 
 cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
 cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do