Skip to content

Commit 729b4e8

Browse files
VenInfVenInf
committed
+ tests
1 parent 28af58b commit 729b4e8

File tree

3 files changed

+83
-5
lines changed

3 files changed

+83
-5
lines changed

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

Lines changed: 22 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -52,12 +52,12 @@ import qualified Language.LSP.Protocol.Lens as JL
5252
import qualified Language.LSP.Protocol.Message as LSP
5353
import Language.LSP.Protocol.Types
5454
import qualified Language.LSP.VFS as VFS
55-
import Development.IDE.Core.PluginUtils (useWithStaleE, runActionE)
56-
import Ide.Plugin.Error (getNormalizedFilePathE)
5755
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
5856
import Distribution.Package (Dependency())
5957
import Distribution.PackageDescription (depPkgName, unPackageName, allBuildDepends)
6058
import Development.IDE.LSP.HoverDefinition (foundHover)
59+
import Text.Regex.TDFA
60+
import Debug.Trace
6161

6262

6363
data Log
@@ -328,14 +328,31 @@ hover ide _ msgParam = do
328328
Just cursorText -> do
329329
(gpd, _) <- runActionE "cabal.GPD" ide $ useWithStaleE ParseCabalFile nfp
330330
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
331-
if cursorText `elem` depsNames
332-
then pure $ foundHover (Nothing, [cursorText <> "\n", documentationText cursorText])
333-
else pure $ foundHover (Nothing, [cursorText])
331+
mText = filterVersion cursorText
332+
case mText of
333+
Nothing -> pure $ foundHover (Nothing, [cursorText])
334+
Just txt ->
335+
if txt `elem` depsNames
336+
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
337+
else pure $ foundHover (Nothing, [txt])
334338
where
335339
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
336340
uri = msgParam ^. JL.textDocument . JL.uri
341+
337342
dependencyName :: Dependency -> T.Text
338343
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
344+
345+
filterVersion :: T.Text -> Maybe T.Text
346+
filterVersion msg = getMatch (msg =~ regex)
347+
where
348+
regex :: T.Text
349+
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9]).*"
350+
351+
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
352+
getMatch (_, _, _, []) = Nothing
353+
getMatch (_, _, _, [dependency]) = Just dependency
354+
getMatch (_, _, _, _) = Nothing -- impossible case
355+
339356
documentationText :: T.Text -> T.Text
340357
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
341358

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

Lines changed: 51 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
-- ------------------------------------------------------------------------
@@ -282,3 +283,53 @@ gotoDefinitionTests = testGroup "Goto Definition"
282283
doc <- openDoc "simple-with-common.cabal" "cabal"
283284
empty <- getDefinitions doc cursorPos
284285
liftIO $ empty @?= (InR $ InR LSP.Null)
286+
287+
-- ----------------------------------------------------------------------------
288+
-- Hover Tests
289+
-- ----------------------------------------------------------------------------
290+
291+
hoverTests :: TestTree
292+
hoverTests = testGroup "Hover"
293+
[ hoverOnDependencyTests
294+
]
295+
296+
hoverOnDependencyTests :: TestTree
297+
hoverOnDependencyTests = testGroup "Hover Dependency"
298+
[ hoverContainsTest "base with separated version" "hover-deps.cabal" (Position 6 25) "[Documentation](https://hackage.haskell.org/package/base)"
299+
, hoverContainsTest "aeson with not separated version " "hover-deps.cabal" (Position 7 25) "[Documentation](https://hackage.haskell.org/package/aeson)"
300+
, hoverContainsTest "lens no version" "hover-deps.cabal" (Position 7 42) "[Documentation](https://hackage.haskell.org/package/lens)"
301+
302+
, hoverNotContainsTest "name has no documentation" "hover-deps.cabal" (Position 1 25) "[Documentation]"
303+
, hoverNotContainsTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25) "[Documentation]"
304+
, hoverNotContainsTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25) "[Documentation]"
305+
]
306+
where
307+
hoverContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
308+
hoverContainsTest testName cabalFile pos containedText =
309+
runCabalTestCaseSession testName "hover" $ do
310+
doc <- openDoc cabalFile "cabal"
311+
h <- getHover doc pos
312+
case h of
313+
Nothing -> liftIO $ assertFailure "No hover"
314+
Just (Hover contents _) -> case contents of
315+
InL (MarkupContent _ txt) -> do
316+
liftIO
317+
$ assertBool ("Failed to find `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
318+
$ containedText `T.isInfixOf` txt
319+
_ -> liftIO $ assertFailure "Unexpected content type"
320+
closeDoc doc
321+
322+
hoverNotContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
323+
hoverNotContainsTest testName cabalFile pos containedText =
324+
runCabalTestCaseSession testName "hover" $ do
325+
doc <- openDoc cabalFile "cabal"
326+
h <- getHover doc pos
327+
case h of
328+
Nothing -> liftIO $ assertFailure "No hover"
329+
Just (Hover contents _) -> case contents of
330+
InL (MarkupContent _ txt) -> do
331+
liftIO
332+
$ assertBool ("Found `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
333+
$ not (containedText `T.isInfixOf` txt)
334+
_ -> liftIO $ assertFailure "Unexpected content type"
335+
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

0 commit comments

Comments
 (0)