Skip to content

Commit

Permalink
don't crash when an unused operator import ends in . (#2123)
Browse files Browse the repository at this point in the history
* replace head with safer uncons

* if empty, stay empty

* add test for removal of operators ending with '.'

* make remove-import-actions tests pass

* add more tests and debug output for modifyBinding

* implement reviewers suggestions

* restore ghcide/bench/example/HLS

Co-authored-by: Pepe Iborra <[email protected]>
  • Loading branch information
tscholak and pepeiborra authored Aug 24, 2021
1 parent 2e0f6cd commit ed37b61
Show file tree
Hide file tree
Showing 2 changed files with 47 additions and 7 deletions.
15 changes: 8 additions & 7 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1483,20 +1483,21 @@ rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
rangesForBindingImport ImportDecl{ideclHiding = Just (False, L _ lies)} b =
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
where
b' = modifyBinding b
b' = wrapOperatorInParens b
rangesForBindingImport _ _ = []

modifyBinding :: String -> String
modifyBinding = wrapOperatorInParens . unqualify
where
wrapOperatorInParens x = if isAlpha (head x) then x else "(" <> x <> ")"
unqualify x = snd $ breakOnEnd "." x
wrapOperatorInParens :: String -> String
wrapOperatorInParens x =
case uncons x of
Just (h, _t) -> if isAlpha h then x else "(" <> x <> ")"
Nothing -> mempty

smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
smallerRangesForBindingExport lies b =
concatMap (mapMaybe srcSpanToRange . ranges') lies
where
b' = modifyBinding b
unqualify = snd . breakOnEnd "."
b' = wrapOperatorInParens . unqualify $ b
ranges' (L _ (IEThingWith _ thing _ inners labels))
| showSDocUnsafe (ppr thing) == b' = []
| otherwise =
Expand Down
39 changes: 39 additions & 0 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1150,6 +1150,33 @@ removeImportTests = testGroup "remove import actions"
, "type T = K.Type"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
, testSession "remove unused operators whose name ends with '.'" $ do
let contentA = T.unlines
[ "module ModuleA where"
, "(@.) = 0 -- Must have an operator whose name ends with '.'"
, "a = 1 -- .. but also something else"
]
_docA <- createDoc "ModuleA.hs" "haskell" contentA
let contentB = T.unlines
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "import ModuleA (a, (@.))"
, "x = a -- Must use something from module A, but not (@.)"
]
docB <- createDoc "ModuleB.hs" "haskell" contentB
_ <- waitForDiagnostics
[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
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
, "module ModuleB where"
, "import ModuleA (a)"
, "x = a -- Must use something from module A, but not (@.)"
]
liftIO $ expectedContentAfterAction @=? contentAfterAction
]

extendImportTests :: TestTree
Expand Down Expand Up @@ -3311,6 +3338,18 @@ removeExportTests = testGroup "remove export actions"
, "import qualified Data.List as M"
, "a :: ()"
, "a = ()"])
, testSession "qualified re-export ending in '.'" $ template
(T.unlines
[ "module A ((M.@.),a) where"
, "import qualified Data.List as M"
, "a :: ()"
, "a = ()"])
"Remove ‘M.@.’ from export"
(Just $ T.unlines
[ "module A (a) where"
, "import qualified Data.List as M"
, "a :: ()"
, "a = ()"])
, testSession "export module" $ template
(T.unlines
[ "module A (module B) where"
Expand Down

0 comments on commit ed37b61

Please sign in to comment.