Skip to content

Commit 85fc20e

Browse files
fendordyniec
authored andcommitted
Add integration tests for field name code action fixes
1 parent 751f5f6 commit 85fc20e

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