From 5a07d0790a69f8725b5850b25cec73b673956b5e Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 8 Jun 2025 20:27:40 +0200 Subject: [PATCH 01/16] 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 02/16] 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 03/16] 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 04/16] 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 05/16] 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 06/16] 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 07/16] 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 08/16] 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 09/16] 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 From d8b774c024e5b622b30f412e7a5c93c99f53ec26 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Fri, 11 Jul 2025 22:35:39 +0200 Subject: [PATCH 10/16] Stylish-haskell --- plugins/hls-cabal-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 1e5bd16295..9c61488b5c 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 ((^.), preview, _Just, view) +import Control.Lens (_Just, preview, view, (^.)) import Control.Lens.Fold ((^?)) import Control.Monad (guard) import qualified Data.ByteString as BS From 6ae64e8d6f88b08dc5325225a7e62d81e9bfa2d3 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 21:43:45 +0200 Subject: [PATCH 11/16] Use Hsc in cabal hover --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 123 ++++++------------ .../src/Ide/Plugin/Cabal/Dependencies.hs | 24 +++- 2 files changed, 66 insertions(+), 81 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 908513181b..1a04f1096b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -8,57 +8,50 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where -import Control.Lens (_Just, (^.), - (^?)) +import Control.Lens (_Just, (^.), (^?)) import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Maybe (runMaybeT) -import Data.HashMap.Strict (HashMap) -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import qualified Data.Text () -import qualified Data.Text as T -import Development.IDE as D -import Development.IDE.Core.FileStore (getVersionedTextDoc) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (runMaybeT) +import Data.HashMap.Strict (HashMap) +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import qualified Data.Text () +import qualified Data.Text as T +import Development.IDE as D +import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils -import Development.IDE.Core.Shake (restartShakeSession) -import Development.IDE.Graph (Key) -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 qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd -import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd -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.Dependencies as Dependencies -import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest -import qualified Ide.Plugin.Cabal.Files as CabalAdd -import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest -import qualified Ide.Plugin.Cabal.OfInterest as OfInterest -import Ide.Plugin.Cabal.Orphans () +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key) +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 qualified Distribution.Parsec.Position as Syntax +import qualified Ide.Plugin.Cabal.CabalAdd.CodeAction as CabalAdd +import qualified Ide.Plugin.Cabal.CabalAdd.Command as CabalAdd +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.Dependencies as Dependencies +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest +import qualified Ide.Plugin.Cabal.Files as CabalAdd +import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest +import qualified Ide.Plugin.Cabal.OfInterest as OfInterest +import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline -import qualified Ide.Plugin.Cabal.Rules as Rules +import qualified Ide.Plugin.Cabal.Rules as Rules 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 Text.Regex.TDFA +import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath FileVersion @@ -340,43 +333,13 @@ 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) + (hscEnv -> hsc) <- runActionE "cabal.cabal-hover" ide $ useE GhcSession nfp + let hoveredDep = List.find (positionInRange (msgParam ^. JL.position) . (\(x, _, _) -> x)) $ Dependencies.collectPackageDependencyVersions' cabalFields hsc + pure $ case hoveredDep of + Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> Dependencies.printVersion version <> ")\n", documentationText (pkgName <> "-" <> Dependencies.printVersion version)]) + Nothing -> InR Null + where 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 <> ")" 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 9f17ccce26..bddbc44c89 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} -module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens) where +module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens, collectPackageDependencyVersions', printVersion) where import Data.Array ((!)) import Data.ByteString (ByteString) @@ -80,5 +80,27 @@ collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPac pure (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset), pkgName, version) in versions +collectPackageDependencyVersions' :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, 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 -> [(Range, 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 -> [(Range, 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 + let pkgPosStart = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex) + pkgPosEnd = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset) + pure (Range pkgPosStart pkgPosEnd, pkgName, version) + in versions + printVersion :: Version -> T.Text printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v) From 9918fae6432fd28b24a936aee0b9862d9382f173 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 21:54:13 +0200 Subject: [PATCH 12/16] Unify deps resolving function --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- .../src/Ide/Plugin/Cabal/Dependencies.hs | 45 ++++++------------- 2 files changed, 14 insertions(+), 33 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 1a04f1096b..07a15b9737 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -334,7 +334,7 @@ hover ide _ msgParam = do nfp <- getNormalizedFilePathE uri cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp (hscEnv -> hsc) <- runActionE "cabal.cabal-hover" ide $ useE GhcSession nfp - let hoveredDep = List.find (positionInRange (msgParam ^. JL.position) . (\(x, _, _) -> x)) $ Dependencies.collectPackageDependencyVersions' cabalFields hsc + let hoveredDep = List.find (positionInRange (msgParam ^. JL.position) . (\(x, _, _) -> x)) $ Dependencies.collectPackageDependencyVersions cabalFields hsc pure $ case hoveredDep of Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> Dependencies.printVersion version <> ")\n", documentationText (pkgName <> "-" <> Dependencies.printVersion version)]) Nothing -> InR Null 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 bddbc44c89..14b39d2fa6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -1,8 +1,9 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} -module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens, collectPackageDependencyVersions', printVersion) where +module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens, printVersion) where +import Control.Lens ((^.)) import Data.Array ((!)) import Data.ByteString (ByteString) import Data.List @@ -18,6 +19,7 @@ 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 qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Protocol.Types (CodeLens (..), Command (..), InlayHint (..), Range (..), type (|?) (..)) @@ -25,32 +27,31 @@ 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 +dependencyVersionLens cabalFields = (>>= foo) . groupBy (\(a,_,_) (b,_,_)-> (a ^. JL.start . JL.line) == (b ^. JL.start . JL.line)) . collectPackageDependencyVersions cabalFields where - foo :: [(Syntax.Position, T.Text, Version)] -> [CodeLens] + foo :: [(Range, 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 = + mkCodeLens :: Bool -> (Range, T.Text, Version) -> CodeLens + mkCodeLens includePkgName (range, pkgName, dependencyVersion) = + let dependencyText = if includePkgName then pkgName <> " (" <> printVersion dependencyVersion <> ")" else printVersion dependencyVersion command = Command dependencyText mempty Nothing in CodeLens - { _range = Range cPos cPos + { _range = range , _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 + mkHint :: (Range, T.Text, Version) -> InlayHint + mkHint (Range _ pos, _, dependencyVersion) = + InlayHint { _position = pos , _label = InL $ " (" <> printVersion dependencyVersion <> ")" , _kind = Nothing , _textEdits = Nothing @@ -60,28 +61,8 @@ dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersi , _data_ = Nothing } -collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Syntax.Position, T.Text, Version)] +collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, 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, 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 - -collectPackageDependencyVersions' :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, T.Text, Version)] -collectPackageDependencyVersions' cabalFields hscEnv = cabalFields >>= collectPackageVersions where lookupPackageVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) (T.unpack pkgName) . unitPackageNameString) $ getUnitInfoMap hscEnv From ec5191d1c81d3769dbd906227f8fde1fdf1a6fe7 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 22:09:39 +0200 Subject: [PATCH 13/16] Move dependency hover to Dependencies module --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 9 +-- .../src/Ide/Plugin/Cabal/Dependencies.hs | 59 ++++++++++++------- 2 files changed, 39 insertions(+), 29 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 07a15b9737..ebb1922c91 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -24,7 +24,6 @@ import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (Key) -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 @@ -334,14 +333,10 @@ hover ide _ msgParam = do nfp <- getNormalizedFilePathE uri cabalFields <- runActionE "cabal.cabal-hover" ide $ useE ParseCabalFields nfp (hscEnv -> hsc) <- runActionE "cabal.cabal-hover" ide $ useE GhcSession nfp - let hoveredDep = List.find (positionInRange (msgParam ^. JL.position) . (\(x, _, _) -> x)) $ Dependencies.collectPackageDependencyVersions cabalFields hsc - pure $ case hoveredDep of - Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> Dependencies.printVersion version <> ")\n", documentationText (pkgName <> "-" <> Dependencies.printVersion version)]) - Nothing -> InR Null + pure $ Dependencies.dependencyHover cabalFields hsc cursor where + cursor = msgParam ^. JL.position uri = msgParam ^. JL.textDocument . JL.uri - documentationText :: T.Text -> T.Text - documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" -- ---------------------------------------------------------------- -- Completion 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 14b39d2fa6..70c0192cc4 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -1,30 +1,35 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} -module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, collectPackageDependencyVersions, dependencyVersionLens, printVersion) where +module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, dependencyVersionLens, dependencyHover) where -import Control.Lens ((^.)) -import Data.Array ((!)) -import Data.ByteString (ByteString) +import Control.Lens ((^.)) +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 qualified Language.LSP.Protocol.Lens as JL -import Language.LSP.Protocol.Types (CodeLens (..), Command (..), - InlayHint (..), Range (..), - type (|?) (..)) -import Text.Regex.TDFA (Regex, makeRegex, - matchAllText) +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 Development.IDE.LSP.HoverDefinition (foundHover) +import qualified Distribution.Fields as Syntax +import qualified Distribution.Parsec.Position as Syntax +import qualified Ide.Plugin.Cabal.Completion.Types as Types +import qualified Language.LSP.Protocol.Lens as JL +import Language.LSP.Protocol.Types (CodeLens (..), + Command (..), Hover, + InlayHint (..), Null (..), + Position, Range (..), + positionInRange, + type (|?) (..)) +import Text.Regex.TDFA (Regex, makeRegex, + matchAllText) dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens] dependencyVersionLens cabalFields = (>>= foo) . groupBy (\(a,_,_) (b,_,_)-> (a ^. JL.start . JL.line) == (b ^. JL.start . JL.line)) . collectPackageDependencyVersions cabalFields @@ -61,6 +66,16 @@ dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersi , _data_ = Nothing } +dependencyHover :: [Syntax.Field Syntax.Position] -> HscEnv -> Position -> Hover |? Null +dependencyHover cabalFields hsc cursorPosition = + let hoveredDep = List.find (positionInRange cursorPosition . (\(x, _, _) -> x)) $ collectPackageDependencyVersions cabalFields hsc + in case hoveredDep of + Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> printVersion version <> ")\n", documentationText (pkgName <> "-" <> printVersion version)]) + Nothing -> InR Null + where + documentationText :: T.Text -> T.Text + documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" + collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, T.Text, Version)] collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPackageVersions where From 1c1719b093148d0c395f7bf29711639764afee5d Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 22:33:46 +0200 Subject: [PATCH 14/16] Introduce explicit type for found dependency --- .../src/Ide/Plugin/Cabal/Dependencies.hs | 65 +++++++++++-------- 1 file changed, 38 insertions(+), 27 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 70c0192cc4..ff5cf72972 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -3,7 +3,7 @@ module Ide.Plugin.Cabal.Dependencies (dependencyVersionHints, dependencyVersionLens, dependencyHover) where -import Control.Lens ((^.)) +import Control.Lens (to, (^.)) import Data.Array ((!)) import Data.ByteString (ByteString) import Data.List @@ -32,71 +32,82 @@ import Text.Regex.TDFA (Regex, makeRegex, matchAllText) dependencyVersionLens :: [Syntax.Field Syntax.Position] -> HscEnv -> [CodeLens] -dependencyVersionLens cabalFields = (>>= foo) . groupBy (\(a,_,_) (b,_,_)-> (a ^. JL.start . JL.line) == (b ^. JL.start . JL.line)) . collectPackageDependencyVersions cabalFields +dependencyVersionLens cabalFields = Maybe.catMaybes . (>>= foo) . groupBy (\a b-> (a ^. to range . JL.start . JL.line) == (b ^. to range . JL.start . JL.line)) . collectPackageDependencyVersions cabalFields where - foo :: [(Range, T.Text, Version)] -> [CodeLens] + foo :: [DependencyInfo] -> [Maybe CodeLens] foo [] = [] foo [single] = [mkCodeLens False single] foo multi = mkCodeLens True <$> multi - mkCodeLens :: Bool -> (Range, T.Text, Version) -> CodeLens - mkCodeLens includePkgName (range, pkgName, dependencyVersion) = + mkCodeLens :: Bool -> DependencyInfo -> Maybe CodeLens + mkCodeLens includePkgName DependencyInfo{range, packageName, installedVersion = Just version} = let dependencyText = if includePkgName - then pkgName <> " (" <> printVersion dependencyVersion <> ")" - else printVersion dependencyVersion + then packageName <> " (" <> printVersion version <> ")" + else printVersion version command = Command dependencyText mempty Nothing - in CodeLens + in Just $ CodeLens { _range = range , _command = Just command , _data_ = Nothing } + mkCodeLens _ _ = Nothing dependencyVersionHints :: [Syntax.Field Syntax.Position] -> HscEnv -> [InlayHint] -dependencyVersionHints cabalFields = fmap mkHint . collectPackageDependencyVersions cabalFields +dependencyVersionHints cabalFields = Maybe.mapMaybe mkHint . collectPackageDependencyVersions cabalFields where - mkHint :: (Range, T.Text, Version) -> InlayHint - mkHint (Range _ pos, _, dependencyVersion) = - InlayHint { _position = pos - , _label = InL $ " (" <> printVersion dependencyVersion <> ")" - , _kind = Nothing - , _textEdits = Nothing - , _tooltip = Nothing - , _paddingLeft = Nothing - , _paddingRight = Nothing - , _data_ = Nothing - } + mkHint :: DependencyInfo -> Maybe InlayHint + mkHint (DependencyInfo range _ (Just installedVersion)) = + Just $ + InlayHint { _position = range ^. JL.end + , _label = InL $ " (" <> printVersion installedVersion <> ")" + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Nothing + , _paddingRight = Nothing + , _data_ = Nothing + } + mkHint _ = Nothing dependencyHover :: [Syntax.Field Syntax.Position] -> HscEnv -> Position -> Hover |? Null dependencyHover cabalFields hsc cursorPosition = - let hoveredDep = List.find (positionInRange cursorPosition . (\(x, _, _) -> x)) $ collectPackageDependencyVersions cabalFields hsc + let hoveredDep = List.find (positionInRange cursorPosition . range) $ collectPackageDependencyVersions cabalFields hsc in case hoveredDep of - Just (_, pkgName, version) -> foundHover (Nothing, [pkgName <> " (" <> printVersion version <> ")\n", documentationText (pkgName <> "-" <> printVersion version)]) + Just (DependencyInfo {packageName, installedVersion}) -> + let showVersion f = maybe T.empty (f . printVersion) installedVersion + in foundHover (Nothing, [packageName <> showVersion (\v -> " (" <> v <> ")") <> "\n", documentationText (packageName <> showVersion ("-" <>))]) Nothing -> InR Null where documentationText :: T.Text -> T.Text documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")" -collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [(Range, T.Text, Version)] +collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [DependencyInfo] 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 -> [(Range, T.Text, Version)] + collectPackageVersions :: Syntax.Field Syntax.Position -> [DependencyInfo] collectPackageVersions (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap fieldLinePackageVersions pos collectPackageVersions (Syntax.Section _ _ fields) = concatMap collectPackageVersions fields collectPackageVersions _ = [] - fieldLinePackageVersions :: Syntax.FieldLine Syntax.Position -> [(Range, T.Text, Version)] + fieldLinePackageVersions :: Syntax.FieldLine Syntax.Position -> [DependencyInfo] 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 let pkgPosStart = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex) pkgPosEnd = Types.cabalPositionToLSPPosition $ Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + pkgIndex + pkgOffset) - pure (Range pkgPosStart pkgPosEnd, pkgName, version) + version = lookupPackageVersion pkgName + pure $ DependencyInfo (Range pkgPosStart pkgPosEnd) pkgName version in versions +data DependencyInfo = DependencyInfo + { range :: Range + , packageName :: T.Text + , installedVersion :: Maybe Version + } + printVersion :: Version -> T.Text printVersion v = T.intercalate "." (fmap (T.pack . show) $ versionBranch v) From 51324d02810de591af272dfb4c447614e10d9351 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 22:48:49 +0200 Subject: [PATCH 15/16] Adjust cabal hover test --- plugins/hls-cabal-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 33e454cdae..46cbca4f61 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -235,7 +235,7 @@ hoverTests = testGroup "Hover" 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 "base with separated version" "hover-deps.cabal" (Position 6 25) "[Documentation](https://hackage.haskell.org/package/base-4.19.2.0)" , 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)" From 0dacf664265f6163761176cabd53b24f2a4e62d7 Mon Sep 17 00:00:00 2001 From: Tomasz Batko Date: Sun, 10 Aug 2025 23:54:59 +0200 Subject: [PATCH 16/16] Adjust for GHC96 --- .../src/Ide/Plugin/Cabal/Dependencies.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 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 ff5cf72972..6c400aea23 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} @@ -12,11 +13,12 @@ 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, +import Development.IDE.GHC.Compat (HscEnv, getUnitInfoMap, unitPackageNameString, unitPackageVersion) +#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) +import Development.IDE.GHC.Compat (nonDetEltsUniqMap) +#endif import Development.IDE.LSP.HoverDefinition (foundHover) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax @@ -84,7 +86,12 @@ dependencyHover cabalFields hsc cursorPosition = collectPackageDependencyVersions :: [Syntax.Field Syntax.Position] -> HscEnv -> [DependencyInfo] collectPackageDependencyVersions cabalFields hscEnv = cabalFields >>= collectPackageVersions where - lookupPackageVersion pkgName = Maybe.listToMaybe $ nonDetEltsUniqMap $ fmap unitPackageVersion $ filterUniqMap ((==) (T.unpack pkgName) . unitPackageNameString) $ getUnitInfoMap hscEnv +#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) + unitInfoList = nonDetEltsUniqMap $ getUnitInfoMap hscEnv +#else + unitInfoList = getUnitInfoMap hscEnv +#endif + lookupPackageVersion pkgName = fmap unitPackageVersion $ find ((==) (T.unpack pkgName) . unitPackageNameString) unitInfoList collectPackageVersions :: Syntax.Field Syntax.Position -> [DependencyInfo] collectPackageVersions (Syntax.Field (Syntax.Name _ "build-depends") pos) = concatMap fieldLinePackageVersions pos