Skip to content

Commit 8f164e2

Browse files
ChristophHochrainerChristophHochrainer
committed
Add goto-definitions for cabal common secitons
1 parent 9565d0b commit 8f164e2

File tree

2 files changed

+137
-3
lines changed

2 files changed

+137
-3
lines changed

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

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import qualified Data.ByteString as BS
1717
import Data.Hashable
1818
import Data.HashMap.Strict (HashMap)
1919
import qualified Data.HashMap.Strict as HashMap
20+
import Data.List (find)
2021
import qualified Data.List.NonEmpty as NE
2122
import qualified Data.Maybe as Maybe
2223
import qualified Data.Text as T
@@ -31,6 +32,7 @@ import Development.IDE.Types.Shake (toKey)
3132
import qualified Distribution.Fields as Syntax
3233
import qualified Distribution.Parsec.Position as Syntax
3334
import GHC.Generics
35+
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
3436
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3537
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
3638
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
@@ -93,6 +95,7 @@ descriptor recorder plId =
9395
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
9496
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
9597
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
98+
, mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
9699
]
97100
, pluginNotificationHandlers =
98101
mconcat
@@ -277,6 +280,38 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
277280
let completionTexts = fmap (^. JL.label) completions
278281
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
279282

283+
-- | CodeActions for going to definitions.
284+
--
285+
-- Provides a CodeAction for going to a definition when clicking on an identifier.
286+
-- The definition is found by traversing the sections and comparing their name to
287+
-- the clicked identifier.
288+
--
289+
-- TODO: Support more definitions than sections.
290+
gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
291+
gotoDefinition ideState _ msgParam = do
292+
case uriToFilePath' uri of
293+
Nothing ->
294+
pure $ InR $ InR Null
295+
Just filePath -> do
296+
mCabalFields <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalFields $ toNormalizedFilePath filePath
297+
let mCursorText = CabalFields.findTextWord cursor =<< mCabalFields
298+
case mCursorText of
299+
Nothing ->
300+
pure $ InR $ InR Null
301+
Just cursorText -> do
302+
mCommonSections <- liftIO $ runAction "cabal-plugin.commonSections" ideState $ use ParseCabalCommonSections $ toNormalizedFilePath filePath
303+
let mCommonSection = find (filterSectionArgName cursorText) =<< mCommonSections
304+
case mCommonSection of
305+
Nothing ->
306+
pure $ InR $ InR Null
307+
Just commonSection -> do
308+
pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
309+
where
310+
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
311+
uri = msgParam ^. JL.textDocument . JL.uri
312+
filterSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
313+
filterSectionArgName _ _ = False
314+
280315
-- ----------------------------------------------------------------
281316
-- Cabal file of Interest rules and global variable
282317
-- ----------------------------------------------------------------

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

Lines changed: 102 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,16 @@
1-
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where
1+
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
2+
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, findTextWord, findFieldLine, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs, getFieldEndPosition, getSectionArgEndPosition, getNameEndPosition, getFieldLineEndPosition, getFieldLSPRange) where
23

4+
import qualified Data.ByteString as BS
5+
import Data.List (find)
36
import Data.List.NonEmpty (NonEmpty)
47
import qualified Data.List.NonEmpty as NE
58
import qualified Data.Text as T
69
import qualified Data.Text.Encoding as T
710
import qualified Distribution.Fields as Syntax
811
import qualified Distribution.Parsec.Position as Syntax
912
import Ide.Plugin.Cabal.Completion.Types
13+
import qualified Language.LSP.Protocol.Types as LSPTypes
1014

1115
-- ----------------------------------------------------------------
1216
-- Cabal-syntax utilities I don't really want to write myself
@@ -46,6 +50,71 @@ findFieldSection cursor (x:y:ys)
4650
where
4751
cursorLine = Syntax.positionRow cursor
4852

53+
-- | Determine the field line the cursor is currently a part of.
54+
--
55+
-- The result is said field line and its starting position
56+
-- or Nothing if the passed list of fields is empty.
57+
58+
-- This function assumes that elements in a field's @FieldLine@ list
59+
-- do not share the same row.
60+
findFieldLine :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.FieldLine Syntax.Position)
61+
findFieldLine _cursor [] = Nothing
62+
findFieldLine cursor fields =
63+
case findFieldSection cursor fields of
64+
Nothing -> Nothing
65+
Just (Syntax.Field _ fieldLines) -> find filterLineFields fieldLines
66+
Just (Syntax.Section _ _ fields) -> findFieldLine cursor fields
67+
where
68+
cursorLine = Syntax.positionRow cursor
69+
-- In contrast to `Field` or `Section`, `FieldLine` must have the exact
70+
-- same line position as the cursor.
71+
filterLineFields (Syntax.FieldLine pos _) = Syntax.positionRow pos == cursorLine
72+
73+
-- | Determine the exact word at the current cursor position.
74+
--
75+
-- The result is said word or Nothing if the passed list is empty
76+
-- or the cursor position is not next to, or on a word.
77+
-- For this function, a word is a sequence of consecutive characters
78+
-- that are not a space or column.
79+
80+
-- This function currently only considers words inside of a @FieldLine@.
81+
findTextWord :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe T.Text
82+
findTextWord _cursor [] = Nothing
83+
findTextWord cursor fields =
84+
case findFieldLine cursor fields of
85+
Nothing -> Nothing
86+
Just (Syntax.FieldLine pos byteString) ->
87+
let decodedText = T.decodeUtf8 byteString
88+
lineFieldCol = Syntax.positionCol pos
89+
lineFieldLen = T.length decodedText
90+
offset = cursorCol - lineFieldCol in
91+
-- Range check if cursor is inside or or next to found line.
92+
-- The latter comparison includes the length of the line as offset,
93+
-- which is done to also include cursors that are at the end of a line.
94+
-- e.g. "foo,bar|"
95+
-- ^
96+
-- cursor
97+
--
98+
-- Having an offset which is outside of the line is possible because of `splitAt`.
99+
if offset >= 0 && lineFieldLen >= offset
100+
then
101+
let (lhs, rhs) = T.splitAt offset decodedText
102+
strippedLhs = T.takeWhileEnd isAllowedChar lhs
103+
strippedRhs = T.takeWhile isAllowedChar rhs
104+
resultText = T.concat [strippedLhs, strippedRhs] in
105+
-- It could be possible that the cursor was in-between separators, in this
106+
-- case the resulting text would be empty, which should result in `Nothing`.
107+
-- e.g. " foo ,| bar"
108+
-- ^
109+
-- cursor
110+
if not $ T.null resultText then Just resultText else Nothing
111+
else
112+
Nothing
113+
where
114+
cursorCol = Syntax.positionCol cursor
115+
separators = [',', ' ']
116+
isAllowedChar = (`notElem` separators)
117+
49118
type FieldName = T.Text
50119

51120
getAnnotation :: Syntax.Field ann -> ann
@@ -73,12 +142,42 @@ getOptionalSectionName (x:xs) = case x of
73142
--
74143
-- For example, @flag@ @(@ @pedantic@ @)@ will be joined in
75144
-- one line, instead of four @SectionArg@s separately.
76-
onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text
145+
onelineSectionArgs :: [Syntax.SectionArg ann] -> T.Text
77146
onelineSectionArgs sectionArgs = joinedName
78147
where
79148
joinedName = T.unwords $ map getName sectionArgs
80149

81-
getName :: Syntax.SectionArg Syntax.Position -> T.Text
150+
getName :: Syntax.SectionArg ann -> T.Text
82151
getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier
83152
getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString
84153
getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string
154+
155+
156+
-- | Returns the end position of a provided field
157+
getFieldEndPosition :: Syntax.Field Syntax.Position -> Syntax.Position
158+
getFieldEndPosition (Syntax.Field name []) = getNameEndPosition name
159+
getFieldEndPosition (Syntax.Field _ (x:xs)) = getFieldLineEndPosition $ NE.last (x NE.:| xs)
160+
getFieldEndPosition (Syntax.Section name [] []) = getNameEndPosition name
161+
getFieldEndPosition (Syntax.Section _ (x:xs) []) = getSectionArgEndPosition $ NE.last (x NE.:| xs)
162+
getFieldEndPosition (Syntax.Section _ _ (x:xs)) = getFieldEndPosition $ NE.last (x NE.:| xs)
163+
164+
-- | Returns the end position of a provided section arg
165+
getSectionArgEndPosition :: Syntax.SectionArg Syntax.Position -> Syntax.Position
166+
getSectionArgEndPosition (Syntax.SecArgName (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString)
167+
getSectionArgEndPosition (Syntax.SecArgStr (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString)
168+
getSectionArgEndPosition (Syntax.SecArgOther (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString)
169+
170+
-- | Returns the end position of a provided name
171+
getNameEndPosition :: Syntax.Name Syntax.Position -> Syntax.Position
172+
getNameEndPosition (Syntax.Name (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString)
173+
174+
-- | Returns the end position of a provided field line
175+
getFieldLineEndPosition :: Syntax.FieldLine Syntax.Position -> Syntax.Position
176+
getFieldLineEndPosition (Syntax.FieldLine (Syntax.Position row col) byteString) = Syntax.Position row (col + BS.length byteString)
177+
178+
-- | Returns a LSP compatible range for a provided field
179+
getFieldLSPRange :: Syntax.Field Syntax.Position -> LSPTypes.Range
180+
getFieldLSPRange field = LSPTypes.Range startLSPPos endLSPPos
181+
where
182+
startLSPPos = cabalPositionToLSPPosition $ getAnnotation field
183+
endLSPPos = cabalPositionToLSPPosition $ getFieldEndPosition field

0 commit comments

Comments
 (0)