Skip to content

Commit be2adaf

Browse files
fendorfendor
committed
Merge remote-tracking branch 'upstream/master' into alex/4057-2
2 parents 972d993 + f628754 commit be2adaf

File tree

12 files changed

+185
-44
lines changed

12 files changed

+185
-44
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
@@ -65,7 +65,7 @@ provider recorder _ _ _ (FormatRange _) _ _ _ = do
6565
throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt."
6666
provider recorder plId ideState _ FormatText contents nfp opts = do
6767
let cabalFmtArgs = [ "--indent", show tabularSize]
68-
cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-gild" ideState $ usePropertyAction #path plId properties
68+
cabalFmtExePath <- fmap T.unpack $ liftIO $ runAction "cabal-fmt" ideState $ usePropertyAction #path plId properties
6969
x <- liftIO $ findExecutable cabalFmtExePath
7070
case x of
7171
Just _ -> do
@@ -86,7 +86,7 @@ provider recorder plId ideState _ FormatText contents nfp opts = do
8686
pure $ InL fmtDiff
8787
Nothing -> do
8888
log Error $ LogFormatterBinNotFound cabalFmtExePath
89-
throwError (PluginInternalError "No installation of cabal-gild could be found. Please install it globally, or provide the full path to the executable")
89+
throwError (PluginInternalError "No installation of cabal-fmt could be found. Please install it globally, or provide the full path to the executable")
9090
where
9191
fp = fromNormalizedFilePath nfp
9292
tabularSize = opts ^. L.tabSize

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

Lines changed: 101 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -8,50 +8,64 @@ 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
14-
import Control.Monad.Trans.Maybe (runMaybeT)
15-
import qualified Data.ByteString as BS
14+
import Control.Monad.Trans.Class (lift)
15+
import Control.Monad.Trans.Maybe (runMaybeT)
16+
import qualified Data.ByteString as BS
1617
import Data.Hashable
17-
import Data.HashMap.Strict (HashMap)
18-
import qualified Data.HashMap.Strict as HashMap
19-
import qualified Data.List.NonEmpty as NE
20-
import qualified Data.Maybe as Maybe
21-
import qualified Data.Text as T
22-
import qualified Data.Text.Encoding as Encoding
23-
import qualified Data.Text.Utf16.Rope.Mixed as Rope
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
24+
import Data.Text.Utf16.Rope.Mixed as Rope
2425
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
26+
import Development.IDE as D
27+
import Development.IDE.Core.FileStore (getVersionedTextDoc)
28+
import Development.IDE.Core.PluginUtils
29+
import Development.IDE.Core.Shake (restartShakeSession)
30+
import qualified Development.IDE.Core.Shake as Shake
31+
import Development.IDE.Graph (Key,
32+
alwaysRerun)
33+
import Development.IDE.LSP.HoverDefinition (foundHover)
34+
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
35+
import Development.IDE.Types.Shake (toKey)
36+
import qualified Distribution.Fields as Syntax
37+
import Distribution.Package (Dependency)
38+
import Distribution.PackageDescription (allBuildDepends,
39+
depPkgName,
40+
unPackageName)
41+
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
42+
import qualified Distribution.Parsec.Position as Syntax
3343
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 ()
44+
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
45+
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
46+
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
47+
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
48+
ParseCabalFields (..),
49+
ParseCabalFile (..))
50+
import qualified Ide.Plugin.Cabal.Completion.Types as Types
51+
import Ide.Plugin.Cabal.Definition (gotoDefinition)
52+
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
53+
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
54+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
55+
import Ide.Plugin.Cabal.Orphans ()
4556
import Ide.Plugin.Cabal.Outline
46-
import qualified Ide.Plugin.Cabal.Parse as Parse
57+
import qualified Ide.Plugin.Cabal.Parse as Parse
58+
import Ide.Plugin.Error
4759
import Ide.Types
48-
import qualified Language.LSP.Protocol.Lens as JL
49-
import qualified Language.LSP.Protocol.Message as LSP
60+
import qualified Language.LSP.Protocol.Lens as JL
61+
import qualified Language.LSP.Protocol.Message as LSP
5062
import Language.LSP.Protocol.Types
51-
import qualified Language.LSP.VFS as VFS
63+
import qualified Language.LSP.VFS as VFS
64+
import Text.Regex.TDFA
5265

53-
import qualified Data.Text ()
54-
import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
66+
67+
import qualified Data.Text ()
68+
import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
5569

5670
data Log
5771
= LogModificationTime NormalizedFilePath FileVersion
@@ -118,6 +132,7 @@ descriptor recorder plId =
118132
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
119133
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
120134
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
135+
, mkPluginHandler LSP.SMethod_TextDocumentHover hover
121136
]
122137
, pluginNotificationHandlers =
123138
mconcat
@@ -302,7 +317,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
302317
let completionTexts = fmap (^. JL.label) completions
303318
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
304319

305-
306320
cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
307321
cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
308322
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
@@ -317,7 +331,8 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
317331
case mbCabalFile of
318332
Nothing -> pure $ InL []
319333
Just cabalFilePath -> do
320-
verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
334+
verTxtDocId <- runActionE "cabalAdd.getVersionedTextDoc" state $
335+
lift $ getVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
321336
mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
322337
case mbGPD of
323338
Nothing -> pure $ InL []
@@ -328,6 +343,55 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
328343
gpd
329344
pure $ InL $ fmap InR actions
330345

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

332396
-- ----------------------------------------------------------------
333397
-- Cabal file of Interest rules and global variable

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -31,10 +31,11 @@ import Data.String (IsString)
3131
import qualified Data.Text as T
3232
import Data.Text.Encoding (encodeUtf8)
3333
import qualified Data.Text.Encoding as T
34+
import Data.Text.Utf16.Rope.Mixed as Rope
3435
import Development.IDE (IdeState,
36+
getFileContents,
3537
useWithStale)
3638
import Development.IDE.Core.Rules (runAction)
37-
import Development.IDE.Core.RuleTypes (GetFileContents (..))
3839
import Distribution.Client.Add as Add
3940
import Distribution.Compat.Prelude (Generic)
4041
import Distribution.PackageDescription (GenericPackageDescription,
@@ -235,12 +236,12 @@ getDependencyEdit :: MonadIO m => Recorder (WithPriority Log) -> (IdeState, Clie
235236
getDependencyEdit recorder env cabalFilePath buildTarget dependency = do
236237
let (state, caps, verTxtDocId) = env
237238
(mbCnfOrigContents, mbFields, mbPackDescr) <- liftIO $ runAction "cabal.cabal-add" state $ do
238-
contents <- useWithStale GetFileContents $ toNormalizedFilePath cabalFilePath
239+
contents <- getFileContents $ toNormalizedFilePath cabalFilePath
239240
inFields <- useWithStale ParseCabalFields $ toNormalizedFilePath cabalFilePath
240241
inPackDescr <- useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
241-
let mbCnfOrigContents = case snd . fst <$> contents of
242-
Just (Just txt) -> Just $ encodeUtf8 txt
243-
_ -> Nothing
242+
let mbCnfOrigContents = case contents of
243+
(Just txt) -> Just $ encodeUtf8 $ Rope.toText txt
244+
_ -> Nothing
244245
let mbFields = fst <$> inFields
245246
let mbPackDescr = fst <$> inPackDescr
246247
pure (mbCnfOrigContents, mbFields, mbPackDescr)

‎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",

0 commit comments

Comments
 (0)