module Control.Monad.Trans.CTrace(TracerT, runTracerT, zoom, update, noTracerT, ioTracerT) where
import Control.Monad.Cont.Class
import Control.Monad.Reader
import Control.Monad.Writer.Class
import Control.Monad.Error.Class
import Control.Monad.State.Class
import Control.Monad.RWS.Class
import Lens.Micro
import Data.IORef
newtype TracerT c m a = TracerT (ReaderT (Action c m) m a)
deriving(Functor,Monad,Applicative, MonadIO, MonadFix)
type Action c m = (c -> c) -> m ()
update :: Monad m => (c -> c) -> TracerT c m ()
update f = TracerT $ ReaderT $ \tracer -> tracer f
zoom :: ASetter' c c' -> TracerT c' m a -> TracerT c m a
zoom l (TracerT m) = TracerT $ ReaderT $ \action ->
runReaderT m (\updateFunc -> action (over l updateFunc))
instance MonadTrans (TracerT c) where
lift = TracerT . lift
runTracerT :: ((c -> c) -> m ()) -> TracerT c m a -> m a
runTracerT action (TracerT m) = runReaderT m action
noTracerT :: Monad m => TracerT c m a -> m a
noTracerT = runTracerT (const (return ()))
ioTracerT :: MonadIO m => c -> TracerT c m a -> m (a,c)
ioTracerT init m = do
r <- liftIO $ newIORef init
v <- runTracerT (liftIO . modifyIORef' r) m
c <- liftIO $ readIORef r
return (v,c)
instance MonadReader r m => MonadReader r (TracerT c m) where
ask = lift ask
reader = lift . reader
local f (TracerT m) = TracerT (ReaderT $ local f . runReaderT m)
deriving instance MonadWriter w m => MonadWriter w (TracerT c m)
deriving instance MonadError e m => MonadError e (TracerT c m)
deriving instance MonadState s m => MonadState s (TracerT c m)
deriving instance MonadRWS r w s m => MonadRWS r w s (TracerT c m)
deriving instance MonadCont m => MonadCont (TracerT c m)