Documentation for build-depends on hover

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

@@ -7,6 +7,7 @@ module Development.IDE.LSP.HoverDefinition
     ( Log(..)
     -- * For haskell-language-server
     , hover
+    , foundHover
     , gotoDefinition
     , gotoTypeDefinition
     , documentHighlight

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

@@ -8,50 +8,62 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) whe
 
 import           Control.Concurrent.Strict
 import           Control.DeepSeq
-import           Control.Lens                                ((^.))
+import           Control.Lens                                  ((^.))
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Maybe                   (runMaybeT)
-import qualified Data.ByteString                             as BS
+import           Control.Monad.Trans.Maybe                     (runMaybeT)
+import qualified Data.ByteString                               as BS
 import           Data.Hashable
-import           Data.HashMap.Strict                         (HashMap)
-import qualified Data.HashMap.Strict                         as HashMap
-import qualified Data.List.NonEmpty                          as NE
-import qualified Data.Maybe                                  as Maybe
-import qualified Data.Text                                   as T
-import qualified Data.Text.Encoding                          as Encoding
+import           Data.HashMap.Strict                           (HashMap)
+import qualified Data.HashMap.Strict                           as HashMap
+import qualified Data.List.NonEmpty                            as NE
+import qualified Data.Maybe                                    as Maybe
+import qualified Data.Text                                     as T
+import qualified Data.Text.Encoding                            as Encoding
 import           Data.Typeable
-import           Development.IDE                             as D
-import           Development.IDE.Core.Shake                  (restartShakeSession)
-import qualified Development.IDE.Core.Shake                  as Shake
-import           Development.IDE.Graph                       (Key, alwaysRerun)
-import qualified Development.IDE.Plugin.Completions.Logic    as Ghcide
-import           Development.IDE.Types.Shake                 (toKey)
-import qualified Distribution.Fields                         as Syntax
-import qualified Distribution.Parsec.Position                as Syntax
+import           Development.IDE                               as D
+import           Development.IDE.Core.PluginUtils
+import           Development.IDE.Core.Shake                    (restartShakeSession)
+import qualified Development.IDE.Core.Shake                    as Shake
+import           Development.IDE.Graph                         (Key,
+                                                                alwaysRerun)
+import           Development.IDE.LSP.HoverDefinition           (foundHover)
+import qualified Development.IDE.Plugin.Completions.Logic      as Ghcide
+import           Development.IDE.Types.Shake                   (toKey)
+import qualified Distribution.Fields                           as Syntax
+import           Distribution.Package                          (Dependency)
+import           Distribution.PackageDescription               (allBuildDepends,
+                                                                depPkgName,
+                                                                unPackageName)
+import           Distribution.PackageDescription.Configuration (flattenPackageDescription)
+import qualified Distribution.Parsec.Position                  as Syntax
 import           GHC.Generics
-import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
-import qualified Ide.Plugin.Cabal.Completion.Completions     as Completions
-import           Ide.Plugin.Cabal.Completion.Types           (ParseCabalCommonSections (ParseCabalCommonSections),
-                                                              ParseCabalFields (..),
-                                                              ParseCabalFile (..))
-import qualified Ide.Plugin.Cabal.Completion.Types           as Types
-import           Ide.Plugin.Cabal.Definition                 (gotoDefinition)
-import qualified Ide.Plugin.Cabal.Diagnostics                as Diagnostics
-import qualified Ide.Plugin.Cabal.FieldSuggest               as FieldSuggest
-import qualified Ide.Plugin.Cabal.LicenseSuggest             as LicenseSuggest
-import           Ide.Plugin.Cabal.Orphans                    ()
+import           Ide.Plugin.Cabal.Completion.CabalFields       as CabalFields
+import qualified Ide.Plugin.Cabal.Completion.Completer.Types   as CompleterTypes
+import qualified Ide.Plugin.Cabal.Completion.Completions       as Completions
+import           Ide.Plugin.Cabal.Completion.Types             (ParseCabalCommonSections (ParseCabalCommonSections),
+                                                                ParseCabalFields (..),
+                                                                ParseCabalFile (..))
+import qualified Ide.Plugin.Cabal.Completion.Types             as Types
+import           Ide.Plugin.Cabal.Definition                   (gotoDefinition)
+import qualified Ide.Plugin.Cabal.Diagnostics                  as Diagnostics
+import qualified Ide.Plugin.Cabal.FieldSuggest                 as FieldSuggest
+import qualified Ide.Plugin.Cabal.LicenseSuggest               as LicenseSuggest
+import           Ide.Plugin.Cabal.Orphans                      ()
 import           Ide.Plugin.Cabal.Outline
-import qualified Ide.Plugin.Cabal.Parse                      as Parse
+import qualified Ide.Plugin.Cabal.Parse                        as Parse
+import           Ide.Plugin.Error
 import           Ide.Types
-import qualified Language.LSP.Protocol.Lens                  as JL
-import qualified Language.LSP.Protocol.Message               as LSP
+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 qualified Language.LSP.VFS                              as VFS
+import           Text.Regex.TDFA
 
-import qualified Data.Text                                   ()
-import qualified Ide.Plugin.Cabal.CabalAdd                   as CabalAdd
+
+import qualified Data.Text                                     ()
+import qualified Ide.Plugin.Cabal.CabalAdd                     as CabalAdd
 
 data Log
   = LogModificationTime NormalizedFilePath FileVersion
@@ -118,6 +130,7 @@ descriptor recorder plId =
           , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
           , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
           , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
+          , mkPluginHandler LSP.SMethod_TextDocumentHover hover
           ]
     , pluginNotificationHandlers =
         mconcat
@@ -302,7 +315,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
       let completionTexts = fmap (^. JL.label) completions
       pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
 
-
 cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
 cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
   maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
@@ -328,6 +340,55 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
                                                                               gpd
                   pure $ InL $ fmap InR actions
 
+-- | Handler for hover messages.
+--
+-- Provides a Handler for displaying message on hover.
+-- If found that the filtered hover message is a dependency,
+-- adds a Documentation link.
+hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover
+hover ide _ msgParam = do
+  nfp <- getNormalizedFilePathE uri
+  cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp
+  case CabalFields.findTextWord cursor cabalFields of
+    Nothing ->
+      pure $ InR Null
+    Just cursorText -> do
+      gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp
+      let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
+      case filterVersion cursorText of
+        Nothing -> pure $ InR Null
+        Just txt ->
+          if txt `elem` depsNames
+          then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
+          else pure $ InR Null
+  where
+    cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
+    uri = msgParam ^. JL.textDocument . JL.uri
+
+    dependencyName :: Dependency -> T.Text
+    dependencyName dep = T.pack $ unPackageName $ depPkgName dep
+
+    -- | Removes version requirements like
+    -- `==1.0.0.0`, `>= 2.1.1` that could be included in
+    -- hover message. Assumes that the dependency consists
+    -- of alphanums with dashes in between. Ends with an alphanum.
+    --
+    -- Examples:
+    -- >>> filterVersion "imp-deps>=2.1.1"
+    -- "imp-deps"
+    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 (_, _, _, [dependency]) = Just dependency
+        getMatch (_, _, _, _)            = Nothing -- impossible case
+
+    documentationText :: T.Text -> T.Text
+    documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
+
 
 -- ----------------------------------------------------------------
 -- Cabal file of Interest rules and global variable

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

@@ -38,6 +38,7 @@ main = do
             , outlineTests
             , codeActionTests
             , gotoDefinitionTests
+            , hoverTests
             ]
 
 -- ------------------------------------------------------------------------
@@ -230,3 +231,46 @@ codeActionTests = testGroup "Code Actions"
         InR action@CodeAction{_title} <- codeActions
         guard (_title == "Replace with " <> license)
         pure action
+
+-- ----------------------------------------------------------------------------
+-- 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)"
+
+    , hoverIsNullTest "name has no documentation" "hover-deps.cabal" (Position 1 25)
+    , hoverIsNullTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25)
+    , hoverIsNullTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25)
+    ]
+    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
+
+        hoverIsNullTest :: TestName -> FilePath -> Position -> TestTree
+        hoverIsNullTest testName cabalFile pos =
+            runCabalTestCaseSession testName "hover" $ do
+                doc <- openDoc cabalFile "cabal"
+                h <- getHover doc pos
+                liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h
+                closeDoc doc

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

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

@@ -12,6 +12,7 @@
             "codeActionsOn": true,
             "completionOn": true,
             "diagnosticsOn": true,
+            "hoverOn": true,
             "symbolsOn": true
         },
         "cabal-fmt": {

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

@@ -35,6 +35,12 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal.hoverOn": {
+        "default": true,
+        "description": "Enables cabal hover",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.cabal.symbolsOn": {
         "default": true,
         "description": "Enables cabal symbols",

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

@@ -12,6 +12,7 @@
             "codeActionsOn": true,
             "completionOn": true,
             "diagnosticsOn": true,
+            "hoverOn": true,
             "symbolsOn": true
         },
         "cabal-fmt": {

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

@@ -35,6 +35,12 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal.hoverOn": {
+        "default": true,
+        "description": "Enables cabal hover",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.cabal.symbolsOn": {
         "default": true,
         "description": "Enables cabal symbols",

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

@@ -12,6 +12,7 @@
             "codeActionsOn": true,
             "completionOn": true,
             "diagnosticsOn": true,
+            "hoverOn": true,
             "symbolsOn": true
         },
         "cabal-fmt": {

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

@@ -35,6 +35,12 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.cabal.hoverOn": {
+        "default": true,
+        "description": "Enables cabal hover",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.cabal.symbolsOn": {
         "default": true,
         "description": "Enables cabal symbols",