Skip to content

Commit

Permalink
Refactor pragmas plugin (#1417)
Browse files Browse the repository at this point in the history 
* Refactor pragmas plugin

* Revert some format changes

* Run pre-commit hook

* Fix and format class test

* Fix and format func-test (code action)

* Update test

* Don't look contents in endOfModuleHeader
  • Loading branch information
@berberman
berberman committed Feb 22, 2021
1 parent 9d21805 commit 1c45629
Show file tree
Hide file tree
Showing 5 changed files with 195 additions and 188 deletions.
23 changes: 0 additions & 23 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
View file
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
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

0 comments on commit 1c45629

Please sign in to comment.