Skip to content

Commit 96c3aa7

Browse files
VenInffendor
VenInf
and
fendor
authored
Documentation for build-depends on hover (#4385)
If you hover over the field under `build-depends` it will give Documentation with a hackage link to a package. Video with an example: * + hover * + hover handler * working prototype * bugfix * rm TODO * + tests * docs * requested changes * - Debug.Trace * schema * Apply suggestions from code review Co-authored-by: fendor <[email protected]> * resolve merge issues * runActionE -> runAction * revert prev, useWithStaleE -> useE * Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs Co-authored-by: fendor <[email protected]> * + documentation --------- Co-authored-by: fendor <[email protected]>
1 parent 9f4d673 commit 96c3aa7

File tree

10 files changed

+172
-35
lines changed

10 files changed

+172
-35
lines changed

‎ghcide/src/Development/IDE/LSP/HoverDefinition.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ module Development.IDE.LSP.HoverDefinition
77
( Log(..)
88
-- * For haskell-language-server
99
, hover
10+
, foundHover
1011
, gotoDefinition
1112
, gotoTypeDefinition
1213
, documentHighlight

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 96 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -8,50 +8,62 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) whe
88

99
import Control.Concurrent.Strict
1010
import Control.DeepSeq
11-
import Control.Lens ((^.))
11+
import Control.Lens ((^.))
1212
import Control.Monad.Extra
1313
import Control.Monad.IO.Class
1414
import Control.Monad.Trans.Class
15-
import Control.Monad.Trans.Maybe (runMaybeT)
16-
import qualified Data.ByteString as BS
15+
import Control.Monad.Trans.Maybe (runMaybeT)
16+
import qualified Data.ByteString as BS
1717
import Data.Hashable
18-
import Data.HashMap.Strict (HashMap)
19-
import qualified Data.HashMap.Strict as HashMap
20-
import qualified Data.List.NonEmpty as NE
21-
import qualified Data.Maybe as Maybe
22-
import qualified Data.Text as T
23-
import qualified Data.Text.Encoding as Encoding
18+
import Data.HashMap.Strict (HashMap)
19+
import qualified Data.HashMap.Strict as HashMap
20+
import qualified Data.List.NonEmpty as NE
21+
import qualified Data.Maybe as Maybe
22+
import qualified Data.Text as T
23+
import qualified Data.Text.Encoding as Encoding
2424
import Data.Typeable
25-
import Development.IDE as D
26-
import Development.IDE.Core.Shake (restartShakeSession)
27-
import qualified Development.IDE.Core.Shake as Shake
28-
import Development.IDE.Graph (Key, alwaysRerun)
29-
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
30-
import Development.IDE.Types.Shake (toKey)
31-
import qualified Distribution.Fields as Syntax
32-
import qualified Distribution.Parsec.Position as Syntax
25+
import Development.IDE as D
26+
import Development.IDE.Core.PluginUtils
27+
import Development.IDE.Core.Shake (restartShakeSession)
28+
import qualified Development.IDE.Core.Shake as Shake
29+
import Development.IDE.Graph (Key,
30+
alwaysRerun)
31+
import Development.IDE.LSP.HoverDefinition (foundHover)
32+
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
33+
import Development.IDE.Types.Shake (toKey)
34+
import qualified Distribution.Fields as Syntax
35+
import Distribution.Package (Dependency)
36+
import Distribution.PackageDescription (allBuildDepends,
37+
depPkgName,
38+
unPackageName)
39+
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
40+
import qualified Distribution.Parsec.Position as Syntax
3341
import GHC.Generics
34-
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
35-
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
36-
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
37-
ParseCabalFields (..),
38-
ParseCabalFile (..))
39-
import qualified Ide.Plugin.Cabal.Completion.Types as Types
40-
import Ide.Plugin.Cabal.Definition (gotoDefinition)
41-
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
42-
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
43-
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
44-
import Ide.Plugin.Cabal.Orphans ()
42+
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
43+
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
44+
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
45+
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
46+
ParseCabalFields (..),
47+
ParseCabalFile (..))
48+
import qualified Ide.Plugin.Cabal.Completion.Types as Types
49+
import Ide.Plugin.Cabal.Definition (gotoDefinition)
50+
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
51+
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
52+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
53+
import Ide.Plugin.Cabal.Orphans ()
4554
import Ide.Plugin.Cabal.Outline
46-
import qualified Ide.Plugin.Cabal.Parse as Parse
55+
import qualified Ide.Plugin.Cabal.Parse as Parse
56+
import Ide.Plugin.Error
4757
import Ide.Types
48-
import qualified Language.LSP.Protocol.Lens as JL
49-
import qualified Language.LSP.Protocol.Message as LSP
58+
import qualified Language.LSP.Protocol.Lens as JL
59+
import qualified Language.LSP.Protocol.Message as LSP
5060
import Language.LSP.Protocol.Types
51-
import qualified Language.LSP.VFS as VFS
61+
import qualified Language.LSP.VFS as VFS
62+
import Text.Regex.TDFA
5263

53-
import qualified Data.Text ()
54-
import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
64+
65+
import qualified Data.Text ()
66+
import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
5567

5668
data Log
5769
= LogModificationTime NormalizedFilePath FileVersion
@@ -118,6 +130,7 @@ descriptor recorder plId =
118130
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
119131
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
120132
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
133+
, mkPluginHandler LSP.SMethod_TextDocumentHover hover
121134
]
122135
, pluginNotificationHandlers =
123136
mconcat
@@ -302,7 +315,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
302315
let completionTexts = fmap (^. JL.label) completions
303316
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
304317

305-
306318
cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
307319
cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
308320
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
@@ -328,6 +340,55 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
328340
gpd
329341
pure $ InL $ fmap InR actions
330342

343+
-- | Handler for hover messages.
344+
--
345+
-- Provides a Handler for displaying message on hover.
346+
-- If found that the filtered hover message is a dependency,
347+
-- adds a Documentation link.
348+
hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover
349+
hover ide _ msgParam = do
350+
nfp <- getNormalizedFilePathE uri
351+
cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp
352+
case CabalFields.findTextWord cursor cabalFields of
353+
Nothing ->
354+
pure $ InR Null
355+
Just cursorText -> do
356+
gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp
357+
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
358+
case filterVersion cursorText of
359+
Nothing -> pure $ InR Null
360+
Just txt ->
361+
if txt `elem` depsNames
362+
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
363+
else pure $ InR Null
364+
where
365+
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
366+
uri = msgParam ^. JL.textDocument . JL.uri
367+
368+
dependencyName :: Dependency -> T.Text
369+
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
370+
371+
-- | Removes version requirements like
372+
-- `==1.0.0.0`, `>= 2.1.1` that could be included in
373+
-- hover message. Assumes that the dependency consists
374+
-- of alphanums with dashes in between. Ends with an alphanum.
375+
--
376+
-- Examples:
377+
-- >>> filterVersion "imp-deps>=2.1.1"
378+
-- "imp-deps"
379+
filterVersion :: T.Text -> Maybe T.Text
380+
filterVersion msg = getMatch (msg =~ regex)
381+
where
382+
regex :: T.Text
383+
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])"
384+
385+
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
386+
getMatch (_, _, _, [dependency]) = Just dependency
387+
getMatch (_, _, _, _) = Nothing -- impossible case
388+
389+
documentationText :: T.Text -> T.Text
390+
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
391+
331392

332393
-- ----------------------------------------------------------------
333394
-- Cabal file of Interest rules and global variable

‎plugins/hls-cabal-plugin/test/Main.hs

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ main = do
3838
, outlineTests
3939
, codeActionTests
4040
, gotoDefinitionTests
41+
, hoverTests
4142
]
4243

4344
-- ------------------------------------------------------------------------
@@ -230,3 +231,46 @@ codeActionTests = testGroup "Code Actions"
230231
InR action@CodeAction{_title} <- codeActions
231232
guard (_title == "Replace with " <> license)
232233
pure action
234+
235+
-- ----------------------------------------------------------------------------
236+
-- Hover Tests
237+
-- ----------------------------------------------------------------------------
238+
239+
hoverTests :: TestTree
240+
hoverTests = testGroup "Hover"
241+
[ hoverOnDependencyTests
242+
]
243+
244+
hoverOnDependencyTests :: TestTree
245+
hoverOnDependencyTests = testGroup "Hover Dependency"
246+
[ hoverContainsTest "base with separated version" "hover-deps.cabal" (Position 6 25) "[Documentation](https://hackage.haskell.org/package/base)"
247+
, hoverContainsTest "aeson with not separated version " "hover-deps.cabal" (Position 7 25) "[Documentation](https://hackage.haskell.org/package/aeson)"
248+
, hoverContainsTest "lens no version" "hover-deps.cabal" (Position 7 42) "[Documentation](https://hackage.haskell.org/package/lens)"
249+
250+
, hoverIsNullTest "name has no documentation" "hover-deps.cabal" (Position 1 25)
251+
, hoverIsNullTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25)
252+
, hoverIsNullTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25)
253+
]
254+
where
255+
hoverContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
256+
hoverContainsTest testName cabalFile pos containedText =
257+
runCabalTestCaseSession testName "hover" $ do
258+
doc <- openDoc cabalFile "cabal"
259+
h <- getHover doc pos
260+
case h of
261+
Nothing -> liftIO $ assertFailure "No hover"
262+
Just (Hover contents _) -> case contents of
263+
InL (MarkupContent _ txt) -> do
264+
liftIO
265+
$ assertBool ("Failed to find `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
266+
$ containedText `T.isInfixOf` txt
267+
_ -> liftIO $ assertFailure "Unexpected content type"
268+
closeDoc doc
269+
270+
hoverIsNullTest :: TestName -> FilePath -> Position -> TestTree
271+
hoverIsNullTest testName cabalFile pos =
272+
runCabalTestCaseSession testName "hover" $ do
273+
doc <- openDoc cabalFile "cabal"
274+
h <- getHover doc pos
275+
liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h
276+
closeDoc doc

‎plugins/hls-cabal-plugin/test/testdata/hover/hover-deps.cabal

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
cabal-version: 3.0
2+
name: hover-deps
3+
version: 0.1.0.0
4+
5+
library
6+
exposed-modules: Module
7+
build-depends: base ^>=4.14.3.0
8+
, aeson==1.0.0.0 , lens
9+
hs-source-dirs: src
10+
default-language: Haskell2010

‎test/testdata/schema/ghc94/default-config.golden.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
"codeActionsOn": true,
1313
"completionOn": true,
1414
"diagnosticsOn": true,
15+
"hoverOn": true,
1516
"symbolsOn": true
1617
},
1718
"cabal-fmt": {

‎test/testdata/schema/ghc94/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.hoverOn": {
39+
"default": true,
40+
"description": "Enables cabal hover",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.cabal.symbolsOn": {
3945
"default": true,
4046
"description": "Enables cabal symbols",

‎test/testdata/schema/ghc96/default-config.golden.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
"codeActionsOn": true,
1313
"completionOn": true,
1414
"diagnosticsOn": true,
15+
"hoverOn": true,
1516
"symbolsOn": true
1617
},
1718
"cabal-fmt": {

‎test/testdata/schema/ghc96/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.hoverOn": {
39+
"default": true,
40+
"description": "Enables cabal hover",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.cabal.symbolsOn": {
3945
"default": true,
4046
"description": "Enables cabal symbols",

‎test/testdata/schema/ghc98/default-config.golden.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
"codeActionsOn": true,
1313
"completionOn": true,
1414
"diagnosticsOn": true,
15+
"hoverOn": true,
1516
"symbolsOn": true
1617
},
1718
"cabal-fmt": {

‎test/testdata/schema/ghc98/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.hoverOn": {
39+
"default": true,
40+
"description": "Enables cabal hover",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.cabal.symbolsOn": {
3945
"default": true,
4046
"description": "Enables cabal symbols",

0 commit comments

Comments
 (0)