mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Fix redundant import code action corner cases (#433)
- Redundant "All" imports, e.g. Maybe(..) - Redundant datatype plus constructors, e.g. Maybe(Just) Fixes #352
This commit is contained in:
parent
286635bac8
commit
f586955e8a
@ -138,6 +138,7 @@ library
|
||||
Development.IDE.Spans.Calculate
|
||||
Development.IDE.Spans.Documentation
|
||||
Development.IDE.Spans.Type
|
||||
Development.IDE.Plugin.CodeAction.PositionIndexed
|
||||
Development.IDE.Plugin.Completions.Logic
|
||||
Development.IDE.Plugin.Completions.Types
|
||||
ghc-options: -Wall -Wno-name-shadowing
|
||||
|
@ -22,6 +22,7 @@ module Development.IDE.GHC.Compat(
|
||||
pattern TyClD,
|
||||
pattern ValD,
|
||||
pattern ClassOpSig,
|
||||
pattern IEThingAll,
|
||||
pattern IEThingWith,
|
||||
GHC.ModLocation,
|
||||
pattern ModLocation,
|
||||
@ -34,7 +35,7 @@ import DynFlags
|
||||
import FieldLabel
|
||||
|
||||
import qualified GHC
|
||||
import GHC hiding (ClassOpSig, DerivD, ForD, IEThingWith, InstD, TyClD, ValD, ModLocation)
|
||||
import GHC hiding (ClassOpSig, DerivD, ForD, IEThingAll, IEThingWith, InstD, TyClD, ValD, ModLocation)
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,8,0)
|
||||
import HieAst
|
||||
@ -147,3 +148,11 @@ pattern ModLocation a b c <-
|
||||
#else
|
||||
GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c
|
||||
#endif
|
||||
|
||||
pattern IEThingAll :: LIEWrappedName (IdP pass) -> IE pass
|
||||
pattern IEThingAll a <-
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
GHC.IEThingAll _ a
|
||||
#else
|
||||
GHC.IEThingAll a
|
||||
#endif
|
||||
|
@ -19,6 +19,7 @@ import Development.IDE.Core.Shake
|
||||
import Development.IDE.GHC.Error
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.LSP.Server
|
||||
import Development.IDE.Plugin.CodeAction.PositionIndexed
|
||||
import Development.IDE.Types.Location
|
||||
import Development.IDE.Types.Options
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
@ -130,6 +131,7 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod
|
||||
, Just c <- contents
|
||||
, ranges <- map (rangesForBinding impDecl . T.unpack) (T.splitOn ", " bindings)
|
||||
, ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T.unpack c) (concat ranges)
|
||||
, not (null ranges')
|
||||
= [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]
|
||||
|
||||
-- File.hs:16:1: warning:
|
||||
@ -424,7 +426,7 @@ rangesForBinding _ _ = []
|
||||
rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
|
||||
rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]
|
||||
rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l]
|
||||
rangesForBinding' b (L l x@IEThingAll{}) | showSDocUnsafe (ppr x) == b = [l]
|
||||
rangesForBinding' b (L l (IEThingAll x)) | showSDocUnsafe (ppr x) == b = [l]
|
||||
rangesForBinding' b (L l (IEThingWith thing _ inners labels))
|
||||
| showSDocUnsafe (ppr thing) == b = [l]
|
||||
| otherwise =
|
||||
@ -464,52 +466,4 @@ filterNewlines :: T.Text -> T.Text
|
||||
filterNewlines = T.concat . T.lines
|
||||
|
||||
unifySpaces :: T.Text -> T.Text
|
||||
unifySpaces = T.unwords . T.words
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
type PositionIndexedString = [(Position, Char)]
|
||||
|
||||
indexedByPosition :: String -> PositionIndexedString
|
||||
indexedByPosition = unfoldr f . (Position 0 0,) where
|
||||
f (_, []) = Nothing
|
||||
f (p@(Position l _), '\n' : rest) = Just ((p,'\n'), (Position (l+1) 0, rest))
|
||||
f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c+1), rest))
|
||||
|
||||
-- | Returns a tuple (before, contents, after)
|
||||
unconsRange :: Range -> PositionIndexedString -> (PositionIndexedString, PositionIndexedString, PositionIndexedString)
|
||||
unconsRange Range {..} indexedString = (before, mid, after)
|
||||
where
|
||||
(before, rest) = span ((/= _start) . fst) indexedString
|
||||
(mid, after) = span ((/= _end) . fst) rest
|
||||
|
||||
stripRange :: Range -> PositionIndexedString -> PositionIndexedString
|
||||
stripRange r s = case unconsRange r s of
|
||||
(b, _, a) -> b ++ a
|
||||
|
||||
extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]
|
||||
extendAllToIncludeCommaIfPossible _ [] = []
|
||||
extendAllToIncludeCommaIfPossible indexedString (r : rr) = r' : extendAllToIncludeCommaIfPossible indexedString' rr
|
||||
where
|
||||
r' = case extendToIncludeCommaIfPossible indexedString r of
|
||||
[] -> r
|
||||
r' : _ -> r'
|
||||
indexedString' = stripRange r' indexedString
|
||||
|
||||
-- | Returns a sorted list of ranges with extended selections includindg preceding or trailing commas
|
||||
extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]
|
||||
extendToIncludeCommaIfPossible indexedString range =
|
||||
-- a, |b|, c ===> a|, b|, c
|
||||
[ range{_start = start'}
|
||||
| (start', ',') : _ <- [before']
|
||||
]
|
||||
++
|
||||
-- a, |b|, c ===> a, |b, |c
|
||||
[ range{_end = end'}
|
||||
| (_, ',') : rest <- [after']
|
||||
, let (end', _) : _ = dropWhile (isSpace . snd) rest
|
||||
]
|
||||
where
|
||||
(before, _, after) = unconsRange range indexedString
|
||||
after' = dropWhile (isSpace . snd) after
|
||||
before' = dropWhile (isSpace . snd) (reverse before)
|
||||
unifySpaces = T.unwords . T.words
|
112
src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs
Normal file
112
src/Development/IDE/Plugin/CodeAction/PositionIndexed.hs
Normal file
@ -0,0 +1,112 @@
|
||||
-- | Position indexed streams of characters
|
||||
module Development.IDE.Plugin.CodeAction.PositionIndexed
|
||||
( PositionIndexed
|
||||
, PositionIndexedString
|
||||
, indexedByPosition
|
||||
, indexedByPositionStartingFrom
|
||||
, extendAllToIncludeCommaIfPossible
|
||||
, mergeRanges
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Language.Haskell.LSP.Types
|
||||
|
||||
type PositionIndexed a = [(Position, a)]
|
||||
|
||||
type PositionIndexedString = PositionIndexed Char
|
||||
|
||||
-- | Add position indexing to a String.
|
||||
--
|
||||
-- > indexedByPositionStartingFrom (0,0) "hey\n ho" ≡
|
||||
-- > [ ((0,0),'h')
|
||||
-- > , ((0,1),'e')
|
||||
-- > , ((0,2),'y')
|
||||
-- > , ((0,3),'\n')
|
||||
-- > , ((1,0),' ')
|
||||
-- > , ((1,1),'h')
|
||||
-- > , ((1,2),'o')
|
||||
-- > ]
|
||||
indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString
|
||||
indexedByPositionStartingFrom initialPos = unfoldr f . (initialPos, ) where
|
||||
f (_, []) = Nothing
|
||||
f (p@(Position l _), '\n' : rest) =
|
||||
Just ((p, '\n'), (Position (l + 1) 0, rest))
|
||||
f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c + 1), rest))
|
||||
|
||||
-- | Add position indexing to a String.
|
||||
--
|
||||
-- > indexedByPosition = indexedByPositionStartingFrom (Position 0 0)
|
||||
indexedByPosition :: String -> PositionIndexedString
|
||||
indexedByPosition = indexedByPositionStartingFrom (Position 0 0)
|
||||
|
||||
-- | Returns a tuple (before, contents, after) if the range is present.
|
||||
-- The range is present only if both its start and end positions are present
|
||||
unconsRange
|
||||
:: Range
|
||||
-> PositionIndexed a
|
||||
-> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)
|
||||
unconsRange Range {..} indexedString
|
||||
| (before, rest@(_ : _)) <- span ((/= _start) . fst) indexedString
|
||||
, (mid, after@(_ : _)) <- span ((/= _end) . fst) rest
|
||||
= Just (before, mid, after)
|
||||
| otherwise
|
||||
= Nothing
|
||||
|
||||
-- | Strips out all the positions included in the range.
|
||||
-- Returns 'Nothing' if the start or end of the range are not included in the input.
|
||||
stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)
|
||||
stripRange r s = case unconsRange r s of
|
||||
Just (b, _, a) -> Just (b ++ a)
|
||||
Nothing -> Nothing
|
||||
|
||||
-- | Returns the smallest possible set of disjoint ranges that is equivalent to the input.
|
||||
-- Assumes input ranges are sorted on the start positions.
|
||||
mergeRanges :: [Range] -> [Range]
|
||||
mergeRanges (r : r' : rest)
|
||||
|
|
||||
-- r' is contained in r
|
||||
_end r > _end r' = mergeRanges (r : rest)
|
||||
|
|
||||
-- r and r' are overlapping
|
||||
_end r > _start r' = mergeRanges (r { _end = _end r' } : rest)
|
||||
|
||||
| otherwise = r : mergeRanges (r' : rest)
|
||||
mergeRanges other = other
|
||||
|
||||
-- | Returns a sorted list of ranges with extended selections including preceding or trailing commas
|
||||
--
|
||||
-- @
|
||||
-- a, |b|, c ===> a|, b|, c
|
||||
-- a, b, |c| ===> a, b|, c|
|
||||
-- a, |b|, |c| ===> a|, b||, c|
|
||||
-- @
|
||||
extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]
|
||||
extendAllToIncludeCommaIfPossible indexedString =
|
||||
mergeRanges . go indexedString . sortOn _start
|
||||
where
|
||||
go _ [] = []
|
||||
go input (r : rr)
|
||||
| r' : _ <- extendToIncludeCommaIfPossible input r
|
||||
, Just input' <- stripRange r' input
|
||||
= r' : go input' rr
|
||||
| otherwise
|
||||
= go input rr
|
||||
|
||||
extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]
|
||||
extendToIncludeCommaIfPossible indexedString range
|
||||
| Just (before, _, after) <- unconsRange range indexedString
|
||||
, after' <- dropWhile (isSpace . snd) after
|
||||
, before' <- dropWhile (isSpace . snd) (reverse before)
|
||||
=
|
||||
-- a, |b|, c ===> a|, b|, c
|
||||
[ range { _start = start' } | (start', ',') : _ <- [before'] ]
|
||||
++
|
||||
-- a, |b|, c ===> a, |b, |c
|
||||
[ range { _end = end' }
|
||||
| (_, ',') : rest <- [after']
|
||||
, let (end', _) : _ = dropWhile (isSpace . snd) rest
|
||||
]
|
||||
| otherwise
|
||||
= [range]
|
@ -669,10 +669,11 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "main = print stuffB"
|
||||
]
|
||||
liftIO $ expectedContentAfterAction @=? contentAfterAction
|
||||
, testSession "redundant symbol binding" $ do
|
||||
, testSession "redundant operator" $ do
|
||||
let contentA = T.unlines
|
||||
[ "module ModuleA where"
|
||||
, "a !! b = a"
|
||||
, "a <?> b = a"
|
||||
, "stuffB :: Integer"
|
||||
, "stuffB = 123"
|
||||
]
|
||||
@ -680,7 +681,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import qualified ModuleA as A ((!!), stuffB, (!!))"
|
||||
, "import qualified ModuleA as A ((<?>), stuffB, (!!))"
|
||||
, "main = print A.stuffB"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
@ -688,9 +689,9 @@ removeImportTests = testGroup "remove import actions"
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
liftIO $ "Remove !! from import" @=? actionTitle
|
||||
liftIO $ "Remove !!, <?> from import" @=? actionTitle
|
||||
#else
|
||||
liftIO $ "Remove A.!! from import" @=? actionTitle
|
||||
liftIO $ "Remove A.!!, A.<?> from import" @=? actionTitle
|
||||
#endif
|
||||
executeCodeAction action
|
||||
contentAfterAction <- documentContents docB
|
||||
@ -701,7 +702,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "main = print A.stuffB"
|
||||
]
|
||||
liftIO $ expectedContentAfterAction @=? contentAfterAction
|
||||
, (`xfail` "known broken (#299)") $ testSession "redundant hierarchical import" $ do
|
||||
, testSession "redundant all import" $ do
|
||||
let contentA = T.unlines
|
||||
[ "module ModuleA where"
|
||||
, "data A = A"
|
||||
@ -729,6 +730,33 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "main = print stuffB"
|
||||
]
|
||||
liftIO $ expectedContentAfterAction @=? contentAfterAction
|
||||
, testSession "redundant constructor import" $ do
|
||||
let contentA = T.unlines
|
||||
[ "module ModuleA where"
|
||||
, "data D = A | B"
|
||||
, "data E = F"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA (D(A,B), E(F))"
|
||||
, "main = B"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction 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
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA (D(B))"
|
||||
, "main = B"
|
||||
]
|
||||
liftIO $ expectedContentAfterAction @=? contentAfterAction
|
||||
]
|
||||
|
||||
extendImportTests :: TestTree
|
||||
|
Loading…
Reference in New Issue
Block a user