haskell-language-server-2.15.0.0: plugins/hls-export-plugin/test/Main.hs
module Main (main) where
import Control.Lens ((^.))
import Data.Char (isSpace)
import Data.Either (rights)
import Data.List (sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Ide.Plugin.Export (descriptor)
import qualified Language.LSP.Protocol.Lens as L
import System.FilePath ((</>))
import Test.Hls
import Test.Hls.FileSystem (copy, directProject,
mkVirtualFileTree)
plugin :: PluginTestDescriptor ()
plugin = mkPluginTestDescriptor' descriptor "export"
testDataDir :: FilePath
testDataDir = "plugins" </> "hls-export-plugin" </> "test" </> "testdata"
-- | Open the named module in its own temporary single-file project, so each
-- test compiles only the file it needs and cannot pick up signals from a
-- sibling module.
runExport :: FilePath -> (TextDocumentIdentifier -> Session a) -> IO a
runExport = runExportWith []
-- | Like 'runExport' but also copies the named extra files into the project,
-- e.g. a header a CPP @#include@ pulls in next to the module.
runExportWith :: [FilePath] -> FilePath -> (TextDocumentIdentifier -> Session a) -> IO a
runExportWith extra hsFile act =
runSessionWithTestConfig def
{ testDirLocation = Right (mkVirtualFileTree testDataDir (directProject hsFile <> map copy extra))
, testPluginDescriptor = plugin
} $ \_dir -> do
doc <- openDoc hsFile "haskell"
waitForKickDone
act doc
codeActionTitles :: TextDocumentIdentifier -> Range -> Session [T.Text]
codeActionTitles doc range =
sort . map (^. L.title) . rights . map toEither
<$> getCodeActions doc range
executeByPrefix :: T.Text -> TextDocumentIdentifier -> Range -> Session ()
executeByPrefix prefix doc range = do
actions <- rights . map toEither <$> getCodeActions doc range
case filter (\ca -> prefix `T.isPrefixOf` (ca ^. L.title)) actions of
(ca:_) -> executeCodeAction ca
[] -> liftIO $ assertFailure (T.unpack prefix <> "...` action not offered")
executeExportAction, executeRemoveAction :: TextDocumentIdentifier -> Range -> Session ()
executeExportAction = executeByPrefix "Export `"
executeRemoveAction = executeByPrefix "Unexport `"
noActionWithPrefix :: T.Text -> TextDocumentIdentifier -> Range -> Session ()
noActionWithPrefix prefix doc range = do
titles <- codeActionTitles doc range
liftIO $ not (any (prefix `T.isPrefixOf`) titles)
@? ("Did not expect " <> T.unpack prefix <> " action, saw: " <> show titles)
noExportOffered, noRemoveOffered :: TextDocumentIdentifier -> Range -> Session ()
noExportOffered = noActionWithPrefix "Export `"
noRemoveOffered = noActionWithPrefix "Unexport `"
-- | Fail unless some variant is an infix of the text. The message dumps it.
assertAnyInfix :: T.Text -> [T.Text] -> Assertion
assertAnyInfix hay variants =
any (`T.isInfixOf` hay) variants
@? ("Expected one of " <> show variants <> " in:\n" <> T.unpack hay)
containsAfter :: TextDocumentIdentifier -> [T.Text] -> Session ()
containsAfter doc expected = documentContents doc >>= liftIO . (`assertAnyInfix` expected)
-- | Fail unless every needle is an infix of the haystack. Used to assert that
-- CPP directives and conditional items survive an edit verbatim.
assertContainsAll :: T.Text -> [T.Text] -> Assertion
assertContainsAll hay = mapM_ $ \needle ->
needle `T.isInfixOf` hay
@? ("Expected " <> show needle <> " in:\n" <> T.unpack hay)
-- | Lines from the first @(@ through the @) where@ line (included, so an item on
-- the closing line still counts).
exportListRegion :: T.Text -> [T.Text]
exportListRegion txt =
let afterOpen = dropWhile (not . T.isInfixOf "(") (T.lines txt)
(body, close) = break (T.isInfixOf ") where") afterOpen
in body ++ take 1 close
-- | Does @name@ appear in the export list at CPP nesting level 0, i.e. not
-- guarded by any @#if@/@#ifdef@/@#ifndef@?
exportedUnconditionally :: T.Text -> T.Text -> Bool
exportedUnconditionally name txt = go (0 :: Int) (exportListRegion txt)
where
go _ [] = False
go n (l:ls)
| "#if" `T.isPrefixOf` T.stripStart l = go (n + 1) ls
| "#endif" `T.isPrefixOf` T.stripStart l = go (max 0 (n - 1)) ls
| n == 0, name `T.isInfixOf` l = True
| otherwise = go n ls
-- | True when the export-list region carries no doubled or leading comma. A
-- trailing comma before @)@ is legal Haskell, so @,)@ is not flagged.
wellFormedExportList :: T.Text -> Bool
wellFormedExportList txt = not (any (`T.isInfixOf` compact) ["(,", ",,"])
where
compact = T.filter (not . isSpace) (T.unlines (exportListRegion txt))
-- | Run an action at the position, check the export list is well formed, return the new text.
runAndCheck :: (TextDocumentIdentifier -> Range -> Session ()) -> TextDocumentIdentifier -> Range -> Session T.Text
runAndCheck act doc pos = do
act doc pos
txt <- documentContents doc
liftIO $ wellFormedExportList txt
@? ("malformed export list, got:\n" <> T.unpack txt)
pure txt
exportAndCheck :: TextDocumentIdentifier -> Range -> Session T.Text
exportAndCheck = runAndCheck executeExportAction
-- | Crudely re-run CPP for the macro EXAMPLE_FLAG over already-edited text,
-- keeping the branch the given definedness selects. Single level, just enough
-- to inspect the configuration the server did not parse.
preprocessExampleFlag :: Bool -> T.Text -> T.Text
preprocessExampleFlag defined = T.unlines . go Nothing . T.lines
where
-- Nothing outside any conditional. Just b inside one, emitting only when b.
go _ [] = []
go st (l:ls)
| isDir "#ifdef" = go (Just defined) ls
| isDir "#ifndef" = go (Just (not defined)) ls
| isDir "#else" = go (fmap not st) ls
| isDir "#endif" = go Nothing ls
| fromMaybe True st = l : go st ls
| otherwise = go st ls
where isDir d = d `T.isPrefixOf` T.stripStart l
rangeAt :: UInt -> UInt -> Range
rangeAt l c = Range (Position l c) (Position l c)
-- | The CPP block the testdata guards with @#ifdef EXAMPLE_FLAG@. The flag is
-- never defined, so the branch is inactive and must survive an edit verbatim.
flagBlock :: [T.Text]
flagBlock = ["#ifdef EXAMPLE_FLAG", ", flagged", "#endif"]
-- | The new export of @name@ must sit at CPP nesting level 0, never in a branch.
assertExportedUnconditionally :: T.Text -> T.Text -> Assertion
assertExportedUnconditionally name txt =
exportedUnconditionally name txt
@? (T.unpack name <> " must be exported outside any CPP branch, got:\n" <> T.unpack txt)
-- | The 'flagBlock' survives verbatim and @name@ lands outside it.
assertFlaggedBlockKept :: T.Text -> T.Text -> Assertion
assertFlaggedBlockKept name txt =
assertContainsAll txt flagBlock >> assertExportedUnconditionally name txt
-- | Run @exec@ at the position, assert the resulting export list is well-formed,
-- then assert the document contains one of the @expected@ variants.
execCase :: (TextDocumentIdentifier -> Range -> Session ())
-> TestName -> FilePath -> UInt -> UInt -> [T.Text] -> TestTree
execCase exec name file l c expected = testCase name $ runExport file $ \doc -> do
_ <- runAndCheck exec doc (rangeAt l c)
containsAfter doc expected
addCase, removeCase :: TestName -> FilePath -> UInt -> UInt -> [T.Text] -> TestTree
addCase = execCase executeExportAction
removeCase = execCase executeRemoveAction
-- | Assert the export or unexport action is not offered at the position.
absentCase :: (TextDocumentIdentifier -> Range -> Session ())
-> TestName -> FilePath -> UInt -> UInt -> TestTree
absentCase absent name file l c = testCase name $ runExport file $ \doc ->
absent doc (rangeAt l c)
noCase, noRemoveCase :: TestName -> FilePath -> UInt -> UInt -> TestTree
noCase = absentCase noExportOffered
noRemoveCase = absentCase noRemoveOffered
-- | Run @act@ at the position, assert the list is well-formed, then run @check@
-- over the resulting document text.
checkCase :: (TextDocumentIdentifier -> Range -> Session T.Text)
-> TestName -> FilePath -> UInt -> UInt -> (T.Text -> Assertion) -> TestTree
checkCase act name file l c check = testCase name $ runExport file $ \doc -> do
txt <- act doc (rangeAt l c)
liftIO (check txt)
exportCase :: TestName -> FilePath -> UInt -> UInt -> (T.Text -> Assertion) -> TestTree
exportCase = checkCase exportAndCheck
main :: IO ()
main = defaultTestRunner $ testGroup "Export"
[ testGroup "Add"
[ testGroup "value bindings"
[ addCase "add value to export list" "AddExport.hs" 6 0
["module AddExport (foo, Bar, bar)"]
, noCase "no action when value already exported" "AddExport.hs" 3 0 -- on `foo`
, addCase "append follows a multi-line leading-comma list" "AddExportMultiline.hs" 11 0 -- on `baz`
[" , baz\n ) where"]
]
, testGroup "type declarations"
[ addCase "add bare type as T(..)" "AddExport.hs" 9 5 -- on `Baz` type name
["Baz(..)", "Baz (..)"]
]
, testGroup "constructors"
[ addCase "constructor with no parent entry appends T (C)" "AddExport.hs" 9 12 -- on `Baz1`, no Baz entry yet
["Baz (Baz1)", "Baz(Baz1)"]
, addCase "constructor under bare-type parent promotes to T(C)" "AddCtor.hs" 3 11 -- on `Bar1`, Bar is IEThingAbs
["Bar (Bar1)", "Bar(Bar1)"]
, addCase "constructor merges into existing IEThingWith parent" "AddCtor.hs" 2 18 -- on `Foo2`, Foo has [Foo1]
["Foo (Foo1, Foo2)", "Foo(Foo1, Foo2)"]
, noCase "constructor already in IEThingWith children suppresses action" "AddCtor.hs" 2 11 -- on `Foo1`, already child of Foo(Foo1)
, noCase "constructor under IEThingAll T(..) suppresses action" "AddCtor.hs" 4 11 -- on `Baz1`, Baz(..) covers it
, noCase "constructor exported standalone suppresses action" "AddCtor.hs" 5 11 -- on `Qux1`, Qux1 standalone in list
]
, testGroup "type classes"
[ addCase "add class as T(..)" "AddClass.hs" 8 6 -- on `Baz` class name
["module AddClass (Foo (..), Bar, Baz (..))"]
, noCase "no add action when class exported as T(..)" "AddClass.hs" 2 6 -- on `Foo`, exported as Foo (..)
, noCase "no add action when class exported as bare T" "AddClass.hs" 5 6 -- on `Bar`, exported as bare
, noCase "no add action on class method" "AddClass.hs" 9 2 -- on `baz1` inside `class Baz a where`
]
, testGroup "layout variants"
[ addCase "add to an empty export list" "AddExportEmpty.hs" 2 0 -- on `foo`
["module AddExportEmpty (foo) where"]
, addCase "append after a trailing comma" "AddExportTrailingComma.hs" 7 0 -- on `bar`
["( foo, bar"]
, addCase "preserve a haddock comment between items" "AddExportComment.hs" 16 0 -- on `quux`
[" -- * For testing\n , baz\n , quux\n ) where"]
]
, testGroup "declaration kinds"
[ addCase "function operator is parenthesized" "AddExportKinds.hs" 8 1 -- on `(<|)`
["(placeholder, (<|))"]
, addCase "infix function exports bare name" "AddExportKinds.hs" 11 3 -- on `f`
["(placeholder, f)"]
, addCase "newtype exports as T(..)" "AddExportKinds.hs" 13 8 -- on `NT`
["placeholder, NT(..)", "placeholder, NT (..)"]
, addCase "type synonym exports bare" "AddExportKinds.hs" 15 5 -- on `Syn`
["(placeholder, Syn)"]
, addCase "type family exports bare" "AddExportKinds.hs" 17 12 -- on `TF`
["(placeholder, TF)"]
, addCase "pattern synonym gets a pattern prefix" "AddExportKinds.hs" 20 9 -- on `Pat`
["(placeholder, pattern Pat)"]
, addCase "data operator gets type keyword and (..)" "AddExportKinds.hs" 22 7 -- on `(:<)`
["placeholder, type (:<)(..)", "placeholder, type (:<) (..)"]
]
, testGroup "type-level operators"
[ addCase "type synonym operator has no type keyword" "AddExportTypeOps.hs" 8 7 -- on `(:<>)`
["(placeholder, (:<>))"]
, addCase "type family operator gets type keyword" "AddExportTypeOps.hs" 10 14 -- on `(:+:)`
["(placeholder, type (:+:))"]
, addCase "typeclass operator gets type keyword and (..)" "AddExportTypeOps.hs" 12 8 -- on `(:*:)`
["placeholder, type (:*:)(..)", "placeholder, type (:*:) (..)"]
, addCase "newtype operator gets type keyword and (..)" "AddExportTypeOps.hs" 14 10 -- on `(:->)`
["placeholder, type (:->)(..)", "placeholder, type (:->) (..)"]
, addCase "pattern synonym operator is parenthesized" "AddExportTypeOps.hs" 16 11 -- on `(:++)`
["(placeholder, pattern (:++))"]
]
, testGroup "negative cases"
[ noCase "no action on implicit module" "Implicit.hs" 3 0
, noCase "no action when cursor on RHS" "AddExport.hs" 6 6 -- col 6 is on the `2` of `bar = 2`
, noCase "no action on a where-bound name" "AddExportNegatives.hs" 7 8 -- on `whereBound`
, noCase "no action on a record field" "AddExportNegatives.hs" 9 18 -- on `recField`
]
, testGroup "CPP in the export list"
-- EXAMPLE_FLAG is never defined in the test project, so #ifdef branches
-- are inactive and #ifndef branches are active. The edit must preserve
-- every directive verbatim and place the new export outside any branch.
[ exportCase "preserves a trailing #ifdef block" "CppExportTail.hs" 15 0 -- on `baz`
(assertFlaggedBlockKept "baz")
, exportCase "preserves a leading #ifndef block" "CppExportHead.hs" 12 0 $ \txt -> do -- on `bar`
-- the whole guarded block survives verbatim, not just stray substrings
assertContainsAll txt ["#ifndef EXAMPLE_FLAG\n foo\n#endif"]
assertExportedUnconditionally "bar" txt
, exportCase "preserves both #if/#else branches" "CppExportElse.hs" 20 0 $ \txt -> do -- on `extra`
assertContainsAll txt
["#ifdef EXAMPLE_FLAG", ", windows", "#else", ", posix", "#endif"]
assertExportedUnconditionally "extra" txt
, testCase "preserves an #include directive" $ runExportWith ["CppExportInclude.h"] "CppExportInclude.hs" $ \doc -> do
txt <- exportAndCheck doc (rangeAt 13 0) -- on `extra`
liftIO $ do
assertContainsAll txt ["#include \"CppExportInclude.h\"", "( extra, foo"]
assertExportedUnconditionally "extra" txt
, exportCase "appends a new T(C) beside a CPP block" "CppCtorAppend.hs" 11 11 $ \txt -> do -- on `Baz1`, no Baz entry yet
assertFlaggedBlockKept "Baz1" txt
txt `assertAnyInfix` ["Baz (Baz1)", "Baz(Baz1)"]
, exportCase "adds a separate entry beside an IEThingWith parent" "CppCtorExtend.hs" 8 18 $ \txt -> do -- on `Foo2`, Foo has [Foo1]
assertFlaggedBlockKept "Foo2" txt
assertContainsAll txt ["Foo(Foo1)"]
txt `assertAnyInfix` ["Foo (Foo2)", "Foo(Foo2)"]
, exportCase "adds a separate entry without a double comma" "CppCtorMid.hs" 9 18 $ \txt -> do -- on `Foo2`, Foo(Foo1) precedes `, bar`
assertContainsAll txt (flagBlock <> [", bar", "Foo(Foo1)"])
txt `assertAnyInfix` ["Foo (Foo2)", "Foo(Foo2)"]
, exportCase "adds a separate entry beside a bare-type parent" "CppCtorUpgrade.hs" 8 11 $ \txt -> do -- on `Bar1`, Bar is IEThingAbs
assertFlaggedBlockKept "Bar1" txt
txt `assertAnyInfix` ["Bar (Bar1)", "Bar(Bar1)"]
, exportCase "exports an operator beside a CPP block" "CppExportKinds.hs" 12 1 -- on `(<|)`
(assertFlaggedBlockKept "(<|)")
, exportCase "exports a pattern synonym beside a CPP block" "CppExportKinds.hs" 16 8 -- on `Zero`
(assertFlaggedBlockKept "pattern Zero")
, exportCase "adds a separate entry beside a directive inside a constructor list" "CppCtorIntra.hs" 9 24 $ \txt -> do -- on `Foo2`
-- the #ifdef sits inside Foo(...), where an in-place merge would erase it
assertContainsAll txt ["#ifdef EXAMPLE_FLAG\n , Bar\n#endif", "Foo(Foo1"]
txt `assertAnyInfix` ["Foo (Foo2)", "Foo(Foo2)"]
, exportCase "front-inserts even when the close paren shares a line" "CppExportParenShared.hs" 18 0 $ \txt -> do -- on `baz`
assertContainsAll txt (flagBlock <> [", bar )"])
assertExportedUnconditionally "baz" txt
, exportCase "no double comma when the last item already has a trailing comma" "CppExportTrailingComma.hs" 15 0 $ \txt -> do -- on `baz`
-- a doubled `,,` would be caught by exportAndCheck's well-formedness check
assertContainsAll txt ["#ifdef EXAMPLE_FLAG", "flagged,", "#endif"]
assertExportedUnconditionally "baz" txt
, exportCase "edit stays valid in the unparsed CPP branch" "CppExportOtherBranch.hs" 12 0 $ \txt -> do -- on `bar`, the only item is in the other branch
-- the single item lives under #ifndef, so it is the whole parsed list.
-- The front-insert plus trailing comma stays valid when the flag flips
-- and that item disappears.
let otherBranch = preprocessExampleFlag True txt
wellFormedExportList otherBranch
@? ("edit breaks the EXAMPLE_FLAG-defined configuration:\n" <> T.unpack otherBranch)
]
]
, testGroup "Export fixes the unused-binding warning"
[ knownBrokenForGhcVersions [GHC96]
"TcRnUnusedName provenance is unstructured before GHC 9.8 (GHC #20115)" $
testCase "Export action attaches the -Wunused-top-binds diagnostic" $ runExport "ExportUnusedFix.hs" $ \doc -> do
actions <- rights . map toEither <$> getCodeActions doc (rangeAt 6 0) -- on `unused`
case filter ((== "Export `unused`") . (^. L.title)) actions of
(ca:_) -> liftIO $ not (null (fromMaybe [] (ca ^. L.diagnostics)))
@? "Export action should carry the unused-binding diagnostic"
[] -> liftIO $ assertFailure $
"Export `unused` not offered; saw: " <> show (map (^. L.title) actions)
]
, testGroup "Remove"
[ testGroup "value bindings"
[ removeCase "remove first value (foo)" "RemoveExport.hs" 3 0
["module RemoveExport (Bar, Baz (Baz1))"]
, noRemoveCase "no remove action when value not in export list" "AddExport.hs" 6 0 -- `bar` not exported
, removeCase "unexporting the sole export empties the list to ()" "SoleExport.hs" 3 0 -- on `only`, the only export
["module SoleExport () where"]
, removeCase "remove first item of a multi-line list keeps own-line layout" "RemoveFirstMultiline.hs" 6 0 -- on `foo`, the first export
["( bar\n , baz\n ) where"]
, testCase "remove first item drops its comment, keeps the others'" $ runExport "RemoveItemComment.hs" $ \doc -> do
executeRemoveAction doc (rangeAt 6 0) -- on `foo`, the first export
txt <- documentContents doc
liftIO $ do
assertContainsAll txt ["bar -- the bar", "baz -- the baz"]
not ("the foo" `T.isInfixOf` txt) @? ("foo's comment survived:\n" <> T.unpack txt)
, testCase "remove middle item drops its comment, keeps the others'" $ runExport "RemoveItemComment.hs" $ \doc -> do
executeRemoveAction doc (rangeAt 9 0) -- on `bar`, the middle export
txt <- documentContents doc
liftIO $ do
assertContainsAll txt ["foo -- the foo", "baz -- the baz"]
not ("the bar" `T.isInfixOf` txt) @? ("bar's comment survived:\n" <> T.unpack txt)
]
, testGroup "type declarations"
[ removeCase "remove bare type (middle item)" "RemoveExport.hs" 5 5 -- on `Bar`
["module RemoveExport (foo, Baz (Baz1))"]
, removeCase "remove IEThingWith type removes whole entry" "RemoveCtor.hs" 2 5 -- on `Foo` type
["module RemoveCtor (Bar (..), Baz1)"]
, removeCase "remove IEThingAll type removes whole entry" "RemoveCtor.hs" 3 5 -- on `Bar` type with (..)
["module RemoveCtor (Foo (Foo1, Foo2), Baz1)"]
]
, testGroup "constructors"
[ removeCase "remove sole constructor downgrades to bare type" "RemoveExport.hs" 6 11 -- on `Baz1` in Baz(Baz1)
["module RemoveExport (foo, Bar, Baz)"]
, removeCase "remove first constructor of T(C1, C2) yields T (C2)" "RemoveCtor.hs" 2 11 -- on `Foo1` in Foo(Foo1, Foo2)
["Foo (Foo2)", "Foo(Foo2)"]
, removeCase "remove second constructor of T(C1, C2) yields T (C1)" "RemoveCtor.hs" 2 18 -- on `Foo2` in Foo(Foo1, Foo2)
["Foo (Foo1)", "Foo(Foo1)"]
, removeCase "remove standalone-exported constructor" "RemoveCtor.hs" 4 11 -- on `Baz1` standalone
["module RemoveCtor (Foo (Foo1, Foo2), Bar (..))"]
, noRemoveCase "constructor under IEThingAll suppresses remove action" "RemoveCtor.hs" 3 11 -- on `Bar1`, only Bar(..) in list
, noRemoveCase "constructor not in export list suppresses remove action" "RemoveCtor.hs" 2 25 -- on `Foo3`, not in any entry
-- `data Bar = Bar`: unexporting the constructor leaves the abstract type
-- exported, so unexport must skip the standalone-removal fallback.
, noRemoveCase "constructor sharing its type's name does not unexport the type" "RemoveCtorNameClash.hs" 5 11 -- on the constructor `Bar`
, removeCase "unexporting the type still works when a constructor shares its name" "RemoveCtorNameClash.hs" 5 5 -- on the type `Bar`
["module RemoveCtorNameClash (foo)"]
, removeCase "downgrading an operator type keeps the type keyword" "RemoveCtorOp.hs" 4 15 -- on `Op`, the sole constructor of (:+:)
["(type (:+:)) where", "(type (:+:) ) where"]
, testCase "removing a child preserves the survivors' multiline layout" $ runExport "RemoveCtorMultiline.hs" $ \doc -> do
executeRemoveAction doc (rangeAt 8 18) -- on `Foo2` in the data decl, the middle child
txt <- documentContents doc
let region = exportListRegion txt
liftIO $ do
-- Survivors keep their layout: head not flushed to `(`, Foo3 on its own line.
assertContainsAll txt ["( Foo1\n", " , Foo3\n"]
not (any ("Foo2" `T.isInfixOf`) region) @? ("Foo2 still exported:\n" <> T.unpack txt)
, testCase "removing a middle child keeps the surviving siblings' comments" $ runExport "RemoveCtorComment.hs" $ \doc -> do
executeRemoveAction doc (rangeAt 8 18) -- on `Foo2` in the data decl
txt <- documentContents doc
liftIO $ do
assertContainsAll txt ["Foo1 -- first", "Foo3 -- third"]
-- The removed child takes its own trailing comment with it.
not ("second" `T.isInfixOf` txt) @? ("Foo2's comment lingered:\n" <> T.unpack txt)
, testCase "removing the head child keeps the new head's own comment" $ runExport "RemoveCtorComment.hs" $ \doc -> do
executeRemoveAction doc (rangeAt 8 11) -- on `Foo1` in the data decl
txt <- documentContents doc
liftIO $ do
-- Foo2 slides into Foo1's slot keeping its own `-- second`,
-- and Foo1's `-- first` is deleted along with Foo1.
assertContainsAll txt ["Foo2 -- second", "Foo3 -- third"]
not ("first" `T.isInfixOf` txt) @? ("Foo1's comment survived:\n" <> T.unpack txt)
]
, testGroup "type classes"
[ removeCase "remove class exported as T(..)" "RemoveClass.hs" 2 6 -- on `Foo`
["module RemoveClass (Bar, Baz (baz1))"]
, removeCase "remove class exported as bare T" "RemoveClass.hs" 5 6 -- on `Bar`
["module RemoveClass (Foo (..), Baz (baz1))"]
, removeCase "remove class exported as T(method)" "RemoveClass.hs" 8 6 -- on `Baz`
["module RemoveClass (Foo (..), Bar)"]
, noRemoveCase "no remove action when class not in export list" "RemoveClass.hs" 12 6 -- on `Qux`, not exported
, noRemoveCase "no remove action on class method" "RemoveClass.hs" 9 2 -- on `baz1` inside `class Baz a where`
]
, testGroup "negative cases"
[ noRemoveCase "no remove action on implicit module" "Implicit.hs" 3 0
, noRemoveCase "no remove action when cursor on RHS" "RemoveExport.hs" 3 6 -- on the `1` of `foo = 1`
-- A reprint would erase the directives the parser stripped, so removal is
-- declined whenever the export list holds a CPP directive.
, noRemoveCase "no remove action under a CPP export list" "CppExportTail.hs" 9 0 -- on `foo`, exported beside an #ifdef block
]
]
]