Skip to content

4416 - show versions of installed packages #4651

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 10 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions haskell-language-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -242,6 +242,7 @@ library hls-cabal-plugin
exposed-modules:
Ide.Plugin.Cabal
Ide.Plugin.Cabal.Diagnostics
Ide.Plugin.Cabal.Dependencies
Ide.Plugin.Cabal.Completion.CabalFields
Ide.Plugin.Cabal.Completion.Completer.FilePath
Ide.Plugin.Cabal.Completion.Completer.Module
Expand All @@ -262,6 +263,7 @@ library hls-cabal-plugin


build-depends:
, array
, bytestring
, Cabal-syntax >= 3.7
, containers
Expand Down
37 changes: 36 additions & 1 deletion plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,14 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

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

import Control.Concurrent.Strict
import Control.DeepSeq
import Control.Lens ((^.))
import Control.Lens (_Just, (^.),
(^?))
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
Expand Down Expand Up @@ -55,6 +57,7 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommon
ParseCabalFile (..))
import qualified Ide.Plugin.Cabal.Completion.Types as Types
import Ide.Plugin.Cabal.Definition (gotoDefinition)
import qualified Ide.Plugin.Cabal.Dependencies as Dependencies
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
Expand Down Expand Up @@ -135,6 +138,8 @@ descriptor recorder plId =
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
, mkPluginHandler LSP.SMethod_TextDocumentHover hover
, mkPluginHandler LSP.SMethod_TextDocumentInlayHint hints
, mkPluginHandler LSP.SMethod_TextDocumentCodeLens lens
]
, pluginNotificationHandlers =
mconcat
Expand Down Expand Up @@ -376,6 +381,36 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
gpd
pure $ InL $ fmap InR actions

lens :: PluginMethodHandler IdeState LSP.Method_TextDocumentCodeLens
lens state _plId clp = do
packageDependenciesLens <-
fmap (Maybe.fromMaybe mempty) $
whenMaybe (not $ inlayHintCapabilityAvailable state) $ do
let uri = clp ^. JL.textDocument . JL.uri
nfp <- getNormalizedFilePathE uri
cabalFields <- runActionE "cabal.cabal-code-lens" state $ useE ParseCabalFields nfp
(hscEnv -> hsc) <- runActionE "cabal.cabal-code-lens" state $ useE GhcSession nfp
pure $ Dependencies.dependencyVersionLens cabalFields hsc

pure $ InL packageDependenciesLens

hints :: PluginMethodHandler IdeState LSP.Method_TextDocumentInlayHint
hints state _plId clp = do
packageDependenciesHints <-
fmap (Maybe.fromMaybe mempty) $
whenMaybe (inlayHintCapabilityAvailable state) $ do
let uri = clp ^. JL.textDocument . JL.uri
nfp <- getNormalizedFilePathE uri
cabalFields <- runActionE "cabal.cabal-hints" state $ useE ParseCabalFields nfp
(hscEnv -> hsc) <- runActionE "cabal.cabal-hints" state $ useE GhcSession nfp
pure $ Dependencies.dependencyVersionHints cabalFields hsc
pure $ InL packageDependenciesHints

inlayHintCapabilityAvailable :: IdeState -> Bool
inlayHintCapabilityAvailable state =
let clientCaps = Shake.clientCapabilities $ shakeExtras state
in Maybe.isJust $ clientCaps ^? JL.textDocument . _Just . JL.inlayHint . _Just

-- | Handler for hover messages.
--
-- Provides a Handler for displaying message on hover.
Expand Down
84 changes: 84 additions & 0 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where

import Data.Array ((!))
import Data.ByteString (ByteString)
import Data.List
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as Encoding
import Data.Version (Version (..))
import Development.IDE.GHC.Compat (HscEnv, filterUniqMap,
getUnitInfoMap,
nonDetEltsUniqMap,
unitPackageNameString,
unitPackageVersion)
import qualified Distribution.Fields as Syntax
import qualified Distribution.Parsec.Position as Syntax
import qualified Ide.Plugin.Cabal.Completion.Types as Types
import Language.LSP.Protocol.Types (CodeLens (..), Command (..),
InlayHint (..), Range (..),
type (|?) (..))
import Text.Regex.TDFA (Regex, makeRegex,
matchAllText)

dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens]
dependencyVersionLens cabalFields = (>>= foo) . groupBy (\(Syntax.Position line1 _, _, _) (Syntax.Position line2 _, _, _) -> line1 == line2) . collectPackageDependencyVersions cabalFields
where
foo :: [(Syntax.Position, T.Text, Version)] -> [CodeLens]
foo [] = []
foo [single] = [mkCodeLens False single]
foo multi = mkCodeLens True <$> multi

mkCodeLens :: Bool -> (Syntax.Position, T.Text, Version) -> CodeLens
mkCodeLens includePkgName (pos, pkgName, dependencyVersion) =
let cPos = Types.cabalPositionToLSPPosition pos
dependencyText =
if includePkgName
then pkgName <> " (" <> printVersion dependencyVersion <> ")"
else printVersion dependencyVersion
command = Command dependencyText mempty Nothing
in CodeLens
{ _range = Range cPos cPos
, _command = Just command
, _data_ = Nothing }

dependencyVersionHints :: [Syntax.Field Syntax.Position] -> HscEnv -> [InlayHint]
dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersions cabalFields
where
mkHint :: (Syntax.Position, T.Text, Version) -> InlayHint
mkHint (pos, _, dependencyVersion) =
InlayHint { _position = Types.cabalPositionToLSPPosition pos
, _label = InL $ " (" <> printVersion dependencyVersion <> ")"
, _kind = Nothing
, _textEdits = Nothing
, _tooltip = Nothing
, _paddingLeft = Nothing
, _paddingRight = Nothing
, _data_ = Nothing
}

collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Syntax.Position, T.Text, Version)]
collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPackageVersions
where
lookupPackageVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) (T.unpack pkgName) . unitPackageNameString) $ getUnitInfoMap hscEnv

Check failure on line 66 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, macOS-latest, false)

• Couldn't match type: Data.Map.Internal.Map

Check failure on line 66 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, ubuntu-latest, true)

• Couldn't match type: Data.Map.Internal.Map

Check failure on line 66 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, windows-latest, true)

• Couldn't match type: Data.Map.Internal.Map

Check failure on line 66 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / flags (9.6, ubuntu-latest)

• Couldn't match type: Data.Map.Internal.Map

collectPackageVersions :: Syntax.Field Syntax.Position -> [(Syntax.Position, T.Text, Version)]
collectPackageVersions (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap fieldLinePackageVersions pos
collectPackageVersions (Syntax.Section _ _ fields) = concatMap collectPackageVersions fields
collectPackageVersions _ = []

fieldLinePackageVersions :: Syntax.FieldLine Syntax.Position -> [(Syntax.Position, T.Text, Version)]
fieldLinePackageVersions (Syntax.FieldLine pos line) =
let linePackageNameRegex :: Regex = makeRegex ("(^|,)[[:space:]]*([a-zA-Z-]+)" :: ByteString)
packageNames = (\x -> x ! 2) <$> matchAllText linePackageNameRegex (Encoding.decodeUtf8Lenient line)
versions = do
(pkgName, (pkgIndex, pkgOffset)) <- packageNames
version <- Maybe.maybeToList $ lookupPackageVersion pkgName
pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset), pkgName, version)
in versions

Check failure on line 81 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, macOS-latest, false)

• Couldn't match type ‘(k0, Version)’ with ‘Version’

Check failure on line 81 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, ubuntu-latest, true)

• Couldn't match type ‘(k0, Version)’ with ‘Version’

Check failure on line 81 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / test (9.6, windows-latest, true)

• Couldn't match type ‘(k0, Version)’ with ‘Version’

Check failure on line 81 in plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs

View workflow job for this annotation

GitHub Actions / flags (9.6, ubuntu-latest)

• Couldn't match type ‘(k0, Version)’ with ‘Version’

printVersion :: Version -> T.Text
printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v)
1 change: 0 additions & 1 deletion plugins/hls-cabal-plugin/test/CabalAdd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -175,7 +175,6 @@ cabalAddTests =
, _data_ = Nothing
}


generatePackageYAMLTestSession :: FilePath -> Session ()
generatePackageYAMLTestSession haskellFile = do
hsdoc <- openDoc haskellFile "haskell"
Expand Down
27 changes: 26 additions & 1 deletion plugins/hls-cabal-plugin/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ module Main (
import CabalAdd (cabalAddTests)
import Completer (completerTests)
import Context (contextTests)
import Control.Lens ((^.))
import Control.Lens ((^.), preview, _Just, view)
import Control.Lens.Fold ((^?))
import Control.Monad (guard)
import qualified Data.ByteString as BS
Expand Down Expand Up @@ -39,6 +39,7 @@ main = do
, codeActionTests
, gotoDefinitionTests
, hoverTests
, codeLensTests
]

-- ------------------------------------------------------------------------
Expand Down Expand Up @@ -259,3 +260,27 @@ hoverOnDependencyTests = testGroup "Hover Dependency"
h <- getHover doc pos
liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h
closeDoc doc

-- ----------------------------------------------------------------------------
-- Code Lens Tests
-- ----------------------------------------------------------------------------

codeLensTests :: TestTree
codeLensTests = testGroup "Code Lens"
[ dependencyVersionLenses
, dependencyVersionInlayHints
]
where
dependencyVersionLenses =
runCabalTestCaseSession "Code Lens Test" "dependencies" $ do
doc <- openDoc "deps-versions.cabal" "cabal"
lenses <- getCodeLenses doc
liftIO $ map (preview $ L.command . _Just . L.title) lenses @?= [Just "4.19.2.0", Just "text (2.1.1)", Just "transformers (0.6.1.0)"]
closeDoc doc
dependencyVersionInlayHints =
runCabalTestCaseSession "InlayHints tests" "dependencies" $ do
doc <- openDoc "deps-versions.cabal" "cabal"
let range = Range (Position 0 0) (Position 1000 1000)
hints <- getInlayHints doc range
liftIO $ map (view L.label) hints @?= [InL " (4.19.2.0)",InL " (2.1.1)",InL " (0.6.1.0)"]
closeDoc doc
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
cabal-version: 3.0
name: deps-versions
version: 0.1.0.0

library
exposed-modules: Module
build-depends: base ^>=4.14.3.0
, text, transformers
hs-source-dirs: src
default-language: Haskell2010
Loading