Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 8fc5a79

Browse files
jvanbrueggemergify[bot]
andauthored
hls-notes-plugin: Allow to see where a note is referenced from (#4624)
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 20b9c23 commit 8fc5a79

File tree

4 files changed

+109
-35
lines changed

4 files changed

+109
-35
lines changed

‎plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs

Lines changed: 86 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,21 @@
11
module Ide.Plugin.Notes (descriptor, Log) where
22

33
import Control.Lens ((^.))
4-
import Control.Monad.Except (throwError)
4+
import Control.Monad.Except (ExceptT, MonadError,
5+
throwError)
56
import Control.Monad.IO.Class (liftIO)
67
import qualified Data.Array as A
8+
import Data.Foldable (foldl')
79
import Data.HashMap.Strict (HashMap)
810
import qualified Data.HashMap.Strict as HM
911
import qualified Data.HashSet as HS
12+
import Data.List (uncons)
1013
import Data.Maybe (catMaybes, listToMaybe,
1114
mapMaybe)
1215
import Data.Text (Text, intercalate)
1316
import qualified Data.Text as T
1417
import qualified Data.Text.Utf16.Rope.Mixed as Rope
18+
import Data.Traversable (for)
1519
import Development.IDE hiding (line)
1620
import Development.IDE.Core.PluginUtils (runActionE, useE)
1721
import Development.IDE.Core.Shake (toKnownFiles)
@@ -21,8 +25,8 @@ import GHC.Generics (Generic)
2125
import Ide.Plugin.Error (PluginError (..))
2226
import Ide.Types
2327
import qualified Language.LSP.Protocol.Lens as L
24-
import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition),
25-
SMethod (SMethod_TextDocumentDefinition))
28+
import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition, Method_TextDocumentReferences),
29+
SMethod (SMethod_TextDocumentDefinition, SMethod_TextDocumentReferences))
2630
import Language.LSP.Protocol.Types
2731
import Text.Regex.TDFA (Regex, caseSensitive,
2832
defaultCompOpt,
@@ -31,25 +35,39 @@ import Text.Regex.TDFA (Regex, caseSensitive,
3135

3236
data Log
3337
= LogShake Shake.Log
34-
| LogNotesFound NormalizedFilePath [(Text, Position)]
38+
| LogNotesFound NormalizedFilePath [(Text, [Position])]
39+
| LogNoteReferencesFound NormalizedFilePath [(Text, [Position])]
3540
deriving Show
3641

3742
data GetNotesInFile = MkGetNotesInFile
3843
deriving (Show, Generic, Eq, Ord)
3944
deriving anyclass (Hashable, NFData)
40-
type instance RuleResult GetNotesInFile = HM.HashMap Text Position
45+
-- The GetNotesInFile action scans the source file and extracts a map of note
46+
-- definitions (note name -> position) and a map of note references
47+
-- (note name -> [position]).
48+
type instance RuleResult GetNotesInFile = (HM.HashMap Text Position, HM.HashMap Text [Position])
4149

4250
data GetNotes = MkGetNotes
4351
deriving (Show, Generic, Eq, Ord)
4452
deriving anyclass (Hashable, NFData)
53+
-- GetNotes collects all note definition across all files in the
54+
-- project. It returns a map from note name to pair of (filepath, position).
4555
type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position)
4656

57+
data GetNoteReferences = MkGetNoteReferences
58+
deriving (Show, Generic, Eq, Ord)
59+
deriving anyclass (Hashable, NFData)
60+
-- GetNoteReferences collects all note references across all files in the
61+
-- project. It returns a map from note name to list of (filepath, position).
62+
type instance RuleResult GetNoteReferences = HashMap Text [(NormalizedFilePath, Position)]
63+
4764
instance Pretty Log where
4865
pretty = \case
49-
LogShake l -> pretty l
50-
LogNotesFound file notes ->
51-
"Found notes in " <> pretty (show file) <> ": ["
52-
<> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> T.pack (show p)) notes)) <> "]"
66+
LogShake l -> pretty l
67+
LogNoteReferencesFound file refs -> "Found note references in " <> prettyNotes file refs
68+
LogNotesFound file notes -> "Found notes in " <> prettyNotes file notes
69+
where prettyNotes file hm = pretty (show file) <> ": ["
70+
<> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> intercalate ", " (map (T.pack . show) p)) hm)) <> "]"
5371

5472
{-
5573
The first time the user requests a jump-to-definition on a note reference, the
@@ -59,7 +77,9 @@ title is then saved in the HLS database to be retrieved for all future requests.
5977
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
6078
descriptor recorder plId = (defaultPluginDescriptor plId "Provides goto definition support for GHC-style notes")
6179
{ Ide.Types.pluginRules = findNotesRules recorder
62-
, Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDefinition jumpToNote
80+
, Ide.Types.pluginHandlers =
81+
mkPluginHandler SMethod_TextDocumentDefinition jumpToNote
82+
<> mkPluginHandler SMethod_TextDocumentReferences listReferences
6383
}
6484

6585
findNotesRules :: Recorder (WithPriority Log) -> Rules ()
@@ -69,20 +89,59 @@ findNotesRules recorder = do
6989

7090
defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNotes _ -> do
7191
targets <- toKnownFiles <$> useNoFile_ GetKnownTargets
72-
definedNotes <- catMaybes <$> mapM (\nfp -> fmap (HM.map (nfp,)) <$> use MkGetNotesInFile nfp) (HS.toList targets)
92+
definedNotes <- catMaybes <$> mapM (\nfp -> fmap (HM.map (nfp,).fst) <$> use MkGetNotesInFile nfp) (HS.toList targets)
7393
pure $ Just $ HM.unions definedNotes
7494

95+
defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNoteReferences _ -> do
96+
targets <- toKnownFiles <$> useNoFile_ GetKnownTargets
97+
definedReferences <- catMaybes <$> for (HS.toList targets) (\nfp -> do
98+
references <- fmap snd <$> use MkGetNotesInFile nfp
99+
pure $ fmap (HM.map (fmap (nfp,))) references
100+
)
101+
pure $ Just $ foldl' (HM.unionWith (<>)) HM.empty definedReferences
102+
103+
err :: MonadError PluginError m => Text -> Maybe a -> m a
104+
err s = maybe (throwError $ PluginInternalError s) pure
105+
106+
getNote :: NormalizedFilePath -> IdeState -> Position -> ExceptT PluginError (HandlerM c) (Maybe Text)
107+
getNote nfp state (Position l c) = do
108+
contents <-
109+
err "Error getting file contents"
110+
=<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp))
111+
line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst
112+
(Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents))
113+
pure $ listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line
114+
where
115+
atPos c arr = case arr A.! 0 of
116+
-- We check if the line we are currently at contains a note
117+
-- reference. However, we need to know if the cursor is within the
118+
-- match or somewhere else. The second entry of the array contains
119+
-- the title of the note as extracted by the regex.
120+
(_, (c', len)) -> if c' <= c && c <= c' + len
121+
then Just (fst (arr A.! 1)) else Nothing
122+
123+
listReferences :: PluginMethodHandler IdeState Method_TextDocumentReferences
124+
listReferences state _ param
125+
| Just nfp <- uriToNormalizedFilePath uriOrig
126+
= do
127+
let pos@(Position l _) = param ^. L.position
128+
noteOpt <- getNote nfp state pos
129+
case noteOpt of
130+
Nothing -> pure (InR Null)
131+
Just note -> do
132+
notes <- runActionE "notes.definedNoteReferencess" state $ useE MkGetNoteReferences nfp
133+
poss <- err ("Note reference (a comment of the form `{- Note [" <> note <> "] -}`) not found") (HM.lookup note notes)
134+
pure $ InL (mapMaybe (\(noteFp, pos@(Position l' _)) -> if l' == l then Nothing else Just (
135+
Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos))) poss)
136+
where
137+
uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri)
138+
listReferences _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed"
139+
75140
jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition
76141
jumpToNote state _ param
77142
| Just nfp <- uriToNormalizedFilePath uriOrig
78143
= do
79-
let Position l c = param ^. L.position
80-
contents <-
81-
err "Error getting file contents"
82-
=<< liftIO (runAction "notes.getfileContents" state (getFileContents nfp))
83-
line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst
84-
(Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents))
85-
let noteOpt = listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line
144+
noteOpt <- getNote nfp state (param ^. L.position)
86145
case noteOpt of
87146
Nothing -> pure (InR (InR Null))
88147
Just note -> do
@@ -93,28 +152,23 @@ jumpToNote state _ param
93152
))
94153
where
95154
uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri)
96-
err s = maybe (throwError $ PluginInternalError s) pure
97-
atPos c arr = case arr A.! 0 of
98-
-- We check if the line we are currently at contains a note
99-
-- reference. However, we need to know if the cursor is within the
100-
-- match or somewhere else. The second entry of the array contains
101-
-- the title of the note as extracted by the regex.
102-
(_, (c', len)) -> if c' <= c && c <= c' + len
103-
then Just (fst (arr A.! 1)) else Nothing
104155
jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed"
105156

106-
findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position))
157+
findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position, HM.HashMapText [Position]))
107158
findNotesInFile file recorder = do
108159
-- GetFileContents only returns a value if the file is open in the editor of
109160
-- the user. If not, we need to read it from disk.
110161
contentOpt <- (snd =<<) <$> use GetFileContents file
111162
content <- case contentOpt of
112163
Just x -> pure $ Rope.toText x
113164
Nothing -> liftIO $ readFileUtf8 $ fromNormalizedFilePath file
114-
let matches = (A.! 1) <$> matchAllText noteRegex content
115-
m = toPositions matches content
116-
logWith recorder Debug $ LogNotesFound file (HM.toList m)
117-
pure $ Just m
165+
let noteMatches = (A.! 1) <$> matchAllText noteRegex content
166+
notes = toPositions noteMatches content
167+
logWith recorder Debug $ LogNotesFound file (HM.toList notes)
168+
let refMatches = (A.! 1) <$> matchAllText noteRefRegex content
169+
refs = toPositions refMatches content
170+
logWith recorder Debug $ LogNoteReferencesFound file (HM.toList refs)
171+
pure $ Just (HM.mapMaybe (fmap fst . uncons) notes, refs)
118172
where
119173
uint = fromIntegral . toInteger
120174
-- the regex library returns the character index of the match. However
@@ -129,7 +183,7 @@ findNotesInFile file recorder = do
129183
let !c' = c + 1
130184
(!n', !nc') = if char' == '\n' then (n + 1, c') else (n, nc)
131185
p@(!_, !_) = if char == c then
132-
(xs, HM.insert name (Position (uint n') (uint (char - nc'))) m)
186+
(xs, HM.insertWith (<>)name [Position (uint n') (uint (char - nc'))] m)
133187
else (x:xs, m)
134188
in (p, (n', nc', c'))
135189
) ((matches, HM.empty), (0, 0, 0))

‎plugins/hls-notes-plugin/test/NotesTest.hs

Lines changed: 19 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ main :: IO ()
1111
main = defaultTestRunner $
1212
testGroup "Notes"
1313
[ gotoNoteTests
14+
, noteReferenceTests
1415
]
1516

1617
runSessionWithServer' :: FilePath -> (FilePath -> Session a) -> IO a
@@ -21,6 +22,21 @@ runSessionWithServer' fp act =
2122
, testDirLocation = Left fp
2223
} act
2324

25+
noteReferenceTests :: TestTree
26+
noteReferenceTests = testGroup "Note References"
27+
[
28+
testCase "multi_file" $ runSessionWithServer' testDataDir $ \dir -> do
29+
doc <- openDoc "NoteDef.hs" "haskell"
30+
waitForKickDone
31+
refs <- getReferences doc (Position 21 15) False
32+
let fp = dir </> "NoteDef.hs"
33+
liftIO $ refs @?= [
34+
Location (filePathToUri (dir </> "Other.hs")) (Range (Position 6 13) (Position 6 13)),
35+
Location (filePathToUri fp) (Range (Position 9 9) (Position 9 9)),
36+
Location (filePathToUri fp) (Range (Position 5 67) (Position 5 67))
37+
]
38+
]
39+
2440
gotoNoteTests :: TestTree
2541
gotoNoteTests = testGroup "Goto Note Definition"
2642
[
@@ -29,13 +45,13 @@ gotoNoteTests = testGroup "Goto Note Definition"
2945
waitForKickDone
3046
defs <- getDefinitions doc (Position 3 41)
3147
let fp = dir </> "NoteDef.hs"
32-
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 8 9) (Position 8 9))]))
48+
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 11 9) (Position 11 9))]))
3349
, testCase "liberal_format" $ runSessionWithServer' testDataDir $ \dir -> do
3450
doc <- openDoc "NoteDef.hs" "haskell"
3551
waitForKickDone
3652
defs <- getDefinitions doc (Position 5 64)
3753
let fp = dir </> "NoteDef.hs"
38-
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 18 11) (Position 18 11))]))
54+
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 21 11) (Position 21 11))]))
3955

4056
, testCase "invalid_note" $ runSessionWithServer' testDataDir $ const $ do
4157
doc <- openDoc "NoteDef.hs" "haskell"
@@ -54,7 +70,7 @@ gotoNoteTests = testGroup "Goto Note Definition"
5470
waitForKickDone
5571
defs <- getDefinitions doc (Position 5 20)
5672
let fp = dir </> "NoteDef.hs"
57-
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 12 6) (Position 12 6))]))
73+
liftIO $ defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 15 6) (Position 15 6))]))
5874
]
5975

6076
testDataDir :: FilePath

‎plugins/hls-notes-plugin/test/testdata/NoteDef.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,9 @@ foo _ = 0 -- We always return zero, see Note [Returning zero from foo]
66
-- The plugin is more liberal with the note definitions, see Note [Single line comments]
77
-- It does not work on wrong note definitions, see Note [Not a valid Note]
88

9+
-- We can also have multiple references to the same note, see
10+
-- Note [Single line comments]
11+
912
{- Note [Returning zero from foo]
1013
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1114
This is a big long form note, with very important info

‎plugins/hls-notes-plugin/test/testdata/Other.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,4 @@ import NoteDef
44

55
bar :: Int
66
bar = 4 -- See @Note [Multiple notes in comment]@ in NoteDef
7+
-- See Note [Single line comments]

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /