haskell - 跳过 monad 中剩余的操作 - 类似 return

Question

嗨，我正在寻找一种好方法来允许 monad 堆栈跳过剩余的操作，而不会完全跳过。有点像 C 系列语言中的 return。

例如，假设我正在使用 monadic 操作来处理副作用

type MyMonad = ??
doStuff :: MyMonad ()
doStuff = do
   r <- doSomething

   -- equivalent to if (r == "X") return; in C
   dontGoPastHereIf (r == "X")

   doSomeSideEffects r

所以我希望它只在某些条件下执行 doSomeSideEffects。

我知道您可以使用 guard和 when来完成接近此的操作。可以不嵌套吗？
ExceptT 已经允许您退出正常流程并返回早期结果。但是使用 ExceptT 错误/跳过将传播。我只想跳过本地函数中的其余步骤

doTwoSteps :: MyMonad ()
doTwoSteps = do
  -- if I used ExceptT, an error in the first function will skip the second.
  -- But I still want to do the second step here
  doStuff
  doStuff

似乎 bind >>= 已经这样做了。至少它肯定在 monad 的可能性范围内，但我不确定如何处理 monad 转换器。

这是一个更完整的例子。该系统应该执行“工作流程”。每个步骤都会产生一个响应，它应该停止整个工作流程并做出响应( ExceptT )。

可以通过传递 ApplicationState 重新启动工作流。如果一个步骤有之前的 Continue 我们可以跳过该步骤的逻辑，但我们仍然需要执行下一步。

有一个更好的方法吗？是否有一些monad转换器或一种定义 Flow monad的方法，使我可以在不传递任何 Action 的情况下运行 checkShouldSkip？

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import Control.Monad.Except (throwError, ExceptT)
import Control.Monad.State (gets, StateT, modify)
import Data.Text (Text)

data ApplicationState = ApplicationState
    { step1Result :: Maybe StepResult
    , step2Result :: Maybe StepResult
    } deriving (Show, Eq)

data StepResult
    = Stop
    | Continue
    deriving (Show, Eq)

type Flow a = StateT ApplicationState (ExceptT Text IO) a


flow :: Flow ()
flow = do
    step1
    step2

step1 :: Flow ()
step1 = do
    ms <- gets step1Result
    checkShouldSkip ms $ do
      info <- getStuffFromAServer
      let r = runSomeLogic info
      modify $ setStep1 $ Just r
      checkShouldRespond r

  where
    getStuffFromAServer = undefined
    runSomeLogic _ = undefined
    setStep1 r s = s { step1Result = r }


step2 :: Flow ()
step2 = do
    ms <- gets step2Result
    checkShouldSkip ms $ do
      -- this will run some different logic, eventually resulting in a step result
      r <- getStuffAndRunLogic
      modify $ setStep2 $ Just r
      checkShouldRespond r

  where
    getStuffAndRunLogic = undefined
    setStep2 r s = s { step2Result = r }


checkShouldSkip :: Maybe StepResult -> Flow () -> Flow ()
checkShouldSkip (Just Continue) _ = pure () -- skip the logic, continue
checkShouldSkip (Just Stop) _ = respond "Stop" -- skip the logic, stop everything
checkShouldSkip Nothing a = a -- run the action


checkShouldRespond :: StepResult -> Flow ()
checkShouldRespond Continue = pure ()
checkShouldRespond Stop = respond "Stop" -- if a response, stop all execution


-- rename because these aren't really errors, I just want to stop everything
respond :: Text -> Flow ()
respond t = throwError t

Answer 1

如果您愿意包装您希望能够退出的范围，您可以使用 ExceptT 执行此操作:

type EarlyReturnT m a = ExceptT a m a

withEarlyReturn :: (Functor m) => EarlyReturnT m a -> m a
withEarlyReturn = fmap (either id id) . runExceptT

earlyReturn :: (Applicative m) => a -> EarlyReturnT m a
earlyReturn = ExceptT . pure . Left

例如:

doStuff :: Bool -> IO String
doStuff x = withEarlyReturn $ do
  lift $ putStrLn "hello"
  when x $ earlyReturn "beans"
  lift $ putStrLn "goodbye"
  return "eggs"

> doStuff False
hello
goodbye
"eggs"

> doStuff True
hello
"beans"

或者使用 ContT ，其中“提前返回”是一个延续。

type EarlyReturnT m a = ContT a m a

withEarlyReturn
  :: (Applicative m)
  => ((a -> EarlyReturnT m a) -> EarlyReturnT m a)
  -> m a
withEarlyReturn = flip runContT pure . callCC

doStuff :: Bool -> IO String
doStuff x = withEarlyReturn $ \ earlyReturn -> do
  lift $ putStrLn "hello"
  when x $ earlyReturn "beans"
  lift $ putStrLn "goodbye"
  return "eggs"