From 4b4f8a7cc9c4cc198f9a94750e1d5b979f767c8a Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Tue, 18 Jul 2023 12:57:18 -0500 Subject: [PATCH 1/2] Add gotoDefinition other file tests --- test/functional/Definition.hs | 33 +++++++++++++++++++++++++++---- test/testdata/definition/Bar.hs | 6 ++++++ test/testdata/definition/Foo.hs | 3 +++ test/testdata/definition/hie.yaml | 5 +++++ 4 files changed, 43 insertions(+), 4 deletions(-) create mode 100644 test/testdata/definition/hie.yaml diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index 24ce49297d..3c32f2cf72 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -7,18 +7,43 @@ import Test.Hls import Test.Hls.Command tests :: TestTree -tests = testGroup "definitions" [ +tests = testGroup "definitions" [symbolTests, moduleTests] - ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/References.hs" $ - testCase "goto's symbols" $ runSession hlsCommand fullCaps "test/testdata" $ do +symbolTests :: TestTree +symbolTests = testGroup "gotoDefinition on symbols" + -- gotoDefinition where the definition is in the same file + [ testCase "gotoDefinition in this file" $ runSession hlsCommand fullCaps "test/testdata" $ do doc <- openDoc "References.hs" "haskell" defs <- getDefinitions doc (Position 7 8) let expRange = Range (Position 4 0) (Position 4 3) liftIO $ defs @?= InL (Definition (InR [Location (doc ^. uri) expRange])) + -- gotoDefinition where the definition is in a different file + , testCase "gotoDefinition in other file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do + doc <- openDoc "Foo.hs" "haskell" + defs <- getDefinitions doc (Position 4 11) + let expRange = Range (Position 2 0) (Position 2 1) + liftIO $ do + fp <- canonicalizePath "test/testdata/definition/Bar.hs" + defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange])) + + -- gotoDefinition where the definition is in a different file and the + -- definition in the other file is on a line number that is greater + -- than the number of lines in the file we are requesting from + , testCase "gotoDefinition in other file past lines in this file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do + doc <- openDoc "Foo.hs" "haskell" + defs <- getDefinitions doc (Position 5 13) + let expRange = Range (Position 8 0) (Position 8 1) + liftIO $ do + fp <- canonicalizePath "test/testdata/definition/Bar.hs" + defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange])) + ] + -- ----------------------------------- - , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ +moduleTests :: TestTree +moduleTests = testGroup "gotoDefinition on modules" + [ ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ testCase "goto's imported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do doc <- openDoc "Foo.hs" "haskell" defs <- getDefinitions doc (Position 2 8) diff --git a/test/testdata/definition/Bar.hs b/test/testdata/definition/Bar.hs index 02a244cd4d..9ae116114e 100644 --- a/test/testdata/definition/Bar.hs +++ b/test/testdata/definition/Bar.hs @@ -1,3 +1,9 @@ module Bar where a = 42 + +-- These blank lines are here +-- to ensure that b is defined +-- on a line number larger than +-- the number of lines in Foo.hs. +b = 43 diff --git a/test/testdata/definition/Foo.hs b/test/testdata/definition/Foo.hs index 6dfb3ba2e6..ca73e2d375 100644 --- a/test/testdata/definition/Foo.hs +++ b/test/testdata/definition/Foo.hs @@ -1,3 +1,6 @@ module Foo (module Bar) where import Bar + +fortyTwo = a +fortyThree = b diff --git a/test/testdata/definition/hie.yaml b/test/testdata/definition/hie.yaml new file mode 100644 index 0000000000..9adb47d0f3 --- /dev/null +++ b/test/testdata/definition/hie.yaml @@ -0,0 +1,5 @@ +cradle: + direct: + arguments: + - "Foo" + - "Bar" From 3b64fbb234dd56fbb7a4c9c115b810b0321b663b Mon Sep 17 00:00:00 2001 From: Elodie Lander Date: Thu, 20 Jul 2023 11:25:09 -0500 Subject: [PATCH 2/2] Use correct position mapping in getDefinition --- ghcide/src/Development/IDE/Core/Actions.hs | 43 +++++++++++++++++++--- 1 file changed, 37 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index c8e384c1b5..7c0ea1a07e 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -13,6 +13,7 @@ module Development.IDE.Core.Actions , lookupMod ) where +import Control.Monad.Extra (mapMaybeM) import Control.Monad.Reader import Control.Monad.Trans.Maybe import qualified Data.HashMap.Strict as HM @@ -31,7 +32,9 @@ import Development.IDE.Types.HscEnvEq (hscEnv) import Development.IDE.Types.Location import qualified HieDb import Language.LSP.Protocol.Types (DocumentHighlight (..), - SymbolInformation (..)) + SymbolInformation (..), + normalizedFilePathToUri, + uriToNormalizedFilePath) -- | Eventually this will lookup/generate URIs for files in dependencies, but not in the @@ -66,10 +69,36 @@ getAtPoint file pos = runMaybeT $ do !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) MaybeT $ pure $ first (toCurrentRange mapping =<<) <$> AtPoint.atPoint opts hf dkMap env pos' -toCurrentLocations :: PositionMapping -> [Location] -> [Location] -toCurrentLocations mapping = mapMaybe go +-- | For each Loacation, 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 + :: PositionMapping + -> NormalizedFilePath + -> [Location] + -> IdeAction [Location] +toCurrentLocations mapping file = mapMaybeM go where - go (Location uri range) = Location uri <$> toCurrentRange mapping range + 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 + useE GetHieAst otherLocationFile + pure $ Location uri <$> (flip toCurrentRange range =<< otherLocationMapping) + where + nUri :: NormalizedUri + nUri = toNormalizedUri uri -- | useE is useful to implement functions that aren’t rules but need shortcircuiting -- e.g. getDefinition. @@ -90,7 +119,8 @@ getDefinition file pos = runMaybeT $ do (HAR _ hf _ _ _, mapping) <- useE GetHieAst file (ImportMap imports, _) <- useE GetImportMap file !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos) - toCurrentLocations mapping <$> AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos' + locations <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos' + MaybeT $ Just <$> toCurrentLocations mapping file locations getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location]) getTypeDefinition file pos = runMaybeT $ do @@ -98,7 +128,8 @@ getTypeDefinition file pos = runMaybeT $ do opts <- liftIO $ getIdeOptionsIO ide (hf, mapping) <- useE GetHieAst file !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) - toCurrentLocations mapping <$> AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos' + locations <- AtPoint.gotoTypeDefinition withHieDb (lookupMod hiedbWriter) opts hf pos' + MaybeT $ Just <$> toCurrentLocations mapping file locations highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight]) highlightAtPoint file pos = runMaybeT $ do