MonadBase and MonadBaseControl instances

derivation.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Concurrent.STM.TVar
import Control.Monad.Reader
import Control.Monad.Base
import Control.Monad.Trans.Control

data Env = Env {envBalance :: !(TVar Int)}

newtype AppM a = AppM { unAppM :: ReaderT Env IO a }
    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env)

instance MonadBase IO AppM where
    liftBase = AppM . liftBase

instance MonadBaseControl IO AppM where
    type StM AppM a = a
    liftBaseWith f = AppM (liftBaseWith (\g -> f (\(AppM x) -> g x)))
    restoreM = AppM . restoreM