hls-notes-plugin: Allow Note definition within single line comments

Author: jvanbruegge

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

@@ -128,7 +128,7 @@ findNotesInFile file recorder = do
             ((x@(name, (char, _)):xs, m), (n, nc, c)) -> \char' ->
                 let !c' = c + 1
                     (!n', !nc') = if char' == '\n' then (n + 1, c') else (n, nc)
-                    p = if char == c then
+                    p@(!_, !_) = if char == c then
                             (xs, HM.insert name (Position (uint n') (uint (char - nc'))) m)
                         else (x:xs, m)
                 in (p, (n', nc', c'))
@@ -137,7 +137,7 @@ findNotesInFile file recorder = do
 noteRefRegex, noteRegex :: Regex
 (noteRefRegex, noteRegex) =
     ( mkReg ("note \\[(.+)\\]" :: String)
-    , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]][[:space:]]?~~~" :: String)
+    , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]](--)?[[:blank:]]*~~~" :: String)
     )
     where
         mkReg = makeRegexOpts (defaultCompOpt { caseSensitive = False }) defaultExecOpt

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

@@ -23,7 +23,21 @@ gotoNoteTests = testGroup "Goto Note Definition"
         defs <- getDefinitions doc (Position 3 41)
         liftIO $ do
           fp <- canonicalizePath "NoteDef.hs"
-          defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 5 9) (Position 5 9))]))
+          defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 8 9) (Position 8 9))]))
+    , testCase "liberal_format" $ runSessionWithServer def plugin testDataDir $ do
+        doc <- openDoc "NoteDef.hs" "haskell"
+        _ <- waitForAllProgressDone
+        defs <- getDefinitions doc (Position 5 64)
+        liftIO $ do
+          fp <- canonicalizePath "NoteDef.hs"
+          defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 18 9) (Position 18 9))]))
+    , testCase "invalid_note" $ runSessionWithServer def plugin testDataDir $ do
+        doc <- openDoc "NoteDef.hs" "haskell"
+        _ <- waitForAllProgressDone
+        defs <- getDefinitions doc (Position 6 54)
+        liftIO $ do
+            defs @?= InL (Definition (InR []))
+
     , testCase "no_note" $ runSessionWithServer def plugin testDataDir $ do
         doc <- openDoc "NoteDef.hs" "haskell"
         defs <- getDefinitions doc (Position 1 0)
@@ -36,7 +50,7 @@ gotoNoteTests = testGroup "Goto Note Definition"
         defs <- getDefinitions doc (Position 5 20)
         liftIO $ do
           fp <- canonicalizePath "NoteDef.hs"
-          defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 9 6) (Position 9 6))]))
+          defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 12 6) (Position 12 6))]))
     ]
 
 testDataDir :: FilePath

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

@@ -3,6 +3,9 @@ module NoteDef (foo) where
 foo :: Int -> Int
 foo _ = 0 -- We always return zero, see Note [Returning zero from foo]
 
+-- The plugin is more liberal with the note definitions, see Note [Single line comments]
+-- It does not work on wrong note definitions, see Note [Not a valid Note]
+
 {- Note [Returning zero from foo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 This is a big long form note, with very important info
@@ -12,3 +15,14 @@ Note [Multiple notes in comment]
 This is also a very common thing to do for GHC
 
 -}
+
+-- Note [Single line comments]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- GHC's notes script only allows multiline comments to define notes, but in the
+-- HLS codebase this single line style can be found as well.
+
+{- Note [Not a valid Note]
+
+~~~~~~~~~~~~
+The underline needs to be directly under the Note header
+-}