ApplicativeDo selects "GHC.Base.Monad.return" when actions are used without patterns.

GHC 8.0.2 and 8.2.1-rc1 (rc2 not checked) have a bug where -XApplicativeDo causes "GHC.Base.Monad.return" to be used instead of the locally available "return", and a spurious "return ()" shows up. This desugaring is not adhering to the -XRebindableSyntax spec (see: #12490 (closed)).

Example:

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RebindableSyntax  #-}
-- Bug vanishes if this next line is removed:
{-# LANGUAGE ApplicativeDo  #-}

module Main where

import Prelude (String, print)

class MyFunctor f where
    fmap :: (a -> b) -> f a -> f b

class MyApplicative f where
    pure :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

class MyMonad m where
    return :: a -> m a
    (>>) :: m a -> m b -> m b
    (>>=) :: m a -> (a -> m b) -> m b
    fail :: String -> m a
    join :: m (m a) -> m a

testCase1 m1 m2 = do
    m1
    m2
    return ()

testCase2 m1 m2 = do
    _ <- m1
    _ <- m2
    return ()

main = print "42"

:t testCase1
testCase1
  :: (MyFunctor f, MyApplicative f, MyMonad f, Monad f) =>
     f a2 -> f a1 -> f ()

:t testCase2
  :: testCase2 :: (MyFunctor f, MyApplicative f) => f t -> f a -> f ()

The desugaring for testCase1 shows the issue:

testCase1' m1 m2 =
      (<*>)
        (fmap
           (\ r1 r2 ->
              case r1 of { () -> case r2 of { () -> () } })
           (m1 >> (GHC.Base.Monad.return ())))
        (m2 >> (GHC.Base.Monad.return ()))
-- or:
testCase1'' m1 m2 = (fmap (\() () -> () ) (m1 >> (GHC.Base.Monad.return ()))) <*> (m2 >> (GHC.Base.Monad.return ()))

I would be able to work on this if someone pointed me in the right direction. It looks like it would be in compiler/rename/RnEnv and compiler/rename/RnExpr, as with #12490 (closed)?

As a proposed fix, I would want to implement a limited-scope fix before the 8.2.1 release which would not address the thornier issue of #10892. The patch would:

1. Replace GHC.Base.Monad.return with local pure, removing the Monad constraint.
2. Replace >> with *>, removing the MyMonad constraint.

This isn't a complete fix, as this would still leave the unnecessary pattern matches in the use of fmap. The resulting desugaring would be:

testCase1''' m1 m2 = (fmap (\() () -> () ) (m1 *> (pure ()))) <*> (m2 *> (pure ()))