Skip to content

Commit 306911e

Browse files
VenInfVenInf
authored
Merge branch 'master' into cabal-go-to-modules-definition
2 parents 7f08ee2 + de36c8e commit 306911e

File tree

4 files changed

+162
-0
lines changed

4 files changed

+162
-0
lines changed

‎.github/actions/setup-build/action.yml

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -116,3 +116,18 @@ runs:
116116
- name: "Remove freeze file"
117117
run: rm -f cabal.project.freeze
118118
shell: bash
119+
120+
# Make sure to clear all unneeded `ghcup`` caches.
121+
# At some point, we were running out of disk space, see issue
122+
# https://github.com/haskell/haskell-language-server/issues/4386 for details.
123+
#
124+
# Using "printf" debugging (`du -sh *` and `df -h /`) and binary searching,
125+
# we figured out that `ghcup` caches are taking up a sizable portion of the
126+
# disk space.
127+
# Thus, we remove anything we don't need, especially caches and temporary files.
128+
# For got measure, we also make sure no other tooling versions are
129+
# installed besides the ones we explicitly want.
130+
- name: "Remove ghcup caches"
131+
if: runner.os == 'Linux'
132+
run: ghcup gc --ghc-old --share-dir --hls-no-ghc --cache --tmpdirs --unset
133+
shell: bash

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

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,12 +17,14 @@ 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
2324
import qualified Data.Text.Encoding as Encoding
2425
import Data.Typeable
2526
import Development.IDE as D
27+
import Development.IDE.Core.PluginUtils
2628
import Development.IDE.Core.Shake (restartShakeSession)
2729
import qualified Development.IDE.Core.Shake as Shake
2830
import Development.IDE.Graph (Key, alwaysRerun)
@@ -31,6 +33,7 @@ import Development.IDE.Types.Shake (toKey)
3133
import qualified Distribution.Fields as Syntax
3234
import qualified Distribution.Parsec.Position as Syntax
3335
import GHC.Generics
36+
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
3437
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3538
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
3639
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
@@ -44,6 +47,7 @@ import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
4447
import Ide.Plugin.Cabal.Orphans ()
4548
import Ide.Plugin.Cabal.Outline
4649
import qualified Ide.Plugin.Cabal.Parse as Parse
50+
import Ide.Plugin.Error
4751
import Ide.Types
4852
import qualified Language.LSP.Protocol.Lens as JL
4953
import qualified Language.LSP.Protocol.Message as LSP
@@ -279,6 +283,33 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
279283
let completionTexts = fmap (^. JL.label) completions
280284
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
281285

286+
-- | CodeActions for going to definitions.
287+
--
288+
-- Provides a CodeAction for going to a definition when clicking on an identifier.
289+
-- The definition is found by traversing the sections and comparing their name to
290+
-- the clicked identifier.
291+
--
292+
-- TODO: Support more definitions than sections.
293+
gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
294+
gotoDefinition ideState _ msgParam = do
295+
nfp <- getNormalizedFilePathE uri
296+
cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp
297+
case CabalFields.findTextWord cursor cabalFields of
298+
Nothing ->
299+
pure $ InR $ InR Null
300+
Just cursorText -> do
301+
commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp
302+
case find (isSectionArgName cursorText) commonSections of
303+
Nothing ->
304+
pure $ InR $ InR Null
305+
Just commonSection -> do
306+
pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
307+
where
308+
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
309+
uri = msgParam ^. JL.textDocument . JL.uri
310+
isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
311+
isSectionArgName _ _ = False
312+
282313
-- ----------------------------------------------------------------
283314
-- Cabal file of Interest rules and global variable
284315
-- ----------------------------------------------------------------

‎plugins/hls-cabal-plugin/test/Main.hs

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Definition (gotoDefinitionTests)
2121
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
2222
import qualified Ide.Plugin.Cabal.Parse as Lib
2323
import qualified Language.LSP.Protocol.Lens as L
24+
import qualified Language.LSP.Protocol.Types as LSP
2425
import Outline (outlineTests)
2526
import System.FilePath
2627
import Test.Hls
@@ -229,3 +230,56 @@ codeActionTests = testGroup "Code Actions"
229230
InR action@CodeAction{_title} <- codeActions
230231
guard (_title == "Replace with " <> license)
231232
pure action
233+
234+
-- ----------------------------------------------------------------------------
235+
-- Goto Definition Tests
236+
-- ----------------------------------------------------------------------------
237+
238+
gotoDefinitionTests :: TestTree
239+
gotoDefinitionTests = testGroup "Goto Definition"
240+
[ positiveTest "middle of identifier" (mkP 27 16) (mkR 6 0 7 22)
241+
, positiveTest "left of identifier" (mkP 30 12) (mkR 10 0 17 40)
242+
, positiveTest "right of identifier" (mkP 33 22) (mkR 20 0 23 34)
243+
, positiveTest "left of '-' in identifier" (mkP 36 20) (mkR 6 0 7 22)
244+
, positiveTest "right of '-' in identifier" (mkP 39 19) (mkR 10 0 17 40)
245+
, positiveTest "identifier in identifier list" (mkP 42 16) (mkR 20 0 23 34)
246+
, positiveTest "left of ',' right of identifier" (mkP 45 33) (mkR 10 0 17 40)
247+
, positiveTest "right of ',' left of identifier" (mkP 48 34) (mkR 6 0 7 22)
248+
249+
, negativeTest "right of ',' left of space" (mkP 51 23)
250+
, negativeTest "right of ':' left of space" (mkP 54 11)
251+
, negativeTest "not a definition" (mkP 57 8)
252+
, negativeTest "empty space" (mkP 59 7)
253+
]
254+
where
255+
mkP :: UInt -> UInt -> Position
256+
mkP x1 y1 = Position x1 y1
257+
258+
mkR :: UInt -> UInt -> UInt -> UInt -> Range
259+
mkR x1 y1 x2 y2 = Range (mkP x1 y1) (mkP x2 y2)
260+
261+
getDefinition :: Show b => (Definition |? b) -> Range
262+
getDefinition (InL (Definition (InL loc))) = loc^.L.range
263+
getDefinition unk = error $ "Unexpected pattern '" ++ show unk ++ "' , expected '(InL (Definition (InL loc))'"
264+
265+
-- A positive test checks if the provided range is equal
266+
-- to the expected range from the definition in the test file.
267+
-- The test emulates a goto-definition request of an actual definition.
268+
positiveTest :: TestName -> Position -> Range -> TestTree
269+
positiveTest testName cursorPos expectedRange =
270+
runCabalTestCaseSession testName "goto-definition" $ do
271+
doc <- openDoc "simple-with-common.cabal" "cabal"
272+
definitions <- getDefinitions doc cursorPos
273+
let locationRange = getDefinition definitions
274+
liftIO $ locationRange @?= expectedRange
275+
276+
-- A negative test checks if the request failed and
277+
-- the provided result is empty, i.e. `InR $ InR Null`.
278+
-- The test emulates a goto-definition request of anything but an
279+
-- actual definition.
280+
negativeTest :: TestName -> Position -> TestTree
281+
negativeTest testName cursorPos =
282+
runCabalTestCaseSession testName "goto-definition" $ do
283+
doc <- openDoc "simple-with-common.cabal" "cabal"
284+
empty <- getDefinitions doc cursorPos
285+
liftIO $ empty @?= (InR $ InR LSP.Null)

‎plugins/hls-cabal-plugin/test/testdata/goto-definition/simple-with-common.cabal

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
cabal-version: 3.0
2+
name: simple-cabal
3+
version: 0.1.0.0
4+
license: MIT
5+
6+
-- Range : (6, 0) - (7, 22)
7+
common warnings-0
8+
ghc-options: -Wall
9+
10+
-- Range : (10, 0) - (17, 40)
11+
common warnings-1
12+
ghc-options: -Wall
13+
-Wredundant-constraints
14+
-Wunused-packages
15+
16+
-Wno-name-shadowing
17+
18+
-Wno-unticked-promoted-constructors
19+
20+
-- Range : (20, 0) - (23, 34)
21+
common warnings-2
22+
ghc-options: -Wall
23+
-Wredundant-constraints
24+
-Wunused-packages
25+
26+
library
27+
28+
import: warnings-0
29+
-- ^ Position: (27, 16), middle of identifier
30+
31+
import: warnings-1
32+
-- ^ Position: (30, 12), left of identifier
33+
34+
import: warnings-2
35+
-- ^ Position: (33, 22), right of identifier
36+
37+
import: warnings-0
38+
-- ^ Position: (36, 20), left of '-' in identifier
39+
40+
import: warnings-1
41+
-- ^ Position: (39, 19), right of "-" in identifier
42+
43+
import: warnings-2,warnings-1,warnings-0
44+
-- ^ Position: (42, 16), identifier in identifier list
45+
46+
import: warnings-2,warnings-1,warnings-0
47+
-- ^ Position: (45, 33), left of ',' right of identifier
48+
49+
import: warnings-2,warnings-1,warnings-0
50+
-- ^ Position: (48, 34), right of ',' left of identifier
51+
52+
import: warnings-2, warnings-1,warnings-0
53+
-- ^ Position: (51, 37), right of ',' left of space
54+
55+
import: warnings-0
56+
-- ^ Position: (54, 11), right of ':' left of space
57+
58+
import: warnings-0
59+
-- ^ Position: (57, 8), not a definition
60+
61+
-- EOL
62+
-- ^ Position: (59, 7), empty space

0 commit comments

Comments
 (0)