Skip to content

Commit f4422a3

Browse files
fendorfendor
committed
Add integration tests for field name code action fixes
1 parent d30c294 commit f4422a3

File tree

5 files changed

+156
-50
lines changed

5 files changed

+156
-50
lines changed

‎haskell-language-server.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -284,6 +284,7 @@ test-suite hls-cabal-plugin-tests
284284
, base
285285
, bytestring
286286
, Cabal-syntax >= 3.7
287+
, extra
287288
, filepath
288289
, ghcide
289290
, haskell-language-server:hls-cabal-plugin

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

+78-50
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,12 @@ module Main (
88
import Completer (completerTests)
99
import Context (contextTests)
1010
import Control.Lens ((^.))
11+
import Control.Lens.Fold ((^?))
1112
import Control.Monad (guard)
1213
import qualified Data.ByteString as BS
1314
import Data.Either (isRight)
15+
import Data.List.Extra (nubOrdOn)
16+
import qualified Data.Maybe as Maybe
1417
import qualified Data.Text as T
1518
import qualified Data.Text as Text
1619
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
@@ -29,6 +32,7 @@ main = do
2932
, pluginTests
3033
, completerTests
3134
, contextTests
35+
, codeActionTests
3236
]
3337

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

‎plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal

+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+
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+
ghc-opts: -Wall
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+

‎plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal

+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-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+
location: fake
23+
24+
library
25+
ghc-options: -Wall
26+
-- Import isn't supported right now.
27+
impor: 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)