Use TextEdit to insert new imports

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

@@ -43,7 +43,8 @@ import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Error
 import           Development.IDE.GHC.ExactPrint
 import           Development.IDE.GHC.Util                          (prettyPrint,
-                                                                    printRdrName)
+                                                                    printRdrName,
+                                                                    unsafePrintSDoc)
 import           Development.IDE.Plugin.CodeAction.Args
 import           Development.IDE.Plugin.CodeAction.ExactPrint
 import           Development.IDE.Plugin.CodeAction.PositionIndexed
@@ -71,7 +72,8 @@ import           Outputable                                        (Outputable,
 import           RdrName                                           (GlobalRdrElt (..),
                                                                     lookupGlobalRdrEnv)
 import           Safe                                              (atMay)
-import           SrcLoc                                            (realSrcSpanStart)
+import           SrcLoc                                            (realSrcSpanEnd,
+                                                                    realSrcSpanStart)
 import           TcRnTypes                                         (ImportAvails (..),
                                                                     TcGblEnv (..))
 import           Text.Regex.TDFA                                   (mrAfter,
@@ -179,8 +181,8 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` l)
 --  imported from ‘Data.ByteString’ at B.hs:6:1-22
 --  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
 --  imported from ‘Data.Text’ at B.hs:7:1-16
-suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Rewrite])]
-suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}
+suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
+suggestHideShadow ps@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}
   | Just [identifier, modName, s] <-
       matchRegexUnifySpaces
         _message
@@ -205,8 +207,8 @@ suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_messag
         mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,
         title <- "Hide " <> identifier <> " from " <> modName =
         if modName == "Prelude" && null mDecl
-          then [(title, maybeToList $ hideImplicitPreludeSymbol (T.unpack identifier) pm)]
-          else maybeToList $ (title,) . pure . hideSymbol (T.unpack identifier) <$> mDecl
+          then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps
+          else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl
       | otherwise = []
 
 findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
@@ -808,7 +810,7 @@ suggestImportDisambiguation ::
     Maybe T.Text ->
     ParsedSource ->
     Diagnostic ->
-    [(T.Text, [Rewrite])]
+    [(T.Text, [Either TextEdit Rewrite])]
 suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@Diagnostic {..}
     | Just [ambiguous] <-
         matchRegexUnifySpaces
@@ -897,23 +899,23 @@ disambiguateSymbol ::
     Diagnostic ->
     T.Text ->
     HidingMode ->
-    [Rewrite]
+    [Either TextEdit Rewrite]
 disambiguateSymbol pm Diagnostic {..} (T.unpack -> symbol) = \case
     (HideOthers hiddens0) ->
-        [ hideSymbol symbol idecl
+        [ Right $ hideSymbol symbol idecl
         | ExistingImp idecls <- hiddens0
         , idecl <- NE.toList idecls
         ]
             ++ mconcat
                 [ if null imps
-                    then maybeToList $ hideImplicitPreludeSymbol symbol pm
-                    else hideSymbol symbol <$> imps
+                    then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm
+                    else Right . hideSymbol symbol <$> imps
                 | ImplicitPrelude imps <- hiddens0
                 ]
     (ToQualified parensed qualMod) ->
         let occSym = mkVarOcc symbol
             rdr = Qual qualMod occSym
-         in [ if parensed
+         in Right <$> [ if parensed
                 then Rewrite (rangeToSrcSpan "<dummy>" _range) $ \df ->
                     liftParseAST @(HsExpr GhcPs) df $
                     prettyPrint $
@@ -1136,7 +1138,7 @@ removeRedundantConstraints mContents Diagnostic{..}
 
 -------------------------------------------------------------------------------------------------
 
-suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])]
+suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])]
 suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message}
   | Just [methodName, className] <-
       matchRegexUnifySpaces
@@ -1155,22 +1157,24 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message
           -- extend
           Just decl ->
             [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText,
-                [uncurry extendImport (unImportStyle style) decl]
+                [Right $ uncurry extendImport (unImportStyle style) decl]
               )
               | style <- importStyle
             ]
           -- new
-          _ ->
-            [ ( "Import " <> moduleNameText <> " with " <> rendered,
-                maybeToList $ newUnqualImport (T.unpack moduleNameText) (T.unpack rendered) False ps
-              )
+          _
+            | Just (range, indent) <- newImportInsertRange ps
+            ->
+             (\(unNewImport -> x) -> (x, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$>
+            [ newUnqualImport moduleNameText rendered False
               | style <- importStyle,
                 let rendered = renderImportStyle style
             ]
-              <> maybeToList (("Import " <> moduleNameText,) <$> fmap pure (newImportAll (T.unpack moduleNameText) ps))
+              <> [newImportAll moduleNameText]
+            | otherwise -> []
 
-suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)]
-suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
+suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, TextEdit)]
+suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message}
   | msg <- unifySpaces _message
   , Just thingMissing <- extractNotInScopeName msg
   , qual <- extractQualifiedModuleName msg
@@ -1179,23 +1183,16 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule
         >>= (findImportDeclByModuleName hsmodImports . T.unpack)
         >>= ideclAs . unLoc
         <&> T.pack . moduleNameString . unLoc
-  , Just insertLine <- case hsmodImports of
-        [] -> case srcSpanStart $ getLoc (head hsmodDecls) of
-          RealSrcLoc s -> Just $ srcLocLine s - 1
-          _            -> Nothing
-        _ -> case srcSpanEnd $ getLoc (last hsmodImports) of
-          RealSrcLoc s -> Just $ srcLocLine s
-          _            -> Nothing
-  , insertPos <- Position insertLine 0
+  , Just (range, indent) <- newImportInsertRange ps
   , extendImportSuggestions <- matchRegexUnifySpaces msg
     "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
-  = [(imp, TextEdit (Range insertPos insertPos) (imp <> "\n"))
-    | imp <- sort $ constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions
+  = sortOn fst [(imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))
+    | (unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions
     ]
 suggestNewImport _ _ _ = []
 
 constructNewImportSuggestions
-  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [T.Text]
+  :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [NewImport]
 constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd
   [ suggestion
   | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing]
@@ -1205,18 +1202,74 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules =
   , suggestion <- renderNewImport identInfo
   ]
  where
-  renderNewImport :: IdentInfo -> [T.Text]
+  renderNewImport :: IdentInfo -> [NewImport]
   renderNewImport identInfo
     | Just q <- qual
-    , asQ <- if q == m then "" else " as " <> q
-    = ["import qualified " <> m <> asQ]
+    = [newQualImport m q]
     | otherwise
-    = ["import " <> m <> " (" <> renderImportStyle importStyle <> ")"
+    = [newUnqualImport m (renderImportStyle importStyle) False
       | importStyle <- NE.toList $ importStyles identInfo] ++
-      ["import " <> m ]
+      [newImportAll m]
     where
         m = moduleNameText identInfo
 
+newtype NewImport = NewImport {unNewImport :: T.Text}
+  deriving (Show, Eq, Ord)
+
+newImportToEdit :: NewImport -> ParsedSource -> Maybe (T.Text, TextEdit)
+newImportToEdit (unNewImport -> imp) ps
+  | Just (range, indent) <- newImportInsertRange ps
+  = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " "))
+  | otherwise = Nothing
+
+newImportInsertRange :: ParsedSource -> Maybe (Range, Int)
+newImportInsertRange (L _ HsModule {..})
+  |  Just (uncurry Position -> insertPos, col) <- case hsmodImports of
+      [] -> case getLoc (head hsmodDecls) of
+        RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1
+              in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col)
+        _            -> Nothing
+      _ -> case  getLoc (last hsmodImports) of
+        RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1
+            in Just ((srcLocLine $ realSrcSpanEnd s,col), col)
+        _            -> Nothing
+    = Just (Range insertPos insertPos, col)
+  | otherwise = Nothing
+
+-- | Construct an import declaration with at most one symbol
+newImport
+  :: T.Text -- ^ module name
+  -> Maybe T.Text -- ^  the symbol
+  -> Maybe T.Text -- ^ qualified name
+  -> Bool -- ^ the symbol is to be imported or hidden
+  -> NewImport
+newImport modName mSymbol mQual hiding = NewImport impStmt
+  where
+     symImp
+            | Just symbol <- mSymbol
+              , symOcc <- mkVarOcc $ T.unpack symbol =
+              " (" <> T.pack (unsafePrintSDoc (parenSymOcc symOcc $ ppr symOcc)) <> ")"
+            | otherwise = ""
+     impStmt =
+       "import "
+         <> maybe "" (const "qualified ") mQual
+         <> modName
+         <> (if hiding then " hiding" else "")
+         <> symImp
+         <> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual
+
+newQualImport :: T.Text -> T.Text -> NewImport
+newQualImport modName qual = newImport modName Nothing (Just qual) False
+
+newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport
+newUnqualImport modName symbol = newImport modName (Just symbol) Nothing
+
+newImportAll :: T.Text -> NewImport
+newImportAll modName = newImport modName Nothing Nothing False
+
+hideImplicitPreludeSymbol :: T.Text -> NewImport
+hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True
+
 canUseIdent :: NotInScope -> IdentInfo -> Bool
 canUseIdent NotInScopeDataConstructor{} = isDatacon
 canUseIdent _                           = const True

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

@@ -25,8 +25,12 @@ import           Language.LSP.Types                           (CodeActionKind (C
 import           Retrie                                       (Annotated (astA))
 import           Retrie.ExactPrint                            (annsA)
 
+type CodeActionTitle = T.Text
+
+type CodeActionPreferred = Bool
+
 -- | A compact representation of 'Language.LSP.Types.CodeAction's
-type GhcideCodeActions = [(T.Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])]
+type GhcideCodeActions = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])]
 
 class ToTextEdit a where
   toTextEdit :: CodeActionArgs -> a -> [TextEdit]
@@ -105,16 +109,16 @@ instance ToCodeAction a => ToCodeAction [a] where
 instance ToCodeAction a => ToCodeAction (Maybe a) where
   toCodeAction caa = maybe [] (toCodeAction caa)
 
-instance ToTextEdit a => ToCodeAction (T.Text, a) where
+instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where
   toCodeAction caa (title, te) = [(title, Just CodeActionQuickFix, Nothing, toTextEdit caa te)]
 
-instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, a) where
+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where
   toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)]
 
-instance ToTextEdit a => ToCodeAction (T.Text, Bool, a) where
+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where
   toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)]
 
-instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, Bool, a) where
+instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where
   toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)]
 
 -------------------------------------------------------------------------------------------------

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

@@ -12,12 +12,8 @@ module Development.IDE.Plugin.CodeAction.ExactPrint (
   -- * Utilities
   appendConstraint,
   extendImport,
-  hideImplicitPreludeSymbol,
   hideSymbol,
   liftParseAST,
-  newImport,
-  newUnqualImport,
-  newImportAll,
 ) where
 
 import           Control.Applicative
@@ -39,20 +35,14 @@ import           Development.IDE.GHC.ExactPrint        (ASTElement (parseAST),
 import           Development.IDE.Spans.Common
 import           FieldLabel                            (flLabel)
 import           GHC.Exts                              (IsList (fromList))
-import           GhcPlugins                            (mkRealSrcLoc,
-                                                        realSrcSpanStart,
-                                                        sigPrec)
+import           GhcPlugins                            (sigPrec)
 import           Language.Haskell.GHC.ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP),
                                                         KeywordId (G), mkAnnKey)
 import           Language.LSP.Types
 import           OccName
-import           Outputable                            (ppr, showSDoc,
-                                                        showSDocUnsafe)
-import           Retrie.GHC                            (mkRealSrcSpan,
-                                                        rdrNameOcc,
-                                                        realSrcSpanEnd,
-                                                        unpackFS)
+import           Outputable                            (ppr, showSDocUnsafe)
+import           Retrie.GHC                            (rdrNameOcc, unpackFS)
 
 ------------------------------------------------------------------------------
 
@@ -432,69 +422,3 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do
             (filter ((/= symbol) . unqualIEWrapName . unLoc) cons)
             (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds)
   killLie v = Just v
-
--- | Insert a import declaration with at most one symbol
-
--- newImport "A" (Just "Bar(Cons)") Nothing False --> import A (Bar(Cons))
--- newImport "A" (Just "foo") Nothing True --> import A hiding (foo)
--- newImport "A" Nothing (Just "Q") False --> import qualified A as Q
---
--- Wrong combinations will result in parse error
--- Returns Nothing if there is no imports and declarations
-newImport ::
-  -- | module name
-  String ->
-  -- | the symbol
-  Maybe String ->
-  -- | whether to be qualified
-  Maybe String ->
-  -- | the symbol is to be imported or hidden
-  Bool ->
-  ParsedSource ->
-  Maybe Rewrite
-newImport modName mSymbol mQual hiding (L _ HsModule{..}) = do
-  -- TODO (berberman): if the previous line is module name and there is no other imports,
-  -- 'AnnWhere' will be crowded out to the next line, which is a bug
-  let predLine old =
-        mkRealSrcLoc
-          (srcLocFile old)
-          (srcLocLine old - 1)
-          (srcLocCol old)
-      existingImpSpan = (fmap (realSrcSpanEnd,) . realSpan . getLoc) =<< lastMaybe hsmodImports
-      existingDeclSpan = (fmap (predLine . realSrcSpanStart,) . realSpan . getLoc) =<< headMaybe hsmodDecls
-  (f, s) <- existingImpSpan <|> existingDeclSpan
-  let beg = f s
-      indentation = srcSpanStartCol s
-      ran = RealSrcSpan $ mkRealSrcSpan beg beg
-  pure $
-    Rewrite ran $ \df -> do
-      let symImp
-            | Just symbol <- mSymbol
-              , symOcc <- mkVarOcc symbol =
-              "(" <> showSDoc df (parenSymOcc symOcc $ ppr symOcc) <> ")"
-            | otherwise = ""
-          impStmt =
-            "import "
-              <> maybe "" (const "qualified ") mQual
-              <> modName
-              <> (if hiding then " hiding " else " ")
-              <> symImp
-              <> maybe "" (" as " <>) mQual
-      -- Re-labeling is needed to reflect annotations correctly
-      L _ idecl0 <- liftParseAST @(ImportDecl GhcPs) df impStmt
-      let idecl = L ran idecl0
-      addSimpleAnnT
-        idecl
-        (DP (1, indentation - 1))
-        [(G AnnImport, DP (1, indentation - 1))]
-      pure idecl
-
-newUnqualImport :: String -> String -> Bool -> ParsedSource -> Maybe Rewrite
-newUnqualImport modName symbol = newImport modName (Just symbol) Nothing
-
-newImportAll :: String -> ParsedSource -> Maybe Rewrite
-newImportAll modName = newImport modName Nothing Nothing False
-
--- | Insert "import Prelude hiding (symbol)"
-hideImplicitPreludeSymbol :: String -> ParsedSource -> Maybe Rewrite
-hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True