{-# LANGUAGE
GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses
#-}
import Control.Monad.Except (MonadError (..), MonadIO (..), liftIO, lift)
import Control.Monad.Writer
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Control.Concurrent (threadDelay)
import Debug.Trace (trace)
newtype MyTrans m e a = MyTrans { unMyTrans :: ExceptT e m a }
deriving (Functor, Applicative, Monad, MonadError e)
instance (MonadIO m) => MonadIO (MyTrans m e) where
liftIO = MyTrans . liftIO
instance (MonadWriter w m) => MonadWriter w (MyTrans m e) where
writer = MyTrans. lift . writer
tell = MyTrans. lift . tell
throwMT :: Monad m => e -> MyTrans m e a
throwMT = MyTrans . throwE
runMyTrans :: Monad m => MyTrans m e a -> m (Either e a)
runMyTrans = runExceptT . unMyTrans
comp :: MyTrans IO String ()
comp = do
liftIO $ putStrLn "Starting Computation"
throwMT $ "Some Error"
-- dead code from this line
liftIO $ threadDelay (10*10^6)
liftIO $ putStrLn "Ending Computation"
return $ trace "retutning ()" ()
comp1 :: MyTrans (Writer [String]) String ()
comp1 = do
tell ["Starting Computation"]
throwMT "Some Error"
tell ["Ending Computation"]
return ()
main = do
print =<< runMyTrans comp
print $ runWriter (runMyTrans comp1)
