Skip to content

Commit a4b696b

Browse files
fendorfendor
authored
Merge branch 'master' into cabal-add-codeaction-continuation
2 parents 60f776a + f628754 commit a4b696b

File tree

11 files changed

+174
-37
lines changed

11 files changed

+174
-37
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-fmt-plugin/src/Ide/Plugin/CabalFmt.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ provider recorder _ _ _ (FormatRange _) _ _ _ = do
6464
throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt."
6565
provider recorder plId ideState _ FormatText contents nfp opts = do
6666
let cabalFmtArgs = [ "--indent", show tabularSize]
67-
cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
67+
cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-fmt" ideState $ usePropertyAction #path plId properties
6868
x <- liftIO $ findExecutable cabalFmtExePath
6969
case x of
7070
Just _ -> do
@@ -85,7 +85,7 @@ provider recorder plId ideState _ FormatText contents nfp opts = do
8585
pure $ InL fmtDiff
8686
Nothing -> do
8787
log Error $ LogFormatterBinNotFound cabalFmtExePath
88-
throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable")
88+
throwError (PluginInternalError "No installation of cabal-fmt could be found. Please install it globally, or provide the full path to the executable")
8989
where
9090
fp = fromNormalizedFilePath nfp
9191
tabularSize = opts ^. L.tabSize

‎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
@@ -326,6 +338,55 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
326338
cabalFilePath gpd
327339
pure $ InL $ fmap InR actions
328340

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

330391
-- ----------------------------------------------------------------
331392
-- 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": {

0 commit comments

Comments
 (0)