Skip to content

Commit 200c8df

Browse files
fendorVeryMilkyJoe
authored andcommitted
Add integration tests for field name code action fixes
1 parent b0e9815 commit 200c8df

File tree

6 files changed

+159
-50
lines changed

6 files changed

+159
-50
lines changed

haskell-language-server.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -286,6 +286,7 @@ test-suite hls-cabal-plugin-tests
286286
, base
287287
, bytestring
288288
, Cabal-syntax >= 3.7
289+
, extra
289290
, filepath
290291
, ghcide
291292
, haskell-language-server:hls-cabal-plugin

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

+1
Original file line numberDiff line numberDiff line change
@@ -385,6 +385,7 @@ computeCompletionsAt recorder ide prefInfo fp fields = do
385385
-- The `withStale` option is very important here, since we often call this rule with invalid cabal files.
386386
mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp
387387
pure $ fmap fst mGPD
388+
, getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp
388389
, cabalPrefixInfo = prefInfo
389390
, stanzaName =
390391
case fst ctx of

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

+80-50
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,12 @@ module Main (
99
import Completer (completerTests)
1010
import Context (contextTests)
1111
import Control.Lens ((^.))
12+
import Control.Lens.Fold ((^?))
1213
import Control.Monad (guard)
1314
import qualified Data.ByteString as BS
1415
import Data.Either (isRight)
16+
import Data.List.Extra (nubOrdOn)
17+
import qualified Data.Maybe as Maybe
1518
import qualified Data.Text as T
1619
import qualified Data.Text as Text
1720
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
@@ -30,6 +33,7 @@ main = do
3033
, pluginTests
3134
, completerTests
3235
, contextTests
36+
, codeActionTests
3337
]
3438

3539
-- ------------------------------------------------------------------------
@@ -137,57 +141,83 @@ pluginTests =
137141
unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
138142
unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
139143
]
140-
, testGroup
141-
"Code Actions"
142-
[ runCabalTestCaseSession "BSD-3" "" $ do
143-
doc <- openDoc "licenseCodeAction.cabal" "cabal"
144-
diags <- waitForDiagnosticsFromSource doc "cabal"
145-
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]
146-
liftIO $ do
147-
length diags @?= 1
148-
reduceDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
149-
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
150-
[codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
151-
executeCodeAction codeAction
152-
contents <- documentContents doc
153-
liftIO $
154-
contents
155-
@?= Text.unlines
156-
[ "cabal-version: 3.0"
157-
, "name: licenseCodeAction"
158-
, "version: 0.1.0.0"
159-
, "license: BSD-3-Clause"
160-
, ""
161-
, "library"
162-
, " build-depends: base"
163-
, " default-language: Haskell2010"
164-
]
165-
, runCabalTestCaseSession "Apache-2.0" "" $ do
166-
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
167-
diags <- waitForDiagnosticsFromSource doc "cabal"
168-
-- test if it supports typos in license name, here 'apahe'
169-
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"]
170-
liftIO $ do
171-
length diags @?= 1
172-
reduceDiag ^. L.range @?= Range (Position 3 25) (Position 4 0)
173-
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
174-
[codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
175-
executeCodeAction codeAction
176-
contents <- documentContents doc
177-
liftIO $
178-
contents
179-
@?= Text.unlines
180-
[ "cabal-version: 3.0"
181-
, "name: licenseCodeAction2"
182-
, "version: 0.1.0.0"
183-
, "license: Apache-2.0"
184-
, ""
185-
, "library"
186-
, " build-depends: base"
187-
, " default-language: Haskell2010"
188-
]
189-
]
190144
]
145+
-- ----------------------------------------------------------------------------
146+
-- Code Action Tests
147+
-- ----------------------------------------------------------------------------
148+
149+
codeActionTests :: TestTree
150+
codeActionTests = testGroup "Code Actions"
151+
[ runCabalTestCaseSession "BSD-3" "" $ do
152+
doc <- openDoc "licenseCodeAction.cabal" "cabal"
153+
diags <- waitForDiagnosticsFromSource doc "cabal"
154+
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]
155+
liftIO $ do
156+
length diags @?= 1
157+
reduceDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
158+
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
159+
[codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
160+
executeCodeAction codeAction
161+
contents <- documentContents doc
162+
liftIO $
163+
contents
164+
@?= Text.unlines
165+
[ "cabal-version: 3.0"
166+
, "name: licenseCodeAction"
167+
, "version: 0.1.0.0"
168+
, "license: BSD-3-Clause"
169+
, ""
170+
, "library"
171+
, " build-depends: base"
172+
, " default-language: Haskell2010"
173+
]
174+
, runCabalTestCaseSession "Apache-2.0" "" $ do
175+
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
176+
diags <- waitForDiagnosticsFromSource doc "cabal"
177+
-- test if it supports typos in license name, here 'apahe'
178+
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"]
179+
liftIO $ do
180+
length diags @?= 1
181+
reduceDiag ^. L.range @?= Range (Position 3 25) (Position 4 0)
182+
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
183+
[codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
184+
executeCodeAction codeAction
185+
contents <- documentContents doc
186+
liftIO $
187+
contents
188+
@?= Text.unlines
189+
[ "cabal-version: 3.0"
190+
, "name: licenseCodeAction2"
191+
, "version: 0.1.0.0"
192+
, "license: Apache-2.0"
193+
, ""
194+
, "library"
195+
, " build-depends: base"
196+
, " default-language: Haskell2010"
197+
]
198+
, runCabalGoldenSession "Code Actions - Can fix field names" "code-actions" "FieldSuggestions" $ \doc -> do
199+
_ <- waitForDiagnosticsFrom doc
200+
cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc
201+
-- Filter out the code actions we want to invoke.
202+
-- We only want to invoke Code Actions with certain titles, and
203+
-- we want to invoke them only once, not once for each cursor request.
204+
-- 'getAllCodeActions' iterates over each cursor position and requests code actions.
205+
let selectedCas = nubOrdOn (^. L.title) $ filter
206+
(\ca -> (ca ^. L.title) `elem`
207+
[ "Replace with license"
208+
, "Replace with build-type"
209+
, "Replace with extra-doc-files"
210+
, "Replace with ghc-options"
211+
, "Replace with location"
212+
, "Replace with default-language"
213+
, "Replace with import"
214+
, "Replace with build-depends"
215+
, "Replace with main-is"
216+
, "Replace with hs-source-dirs"
217+
]) cas
218+
mapM_ executeCodeAction selectedCas
219+
pure ()
220+
]
191221
where
192222
getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction]
193223
getLicenseAction license codeActions = do

plugins/hls-cabal-plugin/test/Utils.hs

+3
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,9 @@ runCabalSession :: FilePath -> Session a -> IO a
4646
runCabalSession subdir =
4747
failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir </> subdir)
4848

49+
runCabalGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
50+
runCabalGoldenSession title subdir fp act = goldenWithCabalDoc def cabalPlugin title testDataDir (subdir </> fp) "golden" "cabal" act
51+
4952
testDataDir :: FilePath
5053
testDataDir = "plugins" </> "hls-cabal-plugin" </> "test" </> "testdata"
5154

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
cabal-version: 3.0
2+
name: FieldSuggestions
3+
version: 0.1.0
4+
licens: BSD-3-Clause
5+
6+
buil-type: Simple
7+
8+
extra-doc-fils:
9+
ChangeLog
10+
11+
-- Default warnings in HLS
12+
common warnings
13+
-- Common sections are currently not supported. So, ignore!
14+
ghc-option: -Wall
15+
-Wredundant-constraints
16+
-Wunused-packages
17+
-Wno-name-shadowing
18+
-Wno-unticked-promoted-constructors
19+
20+
source-repository head
21+
type: git
22+
loc: fake
23+
24+
library
25+
default-lang: Haskell2010
26+
-- Import isn't supported right now.
27+
impor: warnings
28+
build-dep: base
29+
30+
executable my-exe
31+
mains: Main.hs
32+
33+
test-suite Test
34+
type: exitcode-stdio-1.0
35+
main-is: Test.hs
36+
hs-source-drs:
37+
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
cabal-version: 3.0
2+
name: FieldSuggestions
3+
version: 0.1.0
4+
license: BSD-3-Clause
5+
6+
build-type: Simple
7+
8+
extra-doc-files:
9+
ChangeLog
10+
11+
-- Default warnings in HLS
12+
common warnings
13+
-- Common sections are currently not supported. So, ignore!
14+
ghc-options: -Wall
15+
-Wredundant-constraints
16+
-Wunused-packages
17+
-Wno-name-shadowing
18+
-Wno-unticked-promoted-constructors
19+
20+
source-repository head
21+
type: git
22+
location: fake
23+
24+
library
25+
default-language: Haskell2010
26+
-- Import isn't supported right now.
27+
import: warnings
28+
build-depends: base
29+
30+
executable my-exe
31+
main-is: Main.hs
32+
33+
test-suite Test
34+
type: exitcode-stdio-1.0
35+
main-is: Test.hs
36+
hs-source-dirs:
37+

0 commit comments

Comments
 (0)