Unify deps resolving function

Author: batkot

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

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,39 +19,39 @@ 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 (|?) (..))
 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