fix: produce valid code when adding constraint to context

This closes #4648.

When adding constraint to a context which is followed by a comment, such
as:

```
foo :: (Monad m) =>
   -- | This is a comment
   m ()
```

The comment annotation is anchored to the previous token, which is `=>`
in this context. If we add a new constraint in the context, the newly
generated content goes beyond the anchor and, depending on GHC version,
or ghc-exactprint (the reason is not fully understood), the comment is
printed BEFORE the new constraint, leading to invalid syntax, such as
`(Monad m -- | This is a comment , Applicative m =>)`

This commit moves all the comment of the block at the end of the block
using the `followingComments` of `EpAnnComments`.

It seems super adhoc, but actually, consider the following example:

```haskell

bar :: 
  -- BEFORE
  {- yoto -} (Monad m {- yiti -}){- yutu -} => {- yete -} -- Trailing
  -- After
  m ()
```

Comment `BEFORE` and `yoto` are attached to the previous block. Comment
`yiti` is attached to `Monad m`.

The comments `yiti`, `yutu`, `yete`, `Trailing` and `After` are all
attached to this block and will hence be moved after the block.

However this is not an easy task, all the associated comments should be
moved by the relevant offset.

TODO: do that instead.

Author: guibou

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

@@ -63,6 +63,7 @@ import           GHC                                    (addAnns, ann)
 
 #if MIN_VERSION_ghc(9,9,0)
 import           GHC                                    (NoAnn (..))
+import           GHC                                    (EpAnnComments (..))
 #endif
 
 ------------------------------------------------------------------------------
@@ -170,7 +171,7 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
     constraint <- liftParseAST df constraintT
     constraint <- pure $ setEntryDP constraint (SameLine 1)
 #if MIN_VERSION_ghc(9,9,0)
-    let l'' = fmap (addParensToCtxt close_dp) l'
+    let l'' = moveCommentsToTheEnd $ fmap (addParensToCtxt close_dp) l'
 #else
     let l'' = (fmap.fmap) (addParensToCtxt close_dp) l'
 #endif
@@ -205,6 +206,26 @@ appendConstraint constraintT = go . traceAst "appendConstraint"
 
     return $ reLocA $ L lTop $ HsQualTy noExtField context ast
 
+#if MIN_VERSION_ghc(9,9,0)
+-- | This moves comment annotation toward the end of the block
+-- This is useful when extending a block, so the comment correctly appears
+-- after.
+--
+-- See https://github.com/haskell/haskell-language-server/issues/4648 for
+-- discussion.
+--
+-- For example, the following element, @(Foo) => -- hello@, when introducing an
+-- additionnal constraint, `Bar`, instead of getting `@(Foo, Bar) => -- hello@,
+-- we get @(Foo, -- hello Bar) =>@
+--
+-- This is a bit painful that the pretty printer is not able to realize that it
+-- introduces the token `=>` inside the comment and instead does something with
+-- meaning, but that's another story.
+moveCommentsToTheEnd :: EpAnn ann -> EpAnn ann
+moveCommentsToTheEnd (EpAnn entry anns (EpaComments priors)) = EpAnn entry anns (EpaCommentsBalanced { priorComments = [], followingComments = priors})
+moveCommentsToTheEnd (EpAnn entry anns (EpaCommentsBalanced priors following)) = EpAnn entry anns (EpaCommentsBalanced { priorComments = [], followingComments = priors <> following})
+#endif
+
 liftParseAST
     :: forall ast l.  (ASTElement l ast, ExactPrint (LocatedAn l ast))
     => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
@@ -500,7 +521,7 @@ extendHiding symbol (L l idecls) mlies df = do
     Nothing -> do
 #if MIN_VERSION_ghc(9,11,0)
         let ann :: EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
-            ann = noAnnSrcSpanDP0 
+            ann = noAnnSrcSpanDP0
 #elif MIN_VERSION_ghc(9,9,0)
         let ann = noAnnSrcSpanDP0
 #else

plugins/hls-refactor-plugin/test/Main.hs

@@ -3045,7 +3045,7 @@ addFunctionConstraintTests = let
 
     [ "module Testing where"
     , "foo "
-    , "    :: (" <> constraint <> ") =>"
+    , "    :: ("<> constraint <> ") =>"
     , "    -- This is a comment"
     , "    m ()"
     , "foo = pure ()"
@@ -3098,7 +3098,7 @@ addFunctionConstraintTests = let
     "preexisting constraint, with haddock comment in type signature"
     "Add `Applicative m` to the context of the type signature for `foo`"
     (incompleteConstraintSourceCodeWithCommentInTypeSignature "")
-    (incompleteConstraintSourceCodeWithCommentInTypeSignature "Applicative m")
+    (incompleteConstraintSourceCodeWithCommentInTypeSignature " Applicative m")
   , checkCodeAction
     "missing Monad constraint"
     "Add `Monad m` to the context of the type signature for `f`"