improve position handling

Author: lucalabs-de

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

@@ -80,6 +80,7 @@ import Language.LSP.Protocol.Types
 import Language.LSP.VFS qualified as VFS
 import Text.Regex.TDFA
 import System.FilePath ((</>))
+import Debug.Trace
 
 data Log
   = LogModificationTime NormalizedFilePath FileVersion
@@ -444,6 +445,7 @@ lens state _plId clp = do
 
       nfp <- getNormalizedFilePathE uri
       cabalFields <- runActionE "cabal.cabal-lens" state $ useE ParseCabalFields nfp
+      
       let positionedDeps = concatMap parseDeps cabalFields
 
       let rfp = rootDir state
@@ -460,7 +462,8 @@ lens state _plId clp = do
   where
     getCodeLens :: Positioned SimpleDependency -> CodeLens
     getCodeLens (Positioned pos (Dependency _ v)) = 
-      let cPos = Types.cabalPositionToLSPPosition pos in CodeLens 
+      let cPos = Types.cabalPositionToLSPPosition pos
+      in CodeLens 
           { _range = Range cPos cPos
           , _command = Just $ mkActionlessCommand v 
           , _data_ = Nothing 

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

@@ -185,9 +185,11 @@ type PkgName = T.Text
 type PkgVersion = T.Text
 
 data SimpleDependency = Dependency PkgName PkgVersion
+  deriving Show
 
 -- | Represents some element that has an associated position in a file
 data Positioned a = Positioned Syntax.Position a
+  deriving Show
 
 data DependencyInstances = DependencyInstances 
     { installPlan :: [DependencyInstance] }
@@ -197,7 +199,7 @@ data DependencyInstances = DependencyInstances
 data DependencyInstance = DependencyInstance 
     { _pkgName :: PkgName
     , _pkgVersion :: PkgVersion
-    , _componentName :: T.Text
+    , _pkgType :: T.Text
     } -- missing some unneeded fields
     deriving (Show, Generic)
 
@@ -207,8 +209,8 @@ instance A.FromJSON DependencyInstance where
     parseJSON = A.withObject "InstallPlan" $ \obj -> do
         pkgName <- obj .: "pkg-name"
         pkgVersion <- obj .: "pkg-version"
-        cmpName <- obj .: "component-name"
-        return $ DependencyInstance pkgName pkgVersion cmpName
+        pkgType <- obj .: "type"
+        return $ DependencyInstance pkgName pkgVersion pkgType
 
 instance A.FromJSON DependencyInstances where
   parseJSON = A.withObject "PlanJson" $ \obj -> do

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

@@ -4,7 +4,8 @@ module Ide.Plugin.Cabal.Dependencies (
     DependencyInstance(..),
     DependencyInstances(..),
     parseDeps,
-    planJsonPath
+    planJsonPath,
+    packageRegex
 ) where
 
 import Distribution.Fields qualified as Syntax
@@ -14,18 +15,20 @@ import Data.Text.Encoding qualified as Encoding
 import Data.Text qualified as T
 import System.FilePath ((</>), (<.>))
 
-import Text.Regex.TDFA ((=~), AllTextMatches (getAllTextMatches))
+import Text.Regex.TDFA ((=~), AllTextMatches (getAllTextMatches), AllMatches(getAllMatches))
 import Data.ByteString (ByteString)
 
 import Ide.Plugin.Cabal.Completion.Types
-    
+import Debug.Trace
+import Data.Tuple.Extra (dupe)
+
 planJsonPath :: FilePath
 planJsonPath = "dist-newstyle" </> "cache" </> "plan" <.> "json" -- hard coded for now
-    
+
 -- | Parses a Field that may contain dependencies
 parseDeps :: Syntax.Field Syntax.Position -> [Positioned PkgName]
 parseDeps (Syntax.Field (Syntax.Name _ "build-depends") fls) = concatMap mkPosDeps fls
-parseDeps (Syntax.Section _ _ fls) = concatMap parseDeps fls 
+parseDeps (Syntax.Section _ _ fls) = concatMap parseDeps fls
 parseDeps _ = []
 
 -- | Matches valid Cabal dependency names 
@@ -35,7 +38,13 @@ packageRegex = "[a-zA-Z0-9_-]+" -- not sure if this is correct
 -- | Parses a single FieldLine of Cabal dependencies. Returns a list since a single line may
 -- contain multiple dependencies.
 mkPosDeps :: Syntax.FieldLine Syntax.Position -> [Positioned PkgName]
-mkPosDeps (Syntax.FieldLine pos dep) = map (\n -> Positioned pos n) $ getPackageNames dep
-    where 
+mkPosDeps (Syntax.FieldLine pos dep) = zipWith 
+        (\n (o, _) -> Positioned (Syntax.Position (Syntax.positionRow pos) (Syntax.positionCol pos + o + 1)) n) 
+        (getPackageNames dep) 
+        (getPackageNameOffsets dep)
+    where
         getPackageNames :: ByteString -> [T.Text]
         getPackageNames dep = getAllTextMatches (Encoding.decodeUtf8Lenient dep =~ packageRegex)
+
+        getPackageNameOffsets :: ByteString -> [(Int, Int)]
+        getPackageNameOffsets dep = getAllMatches (Encoding.decodeUtf8Lenient dep =~ packageRegex)