Skip to content

Commit

Permalink
improve position handling
Browse files Browse the repository at this point in the history
  • Loading branch information
lucalabs-de committed Oct 14, 2024
1 parent 961d714 commit f5fad79
Show file tree
Hide file tree
Showing 3 changed files with 25 additions and 11 deletions.
5 changes: 4 additions & 1 deletion plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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] }
Expand All @@ -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)

Expand All @@ -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
Expand Down
23 changes: 16 additions & 7 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Dependencies.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,8 @@ module Ide.Plugin.Cabal.Dependencies (
DependencyInstance(..),
DependencyInstances(..),
parseDeps,
planJsonPath
planJsonPath,
packageRegex
) where

import Distribution.Fields qualified as Syntax
Expand All @@ -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
Expand All @@ -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)

0 comments on commit f5fad79

Please sign in to comment.