From f3cdcbd41402ca93a8bccb8301a30e7f1a54f714 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 12 Aug 2024 17:44:50 +0300 Subject: [PATCH 01/27] forced PR 4375 --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 38 +++++++ .../Plugin/Cabal/Completion/CabalFields.hs | 103 +++++++++++++++++- 2 files changed, 138 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7d23cea6c9..cd31e74582 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -48,6 +48,8 @@ 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 Data.List (find) +import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields data Log = LogModificationTime NormalizedFilePath FileVersion @@ -93,6 +95,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder + , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition ] , pluginNotificationHandlers = mconcat @@ -277,6 +280,41 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range + +-- | CodeActions for going to definitions. +-- +-- Provides a CodeAction for going to a definition when clicking on an identifier. +-- The definition is found by traversing the sections and comparing their name to +-- the clicked identifier. +-- +-- TODO: Support more definitions than sections. +gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition +gotoDefinition ideState _ msgParam = do + case uriToFilePath' uri of + Nothing -> + pure $ InR $ InR Null + Just filePath -> do + mCabalFields <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalFields $ toNormalizedFilePath filePath + let mCursorText = CabalFields.findTextWord cursor =<< mCabalFields + case mCursorText of + Nothing -> + pure $ InR $ InR Null + Just cursorText -> do + mCommonSections <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalCommonSections $ toNormalizedFilePath filePath + let mCommonSection = find (filterSectionArgName cursorText) =<< mCommonSections + case mCommonSection of + Nothing -> + pure $ InR $ InR Null + Just commonSection -> do + pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + where + cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) + uri = msgParam ^. JL.textDocument . JL.uri + filterSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName + filterSectionArgName _ _ = False + + + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 84ec3ec345..db244c7133 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,4 +1,4 @@ -module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where +module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE @@ -7,6 +7,9 @@ import qualified Data.Text.Encoding as T import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax import Ide.Plugin.Cabal.Completion.Types +import qualified Data.ByteString as BS +import Data.List (find) +import qualified Language.LSP.Protocol.Types as LSP -- ---------------------------------------------------------------- -- Cabal-syntax utilities I don't really want to write myself @@ -48,6 +51,71 @@ findFieldSection cursor (x:y:ys) type FieldName = T.Text + +-- | Determine the field line the cursor is currently a part of. +-- +-- The result is said field line and its starting position +-- or Nothing if the passed list of fields is empty. +-- +-- This function assumes that elements in a field's @FieldLine@ list +-- do not share the same row. +findFieldLine :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.FieldLine Syntax.Position) +findFieldLine _cursor [] = Nothing +findFieldLine cursor fields = + case findFieldSection cursor fields of + Nothing -> Nothing + Just (Syntax.Field _ fieldLines) -> find filterLineFields fieldLines + Just (Syntax.Section _ _ fields) -> findFieldLine cursor fields + where + cursorLine = Syntax.positionRow cursor + -- In contrast to `Field` or `Section`, `FieldLine` must have the exact + -- same line position as the cursor. + filterLineFields (Syntax.FieldLine pos _) = Syntax.positionRow pos == cursorLine + +-- | Determine the exact word at the current cursor position. +-- +-- The result is said word or Nothing if the passed list is empty +-- or the cursor position is not next to, or on a word. +-- For this function, a word is a sequence of consecutive characters +-- that are not a space or column. +-- +-- This function currently only considers words inside of a @FieldLine@. +findTextWord :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe T.Text +findTextWord _cursor [] = Nothing +findTextWord cursor fields = + case findFieldLine cursor fields of + Nothing -> Nothing + Just (Syntax.FieldLine pos byteString) -> + let decodedText = T.decodeUtf8 byteString + lineFieldCol = Syntax.positionCol pos + lineFieldLen = T.length decodedText + offset = cursorCol - lineFieldCol in + -- Range check if cursor is inside or or next to found line. + -- The latter comparison includes the length of the line as offset, + -- which is done to also include cursors that are at the end of a line. + -- e.g. "foo,bar|" + -- ^ + -- cursor + -- + -- Having an offset which is outside of the line is possible because of `splitAt`. + if offset >= 0 && lineFieldLen >= offset + then + let (lhs, rhs) = T.splitAt offset decodedText + strippedLhs = T.takeWhileEnd isAllowedChar lhs + strippedRhs = T.takeWhile isAllowedChar rhs + resultText = T.concat [strippedLhs, strippedRhs] in + -- It could be possible that the cursor was in-between separators, in this + -- case the resulting text would be empty, which should result in `Nothing`. + -- e.g. " foo ,| bar" + -- ^ + -- cursor + if not $ T.null resultText then Just resultText else Nothing + else + Nothing + where + cursorCol = Syntax.positionCol cursor + separators = [',', ' '] + isAllowedChar = (`notElem` separators) getAnnotation :: Syntax.Field ann -> ann getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann @@ -73,12 +141,41 @@ getOptionalSectionName (x:xs) = case x of -- -- For example, @flag@ @(@ @pedantic@ @)@ will be joined in -- one line, instead of four @SectionArg@s separately. -onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text +onelineSectionArgs :: [Syntax.SectionArg ann] -> T.Text onelineSectionArgs sectionArgs = joinedName where joinedName = T.unwords $ map getName sectionArgs - getName :: Syntax.SectionArg Syntax.Position -> T.Text + getName :: Syntax.SectionArg ann -> T.Text getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string + +-- | Returns the end position of a provided field +getFieldEndPosition :: Syntax.Field Syntax.Position -> Syntax.Position +getFieldEndPosition (Syntax.Field name []) = getNameEndPosition name +getFieldEndPosition (Syntax.Field _ (x:xs)) = getFieldLineEndPosition $ NE.last (x NE.:| xs) +getFieldEndPosition (Syntax.Section name [] []) = getNameEndPosition name +getFieldEndPosition (Syntax.Section _ (x:xs) []) = getSectionArgEndPosition $ NE.last (x NE.:| xs) +getFieldEndPosition (Syntax.Section _ _ (x:xs)) = getFieldEndPosition $ NE.last (x NE.:| xs) + +-- | Returns the end position of a provided section arg +getSectionArgEndPosition :: Syntax.SectionArg Syntax.Position -> Syntax.Position +getSectionArgEndPosition (Syntax.SecArgName (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) +getSectionArgEndPosition (Syntax.SecArgStr (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) +getSectionArgEndPosition (Syntax.SecArgOther (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) + +-- | Returns the end position of a provided name +getNameEndPosition :: Syntax.Name Syntax.Position -> Syntax.Position +getNameEndPosition (Syntax.Name (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) + +-- | Returns the end position of a provided field line +getFieldLineEndPosition :: Syntax.FieldLine Syntax.Position -> Syntax.Position +getFieldLineEndPosition (Syntax.FieldLine (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) + +-- | Returns a LSP compatible range for a provided field +getFieldLSPRange :: Syntax.Field Syntax.Position -> LSP.Range +getFieldLSPRange field = LSP.Range startLSPPos endLSPPos + where + startLSPPos = cabalPositionToLSPPosition $ getAnnotation field + endLSPPos = cabalPositionToLSPPosition $ getFieldEndPosition field From 169fa2cafd183b5964f3af965825433a3e343a78 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 13 Aug 2024 00:54:42 +0300 Subject: [PATCH 02/27] get modules with names --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 7 ++++ .../Plugin/Cabal/Completion/CabalFields.hs | 41 ++++++++++++++++++- 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index cd31e74582..91b80b51f8 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -51,6 +51,8 @@ import qualified Language.LSP.VFS as VFS import Data.List (find) import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields +import Debug.Trace + data Log = LogModificationTime NormalizedFilePath FileVersion | LogShake Shake.Log @@ -295,6 +297,11 @@ gotoDefinition ideState _ msgParam = do pure $ InR $ InR Null Just filePath -> do mCabalFields <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalFields $ toNormalizedFilePath filePath + let mModuleNames = CabalFields.getModulesNames <$> mCabalFields + let mModuleSections = CabalFields.getSectionsWithModules <$> mCabalFields + traceShowM ("mModuleNames", mModuleNames) + traceShowM ("mModuleSections", mModuleSections) + let mCursorText = CabalFields.findTextWord cursor =<< mCabalFields case mCursorText of Nothing -> diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index db244c7133..f5fd4215f6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,4 +1,4 @@ -module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where +module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, getSectionsWithModules, getModulesNames, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE @@ -124,6 +124,9 @@ getFieldName :: Syntax.Field ann -> FieldName getFieldName (Syntax.Field (Syntax.Name _ fn) _) = T.decodeUtf8 fn getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn +getFieldLineName :: Syntax.FieldLine ann -> FieldName +getFieldLineName (Syntax.FieldLine _ fn) = T.decodeUtf8 fn + -- | Returns the name of a section if it has a name. -- -- This assumes that the given section args belong to named stanza @@ -134,6 +137,42 @@ getOptionalSectionName (x:xs) = case x of Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) _ -> getOptionalSectionName xs +getModulesNames :: [Syntax.Field any] -> [(T.Text, T.Text)] +getModulesNames fields = concatMap getSectionModuleNames sections + where + sections = getSectionsWithModules fields + + getSectionModuleNames (Syntax.Section _ secArgs fields) = map (getArgsName secArgs, ) $ concatMap getFieldModuleNames fields + getSectionModuleNames _ = [] + + getArgsName [] = T.empty + getArgsName [Syntax.SecArgName _ name] = T.decodeUtf8 name + getArgsName _ = T.empty + + getFieldModuleNames field@(Syntax.Field _ modules) = if getFieldName field == T.pack "exposed-modules" || + getFieldName field == T.pack "other-modules" + then map getFieldLineName modules + else [] + getFieldModuleNames _ = [] + +getSectionsWithModules :: [Syntax.Field any] -> [Syntax.Field any] +getSectionsWithModules fields = concatMap go fields + where + go :: Syntax.Field any -> [Syntax.Field any] + go (Syntax.Field _ _) = [] + go section@(Syntax.Section _ _ fields) = concatMap onlySectionsWithModules (section:fields) + + onlySectionsWithModules :: Syntax.Field any -> [Syntax.Field any] + onlySectionsWithModules (Syntax.Field _ _) = [] + onlySectionsWithModules (Syntax.Section name secArgs fields) + | (not . null) newFields = [Syntax.Section name secArgs newFields] + | otherwise = [] + where newFields = filter subfieldHasModule fields + + subfieldHasModule :: Syntax.Field any -> Bool + subfieldHasModule field@(Syntax.Field _ _) = getFieldName field == T.pack "exposed-modules" || + getFieldName field == T.pack "other-modules" + subfieldHasModule (Syntax.Section _ _ _) = False -- | Makes a single text line out of multiple -- @SectionArg@s. Allows to display conditions, From a49ecea474942c150b5346df47173593a912f21f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 13 Aug 2024 22:04:32 +0300 Subject: [PATCH 03/27] finding hsSourceDirs --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 162 +++++++++++++----- .../Plugin/Cabal/Completion/CabalFields.hs | 21 ++- 2 files changed, 129 insertions(+), 54 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 91b80b51f8..9e6e87840d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -2,56 +2,69 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal (descriptor, Log (..)) where import Control.Concurrent.Strict import Control.DeepSeq -import Control.Lens ((^.)) +import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.ByteString as BS import Data.Hashable -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import qualified Data.List.NonEmpty as NE -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as Encoding +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.List (find) +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as Encoding import Data.Typeable -import Development.IDE as D -import Development.IDE.Core.Shake (restartShakeSession) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph (Key, alwaysRerun) -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 Development.IDE as D +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key, + alwaysRerun) +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 GHC.Generics -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 qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics -import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest -import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest -import Ide.Plugin.Cabal.Orphans () +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 qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest +import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest +import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline -import qualified Ide.Plugin.Cabal.Parse as Parse +import qualified Ide.Plugin.Cabal.Parse as Parse 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 Data.List (find) -import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields - -import Debug.Trace +import qualified Language.LSP.VFS as VFS + +import Debug.Trace +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + Executable (..), + ForeignLib (..), + Library (..), + LibraryName (LMainLibName, LSubLibName), + PackageDescription (..), + TestSuite (..), + library, + unUnqualComponentName) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -297,10 +310,6 @@ gotoDefinition ideState _ msgParam = do pure $ InR $ InR Null Just filePath -> do mCabalFields <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalFields $ toNormalizedFilePath filePath - let mModuleNames = CabalFields.getModulesNames <$> mCabalFields - let mModuleSections = CabalFields.getSectionsWithModules <$> mCabalFields - traceShowM ("mModuleNames", mModuleNames) - traceShowM ("mModuleSections", mModuleSections) let mCursorText = CabalFields.findTextWord cursor =<< mCabalFields case mCursorText of @@ -308,20 +317,79 @@ gotoDefinition ideState _ msgParam = do pure $ InR $ InR Null Just cursorText -> do mCommonSections <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalCommonSections $ toNormalizedFilePath filePath - let mCommonSection = find (filterSectionArgName cursorText) =<< mCommonSections + let mCommonSection = find (isSectionArgName cursorText) =<< mCommonSections case mCommonSection of - Nothing -> - pure $ InR $ InR Null Just commonSection -> do pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + Nothing -> do + let mModuleNames = CabalFields.getModulesNames <$> mCabalFields + mModuleName = find (isModuleName cursorText) =<< mModuleNames + case mModuleName of + Nothing -> traceShowM ("NOT A MODULE") + Just (mBuildTargetNames, moduleName) -> do + traceShowM ("IS A MODULE", moduleName, "at", mBuildTargetNames) + mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile $ toNormalizedFilePath filePath + case mGPD of + Nothing -> traceShowM ("failed to get GPD") + Just (gpd, _) -> do + let debug = map (lookupBuildTargetPackageDescription + (flattenPackageDescription gpd)) + mBuildTargetNames + traceShowM ("debug is", debug) + let buildInfos = foldMap (lookupBuildTargetPackageDescription + (flattenPackageDescription gpd)) + mBuildTargetNames + traceShowM ("buildInfos is", buildInfos) + traceShowM ("Found hsSourceDirs", map hsSourceDirs buildInfos) + pure $ InR $ InR Null where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) uri = msgParam ^. JL.textDocument . JL.uri - filterSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName - filterSectionArgName _ _ = False - - - + isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName + isSectionArgName _ _ = False + isModuleName name (_, moduleName) = name == moduleName + + lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] + lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = + case library of + Nothing -> error "Target is a main library but no main library was found" + Just (Library {libBuildInfo}) -> [libBuildInfo] + lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = + Maybe.catMaybes $ + map (\exec -> executableNameLookup exec buildTargetName) executables <> + map (\lib -> subLibraryNameLookup lib buildTargetName) subLibraries <> + map (\lib -> foreignLibsNameLookup lib buildTargetName) foreignLibs <> + map (\test -> testSuiteNameLookup test buildTargetName) testSuites <> + map (\bench -> benchmarkNameLookup bench buildTargetName) benchmarks + where + executableNameLookup :: Executable -> T.Text -> Maybe BuildInfo + executableNameLookup (Executable {exeName, buildInfo}) buildTargetName = + if T.pack (unUnqualComponentName exeName) == buildTargetName + then Just buildInfo + else Nothing + subLibraryNameLookup :: Library -> T.Text -> Maybe BuildInfo + subLibraryNameLookup (Library {libName, libBuildInfo}) buildTargetName = + case libName of + (LSubLibName name) -> + if T.pack (unUnqualComponentName name) == buildTargetName + then Just libBuildInfo + else Nothing + LMainLibName -> Nothing + foreignLibsNameLookup :: ForeignLib -> T.Text -> Maybe BuildInfo + foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) buildTargetName = + if T.pack (unUnqualComponentName foreignLibName) == buildTargetName + then Just foreignLibBuildInfo + else Nothing + testSuiteNameLookup :: TestSuite -> T.Text -> Maybe BuildInfo + testSuiteNameLookup (TestSuite {testName, testBuildInfo}) buildTargetName = + if T.pack (unUnqualComponentName testName) == buildTargetName + then Just testBuildInfo + else Nothing + benchmarkNameLookup :: Benchmark -> T.Text -> Maybe BuildInfo + benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) buildTargetName = + if T.pack (unUnqualComponentName benchmarkName) == buildTargetName + then Just benchmarkBuildInfo + else Nothing -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index f5fd4215f6..44483e98f6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -10,6 +10,9 @@ import Ide.Plugin.Cabal.Completion.Types import qualified Data.ByteString as BS import Data.List (find) import qualified Language.LSP.Protocol.Types as LSP +import Data.List.Extra (groupSort) +import Data.Bifunctor (second) +import Data.Tuple (swap) -- ---------------------------------------------------------------- -- Cabal-syntax utilities I don't really want to write myself @@ -51,7 +54,6 @@ findFieldSection cursor (x:y:ys) type FieldName = T.Text - -- | Determine the field line the cursor is currently a part of. -- -- The result is said field line and its starting position @@ -137,17 +139,22 @@ getOptionalSectionName (x:xs) = case x of Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) _ -> getOptionalSectionName xs -getModulesNames :: [Syntax.Field any] -> [(T.Text, T.Text)] -getModulesNames fields = concatMap getSectionModuleNames sections +type BuildTargetName = T.Text +type ModuleName = T.Text + +getModulesNames :: [Syntax.Field any] -> [([Maybe BuildTargetName], ModuleName)] +getModulesNames fields = map swap $ groupSort rawModuleTargetPairs where + rawModuleTargetPairs = concatMap getSectionModuleNames sections sections = getSectionsWithModules fields - getSectionModuleNames (Syntax.Section _ secArgs fields) = map (getArgsName secArgs, ) $ concatMap getFieldModuleNames fields + getSectionModuleNames :: Syntax.Field any -> [(ModuleName, Maybe BuildTargetName)] + getSectionModuleNames (Syntax.Section _ secArgs fields) = map (, getArgsName secArgs) $ concatMap getFieldModuleNames fields getSectionModuleNames _ = [] - getArgsName [] = T.empty - getArgsName [Syntax.SecArgName _ name] = T.decodeUtf8 name - getArgsName _ = T.empty + getArgsName [] = Nothing -- only a main library can have no name + getArgsName [Syntax.SecArgName _ name] = Just $ T.decodeUtf8 name + getArgsName _ = Nothing -- impossible to have multiple names for a build target getFieldModuleNames field@(Syntax.Field _ modules) = if getFieldName field == T.pack "exposed-modules" || getFieldName field == T.pack "other-modules" From 2ff597a5dba62ad63bc96f157d80ce3029eb16b2 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 14 Aug 2024 02:38:30 +0300 Subject: [PATCH 04/27] correct path, indefinite search(?) --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 30 ++++++++++++------- .../Plugin/Cabal/Completion/CabalFields.hs | 16 +++++----- 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 9e6e87840d..3e41e777bb 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -65,6 +65,10 @@ import Distribution.PackageDescription (Benchmark (..), library, unUnqualComponentName) import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import Distribution.Utils.Path (getSymbolicPath) +import System.Directory (doesFileExist) +import System.FilePath ((), takeDirectory) +import Distribution.Utils.Generic (safeHead) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -325,23 +329,25 @@ gotoDefinition ideState _ msgParam = do let mModuleNames = CabalFields.getModulesNames <$> mCabalFields mModuleName = find (isModuleName cursorText) =<< mModuleNames case mModuleName of - Nothing -> traceShowM ("NOT A MODULE") + Nothing -> pure $ InR $ InR Null Just (mBuildTargetNames, moduleName) -> do - traceShowM ("IS A MODULE", moduleName, "at", mBuildTargetNames) mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile $ toNormalizedFilePath filePath case mGPD of - Nothing -> traceShowM ("failed to get GPD") + Nothing -> pure $ InR $ InR Null Just (gpd, _) -> do - let debug = map (lookupBuildTargetPackageDescription - (flattenPackageDescription gpd)) - mBuildTargetNames - traceShowM ("debug is", debug) let buildInfos = foldMap (lookupBuildTargetPackageDescription (flattenPackageDescription gpd)) mBuildTargetNames - traceShowM ("buildInfos is", buildInfos) - traceShowM ("Found hsSourceDirs", map hsSourceDirs buildInfos) - pure $ InR $ InR Null + sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos + potentialPaths = map (\dir -> takeDirectory filePath dir toHaskellFile moduleName) sourceDirs + traceShowM ("potentialPaths", potentialPaths) + allPaths <- liftIO $ filterM doesFileExist potentialPaths + traceShowM ("allPaths", allPaths) + let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths + traceShowM ("locations", locations) + case safeHead locations of + Nothing -> pure $ InR $ InR Null + Just location -> pure $ InL $ Definition $ InL location where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) uri = msgParam ^. JL.textDocument . JL.uri @@ -390,6 +396,10 @@ gotoDefinition ideState _ msgParam = do if T.pack (unUnqualComponentName benchmarkName) == buildTargetName then Just benchmarkBuildInfo else Nothing + + toHaskellFile :: T.Text -> FilePath + toHaskellFile moduleName = foldl1 () (map T.unpack $ T.splitOn "." moduleName) ++ ".hs" + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 44483e98f6..37c50989d0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,18 +1,18 @@ module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, getSectionsWithModules, getModulesNames, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where +import qualified Data.ByteString as BS +import Data.List (find) +import Data.List.Extra (groupSort) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Tuple (swap) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax -import Ide.Plugin.Cabal.Completion.Types -import qualified Data.ByteString as BS -import Data.List (find) +import Ide.Plugin.Cabal.Completion.Types + ( cabalPositionToLSPPosition, FieldContext(None), StanzaContext ) import qualified Language.LSP.Protocol.Types as LSP -import Data.List.Extra (groupSort) -import Data.Bifunctor (second) -import Data.Tuple (swap) -- ---------------------------------------------------------------- -- Cabal-syntax utilities I don't really want to write myself @@ -152,9 +152,9 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs getSectionModuleNames (Syntax.Section _ secArgs fields) = map (, getArgsName secArgs) $ concatMap getFieldModuleNames fields getSectionModuleNames _ = [] - getArgsName [] = Nothing -- only a main library can have no name + getArgsName [] = Nothing -- only a main library can have no name getArgsName [Syntax.SecArgName _ name] = Just $ T.decodeUtf8 name - getArgsName _ = Nothing -- impossible to have multiple names for a build target + getArgsName _ = Nothing -- impossible to have multiple names for a build target getFieldModuleNames field@(Syntax.Field _ modules) = if getFieldName field == T.pack "exposed-modules" || getFieldName field == T.pack "other-modules" From 5cc39062c1830adeec0b24dc20645ddfbd17f85f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 14 Aug 2024 16:23:26 +0300 Subject: [PATCH 05/27] formatting and docs --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 47 +++++++------- .../Plugin/Cabal/Completion/CabalFields.hs | 65 ++++++++++++++++++- 2 files changed, 85 insertions(+), 27 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3e41e777bb..69016abbb7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -32,7 +32,20 @@ import Development.IDE.Graph (Key, import qualified Development.IDE.Plugin.Completions.Logic as Ghcide import Development.IDE.Types.Shake (toKey) import qualified Distribution.Fields as Syntax +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + Executable (..), + ForeignLib (..), + Library (..), + LibraryName (LMainLibName, LSubLibName), + PackageDescription (..), + TestSuite (..), + library, + unUnqualComponentName) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) import qualified Distribution.Parsec.Position as Syntax +import Distribution.Utils.Generic (safeHead) +import Distribution.Utils.Path (getSymbolicPath) import GHC.Generics import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes @@ -52,23 +65,9 @@ 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 Debug.Trace -import Distribution.PackageDescription (Benchmark (..), - BuildInfo (..), - Executable (..), - ForeignLib (..), - Library (..), - LibraryName (LMainLibName, LSubLibName), - PackageDescription (..), - TestSuite (..), - library, - unUnqualComponentName) -import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import Distribution.Utils.Path (getSymbolicPath) -import System.Directory (doesFileExist) -import System.FilePath ((), takeDirectory) -import Distribution.Utils.Generic (safeHead) +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory, + ()) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -302,11 +301,12 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif -- | CodeActions for going to definitions. -- --- Provides a CodeAction for going to a definition when clicking on an identifier. +-- Provides a CodeAction for going to a definition when clicking on an identifier +-- and clicking on exposed-module or other-module field. -- The definition is found by traversing the sections and comparing their name to --- the clicked identifier. +-- the clicked identifier. If it's not in sections it attempts to find it in module names. -- --- TODO: Support more definitions than sections. +-- TODO: Resolve more cases for go-to definition. gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition gotoDefinition ideState _ msgParam = do case uriToFilePath' uri of @@ -340,13 +340,10 @@ gotoDefinition ideState _ msgParam = do mBuildTargetNames sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos potentialPaths = map (\dir -> takeDirectory filePath dir toHaskellFile moduleName) sourceDirs - traceShowM ("potentialPaths", potentialPaths) allPaths <- liftIO $ filterM doesFileExist potentialPaths - traceShowM ("allPaths", allPaths) let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths - traceShowM ("locations", locations) - case safeHead locations of - Nothing -> pure $ InR $ InR Null + case safeHead locations of -- We assume there could be only one source location + Nothing -> pure $ InR $ InR Null Just location -> pure $ InL $ Definition $ InL location where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 37c50989d0..e450de4246 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -10,8 +10,9 @@ import qualified Data.Text.Encoding as T import Data.Tuple (swap) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax -import Ide.Plugin.Cabal.Completion.Types - ( cabalPositionToLSPPosition, FieldContext(None), StanzaContext ) +import Ide.Plugin.Cabal.Completion.Types (FieldContext (None), + StanzaContext, + cabalPositionToLSPPosition) import qualified Language.LSP.Protocol.Types as LSP -- ---------------------------------------------------------------- @@ -142,6 +143,34 @@ getOptionalSectionName (x:xs) = case x of type BuildTargetName = T.Text type ModuleName = T.Text +-- | Given a cabal AST returns pairs of all respective target names +-- and the module name bounded to them. If a target is a main library gives +-- @Nothing@, otherwise @Just target-name@ +-- +-- Examples of input cabal files and the outputs: +-- +-- * Target is a main library module: +-- +-- > library +-- > exposed-modules: +-- > MyLib +-- +-- * @getModulesNames@ output: +-- +-- > [([Nothing], "MyLib")] +-- +-- * Same module names in different targets: +-- +-- > test-suite first-target +-- > other-modules: +-- > Config +-- > test-suite second-target +-- > other-modules: +-- > Config +-- +-- * @getModulesNames@ output: +-- +-- > [([Just "first-target", Just "second-target"], "Config")] getModulesNames :: [Syntax.Field any] -> [([Maybe BuildTargetName], ModuleName)] getModulesNames fields = map swap $ groupSort rawModuleTargetPairs where @@ -162,6 +191,38 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs else [] getFieldModuleNames _ = [] +-- | Trims a given cabal AST leaving only targets and their +-- @exposed-modules@ and @other-modules@ sections. +-- +-- For examle: +-- +-- * Given a cabal file like this: +-- +-- > library +-- > import: extra +-- > hs-source-dirs: source/directory +-- > ... +-- > exposed-modules: +-- > Importaint.Exposed.Module +-- > other-modules: +-- > Importaint.Other.Module +-- > +-- > test-suite tests +-- > type: type +-- > build-tool-depends: tool +-- > other-modules: +-- > Importaint.Other.Module +-- +-- * @getSectionsWithModules@ gives output: +-- +-- > library +-- > exposed-modules: +-- > Importaint.Exposed.Module +-- > other-modules: +-- > Importaint.Other.Module +-- > test-suite tests +-- > other-modules: +-- > Importaint.Other.Module getSectionsWithModules :: [Syntax.Field any] -> [Syntax.Field any] getSectionsWithModules fields = concatMap go fields where From 7cf02652ed99bb50e5759ec38f586ebbb81d9825 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 14 Aug 2024 19:25:03 +0300 Subject: [PATCH 06/27] formatting --- .../src/Ide/Plugin/Cabal/Completion/CabalFields.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index e450de4246..b58a4b1f2a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,4 +1,10 @@ -module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, getSectionsWithModules, getModulesNames, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where +module Ide.Plugin.Cabal.Completion.CabalFields + ( findStanzaForColumn, getModulesNames, getFieldLSPRange, + findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, + getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, + getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition + ) + where import qualified Data.ByteString as BS import Data.List (find) From 1236c066bd95f73dbea5ded1a22ac6e279d3e6be Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Fri, 16 Aug 2024 21:54:26 +0300 Subject: [PATCH 07/27] Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs Co-authored-by: fendor --- .../src/Ide/Plugin/Cabal/Completion/CabalFields.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index b58a4b1f2a..cae51d1078 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -150,7 +150,7 @@ type BuildTargetName = T.Text type ModuleName = T.Text -- | Given a cabal AST returns pairs of all respective target names --- and the module name bounded to them. If a target is a main library gives +-- and the module name bound to them. If a target is a main library gives -- @Nothing@, otherwise @Just target-name@ -- -- Examples of input cabal files and the outputs: From adcd5b9fa70c560ad1c756e8ae7211457a052e03 Mon Sep 17 00:00:00 2001 From: Chrizzl Date: Sun, 18 Aug 2024 10:36:09 +0200 Subject: [PATCH 08/27] Add Goto Definition for cabal common sections (#4375) * Add goto-definitions for cabal common sections * Add default direct cradle hie.yaml file to testdata * incorporate changes requested in #4375 * add tests for cabal goto-definition --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 69 ++++++++--------- .../Plugin/Cabal/Completion/CabalFields.hs | 75 ++++++++++++++++++- plugins/hls-cabal-plugin/test/Main.hs | 55 ++++++++++++++ .../goto-definition/simple-with-common.cabal | 62 +++++++++++++++ .../hls-cabal-plugin/test/testdata/hie.yaml | 3 + 5 files changed, 224 insertions(+), 40 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/hie.yaml diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 69016abbb7..f43439a3a0 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -25,6 +25,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D +import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (Key, @@ -60,6 +61,7 @@ import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline import qualified Ide.Plugin.Cabal.Parse as Parse +import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP @@ -309,42 +311,37 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif -- TODO: Resolve more cases for go-to definition. gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition gotoDefinition ideState _ msgParam = do - case uriToFilePath' uri of - Nothing -> - pure $ InR $ InR Null - Just filePath -> do - mCabalFields <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalFields $ toNormalizedFilePath filePath - - let mCursorText = CabalFields.findTextWord cursor =<< mCabalFields - case mCursorText of - Nothing -> - pure $ InR $ InR Null - Just cursorText -> do - mCommonSections <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalCommonSections $ toNormalizedFilePath filePath - let mCommonSection = find (isSectionArgName cursorText) =<< mCommonSections - case mCommonSection of - Just commonSection -> do - pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection - Nothing -> do - let mModuleNames = CabalFields.getModulesNames <$> mCabalFields - mModuleName = find (isModuleName cursorText) =<< mModuleNames - case mModuleName of - Nothing -> pure $ InR $ InR Null - Just (mBuildTargetNames, moduleName) -> do - mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile $ toNormalizedFilePath filePath - case mGPD of - Nothing -> pure $ InR $ InR Null - Just (gpd, _) -> do - let buildInfos = foldMap (lookupBuildTargetPackageDescription - (flattenPackageDescription gpd)) - mBuildTargetNames - sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos - potentialPaths = map (\dir -> takeDirectory filePath dir toHaskellFile moduleName) sourceDirs - allPaths <- liftIO $ filterM doesFileExist potentialPaths - let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths - case safeHead locations of -- We assume there could be only one source location - Nothing -> pure $ InR $ InR Null - Just location -> pure $ InL $ Definition $ InL location + nfp <- getNormalizedFilePathE uri + cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp + case CabalFields.findTextWord cursor cabalFields of + Nothing -> + pure $ InR $ InR Null + Just cursorText -> do + commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp + case find (isSectionArgName cursorText) commonSections of + Just commonSection -> do + pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + + Nothing -> do + let mModuleNames = CabalFields.getModulesNames <$> mCabalFields + mModuleName = find (isModuleName cursorText) =<< mModuleNames + case mModuleName of + Nothing -> pure $ InR $ InR Null + Just (mBuildTargetNames, moduleName) -> do + mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile nfp + case mGPD of + Nothing -> pure $ InR $ InR Null + Just (gpd, _) -> do + let buildInfos = foldMap (lookupBuildTargetPackageDescription + (flattenPackageDescription gpd)) + mBuildTargetNames + sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos + potentialPaths = map (\dir -> takeDirectory filePath dir toHaskellFile moduleName) sourceDirs + allPaths <- liftIO $ filterM doesFileExist potentialPaths + let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths + case safeHead locations of -- We assume there could be only one source location + Nothing -> pure $ InR $ InR Null + Just location -> pure $ InL $ Definition $ InL location where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) uri = msgParam ^. JL.textDocument . JL.uri diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index cae51d1078..a9d76516ca 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -16,9 +16,7 @@ import qualified Data.Text.Encoding as T import Data.Tuple (swap) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax -import Ide.Plugin.Cabal.Completion.Types (FieldContext (None), - StanzaContext, - cabalPositionToLSPPosition) +import Ide.Plugin.Cabal.Completion.Types import qualified Language.LSP.Protocol.Types as LSP -- ---------------------------------------------------------------- @@ -41,7 +39,7 @@ findStanzaForColumn col ctx = case NE.uncons ctx of -- -- The result is said field and its starting position -- or Nothing if the passed list of fields is empty. - +-- -- This only looks at the row of the cursor and not at the cursor's -- position within the row. -- @@ -59,6 +57,71 @@ findFieldSection cursor (x:y:ys) where cursorLine = Syntax.positionRow cursor +-- | Determine the field line the cursor is currently a part of. +-- +-- The result is said field line and its starting position +-- or Nothing if the passed list of fields is empty. +-- +-- This function assumes that elements in a field's @FieldLine@ list +-- do not share the same row. +findFieldLine :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.FieldLine Syntax.Position) +findFieldLine _cursor [] = Nothing +findFieldLine cursor fields = + case findFieldSection cursor fields of + Nothing -> Nothing + Just (Syntax.Field _ fieldLines) -> find filterLineFields fieldLines + Just (Syntax.Section _ _ fields) -> findFieldLine cursor fields + where + cursorLine = Syntax.positionRow cursor + -- In contrast to `Field` or `Section`, `FieldLine` must have the exact + -- same line position as the cursor. + filterLineFields (Syntax.FieldLine pos _) = Syntax.positionRow pos == cursorLine + +-- | Determine the exact word at the current cursor position. +-- +-- The result is said word or Nothing if the passed list is empty +-- or the cursor position is not next to, or on a word. +-- For this function, a word is a sequence of consecutive characters +-- that are not a space or column. +-- +-- This function currently only considers words inside of a @FieldLine@. +findTextWord :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe T.Text +findTextWord _cursor [] = Nothing +findTextWord cursor fields = + case findFieldLine cursor fields of + Nothing -> Nothing + Just (Syntax.FieldLine pos byteString) -> + let decodedText = T.decodeUtf8 byteString + lineFieldCol = Syntax.positionCol pos + lineFieldLen = T.length decodedText + offset = cursorCol - lineFieldCol in + -- Range check if cursor is inside or or next to found line. + -- The latter comparison includes the length of the line as offset, + -- which is done to also include cursors that are at the end of a line. + -- e.g. "foo,bar|" + -- ^ + -- cursor + -- + -- Having an offset which is outside of the line is possible because of `splitAt`. + if offset >= 0 && lineFieldLen >= offset + then + let (lhs, rhs) = T.splitAt offset decodedText + strippedLhs = T.takeWhileEnd isAllowedChar lhs + strippedRhs = T.takeWhile isAllowedChar rhs + resultText = T.concat [strippedLhs, strippedRhs] in + -- It could be possible that the cursor was in-between separators, in this + -- case the resulting text would be empty, which should result in `Nothing`. + -- e.g. " foo ,| bar" + -- ^ + -- cursor + if not $ T.null resultText then Just resultText else Nothing + else + Nothing + where + cursorCol = Syntax.positionCol cursor + separators = [',', ' '] + isAllowedChar = (`notElem` separators) + type FieldName = T.Text -- | Determine the field line the cursor is currently a part of. @@ -264,6 +327,10 @@ onelineSectionArgs sectionArgs = joinedName getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string +<<<<<<< HEAD +======= + +>>>>>>> 6f6f75bc (Add Goto Definition for cabal common sections (#4375)) -- | Returns the end position of a provided field getFieldEndPosition :: Syntax.Field Syntax.Position -> Syntax.Position getFieldEndPosition (Syntax.Field name []) = getNameEndPosition name diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index ddc197c4ae..2009352bbd 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -20,6 +20,7 @@ import qualified Data.Text as Text import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) import System.FilePath import Test.Hls @@ -36,6 +37,7 @@ main = do , contextTests , outlineTests , codeActionTests + , gotoDefinitionTests ] -- ------------------------------------------------------------------------ @@ -227,3 +229,56 @@ codeActionTests = testGroup "Code Actions" InR action@CodeAction{_title} <- codeActions guard (_title == "Replace with " <> license) pure action + +-- ---------------------------------------------------------------------------- +-- Goto Definition Tests +-- ---------------------------------------------------------------------------- + +gotoDefinitionTests :: TestTree +gotoDefinitionTests = testGroup "Goto Definition" + [ positiveTest "middle of identifier" (mkP 27 16) (mkR 6 0 7 22) + , positiveTest "left of identifier" (mkP 30 12) (mkR 10 0 17 40) + , positiveTest "right of identifier" (mkP 33 22) (mkR 20 0 23 34) + , positiveTest "left of '-' in identifier" (mkP 36 20) (mkR 6 0 7 22) + , positiveTest "right of '-' in identifier" (mkP 39 19) (mkR 10 0 17 40) + , positiveTest "identifier in identifier list" (mkP 42 16) (mkR 20 0 23 34) + , positiveTest "left of ',' right of identifier" (mkP 45 33) (mkR 10 0 17 40) + , positiveTest "right of ',' left of identifier" (mkP 48 34) (mkR 6 0 7 22) + + , negativeTest "right of ',' left of space" (mkP 51 23) + , negativeTest "right of ':' left of space" (mkP 54 11) + , negativeTest "not a definition" (mkP 57 8) + , negativeTest "empty space" (mkP 59 7) + ] + where + mkP :: UInt -> UInt -> Position + mkP x1 y1 = Position x1 y1 + + mkR :: UInt -> UInt -> UInt -> UInt -> Range + mkR x1 y1 x2 y2 = Range (mkP x1 y1) (mkP x2 y2) + + getDefinition :: Show b => (Definition |? b) -> Range + getDefinition (InL (Definition (InL loc))) = loc^.L.range + getDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + + -- A positive test checks if the provided range is equal + -- to the expected range from the definition in the test file. + -- The test emulates a goto-definition request of an actual definition. + positiveTest :: TestName -> Position -> Range -> TestTree + positiveTest testName cursorPos expectedRange = + runCabalTestCaseSession testName "goto-definition" $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + definitions <- getDefinitions doc cursorPos + let locationRange = getDefinition definitions + liftIO $ locationRange @?= expectedRange + + -- A negative test checks if the request failed and + -- the provided result is empty, i.e. `InR $ InR Null`. + -- The test emulates a goto-definition request of anything but an + -- actual definition. + negativeTest :: TestName -> Position -> TestTree + negativeTest testName cursorPos = + runCabalTestCaseSession testName "goto-definition" $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + empty <- getDefinitions doc cursorPos + liftIO $ empty @?= (InR $ InR LSP.Null) diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal new file mode 100644 index 0000000000..c71e369b30 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal @@ -0,0 +1,62 @@ +cabal-version: 3.0 +name: simple-cabal +version: 0.1.0.0 +license: MIT + +-- Range : (6, 0) - (7, 22) +common warnings-0 + ghc-options: -Wall + +-- Range : (10, 0) - (17, 40) +common warnings-1 + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + + -Wno-name-shadowing + + -Wno-unticked-promoted-constructors + +-- Range : (20, 0) - (23, 34) +common warnings-2 + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + +library + + import: warnings-0 +-- ^ Position: (27, 16), middle of identifier + + import: warnings-1 +-- ^ Position: (30, 12), left of identifier + + import: warnings-2 +-- ^ Position: (33, 22), right of identifier + + import: warnings-0 +-- ^ Position: (36, 20), left of '-' in identifier + + import: warnings-1 +-- ^ Position: (39, 19), right of "-" in identifier + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (42, 16), identifier in identifier list + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (45, 33), left of ',' right of identifier + + import: warnings-2,warnings-1,warnings-0 +-- ^ Position: (48, 34), right of ',' left of identifier + + import: warnings-2, warnings-1,warnings-0 +-- ^ Position: (51, 37), right of ',' left of space + + import: warnings-0 +-- ^ Position: (54, 11), right of ':' left of space + + import: warnings-0 +-- ^ Position: (57, 8), not a definition + + -- EOL +-- ^ Position: (59, 7), empty space \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/hie.yaml b/plugins/hls-cabal-plugin/test/testdata/hie.yaml new file mode 100644 index 0000000000..95d800026a --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/hie.yaml @@ -0,0 +1,3 @@ +cradle: + direct: + arguments: [] \ No newline at end of file From 1bedad29187a322878ab85573ba037d39bdfe2ab Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 01:21:47 +0300 Subject: [PATCH 09/27] resolve merging issues --- .../src/Ide/Plugin/Cabal/Completion/CabalFields.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index a9d76516ca..65b58436be 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -327,10 +327,6 @@ onelineSectionArgs sectionArgs = joinedName getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string -<<<<<<< HEAD -======= - ->>>>>>> 6f6f75bc (Add Goto Definition for cabal common sections (#4375)) -- | Returns the end position of a provided field getFieldEndPosition :: Syntax.Field Syntax.Position -> Syntax.Position getFieldEndPosition (Syntax.Field name []) = getNameEndPosition name From bd72add1e4331b0cf33092660fde1ac402b2468c Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 01:36:14 +0300 Subject: [PATCH 10/27] resolve merging issues --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 6 +- .../Plugin/Cabal/Completion/CabalFields.hs | 64 ------------------- 2 files changed, 3 insertions(+), 67 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index f43439a3a0..daa6b523c4 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -323,8 +323,8 @@ gotoDefinition ideState _ msgParam = do pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection Nothing -> do - let mModuleNames = CabalFields.getModulesNames <$> mCabalFields - mModuleName = find (isModuleName cursorText) =<< mModuleNames + let moduleNames = CabalFields.getModulesNames cabalFields + mModuleName = find (isModuleName cursorText) moduleNames case mModuleName of Nothing -> pure $ InR $ InR Null Just (mBuildTargetNames, moduleName) -> do @@ -336,7 +336,7 @@ gotoDefinition ideState _ msgParam = do (flattenPackageDescription gpd)) mBuildTargetNames sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos - potentialPaths = map (\dir -> takeDirectory filePath dir toHaskellFile moduleName) sourceDirs + potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs allPaths <- liftIO $ filterM doesFileExist potentialPaths let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths case safeHead locations of -- We assume there could be only one source location diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 65b58436be..ed0bd8d8c5 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -124,70 +124,6 @@ findTextWord cursor fields = type FieldName = T.Text --- | Determine the field line the cursor is currently a part of. --- --- The result is said field line and its starting position --- or Nothing if the passed list of fields is empty. --- --- This function assumes that elements in a field's @FieldLine@ list --- do not share the same row. -findFieldLine :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.FieldLine Syntax.Position) -findFieldLine _cursor [] = Nothing -findFieldLine cursor fields = - case findFieldSection cursor fields of - Nothing -> Nothing - Just (Syntax.Field _ fieldLines) -> find filterLineFields fieldLines - Just (Syntax.Section _ _ fields) -> findFieldLine cursor fields - where - cursorLine = Syntax.positionRow cursor - -- In contrast to `Field` or `Section`, `FieldLine` must have the exact - -- same line position as the cursor. - filterLineFields (Syntax.FieldLine pos _) = Syntax.positionRow pos == cursorLine - --- | Determine the exact word at the current cursor position. --- --- The result is said word or Nothing if the passed list is empty --- or the cursor position is not next to, or on a word. --- For this function, a word is a sequence of consecutive characters --- that are not a space or column. --- --- This function currently only considers words inside of a @FieldLine@. -findTextWord :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe T.Text -findTextWord _cursor [] = Nothing -findTextWord cursor fields = - case findFieldLine cursor fields of - Nothing -> Nothing - Just (Syntax.FieldLine pos byteString) -> - let decodedText = T.decodeUtf8 byteString - lineFieldCol = Syntax.positionCol pos - lineFieldLen = T.length decodedText - offset = cursorCol - lineFieldCol in - -- Range check if cursor is inside or or next to found line. - -- The latter comparison includes the length of the line as offset, - -- which is done to also include cursors that are at the end of a line. - -- e.g. "foo,bar|" - -- ^ - -- cursor - -- - -- Having an offset which is outside of the line is possible because of `splitAt`. - if offset >= 0 && lineFieldLen >= offset - then - let (lhs, rhs) = T.splitAt offset decodedText - strippedLhs = T.takeWhileEnd isAllowedChar lhs - strippedRhs = T.takeWhile isAllowedChar rhs - resultText = T.concat [strippedLhs, strippedRhs] in - -- It could be possible that the cursor was in-between separators, in this - -- case the resulting text would be empty, which should result in `Nothing`. - -- e.g. " foo ,| bar" - -- ^ - -- cursor - if not $ T.null resultText then Just resultText else Nothing - else - Nothing - where - cursorCol = Syntax.positionCol cursor - separators = [',', ' '] - isAllowedChar = (`notElem` separators) getAnnotation :: Syntax.Field ann -> ann getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann From 3727a63a178aa31b3e9ca0e4c2a494c1be353eb9 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 01:55:20 +0300 Subject: [PATCH 11/27] rm error call --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index daa6b523c4..64ea0880fd 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -70,6 +70,7 @@ import qualified Language.LSP.VFS as VFS import System.Directory (doesFileExist) import System.FilePath (takeDirectory, ()) +import Ide.Plugin.Error data Log = LogModificationTime NormalizedFilePath FileVersion @@ -352,7 +353,7 @@ gotoDefinition ideState _ msgParam = do lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = case library of - Nothing -> error "Target is a main library but no main library was found" + Nothing -> [] -- Target is a main library but no main library was found Just (Library {libBuildInfo}) -> [libBuildInfo] lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = Maybe.catMaybes $ From b2e45e9b41cb4d8eb15dcabcec34d63c991e95ae Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 01:58:38 +0300 Subject: [PATCH 12/27] unnecessary parameter --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 64ea0880fd..e199a0f2f7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -357,37 +357,37 @@ gotoDefinition ideState _ msgParam = do Just (Library {libBuildInfo}) -> [libBuildInfo] lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = Maybe.catMaybes $ - map (\exec -> executableNameLookup exec buildTargetName) executables <> - map (\lib -> subLibraryNameLookup lib buildTargetName) subLibraries <> - map (\lib -> foreignLibsNameLookup lib buildTargetName) foreignLibs <> - map (\test -> testSuiteNameLookup test buildTargetName) testSuites <> - map (\bench -> benchmarkNameLookup bench buildTargetName) benchmarks + map executableNameLookup executables <> + map subLibraryNameLookup subLibraries <> + map foreignLibsNameLookup foreignLibs <> + map testSuiteNameLookup testSuites <> + map benchmarkNameLookup benchmarks where - executableNameLookup :: Executable -> T.Text -> Maybe BuildInfo - executableNameLookup (Executable {exeName, buildInfo}) buildTargetName = + executableNameLookup :: Executable -> Maybe BuildInfo + executableNameLookup (Executable {exeName, buildInfo}) = if T.pack (unUnqualComponentName exeName) == buildTargetName then Just buildInfo else Nothing - subLibraryNameLookup :: Library -> T.Text -> Maybe BuildInfo - subLibraryNameLookup (Library {libName, libBuildInfo}) buildTargetName = + subLibraryNameLookup :: Library -> Maybe BuildInfo + subLibraryNameLookup (Library {libName, libBuildInfo}) = case libName of (LSubLibName name) -> if T.pack (unUnqualComponentName name) == buildTargetName then Just libBuildInfo else Nothing LMainLibName -> Nothing - foreignLibsNameLookup :: ForeignLib -> T.Text -> Maybe BuildInfo - foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) buildTargetName = + foreignLibsNameLookup :: ForeignLib -> Maybe BuildInfo + foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) = if T.pack (unUnqualComponentName foreignLibName) == buildTargetName then Just foreignLibBuildInfo else Nothing - testSuiteNameLookup :: TestSuite -> T.Text -> Maybe BuildInfo - testSuiteNameLookup (TestSuite {testName, testBuildInfo}) buildTargetName = + testSuiteNameLookup :: TestSuite -> Maybe BuildInfo + testSuiteNameLookup (TestSuite {testName, testBuildInfo}) = if T.pack (unUnqualComponentName testName) == buildTargetName then Just testBuildInfo else Nothing - benchmarkNameLookup :: Benchmark -> T.Text -> Maybe BuildInfo - benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) buildTargetName = + benchmarkNameLookup :: Benchmark -> Maybe BuildInfo + benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) = if T.pack (unUnqualComponentName benchmarkName) == buildTargetName then Just benchmarkBuildInfo else Nothing From 766a3626bd3ff73362ec927922519e78ea479dfe Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 02:29:04 +0300 Subject: [PATCH 13/27] docs --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index e199a0f2f7..52dfd43e13 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -70,7 +70,6 @@ import qualified Language.LSP.VFS as VFS import System.Directory (doesFileExist) import System.FilePath (takeDirectory, ()) -import Ide.Plugin.Error data Log = LogModificationTime NormalizedFilePath FileVersion @@ -350,6 +349,11 @@ gotoDefinition ideState _ msgParam = do isSectionArgName _ _ = False isModuleName name (_, moduleName) = name == moduleName + -- | Gives all `buildInfo`s given a target name. + -- + -- `Maybe buildTargetName` is provided, and if it's + -- Nothing we assume, that it's a main library. + -- Otherwise looks for the provided name. lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = case library of @@ -392,8 +396,17 @@ gotoDefinition ideState _ msgParam = do then Just benchmarkBuildInfo else Nothing + -- | Converts a name of a module to a FilePath + -- Warning: Takes a lot of assumptions and generally + -- not advised to copy. + -- + -- Examples: (output is system dependent) + -- >>> toHaskellFile "My.Module.Lib" + -- "My/Module/Lib.hs" + -- >>> toHaskellFile "Main" + -- "Main.hs" toHaskellFile :: T.Text -> FilePath - toHaskellFile moduleName = foldl1 () (map T.unpack $ T.splitOn "." moduleName) ++ ".hs" + toHaskellFile moduleName = foldl () "" (map T.unpack $ T.splitOn "." moduleName) ++ ".hs" -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable From 8869d6ee4749d7191386e5c79a977843c96d63dc Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 19:03:39 +0300 Subject: [PATCH 14/27] first test --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 4 +- plugins/hls-cabal-plugin/test/Main.hs | 72 ++++++++++++------- .../simple-with-common.cabal | 0 3 files changed, 50 insertions(+), 26 deletions(-) rename plugins/hls-cabal-plugin/test/testdata/goto-definition/{ => common-section}/simple-with-common.cabal (100%) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 52dfd43e13..7708dcdf6a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -69,7 +69,7 @@ import Language.LSP.Protocol.Types import qualified Language.LSP.VFS as VFS import System.Directory (doesFileExist) import System.FilePath (takeDirectory, - ()) + (), (<.>), joinPath) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -406,7 +406,7 @@ gotoDefinition ideState _ msgParam = do -- >>> toHaskellFile "Main" -- "Main.hs" toHaskellFile :: T.Text -> FilePath - toHaskellFile moduleName = foldl () "" (map T.unpack $ T.splitOn "." moduleName) ++ ".hs" + toHaskellFile moduleName = joinPath (map T.unpack $ T.splitOn "." moduleName) <.> ".hs" -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 2009352bbd..aa9f72c43e 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -13,7 +13,7 @@ import Control.Lens.Fold ((^?)) import Control.Monad (guard) import qualified Data.ByteString as BS import Data.Either (isRight) -import Data.List.Extra (nubOrdOn) +import Data.List.Extra (nubOrdOn, isSuffixOf) import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text as Text @@ -236,41 +236,65 @@ codeActionTests = testGroup "Code Actions" gotoDefinitionTests :: TestTree gotoDefinitionTests = testGroup "Goto Definition" - [ positiveTest "middle of identifier" (mkP 27 16) (mkR 6 0 7 22) - , positiveTest "left of identifier" (mkP 30 12) (mkR 10 0 17 40) - , positiveTest "right of identifier" (mkP 33 22) (mkR 20 0 23 34) - , positiveTest "left of '-' in identifier" (mkP 36 20) (mkR 6 0 7 22) - , positiveTest "right of '-' in identifier" (mkP 39 19) (mkR 10 0 17 40) - , positiveTest "identifier in identifier list" (mkP 42 16) (mkR 20 0 23 34) - , positiveTest "left of ',' right of identifier" (mkP 45 33) (mkR 10 0 17 40) - , positiveTest "right of ',' left of identifier" (mkP 48 34) (mkR 6 0 7 22) + [ gotoCommonSectionDefinitionTests + , gotoModuleDefinitionTests + ] - , negativeTest "right of ',' left of space" (mkP 51 23) - , negativeTest "right of ':' left of space" (mkP 54 11) - , negativeTest "not a definition" (mkP 57 8) - , negativeTest "empty space" (mkP 59 7) +gotoModuleDefinitionTests :: TestTree +gotoModuleDefinitionTests = testGroup "Goto Module Definition" + [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" (Position 8 23) "A.hs" ] where - mkP :: UInt -> UInt -> Position - mkP x1 y1 = Position x1 y1 + getUriFromDefinition :: Show b => (Definition |? b) -> Uri + getUriFromDefinition (InL (Definition (InL loc))) = loc^.L.uri + getUriFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + + testGoToDefinitionLink :: TestName -> FilePath -> FilePath -> Position -> FilePath -> TestTree + testGoToDefinitionLink testName testDir cabalFile cursorPos expectedFilePath = + runCabalTestCaseSession testName testDir $ do + doc <- openDoc cabalFile "cabal" + definitions <- getDefinitions doc cursorPos + let uri = getUriFromDefinition definitions + mFilePath = (testDir ) <$> uriToFilePath uri + case mFilePath of + Nothing -> error $ "Not possible to convert Uri " <> show uri <> " to FilePath" + Just filePath -> do + let filePathWithDir = testDir expectedFilePath + isCorrectPath = filePathWithDir `isSuffixOf` filePath + liftIO $ isCorrectPath @? ("Absolute path expected to end on " <> filePathWithDir <> + " but " <> filePath <> " was given.") - mkR :: UInt -> UInt -> UInt -> UInt -> Range - mkR x1 y1 x2 y2 = Range (mkP x1 y1) (mkP x2 y2) +gotoCommonSectionDefinitionTests :: TestTree +gotoCommonSectionDefinitionTests = testGroup "Goto Common Section Definition" + [ positiveTest "middle of identifier" (Position 27 16) (mkRange 6 0 7 22) + , positiveTest "left of identifier" (Position 30 12) (mkRange 10 0 17 40) + , positiveTest "right of identifier" (Position 33 22) (mkRange 20 0 23 34) + , positiveTest "left of '-' in identifier" (Position 36 20) (mkRange 6 0 7 22) + , positiveTest "right of '-' in identifier" (Position 39 19) (mkRange 10 0 17 40) + , positiveTest "identifier in identifier list" (Position 42 16) (mkRange 20 0 23 34) + , positiveTest "left of ',' right of identifier" (Position 45 33) (mkRange 10 0 17 40) + , positiveTest "right of ',' left of identifier" (Position 48 34) (mkRange 6 0 7 22) - getDefinition :: Show b => (Definition |? b) -> Range - getDefinition (InL (Definition (InL loc))) = loc^.L.range - getDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + , negativeTest "right of ',' left of space" (Position 51 23) + , negativeTest "right of ':' left of space" (Position 54 11) + , negativeTest "not a definition" (Position 57 8) + , negativeTest "empty space" (Position 59 7) + ] + where + getRangeFromDefinition :: Show b => (Definition |? b) -> Range + getRangeFromDefinition (InL (Definition (InL loc))) = loc^.L.range + getRangeFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" -- A positive test checks if the provided range is equal -- to the expected range from the definition in the test file. -- The test emulates a goto-definition request of an actual definition. positiveTest :: TestName -> Position -> Range -> TestTree positiveTest testName cursorPos expectedRange = - runCabalTestCaseSession testName "goto-definition" $ do + runCabalTestCaseSession testName ("goto-definition" "common-section") $ do doc <- openDoc "simple-with-common.cabal" "cabal" definitions <- getDefinitions doc cursorPos - let locationRange = getDefinition definitions - liftIO $ locationRange @?= expectedRange + let range = getRangeFromDefinition definitions + liftIO $ range @?= expectedRange -- A negative test checks if the request failed and -- the provided result is empty, i.e. `InR $ InR Null`. @@ -278,7 +302,7 @@ gotoDefinitionTests = testGroup "Goto Definition" -- actual definition. negativeTest :: TestName -> Position -> TestTree negativeTest testName cursorPos = - runCabalTestCaseSession testName "goto-definition" $ do + runCabalTestCaseSession testName ("goto-definition" "common-section") $ do doc <- openDoc "simple-with-common.cabal" "cabal" empty <- getDefinitions doc cursorPos liftIO $ empty @?= (InR $ InR LSP.Null) diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/common-section/simple-with-common.cabal similarity index 100% rename from plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal rename to plugins/hls-cabal-plugin/test/testdata/goto-definition/common-section/simple-with-common.cabal From a9470bd714122f1652cfcc793dbff8b73f313c03 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 19:26:02 +0300 Subject: [PATCH 15/27] + test data --- .../modules/module-examples.cabal | 35 +++++++++++++++++++ .../modules/src/Library/Lib.hs | 1 + .../modules/src/Library/Other/OtherLib.hs | 1 + .../modules/src/bench/Config.hs | 1 + .../goto-definition/modules/src/bench/Main.hs | 3 ++ .../goto-definition/modules/src/exe/Config.hs | 1 + .../goto-definition/modules/src/exe/Main.hs | 3 ++ .../modules/src/test/Config.hs | 1 + .../modules/src/test/Library.hs | 1 + .../goto-definition/modules/src/test/Main.hs | 0 10 files changed, 47 insertions(+) create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Lib.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Other/OtherLib.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Config.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Config.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Main.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Config.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Library.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Main.hs diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal new file mode 100644 index 0000000000..2f31e2561b --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal @@ -0,0 +1,35 @@ +cabal-version: 3.0 +name: module-examples +version: 0.1.0.0 + + +library + exposed-modules: Library.Lib + other-modules: Library.Other.OtherLib + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + +executable exec + hs-source-dirs: src/exe + main-is: Main.hs + build-depends: base + other-modules: + Config + +test-suite module-examples-test + type: exitcode-stdio-1.0 + hs-source-dirs: src/test + main-is: Main.hs + other-modules: + Config + Library + build-depends: base + +benchmark benchmark + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: src/bench + build-depends: base + other-modules: + Config diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Lib.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Lib.hs new file mode 100644 index 0000000000..e2cde3780b --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Lib.hs @@ -0,0 +1 @@ +module Library.Lib where diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Other/OtherLib.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Other/OtherLib.hs new file mode 100644 index 0000000000..625be777dc --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/Library/Other/OtherLib.hs @@ -0,0 +1 @@ +module Library.Other.OtherLib where diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Config.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Config.hs new file mode 100644 index 0000000000..6ea268c214 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Config.hs @@ -0,0 +1 @@ +module Config where diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Main.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Main.hs new file mode 100644 index 0000000000..6640b61707 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/bench/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = undefined \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Config.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Config.hs new file mode 100644 index 0000000000..3a2489708e --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Config.hs @@ -0,0 +1 @@ +module Confing where \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Main.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Main.hs new file mode 100644 index 0000000000..6640b61707 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/exe/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = undefined \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Config.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Config.hs new file mode 100644 index 0000000000..39e39fc16a --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Config.hs @@ -0,0 +1 @@ +module Config where \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Library.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Library.hs new file mode 100644 index 0000000000..7899749de8 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Library.hs @@ -0,0 +1 @@ +module Library where \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Main.hs b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/src/test/Main.hs new file mode 100644 index 0000000000..e69de29bb2 From d77f87948370e4b69d70a9deafa1fa2aee4772a0 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 19:37:50 +0300 Subject: [PATCH 16/27] + test data --- plugins/hls-cabal-plugin/test/Main.hs | 5 ++++- .../goto-definition/modules/module-examples.cabal | 15 ++++++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index aa9f72c43e..8d3a377016 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -242,7 +242,10 @@ gotoDefinitionTests = testGroup "Goto Definition" gotoModuleDefinitionTests :: TestTree gotoModuleDefinitionTests = testGroup "Goto Module Definition" - [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" (Position 8 23) "A.hs" + [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" + (Position 8 23) "A.hs" + , testGoToDefinitionLink "simple cabal test" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 22) "A.hs" ] where getUriFromDefinition :: Show b => (Definition |? b) -> Uri diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal index 2f31e2561b..b430d3b2c9 100644 --- a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal @@ -5,7 +5,12 @@ version: 0.1.0.0 library exposed-modules: Library.Lib +-- ^ Position: (6, 22) +-- ^ Position: (6, 33) other-modules: Library.Other.OtherLib +-- ^ Position: (6, 22) +-- ^ Position: (6, 44) + build-depends: base hs-source-dirs: src default-language: Haskell2010 @@ -16,6 +21,8 @@ executable exec build-depends: base other-modules: Config +-- ^ Position: (22, 8) +-- ^ Position: (22, 14) test-suite module-examples-test type: exitcode-stdio-1.0 @@ -23,7 +30,11 @@ test-suite module-examples-test main-is: Main.hs other-modules: Config +-- ^ Position: (31, 8) +-- ^ Position: (31, 14) Library +-- ^ Position: (31, 8) +-- ^ Position: (31, 15) build-depends: base benchmark benchmark @@ -32,4 +43,6 @@ benchmark benchmark hs-source-dirs: src/bench build-depends: base other-modules: - Config + Config +-- ^ Position: (45, 28) +-- ^ Position: (45, 34) \ No newline at end of file From f834e47eef54033aa3c10b4bbff178d11933a90c Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 19:54:52 +0300 Subject: [PATCH 17/27] Definition module --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 109 +---------- .../src/Ide/Plugin/Cabal/Definition.hs | 179 ++++++++++++++++++ plugins/hls-cabal-plugin/test/Main.hs | 15 +- .../modules/module-examples.cabal | 4 +- 5 files changed, 195 insertions(+), 113 deletions(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c79d714fc3..d054c32485 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -242,6 +242,7 @@ library hls-cabal-plugin Ide.Plugin.Cabal.Completion.Completions Ide.Plugin.Cabal.Completion.Data Ide.Plugin.Cabal.Completion.Types + Ide.Plugin.Cabal.Definition Ide.Plugin.Cabal.FieldSuggest Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Orphans diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 7708dcdf6a..504c0fb3b8 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -70,6 +70,7 @@ import qualified Language.LSP.VFS as VFS import System.Directory (doesFileExist) import System.FilePath (takeDirectory, (), (<.>), joinPath) +import Ide.Plugin.Cabal.Definition (gotoDefinition) data Log = LogModificationTime NormalizedFilePath FileVersion @@ -300,114 +301,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range - --- | CodeActions for going to definitions. --- --- Provides a CodeAction for going to a definition when clicking on an identifier --- and clicking on exposed-module or other-module field. --- The definition is found by traversing the sections and comparing their name to --- the clicked identifier. If it's not in sections it attempts to find it in module names. --- --- TODO: Resolve more cases for go-to definition. -gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition -gotoDefinition ideState _ msgParam = do - nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp - case CabalFields.findTextWord cursor cabalFields of - Nothing -> - pure $ InR $ InR Null - Just cursorText -> do - commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp - case find (isSectionArgName cursorText) commonSections of - Just commonSection -> do - pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection - - Nothing -> do - let moduleNames = CabalFields.getModulesNames cabalFields - mModuleName = find (isModuleName cursorText) moduleNames - case mModuleName of - Nothing -> pure $ InR $ InR Null - Just (mBuildTargetNames, moduleName) -> do - mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile nfp - case mGPD of - Nothing -> pure $ InR $ InR Null - Just (gpd, _) -> do - let buildInfos = foldMap (lookupBuildTargetPackageDescription - (flattenPackageDescription gpd)) - mBuildTargetNames - sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos - potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs - allPaths <- liftIO $ filterM doesFileExist potentialPaths - let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths - case safeHead locations of -- We assume there could be only one source location - Nothing -> pure $ InR $ InR Null - Just location -> pure $ InL $ Definition $ InL location - where - cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) - uri = msgParam ^. JL.textDocument . JL.uri - isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName - isSectionArgName _ _ = False - isModuleName name (_, moduleName) = name == moduleName - - -- | Gives all `buildInfo`s given a target name. - -- - -- `Maybe buildTargetName` is provided, and if it's - -- Nothing we assume, that it's a main library. - -- Otherwise looks for the provided name. - lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] - lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = - case library of - Nothing -> [] -- Target is a main library but no main library was found - Just (Library {libBuildInfo}) -> [libBuildInfo] - lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = - Maybe.catMaybes $ - map executableNameLookup executables <> - map subLibraryNameLookup subLibraries <> - map foreignLibsNameLookup foreignLibs <> - map testSuiteNameLookup testSuites <> - map benchmarkNameLookup benchmarks - where - executableNameLookup :: Executable -> Maybe BuildInfo - executableNameLookup (Executable {exeName, buildInfo}) = - if T.pack (unUnqualComponentName exeName) == buildTargetName - then Just buildInfo - else Nothing - subLibraryNameLookup :: Library -> Maybe BuildInfo - subLibraryNameLookup (Library {libName, libBuildInfo}) = - case libName of - (LSubLibName name) -> - if T.pack (unUnqualComponentName name) == buildTargetName - then Just libBuildInfo - else Nothing - LMainLibName -> Nothing - foreignLibsNameLookup :: ForeignLib -> Maybe BuildInfo - foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) = - if T.pack (unUnqualComponentName foreignLibName) == buildTargetName - then Just foreignLibBuildInfo - else Nothing - testSuiteNameLookup :: TestSuite -> Maybe BuildInfo - testSuiteNameLookup (TestSuite {testName, testBuildInfo}) = - if T.pack (unUnqualComponentName testName) == buildTargetName - then Just testBuildInfo - else Nothing - benchmarkNameLookup :: Benchmark -> Maybe BuildInfo - benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) = - if T.pack (unUnqualComponentName benchmarkName) == buildTargetName - then Just benchmarkBuildInfo - else Nothing - - -- | Converts a name of a module to a FilePath - -- Warning: Takes a lot of assumptions and generally - -- not advised to copy. - -- - -- Examples: (output is system dependent) - -- >>> toHaskellFile "My.Module.Lib" - -- "My/Module/Lib.hs" - -- >>> toHaskellFile "Main" - -- "Main.hs" - toHaskellFile :: T.Text -> FilePath - toHaskellFile moduleName = joinPath (map T.unpack $ T.splitOn "." moduleName) <.> ".hs" - -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs new file mode 100644 index 0000000000..e69e863b02 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Ide.Plugin.Cabal.Definition where + +import Control.Concurrent.Strict +import Control.DeepSeq +import Control.Lens ((^.)) +import Control.Monad.Extra +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.ByteString as BS +import Data.Hashable +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.List (find) +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as Encoding +import Data.Typeable +import Development.IDE as D +import Development.IDE.Core.PluginUtils +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key, + alwaysRerun) +import qualified Development.IDE.Plugin.Completions.Logic as Ghcide +import Development.IDE.Types.Shake (toKey) +import qualified Distribution.Fields as Syntax +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + Executable (..), + ForeignLib (..), + Library (..), + LibraryName (LMainLibName, LSubLibName), + PackageDescription (..), + TestSuite (..), + library, + unUnqualComponentName) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import qualified Distribution.Parsec.Position as Syntax +import Distribution.Utils.Generic (safeHead) +import Distribution.Utils.Path (getSymbolicPath) +import GHC.Generics +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 qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest +import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest +import Ide.Plugin.Cabal.Orphans () +import Ide.Plugin.Cabal.Outline +import qualified Ide.Plugin.Cabal.Parse as Parse +import Ide.Plugin.Error +import Ide.Types +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 System.Directory (doesFileExist) +import System.FilePath (takeDirectory, + (), (<.>), joinPath) + +-- | CodeActions for going to definitions. +-- +-- Provides a CodeAction for going to a definition when clicking on an identifier +-- and clicking on exposed-module or other-module field. +-- The definition is found by traversing the sections and comparing their name to +-- the clicked identifier. If it's not in sections it attempts to find it in module names. +-- +-- TODO: Resolve more cases for go-to definition. +gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition +gotoDefinition ideState _ msgParam = do + nfp <- getNormalizedFilePathE uri + cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp + case CabalFields.findTextWord cursor cabalFields of + Nothing -> + pure $ InR $ InR Null + Just cursorText -> do + commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp + case find (isSectionArgName cursorText) commonSections of + Just commonSection -> do + pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + + Nothing -> do + let moduleNames = CabalFields.getModulesNames cabalFields + mModuleName = find (isModuleName cursorText) moduleNames + case mModuleName of + Nothing -> pure $ InR $ InR Null + Just (mBuildTargetNames, moduleName) -> do + mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile nfp + case mGPD of + Nothing -> pure $ InR $ InR Null + Just (gpd, _) -> do + let buildInfos = foldMap (lookupBuildTargetPackageDescription + (flattenPackageDescription gpd)) + mBuildTargetNames + sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos + potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs + allPaths <- liftIO $ filterM doesFileExist potentialPaths + let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths + case safeHead locations of -- We assume there could be only one source location + Nothing -> pure $ InR $ InR Null + Just location -> pure $ InL $ Definition $ InL location + where + cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) + uri = msgParam ^. JL.textDocument . JL.uri + isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName + isSectionArgName _ _ = False + isModuleName name (_, moduleName) = name == moduleName + +-- | Gives all `buildInfo`s given a target name. +-- +-- `Maybe buildTargetName` is provided, and if it's +-- Nothing we assume, that it's a main library. +-- Otherwise looks for the provided name. +lookupBuildTargetPackageDescription :: PackageDescription -> Maybe T.Text -> [BuildInfo] +lookupBuildTargetPackageDescription (PackageDescription {..}) Nothing = + case library of + Nothing -> [] -- Target is a main library but no main library was found + Just (Library {libBuildInfo}) -> [libBuildInfo] +lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetName) = + Maybe.catMaybes $ + map executableNameLookup executables <> + map subLibraryNameLookup subLibraries <> + map foreignLibsNameLookup foreignLibs <> + map testSuiteNameLookup testSuites <> + map benchmarkNameLookup benchmarks + where + executableNameLookup :: Executable -> Maybe BuildInfo + executableNameLookup (Executable {exeName, buildInfo}) = + if T.pack (unUnqualComponentName exeName) == buildTargetName + then Just buildInfo + else Nothing + subLibraryNameLookup :: Library -> Maybe BuildInfo + subLibraryNameLookup (Library {libName, libBuildInfo}) = + case libName of + (LSubLibName name) -> + if T.pack (unUnqualComponentName name) == buildTargetName + then Just libBuildInfo + else Nothing + LMainLibName -> Nothing + foreignLibsNameLookup :: ForeignLib -> Maybe BuildInfo + foreignLibsNameLookup (ForeignLib {foreignLibName, foreignLibBuildInfo}) = + if T.pack (unUnqualComponentName foreignLibName) == buildTargetName + then Just foreignLibBuildInfo + else Nothing + testSuiteNameLookup :: TestSuite -> Maybe BuildInfo + testSuiteNameLookup (TestSuite {testName, testBuildInfo}) = + if T.pack (unUnqualComponentName testName) == buildTargetName + then Just testBuildInfo + else Nothing + benchmarkNameLookup :: Benchmark -> Maybe BuildInfo + benchmarkNameLookup (Benchmark {benchmarkName, benchmarkBuildInfo}) = + if T.pack (unUnqualComponentName benchmarkName) == buildTargetName + then Just benchmarkBuildInfo + else Nothing + +-- | Converts a name of a module to a FilePath +-- Warning: Takes a lot of assumptions and generally +-- not advised to copy. +-- +-- Examples: (output is system dependent) +-- >>> toHaskellFile "My.Module.Lib" +-- "My/Module/Lib.hs" +-- >>> toHaskellFile "Main" +-- "Main.hs" +toHaskellFile :: T.Text -> FilePath +toHaskellFile moduleName = joinPath (map T.unpack $ T.splitOn "." moduleName) <.> ".hs" \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 8d3a377016..65cd3cd94e 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -243,9 +243,18 @@ gotoDefinitionTests = testGroup "Goto Definition" gotoModuleDefinitionTests :: TestTree gotoModuleDefinitionTests = testGroup "Goto Module Definition" [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" - (Position 8 23) "A.hs" - , testGoToDefinitionLink "simple cabal test" ("goto-definition" "modules") "module-examples.cabal" - (Position 6 22) "A.hs" + (Position 8 23) "A.hs" + + , testGoToDefinitionLink "library start of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 22) "src/Library/Lib.hs" + , testGoToDefinitionLink "library end of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 33) "src/Library/Lib.hs" + + , testGoToDefinitionLink "library start of other-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 9 22) "src/Library/Other/OtherLib.hs" + , testGoToDefinitionLink "library end of other-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 9 44) "src/Library/Other/OtherLib.hs" + ] where getUriFromDefinition :: Show b => (Definition |? b) -> Uri diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal index b430d3b2c9..28bba540b9 100644 --- a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal @@ -8,8 +8,8 @@ library -- ^ Position: (6, 22) -- ^ Position: (6, 33) other-modules: Library.Other.OtherLib --- ^ Position: (6, 22) --- ^ Position: (6, 44) +-- ^ Position: (9, 22) +-- ^ Position: (9, 44) build-depends: base hs-source-dirs: src From 901adc0d118d8b769045d23ad16a2ebc66be44b9 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 20:04:41 +0300 Subject: [PATCH 18/27] formattings --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 86 +++++++------------ .../src/Ide/Plugin/Cabal/Definition.hs | 35 +------- 2 files changed, 36 insertions(+), 85 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 504c0fb3b8..9de52066cb 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -2,75 +2,53 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal (descriptor, Log (..)) where import Control.Concurrent.Strict import Control.DeepSeq -import Control.Lens ((^.)) +import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.ByteString as BS import Data.Hashable -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.List (find) -import qualified Data.List.NonEmpty as NE -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as Encoding +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.List.NonEmpty as NE +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Text.Encoding as Encoding import Data.Typeable -import Development.IDE as D -import Development.IDE.Core.PluginUtils -import Development.IDE.Core.Shake (restartShakeSession) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph (Key, - alwaysRerun) -import qualified Development.IDE.Plugin.Completions.Logic as Ghcide -import Development.IDE.Types.Shake (toKey) -import qualified Distribution.Fields as Syntax -import Distribution.PackageDescription (Benchmark (..), - BuildInfo (..), - Executable (..), - ForeignLib (..), - Library (..), - LibraryName (LMainLibName, LSubLibName), - PackageDescription (..), - TestSuite (..), - library, - unUnqualComponentName) -import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import qualified Distribution.Parsec.Position as Syntax -import Distribution.Utils.Generic (safeHead) -import Distribution.Utils.Path (getSymbolicPath) +import Development.IDE as D +import Development.IDE.Core.Shake (restartShakeSession) +import qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Graph (Key, alwaysRerun) +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 GHC.Generics -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 qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics -import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest -import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest -import Ide.Plugin.Cabal.Orphans () +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.Diagnostics as Diagnostics +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest +import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest +import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline -import qualified Ide.Plugin.Cabal.Parse as Parse -import Ide.Plugin.Error +import qualified Ide.Plugin.Cabal.Parse as Parse 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 System.Directory (doesFileExist) -import System.FilePath (takeDirectory, - (), (<.>), joinPath) -import Ide.Plugin.Cabal.Definition (gotoDefinition) +import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath FileVersion diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index e69e863b02..2f6017bf42 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -1,37 +1,19 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal.Definition where -import Control.Concurrent.Strict -import Control.DeepSeq import Control.Lens ((^.)) import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS -import Data.Hashable -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap import Data.List (find) -import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe import qualified Data.Text as T -import qualified Data.Text.Encoding as Encoding -import Data.Typeable import Development.IDE as D import Development.IDE.Core.PluginUtils -import Development.IDE.Core.Shake (restartShakeSession) -import qualified Development.IDE.Core.Shake as Shake -import Development.IDE.Graph (Key, - alwaysRerun) -import qualified Development.IDE.Plugin.Completions.Logic as Ghcide -import Development.IDE.Types.Shake (toKey) import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (Benchmark (..), BuildInfo (..), @@ -44,32 +26,23 @@ import Distribution.PackageDescription (Benchmark (..), library, unUnqualComponentName) import Distribution.PackageDescription.Configuration (flattenPackageDescription) -import qualified Distribution.Parsec.Position as Syntax import Distribution.Utils.Generic (safeHead) import Distribution.Utils.Path (getSymbolicPath) -import GHC.Generics 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 qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics -import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest -import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () -import Ide.Plugin.Cabal.Outline -import qualified Ide.Plugin.Cabal.Parse as Parse import Ide.Plugin.Error import Ide.Types 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 System.Directory (doesFileExist) -import System.FilePath (takeDirectory, - (), (<.>), joinPath) +import System.FilePath (joinPath, + takeDirectory, + (<.>), ()) -- | CodeActions for going to definitions. -- @@ -176,4 +149,4 @@ lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetN -- >>> toHaskellFile "Main" -- "Main.hs" toHaskellFile :: T.Text -> FilePath -toHaskellFile moduleName = joinPath (map T.unpack $ T.splitOn "." moduleName) <.> ".hs" \ No newline at end of file +toHaskellFile moduleName = joinPath (map T.unpack $ T.splitOn "." moduleName) <.> ".hs" From 5d149f4462b7768f3d51c412a01b74d05ddb77af Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 19 Aug 2024 20:20:13 +0300 Subject: [PATCH 19/27] separate test file --- haskell-language-server.cabal | 3 +- .../src/Ide/Plugin/Cabal/Definition.hs | 2 +- plugins/hls-cabal-plugin/test/Definition.hs | 99 +++++++++++++++++++ plugins/hls-cabal-plugin/test/Main.hs | 93 +---------------- 4 files changed, 104 insertions(+), 93 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/Definition.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d054c32485..5957115ce2 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -283,8 +283,9 @@ test-suite hls-cabal-plugin-tests other-modules: Completer Context - Utils + Definition Outline + Utils build-depends: , base , bytestring diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 2f6017bf42..c470b95c59 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -141,7 +141,7 @@ lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetN -- | Converts a name of a module to a FilePath -- Warning: Takes a lot of assumptions and generally --- not advised to copy. +-- not advised to use. -- -- Examples: (output is system dependent) -- >>> toHaskellFile "My.Module.Lib" diff --git a/plugins/hls-cabal-plugin/test/Definition.hs b/plugins/hls-cabal-plugin/test/Definition.hs new file mode 100644 index 0000000000..ec9913b17b --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Definition.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Definition ( + gotoDefinitionTests, +) where + +import Control.Lens ((^.)) +import Data.List.Extra (isSuffixOf) +import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Types as LSP +import System.FilePath +import Test.Hls +import Utils + + +gotoDefinitionTests :: TestTree +gotoDefinitionTests = testGroup "Goto Definition" + [ gotoCommonSectionDefinitionTests + , gotoModuleDefinitionTests + ] + +gotoModuleDefinitionTests :: TestTree +gotoModuleDefinitionTests = testGroup "Goto Module Definition" + [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" + (Position 8 23) "A.hs" + + , testGoToDefinitionLink "library start of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 22) "src/Library/Lib.hs" + , testGoToDefinitionLink "library end of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 33) "src/Library/Lib.hs" + + , testGoToDefinitionLink "library start of other-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 9 22) "src/Library/Other/OtherLib.hs" + , testGoToDefinitionLink "library end of other-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 9 44) "src/Library/Other/OtherLib.hs" + + ] + where + getUriFromDefinition :: Show b => (Definition |? b) -> Uri + getUriFromDefinition (InL (Definition (InL loc))) = loc^.L.uri + getUriFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + + testGoToDefinitionLink :: TestName -> FilePath -> FilePath -> Position -> FilePath -> TestTree + testGoToDefinitionLink testName testDir cabalFile cursorPos expectedFilePath = + runCabalTestCaseSession testName testDir $ do + doc <- openDoc cabalFile "cabal" + definitions <- getDefinitions doc cursorPos + let uri = getUriFromDefinition definitions + mFilePath = (testDir ) <$> uriToFilePath uri + case mFilePath of + Nothing -> error $ "Not possible to convert Uri " <> show uri <> " to FilePath" + Just filePath -> do + let filePathWithDir = testDir expectedFilePath + isCorrectPath = filePathWithDir `isSuffixOf` filePath + liftIO $ isCorrectPath @? ("Absolute path expected to end on " <> filePathWithDir <> + " but " <> filePath <> " was given.") + +gotoCommonSectionDefinitionTests :: TestTree +gotoCommonSectionDefinitionTests = testGroup "Goto Common Section Definition" + [ positiveTest "middle of identifier" (Position 27 16) (mkRange 6 0 7 22) + , positiveTest "left of identifier" (Position 30 12) (mkRange 10 0 17 40) + , positiveTest "right of identifier" (Position 33 22) (mkRange 20 0 23 34) + , positiveTest "left of '-' in identifier" (Position 36 20) (mkRange 6 0 7 22) + , positiveTest "right of '-' in identifier" (Position 39 19) (mkRange 10 0 17 40) + , positiveTest "identifier in identifier list" (Position 42 16) (mkRange 20 0 23 34) + , positiveTest "left of ',' right of identifier" (Position 45 33) (mkRange 10 0 17 40) + , positiveTest "right of ',' left of identifier" (Position 48 34) (mkRange 6 0 7 22) + + , negativeTest "right of ',' left of space" (Position 51 23) + , negativeTest "right of ':' left of space" (Position 54 11) + , negativeTest "not a definition" (Position 57 8) + , negativeTest "empty space" (Position 59 7) + ] + where + getRangeFromDefinition :: Show b => (Definition |? b) -> Range + getRangeFromDefinition (InL (Definition (InL loc))) = loc^.L.range + getRangeFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" + + -- A positive test checks if the provided range is equal + -- to the expected range from the definition in the test file. + -- The test emulates a goto-definition request of an actual definition. + positiveTest :: TestName -> Position -> Range -> TestTree + positiveTest testName cursorPos expectedRange = + runCabalTestCaseSession testName ("goto-definition" "common-section") $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + definitions <- getDefinitions doc cursorPos + let range = getRangeFromDefinition definitions + liftIO $ range @?= expectedRange + + -- A negative test checks if the request failed and + -- the provided result is empty, i.e. `InR $ InR Null`. + -- The test emulates a goto-definition request of anything but an + -- actual definition. + negativeTest :: TestName -> Position -> TestTree + negativeTest testName cursorPos = + runCabalTestCaseSession testName ("goto-definition" "common-section") $ do + doc <- openDoc "simple-with-common.cabal" "cabal" + empty <- getDefinitions doc cursorPos + liftIO $ empty @?= (InR $ InR LSP.Null) diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 65cd3cd94e..c6383ab393 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -13,14 +13,14 @@ import Control.Lens.Fold ((^?)) import Control.Monad (guard) import qualified Data.ByteString as BS import Data.Either (isRight) -import Data.List.Extra (nubOrdOn, isSuffixOf) +import Data.List.Extra (nubOrdOn) import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text as Text +import Definition (gotoDefinitionTests) import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L -import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) import System.FilePath import Test.Hls @@ -229,92 +229,3 @@ codeActionTests = testGroup "Code Actions" InR action@CodeAction{_title} <- codeActions guard (_title == "Replace with " <> license) pure action - --- ---------------------------------------------------------------------------- --- Goto Definition Tests --- ---------------------------------------------------------------------------- - -gotoDefinitionTests :: TestTree -gotoDefinitionTests = testGroup "Goto Definition" - [ gotoCommonSectionDefinitionTests - , gotoModuleDefinitionTests - ] - -gotoModuleDefinitionTests :: TestTree -gotoModuleDefinitionTests = testGroup "Goto Module Definition" - [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" - (Position 8 23) "A.hs" - - , testGoToDefinitionLink "library start of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 6 22) "src/Library/Lib.hs" - , testGoToDefinitionLink "library end of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 6 33) "src/Library/Lib.hs" - - , testGoToDefinitionLink "library start of other-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 9 22) "src/Library/Other/OtherLib.hs" - , testGoToDefinitionLink "library end of other-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 9 44) "src/Library/Other/OtherLib.hs" - - ] - where - getUriFromDefinition :: Show b => (Definition |? b) -> Uri - getUriFromDefinition (InL (Definition (InL loc))) = loc^.L.uri - getUriFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" - - testGoToDefinitionLink :: TestName -> FilePath -> FilePath -> Position -> FilePath -> TestTree - testGoToDefinitionLink testName testDir cabalFile cursorPos expectedFilePath = - runCabalTestCaseSession testName testDir $ do - doc <- openDoc cabalFile "cabal" - definitions <- getDefinitions doc cursorPos - let uri = getUriFromDefinition definitions - mFilePath = (testDir ) <$> uriToFilePath uri - case mFilePath of - Nothing -> error $ "Not possible to convert Uri " <> show uri <> " to FilePath" - Just filePath -> do - let filePathWithDir = testDir expectedFilePath - isCorrectPath = filePathWithDir `isSuffixOf` filePath - liftIO $ isCorrectPath @? ("Absolute path expected to end on " <> filePathWithDir <> - " but " <> filePath <> " was given.") - -gotoCommonSectionDefinitionTests :: TestTree -gotoCommonSectionDefinitionTests = testGroup "Goto Common Section Definition" - [ positiveTest "middle of identifier" (Position 27 16) (mkRange 6 0 7 22) - , positiveTest "left of identifier" (Position 30 12) (mkRange 10 0 17 40) - , positiveTest "right of identifier" (Position 33 22) (mkRange 20 0 23 34) - , positiveTest "left of '-' in identifier" (Position 36 20) (mkRange 6 0 7 22) - , positiveTest "right of '-' in identifier" (Position 39 19) (mkRange 10 0 17 40) - , positiveTest "identifier in identifier list" (Position 42 16) (mkRange 20 0 23 34) - , positiveTest "left of ',' right of identifier" (Position 45 33) (mkRange 10 0 17 40) - , positiveTest "right of ',' left of identifier" (Position 48 34) (mkRange 6 0 7 22) - - , negativeTest "right of ',' left of space" (Position 51 23) - , negativeTest "right of ':' left of space" (Position 54 11) - , negativeTest "not a definition" (Position 57 8) - , negativeTest "empty space" (Position 59 7) - ] - where - getRangeFromDefinition :: Show b => (Definition |? b) -> Range - getRangeFromDefinition (InL (Definition (InL loc))) = loc^.L.range - getRangeFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" - - -- A positive test checks if the provided range is equal - -- to the expected range from the definition in the test file. - -- The test emulates a goto-definition request of an actual definition. - positiveTest :: TestName -> Position -> Range -> TestTree - positiveTest testName cursorPos expectedRange = - runCabalTestCaseSession testName ("goto-definition" "common-section") $ do - doc <- openDoc "simple-with-common.cabal" "cabal" - definitions <- getDefinitions doc cursorPos - let range = getRangeFromDefinition definitions - liftIO $ range @?= expectedRange - - -- A negative test checks if the request failed and - -- the provided result is empty, i.e. `InR $ InR Null`. - -- The test emulates a goto-definition request of anything but an - -- actual definition. - negativeTest :: TestName -> Position -> TestTree - negativeTest testName cursorPos = - runCabalTestCaseSession testName ("goto-definition" "common-section") $ do - doc <- openDoc "simple-with-common.cabal" "cabal" - empty <- getDefinitions doc cursorPos - liftIO $ empty @?= (InR $ InR LSP.Null) From 5e1a6043a46000b4fb7e5bebe21bf0ce44476b71 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 01:06:15 +0300 Subject: [PATCH 20/27] more tests --- .../Plugin/Cabal/Completion/CabalFields.hs | 18 +++++++-- plugins/hls-cabal-plugin/test/Definition.hs | 39 ++++++++++++++++--- .../modules/module-examples.cabal | 9 +++-- 3 files changed, 53 insertions(+), 13 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index ed0bd8d8c5..0ce0a38427 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,8 +1,18 @@ module Ide.Plugin.Cabal.Completion.CabalFields - ( findStanzaForColumn, getModulesNames, getFieldLSPRange, - findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, - getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, - getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition + ( findStanzaForColumn + , getModulesNames + , getFieldLSPRange + , findFieldSection + , findTextWord + , findFieldLine + , getOptionalSectionName + , getAnnotation + , getFieldName + , onelineSectionArgs + , getFieldEndPosition + , getSectionArgEndPosition + , getNameEndPosition + , getFieldLineEndPosition ) where diff --git a/plugins/hls-cabal-plugin/test/Definition.hs b/plugins/hls-cabal-plugin/test/Definition.hs index ec9913b17b..33163c03eb 100644 --- a/plugins/hls-cabal-plugin/test/Definition.hs +++ b/plugins/hls-cabal-plugin/test/Definition.hs @@ -6,6 +6,8 @@ module Definition ( import Control.Lens ((^.)) import Data.List.Extra (isSuffixOf) +import qualified Data.Text as T +import Ide.Plugin.Cabal.Definition (toHaskellFile) import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Types as LSP import System.FilePath @@ -22,20 +24,38 @@ gotoDefinitionTests = testGroup "Goto Definition" gotoModuleDefinitionTests :: TestTree gotoModuleDefinitionTests = testGroup "Goto Module Definition" [ testGoToDefinitionLink "simple cabal test" "simple-cabal" "simple-cabal.cabal" - (Position 8 23) "A.hs" + (Position 8 23) (toTestHaskellPath "" "A") , testGoToDefinitionLink "library start of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 6 22) "src/Library/Lib.hs" + (Position 6 22) (toTestHaskellPath "src" "Library.Lib") + , testGoToDefinitionLink "library middle of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 6 29) (toTestHaskellPath "src" "Library.Lib") , testGoToDefinitionLink "library end of exposed-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 6 33) "src/Library/Lib.hs" - + (Position 6 33) (toTestHaskellPath "src" "Library.Lib") , testGoToDefinitionLink "library start of other-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 9 22) "src/Library/Other/OtherLib.hs" + (Position 9 22) (toTestHaskellPath "src" "Library.Other.OtherLib") , testGoToDefinitionLink "library end of other-modules" ("goto-definition" "modules") "module-examples.cabal" - (Position 9 44) "src/Library/Other/OtherLib.hs" + (Position 9 44) (toTestHaskellPath "src" "Library.Other.OtherLib") + + , testGoToDefinitionLink "executable other-modules" ("goto-definition" "modules") "module-examples.cabal" + (Position 22 10) (toTestHaskellPath ("src" "exe") "Config") + + , testGoToDefinitionLink "test-suite other-modules Config" ("goto-definition" "modules") "module-examples.cabal" + (Position 31 10) (toTestHaskellPath ("src" "test") "Config") + , testGoToDefinitionLink "test-suite other-modules Library" ("goto-definition" "modules") "module-examples.cabal" + (Position 34 10) (toTestHaskellPath ("src" "test") "Library") + , testGoToDefinitionLink "benchmark other-modules Config" ("goto-definition" "modules") "module-examples.cabal" + (Position 45 30) (toTestHaskellPath ("src" "bench") "Config") + + , testGoToDefinitionLinkNoLocation "not existent module" ("goto-definition" "modules") "module-examples.cabal" (Position 48 25) + , testGoToDefinitionLinkNoLocation "behind module" ("goto-definition" "modules") "module-examples.cabal" (Position 9 20) + , testGoToDefinitionLinkNoLocation "after module" ("goto-definition" "modules") "module-examples.cabal" (Position 9 50) ] where + toTestHaskellPath :: FilePath -> T.Text -> FilePath + toTestHaskellPath dir moduleName = dir toHaskellFile moduleName + getUriFromDefinition :: Show b => (Definition |? b) -> Uri getUriFromDefinition (InL (Definition (InL loc))) = loc^.L.uri getUriFromDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" @@ -55,6 +75,13 @@ gotoModuleDefinitionTests = testGroup "Goto Module Definition" liftIO $ isCorrectPath @? ("Absolute path expected to end on " <> filePathWithDir <> " but " <> filePath <> " was given.") + testGoToDefinitionLinkNoLocation :: TestName -> FilePath -> FilePath -> Position -> TestTree + testGoToDefinitionLinkNoLocation testName testDir cabalFile cursorPos = + runCabalTestCaseSession testName testDir $ do + doc <- openDoc cabalFile "cabal" + empty <- getDefinitions doc cursorPos + liftIO $ empty @?= (InR $ InR LSP.Null) + gotoCommonSectionDefinitionTests :: TestTree gotoCommonSectionDefinitionTests = testGroup "Goto Common Section Definition" [ positiveTest "middle of identifier" (Position 27 16) (mkRange 6 0 7 22) diff --git a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal index 28bba540b9..24c2bb854e 100644 --- a/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/goto-definition/modules/module-examples.cabal @@ -33,8 +33,8 @@ test-suite module-examples-test -- ^ Position: (31, 8) -- ^ Position: (31, 14) Library --- ^ Position: (31, 8) --- ^ Position: (31, 15) +-- ^ Position: (34, 8) +-- ^ Position: (34, 15) build-depends: base benchmark benchmark @@ -45,4 +45,7 @@ benchmark benchmark other-modules: Config -- ^ Position: (45, 28) --- ^ Position: (45, 34) \ No newline at end of file +-- ^ Position: (45, 34) + NotExistent +-- ^ Position: (48, 19) +-- ^ Position: (48, 30) From 660dc8863cfcaa1a42580e511dbe85fedec7f256 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 18:37:00 +0300 Subject: [PATCH 21/27] refactoring and docs --- .../src/Ide/Plugin/Cabal/Definition.hs | 129 ++++++++++++------ 1 file changed, 90 insertions(+), 39 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index c470b95c59..c0f090868a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -15,6 +15,7 @@ import qualified Data.Text as T import Development.IDE as D import Development.IDE.Core.PluginUtils import qualified Distribution.Fields as Syntax +import qualified Distribution.Parsec.Position as Syntax import Distribution.PackageDescription (Benchmark (..), BuildInfo (..), Executable (..), @@ -24,7 +25,7 @@ import Distribution.PackageDescription (Benchmark (..), PackageDescription (..), TestSuite (..), library, - unUnqualComponentName) + unUnqualComponentName, GenericPackageDescription) import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.Utils.Generic (safeHead) import Distribution.Utils.Path (getSymbolicPath) @@ -46,51 +47,101 @@ import System.FilePath (joinPath, -- | CodeActions for going to definitions. -- --- Provides a CodeAction for going to a definition when clicking on an identifier --- and clicking on exposed-module or other-module field. --- The definition is found by traversing the sections and comparing their name to --- the clicked identifier. If it's not in sections it attempts to find it in module names. --- +-- Provides a CodeAction for going to a definition in a cabal file, +-- gathering all possible definitions by calling subfunctions. + -- TODO: Resolve more cases for go-to definition. gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition -gotoDefinition ideState _ msgParam = do +gotoDefinition ide _ msgParam = do nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp - case CabalFields.findTextWord cursor cabalFields of - Nothing -> - pure $ InR $ InR Null - Just cursorText -> do - commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp - case find (isSectionArgName cursorText) commonSections of - Just commonSection -> do - pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nfp + -- Trim the AST three, so multiple passes in subfunctions won't hurt the performance. + let fieldsOfInterest = maybe cabalFields (:[] ) $ CabalFields.findFieldSection cursor cabalFields + + commonSections <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalCommonSections nfp + let mCommonSectionsDef = gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest - Nothing -> do - let moduleNames = CabalFields.getModulesNames cabalFields - mModuleName = find (isModuleName cursorText) moduleNames - case mModuleName of - Nothing -> pure $ InR $ InR Null - Just (mBuildTargetNames, moduleName) -> do - mGPD <- liftIO $ runAction "cabal.GPD" ideState $ useWithStale ParseCabalFile nfp - case mGPD of - Nothing -> pure $ InR $ InR Null - Just (gpd, _) -> do - let buildInfos = foldMap (lookupBuildTargetPackageDescription - (flattenPackageDescription gpd)) - mBuildTargetNames - sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos - potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs - allPaths <- liftIO $ filterM doesFileExist potentialPaths - let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths - case safeHead locations of -- We assume there could be only one source location - Nothing -> pure $ InR $ InR Null - Just location -> pure $ InL $ Definition $ InL location + mModuleDef <- do + mGPD <- liftIO $ runAction "cabal.GPD" ide $ useWithStale ParseCabalFile nfp + case mGPD of + Nothing -> pure Nothing + Just (gpd, _) -> liftIO $ gotoModulesDefinition nfp gpd cursor fieldsOfInterest + + let defs = Maybe.catMaybes [ mCommonSectionsDef + , mModuleDef + ] + -- Take the first found definition. + -- We assume, that there can't be multiple definitions, + -- or the most specific definitions come first. + case safeHead defs of + Nothing -> pure $ InR $ InR Null + Just def -> pure $ InL def where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) uri = msgParam ^. JL.textDocument . JL.uri - isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName - isSectionArgName _ _ = False - isModuleName name (_, moduleName) = name == moduleName + +-- | Definitions for Sections. +-- +-- Provides a Definition if cursor is pointed at an identifier, +-- otherwise gives Nothing +-- The definition is found by traversing the sections and comparing their name to +-- the clicked identifier. +gotoCommonSectionDefinition + :: Uri -- ^ Cabal file URI + -> [Syntax.Field Syntax.Position] -- ^ Found common sections + -> Syntax.Position -- ^ Cursor position + -> [Syntax.Field Syntax.Position] -- ^ Trimmed cabal AST on a cursor + -> Maybe Definition +gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest = + case CabalFields.findTextWord cursor fieldsOfInterest of + Nothing -> Nothing + Just cursorText -> do + case find (isSectionArgName cursorText) commonSections of + Just commonSection -> Just $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection + Nothing -> Nothing + where + isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName + isSectionArgName _ _ = False + +-- | Definitions for Modules. +-- +-- Provides a Definition if cursor is pointed at a +-- exposed-module or other-module field, otherwise gives Nothing +-- +-- Definition is found by looking for a module name, +-- the cursor is pointing to and looking for it in @BuildInfo@s. +-- Note that since a trimmed ast is provided, a @Definition@ to +-- a module with the same name as the target one, +-- but in another build target can't be given. +-- +-- See resolving @Config@ module in tests. +gotoModulesDefinition + :: NormalizedFilePath + -> GenericPackageDescription + -> Syntax.Position + -> [Syntax.Field Syntax.Position] + -> IO (Maybe Definition) +gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do + let mCursorText = CabalFields.findTextWord cursor fieldsOfInterest + moduleNames = CabalFields.getModulesNames fieldsOfInterest + mModuleName = find (isModuleName mCursorText) moduleNames + + case mModuleName of + Nothing -> pure Nothing + Just (mBuildTargetNames, moduleName) -> do + let buildInfos = foldMap (lookupBuildTargetPackageDescription + (flattenPackageDescription gpd)) + mBuildTargetNames + sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos + potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs + allPaths <- liftIO $ filterM doesFileExist potentialPaths + let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths + case safeHead locations of -- We assume there could be only one source location + Nothing -> pure Nothing + Just location -> pure $ Just $ Definition $ InL location + where + isModuleName (Just name) (_, moduleName) = name == moduleName + isModuleName _ _ = False -- | Gives all `buildInfo`s given a target name. -- From 13dd3db1ab566b647adf9da76077d3befe96772a Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 18:38:28 +0300 Subject: [PATCH 22/27] docs --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index c0f090868a..9245c14d62 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -116,10 +116,10 @@ gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest = -- -- See resolving @Config@ module in tests. gotoModulesDefinition - :: NormalizedFilePath + :: NormalizedFilePath -- ^ Normalized FilePath to the cabal file -> GenericPackageDescription - -> Syntax.Position - -> [Syntax.Field Syntax.Position] + -> Syntax.Position -- ^ Cursor position + -> [Syntax.Field Syntax.Position] -- ^ Trimmed cabal AST on a cursor -> IO (Maybe Definition) gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do let mCursorText = CabalFields.findTextWord cursor fieldsOfInterest From 7f08ee24a209f262a993fcab08c9ed6644c10d10 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 18:46:14 +0300 Subject: [PATCH 23/27] grammar --- .../src/Ide/Plugin/Cabal/Definition.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 9245c14d62..5b10f81ab5 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -15,18 +15,19 @@ import qualified Data.Text as T import Development.IDE as D import Development.IDE.Core.PluginUtils import qualified Distribution.Fields as Syntax -import qualified Distribution.Parsec.Position as Syntax import Distribution.PackageDescription (Benchmark (..), BuildInfo (..), Executable (..), ForeignLib (..), + GenericPackageDescription, Library (..), LibraryName (LMainLibName, LSubLibName), PackageDescription (..), TestSuite (..), library, - unUnqualComponentName, GenericPackageDescription) + unUnqualComponentName) import Distribution.PackageDescription.Configuration (flattenPackageDescription) +import qualified Distribution.Parsec.Position as Syntax import Distribution.Utils.Generic (safeHead) import Distribution.Utils.Path (getSymbolicPath) import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields @@ -47,7 +48,7 @@ import System.FilePath (joinPath, -- | CodeActions for going to definitions. -- --- Provides a CodeAction for going to a definition in a cabal file, +-- Provides a CodeAction for going to the definition in a cabal file, -- gathering all possible definitions by calling subfunctions. -- TODO: Resolve more cases for go-to definition. @@ -55,7 +56,7 @@ gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition gotoDefinition ide _ msgParam = do nfp <- getNormalizedFilePathE uri cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nfp - -- Trim the AST three, so multiple passes in subfunctions won't hurt the performance. + -- Trim the AST tree, so multiple passes in subfunctions won't hurt the performance. let fieldsOfInterest = maybe cabalFields (:[] ) $ CabalFields.findFieldSection cursor cabalFields commonSections <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalCommonSections nfp @@ -70,11 +71,11 @@ gotoDefinition ide _ msgParam = do let defs = Maybe.catMaybes [ mCommonSectionsDef , mModuleDef ] - -- Take the first found definition. + -- Take first found definition. -- We assume, that there can't be multiple definitions, -- or the most specific definitions come first. case safeHead defs of - Nothing -> pure $ InR $ InR Null + Nothing -> pure $ InR $ InR Null Just def -> pure $ InL def where cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) @@ -83,7 +84,7 @@ gotoDefinition ide _ msgParam = do -- | Definitions for Sections. -- -- Provides a Definition if cursor is pointed at an identifier, --- otherwise gives Nothing +-- otherwise gives Nothing. -- The definition is found by traversing the sections and comparing their name to -- the clicked identifier. gotoCommonSectionDefinition @@ -135,13 +136,14 @@ gotoModulesDefinition nfp gpd cursor fieldsOfInterest = do sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos potentialPaths = map (\dir -> takeDirectory (fromNormalizedFilePath nfp) dir toHaskellFile moduleName) sourceDirs allPaths <- liftIO $ filterM doesFileExist potentialPaths + -- Don't provide the range, since there is little benefit for it let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths case safeHead locations of -- We assume there could be only one source location Nothing -> pure Nothing Just location -> pure $ Just $ Definition $ InL location where isModuleName (Just name) (_, moduleName) = name == moduleName - isModuleName _ _ = False + isModuleName _ _ = False -- | Gives all `buildInfo`s given a target name. -- From adcbe093815c785bd8dcc1be73fd84b82886b74a Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 21:36:53 +0300 Subject: [PATCH 24/27] rename gotoDefinition to gotoDefinitionAction --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 4 ++-- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs | 4 ++-- 2 files changed, 4 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 3634a7c8fa..6b6a89ff3a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -40,7 +40,7 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSe ParseCabalFields (..), ParseCabalFile (..)) import qualified Ide.Plugin.Cabal.Completion.Types as Types -import Ide.Plugin.Cabal.Definition (gotoDefinition) +import Ide.Plugin.Cabal.Definition (gotoDefinitionAction) import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest @@ -98,7 +98,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder - , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition + , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinitionAction ] , pluginNotificationHandlers = mconcat diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 5b10f81ab5..c2569f36ca 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -52,8 +52,8 @@ import System.FilePath (joinPath, -- gathering all possible definitions by calling subfunctions. -- TODO: Resolve more cases for go-to definition. -gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition -gotoDefinition ide _ msgParam = do +gotoDefinitionAction :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition +gotoDefinitionAction ide _ msgParam = do nfp <- getNormalizedFilePathE uri cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nfp -- Trim the AST tree, so multiple passes in subfunctions won't hurt the performance. From 39b43893eec16fbbec4893afafd98f6b94c0ef9a Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 20 Aug 2024 21:50:07 +0300 Subject: [PATCH 25/27] fix merge issues --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 34 +----------- .../src/Ide/Plugin/Cabal/Definition.hs | 4 +- plugins/hls-cabal-plugin/test/Main.hs | 54 ------------------- 3 files changed, 4 insertions(+), 88 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 6b6a89ff3a..a46c614f80 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -17,14 +17,12 @@ import qualified Data.ByteString as BS import Data.Hashable import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.List (find) import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D -import Development.IDE.Core.PluginUtils import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (Key, alwaysRerun) @@ -33,21 +31,19 @@ import Development.IDE.Types.Shake (toKey) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax import GHC.Generics -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 (gotoDefinitionAction) +import Ide.Plugin.Cabal.Definition (gotoDefinition) import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () import Ide.Plugin.Cabal.Outline import qualified Ide.Plugin.Cabal.Parse as Parse -import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP @@ -98,7 +94,7 @@ descriptor recorder plId = , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder - , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinitionAction + , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition ] , pluginNotificationHandlers = mconcat @@ -283,32 +279,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif let completionTexts = fmap (^. JL.label) completions pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range --- | CodeActions for going to definitions. --- --- Provides a CodeAction for going to a definition when clicking on an identifier. --- The definition is found by traversing the sections and comparing their name to --- the clicked identifier. --- --- TODO: Support more definitions than sections. -gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition -gotoDefinition ideState _ msgParam = do - nfp <- getNormalizedFilePathE uri - cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp - case CabalFields.findTextWord cursor cabalFields of - Nothing -> - pure $ InR $ InR Null - Just cursorText -> do - commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp - case find (isSectionArgName cursorText) commonSections of - Nothing -> - pure $ InR $ InR Null - Just commonSection -> do - pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection - where - cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position) - uri = msgParam ^. JL.textDocument . JL.uri - isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName - isSectionArgName _ _ = False -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index c2569f36ca..5b10f81ab5 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -52,8 +52,8 @@ import System.FilePath (joinPath, -- gathering all possible definitions by calling subfunctions. -- TODO: Resolve more cases for go-to definition. -gotoDefinitionAction :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition -gotoDefinitionAction ide _ msgParam = do +gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition +gotoDefinition ide _ msgParam = do nfp <- getNormalizedFilePathE uri cabalFields <- runActionE "cabal-plugin.commonSections" ide $ useE ParseCabalFields nfp -- Trim the AST tree, so multiple passes in subfunctions won't hurt the performance. diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 9b11a1284e..c6383ab393 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -21,7 +21,6 @@ import Definition (gotoDefinitionTests) import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L -import qualified Language.LSP.Protocol.Types as LSP import Outline (outlineTests) import System.FilePath import Test.Hls @@ -230,56 +229,3 @@ codeActionTests = testGroup "Code Actions" InR action@CodeAction{_title} <- codeActions guard (_title == "Replace with " <> license) pure action - --- ---------------------------------------------------------------------------- --- Goto Definition Tests --- ---------------------------------------------------------------------------- - -gotoDefinitionTests :: TestTree -gotoDefinitionTests = testGroup "Goto Definition" - [ positiveTest "middle of identifier" (mkP 27 16) (mkR 6 0 7 22) - , positiveTest "left of identifier" (mkP 30 12) (mkR 10 0 17 40) - , positiveTest "right of identifier" (mkP 33 22) (mkR 20 0 23 34) - , positiveTest "left of '-' in identifier" (mkP 36 20) (mkR 6 0 7 22) - , positiveTest "right of '-' in identifier" (mkP 39 19) (mkR 10 0 17 40) - , positiveTest "identifier in identifier list" (mkP 42 16) (mkR 20 0 23 34) - , positiveTest "left of ',' right of identifier" (mkP 45 33) (mkR 10 0 17 40) - , positiveTest "right of ',' left of identifier" (mkP 48 34) (mkR 6 0 7 22) - - , negativeTest "right of ',' left of space" (mkP 51 23) - , negativeTest "right of ':' left of space" (mkP 54 11) - , negativeTest "not a definition" (mkP 57 8) - , negativeTest "empty space" (mkP 59 7) - ] - where - mkP :: UInt -> UInt -> Position - mkP x1 y1 = Position x1 y1 - - mkR :: UInt -> UInt -> UInt -> UInt -> Range - mkR x1 y1 x2 y2 = Range (mkP x1 y1) (mkP x2 y2) - - getDefinition :: Show b => (Definition |? b) -> Range - getDefinition (InL (Definition (InL loc))) = loc^.L.range - getDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'" - - -- A positive test checks if the provided range is equal - -- to the expected range from the definition in the test file. - -- The test emulates a goto-definition request of an actual definition. - positiveTest :: TestName -> Position -> Range -> TestTree - positiveTest testName cursorPos expectedRange = - runCabalTestCaseSession testName "goto-definition" $ do - doc <- openDoc "simple-with-common.cabal" "cabal" - definitions <- getDefinitions doc cursorPos - let locationRange = getDefinition definitions - liftIO $ locationRange @?= expectedRange - - -- A negative test checks if the request failed and - -- the provided result is empty, i.e. `InR $ InR Null`. - -- The test emulates a goto-definition request of anything but an - -- actual definition. - negativeTest :: TestName -> Position -> TestTree - negativeTest testName cursorPos = - runCabalTestCaseSession testName "goto-definition" $ do - doc <- openDoc "simple-with-common.cabal" "cabal" - empty <- getDefinitions doc cursorPos - liftIO $ empty @?= (InR $ InR LSP.Null) From cec4e54ac14f0bfd18b5765c59192fac860c5e6e Mon Sep 17 00:00:00 2001 From: Georgii Gerasev <54953043+VenInf@users.noreply.github.com> Date: Wed, 21 Aug 2024 18:47:56 +0300 Subject: [PATCH 26/27] Apply suggestions from code review Co-authored-by: VeryMilkyJoe --- .../Ide/Plugin/Cabal/Completion/CabalFields.hs | 16 ++++++++-------- .../src/Ide/Plugin/Cabal/Definition.hs | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 0ce0a38427..d9af604f4a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -209,7 +209,7 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs -- | Trims a given cabal AST leaving only targets and their -- @exposed-modules@ and @other-modules@ sections. -- --- For examle: +-- For example: -- -- * Given a cabal file like this: -- @@ -218,26 +218,26 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs -- > hs-source-dirs: source/directory -- > ... -- > exposed-modules: --- > Importaint.Exposed.Module +-- > Important.Exposed.Module -- > other-modules: --- > Importaint.Other.Module +-- > Important.Other.Module -- > -- > test-suite tests -- > type: type -- > build-tool-depends: tool -- > other-modules: --- > Importaint.Other.Module +-- > Important.Other.Module -- -- * @getSectionsWithModules@ gives output: -- -- > library -- > exposed-modules: --- > Importaint.Exposed.Module +-- > Important.Exposed.Module -- > other-modules: --- > Importaint.Other.Module +-- > Important.Other.Module -- > test-suite tests -- > other-modules: --- > Importaint.Other.Module +-- > Important.Other.Module getSectionsWithModules :: [Syntax.Field any] -> [Syntax.Field any] getSectionsWithModules fields = concatMap go fields where @@ -295,7 +295,7 @@ getNameEndPosition (Syntax.Name (Syntax.Position row col) byteString) = Syntax.P getFieldLineEndPosition :: Syntax.FieldLine Syntax.Position -> Syntax.Position getFieldLineEndPosition (Syntax.FieldLine (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString) --- | Returns a LSP compatible range for a provided field +-- | Returns an LSP compatible range for a provided field getFieldLSPRange :: Syntax.Field Syntax.Position -> LSP.Range getFieldLSPRange field = LSP.Range startLSPPos endLSPPos where diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 5b10f81ab5..643ea02df2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -193,7 +193,7 @@ lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetN else Nothing -- | Converts a name of a module to a FilePath --- Warning: Takes a lot of assumptions and generally +-- Warning: Makes a lot of assumptions and generally -- not advised to use. -- -- Examples: (output is system dependent) From dcc045a672b74df926f0c73f75d6bb40aaa0e126 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 21 Aug 2024 19:37:07 +0300 Subject: [PATCH 27/27] docs and small changes --- .../Plugin/Cabal/Completion/CabalFields.hs | 4 +-- .../src/Ide/Plugin/Cabal/Definition.hs | 25 ++++++++++--------- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index d9af604f4a..b8cb7ce0d6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -196,9 +196,9 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs getSectionModuleNames (Syntax.Section _ secArgs fields) = map (, getArgsName secArgs) $ concatMap getFieldModuleNames fields getSectionModuleNames _ = [] - getArgsName [] = Nothing -- only a main library can have no name getArgsName [Syntax.SecArgName _ name] = Just $ T.decodeUtf8 name - getArgsName _ = Nothing -- impossible to have multiple names for a build target + getArgsName _ = Nothing -- Can be only a main library, that has no name + -- since it's impossible to have multiple names for a build target getFieldModuleNames field@(Syntax.Field _ modules) = if getFieldName field == T.pack "exposed-modules" || getFieldName field == T.pack "other-modules" diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs index 643ea02df2..5f85151199 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Definition.hs @@ -46,9 +46,9 @@ import System.FilePath (joinPath, takeDirectory, (<.>), ()) --- | CodeActions for going to definitions. +-- | Handler for going to definitions. -- --- Provides a CodeAction for going to the definition in a cabal file, +-- Provides a handler for going to the definition in a cabal file, -- gathering all possible definitions by calling subfunctions. -- TODO: Resolve more cases for go-to definition. @@ -93,13 +93,10 @@ gotoCommonSectionDefinition -> Syntax.Position -- ^ Cursor position -> [Syntax.Field Syntax.Position] -- ^ Trimmed cabal AST on a cursor -> Maybe Definition -gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest = - case CabalFields.findTextWord cursor fieldsOfInterest of - Nothing -> Nothing - Just cursorText -> do - case find (isSectionArgName cursorText) commonSections of - Just commonSection -> Just $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection - Nothing -> Nothing +gotoCommonSectionDefinition uri commonSections cursor fieldsOfInterest = do + cursorText <- CabalFields.findTextWord cursor fieldsOfInterest + commonSection <- find (isSectionArgName cursorText) commonSections + Just $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection where isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName isSectionArgName _ _ = False @@ -192,9 +189,13 @@ lookupBuildTargetPackageDescription (PackageDescription {..}) (Just buildTargetN then Just benchmarkBuildInfo else Nothing --- | Converts a name of a module to a FilePath --- Warning: Makes a lot of assumptions and generally --- not advised to use. +-- | Converts a name of a module to a FilePath. +-- Is needed to guess the relative path to a file +-- using the name of the module. +-- We assume, that correct module naming is guaranteed. +-- +-- Warning: Generally not advised to use, if there are +-- better ways to get the path. -- -- Examples: (output is system dependent) -- >>> toHaskellFile "My.Module.Lib"