@@ -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-- ------------------------------------------------------------------------
@@ -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
0 commit comments