Skip to content

Commit 9b7302f

Browse files
berbermanpepeiborra
berberman
and
pepeiborra
authored
Use TextEdit to insert new imports (#1554)
* Use TextEdit to insert new imports * Fix build * Fix order Co-authored-by: Pepe Iborra <[email protected]>
1 parent ba92f5f commit 9b7302f

File tree

4 files changed

+111
-150
lines changed

4 files changed

+111
-150
lines changed

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

Lines changed: 90 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,8 @@ import Development.IDE.GHC.Compat
4343
import Development.IDE.GHC.Error
4444
import Development.IDE.GHC.ExactPrint
4545
import Development.IDE.GHC.Util (prettyPrint,
46-
printRdrName)
46+
printRdrName,
47+
unsafePrintSDoc)
4748
import Development.IDE.Plugin.CodeAction.Args
4849
import Development.IDE.Plugin.CodeAction.ExactPrint
4950
import Development.IDE.Plugin.CodeAction.PositionIndexed
@@ -71,7 +72,8 @@ import Outputable (Outputable,
7172
import RdrName (GlobalRdrElt (..),
7273
lookupGlobalRdrEnv)
7374
import Safe (atMay)
74-
import SrcLoc (realSrcSpanStart)
75+
import SrcLoc (realSrcSpanEnd,
76+
realSrcSpanStart)
7577
import TcRnTypes (ImportAvails (..),
7678
TcGblEnv (..))
7779
import Text.Regex.TDFA (mrAfter,
@@ -179,8 +181,8 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` l)
179181
-- imported from ‘Data.ByteString’ at B.hs:6:1-22
180182
-- imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
181183
-- imported from ‘Data.Text’ at B.hs:7:1-16
182-
suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Rewrite])]
183-
suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}
184+
suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
185+
suggestHideShadow ps@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}
184186
| Just [identifier, modName, s] <-
185187
matchRegexUnifySpaces
186188
_message
@@ -205,8 +207,8 @@ suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_messag
205207
mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,
206208
title <- "Hide " <> identifier <> " from " <> modName =
207209
if modName == "Prelude" && null mDecl
208-
then [(title, maybeToList $ hideImplicitPreludeSymbol (T.unpack identifier) pm)]
209-
else maybeToList $ (title,) . pure . hideSymbol (T.unpack identifier) <$> mDecl
210+
then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps
211+
else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl
210212
| otherwise = []
211213

212214
findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
@@ -808,7 +810,7 @@ suggestImportDisambiguation ::
808810
Maybe T.Text ->
809811
ParsedSource ->
810812
Diagnostic ->
811-
[(T.Text, [Rewrite])]
813+
[(T.Text, [Either TextEdit Rewrite])]
812814
suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@Diagnostic {..}
813815
| Just [ambiguous] <-
814816
matchRegexUnifySpaces
@@ -897,23 +899,23 @@ disambiguateSymbol ::
897899
Diagnostic ->
898900
T.Text ->
899901
HidingMode ->
900-
[Rewrite]
902+
[Either TextEdit Rewrite]
901903
disambiguateSymbol pm Diagnostic {..} (T.unpack -> symbol) = \case
902904
(HideOthers hiddens0) ->
903-
[ hideSymbol symbol idecl
905+
[ Right $ hideSymbol symbol idecl
904906
| ExistingImp idecls <- hiddens0
905907
, idecl <- NE.toList idecls
906908
]
907909
++ mconcat
908910
[ if null imps
909-
then maybeToList $ hideImplicitPreludeSymbol symbol pm
910-
else hideSymbol symbol <$> imps
911+
then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm
912+
else Right . hideSymbol symbol <$> imps
911913
| ImplicitPrelude imps <- hiddens0
912914
]
913915
(ToQualified parensed qualMod) ->
914916
let occSym = mkVarOcc symbol
915917
rdr = Qual qualMod occSym
916-
in [ if parensed
918+
in Right <$> [ if parensed
917919
then Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->
918920
liftParseAST @(HsExpr GhcPs) df $
919921
prettyPrint $
@@ -1136,7 +1138,7 @@ removeRedundantConstraints mContents Diagnostic{..}
11361138

11371139
-------------------------------------------------------------------------------------------------
11381140

1139-
suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])]
1141+
suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
11401142
suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message}
11411143
| Just [methodName, className] <-
11421144
matchRegexUnifySpaces
@@ -1155,22 +1157,24 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message
11551157
-- extend
11561158
Just decl ->
11571159
[ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,
1158-
[uncurry extendImport (unImportStyle style) decl]
1160+
[Right $ uncurry extendImport (unImportStyle style) decl]
11591161
)
11601162
| style <- importStyle
11611163
]
11621164
-- new
1163-
_ ->
1164-
[ ( "Import " <> moduleNameText <> " with " <> rendered,
1165-
maybeToList $ newUnqualImport (T.unpack moduleNameText) (T.unpack rendered) False ps
1166-
)
1165+
_
1166+
| Just (range, indent) <- newImportInsertRange ps
1167+
->
1168+
(\(unNewImport -> x) -> (x, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$>
1169+
[ newUnqualImport moduleNameText rendered False
11671170
| style <- importStyle,
11681171
let rendered = renderImportStyle style
11691172
]
1170-
<> maybeToList (("Import " <> moduleNameText,) <$> fmap pure (newImportAll (T.unpack moduleNameText) ps))
1173+
<> [newImportAll moduleNameText]
1174+
| otherwise -> []
11711175

1172-
suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)]
1173-
suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
1176+
suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, TextEdit)]
1177+
suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message}
11741178
| msg <- unifySpaces _message
11751179
, Just thingMissing <- extractNotInScopeName msg
11761180
, qual <- extractQualifiedModuleName msg
@@ -1179,23 +1183,16 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule
11791183
>>= (findImportDeclByModuleName hsmodImports . T.unpack)
11801184
>>= ideclAs . unLoc
11811185
<&> T.pack . moduleNameString . unLoc
1182-
, Just insertLine <- case hsmodImports of
1183-
[] -> case srcSpanStart $ getLoc (head hsmodDecls) of
1184-
RealSrcLoc s -> Just $ srcLocLine s - 1
1185-
_ -> Nothing
1186-
_ -> case srcSpanEnd $ getLoc (last hsmodImports) of
1187-
RealSrcLoc s -> Just $ srcLocLine s
1188-
_ -> Nothing
1189-
, insertPos <- Position insertLine 0
1186+
, Just (range, indent) <- newImportInsertRange ps
11901187
, extendImportSuggestions <- matchRegexUnifySpaces msg
11911188
"Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
1192-
= [(imp, TextEdit (Range insertPos insertPos) (imp <> "\n"))
1193-
| imp <- sort $ constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions
1189+
= sortOn fst [(imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))
1190+
| (unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions
11941191
]
11951192
suggestNewImport _ _ _ = []
11961193

11971194
constructNewImportSuggestions
1198-
:: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [T.Text]
1195+
:: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [NewImport]
11991196
constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd
12001197
[ suggestion
12011198
| Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing]
@@ -1205,18 +1202,74 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules =
12051202
, suggestion <- renderNewImport identInfo
12061203
]
12071204
where
1208-
renderNewImport :: IdentInfo -> [T.Text]
1205+
renderNewImport :: IdentInfo -> [NewImport]
12091206
renderNewImport identInfo
12101207
| Just q <- qual
1211-
, asQ <- if q == m then "" else " as " <> q
1212-
= ["import qualified " <> m <> asQ]
1208+
= [newQualImport m q]
12131209
| otherwise
1214-
= ["import " <> m <> " (" <> renderImportStyle importStyle <> ")"
1210+
= [newUnqualImport m (renderImportStyle importStyle) False
12151211
| importStyle <- NE.toList $ importStyles identInfo] ++
1216-
["import " <> m ]
1212+
[newImportAll m]
12171213
where
12181214
m = moduleNameText identInfo
12191215

1216+
newtype NewImport = NewImport {unNewImport :: T.Text}
1217+
deriving (Show, Eq, Ord)
1218+
1219+
newImportToEdit :: NewImport -> ParsedSource -> Maybe (T.Text, TextEdit)
1220+
newImportToEdit (unNewImport -> imp) ps
1221+
| Just (range, indent) <- newImportInsertRange ps
1222+
= Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))
1223+
| otherwise = Nothing
1224+
1225+
newImportInsertRange :: ParsedSource -> Maybe (Range, Int)
1226+
newImportInsertRange (L _ HsModule {..})
1227+
| Just (uncurry Position -> insertPos, col) <- case hsmodImports of
1228+
[] -> case getLoc (head hsmodDecls) of
1229+
RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1
1230+
in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col)
1231+
_ -> Nothing
1232+
_ -> case getLoc (last hsmodImports) of
1233+
RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1
1234+
in Just ((srcLocLine $ realSrcSpanEnd s,col), col)
1235+
_ -> Nothing
1236+
= Just (Range insertPos insertPos, col)
1237+
| otherwise = Nothing
1238+
1239+
-- | Construct an import declaration with at most one symbol
1240+
newImport
1241+
:: T.Text -- ^ module name
1242+
-> Maybe T.Text -- ^ the symbol
1243+
-> Maybe T.Text -- ^ qualified name
1244+
-> Bool -- ^ the symbol is to be imported or hidden
1245+
-> NewImport
1246+
newImport modName mSymbol mQual hiding = NewImport impStmt
1247+
where
1248+
symImp
1249+
| Just symbol <- mSymbol
1250+
, symOcc <- mkVarOcc $ T.unpack symbol =
1251+
" (" <> T.pack (unsafePrintSDoc (parenSymOcc symOcc $ ppr symOcc)) <> ")"
1252+
| otherwise = ""
1253+
impStmt =
1254+
"import "
1255+
<> maybe "" (const "qualified ") mQual
1256+
<> modName
1257+
<> (if hiding then " hiding" else "")
1258+
<> symImp
1259+
<> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual
1260+
1261+
newQualImport :: T.Text -> T.Text -> NewImport
1262+
newQualImport modName qual = newImport modName Nothing (Just qual) False
1263+
1264+
newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport
1265+
newUnqualImport modName symbol = newImport modName (Just symbol) Nothing
1266+
1267+
newImportAll :: T.Text -> NewImport
1268+
newImportAll modName = newImport modName Nothing Nothing False
1269+
1270+
hideImplicitPreludeSymbol :: T.Text -> NewImport
1271+
hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True
1272+
12201273
canUseIdent :: NotInScope -> IdentInfo -> Bool
12211274
canUseIdent NotInScopeDataConstructor{} = isDatacon
12221275
canUseIdent _ = const True

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

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,12 @@ import Language.LSP.Types (CodeActionKind (C
2525
import Retrie (Annotated (astA))
2626
import Retrie.ExactPrint (annsA)
2727

28+
type CodeActionTitle = T.Text
29+
30+
type CodeActionPreferred = Bool
31+
2832
-- | A compact representation of 'Language.LSP.Types.CodeAction's
29-
type GhcideCodeActions = [(T.Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])]
33+
type GhcideCodeActions = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])]
3034

3135
class ToTextEdit a where
3236
toTextEdit :: CodeActionArgs -> a -> [TextEdit]
@@ -105,16 +109,16 @@ instance ToCodeAction a => ToCodeAction [a] where
105109
instance ToCodeAction a => ToCodeAction (Maybe a) where
106110
toCodeAction caa = maybe [] (toCodeAction caa)
107111

108-
instance ToTextEdit a => ToCodeAction (T.Text, a) where
112+
instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where
109113
toCodeAction caa (title, te) = [(title, Just CodeActionQuickFix, Nothing, toTextEdit caa te)]
110114

111-
instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, a) where
115+
instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where
112116
toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)]
113117

114-
instance ToTextEdit a => ToCodeAction (T.Text, Bool, a) where
118+
instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where
115119
toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)]
116120

117-
instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, Bool, a) where
121+
instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where
118122
toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)]
119123

120124
-------------------------------------------------------------------------------------------------

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

Lines changed: 3 additions & 79 deletions
Original file line numberDiff line numberDiff line change
@@ -12,12 +12,8 @@ module Development.IDE.Plugin.CodeAction.ExactPrint (
1212
-- * Utilities
1313
appendConstraint,
1414
extendImport,
15-
hideImplicitPreludeSymbol,
1615
hideSymbol,
1716
liftParseAST,
18-
newImport,
19-
newUnqualImport,
20-
newImportAll,
2117
) where
2218

2319
import Control.Applicative
@@ -39,20 +35,14 @@ import Development.IDE.GHC.ExactPrint (ASTElement (parseAST),
3935
import Development.IDE.Spans.Common
4036
import FieldLabel (flLabel)
4137
import GHC.Exts (IsList (fromList))
42-
import GhcPlugins (mkRealSrcLoc,
43-
realSrcSpanStart,
44-
sigPrec)
38+
import GhcPlugins (sigPrec)
4539
import Language.Haskell.GHC.ExactPrint
4640
import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
4741
KeywordId (G), mkAnnKey)
4842
import Language.LSP.Types
4943
import OccName
50-
import Outputable (ppr, showSDoc,
51-
showSDocUnsafe)
52-
import Retrie.GHC (mkRealSrcSpan,
53-
rdrNameOcc,
54-
realSrcSpanEnd,
55-
unpackFS)
44+
import Outputable (ppr, showSDocUnsafe)
45+
import Retrie.GHC (rdrNameOcc, unpackFS)
5646

5747
------------------------------------------------------------------------------
5848

@@ -432,69 +422,3 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do
432422
(filter ((/= symbol) . unqualIEWrapName . unLoc) cons)
433423
(filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds)
434424
killLie v = Just v
435-
436-
-- | Insert a import declaration with at most one symbol
437-
438-
-- newImport "A" (Just "Bar(Cons)") Nothing False --> import A (Bar(Cons))
439-
-- newImport "A" (Just "foo") Nothing True --> import A hiding (foo)
440-
-- newImport "A" Nothing (Just "Q") False --> import qualified A as Q
441-
--
442-
-- Wrong combinations will result in parse error
443-
-- Returns Nothing if there is no imports and declarations
444-
newImport ::
445-
-- | module name
446-
String ->
447-
-- | the symbol
448-
Maybe String ->
449-
-- | whether to be qualified
450-
Maybe String ->
451-
-- | the symbol is to be imported or hidden
452-
Bool ->
453-
ParsedSource ->
454-
Maybe Rewrite
455-
newImport modName mSymbol mQual hiding (L _ HsModule{..}) = do
456-
-- TODO (berberman): if the previous line is module name and there is no other imports,
457-
-- 'AnnWhere' will be crowded out to the next line, which is a bug
458-
let predLine old =
459-
mkRealSrcLoc
460-
(srcLocFile old)
461-
(srcLocLine old - 1)
462-
(srcLocCol old)
463-
existingImpSpan = (fmap (realSrcSpanEnd,) . realSpan . getLoc) =<< lastMaybe hsmodImports
464-
existingDeclSpan = (fmap (predLine . realSrcSpanStart,) . realSpan . getLoc) =<< headMaybe hsmodDecls
465-
(f, s) <- existingImpSpan <|> existingDeclSpan
466-
let beg = f s
467-
indentation = srcSpanStartCol s
468-
ran = RealSrcSpan $ mkRealSrcSpan beg beg
469-
pure $
470-
Rewrite ran $ \df -> do
471-
let symImp
472-
| Just symbol <- mSymbol
473-
, symOcc <- mkVarOcc symbol =
474-
"(" <> showSDoc df (parenSymOcc symOcc $ ppr symOcc) <> ")"
475-
| otherwise = ""
476-
impStmt =
477-
"import "
478-
<> maybe "" (const "qualified ") mQual
479-
<> modName
480-
<> (if hiding then " hiding " else " ")
481-
<> symImp
482-
<> maybe "" (" as " <>) mQual
483-
-- Re-labeling is needed to reflect annotations correctly
484-
L _ idecl0 <- liftParseAST @(ImportDecl GhcPs) df impStmt
485-
let idecl = L ran idecl0
486-
addSimpleAnnT
487-
idecl
488-
(DP (1, indentation - 1))
489-
[(G AnnImport, DP (1, indentation - 1))]
490-
pure idecl
491-
492-
newUnqualImport :: String -> String -> Bool -> ParsedSource -> Maybe Rewrite
493-
newUnqualImport modName symbol = newImport modName (Just symbol) Nothing
494-
495-
newImportAll :: String -> ParsedSource -> Maybe Rewrite
496-
newImportAll modName = newImport modName Nothing Nothing False
497-
498-
-- | Insert "import Prelude hiding (symbol)"
499-
hideImplicitPreludeSymbol :: String -> ParsedSource -> Maybe Rewrite
500-
hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True

0 commit comments

Comments
 (0)