+ tests

haskell · Aug 19, 2024 · 729b4e8 · 729b4e8
1 parent 28af58b
commit 729b4e8
Show file tree

Hide file tree

Showing 3 changed files with 83 additions and 5 deletions.
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
@@ -52,12 +52,12 @@ import qualified Language.LSP.Protocol.Lens                  as JL
 import qualified Language.LSP.Protocol.Message               as LSP
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.VFS                            as VFS
-import Development.IDE.Core.PluginUtils (useWithStaleE, runActionE)
-import Ide.Plugin.Error (getNormalizedFilePathE)
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 import Distribution.Package (Dependency())
 import Distribution.PackageDescription (depPkgName, unPackageName, allBuildDepends)
 import Development.IDE.LSP.HoverDefinition (foundHover)
+import           Text.Regex.TDFA
+import Debug.Trace
 
 
 data Log
@@ -328,14 +328,31 @@ hover ide _ msgParam = do
         Just cursorText -> do
           (gpd, _) <- runActionE "cabal.GPD" ide $ useWithStaleE ParseCabalFile nfp
           let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
-          if cursorText `elem` depsNames
-            then pure $ foundHover (Nothing, [cursorText <> "\n", documentationText cursorText])
-            else pure $ foundHover (Nothing, [cursorText])
+              mText = filterVersion cursorText
+          case mText of
+            Nothing -> pure $ foundHover (Nothing, [cursorText])
+            Just txt ->
+              if txt `elem` depsNames
+                then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
+                else pure $ foundHover (Nothing, [txt])
   where
       cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
       uri = msgParam ^. JL.textDocument . JL.uri
+
       dependencyName :: Dependency -> T.Text
       dependencyName dep = T.pack $ unPackageName $ depPkgName dep
+
+      filterVersion :: T.Text -> Maybe T.Text
+      filterVersion msg = getMatch (msg =~ regex)
+        where
+          regex :: T.Text
+          regex = "([a-zA-Z0-9-]*[a-zA-Z0-9]).*"
+
+          getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
+          getMatch (_, _, _, []) = Nothing
+          getMatch (_, _, _, [dependency]) = Just dependency
+          getMatch (_, _, _, _) = Nothing -- impossible case
+
       documentationText :: T.Text -> T.Text
       documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
 

diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs
@@ -38,6 +38,7 @@ main = do
             , outlineTests
             , codeActionTests
             , gotoDefinitionTests
+            , hoverTests
             ]
 
 -- ------------------------------------------------------------------------
@@ -282,3 +283,53 @@ gotoDefinitionTests = testGroup "Goto Definition"
                 doc <- openDoc "simple-with-common.cabal" "cabal"
                 empty <- getDefinitions doc cursorPos
                 liftIO $ empty @?= (InR $ InR LSP.Null)
+
+-- ----------------------------------------------------------------------------
+-- Hover Tests
+-- ----------------------------------------------------------------------------
+
+hoverTests :: TestTree
+hoverTests = testGroup "Hover"
+    [ hoverOnDependencyTests
+    ]
+
+hoverOnDependencyTests :: TestTree
+hoverOnDependencyTests = testGroup "Hover Dependency"
+    [ hoverContainsTest "base with separated version" "hover-deps.cabal" (Position 6 25) "[Documentation](https://hackage.haskell.org/package/base)"
+    , hoverContainsTest "aeson with not separated version " "hover-deps.cabal" (Position 7 25) "[Documentation](https://hackage.haskell.org/package/aeson)"
+    , hoverContainsTest "lens no version" "hover-deps.cabal" (Position 7 42) "[Documentation](https://hackage.haskell.org/package/lens)"
+
+    , hoverNotContainsTest "name has no documentation" "hover-deps.cabal" (Position 1 25) "[Documentation]"
+    , hoverNotContainsTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25) "[Documentation]"
+    , hoverNotContainsTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25) "[Documentation]"
+    ]
+    where
+        hoverContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
+        hoverContainsTest testName cabalFile pos containedText =
+            runCabalTestCaseSession testName "hover" $ do
+                doc <- openDoc cabalFile "cabal"
+                h <- getHover doc pos
+                case h of
+                    Nothing -> liftIO $ assertFailure "No hover"
+                    Just (Hover contents _) -> case contents of
+                        InL (MarkupContent _ txt) -> do
+                            liftIO
+                            $ assertBool ("Failed to find `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
+                            $ containedText `T.isInfixOf` txt
+                        _ -> liftIO $ assertFailure "Unexpected content type"
+                closeDoc doc
+
+        hoverNotContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
+        hoverNotContainsTest testName cabalFile pos containedText =
+            runCabalTestCaseSession testName "hover" $ do
+                doc <- openDoc cabalFile "cabal"
+                h <- getHover doc pos
+                case h of
+                    Nothing -> liftIO $ assertFailure "No hover"
+                    Just (Hover contents _) -> case contents of
+                        InL (MarkupContent _ txt) -> do
+                            liftIO
+                            $ assertBool ("Found `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
+                            $ not (containedText `T.isInfixOf` txt)
+                        _ -> liftIO $ assertFailure "Unexpected content type"
+                closeDoc doc
diff --git a/plugins/hls-cabal-plugin/test/testdata/hover/hover-deps.cabal b/plugins/hls-cabal-plugin/test/testdata/hover/hover-deps.cabal
@@ -0,0 +1,10 @@
+cabal-version:      3.0
+name:               hover-deps
+version:            0.1.0.0
+
+library
+    exposed-modules:  Module
+    build-depends:    base ^>=4.14.3.0
+                    , aeson==1.0.0.0 , lens
+    hs-source-dirs:   src
+    default-language: Haskell2010