Skip to content

Commit eb557b3

Browse files
berbermanberberman
committed
Use exact print to suggestExtendImport
1 parent 6eafe90 commit eb557b3

File tree

2 files changed

+30
-69
lines changed

2 files changed

+30
-69
lines changed

‎ghcide/src/Development/IDE/Plugin/CodeAction.hs‎

Lines changed: 20 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -108,13 +108,13 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
108108
| x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text x
109109
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
110110
] <> caRemoveRedundantImports parsedModule text diag xs uri
111-
111+
112112
actions' =
113113
[mkCA title [x] edit
114114
| x <- xs
115115
, Just ps <- [annotatedPS]
116116
, Just dynflags <- [df]
117-
, (title, graft) <- suggestExactAction dynflags ps x
117+
, (title, graft) <- suggestExactAction exportsMap dynflags ps x
118118
, let edit = either error id $
119119
rewriteToEdit dynflags uri (annsA ps) graft
120120
]
@@ -171,14 +171,16 @@ commandHandler lsp _ideState ExecuteCommandParams{..}
171171
= return (Right Null, Nothing)
172172

173173
suggestExactAction ::
174+
ExportsMap ->
174175
DynFlags ->
175176
Annotated ParsedSource ->
176177
Diagnostic ->
177178
[(T.Text, Rewrite)]
178-
suggestExactAction df ps x =
179+
suggestExactAction exportsMap df ps x =
179180
concat
180181
[ suggestConstraint df (astA ps) x
181182
, suggestImplicitParameter (astA ps) x
183+
, suggestExtendImport exportsMap (astA ps) x
182184
]
183185

184186
suggestAction
@@ -191,7 +193,6 @@ suggestAction
191193
suggestAction packageExports ideOptions parsedModule text diag = concat
192194
-- Order these suggestions by priority
193195
[ suggestSignature True diag
194-
, suggestExtendImport packageExports text diag
195196
, suggestFillTypeWildcard diag
196197
, suggestFixConstructorImport text diag
197198
, suggestModuleTypo diag
@@ -660,32 +661,31 @@ getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of
660661
indentation :: T.Text -> Int
661662
indentation = T.length . T.takeWhile isSpace
662663

663-
suggestExtendImport :: ExportsMap -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
664-
suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
664+
suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)]
665+
suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..}
665666
| Just [binding, mod, srcspan] <-
666667
matchRegexUnifySpaces _message
667668
"Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\).$"
668-
, Just c <- contents
669-
= suggestions c binding mod srcspan
669+
= suggestions hsmodImports binding mod srcspan
670670
| Just (binding, mod_srcspan) <-
671671
matchRegExMultipleImports _message
672-
, Just c <- contents
673-
= mod_srcspan >>= (\(x, y) -> suggestions c binding x y)
672+
= mod_srcspan >>= uncurry (suggestions hsmodImports binding)
674673
| otherwise = []
675674
where
676-
suggestions c binding mod srcspan
675+
unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x)
676+
unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x)
677+
suggestions decls binding mod srcspan
677678
| range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of
678679
[s] -> let x = realSrcSpanToRange s
679680
in x{_end = (_end x){_character = succ (_character (_end x))}}
680681
_ -> error "bug in srcspan parser",
681-
importLine <- textInRange range c,
682+
Just decl <- findImportDeclByRange decls range,
682683
Just ident <- lookupExportMap binding mod
683-
= [ ( "Add " <> rendered <> " to the import list of " <> mod
684-
, [TextEdit range result]
684+
= [ ( "Add " <> renderImportStyle importStyle <> " to the import list of " <> mod
685+
, uncurry extendImport (unImportStyle importStyle) decl
685686
)
686687
| importStyle <- NE.toList $ importStyles ident
687-
, let rendered = renderImportStyle importStyle
688-
, result <- maybeToList $ addBindingToImportList importStyle importLine]
688+
]
689689
| otherwise = []
690690
lookupExportMap binding mod
691691
| Just match <- Map.lookup binding (getExportsMap exportsMap)
@@ -700,6 +700,9 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
700700
, parent = Nothing
701701
, isDatacon = False}
702702

703+
findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs)
704+
findImportDeclByRange xs range = find (\(L l _)-> srcSpanToRange l == Just range) xs
705+
703706
suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
704707
suggestFixConstructorImport _ Diagnostic{_range=_range,..}
705708
-- ‘Success’ is a data constructor of ‘Result’
@@ -1109,49 +1112,6 @@ rangesForBinding' b (L l (IEThingWith _ thing _ inners labels))
11091112
[ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b]
11101113
rangesForBinding' _ _ = []
11111114

1112-
-- | Extends an import list with a new binding.
1113-
-- Assumes an import statement of the form:
1114-
-- import (qualified) A (..) ..
1115-
-- Places the new binding first, preserving whitespace.
1116-
-- Copes with multi-line import lists
1117-
addBindingToImportList :: ImportStyle -> T.Text -> Maybe T.Text
1118-
addBindingToImportList importStyle importLine =
1119-
case T.breakOn "(" importLine of
1120-
(pre, T.uncons -> Just (_, rest)) ->
1121-
case importStyle of
1122-
ImportTopLevel rendered ->
1123-
-- the binding has no parent, add it to the head of import list
1124-
Just $ T.concat [pre, "(", rendered, addCommaIfNeeds rest]
1125-
ImportViaParent rendered parent -> case T.breakOn parent rest of
1126-
-- the binding has a parent, and the current import list contains the
1127-
-- parent
1128-
--
1129-
-- `rest'` could be 1. `,...)`
1130-
-- or 2. `(),...)`
1131-
-- or 3. `(ConsA),...)`
1132-
-- or 4. `)`
1133-
(leading, T.stripPrefix parent -> Just rest') -> case T.uncons (T.stripStart rest') of
1134-
-- case 1: no children and parentheses, e.g. `import A(Foo,...)` --> `import A(Foo(Cons), ...)`
1135-
Just (',', rest'') -> Just $ T.concat [pre, "(", leading, parent, "(", rendered, ")", addCommaIfNeeds rest'']
1136-
-- case 2: no children but parentheses, e.g. `import A(Foo(),...)` --> `import A(Foo(Cons), ...)`
1137-
Just ('(', T.uncons -> Just (')', rest'')) -> Just $ T.concat [pre, "(", leading, parent, "(", rendered, ")", rest'']
1138-
-- case 3: children with parentheses, e.g. `import A(Foo(ConsA),...)` --> `import A(Foo(Cons, ConsA), ...)`
1139-
Just ('(', T.breakOn ")" -> (children, rest''))
1140-
| not (T.null children),
1141-
-- ignore A(Foo({-...-}), ...)
1142-
not $ "{-" `T.isPrefixOf` T.stripStart children
1143-
-> Just $ T.concat [pre, "(", leading, parent, "(", rendered, ", ", children, rest'']
1144-
-- case 4: no trailing, e.g. `import A(..., Foo)` --> `import A(..., Foo(Cons))`
1145-
Just (')', _) -> Just $ T.concat [pre, "(", leading, parent, "(", rendered, ")", rest']
1146-
_ -> Nothing
1147-
-- current import list does not contain the parent, e.g. `import A(...)` --> `import A(Foo(Cons), ...)`
1148-
_ -> Just $ T.concat [pre, "(", parent, "(", rendered, ")", addCommaIfNeeds rest]
1149-
_ -> Nothing
1150-
where
1151-
addCommaIfNeeds r = case T.uncons (T.stripStart r) of
1152-
Just (')', _) -> r
1153-
_ -> ", " <> r
1154-
11551115
-- | 'matchRegex' combined with 'unifySpaces'
11561116
matchRegexUnifySpaces :: T.Text -> T.Text -> Maybe [T.Text]
11571117
matchRegexUnifySpaces message = matchRegex (unifySpaces message)
@@ -1243,6 +1203,7 @@ data ImportStyle
12431203
--
12441204
-- @P@ and @?@ can be a data type and a constructor, a class and a method,
12451205
-- a class and an associated type/data family, etc.
1206+
deriving Show
12461207

12471208
importStyles :: IdentInfo -> NonEmpty ImportStyle
12481209
importStyles IdentInfo {parent, rendered, isDatacon}

‎ghcide/test/exe/Main.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1110,7 +1110,7 @@ extendImportTests = testGroup "extend import actions"
11101110
["Add stuffA to the import list of ModuleA"]
11111111
(T.unlines
11121112
[ "module ModuleB where"
1113-
, "import ModuleA as A (stuffA, stuffB)"
1113+
, "import ModuleA as A (stuffB, stuffA)"
11141114
, "main = print (stuffA, stuffB)"
11151115
])
11161116
, testSession "extend single line import with operator" $ template
@@ -1130,7 +1130,7 @@ extendImportTests = testGroup "extend import actions"
11301130
["Add (.*) to the import list of ModuleA"]
11311131
(T.unlines
11321132
[ "module ModuleB where"
1133-
, "import ModuleA as A ((.*), stuffB)"
1133+
, "import ModuleA as A (stuffB, (.*))"
11341134
, "main = print (stuffB .* stuffB)"
11351135
])
11361136
, testSession "extend single line import with type" $ template
@@ -1167,7 +1167,7 @@ extendImportTests = testGroup "extend import actions"
11671167
["Add A(Constructor) to the import list of ModuleA"]
11681168
(T.unlines
11691169
[ "module ModuleB where"
1170-
, "import ModuleA (A(Constructor))"
1170+
, "import ModuleA (A (Constructor))"
11711171
, "b :: A"
11721172
, "b = Constructor"
11731173
])
@@ -1179,15 +1179,15 @@ extendImportTests = testGroup "extend import actions"
11791179
])]
11801180
("ModuleB.hs", T.unlines
11811181
[ "module ModuleB where"
1182-
, "import ModuleA (A(ConstructorBar), a)"
1182+
, "import ModuleA (A (ConstructorBar), a)"
11831183
, "b :: A"
11841184
, "b = ConstructorFoo"
11851185
])
11861186
(Range (Position 2 5) (Position 2 5))
11871187
["Add A(ConstructorFoo) to the import list of ModuleA"]
11881188
(T.unlines
11891189
[ "module ModuleB where"
1190-
, "import ModuleA (A(ConstructorFoo, ConstructorBar), a)"
1190+
, "import ModuleA (A (ConstructorBar, ConstructorFoo), a)"
11911191
, "b :: A"
11921192
, "b = ConstructorFoo"
11931193
])
@@ -1208,7 +1208,7 @@ extendImportTests = testGroup "extend import actions"
12081208
["Add stuffA to the import list of ModuleA"]
12091209
(T.unlines
12101210
[ "module ModuleB where"
1211-
, "import qualified ModuleA as A (stuffA, stuffB)"
1211+
, "import qualified ModuleA as A (stuffB, stuffA)"
12121212
, "main = print (A.stuffA, A.stuffB)"
12131213
])
12141214
, testSession "extend multi line import with value" $ template
@@ -1229,7 +1229,7 @@ extendImportTests = testGroup "extend import actions"
12291229
["Add stuffA to the import list of ModuleA"]
12301230
(T.unlines
12311231
[ "module ModuleB where"
1232-
, "import ModuleA (stuffA, stuffB"
1232+
, "import ModuleA (stuffB, stuffA"
12331233
, " )"
12341234
, "main = print (stuffA, stuffB)"
12351235
])
@@ -1250,7 +1250,7 @@ extendImportTests = testGroup "extend import actions"
12501250
"Add m2 to the import list of ModuleA"]
12511251
(T.unlines
12521252
[ "module ModuleB where"
1253-
, "import ModuleA (C(m2, m1))"
1253+
, "import ModuleA (C(m1, m2))"
12541254
, "b = m2"
12551255
])
12561256
, testSession "extend single line import with method without class" $ template
@@ -1270,7 +1270,7 @@ extendImportTests = testGroup "extend import actions"
12701270
"Add C(m2) to the import list of ModuleA"]
12711271
(T.unlines
12721272
[ "module ModuleB where"
1273-
, "import ModuleA (m2, C(m1))"
1273+
, "import ModuleA (C(m1), m2)"
12741274
, "b = m2"
12751275
])
12761276
, testSession "extend import list with multiple choices" $ template
@@ -1311,7 +1311,7 @@ extendImportTests = testGroup "extend import actions"
13111311
["Add (:~:)(Refl) to the import list of Data.Type.Equality"]
13121312
(T.unlines
13131313
[ "module ModuleA where"
1314-
, "import Data.Type.Equality ((:~:)(Refl))"
1314+
, "import Data.Type.Equality ((:~:) (Refl))"
13151315
, "x :: (:~:) [] []"
13161316
, "x = Refl"
13171317
])

0 commit comments

Comments
 (0)