１時間もかかってしまった。。。Hskell力が足りない・・・

gistfile1.hs

module Main where
import Control.Monad
import Control.Monad.Trans

-- Try
data Try a b = Success a | Failed b deriving Show
instance Monad (Try a) where
  return x = Failed x
  m >>= k = case m of
    Success x -> Success x
    Failed x -> k x

-- TryT
newtype TryT a m b = TryT { runTryT :: m (Try a b) }
instance MonadTrans (TryT a) where
  lift = TryT . liftM Failed
instance Monad m => Monad (TryT a m) where
  return = lift . return
  x >>= f = TryT $ do
    v <- runTryT x
    case v of
      Success y -> return $ Success y 
      Failed y -> runTryT (f y)

success :: Monad m => a -> TryT a m b
success x = TryT (return $ Success x)

failure :: Monad m => b -> TryT a m b
failure x = TryT (return $ Failed x)

-- TryIO
type TryIO a b = TryT a IO b
runTryIO :: TryIO a b -> IO (Try a b)
runTryIO = runTryT

-- Test
process :: Bool -> String -> TryIO () ()
process True s = do
  lift . putStrLn $ "Process " ++ s ++ " success!"
  success ()
process False s = do
  lift . putStrLn $ "Process " ++ s ++ " failed!"
  failure ()

main :: IO ()
main = do
  v <- runTryIO $ do
    process False "A"
    process False "B"
    process False "C"
  case v of
    Success x -> putStrLn "Process D to be run!"
    Failed x -> putStrLn "All process failed!"