Skip to content

Commit 6ae64e8

Browse files
batkotbatkot
committed
Use Hsc in cabal hover
1 parent eae689b commit 6ae64e8

File tree

2 files changed

+66
-81
lines changed

2 files changed

+66
-81
lines changed

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

Lines changed: 43 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -8,57 +8,50 @@
88

99
module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
1010

11-
import Control.Lens (_Just, (^.),
12-
(^?))
11+
import Control.Lens (_Just, (^.), (^?))
1312
import Control.Monad.Extra
1413
import Control.Monad.IO.Class
15-
import Control.Monad.Trans.Class (lift)
16-
import Control.Monad.Trans.Maybe (runMaybeT)
17-
import Data.HashMap.Strict (HashMap)
18-
import qualified Data.List as List
19-
import qualified Data.Maybe as Maybe
20-
import qualified Data.Text ()
21-
import qualified Data.Text as T
22-
import Development.IDE as D
23-
import Development.IDE.Core.FileStore (getVersionedTextDoc)
14+
import Control.Monad.Trans.Class (lift)
15+
import Control.Monad.Trans.Maybe (runMaybeT)
16+
import Data.HashMap.Strict (HashMap)
17+
import qualified Data.List as List
18+
import qualified Data.Maybe as Maybe
19+
import qualified Data.Text ()
20+
import qualified Data.Text as T
21+
import Development.IDE as D
22+
import Development.IDE.Core.FileStore (getVersionedTextDoc)
2423
import Development.IDE.Core.PluginUtils
25-
import Development.IDE.Core.Shake (restartShakeSession)
26-
import Development.IDE.Graph (Key)
27-
import Development.IDE.LSP.HoverDefinition (foundHover)
28-
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
29-
import Development.IDE.Types.Shake (toKey)
30-
import qualified Distribution.Fields as Syntax
31-
import Distribution.Package (Dependency)
32-
import Distribution.PackageDescription (allBuildDepends,
33-
depPkgName,
34-
unPackageName)
35-
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
36-
import qualified Distribution.Parsec.Position as Syntax
37-
import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd
38-
import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd
39-
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
40-
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
41-
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
42-
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
43-
ParseCabalFields (..),
44-
ParseCabalFile (..))
45-
import qualified Ide.Plugin.Cabal.Completion.Types as Types
46-
import Ide.Plugin.Cabal.Definition (gotoDefinition)
47-
import qualified Ide.Plugin.Cabal.Dependencies as Dependencies
48-
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
49-
import qualified Ide.Plugin.Cabal.Files as CabalAdd
50-
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
51-
import qualified Ide.Plugin.Cabal.OfInterest as OfInterest
52-
import Ide.Plugin.Cabal.Orphans ()
24+
import Development.IDE.Core.Shake (restartShakeSession)
25+
import qualified Development.IDE.Core.Shake as Shake
26+
import Development.IDE.Graph (Key)
27+
import Development.IDE.LSP.HoverDefinition (foundHover)
28+
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
29+
import Development.IDE.Types.Shake (toKey)
30+
import qualified Distribution.Fields as Syntax
31+
import qualified Distribution.Parsec.Position as Syntax
32+
import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd
33+
import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd
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.Dependencies as Dependencies
42+
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
43+
import qualified Ide.Plugin.Cabal.Files as CabalAdd
44+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
45+
import qualified Ide.Plugin.Cabal.OfInterest as OfInterest
46+
import Ide.Plugin.Cabal.Orphans ()
5347
import Ide.Plugin.Cabal.Outline
54-
import qualified Ide.Plugin.Cabal.Rules as Rules
48+
import qualified Ide.Plugin.Cabal.Rules as Rules
5549
import Ide.Plugin.Error
5650
import Ide.Types
57-
import qualified Language.LSP.Protocol.Lens as JL
58-
import qualified Language.LSP.Protocol.Message as LSP
51+
import qualified Language.LSP.Protocol.Lens as JL
52+
import qualified Language.LSP.Protocol.Message as LSP
5953
import Language.LSP.Protocol.Types
60-
import qualified Language.LSP.VFS as VFS
61-
import Text.Regex.TDFA
54+
import qualified Language.LSP.VFS as VFS
6255

6356
data Log
6457
= LogModificationTime NormalizedFilePath FileVersion
@@ -340,43 +333,13 @@ hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover
340333
hover ide _ msgParam = do
341334
nfp <- getNormalizedFilePathE uri
342335
cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp
343-
case CabalFields.findTextWord cursor cabalFields of
344-
Nothing ->
345-
pure $ InR Null
346-
Just cursorText -> do
347-
gpd <- runActionE "cabal.GPD" ide $ useE ParseCabalFile nfp
348-
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
349-
case filterVersion cursorText of
350-
Nothing -> pure $ InR Null
351-
Just txt ->
352-
if txt `elem` depsNames
353-
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
354-
else pure $ InR Null
355-
where
356-
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
336+
(hscEnv -> hsc) <- runActionE "cabal.cabal-hover" ide $ useE GhcSession nfp
337+
let hoveredDep = List.find (positionInRange (msgParam ^. JL.position) . (\(x, _, _) -> x)) $ Dependencies.collectPackageDependencyVersions' cabalFields hsc
338+
pure $ case hoveredDep of
339+
Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> Dependencies.printVersion version <> ")\n", documentationText (pkgName <> "-" <> Dependencies.printVersion version)])
340+
Nothing -> InR Null
341+
where
357342
uri = msgParam ^. JL.textDocument . JL.uri
358-
359-
dependencyName :: Dependency -> T.Text
360-
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
361-
362-
-- \| Removes version requirements like
363-
-- `==1.0.0.0`, `>= 2.1.1` that could be included in
364-
-- hover message. Assumes that the dependency consists
365-
-- of alphanums with dashes in between. Ends with an alphanum.
366-
--
367-
-- Examples:
368-
-- >>> filterVersion "imp-deps>=2.1.1"
369-
-- "imp-deps"
370-
filterVersion :: T.Text -> Maybe T.Text
371-
filterVersion msg = getMatch (msg =~ regex)
372-
where
373-
regex :: T.Text
374-
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])"
375-
376-
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
377-
getMatch (_, _, _, [dependency]) = Just dependency
378-
getMatch (_, _, _, _) = Nothing -- impossible case
379-
380343
documentationText :: T.Text -> T.Text
381344
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
382345

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

Lines changed: 23 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
22
{-# LANGUAGE OverloadedStrings #-}
33

4-
module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where
4+
module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens, collectPackageDependencyVersions', printVersion) where
55

66
import Data.Array ((!))
77
import Data.ByteString (ByteString)
@@ -80,5 +80,27 @@ collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPac
8080
pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset), pkgName, version)
8181
in versions
8282

83+
collectPackageDependencyVersions' :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, T.Text, Version)]
84+
collectPackageDependencyVersions' cabalFields hscEnv = cabalFields >>= collectPackageVersions
85+
where
86+
lookupPackageVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) (T.unpack pkgName) . unitPackageNameString) $ getUnitInfoMap hscEnv
87+
88+
collectPackageVersions :: Syntax.Field Syntax.Position -> [(Range, T.Text, Version)]
89+
collectPackageVersions (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap fieldLinePackageVersions pos
90+
collectPackageVersions (Syntax.Section _ _ fields) = concatMap collectPackageVersions fields
91+
collectPackageVersions _ = []
92+
93+
fieldLinePackageVersions :: Syntax.FieldLine Syntax.Position -> [(Range, T.Text, Version)]
94+
fieldLinePackageVersions (Syntax.FieldLine pos line) =
95+
let linePackageNameRegex :: Regex = makeRegex ("(^|,)[[:space:]]*([a-zA-Z-]+)" :: ByteString)
96+
packageNames = (\x -> x ! 2) <$> matchAllText linePackageNameRegex (Encoding.decodeUtf8Lenient line)
97+
versions = do
98+
(pkgName, (pkgIndex, pkgOffset)) <- packageNames
99+
version <- Maybe.maybeToList $ lookupPackageVersion pkgName
100+
let pkgPosStart = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex)
101+
pkgPosEnd = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset)
102+
pure (Range pkgPosStart pkgPosEnd, pkgName, version)
103+
in versions
104+
83105
printVersion :: Version -> T.Text
84106
printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v)

0 commit comments

Comments
 (0)