@@ -125,127 +125,54 @@ spec = describe "code actions" $ do
125125 liftIO $ x `shouldBe` " foo = putStrLn \" world\" "
126126
127127 describe " import suggestions" $ do
128- it " works with 3.8 code action kinds" $ runSession hieCommand fullCaps " test/testdata" $ do
129- doc <- openDoc " CodeActionImport.hs" " haskell"
130-
131- -- ignore the first empty hlint diagnostic publish
132- [_,diag: _] <- count 2 waitForDiagnostics
133- liftIO $ diag ^. L. message `shouldBe` " Variable not in scope: when :: Bool -> IO () -> IO ()"
134-
135- actionsOrCommands <- getAllCodeActions doc
136- let actns = map fromAction actionsOrCommands
137-
138- liftIO $ do
139- head actns ^. L. title `shouldBe` " Import module Control.Monad"
140- head (tail actns) ^. L. title `shouldBe` " Import module Control.Monad (when)"
141- forM_ actns $ \ a -> do
142- a ^. L. kind `shouldBe` Just CodeActionQuickFix
143- a ^. L. command `shouldSatisfy` isJust
144- a ^. L. edit `shouldBe` Nothing
145- let hasOneDiag (Just (List [_])) = True
146- hasOneDiag _ = False
147- a ^. L. diagnostics `shouldSatisfy` hasOneDiag
148- length actns `shouldBe` 10
149-
150- executeCodeAction (head actns)
151-
152- contents <- getDocumentEdit doc
153- liftIO $ contents `shouldBe` " import Control.Monad\n main :: IO ()\n main = when True $ putStrLn \" hello\" "
154- it " formats with brittany" $ runSession hieCommand fullCaps " test/testdata" $ do
155- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
156- _ <- waitForDiagnosticsSource " ghcmod"
157-
158- actionsOrCommands <- getAllCodeActions doc
159- let action: _ = map fromAction actionsOrCommands
160- executeCodeAction action
161-
162- contents <- getDocumentEdit doc
163- liftIO $ do
164- let l1: l2: l3: _ = T. lines contents
165- l1 `shouldBe` " import qualified Data.Maybe"
166- l2 `shouldBe` " import Control.Monad"
167- l3 `shouldBe` " main :: IO ()"
168- it " formats with floskell" $ runSession hieCommand fullCaps " test/testdata" $ do
169- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
170- _ <- waitForDiagnosticsSource " ghcmod"
171-
172- let config = def { formattingProvider = " floskell" }
173- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
174-
175- actionsOrCommands <- getAllCodeActions doc
176- let action: _ = map fromAction actionsOrCommands
177- executeCodeAction action
178-
179- contents <- getDocumentEdit doc
180- liftIO $ do
181- let l1: l2: l3: _ = T. lines contents
182- l1 `shouldBe` " import qualified Data.Maybe"
183- l2 `shouldBe` " import Control.Monad"
184- l3 `shouldBe` " main :: IO ()"
185- it " import-list formats with brittany" $ runSession hieCommand fullCaps " test/testdata" $ do
186- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
187- _ <- waitForDiagnosticsSource " ghcmod"
188-
189- actionsOrCommands <- getAllCodeActions doc
190- let _: action: _ = map fromAction actionsOrCommands
191- executeCodeAction action
192-
193- contents <- getDocumentEdit doc
194- liftIO $ do
195- let l1: l2: l3: _ = T. lines contents
196- l1 `shouldBe` " import qualified Data.Maybe"
197- l2 `shouldBe` " import Control.Monad ( when )"
198- l3 `shouldBe` " main :: IO ()"
199- it " import-list formats with floskell" $ runSession hieCommand fullCaps " test/testdata" $ do
200- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
201- _ <- waitForDiagnosticsSource " ghcmod"
202-
203- let config = def { formattingProvider = " floskell" }
204- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
205-
206- actionsOrCommands <- getAllCodeActions doc
207- let _: action: _ = map fromAction actionsOrCommands
208- executeCodeAction action
209-
210- contents <- getDocumentEdit doc
211- liftIO $ do
212- let l1: l2: l3: _ = T. lines contents
213- l1 `shouldBe` " import qualified Data.Maybe"
214- l2 `shouldBe` " import Control.Monad (when)"
215- l3 `shouldBe` " main :: IO ()"
216- -- TODO: repeated code actions
217- it " respects format config" $ runSession hieCommand fullCaps " test/testdata" $ do
218- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
219- _ <- waitForDiagnosticsSource " ghcmod"
220-
221- let config = def { formatOnImportOn = False }
222- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
223-
224- actionsOrCommands <- getAllCodeActions doc
225- let action: _ = map fromAction actionsOrCommands
226- executeCodeAction action
227-
228- contents <- getDocumentEdit doc
229- liftIO $ do
230- let l1: l2: _ = T. lines contents
231- l1 `shouldBe` " import qualified Data.Maybe"
232- l2 `shouldBe` " import Control.Monad"
233- it " import-list respects format config" $ runSession hieCommand fullCaps " test/testdata" $ do
234- doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
235- _ <- waitForDiagnosticsSource " ghcmod"
236-
237- let config = def { formatOnImportOn = False }
238- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
239-
240- actionsOrCommands <- getAllCodeActions doc
241- let _: action: _ = map fromAction actionsOrCommands
242- executeCodeAction action
243-
244- contents <- getDocumentEdit doc
245- liftIO $ do
246- let l1: l2: _ = T. lines contents
247- l1 `shouldBe` " import qualified Data.Maybe"
248- l2 `shouldBe` " import Control.Monad (when)"
128+ hsImportSpec " brittany"
129+ [ -- Expected output for simple format.
130+ [ " import qualified Data.Maybe"
131+ , " import Control.Monad"
132+ , " main :: IO ()"
133+ , " main = when True $ putStrLn \" hello\" "
134+ ]
135+ , -- Use an import list and format the output.
136+ [ " import qualified Data.Maybe"
137+ , " import Control.Monad ( when )"
138+ , " main :: IO ()"
139+ , " main = when True $ putStrLn \" hello\" "
140+ ]
141+ , -- Multiple import lists, should not introduce multiple newlines.
142+ [ " import Data.Maybe ( fromMaybe )"
143+ , " import Control.Monad ( when )"
144+ , " import System.IO ( hPutStrLn"
145+ , " , stdout"
146+ , " )"
147+ , " main ="
148+ , " when True"
149+ , " $ hPutStrLn stdout"
150+ , " $ fromMaybe \" Good night, World!\" (Just \" Hello, World!\" )"
151+ ]
152+ ]
153+ hsImportSpec " floskell"
154+ [ -- Expected output for simple format.
155+ [ " import qualified Data.Maybe"
156+ , " import Control.Monad"
157+ , " main :: IO ()"
158+ , " main = when True $ putStrLn \" hello\" "
159+ ]
160+ , -- Use an import list and format the output.
161+ [ " import qualified Data.Maybe"
162+ , " import Control.Monad (when)"
163+ , " main :: IO ()"
164+ , " main = when True $ putStrLn \" hello\" "
165+ ]
166+ , -- Multiple import lists, should not introduce multiple newlines.
167+ [ " import Data.Maybe (fromMaybe)"
168+ , " import Control.Monad (when)"
169+ , " import System.IO (hPutStrLn, stdout)"
170+ , " main ="
171+ , " when True"
172+ , " $ hPutStrLn stdout"
173+ , " $ fromMaybe \" Good night, World!\" (Just \" Hello, World!\" )"
174+ ]
175+ ]
249176 describe " add package suggestions" $ do
250177 it " adds to .cabal files" $ runSession hieCommand fullCaps " test/testdata/addPackageTest/cabal" $ do
251178 doc <- openDoc " AddPackage.hs" " haskell"
@@ -539,6 +466,164 @@ spec = describe "code actions" $ do
539466 kinds `shouldSatisfy` all (Just CodeActionRefactorInline == )
540467
541468-- ---------------------------------------------------------------------
469+ -- Parameterized HsImport Spec.
470+ -- ---------------------------------------------------------------------
471+ hsImportSpec :: T. Text -> [[T. Text ]]-> Spec
472+ hsImportSpec formatterName [e1, e2, e3] =
473+ describe (" Execute HsImport with formatter " <> T. unpack formatterName) $ do
474+ it " works with 3.8 code action kinds" $ runSession hieCommand fullCaps " test/testdata" $ do
475+ doc <- openDoc " CodeActionImport.hs" " haskell"
476+ -- No Formatting:
477+ let config = def { formattingProvider = " none" }
478+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
479+
480+ -- ignore the first empty hlint diagnostic publish
481+ [_,diag: _] <- count 2 waitForDiagnostics
482+ liftIO $ diag ^. L. message `shouldBe` " Variable not in scope: when :: Bool -> IO () -> IO ()"
483+
484+ actionsOrCommands <- getAllCodeActions doc
485+ let actns = map fromAction actionsOrCommands
486+
487+ liftIO $ do
488+ head actns ^. L. title `shouldBe` " Import module Control.Monad"
489+ head (tail actns) ^. L. title `shouldBe` " Import module Control.Monad (when)"
490+ forM_ actns $ \ a -> do
491+ a ^. L. kind `shouldBe` Just CodeActionQuickFix
492+ a ^. L. command `shouldSatisfy` isJust
493+ a ^. L. edit `shouldBe` Nothing
494+ let hasOneDiag (Just (List [_])) = True
495+ hasOneDiag _ = False
496+ a ^. L. diagnostics `shouldSatisfy` hasOneDiag
497+ length actns `shouldBe` 10
498+
499+ executeCodeAction (head actns)
500+
501+ contents <- getDocumentEdit doc
502+ liftIO $ contents `shouldBe` " import Control.Monad\n main :: IO ()\n main = when True $ putStrLn \" hello\" "
503+
504+ it " formats" $ runSession hieCommand fullCaps " test/testdata" $ do
505+ doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
506+ _ <- waitForDiagnosticsSource " ghcmod"
507+
508+ let config = def { formattingProvider = formatterName }
509+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
510+
511+ actionsOrCommands <- getAllCodeActions doc
512+ let action: _ = map fromAction actionsOrCommands
513+ executeCodeAction action
514+
515+ contents <- getDocumentEdit doc
516+ liftIO $ T. lines contents `shouldMatchList` e1
517+
518+ it " import-list formats" $ runSession hieCommand fullCaps " test/testdata" $ do
519+ doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
520+ _ <- waitForDiagnosticsSource " ghcmod"
521+
522+ let config = def { formattingProvider = formatterName }
523+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
524+
525+ actionsOrCommands <- getAllCodeActions doc
526+ let _: action: _ = map fromAction actionsOrCommands
527+ executeCodeAction action
528+
529+ contents <- getDocumentEdit doc
530+ liftIO $ T. lines contents `shouldMatchList` e2
531+
532+ it " multiple import-list formats" $ runSession hieCommand fullCaps " test/testdata" $ do
533+ doc <- openDoc " CodeActionImportList.hs" " haskell"
534+ _ <- waitForDiagnosticsSource " ghcmod"
535+
536+ let config = def { formattingProvider = formatterName }
537+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
538+
539+ let wantedCodeActionTitles = [ " Import module System.IO (hPutStrLn)"
540+ , " Import module System.IO (stdout)"
541+ , " Import module Control.Monad (when)"
542+ , " Import module Data.Maybe (fromMaybe)"
543+ ]
544+
545+ mapM_ (executeCodeActionByName doc) wantedCodeActionTitles
546+
547+ contents <- getDocumentEdit doc
548+ liftIO $ T. lines contents `shouldBe` e3
549+
550+ it " respects format config, multiple import-list" $ runSession hieCommand fullCaps " test/testdata" $ do
551+ doc <- openDoc " CodeActionImportList.hs" " haskell"
552+ _ <- waitForDiagnosticsSource " ghcmod"
553+
554+ let config = def { formatOnImportOn = False , formattingProvider = formatterName }
555+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
556+
557+ let wantedCodeActionTitles = [ " Import module System.IO (hPutStrLn)"
558+ , " Import module System.IO (stdout)"
559+ , " Import module Control.Monad (when)"
560+ , " Import module Data.Maybe (fromMaybe)"
561+ ]
562+
563+ mapM_ (executeCodeActionByName doc) wantedCodeActionTitles
564+
565+ contents <- getDocumentEdit doc
566+ liftIO $ T. lines contents `shouldBe`
567+ [ " import Data.Maybe (fromMaybe)"
568+ , " import Control.Monad (when)"
569+ , " import System.IO (hPutStrLn, stdout)"
570+ , " main :: IO ()"
571+ , " main ="
572+ , " when True"
573+ , " $ hPutStrLn stdout"
574+ , " $ fromMaybe \" Good night, World!\" (Just \" Hello, World!\" )]"
575+ ]
576+ it " respects format config" $ runSession hieCommand fullCaps " test/testdata" $ do
577+ doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
578+ _ <- waitForDiagnosticsSource " ghcmod"
579+
580+ let config = def { formatOnImportOn = False , formattingProvider = formatterName }
581+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
582+
583+ actionsOrCommands <- getAllCodeActions doc
584+ let action: _ = map fromAction actionsOrCommands
585+ executeCodeAction action
586+
587+ contents <- getDocumentEdit doc
588+ liftIO $ do
589+ let [l1, l2, l3, l4] = T. lines contents
590+ l1 `shouldBe` " import qualified Data.Maybe"
591+ l2 `shouldBe` " import Control.Monad"
592+ l3 `shouldBe` " main :: IO ()"
593+ l4 `shouldBe` " main = when True $ putStrLn \" hello\" "
594+
595+ it (" import-list respects format config with " <> T. unpack formatterName) $ runSession hieCommand fullCaps " test/testdata" $ do
596+ doc <- openDoc " CodeActionImportBrittany.hs" " haskell"
597+ _ <- waitForDiagnosticsSource " ghcmod"
598+
599+ let config = def { formatOnImportOn = False , formattingProvider = formatterName }
600+ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
601+
602+ actionsOrCommands <- getAllCodeActions doc
603+ let _: action: _ = map fromAction actionsOrCommands
604+ executeCodeAction action
605+
606+ contents <- getDocumentEdit doc
607+ liftIO $ do
608+ let [l1, l2, l3, l4] = T. lines contents
609+ l1 `shouldBe` " import qualified Data.Maybe"
610+ l2 `shouldBe` " import Control.Monad (when)"
611+ l3 `shouldBe` " main :: IO ()"
612+ l4 `shouldBe` " main = when True $ putStrLn \" hello\" "
613+ where
614+ executeCodeActionByName :: TextDocumentIdentifier -> T. Text -> Session ()
615+ executeCodeActionByName doc name = do
616+ actionsOrCommands <- getAllCodeActions doc
617+ let action: _ = filter ((== name) . (^. L. title)) $ map fromAction actionsOrCommands
618+ executeCodeAction action
619+
620+ -- Silence warnings
621+ hsImportSpec formatter args =
622+ error $ " Not the right amount of arguments for \" hsImportSpec ("
623+ ++ T. unpack formatter
624+ ++ " )\" , expected 3, got "
625+ ++ show (length args)
626+ -- ---------------------------------------------------------------------
542627
543628fromAction :: CAResult -> CodeAction
544629fromAction (CACodeAction action) = action
0 commit comments