From 5a07d0790a69f8725b5850b25cec73b673956b5e Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 8 Jun 2025 20:27:40 +0200 Subject: [PATCH 1/9] WIP: Working PoC --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 48 +++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 9a56467f3f..9a8c955815 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where @@ -68,6 +69,9 @@ import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import Text.Regex.TDFA +import Development.IDE.GHC.Compat (getUnitInfoMap, unitPackageNameString, unitPackageVersion, filterUniqMap, nonDetEltsUniqMap) +import Data.Version (Version(..)) +import qualified Data.Char as Char data Log = LogModificationTime NormalizedFilePath FileVersion @@ -135,6 +139,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition , mkPluginHandler LSP.SMethod_TextDocumentHover hover + , mkPluginHandler LSP.SMethod_TextDocumentInlayHint hints ] , pluginNotificationHandlers = mconcat @@ -376,6 +381,49 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) gpd pure $ InL $ fmap InR actions +hints :: PluginMethodHandler IdeState LSP.Method_TextDocumentInlayHint +hints state _plId clp = do + let uri = clp ^. JL.textDocument . JL.uri + nfp <- getNormalizedFilePathE uri + cabalFields <- runActionE "cabal.cabal-lens" state $ useE ParseCabalFields nfp + (hscEnv -> hsc) <- runActionE "classplugin.codeAction.GhcSession" state $ useE GhcSession nfp + let lookupVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) pkgName . unitPackageNameString) $ getUnitInfoMap hsc + pure $ InL $ fmap hint $ collectPackageVersions (fmap printVersion . lookupVersion . T.unpack) =<< cabalFields + where + collectPackageVersions :: (T.Text -> Maybe T.Text) -> Syntax.Field Syntax.Position -> [(Syntax.Position, LicenseSuggest.Text)] + collectPackageVersions lookupVersion (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap (fieldLinePackageVersions lookupVersion) pos + collectPackageVersions lookupVersion (Syntax.Section _ _ fields) = concatMap (collectPackageVersions lookupVersion) fields + collectPackageVersions _ _ = [] + + fieldLinePackageVersions :: (T.Text -> Maybe T.Text) -> Syntax.FieldLine Syntax.Position -> [(Syntax.Position, LicenseSuggest.Text)] + fieldLinePackageVersions lookupVersion (Syntax.FieldLine pos x) = + let splitted = T.splitOn "," $ Encoding.decodeUtf8Lenient x + calcStartPosition (prev, start) = T.length prev + 1 + start + potentialPkgs = List.foldl' (\a b -> a <> [(b, Maybe.maybe 0 calcStartPosition $ Maybe.listToMaybe $ reverse a)]) [] splitted + versions = do + (pkg', pkgStartOffset) <- potentialPkgs + let pkgName = T.takeWhile (not . Char.isSpace) . T.strip $ pkg' + endOfPackage = T.length pkgName + (T.length $ T.takeWhile Char.isSpace pkg') + version <- Maybe.maybeToList $ lookupVersion $ T.takeWhile (not . Char.isSpace) . T.strip $ pkg' + pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgStartOffset + endOfPackage), version) + in versions + + printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v) + + hint :: (Syntax.Position, LicenseSuggest.Text) -> InlayHint + hint (pos, foo) = + let cPos = Types.cabalPositionToLSPPosition pos + mkInlayHintLabelPart = InlayHintLabelPart (" (" <> foo <> ")") Nothing Nothing Nothing + in InlayHint { _position = cPos + , _label = InR $ pure mkInlayHintLabelPart + , _kind = Nothing -- neither a type nor a parameter + , _textEdits = Nothing -- same as CodeAction + , _tooltip = Nothing + , _paddingLeft = Nothing + , _paddingRight = Nothing + , _data_ = Nothing + } + -- | Handler for hover messages. -- -- Provides a Handler for displaying message on hover. From 69d5fbf49a39faf0137425d0d9dd998009445e72 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 8 Jun 2025 21:03:48 +0200 Subject: [PATCH 2/9] Introduce Ide.Plugin.Cabal.Dependencies module --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 47 ++------------ .../src/Ide/Plugin/Cabal/Dependencies.hs | 62 +++++++++++++++++++ 3 files changed, 68 insertions(+), 42 deletions(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index fd14c7f5b9..59819c1d52 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -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 diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 9a8c955815..2358fb53ad 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -3,7 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where @@ -56,6 +56,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 @@ -69,9 +70,6 @@ import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import Text.Regex.TDFA -import Development.IDE.GHC.Compat (getUnitInfoMap, unitPackageNameString, unitPackageVersion, filterUniqMap, nonDetEltsUniqMap) -import Data.Version (Version(..)) -import qualified Data.Char as Char data Log = LogModificationTime NormalizedFilePath FileVersion @@ -385,44 +383,9 @@ hints :: PluginMethodHandler IdeState LSP.Method_TextDocumentInlayHint hints state _plId clp = do let uri = clp ^. JL.textDocument . JL.uri nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal.cabal-lens" state $ useE ParseCabalFields nfp - (hscEnv -> hsc) <- runActionE "classplugin.codeAction.GhcSession" state $ useE GhcSession nfp - let lookupVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) pkgName . unitPackageNameString) $ getUnitInfoMap hsc - pure $ InL $ fmap hint $ collectPackageVersions (fmap printVersion . lookupVersion . T.unpack) =<< cabalFields - where - collectPackageVersions :: (T.Text -> Maybe T.Text) -> Syntax.Field Syntax.Position -> [(Syntax.Position, LicenseSuggest.Text)] - collectPackageVersions lookupVersion (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap (fieldLinePackageVersions lookupVersion) pos - collectPackageVersions lookupVersion (Syntax.Section _ _ fields) = concatMap (collectPackageVersions lookupVersion) fields - collectPackageVersions _ _ = [] - - fieldLinePackageVersions :: (T.Text -> Maybe T.Text) -> Syntax.FieldLine Syntax.Position -> [(Syntax.Position, LicenseSuggest.Text)] - fieldLinePackageVersions lookupVersion (Syntax.FieldLine pos x) = - let splitted = T.splitOn "," $ Encoding.decodeUtf8Lenient x - calcStartPosition (prev, start) = T.length prev + 1 + start - potentialPkgs = List.foldl' (\a b -> a <> [(b, Maybe.maybe 0 calcStartPosition $ Maybe.listToMaybe $ reverse a)]) [] splitted - versions = do - (pkg', pkgStartOffset) <- potentialPkgs - let pkgName = T.takeWhile (not . Char.isSpace) . T.strip $ pkg' - endOfPackage = T.length pkgName + (T.length $ T.takeWhile Char.isSpace pkg') - version <- Maybe.maybeToList $ lookupVersion $ T.takeWhile (not . Char.isSpace) . T.strip $ pkg' - pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgStartOffset + endOfPackage), version) - in versions - - printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v) - - hint :: (Syntax.Position, LicenseSuggest.Text) -> InlayHint - hint (pos, foo) = - let cPos = Types.cabalPositionToLSPPosition pos - mkInlayHintLabelPart = InlayHintLabelPart (" (" <> foo <> ")") Nothing Nothing Nothing - in InlayHint { _position = cPos - , _label = InR $ pure mkInlayHintLabelPart - , _kind = Nothing -- neither a type nor a parameter - , _textEdits = Nothing -- same as CodeAction - , _tooltip = Nothing - , _paddingLeft = Nothing - , _paddingRight = Nothing - , _data_ = Nothing - } + cabalFields <- runActionE "cabal.cabal-hints" state $ useE ParseCabalFields nfp + (hscEnv -> hsc) <- runActionE "cabal.cabal-hints" state $ useE GhcSession nfp + pure $ InL $ Dependencies.dependencyVersionHints cabalFields hsc -- | Handler for hover messages. -- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs new file mode 100644 index 0000000000..91e18c152f --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions) where + +import qualified Data.Char as Char +import qualified Data.List as 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 (InlayHint (..), + InlayHintLabelPart (InlayHintLabelPart), + type (|?) (..)) + +dependencyVersionHints :: [Syntax.Field Syntax.Position] -> HscEnv -> [InlayHint] +dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersions cabalFields + where + mkHint :: (Syntax.Position, Version) -> InlayHint + mkHint (pos, dependencyVersion) = + let mkInlayHintLabelPart = InlayHintLabelPart (" (" <> printVersion dependencyVersion <> ")") Nothing Nothing Nothing + in InlayHint { _position = Types.cabalPositionToLSPPosition pos + , _label = InR $ pure mkInlayHintLabelPart + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Nothing + , _paddingRight = Nothing + , _data_ = Nothing + } + +collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Syntax.Position, Version)] +collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPackageVersions + where + lookupPackageVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) (T.unpack pkgName) . unitPackageNameString) $ getUnitInfoMap hscEnv + + collectPackageVersions :: Syntax.Field Syntax.Position -> [(Syntax.Position, 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, Version)] + fieldLinePackageVersions (Syntax.FieldLine pos x) = + let splitted = T.splitOn "," $ Encoding.decodeUtf8Lenient x + calcStartPosition (prev, start) = T.length prev + 1 + start + potentialPkgs = List.foldl' (\a b -> a <> [(b, Maybe.maybe 0 calcStartPosition $ Maybe.listToMaybe $ reverse a)]) [] splitted + versions = do + (pkg', pkgStartOffset) <- potentialPkgs + let pkgName = T.takeWhile (not . Char.isSpace) . T.strip $ pkg' + endOfPackage = T.length pkgName + (T.length $ T.takeWhile Char.isSpace pkg') + version <- Maybe.maybeToList $ lookupPackageVersion $ T.takeWhile (not . Char.isSpace) . T.strip $ pkg' + pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgStartOffset + endOfPackage), version) + in versions + +printVersion :: Version -> T.Text +printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v) From 1b8ce5fa242c5ca5e06822337263ed77bd714669 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 8 Jun 2025 21:21:17 +0200 Subject: [PATCH 3/9] Add CodeLens based dependency version --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 10 ++++++++ .../src/Ide/Plugin/Cabal/Dependencies.hs | 23 +++++++++++++++---- 2 files changed, 29 insertions(+), 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2358fb53ad..ca75f505ab 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -138,6 +138,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition , mkPluginHandler LSP.SMethod_TextDocumentHover hover , mkPluginHandler LSP.SMethod_TextDocumentInlayHint hints + , mkPluginHandler LSP.SMethod_TextDocumentCodeLens lens ] , pluginNotificationHandlers = mconcat @@ -379,6 +380,15 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) gpd pure $ InL $ fmap InR actions +lens :: PluginMethodHandler IdeState LSP.Method_TextDocumentCodeLens +lens state _plId clp = 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 $ InL $ Dependencies.dependencyVersionLens cabalFields hsc + + hints :: PluginMethodHandler IdeState LSP.Method_TextDocumentInlayHint hints state _plId clp = do let uri = clp ^. JL.textDocument . JL.uri diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs index 91e18c152f..1ef6e869fe 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE OverloadedStrings #-} -module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions) where +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where import qualified Data.Char as Char import qualified Data.List as List @@ -15,9 +17,22 @@ import Development.IDE.GHC.Compat (HscEnv, filterUniqMap, 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 (InlayHint (..), +import Language.LSP.Protocol.Types (CodeLens (..), Command (..), + InlayHint (..), InlayHintLabelPart (InlayHintLabelPart), - type (|?) (..)) + Range (..), type (|?) (..)) + +dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens] +dependencyVersionLens cabalFields = fmap mkCodeLens . collectPackageDependencyVersions cabalFields + where + mkCodeLens :: (Syntax.Position, Version) -> CodeLens + mkCodeLens (pos, dependencyVersion) = + let cPos = Types.cabalPositionToLSPPosition pos + command = Command (printVersion dependencyVersion) 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 From 22edd19cf5d4bf9b6cafaaa2000d14364698c49e Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 8 Jun 2025 21:59:57 +0200 Subject: [PATCH 4/9] Disable deps CodeLens when InlayHints are available --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 36 +++++++++++++------ 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index ca75f505ab..fea61c34f6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -9,7 +9,8 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) whe 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) @@ -382,20 +383,33 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) lens :: PluginMethodHandler IdeState LSP.Method_TextDocumentCodeLens lens state _plId clp = 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 $ InL $ Dependencies.dependencyVersionLens cabalFields hsc + 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 - 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 $ InL $ Dependencies.dependencyVersionHints cabalFields hsc + 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. -- From 75bdf4699e9830e5b36f236da19d2f9f146b795d Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Mon, 9 Jun 2025 16:17:28 +0200 Subject: [PATCH 5/9] Use Regex for getting package dependencies --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Cabal/Dependencies.hs | 19 ++++++++++--------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 59819c1d52..63963b0914 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -263,6 +263,7 @@ library hls-cabal-plugin build-depends: + , array , bytestring , Cabal-syntax >= 3.7 , containers diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs index 1ef6e869fe..014bfe6d61 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -3,6 +3,8 @@ module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where +import Data.Array ((!)) +import Data.ByteString (ByteString) import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Maybe as Maybe @@ -21,6 +23,8 @@ import Language.LSP.Protocol.Types (CodeLens (..), Command (..), InlayHint (..), InlayHintLabelPart (InlayHintLabelPart), Range (..), type (|?) (..)) +import Text.Regex.TDFA (Regex, makeRegex, + matchAllText) dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens] dependencyVersionLens cabalFields = fmap mkCodeLens . collectPackageDependencyVersions cabalFields @@ -61,16 +65,13 @@ collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPac collectPackageVersions _ = [] fieldLinePackageVersions :: Syntax.FieldLine Syntax.Position -> [(Syntax.Position, Version)] - fieldLinePackageVersions (Syntax.FieldLine pos x) = - let splitted = T.splitOn "," $ Encoding.decodeUtf8Lenient x - calcStartPosition (prev, start) = T.length prev + 1 + start - potentialPkgs = List.foldl' (\a b -> a <> [(b, Maybe.maybe 0 calcStartPosition $ Maybe.listToMaybe $ reverse a)]) [] splitted + 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 - (pkg', pkgStartOffset) <- potentialPkgs - let pkgName = T.takeWhile (not . Char.isSpace) . T.strip $ pkg' - endOfPackage = T.length pkgName + (T.length $ T.takeWhile Char.isSpace pkg') - version <- Maybe.maybeToList $ lookupPackageVersion $ T.takeWhile (not . Char.isSpace) . T.strip $ pkg' - pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgStartOffset + endOfPackage), version) + (pkgName, (pkgIndex, pkgOffset)) <- packageNames + version <- Maybe.maybeToList $ lookupPackageVersion pkgName + pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset), version) in versions printVersion :: Version -> T.Text From 274ae1085fa94a91d5de3d36a1c774257a6f8ac4 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Wed, 11 Jun 2025 23:48:52 +0200 Subject: [PATCH 6/9] WIP: Tests --- .../src/Ide/Plugin/Cabal/Dependencies.hs | 22 +++++++-------- plugins/hls-cabal-plugin/test/CabalAdd.hs | 1 - plugins/hls-cabal-plugin/test/Main.hs | 27 ++++++++++++++++++- 3 files changed, 35 insertions(+), 15 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs index 014bfe6d61..e409afa4f2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -5,8 +5,6 @@ module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDepe import Data.Array ((!)) import Data.ByteString (ByteString) -import qualified Data.Char as Char -import qualified Data.List as List import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding @@ -21,7 +19,6 @@ import qualified Distribution.Parsec.Position as Syntax import qualified Ide.Plugin.Cabal.Completion.Types as Types import Language.LSP.Protocol.Types (CodeLens (..), Command (..), InlayHint (..), - InlayHintLabelPart (InlayHintLabelPart), Range (..), type (|?) (..)) import Text.Regex.TDFA (Regex, makeRegex, matchAllText) @@ -43,16 +40,15 @@ dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersi where mkHint :: (Syntax.Position, Version) -> InlayHint mkHint (pos, dependencyVersion) = - let mkInlayHintLabelPart = InlayHintLabelPart (" (" <> printVersion dependencyVersion <> ")") Nothing Nothing Nothing - in InlayHint { _position = Types.cabalPositionToLSPPosition pos - , _label = InR $ pure mkInlayHintLabelPart - , _kind = Nothing - , _textEdits = Nothing - , _tooltip = Nothing - , _paddingLeft = Nothing - , _paddingRight = Nothing - , _data_ = Nothing - } + 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, Version)] collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPackageVersions diff --git a/plugins/hls-cabal-plugin/test/CabalAdd.hs b/plugins/hls-cabal-plugin/test/CabalAdd.hs index 6517c811fe..12ae6cb3ef 100644 --- a/plugins/hls-cabal-plugin/test/CabalAdd.hs +++ b/plugins/hls-cabal-plugin/test/CabalAdd.hs @@ -175,7 +175,6 @@ cabalAddTests = , _data_ = Nothing } - generatePackageYAMLTestSession :: FilePath -> Session () generatePackageYAMLTestSession haskellFile = do hsdoc <- openDoc haskellFile "haskell" diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index fcb85a081e..3de22daa46 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -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 @@ -39,6 +39,7 @@ main = do , codeActionTests , gotoDefinitionTests , hoverTests + , codeLensTests ] -- ------------------------------------------------------------------------ @@ -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" "hover" $ do + doc <- openDoc "hover-deps.cabal" "cabal" + lenses <- getCodeLenses doc + liftIO $ map (preview $ L.command . _Just . L.title) lenses @?= [Just "Refresh..."] + closeDoc doc + dependencyVersionInlayHints = + runCabalTestCaseSession "InlayHints tests" "hover" $ do + doc <- openDoc "hover-deps.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)"] + closeDoc doc From 6cb476031c40e52d068c3dfbafd2ec9faf09c73a Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Tue, 8 Jul 2025 23:08:19 +0200 Subject: [PATCH 7/9] Add package name to CodeLens if there are mutliple in line --- .../src/Ide/Plugin/Cabal/Dependencies.hs | 36 ++++++++++++------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs index e409afa4f2..d8661aa14d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -4,7 +4,8 @@ module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where import Data.Array ((!)) -import Data.ByteString (ByteString) +import Data.ByteString (ByteString, singleton) +import Data.List import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding @@ -18,18 +19,27 @@ 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 (|?) (..)) + InlayHint (..), Range (..), + type (|?) (..)) import Text.Regex.TDFA (Regex, makeRegex, matchAllText) dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens] -dependencyVersionLens cabalFields = fmap mkCodeLens . collectPackageDependencyVersions cabalFields +dependencyVersionLens cabalFields = (>>= foo) . groupBy (\(Syntax.Position line1 _, _, _) (Syntax.Position line2 _, _, _) -> line1 == line2) . collectPackageDependencyVersions cabalFields where - mkCodeLens :: (Syntax.Position, Version) -> CodeLens - mkCodeLens (pos, dependencyVersion) = + 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 - command = Command (printVersion dependencyVersion) mempty Nothing + dependencyText = + if includePkgName + then pkgName <> " (" <> printVersion dependencyVersion <> ")" + else printVersion dependencyVersion + command = Command dependencyText mempty Nothing in CodeLens { _range = Range cPos cPos , _command = Just command @@ -38,8 +48,8 @@ dependencyVersionLens cabalFields = fmap mkCodeLens . collectPackageDependencyVe dependencyVersionHints :: [Syntax.Field Syntax.Position] -> HscEnv -> [InlayHint] dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersions cabalFields where - mkHint :: (Syntax.Position, Version) -> InlayHint - mkHint (pos, dependencyVersion) = + mkHint :: (Syntax.Position, T.Text, Version) -> InlayHint + mkHint (pos, _, dependencyVersion) = InlayHint { _position = Types.cabalPositionToLSPPosition pos , _label = InL $ " (" <> printVersion dependencyVersion <> ")" , _kind = Nothing @@ -50,24 +60,24 @@ dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersi , _data_ = Nothing } -collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Syntax.Position, Version)] +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 - collectPackageVersions :: Syntax.Field Syntax.Position -> [(Syntax.Position, Version)] + 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, Version)] + 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), version) + pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset), pkgName, version) in versions printVersion :: Version -> T.Text From cfbe159c64f459ba0046af03e3d2a116d60a4d24 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Tue, 8 Jul 2025 23:11:39 +0200 Subject: [PATCH 8/9] WIP: Tests and redundant import --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs | 2 +- plugins/hls-cabal-plugin/test/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs index d8661aa14d..9f17ccce26 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -4,7 +4,7 @@ module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where import Data.Array ((!)) -import Data.ByteString (ByteString, singleton) +import Data.ByteString (ByteString) import Data.List import qualified Data.Maybe as Maybe import qualified Data.Text as T diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 3de22daa46..a0815571cb 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -275,7 +275,7 @@ codeLensTests = testGroup "Code Lens" runCabalTestCaseSession "Code Lens Test" "hover" $ do doc <- openDoc "hover-deps.cabal" "cabal" lenses <- getCodeLenses doc - liftIO $ map (preview $ L.command . _Just . L.title) lenses @?= [Just "Refresh..."] + liftIO $ map (preview $ L.command . _Just . L.title) lenses @?= [Just "4.19.2.0"] closeDoc doc dependencyVersionInlayHints = runCabalTestCaseSession "InlayHints tests" "hover" $ do From bc42eb23de1ae50c89867405f6358e2475fc5c56 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Tue, 8 Jul 2025 23:17:22 +0200 Subject: [PATCH 9/9] WIP: Tests --- plugins/hls-cabal-plugin/test/Main.hs | 12 ++++++------ .../test/testdata/dependencies/deps-versions.cabal | 10 ++++++++++ 2 files changed, 16 insertions(+), 6 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/dependencies/deps-versions.cabal diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index a0815571cb..1e5bd16295 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -272,15 +272,15 @@ codeLensTests = testGroup "Code Lens" ] where dependencyVersionLenses = - runCabalTestCaseSession "Code Lens Test" "hover" $ do - doc <- openDoc "hover-deps.cabal" "cabal" + 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"] + 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" "hover" $ do - doc <- openDoc "hover-deps.cabal" "cabal" + 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)"] + liftIO $ map (view L.label) hints @?= [InL " (4.19.2.0)",InL " (2.1.1)",InL " (0.6.1.0)"] closeDoc doc diff --git a/plugins/hls-cabal-plugin/test/testdata/dependencies/deps-versions.cabal b/plugins/hls-cabal-plugin/test/testdata/dependencies/deps-versions.cabal new file mode 100644 index 0000000000..16dd4b733d --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/dependencies/deps-versions.cabal @@ -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