Question

我正在尝试找到将以下有状态命令式代码转换为纯函数式表示的最优雅方式（最好在Haskell中使用其Monad实现提供的抽象）。但是我还不擅长使用变压器等组合不同的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
}

当get返回Nothing时，我们需要执行以继续put2，当get返回Just x时，我们希望x获得put1传递给put1并且仅在put1失败或短路时才短路。基本上put2和get可能会终止整个事情或移动到以下语句以某种方式更改基础状态。 put1可以成功并调用put2并循环或失败并继续forever $ do forever (get >>= put1) put2。

我的想法是：

(get >>= put1)

为什么我一直在寻找类似的东西，因为只要get无法返回或put1终止，put2就会短路。同样State终止外循环。但是，我不确定如何将Maybe与必要的Either和/或State混合以实现此目标。

我认为使用变换器组合if和其他monad是必要的，因此代码很可能不是那个succint。但我想它也可能不会更糟。

欢迎任何有关如何优雅地实现翻译的建议。这与使用when，while，Maybe避免显式控制流的“Stateful loop with different types of breaks”不同，而是尝试鼓励使用Either，{{1或其他一些方便的>>=语义。此外，如何将代码转换为功能代码总是一种直接的方式，但它很难被认为是优雅的。

Answer 1

您正在寻找EitherT或ExceptT。它增加了两种返回变压器堆栈的方法。计算可以是return a或throwError e。错误和回报之间存在两个差异。错误保留在Left上，并在Right上返回。当您>>=发生错误时，它会短路。

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 = throwError和right = return。

Left上的错误不会继续，我们将使用它们来表示退出循环。我们将使用EitherT r m ()类型来表示一个循环，该循环可以使用中断结果Left r停止，也可以继续Right ()。这几乎完全是forever，除了我们打开EitherT并删除返回值周围的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或返回数据。

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或返回。

data Failure = Failure deriving Show

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

放置数据的第二个计算是Success或返回。

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 ()

对于您的示例，我们需要组合两个或多个计算，这两个计算都以不同的方式异常停止。我们将使用两个嵌套EitherT来表示它。

EitherT o (EitherT i m) r

外部EitherT是我们目前正在操作的那个。我们可以通过在每个EitherT o m a ^†周围添加额外的EitherT o (EitherT i m) a图层，将EitherT转换为m。

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

我们现在可以构建成功或失败的整体计算。将打破当前循环的计算over。打破外循环的计算是lift ed。

example :: EitherT Failure (State Int) Success
example =
    untilLeft $ do
        lift . untilLeft $ over get1 >>= lift . put1
        over put2

整体Failure在最内层循环中lift两次。这个例子非常有趣，可以看到一些不同的结果。

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

^†如果EitherT有MFunctor个实例，over就是hoist lift，这是一种经常使用的模式值得拥有自己深思熟虑的名字。顺便说一下，我使用EitherT而不是ExceptT主要是因为它的名称加载较少。无论哪一个提供MFunctor实例，对我来说，最终将作为monad变换器赢得胜利。

Answer 2

然而，我还不擅长使用变形金刚等来组合不同的monad。

你真的不需要将不同的monad与组合器组合在一起，你只需要在状态monad中明确地嵌入Maybe monad。完成此操作后，翻译代码段很简单，用相互递归的函数替换循环 - 相互关系实现了分支条件。

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

因此，我假设 put1 和 put2 返回的表示错误的类型是一个表示诊断消息的字符串，我们在String类型上实例化成功monad ：

Success =
  Lemonade_Success.Make(String)

现在，Success模块表示monadic计算，它可能会因诊断而失败。有关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，提供ad-hoc错误描述。这是因为你需要这个特殊的错误描述，你将无法仅使用抽象的monad组合器进行这种转换 - 或者，为了更加迂腐地说，没有规范映射从Maybe到State，因为这些映射是参数化的通过错误描述。

一旦编写了success_get函数，使用相互递归函数和用于处理错误条件的Success.catch函数来转换所描述的分支条件非常简单。

我将Haskell中的实现作为练习留给您。：）

Success模块的完整签名是

  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。

Answer 3

你的问题有点棘手，因为你要问的是一种优雅的方式。有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')

只是简单的递归。

Answer 4

这可能与@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，其中r为Result值，因此调用其中一个示例的代码可能如下所示：

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

请注意，您可以使用Result：

代替自定义Either String String类型

type Result = Either String String

并对Left使用Fail，Right使用Success。

使用不同类型的短路进行状态计算（可能，或者）

4 个答案: