Question

我想推迟采取行动。因此，我使用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两次）。

导致此问题的原因是什么？如何在出错后运行延迟操作？

Answer 1

与user2407038已explained一样，无法在catch中获取状态（延期操作）。但是，您可以使用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。

推迟Haskell中的行动

1 个答案: