"Properly" call callbacks inside IO with transformers

SoTrans.hs

-- https://stackoverflow.com/questions/50166215/how-to-modify-a-state-monad

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module SoTrans where

import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans.Control
import Control.Monad.Trans.Writer
import Control.Monad.Trans.State

seqIO :: IO () -> IO () -> IO ()
seqIO a b = a >> b

seqM :: forall m. MonadBaseControl IO m => m () -> m () -> m ()
seqM a b = liftBaseWith handle >>= restoreM
  where
    handle :: RunInBase m IO -> IO (StM m ())
    handle r = do
      ref <- ((r $ pure ()) :: IO (StM m ())) >>= newMVar
      seqIO (cb r ref a) (cb r ref b)
      takeMVar ref
    cb :: RunInBase m IO -> MVar (StM m ()) -> m () -> IO ()
    cb r ref act = do
      val0 <- takeMVar ref
      val1 <- r ((restoreM val0 :: m ()) >> act)
      putMVar ref val1

-- | Test
-- >>> runWriterT $ seqM (tell "foo") (tell "bar")
-- ((),"foobar")
-- >>> runStateT (seqM (modify (++ "foo")) (modify (++ "bar"))) ""
-- ((),"foobar")