Another option is to use a constraint solver plugin to "tag" the locations with a coercion, and then use a CorePlugin [1] to replace the corresponding cast by a call to liftIO.
As you can see, for:
> {-# OPTIONS_GHC -fplugin=LiftIOPlugin -ddump-ds -ddump-tc -ddump-to-file #-}
> module Test where
>
> import Control.Monad.IO.Class
>
> program :: MonadIO m => m ()
> program = putStrLn "Hello world!"
it results in the following desugar output
> program
> = \ (@(m_a9Ky :: * -> *)) _ [Occ=Dead] ->
> (break<0>() putStrLn (GHC.CString.unpackCString# "Hello world!"#))
> `cast` (Univ(representational plugin "tag_lift_io"
> :: IO, m_a9Ky) <()>_N
> :: IO () ~R# m_a9Ky ())
So now you'll need to make a CorePlugin to recognize that cast and replace it with an application with `liftIO`.
Hopefully someone else can help you with suggestions on how to conjure a proper `liftIO` out of thin air at that point in the compiler pipeline.