Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Refactor pragmas plugin #1417

Merged
merged 13 commits into from Feb 22, 2021
Merged

Refactor pragmas plugin #1417

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
c90fd07
Refactor pragmas plugin
berberman Feb 21, 2021
7c771c6
Revert some format changes
berberman Feb 21, 2021
8c0ea29
Revert some format changes
berberman Feb 21, 2021
298be74
Run pre-commit hook
berberman Feb 21, 2021
46fe2a0
Fix and format class test
berberman Feb 21, 2021
b24fb6d
Merge branch 'master' into refactor-pragmas
berberman Feb 21, 2021
4007428
Fix and format func-test (code action)
berberman Feb 21, 2021
f9653d0
Merge branch 'master' into refactor-pragmas
berberman Feb 21, 2021
7cdb788
Update test
berberman Feb 21, 2021
88f01d3
Update test
berberman Feb 21, 2021
c728684
Merge branch 'master' into refactor-pragmas
berberman Feb 21, 2021
2f0fa18
Merge branch 'master' into refactor-pragmas
berberman Feb 22, 2021
eebf6b6
Don't look contents in endOfModuleHeader
berberman Feb 22, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
23 changes: 0 additions & 23 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
View file
Open in desktop
Expand Up @@ -158,7 +158,6 @@ suggestAction packageExports ideOptions parsedModule text df annSource tcM har d
++ suggestNewImport packageExports pm diag
++ suggestDeleteUnusedBinding pm text diag
++ suggestExportUnusedTopBinding text pm diag
++ suggestDisableWarning pm text diag
| Just pm <- [parsedModule]
] ++
suggestFillHole diag -- Lowest priority
Expand Down Expand Up @@ -257,15 +256,6 @@ isUnusedImportedId
maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs
| otherwise = False

suggestDisableWarning :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestDisableWarning pm contents Diagnostic{..}
| Just (InR (T.stripPrefix "-W" -> Just w)) <- _code =
pure
( "Disable \"" <> w <> "\" warnings"
, [TextEdit (endOfModuleHeader pm contents) $ "{-# OPTIONS_GHC -Wno-" <> w <> " #-}\n"]
)
| otherwise = []

suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmodImports}} contents Diagnostic{_range=_range,..}
-- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant
Expand Down Expand Up @@ -1452,16 +1442,3 @@ renderImportStyle :: ImportStyle -> T.Text
renderImportStyle (ImportTopLevel x) = x
renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")"

-- | Find the first non-blank line before the first of (module name / imports / declarations).
-- Useful for inserting pragmas.
endOfModuleHeader :: ParsedModule -> Maybe T.Text -> Range
endOfModuleHeader pm contents =
let mod = unLoc $ pm_parsed_source pm
modNameLoc = getLoc <$> hsmodName mod
firstImportLoc = getLoc <$> listToMaybe (hsmodImports mod)
firstDeclLoc = getLoc <$> listToMaybe (hsmodDecls mod)
line = fromMaybe 0 $ firstNonBlankBefore . _line . _start =<< srcSpanToRange =<<
modNameLoc <|> firstImportLoc <|> firstDeclLoc
firstNonBlankBefore n = (n -) . fromMaybe 0 . findIndex (not . T.null) . reverse . take n . T.lines <$> contents
loc = Position line 0
in Range loc loc
112 changes: 27 additions & 85 deletions ghcide/test/exe/Main.hs
View file
Open in desktop
Expand Up @@ -81,7 +81,6 @@ import Development.IDE.Plugin.Test (TestRequest (BlockSeconds, GetInterfaceFiles
import Control.Monad.Extra (whenJust)
import qualified Language.LSP.Types.Lens as L
import Control.Lens ((^.))
import Data.Functor
import Data.Tuple.Extra

waitForProgressBegin :: Session ()
Expand Down Expand Up @@ -706,7 +705,6 @@ codeActionTests = testGroup "code actions"
, suggestImportTests
, suggestHideShadowTests
, suggestImportDisambiguationTests
, disableWarningTests
, fixConstructorImportTests
, importRenameActionTests
, fillTypedHoleTests
Expand Down Expand Up @@ -913,8 +911,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -938,8 +937,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -966,8 +966,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove stuffA, stuffC from import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove stuffA, stuffC from import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -994,8 +995,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove !!, <?> from import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove !!, <?> from import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -1021,8 +1023,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove A from import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove A from import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -1047,8 +1050,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove A, E, F from import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove A, E, F from import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -1070,8 +1074,9 @@ removeImportTests = testGroup "remove import actions"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove import")
=<< getCodeActions docB (Range (Position 2 0) (Position 2 5))
[InR action@CodeAction { _title = actionTitle }, _]
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove import" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents docB
let expectedContentAfterAction = T.unlines
Expand All @@ -1094,8 +1099,9 @@ removeImportTests = testGroup "remove import actions"
]
doc <- createDoc "ModuleC.hs" "haskell" content
_ <- waitForDiagnostics
action <- assertJust "Code action not found" . firstJust (caWithTitle "Remove all redundant imports")
=<< getCodeActions doc (Range (Position 2 0) (Position 2 5))
[_, _, _, _, InR action@CodeAction { _title = actionTitle }]
<- getCodeActions doc (Range (Position 2 0) (Position 2 5))
liftIO $ "Remove all redundant imports" @=? actionTitle
executeCodeAction action
contentAfterAction <- documentContents doc
let expectedContentAfterAction = T.unlines
Expand All @@ -1111,10 +1117,6 @@ removeImportTests = testGroup "remove import actions"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
]
where
caWithTitle t = \case
InR a@CodeAction{_title} -> guard (_title == t) >> Just a
_ -> Nothing

extendImportTests :: TestTree
extendImportTests = testGroup "extend import actions"
Expand Down Expand Up @@ -1784,57 +1786,6 @@ suggestHideShadowTests =
, "(++) = id"
]

disableWarningTests :: TestTree
disableWarningTests =
testGroup "disable warnings" $
[
( "missing-signatures"
, T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, "main = putStrLn \"hello\""
]
, T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, "{-# OPTIONS_GHC -Wno-missing-signatures #-}"
, "main = putStrLn \"hello\""
]
)
,
( "unused-imports"
, T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, ""
, ""
, "module M where"
, ""
, "import Data.Functor"
]
, T.unlines
[ "{-# OPTIONS_GHC -Wall #-}"
, "{-# OPTIONS_GHC -Wno-unused-imports #-}"
, ""
, ""
, "module M where"
, ""
, "import Data.Functor"
]
)
]
<&> \(warning, initialContent, expectedContent) -> testSession (T.unpack warning) $ do
doc <- createDoc "Module.hs" "haskell" initialContent
_ <- waitForDiagnostics
codeActs <- mapMaybe caResultToCodeAct <$> getCodeActions doc (Range (Position 0 0) (Position 0 0))
case find (\CodeAction{_title} -> _title == "Disable \"" <> warning <> "\" warnings") codeActs of
Nothing -> liftIO $ assertFailure "No code action with expected title"
Just action -> do
executeCodeAction action
contentAfterAction <- documentContents doc
liftIO $ expectedContent @=? contentAfterAction
where
caResultToCodeAct = \case
InL _ -> Nothing
InR c -> Just c

insertNewDefinitionTests :: TestTree
insertNewDefinitionTests = testGroup "insert new definition actions"
[ testSession "insert new function definition" $ do
Expand Down Expand Up @@ -2586,12 +2537,7 @@ removeRedundantConstraintsTests = let
doc <- createDoc "Testing.hs" "haskell" code
_ <- waitForDiagnostics
actionsOrCommands <- getCodeActions doc (Range (Position 4 0) (Position 4 maxBound))
liftIO $ assertBool "Found some actions (other than \"disable warnings\")"
$ all isDisableWarningAction actionsOrCommands
where
isDisableWarningAction = \case
InR CodeAction{_title} -> "Disable" `T.isPrefixOf` _title && "warnings" `T.isSuffixOf` _title
_ -> False
liftIO $ assertBool "Found some actions" (null actionsOrCommands)

in testGroup "remove redundant function constraints"
[ check
Expand Down Expand Up @@ -4786,9 +4732,7 @@ asyncTests = testGroup "async"
void waitForDiagnostics
actions <- getCodeActions doc (Range (Position 1 0) (Position 1 0))
liftIO $ [ _title | InR CodeAction{_title} <- actions] @=?
[ "add signature: foo :: a -> a"
, "Disable \"missing-signatures\" warnings"
]
[ "add signature: foo :: a -> a" ]
, testSession "request" $ do
-- Execute a custom request that will block for 1000 seconds
void $ sendRequest (SCustomMethod "test") $ toJSON $ BlockSeconds 1000
Expand All @@ -4800,9 +4744,7 @@ asyncTests = testGroup "async"
void waitForDiagnostics
actions <- getCodeActions doc (Range (Position 0 0) (Position 0 0))
liftIO $ [ _title | InR CodeAction{_title} <- actions] @=?
[ "add signature: foo :: a -> a"
, "Disable \"missing-signatures\" warnings"
]
[ "add signature: foo :: a -> a" ]
]


Expand Down