具有不同类型短路的状态计算(也许,要么)

Stateful computation with different types of short-circuit (Maybe, Either)

我正在尝试找到最优雅的方法将以下有状态命令式代码转换为纯函数表示(最好在 Haskell 中使用其 Monad 实现提供的抽象)。但是,我还不擅长使用变压器等组合不同的单子。在我看来,分析他人对此类任务的看法对学习如何自己完成任务最有帮助。命令式代码:

while (true) {
  while (x = get()) { // Think of this as returning Maybe something
    put1(x) // may exit and present some failure representation
  }
  put2() // may exit and present some success representation
}

When get returns Nothing 我们需要继续执行 put2, when get returns Just x 我们希望 x 传递给 put1 并仅在 put1 失败时才短路,否则循环。基本上 put1put2 可能会终止整个事情或移动到以下语句以某种方式更改基础状态。 get 可以成功并调用 put1 并循环或失败并继续 put2

我的想法是一致的:

forever $ do
  forever (get >>= put1)
  put2

为什么我一直在寻找类似的东西,因为 (get >>= put1) 可以在 get 与 return 或 put1 无关时简单地短路。同样 put2 终止外层循环。但是我不确定如何将 State 与必要的 Maybe and/or Either 混合来实现这一点。

我认为使用转换器来组合 State 和其他单子是必要的,因此代码很可能不会那么简洁。不过我估计也不会差多少。

欢迎提出如何优雅地实现翻译的任何建议。这与“”的不同之处在于避免使用 ifwhenwhile 的显式控制流,而是试图鼓励使用 MaybeEither,或其他一些方便的 >>= 语义。此外,如何将代码转换为功能代码总是有一种直接的方法,但它很难被认为是优雅的。

However I am not yet good at combining different monads using transformers and the like.

你真的不需要用组合子来组合不同的单子,你只需要明确地将 Maybe 单子嵌入到状态单子中。一旦完成,翻译片段就很简单了,用相互递归函数代替循环——相互性实现分支条件。

让我们用 OCaml 和 sparkling monad library Lemonade 编写一个解决方案,其中 State monad 被称为 Lemonade_Success。

所以,我假设 put1put2 返回的表示错误的类型是一个字符串,表示诊断信息,我们在 String 类型上实例化 Success monad:

Success =
  Lemonade_Success.Make(String)

现在,Success 模块代表一元计算,它可能因诊断而失败。请参阅下面的 Success 完整签名。我写了上面代码片段的翻译,作为一个由你的数据参数化的仿函数,但是当然,你可以简化它并直接使用实现定义。您的问题的数据由具有签名 P

的模块参数描述
module type P =
sig
    type t
    val get : unit -> t option
    val put1 : t -> unit Success.t
    val put2 : unit -> unit Success.t
end

上述代码段的可能实现方式是

module M(Parameter:P) =
struct
    open Success.Infix

    let success_get () =
      match Parameter.get () with
        | Some(x) -> Success.return x
        | None -> Success.throw "Parameter.get"

    let rec innerloop () =
      Success.catch
        (success_get () >>= Parameter.put1 >>= innerloop)
        (Parameter.put2 >=> outerloop)
    and outerloop () =
      innerloop () >>= outerloop
end

函数 get_success 将 Maybe monad 映射到 Success monad,提供临时错误描述。这是因为你需要这个临时错误描述,你将无法仅使用抽象的 monad 组合器来完成这个转换——或者,更迂腐地说,没有从 Maybe 到 State 的规范映射,因为这些映射是参数化的通过错误描述。

编写 success_get 函数后,使用相互递归函数和用于处理错误条件的 Success.catch 函数来翻译您描述的分支条件非常简单。

我将 Haskell 中的实现作为练习留给您。 :)


成功模块的完整签名为

  module Success :
  sig
    type error = String.t
    type 'a outcome =
      | Success of 'a
      | Error of error
    type 'a t
    val bind : 'a t -> ('a -> 'b t) -> 'b t
    val return : 'a -> 'a t
    val apply : ('a -> 'b) t -> 'a t -> 'b t
    val join : 'a t t -> 'a t
    val map : ('a -> 'b) -> 'a t -> 'b t
    val bind2 : 'a t -> 'b t -> ('a -> 'b -> 'c t) -> 'c t
    val bind3 : 'a t -> 'b t -> 'c t -> ('a -> 'b -> 'c -> 'd t) -> 'd t
    val bind4 :
      'a t -> 'b t -> 'c t -> 'd t -> ('a -> 'b -> 'c -> 'd -> 'e t) -> 'e t
    val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
    val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
    val map4 :
      ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t
    val dist : 'a t list -> 'a list t
    val ignore : 'a t -> unit t
    val filter : ('a -> bool t) -> 'a t list -> 'a list t
    val only_if : bool -> unit t -> unit t
    val unless : bool -> unit t -> unit t
    module Infix :
      sig
        val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
        val ( <$> ) : ('a -> 'b) -> 'a t -> 'b t
        val ( <* ) : 'a t -> 'b t -> 'a t
        val ( >* ) : 'a t -> 'b t -> 'b t
        val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
        val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t
        val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
        val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> 'a -> 'c t
      end
    val throw : error -> 'a t
    val catch : 'a t -> (error -> 'a t) -> 'a t
    val run : 'a t -> 'a outcome
  end

为了保持简洁,我删除了一些类型注释并隐藏了签名中的自然转换 T

你的问题有点棘手,因为你问的是一种优雅的方式,但实际上并不优雅。有 Control.Monad.Loops 来编写这种类型的循环。您可能需要类似 whileJust' 或等效的东西。通常,我们不需要像那样编写 while 循环,普通的旧递归通常是最简单的。

我试图找到一个例子来说明何时需要这种类型的代码,并提供了以下示例。我想建立一个用户输入的字符串列表列表。每行对应于列表中的一个条目。一个空行开始一个新列表,两个空行停止循环。

示例

a
b
c

d
e

f

会给予

[ ["a", "b", "c"
, ["d", "e"]
, ["f"]
]

我可能会在 haskell

中执行以下操作
readMat :: IO [[String]]
readMat = reverse `fmap` go [[]]
    where go sss = do
                s <- getLine
                case s of
                    "" -> case sss of
                        []:sss' -> return sss' # the end
                        _ -> go ([]:sss)       # starts a new line
                    _ -> let (ss:ss') = sss
                          in go ((ss ++ [s]):ss')

只是简单的递归。

您正在寻找 EitherT or ExceptT。它将 return 的两种方式添加到转换器堆栈。计算可以 return athrowError e。错误和 returns 之间有两个区别。错误保留在 LeftRight 上的 return 上。当您 >>= 遇到错误时,它会短路。

newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }

return :: a -> EitherT e m a
return a = EitherT $ return (Right a)

throwError :: e -> EitherT e m a
throwError e = EitherT $ return (Left a)

我们还将使用名称 left = throwErrorright = return

Left 上的错误不会继续,我们将使用它们来表示退出循环。我们将使用类型 EitherT r m () 来表示一个循环,该循环要么以中断结果 Left r 停止,要么以 Right () 继续。这几乎完全是 forever,除了我们打开 EitherT 并去掉 returned 值周围的 Left

import Control.Monad
import Control.Monad.Trans.Either

untilLeft :: Monad m => EitherT r m () -> m r
untilLeft = liftM (either id id) . runEitherT . forever   

我们将在充实您的示例后回头讨论如何使用这些循环。

由于您想看到几乎所有逻辑都消失了,我们也将对其他所有内容使用 EitherT。获取数据的计算是 Done 或 return 数据。

import Control.Monad.Trans.Class
import Control.Monad.Trans.State

data Done = Done       deriving Show

-- Gets numbers for a while.
get1 :: EitherT Done (State Int) Int
get1 = do
    x <- lift get
    lift . put $ x + 1
    if x `mod` 3 == 0
    then left Done
    else right x

放置数据的第一个计算是 Failure 或 returns。

data Failure = Failure deriving Show

put1 :: Int -> EitherT Failure (State Int) ()
put1 x = if x `mod` 16 == 0
         then left Failure
         else right ()

第二次放入数据的计算是 Success 或 returns。

data Success = Success deriving Show

put2 :: EitherT Success (State Int) ()
put2 = do 
        x <- lift get
        if x `mod` 25 == 0
        then left Success
        else right ()

对于您的示例,我们将需要组合两个或多个以不同方式异常停止的计算。我们将用两个嵌套的 EitherTs.

来表示它
EitherT o (EitherT i m) r

外面的EitherT就是我们目前正在操作的那个。我们可以通过在每个 m.

周围添加额外的 EitherT 层将 EitherT o m a 转换为 EitherT o (EitherT i m) a
over :: (MonadTrans t, Monad m) => EitherT e m a -> EitherT e (t m) a
over = mapEitherT lift

内部 EitherT 层将像转换器堆栈中的任何其他底层 monad 一样处理。我们可以 lift 一个 EitherT i m a 到一个 EitherT o (EitherT i m) a

我们现在可以构建一个要么成功要么失败的整体计算。会中断当前循环的计算被运行 overlifted.

会破坏外循环的计算
example :: EitherT Failure (State Int) Success
example =
    untilLeft $ do
        lift . untilLeft $ over get1 >>= lift . put1
        over put2

整体 Failurelift 编辑两次进入最内层循环。这个例子很有趣,可以看到一些不同的结果。

main = print . map (runState $ runEitherT example) $ [1..30]

如果 EitherT 有一个 MFunctor 实例,over 将只是 hoist lift,这是一个模式被如此频繁地使用,它值得拥有自己深思熟虑的名字。顺便说一下,我使用 EitherT 而不是 ExceptT 主要是因为它的名称负载较少。无论哪个首先提供 MFunctor 实例,对我而言,最终都会作为 monad 转换器胜出。

这可能与@Cirdec 的回答有些重叠,但它也可能帮助您更好地了解正在发生的事情。

首先要注意的是您确实没有双重嵌套循环。如果没有 exit 语句,您可以将其编写为一个简单的循环:

example1 = forever $ do
  x <- getNext                -- get the next String
  if (isPrefixOf "break-" x)  -- do we break out of the "inner" loop?
    then put2 x
    else put1 x
  where
    put1 x = putStrLn $ "put1: " ++ x
    put2 x = putStrLn $ "put2: " ++ x

所以现在我们只需使用 runEitherT 的标准技术来打破循环。

首先导入一些:

import Control.Monad
import Control.Monad.Trans.Either
import Control.Monad.State.Strict
import Data.List

以及我们的结果类型和便利函数:

data Result = Success String | Fail String deriving (Show)

exit = left

然后我们重写我们的循环,提升任何 IO 操作,并在我们想要跳出循环时使用 exit

example2 match =
  let loop = runEitherT $ forever $ do
        x <- getNext
        if isPrefixOf "break-" x
          then put2 x
          else put1 x
        where
          put1 "fail" = exit (Fail "fail encountered")
          put1 x      = liftIO $ putStrLn $ "put1: " ++ x

          put2 x      = if x == match
                          then exit (Success $ "found " ++ match)
                          else liftIO $ putStrLn $ "put2: " ++ x
  in loop

这里有一些测试:

-- get next item from the state list:
getNext = do (x:xs) <- get; put xs; return x

test2a = evalStateT (example2 "break-foo") [ "a", "b", "fail" ]
test2b = evalStateT (example2 "break-foo") [ "a", "b", "break-foo", "c", "fail" ]
test2c = evalStateT (example2 "break-foo") [ "a", "b", "break-xxx", "c", "fail" ]

这些测试的输出是:

ghci> test2a
put1: a
put1: b
Left (Fail "fail encountered")

ghci> test2b
put1: a
put1: b
Left (Success "found break-foo")

ghci> test2c
put1: a
put1: b
put2: break-xxx
put1: c
Left (Fail "fail encountered")

在此示例中,runEitherT 的返回值将始终为 Left r,其中 rResult 值,因此调用这些示例之一的代码可能看起来像喜欢:

Left r <- test2a
case r of
  Success ... ->
  Fail    ... -> 

请注意,您可以使用 Either String String:

而不是自定义 Result 类型
type Result = Either String String

并使用 Left 表示 Fail,使用 Right 表示 Success