Merge branch 'master' into cabal-hover-documentation

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

@@ -48,8 +48,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