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/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 | | 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/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 613323b361..ae7d9a85ec 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -64,7 +64,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 @@ -1628,6 +1630,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 @@ -1666,6 +1723,7 @@ library , refactor , overloadedRecordDot , semanticTokens + , notes exposed-modules: Ide.Arguments 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 bd8f134716..e47a7e090b 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1189,6 +1189,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-notes-plugin/README.md b/plugins/hls-notes-plugin/README.md new file mode 100644 index 0000000000..7b05669d46 --- /dev/null +++ b/plugins/hls-notes-plugin/README.md @@ -0,0 +1,32 @@ +# 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 + -- Using at-signs around the note works as well: + -- see @Note [Do Something]@ in Foo +``` + +Foo.hs +```haskell +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..3a3b03d7cb --- /dev/null +++ b/plugins/hls-notes-plugin/src/Ide/Plugin/Notes.hs @@ -0,0 +1,143 @@ +module Ide.Plugin.Notes (descriptor, Log) where + +import Control.Lens ((^.)) +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)) <> "]" + +{- +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 + , 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" (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 + (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)) + )) + where + 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 + 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 + -- 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' -> + 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:]]*\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 new file mode 100644 index 0000000000..e42ef407d7 --- /dev/null +++ b/plugins/hls-notes-plugin/test/NotesTest.hs @@ -0,0 +1,64 @@ +module Main (main) where + +import Development.IDE.Test +import Ide.Plugin.Notes (Log, descriptor) +import System.Directory (canonicalizePath) +import System.FilePath (()) +import Test.Hls hiding (waitForBuildQueue) + +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" + waitForBuildQueue + 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" + waitForBuildQueue + waitForAllProgressDone + defs <- getDefinitions doc (Position 5 64) + liftIO $ do + fp <- canonicalizePath "NoteDef.hs" + 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" + waitForBuildQueue + 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" + waitForBuildQueue + waitForAllProgressDone + 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 ()) + waitForBuildQueue + waitForAllProgressDone + defs <- getDefinitions doc (Position 5 20) + liftIO $ do + fp <- canonicalizePath "NoteDef.hs" + defs @?= InL (Definition (InR [Location (filePathToUri fp) (Range (Position 12 6) (Position 12 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..56b1f6e72a --- /dev/null +++ b/plugins/hls-notes-plugin/test/testdata/NoteDef.hs @@ -0,0 +1,28 @@ +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 + +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 +-} 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/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index ea9badc6ac..23607bae8b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -444,6 +444,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 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")