ApplicativeDo breaks typechecking

Summary

When enabling the ApplicativeDo extension the provided program ceases to typecheck. It does work in 9.4.5 and does work if I move putStrLn around or remove it entirely, which is surprising. Removing ApplicativeDo extension also helps but I'd like to get its effects in parseCommandLine function (omitted here for brevity).

Steps to reproduce

Compile the following program.

Original program:

{-# LANGUAGE ApplicativeDo #-}

module Main (main) where

import Control.Monad

data Command
  = PolyCmd
  | VanillaCmd

data CommonConfig = CommonConfig
  { ccVerbose     :: Bool
  }

parseCommandline :: IO (CommonConfig, Command)
parseCommandline = undefined

locateHelper :: FilePath -> IO (Maybe FilePath)
locateHelper = undefined

complexWrapper :: IO a -> IO a
complexWrapper = undefined

vanillaRun :: IO ()
vanillaRun = pure ()

polyRun :: (forall a. IO a -> IO a) -> IO ()
polyRun f = f $ pure ()

main :: IO ()
main = do
  (config, cmd) <- parseCommandline
  when (ccVerbose config) $
    putStrLn "OK"

  let wrapper :: IO a -> IO a
      wrapper act = do
        complexWrapper act

  case cmd of
    VanillaCmd -> wrapper vanillaRun
    PolyCmd    -> polyRun wrapper

$ ghc -c Main.hs

Main.hs:42:27: error: [GHC-25897]
    • Couldn't match type ‘a’ with ‘()’
      Expected: IO a -> IO a
        Actual: IO () -> IO ()
      ‘a’ is a rigid type variable bound by
        a type expected by the context:
          forall a. IO a -> IO a
        at Main.hs:42:27-33
    • In the first argument of ‘polyRun’, namely ‘wrapper’
      In the expression: polyRun wrapper
      In a case alternative: PolyCmd -> polyRun wrapper
   |
42 |     PolyCmd    -> polyRun wrapper
   |                           ^^^^^^^

However this one does typecheck

{-# LANGUAGE ApplicativeDo #-}

module Main (main) where

import Control.Monad

data Command
  = PolyCmd
  | VanillaCmd

data CommonConfig = CommonConfig
  { ccVerbose     :: Bool
  }

parseCommandline :: IO (CommonConfig, Command)
parseCommandline = undefined

locateHelper :: FilePath -> IO (Maybe FilePath)
locateHelper = undefined

complexWrapper :: IO a -> IO a
complexWrapper = undefined

vanillaRun :: IO ()
vanillaRun = pure ()

polyRun :: (forall a. IO a -> IO a) -> IO ()
polyRun f = f $ pure ()

main :: IO ()
main = do
  (config, cmd) <- parseCommandline

  let wrapper :: IO a -> IO a
      wrapper act = do
        when (ccVerbose config) $
          putStrLn "OK"
        complexWrapper act

  case cmd of
    VanillaCmd -> wrapper vanillaRun
    PolyCmd    -> polyRun wrapper

Commenting out ApplicativeDo also makes the original program typecheck.

Expected behavior

Original program typechecks successfully with ApplicativeDo extension enabled.

Environment

• GHC version used: 9.6.2

Optional:

• Operating System: Linux
• System Architecture: x86_64