Qualify names correctly in splices

haskell-language-server.cabal

@@ -916,6 +916,7 @@ library hls-splice-plugin
   hs-source-dirs:     plugins/hls-splice-plugin/src
   build-depends:
     , aeson
+    , containers
     , extra
     , foldl
     , ghc
@@ -927,6 +928,7 @@ library hls-splice-plugin
     , mtl
     , syb
     , text
+    , text-rope
     , transformers
     , unliftio-core
 
@@ -1557,14 +1559,14 @@ library hls-refactor-plugin
                     Development.IDE.Plugin.CodeAction
                     Development.IDE.Plugin.CodeAction.Util
                     Development.IDE.GHC.Dump
+                    Development.IDE.Plugin.Plugins.ImportUtils
   other-modules:    Development.IDE.Plugin.CodeAction.Args
                     Development.IDE.Plugin.CodeAction.ExactPrint
                     Development.IDE.Plugin.CodeAction.PositionIndexed
                     Development.IDE.Plugin.Plugins.AddArgument
                     Development.IDE.Plugin.Plugins.Diagnostic
                     Development.IDE.Plugin.Plugins.FillHole
                     Development.IDE.Plugin.Plugins.FillTypeWildcard
-                    Development.IDE.Plugin.Plugins.ImportUtils
   default-extensions:
     CPP
     DataKinds

plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE GADTs        #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -16,6 +17,7 @@
       genericGraftWithLargestM,
       graftSmallestDeclsWithM,
       transform,
+      transformWithExtraEdits,
       transformM,
       ExactPrint(..),
       modifySmallestDeclWithM,
@@ -84,7 +86,10 @@
 import           Control.Lens.Operators                  ((%~))
 import           Data.List                               (partition)
 import           GHC                                     (DeltaPos (..),
+                                                          LocatedN, NamePprCtx,
                                                           SrcSpanAnnN)
+import           GHC.Driver.DynFlags                     (initSDocContext)
+import           GHC.Utils.Outputable                    (mkUserStyle, Depth (..))
 
 -- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
 
@@ -178,7 +183,7 @@
  instance to combine 'Graft's, and run them via 'transform'.
 -}
 newtype Graft m a = Graft
-    { runGraft :: DynFlags -> a -> TransformT m a
+    { runGraft :: (DynFlags, NamePprCtx) -> a -> TransformT m a
     }
 
 hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
@@ -220,32 +225,45 @@
 -- | Convert a 'Graft' into a 'WorkspaceEdit'.
 transform ::
     DynFlags ->
+    NamePprCtx ->
     ClientCapabilities ->
     VersionedTextDocumentIdentifier ->
     Graft (Either String) ParsedSource ->
     ParsedSource ->
     Either String WorkspaceEdit
-transform dflags ccs verTxtDocId f a = do
+transform = transformWithExtraEdits id
+
+transformWithExtraEdits ::
+    (T.Text -> T.Text) ->
+    DynFlags ->
+    NamePprCtx ->
+    ClientCapabilities ->
+    VersionedTextDocumentIdentifier ->
+    Graft (Either String) ParsedSource ->
+    ParsedSource ->
+    Either String WorkspaceEdit
+transformWithExtraEdits postProcess dflags npc ccs verTxtDocId f a = do
     let src = printA a
-    a' <- transformA a $ runGraft f dflags
-    let res = printA a'
-    pure $ diffText ccs (verTxtDocId, T.pack src) (T.pack res) IncludeDeletions
+    a' <- transformA a $ runGraft f (dflags, npc)
+    let res = postProcess $ T.pack $ printA a'
+    pure $ diffText ccs (verTxtDocId, T.pack src) res IncludeDeletions
 
 ------------------------------------------------------------------------------
 
 -- | Convert a 'Graft' into a 'WorkspaceEdit'.
 transformM ::
     Monad m =>
     DynFlags ->
+    NamePprCtx ->
     ClientCapabilities ->
     VersionedTextDocumentIdentifier ->
     Graft (ExceptStringT m) ParsedSource ->
     ParsedSource ->
     m (Either String WorkspaceEdit)
-transformM dflags ccs verTextDocId f a = runExceptT $
+transformM dflags npc ccs verTextDocId f a = runExceptT $
     runExceptString $ do
         let src = printA a
-        a' <- transformA a $ runGraft f dflags
+        a' <- transformA a $ runGraft f (dflags, npc)
         let res = printA a'
         pure $ diffText ccs (verTextDocId, T.pack src) (T.pack res) IncludeDeletions
 
@@ -300,8 +318,8 @@
     SrcSpan ->
     LocatedAn l ast ->
     Graft (Either String) a
-graft' needs_space dst val = Graft $ \dflags a -> do
-    val' <- annotate dflags needs_space dst val
+graft' needs_space dst val = Graft $ \(dflags, npc) a -> do
+    val' <- annotate dflags npc needs_space dst val
     pure $
         everywhere'
             ( mkT $
@@ -321,12 +339,12 @@
     SrcSpan ->
     LHsExpr GhcPs ->
     Graft (Either String) a
-graftExpr dst val = Graft $ \dflags a -> do
+graftExpr dst val = Graft $ \(dflags, npc) a -> do
     let (needs_space, mk_parens) = getNeedsSpaceAndParenthesize dst a
 
     runGraft
       (graft' needs_space dst $ mk_parens val)
-      dflags
+      (dflags, npc)
       a
 
 getNeedsSpaceAndParenthesize ::
@@ -358,7 +376,7 @@
     SrcSpan ->
     (LHsExpr GhcPs -> TransformT m (Maybe (LHsExpr GhcPs))) ->
     Graft m a
-graftExprWithM dst trans = Graft $ \dflags a -> do
+graftExprWithM dst trans = Graft $ \(dflags, npc) a -> do
     let (needs_space, mk_parens) = getNeedsSpaceAndParenthesize dst a
 
     everywhereM'
@@ -371,7 +389,7 @@
                             Just val' -> do
                                 val'' <-
                                     hoistTransform (either Fail.fail pure)
-                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space dst (mk_parens val'))
+                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags npc needs_space dst (mk_parens val'))
                                 pure val''
                             Nothing -> pure val
                 l -> pure l
@@ -384,7 +402,7 @@
     SrcSpan ->
     (LocatedAn l ast -> TransformT m (Maybe (LocatedAn l ast))) ->
     Graft m a
-graftWithM dst trans = Graft $ \dflags a -> do
+graftWithM dst trans = Graft $ \(dflags, npc) a -> do
     everywhereM'
         ( mkM $
             \case
@@ -395,7 +413,7 @@
                             Just val' -> do
                                 val'' <-
                                     hoistTransform (either Fail.fail pure) $
-                                        annotate dflags False dst $ maybeParensAST val'
+                                        annotate dflags npc False dst $ maybeParensAST val'
                                 pure val''
                             Nothing -> pure val
                 l -> pure l
@@ -412,7 +430,7 @@
     SrcSpan ->
     (DynFlags -> ast -> GenericM (TransformT m)) ->
     Graft m a
-genericGraftWithSmallestM proxy dst trans = Graft $ \dflags ->
+genericGraftWithSmallestM proxy dst trans = Graft $ \(dflags, _) ->
     smallestM (genericIsSubspan proxy dst) (trans dflags)
 
 -- | Run the given transformation only on the largest node in the tree that
@@ -425,7 +443,7 @@
     SrcSpan ->
     (DynFlags -> ast -> GenericM (TransformT m)) ->
     Graft m a
-genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->
+genericGraftWithLargestM proxy dst trans = Graft $ \(dflags, _) ->
     largestM (genericIsSubspan proxy dst) (trans dflags)
 
 
@@ -435,9 +453,9 @@
     SrcSpan ->
     [LHsDecl GhcPs] ->
     Graft (Either String) a
-graftDecls dst decs0 = Graft $ \dflags a -> do
+graftDecls dst decs0 = Graft $ \(dflags, npc) a -> do
     decs <- forM decs0 $ \decl -> do
-        annotateDecl dflags decl
+        annotateDecl dflags npc decl
     let go [] = DL.empty
         go (L src e : rest)
             | locA src `eqSrcSpan` dst = DL.fromList decs <> DL.fromList rest
@@ -628,13 +646,13 @@
     SrcSpan ->
     (LHsDecl GhcPs -> TransformT (Either String) (Maybe [LHsDecl GhcPs])) ->
     Graft (Either String) a
-graftSmallestDeclsWithM dst toDecls = Graft $ \dflags a -> do
+graftSmallestDeclsWithM dst toDecls = Graft $ \(dflags, npc) a -> do
     let go [] = pure DL.empty
         go (e@(L src _) : rest)
             | dst `isSubspanOf` locA src = toDecls e >>= \case
                 Just decs0 -> do
                     decs <- forM decs0 $ \decl ->
-                        annotateDecl dflags decl
+                        annotateDecl dflags npc decl
                     pure $ DL.fromList decs <> DL.fromList rest
                 Nothing -> (DL.singleton e <>) <$> go rest
             | otherwise = (DL.singleton e <>) <$> go rest
@@ -646,14 +664,14 @@
     SrcSpan ->
     (LHsDecl GhcPs -> TransformT m (Maybe [LHsDecl GhcPs])) ->
     Graft m a
-graftDeclsWithM dst toDecls = Graft $ \dflags a -> do
+graftDeclsWithM dst toDecls = Graft $ \(dflags, npc) a -> do
     let go [] = pure DL.empty
         go (e@(L src _) : rest)
             | locA src `eqSrcSpan` dst = toDecls e >>= \case
                 Just decs0 -> do
                     decs <- forM decs0 $ \decl ->
                         hoistTransform (either Fail.fail pure) $
-                          annotateDecl dflags decl
+                          annotateDecl dflags npc decl
                     pure $ DL.fromList decs <> DL.fromList rest
                 Nothing -> (DL.singleton e <>) <$> go rest
             | otherwise = (DL.singleton e <>) <$> go rest
@@ -720,10 +738,10 @@
 -- | Given an 'LHSExpr', compute its exactprint annotations.
 --   Note that this function will throw away any existing annotations (and format)
 annotate :: ASTElement l ast
-    => DynFlags -> Bool -> SrcSpan -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
-annotate dflags _needs_space _loc ast = do
+    => DynFlags -> NamePprCtx -> Bool -> SrcSpan -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
+annotate dflags npc _needs_space _loc ast = do
     uniq <- show <$> uniqueSrcSpanT
-    let rendered = render dflags ast
+    let rendered = render dflags npc ast
     expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
 #if MIN_VERSION_ghc(9,9,0)
     let L l e = makeDeltaAst expr'
@@ -733,23 +751,29 @@
 #endif
 
 -- | Given an 'LHsDecl', compute its exactprint annotations.
-annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
-annotateDecl dflags ast = do
+annotateDecl :: DynFlags -> NamePprCtx -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
+annotateDecl dflags npc ast = do
     uniq <- show <$> uniqueSrcSpanT
-    let rendered = render dflags ast
+    let rendered = render dflags npc $ unqualifyBindings ast
     expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered
 #if MIN_VERSION_ghc(9,9,0)
     let expr'' = makeDeltaAst expr'
 #else
     let expr'' = expr'
 #endif
     pure $ setPrecedingLines expr'' 1 0
+  where
+    -- TODO is this doing an unnecessarily deep traversal?
+    -- is it even correct?
+    unqualifyBindings = everywhere $ mkT \case
+        fr@(FunRhs{mc_fun = L nl (Orig _ occ)}) -> fr{mc_fun = L nl (mkRdrUnqual occ)}
+        ctx -> ctx :: HsMatchContext (LocatedN RdrName)
 
 ------------------------------------------------------------------------------
 
 -- | Print out something 'Outputable'.
-render :: Outputable a => DynFlags -> a -> String
-render dflags = showSDoc dflags . ppr
+render :: Outputable a => DynFlags -> NamePprCtx -> a -> String
+render dflags npc = renderWithContext (initSDocContext dflags (mkUserStyle npc AllTheWay)) . ppr
 
 ------------------------------------------------------------------------------
 

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -5,6 +5,10 @@
 
 module Development.IDE.Plugin.CodeAction
     (
+    -- TODO factor out somewhere instead of exporting from here?
+    newImport,
+    newImportToEdit,
+    newImportInsertRange,
     mkExactprintPluginDescriptor,
     iePluginDescriptor,
     typeSigsPluginDescriptor,