From 08bdb650687663cf26b1b2ee1cce276a55197785 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Thu, 8 Jun 2023 23:04:27 +0200 Subject: [PATCH 01/11] hls-notes-plugin: Initial implementation --- haskell-language-server.cabal | 56 ++++++++ plugins/hls-notes-plugin/README.md | 30 +++++ .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 125 ++++++++++++++++++ plugins/hls-notes-plugin/test/NotesTest.hs | 43 ++++++ .../hls-notes-plugin/test/testdata/NoteDef.hs | 14 ++ .../hls-notes-plugin/test/testdata/Other.hs | 6 + .../hls-notes-plugin/test/testdata/hie.yaml | 5 + src/HlsPlugins.hs | 7 + 8 files changed, 286 insertions(+) create mode 100644 plugins/hls-notes-plugin/README.md create mode 100644 plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs create mode 100644 plugins/hls-notes-plugin/test/NotesTest.hs create mode 100644 plugins/hls-notes-plugin/test/testdata/NoteDef.hs create mode 100644 plugins/hls-notes-plugin/test/testdata/Other.hs create mode 100644 plugins/hls-notes-plugin/test/testdata/hie.yaml diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 9f719d06b4..d6f7acf743 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1607,6 +1607,61 @@ test-suite hls-semantic-tokens-plugin-tests , data-default , row-types +----------------------------- +-- notes plugin +----------------------------- + +flag notes + description: Enable notes plugin + default: True + manual: True + +common notes + if flag(notes) + build-depends: haskell-language-server:hls-notes-plugin + cpp-options: -Dhls_notes + +library hls-notes-plugin + import: defaults, pedantic, warnings + buildable: True + exposed-modules: + Ide.Plugin.Notes + hs-source-dirs: plugins/hls-notes-plugin/src + build-depends: + , base >=4.12 && <5 + , array + , ghcide == 2.7.0.0 + , hls-graph == 2.7.0.0 + , hls-plugin-api == 2.7.0.0 + , lens + , lsp >=2.4 + , mtl >= 2.2 + , regex-tdfa >= 1.3.1 + , text + , text-rope + , unordered-containers + default-extensions: + DataKinds + , DeriveAnyClass + , DerivingStrategies + , OverloadedStrings + , LambdaCase + , TypeFamilies + +test-suite hls-notes-plugin-tests + import: defaults, pedantic, test-defaults, warnings + type: exitcode-stdio-1.0 + hs-source-dirs: plugins/hls-notes-plugin/test + main-is: NotesTest.hs + build-depends: + , base + , directory + , filepath + , ghcide:ghcide-test-utils + , haskell-language-server:hls-notes-plugin + , hls-test-utils == 2.7.0.0 + default-extensions: OverloadedStrings + ---------------------------- ---------------------------- -- HLS @@ -1645,6 +1700,7 @@ library , refactor , overloadedRecordDot , semanticTokens + , notes exposed-modules: Ide.Arguments diff --git a/plugins/hls-notes-plugin/README.md b/plugins/hls-notes-plugin/README.md new file mode 100644 index 0000000000..60a9a4d4c0 --- /dev/null +++ b/plugins/hls-notes-plugin/README.md @@ -0,0 +1,30 @@ +# Note plugin + +The [Note convention](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/coding-style#2-using-notes) is a nice way to hoist and share big chunks of documentation out of the body of functions. This is done by referencing a long form note from within the function. This plugin extends goto-definition to jump from the reference to the note. + +# Example + +Main.hs +```haskell +module Main where + +main :: IO +main = do + doSomething -- We need this here, see Note [Do Something] in Foo +``` + +Foo.hs +``` +module Foo where + +doSomething :: IO () +doSomething = undefined + +{- +Note [Do Something] +~~~~~~~~~~~~~~~~~~~ +Some very important explanation +-} +``` + +Using "Go-to-definition on the Note reference in `Main.hs` will jump to the beginning of the note in `Foo.hs`. diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs new file mode 100644 index 0000000000..e329551200 --- /dev/null +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -0,0 +1,125 @@ +module Ide.Plugin.Notes (descriptor, Log) where + +import Control.Lens (ix, (^.), (^?)) +import Control.Monad.Except (throwError) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans (lift) +import qualified Data.Array as A +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS +import Data.Maybe (catMaybes, listToMaybe, + mapMaybe) +import Data.Text (Text, intercalate) +import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope +import Development.IDE hiding (line) +import Development.IDE.Core.PluginUtils (runActionE, useE) +import Development.IDE.Core.Shake (toKnownFiles) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph.Classes (Hashable, NFData) +import GHC.Generics (Generic) +import Ide.Plugin.Error (PluginError (..)) +import Ide.Types +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition), + SMethod (SMethod_TextDocumentDefinition)) +import Language.LSP.Protocol.Types +import qualified Language.LSP.Server as LSP +import Language.LSP.VFS (VirtualFile (..)) +import Text.Regex.TDFA (Regex, caseSensitive, + defaultCompOpt, + defaultExecOpt, + makeRegexOpts, matchAllText) + +data Log + = LogShake Shake.Log + | LogNotesFound NormalizedFilePath [(Text, Position)] + deriving Show + +data GetNotesInFile = MkGetNotesInFile + deriving (Show, Generic, Eq, Ord) + deriving anyclass (Hashable, NFData) +type instance RuleResult GetNotesInFile = HM.HashMap Text Position + +data GetNotes = MkGetNotes + deriving (Show, Generic, Eq, Ord) + deriving anyclass (Hashable, NFData) +type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position) + +instance Pretty Log where + pretty = \case + LogShake l -> pretty l + LogNotesFound file notes -> + "Found notes in " <> pretty (show file) <> ": [" + <> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> T.pack (show p)) notes)) <> "]" + +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder plId = (defaultPluginDescriptor plId "Provides goto definition support for GHC-style notes") + { Ide.Types.pluginRules = findNotesRules recorder + , Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDefinition jumpToNote + } + +findNotesRules :: Recorder (WithPriority Log) -> Rules () +findNotesRules recorder = do + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNotesInFile nfp -> do + findNotesInFile nfp recorder + + defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \MkGetNotes _ -> do + targets <- toKnownFiles <$> useNoFile_ GetKnownTargets + definedNotes <- catMaybes <$> mapM (\nfp -> fmap (HM.map (nfp,)) <$> use MkGetNotesInFile nfp) (HS.toList targets) + pure $ Just $ HM.unions definedNotes + +jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition +jumpToNote state _ param + | Just nfp <- uriToNormalizedFilePath uriOrig + = do + let Position l c = param ^. L.position + contents <- fmap _file_text . err "Error getting file contents" + =<< lift (LSP.getVirtualFile uriOrig) + line <- err "Line not found in file" (Rope.lines contents ^? ix (fromIntegral l)) + note <- err "No note at this position" $ listToMaybe $ + mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line + notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes nfp + (noteFp, pos) <- err "Note not found" (HM.lookup note notes) + pure $ InL (Definition (InL + (Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos)) + )) + where + uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) + err s = maybe (throwError $ PluginInternalError s) pure + atPos c arr = case arr A.! 0 of + (_, (c', len)) -> if c' <= c && c <= c' + len + then Just (fst (arr A.! 1)) else Nothing +jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" + +findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position)) +findNotesInFile file recorder = do + contentOpt <- (snd =<<) <$> use GetFileContents file + content <- case contentOpt of + Just x -> pure x + Nothing -> liftIO $ readFileUtf8 $ fromNormalizedFilePath file + let matches = (A.! 1) <$> matchAllText noteRegex content + m = toPositions matches content + logWith recorder Debug $ LogNotesFound file (HM.toList m) + pure $ Just m + where + uint = fromIntegral . toInteger + toPositions matches = snd . fst . T.foldl' (\case + (([], m), _) -> const (([], m), (0, 0, 0)) + ((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 + (xs, HM.insert name (Position (uint n') (uint (char - nc'))) m) + else (x:xs, m) + in (p, (n', nc', c')) + ) ((matches, HM.empty), (0, 0, 0)) + +noteRefRegex, noteRegex :: Regex +(noteRefRegex, noteRegex) = + ( mkReg ("note \\[(.+)\\]" :: String) + , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]][[:space:]]?~~~" :: String) + ) + where + mkReg = makeRegexOpts (defaultCompOpt { caseSensitive = False }) defaultExecOpt diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs new file mode 100644 index 0000000000..0dd545c3de --- /dev/null +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -0,0 +1,43 @@ +module Main (main) where + +import Development.IDE.Test +import Ide.Plugin.Notes (Log, descriptor) +import System.Directory (canonicalizePath) +import System.FilePath (()) +import Test.Hls + +plugin :: PluginTestDescriptor Log +plugin = mkPluginTestDescriptor descriptor "notes" + +main :: IO () +main = defaultTestRunner $ + testGroup "Notes" + [ gotoNoteTests + ] + +gotoNoteTests :: TestTree +gotoNoteTests = testGroup "Goto Note Definition" + [ testCase "single_file" $ runSessionWithServer def plugin testDataDir $ do + doc <- openDoc "NoteDef.hs" "haskell" + _ <- waitForAllProgressDone + defs <- getDefinitions doc (Position 3 41) + liftIO $ do + fp <- canonicalizePath "NoteDef.hs" + defs @?= InL (Definition (InL (Location (filePathToUri fp) (Range (Position 5 9) (Position 5 9))))) + , testCase "no_note" $ runSessionWithServer def plugin testDataDir $ do + doc <- openDoc "NoteDef.hs" "haskell" + defs <- getDefinitions doc (Position 1 0) + liftIO $ defs @?= InL (Definition (InR [])) + + , testCase "unopened_file" $ runSessionWithServer def plugin testDataDir $ do + doc <- openDoc "Other.hs" "haskell" + waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForAllProgressDone + defs <- getDefinitions doc (Position 5 20) + liftIO $ do + fp <- canonicalizePath "NoteDef.hs" + defs @?= InL (Definition (InL (Location (filePathToUri fp) (Range (Position 9 6) (Position 9 6))))) + ] + +testDataDir :: FilePath +testDataDir = "plugins" "hls-notes-plugin" "test" "testdata" diff --git a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs new file mode 100644 index 0000000000..ef5d992196 --- /dev/null +++ b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs @@ -0,0 +1,14 @@ +module NoteDef (foo) where + +foo :: Int -> Int +foo _ = 0 -- We always return zero, see Note [Returning zero from foo] + +{- Note [Returning zero from foo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This is a big long form note, with very important info + +Note [Multiple notes in comment] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This is also a very common thing to do for GHC + +-} diff --git a/plugins/hls-notes-plugin/test/testdata/Other.hs b/plugins/hls-notes-plugin/test/testdata/Other.hs new file mode 100644 index 0000000000..65f9a483aa --- /dev/null +++ b/plugins/hls-notes-plugin/test/testdata/Other.hs @@ -0,0 +1,6 @@ +module Other where + +import NoteDef + +bar :: Int +bar = 4 -- See @Note [Multiple notes in comment]@ in NoteDef diff --git a/plugins/hls-notes-plugin/test/testdata/hie.yaml b/plugins/hls-notes-plugin/test/testdata/hie.yaml new file mode 100644 index 0000000000..59cc740ee8 --- /dev/null +++ b/plugins/hls-notes-plugin/test/testdata/hie.yaml @@ -0,0 +1,5 @@ +cradle: + direct: + arguments: + - Other + - NoteDef diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs index 90db332b6c..e0839990fd 100644 --- a/src/HlsPlugins.hs +++ b/src/HlsPlugins.hs @@ -93,6 +93,10 @@ import qualified Ide.Plugin.ExplicitFields as ExplicitFields import qualified Ide.Plugin.OverloadedRecordDot as OverloadedRecordDot #endif +#if hls_notes +import qualified Ide.Plugin.Notes as Notes +#endif + -- formatters #if hls_floskell @@ -230,6 +234,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins #endif #if hls_overloaded_record_dot let pId = "overloaded-record-dot" in OverloadedRecordDot.descriptor (pluginRecorder pId) pId : +#endif +#if hls_notes + let pId = "notes" in Notes.descriptor (pluginRecorder pId) pId : #endif GhcIde.descriptors (pluginRecorder "ghcide") From 8310a6a455c938c95edae9f84df8b6457543eb24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 29 Nov 2023 13:43:51 +0000 Subject: [PATCH 02/11] hls-notes-plugin: add to feature list and plugin table --- CODEOWNERS | 1 + docs/features.md | 6 ++++++ docs/support/plugin-support.md | 1 + 3 files changed, 8 insertions(+) diff --git a/CODEOWNERS b/CODEOWNERS index 9c1f09495a..e8429c29dd 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -28,6 +28,7 @@ /plugins/hls-gadt-plugin @July541 /plugins/hls-hlint-plugin @eddiemundo /plugins/hls-module-name-plugin +/plugins/hls-notes-plugin @jvanbruegge /plugins/hls-ormolu-plugin @georgefst /plugins/hls-overloaded-record-dot-plugin @joyfulmantis /plugins/hls-pragmas-plugin @eddiemundo diff --git a/docs/features.md b/docs/features.md index 69e34454fb..a701a45b82 100644 --- a/docs/features.md +++ b/docs/features.md @@ -81,6 +81,12 @@ Known limitations: - Only works for [local definitions](https://github.com/haskell/haskell-language-server/issues/708). +## Jump to note definition + +Provided by: `hls-notes-plugin` + +Jump to the definition of a [GHC-style note](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/coding-style#2-using-notes). + ## Find references Provided by: `ghcide` diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index d59c74db40..70c6472c1f 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -56,6 +56,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-gadt-plugin` | 2 | | | `hls-hlint-plugin` | 2 | | | `hls-module-name-plugin` | 2 | | +| `hls-notes-plugin` | 2 | | | `hls-qualify-imported-names-plugin` | 2 | | | `hls-ormolu-plugin` | 2 | | | `hls-rename-plugin` | 2 | | From 381caf5cc50f17a5f56a2806b016f5c8fe38e4fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 29 Nov 2023 13:56:39 +0000 Subject: [PATCH 03/11] hls-notes-plugin: Add more documentation comments --- plugins/hls-notes-plugin/README.md | 2 ++ .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 17 +++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/plugins/hls-notes-plugin/README.md b/plugins/hls-notes-plugin/README.md index 60a9a4d4c0..54f07640d9 100644 --- a/plugins/hls-notes-plugin/README.md +++ b/plugins/hls-notes-plugin/README.md @@ -11,6 +11,8 @@ module Main where main :: IO main = do doSomething -- We need this here, see Note [Do Something] in Foo + -- Using at-signs around the note works as well: + -- see @Note [Do Something]@ in Foo ``` Foo.hs diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index e329551200..7942309b9c 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -54,6 +54,11 @@ instance Pretty Log where "Found notes in " <> pretty (show file) <> ": [" <> pretty (intercalate ", " (fmap (\(s, p) -> "\"" <> s <> "\" at " <> T.pack (show p)) notes)) <> "]" +{- +The first time the user requests a jump-to-definition on a note reference, the +project is indexed and searched for all note definitions. Their location and +title is then saved in the HLS database to be retrieved for all future requests. +-} descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId "Provides goto definition support for GHC-style notes") { Ide.Types.pluginRules = findNotesRules recorder @@ -89,12 +94,18 @@ jumpToNote state _ param uriOrig = toNormalizedUri $ param ^. (L.textDocument . L.uri) err s = maybe (throwError $ PluginInternalError s) pure atPos c arr = case arr A.! 0 of + -- We check if the line we are currently at contains a note + -- reference. However, we need to know if the cursor is within the + -- match or somewhere else. The second entry of the array contains + -- the title of the note as extracted by the regex. (_, (c', len)) -> if c' <= c && c <= c' + len then Just (fst (arr A.! 1)) else Nothing jumpToNote _ _ _ = throwError $ PluginInternalError "conversion to normalized file path failed" findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position)) findNotesInFile file recorder = do + -- GetFileContents only returns a value if the file is open in the editor of + -- the user. If not, we need to read it from disk. contentOpt <- (snd =<<) <$> use GetFileContents file content <- case contentOpt of Just x -> pure x @@ -105,6 +116,12 @@ findNotesInFile file recorder = do pure $ Just m where uint = fromIntegral . toInteger + -- the regex library returns the character index of the match. However + -- to return the position from HLS we need it as a (line, character) + -- tuple. To convert between the two we count the newline characters and + -- reset the current character index every time. For every regex match, + -- once we have counted up to their character index, we save the current + -- line and character values instead. toPositions matches = snd . fst . T.foldl' (\case (([], m), _) -> const (([], m), (0, 0, 0)) ((x@(name, (char, _)):xs, m), (n, nc, c)) -> \char' -> From 3c6d8fcadc9d8ce669523934c9003b5dace6fe04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Fri, 1 Dec 2023 12:21:59 +0000 Subject: [PATCH 04/11] hls-notes-plugin: Fix tests after #3846, add CI job --- .github/workflows/test.yml | 77 +++++++++++----------- plugins/hls-notes-plugin/test/NotesTest.hs | 4 +- 2 files changed, 42 insertions(+), 39 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 2163ad98b6..bc173ee048 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -74,7 +74,7 @@ jobs: - ubuntu-latest - macOS-latest - windows-latest - test: + test: - true - false exclude: @@ -112,140 +112,143 @@ jobs: - if: matrix.test name: Test hls-graph - run: cabal test hls-graph + run: cabal test hls-graph - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test name: Test ghcide # run the tests without parallelism to avoid running out of memory - run: cabal test ghcide || cabal test ghcide + run: cabal test ghcide || cabal test ghcide - if: matrix.test name: Test hls-plugin-api - run: cabal test hls-plugin-api || cabal test hls-plugin-api + run: cabal test hls-plugin-api || cabal test hls-plugin-api - if: matrix.test name: Test func-test suite env: HLS_TEST_EXE: hls HLS_WRAPPER_TEST_EXE: hls-wrapper - run: cabal test func-test || cabal test func-test + run: cabal test func-test || cabal test func-test - if: matrix.test name: Test wrapper-test suite env: HLS_TEST_EXE: hls HLS_WRAPPER_TEST_EXE: hls-wrapper - run: cabal test wrapper-test + run: cabal test wrapper-test - if: matrix.test name: Test hls-refactor-plugin - run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests + run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests - - if: matrix.test + - if: matrix.test name: Test hls-floskell-plugin - run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests + run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests - if: matrix.test name: Test hls-class-plugin - run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests + run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests - if: matrix.test name: Test hls-pragmas-plugin - run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests + run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests - if: matrix.test name: Test hls-eval-plugin - run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests + run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests - if: matrix.test name: Test hls-splice-plugin - run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests + run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - if: matrix.test && matrix.ghc != '9.2' name: Test hls-stan-plugin - run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests + run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests - if: matrix.test name: Test hls-stylish-haskell-plugin - run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests + run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests - - if: matrix.test + - if: matrix.test name: Test hls-ormolu-plugin - run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests + run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test + - if: matrix.test name: Test hls-fourmolu-plugin - run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests + run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests - if: matrix.test name: Test hls-explicit-imports-plugin test suite - run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests + run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests - if: matrix.test name: Test hls-call-hierarchy-plugin test suite - run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests + run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests - if: matrix.test && matrix.os != 'windows-latest' name: Test hls-rename-plugin test suite - run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests + run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests - - if: matrix.test + - if: matrix.test name: Test hls-hlint-plugin test suite - run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests + run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests - if: matrix.test name: Test hls-module-name-plugin test suite - run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests + run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests - if: matrix.test name: Test hls-alternate-number-format-plugin test suite - run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests + run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests - if: matrix.test name: Test hls-qualify-imported-names-plugin test suite - run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests + run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests - if: matrix.test name: Test hls-code-range-plugin test suite - run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests + run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests - if: matrix.test name: Test hls-change-type-signature test suite - run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests + run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests - if: matrix.test name: Test hls-gadt-plugin test suit - run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests + run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests - if: matrix.test name: Test hls-explicit-fixity-plugin test suite - run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests + run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests - if: matrix.test name: Test hls-explicit-record-fields-plugin test suite - run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests + run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests ## version needs to be limited since the tests depend on cabal-fmt which only builds using specific ghc versions - if: matrix.test && matrix.ghc == '9.2' name: Test hls-cabal-fmt-plugin test suite - run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests + run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests - if: matrix.test name: Test hls-cabal-plugin test suite - run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests + run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests - if: matrix.test name: Test hls-retrie-plugin test suite - run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests + run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests - if: matrix.test name: Test hls-overloaded-record-dot-plugin test suite - run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests + run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests - if: matrix.test name: Test hls-semantic-tokens-plugin test suite - run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests + run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests + - if: matrix.test + name: Test hls-notes-plugin test suite + run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests test_post_job: if: always() diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index 0dd545c3de..0fcff4b7d4 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -23,7 +23,7 @@ gotoNoteTests = testGroup "Goto Note Definition" defs <- getDefinitions doc (Position 3 41) liftIO $ do fp <- canonicalizePath "NoteDef.hs" - defs @?= InL (Definition (InL (Location (filePathToUri fp) (Range (Position 5 9) (Position 5 9))))) + defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 5 9) (Position 5 9))])) , testCase "no_note" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" defs <- getDefinitions doc (Position 1 0) @@ -36,7 +36,7 @@ gotoNoteTests = testGroup "Goto Note Definition" defs <- getDefinitions doc (Position 5 20) liftIO $ do fp <- canonicalizePath "NoteDef.hs" - defs @?= InL (Definition (InL (Location (filePathToUri fp) (Range (Position 9 6) (Position 9 6))))) + defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 9 6) (Position 9 6))])) ] testDataDir :: FilePath From 51aedf3d8dff2d9ec69762873fbf358aa8ac23c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 10:11:53 +0000 Subject: [PATCH 05/11] hls-notes-plugin: Address review comments --- flake.nix | 2 +- plugins/hls-notes-plugin/README.md | 4 ++-- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 5 +++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/flake.nix b/flake.nix index 949b1bde20..f0567bc8fc 100644 --- a/flake.nix +++ b/flake.nix @@ -69,7 +69,7 @@ (pkgs.haskell.lib.justStaticExecutables (pkgs.haskell.lib.dontCheck pkgs.haskellPackages.opentelemetry-extra)) capstone # ormolu - # stylish-haskell + stylish-haskell pre-commit ] ++ lib.optionals (!stdenv.isDarwin) [ # tracy has a build problem on macos. diff --git a/plugins/hls-notes-plugin/README.md b/plugins/hls-notes-plugin/README.md index 54f07640d9..7b05669d46 100644 --- a/plugins/hls-notes-plugin/README.md +++ b/plugins/hls-notes-plugin/README.md @@ -16,7 +16,7 @@ main = do ``` Foo.hs -``` +```haskell module Foo where doSomething :: IO () @@ -29,4 +29,4 @@ Some very important explanation -} ``` -Using "Go-to-definition on the Note reference in `Main.hs` will jump to the beginning of the note in `Foo.hs`. +Using "Go-to-definition" on the Note reference in `Main.hs` will jump to the beginning of the note in `Foo.hs`. diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 7942309b9c..afe30dd780 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -1,6 +1,6 @@ module Ide.Plugin.Notes (descriptor, Log) where -import Control.Lens (ix, (^.), (^?)) +import Control.Lens ((^.)) import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans (lift) @@ -82,7 +82,8 @@ jumpToNote state _ param let Position l c = param ^. L.position contents <- fmap _file_text . err "Error getting file contents" =<< lift (LSP.getVirtualFile uriOrig) - line <- err "Line not found in file" (Rope.lines contents ^? ix (fromIntegral l)) + line <- err "Line not found in file" (listToMaybe $ Rope.lines $ fst + (Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) contents)) note <- err "No note at this position" $ listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes nfp From 6b55e58ddfebe9038341e19098d0ca92d9a6a864 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 10:33:34 +0000 Subject: [PATCH 06/11] hls-notes-plugin: Allow Note definition within single line comments --- .../hls-notes-plugin/src/Ide/Plugin/Notes.hs | 4 ++-- plugins/hls-notes-plugin/test/NotesTest.hs | 18 ++++++++++++++++-- .../hls-notes-plugin/test/testdata/NoteDef.hs | 14 ++++++++++++++ 3 files changed, 32 insertions(+), 4 deletions(-) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index afe30dd780..2a49d3fa15 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/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 diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index 0fcff4b7d4..530b0d7a7f 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/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 diff --git a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs index ef5d992196..c1443a0c12 100644 --- a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs +++ b/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 +-} From d431f213aa8ef631f1528b623eb74a8fbbb51614 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 10:38:39 +0000 Subject: [PATCH 07/11] hls-notes-plugin: Improve "Note not found" error message --- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index 2a49d3fa15..adaf362a97 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -87,7 +87,7 @@ jumpToNote state _ param note <- err "No note at this position" $ listToMaybe $ mapMaybe (atPos $ fromIntegral c) $ matchAllText noteRefRegex line notes <- runActionE "notes.definedNotes" state $ useE MkGetNotes nfp - (noteFp, pos) <- err "Note not found" (HM.lookup note notes) + (noteFp, pos) <- err ("Note definition (a comment of the form `{- Note [" <> note <> "]\\n~~~ ... -}`) not found") (HM.lookup note notes) pure $ InL (Definition (InL (Location (fromNormalizedUri $ normalizedFilePathToUri noteFp) (Range pos pos)) )) From 13e51ef4872af0cf03dd3fd12b1e42ac016dfe8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 10:44:41 +0000 Subject: [PATCH 08/11] hls-notes-plugin: Allow single line notes to be indented --- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- plugins/hls-notes-plugin/test/NotesTest.hs | 3 ++- plugins/hls-notes-plugin/test/testdata/NoteDef.hs | 8 ++++---- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index adaf362a97..f9519d5f3d 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -137,7 +137,7 @@ findNotesInFile file recorder = do noteRefRegex, noteRegex :: Regex (noteRefRegex, noteRegex) = ( mkReg ("note \\[(.+)\\]" :: String) - , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]](--)?[[:blank:]]*~~~" :: String) + , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]][[:blank:]]*(--)?[[:blank:]]*~~~" :: String) ) where mkReg = makeRegexOpts (defaultCompOpt { caseSensitive = False }) defaultExecOpt diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index 530b0d7a7f..c0f34ed1d3 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -30,7 +30,8 @@ gotoNoteTests = testGroup "Goto Note Definition" 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))])) + defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 18 11) (Position 18 11))])) + , testCase "invalid_note" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" _ <- waitForAllProgressDone diff --git a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs index c1443a0c12..56b1f6e72a 100644 --- a/plugins/hls-notes-plugin/test/testdata/NoteDef.hs +++ b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs @@ -16,10 +16,10 @@ 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 [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] From 0fb0aac73168cf9b0f1f1e485af131a4c9139cea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 11:00:37 +0000 Subject: [PATCH 09/11] treewide: Add missing underscores to note definitions --- ghcide/src/Development/IDE/Core/Compile.hs | 4 +++- ghcide/src/Development/IDE/Core/FileExists.hs | 3 +++ ghcide/src/Development/IDE/Core/RuleTypes.hs | 1 + ghcide/src/Development/IDE/Core/Rules.hs | 1 + ghcide/src/Development/IDE/GHC/Error.hs | 1 + ghcide/src/Development/IDE/Plugin/HLS.hs | 1 + haskell-language-server.cabal | 4 +++- hie-compat/src-ghc92/Compat/HieAst.hs | 5 +++++ hls-plugin-api/src/Ide/Plugin/Resolve.hs | 1 + hls-plugin-api/src/Ide/Types.hs | 1 + .../src/Development/IDE/Plugin/CodeAction.hs | 1 + 11 files changed, 21 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 8a4948b345..1c46362c19 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -436,6 +436,7 @@ tcRnModule hsc_env tc_helpers pmod = do -- Note [Clearing mi_globals after generating an iface] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- GHC populates the mi_global field in interfaces for GHCi if we are using the bytecode -- interpreter. -- However, this field is expensive in terms of heap usage, and we don't use it in HLS @@ -1366,7 +1367,7 @@ loadHieFile ncu f = do {- Note [Recompilation avoidance in the presence of TH] - + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Most versions of GHC we currently support don't have a working implementation of code unloading for object code, and no version of GHC supports this on certain platforms like Windows. This makes it completely infeasible for interactive use, @@ -1736,6 +1737,7 @@ pathToModuleName = mkModuleName . map rep rep c = c {- Note [Guidelines For Using CPP In GHCIDE Import Statements] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHCIDE's interface with GHC is extensive, and unfortunately, because we have to work with multiple versions of GHC, we have several files that need to use a lot of CPP. In order to simplify the CPP in the import section of every file diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 7a3d9cdd60..4ca55a8d24 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -40,6 +40,7 @@ import qualified System.Directory as Dir import qualified System.FilePath.Glob as Glob {- Note [File existence cache and LSP file watchers] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Some LSP servers provide the ability to register file watches with the client, which will then notify us of file changes. Some clients can do this more efficiently than us, or generally it's a tricky problem @@ -135,6 +136,7 @@ getFileExists :: NormalizedFilePath -> Action Bool getFileExists fp = use_ GetFileExists fp {- Note [Which files should we watch?] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The watcher system gives us a lot of flexibility: we can set multiple watchers, and they can all watch on glob patterns. @@ -201,6 +203,7 @@ fileExistsRulesFast recorder isWatched = else fileExistsSlow file {- Note [Invalidating file existence results] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have two mechanisms for getting file existence information: - The file existence cache - The VFS lookup diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index b3d4a1729f..fc977cea8a 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -512,6 +512,7 @@ makeLensesWith ''Splices {- Note [Client configuration in Rules] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The LSP client configuration is stored by `lsp` for us, and is accesible in handlers through the LspT monad. diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index d769ab30cd..0f4430e6af 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -749,6 +749,7 @@ instance Default GhcSessionDepsConfig where } -- | Note [GhcSessionDeps] +-- ~~~~~~~~~~~~~~~~~~~~~ -- For a file 'Foo', GhcSessionDeps "Foo.hs" results in an HscEnv which includes -- 1. HomeModInfo's (in the HUG/HPT) for all modules in the transitive closure of "Foo", **NOT** including "Foo" itself. -- 2. ModSummary's (in the ModuleGraph) for all modules in the transitive closure of "Foo", including "Foo" itself. diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index c9fe0153d3..16663f8afd 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -91,6 +91,7 @@ realSrcLocToPosition real = Position (fromIntegral $ srcLocLine real - 1) (fromIntegral $ srcLocCol real - 1) -- Note [Unicode support] +-- ~~~~~~~~~~~~~~~~~~~~~~ -- the current situation is: -- LSP Positions use UTF-16 code units(Unicode may count as variable columns); -- GHC use Unicode code points(Unicode count as one column). diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 149a28b7e9..3a30e05f99 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -359,6 +359,7 @@ instance Monoid IdeNotificationHandlers where mempty = IdeNotificationHandlers mempty {- Note [Exception handling in plugins] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Plugins run in LspM, and so have access to IO. This means they are likely to throw exceptions, even if only by accident or through calling libraries that throw exceptions. Ultimately, we're running a bunch of less-trusted IO code, diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d6f7acf743..040b1cb8dd 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -60,7 +60,9 @@ common pedantic if flag(pedantic) ghc-options: -Werror - -- Note [unused-packages] Some packages need CPP conditioned on MIN_VERSION_ghc(x,y,z). + -- Note [unused-packages] + -- ~~~~~~~~~~~~~~~~~~~~~~ + -- Some packages need CPP conditioned on MIN_VERSION_ghc(x,y,z). -- MIN_VERSION_ is CPP macro that cabal defines only when is declared as a dependency. -- But -Wunused-packages still reports it as unused dependency if it's not imported. -- For packages with such "unused" dependencies we demote -Wunused-packages error diff --git a/hie-compat/src-ghc92/Compat/HieAst.hs b/hie-compat/src-ghc92/Compat/HieAst.hs index 487cffc508..f72b1283de 100644 --- a/hie-compat/src-ghc92/Compat/HieAst.hs +++ b/hie-compat/src-ghc92/Compat/HieAst.hs @@ -83,6 +83,7 @@ import GHC.HsToCore.Expr import GHC.HsToCore.Monad {- Note [Updating HieAst for changes in the GHC AST] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When updating the code in this file for changes in the GHC AST, you need to pay attention to the following things: @@ -218,6 +219,7 @@ type TypecheckedSource = LHsBinds GhcTc {- Note [Name Remapping] + ~~~~~~~~~~~~~~~~~~~~~ The Typechecker introduces new names for mono names in AbsBinds. We don't care about the distinction between mono and poly bindings, so we replace all occurrences of the mono name with the poly name. @@ -425,6 +427,7 @@ concatM :: Monad m => [m [a]] -> m [a] concatM xs = concat <$> sequence xs {- Note [Capturing Scopes and other non local information] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ toHie is a local transformation, but scopes of bindings cannot be known locally, hence we have to push the relevant info down into the binding nodes. We use the following types (*Context and *Scoped) to wrap things and @@ -469,6 +472,7 @@ data PScoped a = PS (Maybe Span) deriving (Typeable, Data) -- Pattern Scope {- Note [TyVar Scopes] + ~~~~~~~~~~~~~~~~~~~ Due to -XScopedTypeVariables, type variables can be in scope quite far from their original binding. We resolve the scope of these type variables in a separate pass @@ -522,6 +526,7 @@ tvScopes tvScope rhsScope xs = map (\(RS sc a)-> TVS tvScope sc a) $ listScopes rhsScope xs {- Note [Scoping Rules for SigPat] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Explicitly quantified variables in pattern type signatures are not brought into scope in the rhs, but implicitly quantified variables are (HsWC and HsIB). diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index e83e45a816..c8d448a49e 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -203,6 +203,7 @@ parseError :: Maybe A.Value -> T.Text -> PluginError parseError value errMsg = PluginInternalError ("Ide.Plugin.Resolve: Error parsing value:"<> (T.pack $ show value) <> " Error: "<> errMsg) {- Note [Code action resolve fallback to commands] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To make supporting code action resolve easy for plugins, we want to let them provide one implementation that can be used both when clients support resolve, and when they don't. diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index c6fd8741a3..314b594f8d 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1182,6 +1182,7 @@ installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif {- Note [Resolve in PluginHandlers] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Resolve methods have a few guarantees that need to be made by HLS, specifically they need to only be called once, as neither their errors nor their responses can be easily combined. Whereas commands, which similarly have diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index b2ed67722f..d29e38128d 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -446,6 +446,7 @@ diagInRange Diagnostic {_range = dr} r = dr `subRange` extendedRange extendedRange = extendToFullLines r -- Note [Removing imports is preferred] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- It's good to prefer the remove imports code action because an unused import -- is likely to be removed and less likely the warning will be disabled. -- Therefore actions to remove a single or all redundant imports should be From abcf822d75c6dc54ebf4e12b9f8649b927853818 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 11:42:31 +0000 Subject: [PATCH 10/11] hls-notes-plugin: Wait until HLS is done in tests --- plugins/hls-notes-plugin/test/NotesTest.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index c0f34ed1d3..24996c8eac 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -19,14 +19,16 @@ gotoNoteTests :: TestTree gotoNoteTests = testGroup "Goto Note Definition" [ testCase "single_file" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" - _ <- waitForAllProgressDone + waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForAllProgressDone defs <- getDefinitions doc (Position 3 41) liftIO $ do fp <- canonicalizePath "NoteDef.hs" 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 + waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForAllProgressDone defs <- getDefinitions doc (Position 5 64) liftIO $ do fp <- canonicalizePath "NoteDef.hs" @@ -34,13 +36,16 @@ gotoNoteTests = testGroup "Goto Note Definition" , testCase "invalid_note" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" - _ <- waitForAllProgressDone + waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + 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" + waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForAllProgressDone defs <- getDefinitions doc (Position 1 0) liftIO $ defs @?= InL (Definition (InR [])) From e8e72d1c9acd192a9ad16bc16ee26c1641ec143a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Wed, 28 Feb 2024 14:31:11 +0000 Subject: [PATCH 11/11] hls-notes-plugin: Fix tests on windows The regex did not allow windows line endings in note definitions --- plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs | 2 +- plugins/hls-notes-plugin/test/NotesTest.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs index f9519d5f3d..3a3b03d7cb 100644 --- a/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -137,7 +137,7 @@ findNotesInFile file recorder = do noteRefRegex, noteRegex :: Regex (noteRefRegex, noteRegex) = ( mkReg ("note \\[(.+)\\]" :: String) - , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*[[:space:]][[:blank:]]*(--)?[[:blank:]]*~~~" :: String) + , mkReg ("note \\[([[:print:]]+)\\][[:blank:]]*\r?\n[[:blank:]]*(--)?[[:blank:]]*~~~" :: String) ) where mkReg = makeRegexOpts (defaultCompOpt { caseSensitive = False }) defaultExecOpt diff --git a/plugins/hls-notes-plugin/test/NotesTest.hs b/plugins/hls-notes-plugin/test/NotesTest.hs index 24996c8eac..e42ef407d7 100644 --- a/plugins/hls-notes-plugin/test/NotesTest.hs +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -4,7 +4,7 @@ import Development.IDE.Test import Ide.Plugin.Notes (Log, descriptor) import System.Directory (canonicalizePath) import System.FilePath (()) -import Test.Hls +import Test.Hls hiding (waitForBuildQueue) plugin :: PluginTestDescriptor Log plugin = mkPluginTestDescriptor descriptor "notes" @@ -19,7 +19,7 @@ gotoNoteTests :: TestTree gotoNoteTests = testGroup "Goto Note Definition" [ testCase "single_file" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" - waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 3 41) liftIO $ do @@ -27,7 +27,7 @@ gotoNoteTests = testGroup "Goto Note Definition" 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" - waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 5 64) liftIO $ do @@ -36,7 +36,7 @@ gotoNoteTests = testGroup "Goto Note Definition" , testCase "invalid_note" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" - waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 6 54) liftIO $ do @@ -44,7 +44,7 @@ gotoNoteTests = testGroup "Goto Note Definition" , testCase "no_note" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "NoteDef.hs" "haskell" - waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 1 0) liftIO $ defs @?= InL (Definition (InR [])) @@ -52,6 +52,7 @@ gotoNoteTests = testGroup "Goto Note Definition" , testCase "unopened_file" $ runSessionWithServer def plugin testDataDir $ do doc <- openDoc "Other.hs" "haskell" waitForCustomMessage "ghcide/cradle/loaded" (const $ Just ()) + waitForBuildQueue waitForAllProgressDone defs <- getDefinitions doc (Position 5 20) liftIO $ do