Skip to content

Commit

Permalink
Cabal go to module's definition (#4380)
Browse files Browse the repository at this point in the history 
If you click go-to definition on the field under `exposed-module` or `other-module`
it will open the file where this module was defined.

The go-to definition function compares the highlighted text with modules in the cabal file.
If there is a match, it takes the respective build target and tries to fetch their `hsSourceDirs` from the `PackageDescription`. (by looking at all `buildInfos` with matching names).

After finding them, it constructs a path using directory where the cabal file is located, the info from `hsSourceDirs` and a name of the module converted to a path.
If the file exists it returns the `Definition` with the acquired location.

---------

Co-authored-by: fendor <fendor@users.noreply.github.com>
Co-authored-by: Chrizzl <hochrainer.christoph@gmail.com>
Co-authored-by: VeryMilkyJoe <jana.chadt@nets.at>
  • Loading branch information
@VenInf @fendor
@ChristophHochrainer @VeryMilkyJoe
4 people authored Aug 22, 2024
1 parent 2253752 commit 9cc8c62
Show file tree
Hide file tree
Showing 17 changed files with 585 additions and 101 deletions.
6 changes: 4 additions & 2 deletions haskell-language-server.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.CabalAdd
Expand Down Expand Up @@ -287,11 +288,12 @@ test-suite hls-cabal-plugin-tests
hs-source-dirs: plugins/hls-cabal-plugin/test
main-is: Main.hs
other-modules:
CabalAdd
Completer
Context
Utils
Definition
Outline
CabalAdd
Utils
build-depends:
, base
, bytestring
Expand Down
31 changes: 1 addition & 30 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -33,20 +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 (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
Expand Down Expand Up @@ -305,32 +302,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

cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
Expand Down
137 changes: 122 additions & 15 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs
View file
Original file line number Diff line number Diff line change
@@ -1,25 +1,29 @@
module Ide.Plugin.Cabal.Completion.CabalFields
( findStanzaForColumn,
findFieldSection,
findTextWord,
findFieldLine,
getOptionalSectionName,
getAnnotation,
getFieldName,
onelineSectionArgs,
getFieldEndPosition,
getSectionArgEndPosition,
getNameEndPosition,
getFieldLineEndPosition,
getFieldLSPRange
) where
( 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)
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
Expand Down Expand Up @@ -138,6 +142,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
Expand All @@ -148,6 +155,107 @@ getOptionalSectionName (x:xs) = case x of
Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
_ -> getOptionalSectionName xs

type BuildTargetName = T.Text
type ModuleName = T.Text

-- | Given a cabal AST returns pairs of all respective target names
-- 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:
--
-- * 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
rawModuleTargetPairs = concatMap getSectionModuleNames sections
sections = getSectionsWithModules fields

getSectionModuleNames :: Syntax.Field any -> [(ModuleName, Maybe BuildTargetName)]
getSectionModuleNames (Syntax.Section _ secArgs fields) = map (, getArgsName secArgs) $ concatMap getFieldModuleNames fields
getSectionModuleNames _ = []

getArgsName [Syntax.SecArgName _ name] = Just $ T.decodeUtf8 name
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"
then map getFieldLineName modules
else []
getFieldModuleNames _ = []

-- | Trims a given cabal AST leaving only targets and their
-- @exposed-modules@ and @other-modules@ sections.
--
-- For example:
--
-- * Given a cabal file like this:
--
-- > library
-- > import: extra
-- > hs-source-dirs: source/directory
-- > ...
-- > exposed-modules:
-- > Important.Exposed.Module
-- > other-modules:
-- > Important.Other.Module
-- >
-- > test-suite tests
-- > type: type
-- > build-tool-depends: tool
-- > other-modules:
-- > Important.Other.Module
--
-- * @getSectionsWithModules@ gives output:
--
-- > library
-- > exposed-modules:
-- > Important.Exposed.Module
-- > other-modules:
-- > Important.Other.Module
-- > test-suite tests
-- > other-modules:
-- > Important.Other.Module
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,
Expand All @@ -165,7 +273,6 @@ onelineSectionArgs sectionArgs = joinedName
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
Expand Down
Loading

0 comments on commit 9cc8c62

Please sign in to comment.