ApplicativeDo requires Monad constraint in recursive definition

Summary

With some kinds of recursion, and ApplicativeDo enabled, a Monad constraint is required, even though Applicative would have been sufficient.

Steps to reproduce

Typecheck this:

foreverA :: Applicative f => f a -> f b
foreverA fa = do
  _a <- fa
  foreverA fa

The error message is:

Main.hs:10:3: error:
    • Could not deduce (Monad f) arising from a do statement
      from the context: Applicative f
        bound by the type signature for:
                   foreverA :: forall (f :: * -> *) a. Applicative f => f a -> f ()
        at Main.hs:8:1-40
      Possible fix:
        add (Monad f) to the context of
          the type signature for:
            foreverA :: forall (f :: * -> *) a. Applicative f => f a -> f ()
    • In a stmt of a 'do' block: _a <- fa
      In the expression:
        do _a <- fa
           foreverA fa
      In an equation for ‘foreverA’:
          foreverA fa
            = do _a <- fa
                 foreverA fa
   |
10 |   _a <- fa
   |   ^^^^^^^^

This can be worked around by adding pure () as a last line, as pointed out by maerwald on IRC.

For a more involved example that doesn't have this kind of fix, consider:

{-# LANGUAGE ApplicativeDo #-}
module StreamT where

-- base
import Control.Arrow

data StreamT m a = StreamT { unStreamT :: m (a, StreamT m a) }

instance Functor m => Functor (StreamT m) where
  fmap f = StreamT . fmap (f *** fmap f) . unStreamT

instance Applicative m => Applicative (StreamT m) where
  pure a = StreamT $ pure (a, pure a)
  fs <*> as = StreamT $ do
    (f, fs') <- unStreamT fs
    (a, as') <- unStreamT as
    pure (f a, fs' <*> as')

Error message:

Main.hs:22:5: error:
    • Could not deduce (Monad m) arising from a do statement
      from the context: Applicative m
        bound by the instance declaration at Main.hs:19:10-49
      Possible fix:
        add (Monad m) to the context of
          the type signature for:
            (<*>) :: forall a b.
                     StreamT m (a -> b) -> StreamT m a -> StreamT m b
          or the instance declaration
    • In a stmt of a 'do' block: (f, fs') <- unStreamT fs
      In the second argument of ‘($)’, namely
        ‘do (f, fs') <- unStreamT fs
            (a, as') <- unStreamT as
            pure (f a, fs' <*> as')’
      In the expression:
        StreamT
          $ do (f, fs') <- unStreamT fs
               (a, as') <- unStreamT as
               pure (f a, fs' <*> as')
   |
22 |     (f, fs') <- unStreamT fs
   |     ^^^^^^^^^^^^^^^^^^^^^^^^

Expected behavior

ApplicativeDo can correctly desugar this recursive definition.

Environment

• GHC version used: 8.8

Optional:

• Operating System: NixOS (Linux)