haskell - 推迟Haskell中的操作

我想推迟行动。因此，我使用的WriterT应该记住我对其进行tell的操作。

module Main where

import Control.Exception.Safe
       (Exception, MonadCatch, MonadThrow, SomeException,
        SomeException(SomeException), catch, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)

type Defer m a = WriterT (IO ()) m a

-- | Register an action that should be run later.
defer :: (Monad m) => IO () -> Defer m ()
defer = tell

-- | Ensures to run deferred actions even after an error has been thrown.
runDefer :: (MonadIO m, MonadCatch m) => Defer m () -> m ()
runDefer fn = do
  ((), deferredActions) <- runWriterT (catch fn onError)
  liftIO $ do
    putStrLn "run deferred actions"
    deferredActions

-- | Handle exceptions.
onError :: (MonadIO m) => MyException -> m ()
onError e = liftIO $ putStrLn $ "handle exception: " ++ show e

data MyException =
  MyException String

instance Exception MyException

instance Show MyException where
  show (MyException message) = "MyException(" ++ message ++ ")"

main :: IO ()
main = do
  putStrLn "start"
  runDefer $ do
    liftIO $ putStrLn "do stuff 1"
    defer $ putStrLn "cleanup 1"
    liftIO $ putStrLn "do stuff 2"
    defer $ putStrLn "cleanup 2"
    liftIO $ putStrLn "do stuff 3"
  putStrLn "end"

我得到了预期的输出

start
do stuff 1
do stuff 2
do stuff 3
run deferred actions
cleanup 1
cleanup 2
end

但是，如果引发异常

main :: IO ()
main = do
  putStrLn "start"
  runDefer $ do
    liftIO $ putStrLn "do stuff 1"
    defer $ putStrLn "cleanup 1"
    liftIO $ putStrLn "do stuff 2"
    defer $ putStrLn "cleanup 2"
    liftIO $ putStrLn "do stuff 3"
    throwM $ MyException "exception after do stuff 3"
  putStrLn "end"

没有执行任何延迟的操作

start
do stuff 1
do stuff 2
do stuff 3
handle exception: MyException(exception after do stuff 3)
run deferred actions
end

但我希望这

start
do stuff 1
do stuff 2
do stuff 3
handle exception: MyException(exception after do stuff 3)
run deferred actions
cleanup 1
cleanup 2
end

作家以某种方式失去了他的状态。如果我使用[IO ()]而不是IO ()作为状态

type Defer m a = WriterT [IO ()] m a

并在deferredActions中打印runDefer的长度，成功时为2(因为我两次调用了defer)，错误时为0(即使defer被调用了两次)。

是什么原因导致此问题？发生错误后如何执行延迟的操作？

最佳答案

就像user2407038已经是explained一样，不可能在catch中获得状态(延迟 Action )。但是，您可以使用ExceptT明确捕获错误:

module Main where

import Control.Exception.Safe
       (Exception, Handler(Handler), MonadCatch,
        SomeException(SomeException), catch, catches, throw)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)

type DeferM m = WriterT (IO ()) m

type Defer m a = DeferM m a

-- | Register an action that should be run later.
--
defer :: (Monad m) => IO () -> Defer m ()
defer = tell

-- | Register an action that should be run later.
-- Use @deferE@ instead of @defer@ inside @ExceptT@.
deferE :: (Monad m) => IO () -> ExceptT e (DeferM m) ()
deferE = lift . defer

-- | Ensures to run deferred actions even after an error has been thrown.
--
runDefer :: (MonadIO m, MonadCatch m) => Defer m a -> m a
runDefer fn = do
  (result, deferredActions) <- runWriterT fn
  liftIO $ do
    putStrLn "run deferred actions"
    deferredActions
  return result

-- | Catch all errors that might be thrown in @f@.
--
catchIOError :: (MonadIO m) => IO a -> ExceptT SomeException m a
catchIOError f = do
  r <- liftIO (catch (Right <$> f) (return . Left))
  case r of
    (Left e) -> throwE e
    (Right c) -> return c

data MyException =
  MyException String

instance Exception MyException

instance Show MyException where
  show (MyException message) = "MyException(" ++ message ++ ")"

handleResult :: Show a => Either SomeException a -> IO ()
handleResult result =
  case result of
    Left e -> putStrLn $ "caught an exception " ++ show e
    Right _ -> putStrLn "no exception was thrown"

main :: IO ()
main = do
  putStrLn "start"
  runDefer $ do
    result <-runExceptT $ do
      catchIOError $ putStrLn "do stuff 1"
      deferE $ putStrLn "cleanup 1"
      catchIOError $ putStrLn "do stuff 2"
      deferE $ putStrLn "cleanup 2"
      catchIOError $ putStrLn "do stuff 3"
      catchIOError $ throw $ MyException "exception after do stuff 3"
      return "result"
    liftIO $ handleResult result
  putStrLn "end"

我们得到预期的输出:

start
do stuff 1
do stuff 2
do stuff 3
handle my exception: "exception after do stuff 3"
run deferred actions
cleanup 1
cleanup 2
end

注意，您必须使用catchIOError明确捕获错误。如果您忘记了它，而只是调用liftIO，那么将不会捕获该错误。

还要注意，对handleResult的调用是不安全的。如果引发错误，则延迟的操作将不会在以后执行。您可以考虑在执行操作后处理结果:

main :: IO ()
main = do
  putStrLn "start"
  result <-
    runDefer $ do
      runExceptT $ do
        catchIOError $ putStrLn "do stuff 1"
        deferE $ putStrLn "cleanup 1"
        catchIOError $ putStrLn "do stuff 2"
        deferE $ putStrLn "cleanup 2"
        catchIOError $ putStrLn "do stuff 3"
        catchIOError $ throw $ MyException "exception after do stuff 3"
        return "result"
  handleResult result
  putStrLn "end"

否则，您必须分别捕获该错误。

编辑1:介绍safeIO
编辑2:

使用更简单的错误处理

在所有摘要中使用safeIO

警告handleResult中的异常

编辑3:将safeIO替换为catchIOError。