Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 6206144

Browse files
fendorfendor
committed
Refactor HsImport Code Action tests
Adds a parameterized test suite for formatter providers. Should be used when introducing new formatters.
1 parent 590980a commit 6206144

File tree

1 file changed

+213
-121
lines changed

1 file changed

+213
-121
lines changed

‎test/functional/FunctionalCodeActionsSpec.hs

+213-121
Original file line numberDiff line numberDiff line change
@@ -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\nmain :: IO ()\nmain = 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,171 @@ 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\nmain :: IO ()\nmain = 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_ (const (executeCodeActionByName doc wantedCodeActionTitles)) 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_ (const (executeCodeActionByName doc wantedCodeActionTitles)) 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 names = do
616+
actionsOrCommands <- getAllCodeActions doc
617+
let allActions = map fromAction actionsOrCommands
618+
let actions = filter (\actn -> actn ^. L.title `elem` names) allActions
619+
case actions of
620+
(action:_) -> executeCodeAction action
621+
xs ->
622+
error
623+
$ "Found an unexpected amount of action. Expected 1, but got: "
624+
++ show (length xs)
625+
++ "\n. Titles: " ++ show (map (^. L.title) allActions)
626+
627+
-- Silence warnings
628+
hsImportSpec formatter args =
629+
error $ "Not the right amount of arguments for \"hsImportSpec ("
630+
++ T.unpack formatter
631+
++ ")\", expected 3, got "
632+
++ show (length args)
633+
-- ---------------------------------------------------------------------
542634

543635
fromAction :: CAResult -> CodeAction
544636
fromAction (CACodeAction action) = action

0 commit comments

Comments
 (0)