状态和错误 monad 堆栈，错误状态回滚

问题描述

我有一个问题，我将通过以下示例说明：

假设我想做一些可以产生结果或错误的计算，同时携带一个状态。为此，我有以下 monad 堆栈：

import Control.Monad.Trans.State ( get,modify,State )
import Control.Monad.Trans.Except ( catchE,throwE,ExceptT )

type MyMonad a = ExceptT String (State [Int]) a

因此，状态是整数列表，错误是字符串，计算可以产生任何类型“a”的值。我可以执行以下操作：

putNumber :: Int -> MyMonad ()
putNumber i = lift $ modify (i:)

现在，假设我定义了一个将最后一个数字的一​​半添加到状态的函数：

putHalf :: MyMonad ()
putHalf = do
  s <- lift get
  case s of
    (x:_) -> if even x then putNumber (div x 2) else throwE "Number can't be halved"
    [] -> throwE "The state is empty"

使用 putHalf 将向状态添加一个数字并返回 void，或者产生两个错误中的任何一个。

如果发生错误，我希望能够调用替代函数。我知道我可以通过执行以下操作使用 catchE 实现这一点：

putWithAlternative :: MyMonad ()
putWithAlternative = putHalf `catchE` (\_ -> putNumber 12)

在这种情况下，如果 putHalf 因任何原因失败，数字 12 将被添加到状态中。到目前为止，一切都很好。但是，我可以定义一个调用 putHalf 两次的函数：

putHalfTwice :: MyMonad ()
putHalfTwice = putHalf >> putHalf

问题是，例如，如果状态仅包含数字 2，则对 putHalf 的第一次调用会成功并修改状态，但第二次会失败。我需要 putHalfTwice 进行两次调用并修改状态两次，或者根本不修改状态并保持原样。我不能使用 catchE 或 putWithAlternative，因为在第一次调用时状态仍然被修改。

我知道 Parsec 库通过它的 <|> 和 try 运算符来做到这一点。我怎么能自己定义这些？是否有任何已经定义的 monad 转换器可以实现这一点？

解决方法

如果在您的问题域中，失败永远不应该修改状态，那么最直接的做法是反转层：

type MyMonad' a = StateT [Int] (Except String) a

您的原始 monad 同构为：

s -> (Either e a,s)

所以它总是返回一个新的状态，不管它是成功还是失败。这个新的 monad 同构为：

s -> Either e (a,s)

所以它要么失败，要么返回一个新状态。

以下程序从 putHalfTwice 恢复而不破坏状态：

import Control.Monad.Trans
import Control.Monad.Trans.State
import Control.Monad.Trans.Except

type MyMonad' a = StateT [Int] (Except String) a

putNumber :: Int -> MyMonad' ()
putNumber i = modify (i:)

putHalf :: MyMonad' ()
putHalf = do
  s <- get
  case s of
    (x:_) -> if even x then putNumber (div x 2) else lift $ throwE "Number can't be halved"
    [] -> lift $ throwE "the state is empty"

putHalfTwice :: MyMonad' ()
putHalfTwice = putHalf >> putHalf

foo :: MyMonad' ()
foo = liftCatch catchE putHalfTwice (\_ -> putNumber 12)

main :: IO ()
main = do
  print $ runExcept (runStateT foo [2])

否则，如果您希望回溯是可选的，那么您可以编写自己的 try 来捕获、恢复状态并重新抛出：

try :: MyMonad a -> MyMonad a
try act = do
  s <- lift get
  act `catchE` (\e -> lift (put s) >> throwE e)

然后：

import Control.Monad.Trans
import Control.Monad.Trans.State
import Control.Monad.Trans.Except

type MyMonad a = ExceptT String (State [Int]) a

putNumber :: Int -> MyMonad ()
putNumber i = lift $ modify (i:)

putHalf :: MyMonad ()
putHalf = do
  s <- lift get
  case s of
    (x:_) -> if even x then putNumber (div x 2) else throwE "Number can't be halved"
    [] -> throwE "The state is empty"

putHalfTwice :: MyMonad ()
putHalfTwice = putHalf >> putHalf

try :: MyMonad a -> MyMonad a
try act = do
  s <- lift get
  act `catchE` (\e -> lift (put s) >> throwE e)

foo :: MyMonad ()
foo = putHalfTwice `catchE` (\_ -> putNumber 12)

bar :: MyMonad ()
bar = try putHalfTwice `catchE` (\_ -> putNumber 12)

main :: IO ()
main = do
  print $ runState (runExceptT foo) [2]
  print $ runState (runExceptT bar) [2]