@@ -8,9 +8,12 @@ module Main (
88import Completer (completerTests )
99import Context (contextTests )
1010import Control.Lens ((^.) )
11+ import Control.Lens.Fold ((^?) )
1112import Control.Monad (guard )
1213import qualified Data.ByteString as BS
1314import Data.Either (isRight )
15+ import Data.List.Extra (nubOrdOn )
16+ import qualified Data.Maybe as Maybe
1417import qualified Data.Text as T
1518import qualified Data.Text as Text
1619import 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
0 commit comments