f586955 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Fix redundant import code action corner cases (#433)

f586955Pepe Iborra7 years ago

ghcide.cabal+1

compare with master

unifiedsplit

@@ -138,6 +138,7 @@ library

138 Development.IDE.Spans.Calculate

139 Development.IDE.Spans.Documentation

140 Development.IDE.Spans.Type

141+ Development.IDE.Plugin.CodeAction.PositionIndexed

141 Development.IDE.Plugin.Completions.Logic

142 Development.IDE.Plugin.Completions.Logic

142 Development.IDE.Plugin.Completions.Types

143 Development.IDE.Plugin.Completions.Types

143 ghc-options: -Wall -Wno-name-shadowing

144 ghc-options: -Wall -Wno-name-shadowing

src/Development/IDE/GHC/Compat.hs+10−1

@@ -22,6 +22,7 @@ module Development.IDE.GHC.Compat(

22 pattern TyClD,

23 pattern ValD,

24 pattern ClassOpSig,

25+ pattern IEThingAll,

25 pattern IEThingWith,

26 pattern IEThingWith,

26 GHC.ModLocation,

27 GHC.ModLocation,

27 pattern ModLocation,

28 pattern ModLocation,

@@ -34,7 +35,7 @@ import DynFlags

34import FieldLabel

35import FieldLabel

36import qualified GHC

37import qualified GHC

37−import GHC hiding (ClassOpSig, DerivD, ForD, IEThingWith, InstD, TyClD, ValD, ModLocation)

38+import GHC hiding (ClassOpSig, DerivD, ForD, IEThingAll, IEThingWith, InstD, TyClD, ValD, ModLocation)

39#if MIN_GHC_API_VERSION(8,8,0)

40#if MIN_GHC_API_VERSION(8,8,0)

40import HieAst

41import HieAst

@@ -147,3 +148,11 @@ pattern ModLocation a b c <-

147#else

148#else

148 GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c

149 GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c

149#endif

150#endif

151+

152+pattern IEThingAll :: LIEWrappedName (IdP pass) -> IE pass

153+pattern IEThingAll a <-

154+#if MIN_GHC_API_VERSION(8,6,0)

155+ GHC.IEThingAll _ a

156+#else

157+ GHC.IEThingAll a

158+#endif

src/Development/IDE/Plugin/CodeAction.hs+4−50

@@ -19,6 +19,7 @@ import Development.IDE.Core.Shake

19import Development.IDE.GHC.Error

20import Development.IDE.GHC.Util

21import Development.IDE.LSP.Server

22+import Development.IDE.Plugin.CodeAction.PositionIndexed

22import Development.IDE.Types.Location

23import Development.IDE.Types.Location

23import Development.IDE.Types.Options

24import Development.IDE.Types.Options

24import qualified Data.HashMap.Strict as Map

25import qualified Data.HashMap.Strict as Map

@@ -130,6 +131,7 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod

130 , Just c <- contents

131 , Just c <- contents

131 , ranges <- map (rangesForBinding impDecl . T.unpack) (T.splitOn ", " bindings)

132 , ranges <- map (rangesForBinding impDecl . T.unpack) (T.splitOn ", " bindings)

132 , ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T.unpack c) (concat ranges)

133 , ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T.unpack c) (concat ranges)

134+ , not (null ranges')

133 = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]

135 = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]

134

136

135-- File.hs:16:1: warning:

137-- File.hs:16:1: warning:

@@ -424,7 +426,7 @@ rangesForBinding _ _ = []

424rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]

426rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]

425rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]

427rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]

426rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l]

428rangesForBinding' b (L l x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l]

427−rangesForBinding' b (L l x@IEThingAll{}) | showSDocUnsafe (ppr x) == b = [l]

429+rangesForBinding' b (L l (IEThingAll x)) | showSDocUnsafe (ppr x) == b = [l]

428rangesForBinding' b (L l (IEThingWith thing _ inners labels))

430rangesForBinding' b (L l (IEThingWith thing _ inners labels))

429 | showSDocUnsafe (ppr thing) == b = [l]

431 | showSDocUnsafe (ppr thing) == b = [l]

430 | otherwise =

432 | otherwise =

@@ -464,52 +466,4 @@ filterNewlines :: T.Text -> T.Text

464filterNewlines = T.concat . T.lines

466filterNewlines = T.concat . T.lines

465

467

466unifySpaces :: T.Text -> T.Text

468unifySpaces :: T.Text -> T.Text

467−unifySpaces = T.unwords . T.words

469+unifySpaces = T.unwords . T.words

468−

469−--------------------------------------------------------------------------------

470−

471−type PositionIndexedString = [(Position, Char)]

472−

473−indexedByPosition :: String -> PositionIndexedString

474−indexedByPosition = unfoldr f . (Position 0 0,) where

475− f (_, []) = Nothing

476− f (p@(Position l _), '\n' : rest) = Just ((p,'\n'), (Position (l+1) 0, rest))

477− f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c+1), rest))

478−

479−-- | Returns a tuple (before, contents, after)

480−unconsRange :: Range -> PositionIndexedString -> (PositionIndexedString, PositionIndexedString, PositionIndexedString)

481−unconsRange Range {..} indexedString = (before, mid, after)

482− where

483− (before, rest) = span ((/= _start) . fst) indexedString

484− (mid, after) = span ((/= _end) . fst) rest

485−

486−stripRange :: Range -> PositionIndexedString -> PositionIndexedString

487−stripRange r s = case unconsRange r s of

488− (b, _, a) -> b ++ a

489−

490−extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]

491−extendAllToIncludeCommaIfPossible _ [] = []

492−extendAllToIncludeCommaIfPossible indexedString (r : rr) = r' : extendAllToIncludeCommaIfPossible indexedString' rr

493− where

494− r' = case extendToIncludeCommaIfPossible indexedString r of

495− [] -> r

496− r' : _ -> r'

497− indexedString' = stripRange r' indexedString

498−

499−-- | Returns a sorted list of ranges with extended selections includindg preceding or trailing commas

500−extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]

501−extendToIncludeCommaIfPossible indexedString range =

502− -- a, |b|, c ===> a|, b|, c

503− [ range{_start = start'}

504− | (start', ',') : _ <- [before']

505− ]

506− ++

507− -- a, |b|, c ===> a, |b, |c

508− [ range{_end = end'}

509− | (_, ',') : rest <- [after']

510− , let (end', _) : _ = dropWhile (isSpace . snd) rest

511− ]

512− where

513− (before, _, after) = unconsRange range indexedString

514− after' = dropWhile (isSpace . snd) after

515− before' = dropWhile (isSpace . snd) (reverse before)

src/Development/IDE/Plugin/CodeAction/PositionIndexed.hsnew file+112

@@ -0,0 +1,112 @@

1+-- | Position indexed streams of characters

2+module Development.IDE.Plugin.CodeAction.PositionIndexed

3+ ( PositionIndexed

4+ , PositionIndexedString

5+ , indexedByPosition

6+ , indexedByPositionStartingFrom

7+ , extendAllToIncludeCommaIfPossible

8+ , mergeRanges

9+ )

10+where

11+

12+import Data.Char

13+import Data.List

14+import Language.Haskell.LSP.Types

15+

16+type PositionIndexed a = [(Position, a)]

17+

18+type PositionIndexedString = PositionIndexed Char

19+

20+-- | Add position indexing to a String.

21+--

22+-- > indexedByPositionStartingFrom (0,0) "hey\n ho" ≡

23+-- > [ ((0,0),'h')

24+-- > , ((0,1),'e')

25+-- > , ((0,2),'y')

26+-- > , ((0,3),'\n')

27+-- > , ((1,0),' ')

28+-- > , ((1,1),'h')

29+-- > , ((1,2),'o')

30+-- > ]

31+indexedByPositionStartingFrom :: Position -> String -> PositionIndexedString

32+indexedByPositionStartingFrom initialPos = unfoldr f . (initialPos, ) where

33+ f (_, []) = Nothing

34+ f (p@(Position l _), '\n' : rest) =

35+ Just ((p, '\n'), (Position (l + 1) 0, rest))

36+ f (p@(Position l c), x : rest) = Just ((p, x), (Position l (c + 1), rest))

37+

38+-- | Add position indexing to a String.

39+--

40+-- > indexedByPosition = indexedByPositionStartingFrom (Position 0 0)

41+indexedByPosition :: String -> PositionIndexedString

42+indexedByPosition = indexedByPositionStartingFrom (Position 0 0)

43+

44+-- | Returns a tuple (before, contents, after) if the range is present.

45+-- The range is present only if both its start and end positions are present

46+unconsRange

47+ :: Range

48+ -> PositionIndexed a

49+ -> Maybe (PositionIndexed a, PositionIndexed a, PositionIndexed a)

50+unconsRange Range {..} indexedString

51+ | (before, rest@(_ : _)) <- span ((/= _start) . fst) indexedString

52+ , (mid, after@(_ : _)) <- span ((/= _end) . fst) rest

53+ = Just (before, mid, after)

54+ | otherwise

55+ = Nothing

56+

57+-- | Strips out all the positions included in the range.

58+-- Returns 'Nothing' if the start or end of the range are not included in the input.

59+stripRange :: Range -> PositionIndexed a -> Maybe (PositionIndexed a)

60+stripRange r s = case unconsRange r s of

61+ Just (b, _, a) -> Just (b ++ a)

62+ Nothing -> Nothing

63+

64+-- | Returns the smallest possible set of disjoint ranges that is equivalent to the input.

65+-- Assumes input ranges are sorted on the start positions.

66+mergeRanges :: [Range] -> [Range]

67+mergeRanges (r : r' : rest)

68+ |

69+ -- r' is contained in r

70+ _end r > _end r' = mergeRanges (r : rest)

71+ |

72+ -- r and r' are overlapping

73+ _end r > _start r' = mergeRanges (r { _end = _end r' } : rest)

74+

75+ | otherwise = r : mergeRanges (r' : rest)

76+mergeRanges other = other

77+

78+-- | Returns a sorted list of ranges with extended selections including preceding or trailing commas

79+--

80+-- @

81+-- a, |b|, c ===> a|, b|, c

82+-- a, b, |c| ===> a, b|, c|

83+-- a, |b|, |c| ===> a|, b||, c|

84+-- @

85+extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]

86+extendAllToIncludeCommaIfPossible indexedString =

87+ mergeRanges . go indexedString . sortOn _start

88+ where

89+ go _ [] = []

90+ go input (r : rr)

91+ | r' : _ <- extendToIncludeCommaIfPossible input r

92+ , Just input' <- stripRange r' input

93+ = r' : go input' rr

94+ | otherwise

95+ = go input rr

96+

97+extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]

98+extendToIncludeCommaIfPossible indexedString range

99+ | Just (before, _, after) <- unconsRange range indexedString

100+ , after' <- dropWhile (isSpace . snd) after

101+ , before' <- dropWhile (isSpace . snd) (reverse before)

102+ =

103+ -- a, |b|, c ===> a|, b|, c

104+ [ range { _start = start' } | (start', ',') : _ <- [before'] ]

105+ ++

106+ -- a, |b|, c ===> a, |b, |c

107+ [ range { _end = end' }

108+ | (_, ',') : rest <- [after']

109+ , let (end', _) : _ = dropWhile (isSpace . snd) rest

110+ ]

111+ | otherwise

112+ = [range]

test/exe/Main.hs+33−5

@@ -669,10 +669,11 @@ removeImportTests = testGroup "remove import actions"

669 , "main = print stuffB"

670 ]

671 liftIO $ expectedContentAfterAction @=? contentAfterAction

672− , testSession "redundant symbol binding" $ do

672+ , testSession "redundant operator" $ do

673 let contentA = T.unlines

674 [ "module ModuleA where"

675 , "a !! b = a"

676+ , "a <?> b = a"

676 , "stuffB :: Integer"

677 , "stuffB :: Integer"

677 , "stuffB = 123"

678 , "stuffB = 123"

678 ]

679 ]

@@ -680,7 +681,7 @@ removeImportTests = testGroup "remove import actions"

680 let contentB = T.unlines

681 let contentB = T.unlines

681 [ "{-# OPTIONS_GHC -Wunused-imports #-}"

682 [ "{-# OPTIONS_GHC -Wunused-imports #-}"

682 , "module ModuleB where"

683 , "module ModuleB where"

683− , "import qualified ModuleA as A ((!!), stuffB, (!!))"

684+ , "import qualified ModuleA as A ((<?>), stuffB, (!!))"

684 , "main = print A.stuffB"

685 , "main = print A.stuffB"

685 ]

686 ]

686 docB <- openDoc' "ModuleB.hs" "haskell" contentB

687 docB <- openDoc' "ModuleB.hs" "haskell" contentB

@@ -688,9 +689,9 @@ removeImportTests = testGroup "remove import actions"

688 [CACodeAction action@CodeAction { _title = actionTitle }]

689 [CACodeAction action@CodeAction { _title = actionTitle }]

689 <- getCodeActions docB (Range (Position 2 0) (Position 2 5))

690 <- getCodeActions docB (Range (Position 2 0) (Position 2 5))

690#if MIN_GHC_API_VERSION(8,6,0)

691#if MIN_GHC_API_VERSION(8,6,0)

691− liftIO $ "Remove !! from import" @=? actionTitle

692+ liftIO $ "Remove !!, <?> from import" @=? actionTitle

692#else

693#else

693− liftIO $ "Remove A.!! from import" @=? actionTitle

694+ liftIO $ "Remove A.!!, A.<?> from import" @=? actionTitle

694#endif

695#endif

695 executeCodeAction action

696 executeCodeAction action

696 contentAfterAction <- documentContents docB

697 contentAfterAction <- documentContents docB

@@ -701,7 +702,7 @@ removeImportTests = testGroup "remove import actions"

701 , "main = print A.stuffB"

702 , "main = print A.stuffB"

702 ]

703 ]

703 liftIO $ expectedContentAfterAction @=? contentAfterAction

704 liftIO $ expectedContentAfterAction @=? contentAfterAction

704− , (`xfail` "known broken (#299)") $ testSession "redundant hierarchical import" $ do

705+ , testSession "redundant all import" $ do

705 let contentA = T.unlines

706 let contentA = T.unlines

706 [ "module ModuleA where"

707 [ "module ModuleA where"

707 , "data A = A"

708 , "data A = A"

@@ -729,6 +730,33 @@ removeImportTests = testGroup "remove import actions"

729 , "main = print stuffB"

730 , "main = print stuffB"

730 ]

731 ]

731 liftIO $ expectedContentAfterAction @=? contentAfterAction

732 liftIO $ expectedContentAfterAction @=? contentAfterAction

733+ , testSession "redundant constructor import" $ do

734+ let contentA = T.unlines

735+ [ "module ModuleA where"

736+ , "data D = A | B"

737+ , "data E = F"

738+ ]

739+ _docA <- openDoc' "ModuleA.hs" "haskell" contentA

740+ let contentB = T.unlines

741+ [ "{-# OPTIONS_GHC -Wunused-imports #-}"

742+ , "module ModuleB where"

743+ , "import ModuleA (D(A,B), E(F))"

744+ , "main = B"

745+ ]

746+ docB <- openDoc' "ModuleB.hs" "haskell" contentB

747+ _ <- waitForDiagnostics

748+ [CACodeAction action@CodeAction { _title = actionTitle }]

749+ <- getCodeActions docB (Range (Position 2 0) (Position 2 5))

750+ liftIO $ "Remove A, E, F from import" @=? actionTitle

751+ executeCodeAction action

752+ contentAfterAction <- documentContents docB

753+ let expectedContentAfterAction = T.unlines

754+ [ "{-# OPTIONS_GHC -Wunused-imports #-}"

755+ , "module ModuleB where"

756+ , "import ModuleA (D(B))"

757+ , "main = B"

758+ ]

759+ liftIO $ expectedContentAfterAction @=? contentAfterAction

732 ]

760 ]

733

761

734extendImportTests :: TestTree

762extendImportTests :: TestTree