跳过monad中的剩余动作 - 就像返回一样

Question

嗨,我正在寻找一种允许monad堆栈跳过剩余动作的好方法,而不会完全跳过.有点像returnC系列语言.

例如,假设我正在使用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

好像绑定>>=已经做到了这一点.至少它肯定在monad的可能性范围内,但我不确定如何处理monad变换器.

---

这是一个更完整的例子.该系统应该执行"工作流程".每个步骤都可以产生响应,这应该会停止整个工作流程并响应(ExceptT).

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

有一个更好的方法吗？是否有一些monad变换器或一种定义我的Flowmonad的方法,以便我可以在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

另一个答案很棒!我想谈谈延续解决方案究竟是如何工作的,所以我写了这个奇怪的大事.希望能帮助到你.

第一幕:陷阱陷入困境

我们开始在IO我们最喜欢的州monad 的低洼平原上旅行:

module Lib where

step1 :: IO String
step1 = do
  print "step1 - A"
  print "step1 - B"
  pure "--step1 result--"

step2 :: String -> IO String
step2 input = do
  print input
  print "step2 - A"
  print "step2 - B"
  pure "--step2 complete--"

main :: IO ()
main = do
  result <- step1 >>= step2
  print "--done--"
  print result

我们想要向上攀登并找到从第一步提前返回的方法.我们的第一个尝试是引入某种可疑类型的转义机制:

step1 :: (String -> ???) -> IO String
step1 escape = do
  print "step1 - A"
  escape "escaped!"
  print "step1 - B"
  pure "--step1 result--"

我们交叉手指,希望我们传递的字符串escape最终会成为字符串IO String,并思考究竟什么可以填补那些讨厌的问号.

在我们看来,>>=如果我们有任何希望将控制流从IOmonad中夺走,我们就需要劫持这里.我们谨慎地猜测我们需要自己的monad变压器.

newtype StrangeT inner a =
  StrangeT { runStrangeT :: a -> ??? }

lift :: IO a -> StrangeT IO a
lift io =
  StrangeT (\trapDoor -> io >>= trapDoor)

escape :: a -> StrangeT IO a
escape a =
  StrangeT (\trapDoorA -> trapDoorA a)

step1 :: StrangeT IO String
step1 = do
  lift (print "step1 - A")
  escape "escaped!"
  lift (print "step1 - B")
  pure "--step1 result--"

我们可以认为trapDoorA是一个由密钥保护的逃逸机制,密钥是任何类型的值a.一旦门打开,我们就会进入计算的下一步.

要为问号插入什么类型？我们有点陷入困境; 为了编译这个代码,我们只能:

newtype StrangeT inner a =
  StrangeT { runStrangeT :: (a -> inner a) -> inner a }

第二幕:陌生人

我们现在需要实例Monad (StrangeT inner).不幸的是,我们将遇到一个大问题.StrangeT不是算人!

原因是"a"出现在"负面位置":

newtype StrangeT inner a =
  StrangeT { runStrangeT :: (a -> inner a) -> inner a }
                               -- ^^^^^^^
                               -- :(

(有关此主题的完整讨论,请参阅什么是逆变函子？)

我们可以使用一个讨厌的技巧,即将"负面"和"正面"分成两个不同的类型变量(a和result):

newtype StrangeT result inner a =
  StrangeT { runStrangeT :: (a -> inner result) -> inner result }

lift :: IO a -> StrangeT whatever IO a
lift io = StrangeT (\trapDoor -> io >>= trapDoor)

escape :: a -> StrangeT whatever IO a
escape x = StrangeT (\trapDoor -> trapDoor x)

这使一切成为可能.我们现在可以实例Functor,Applicative和Monad.我们不是试图解开答案,而是简单地让类型检查器接管.任何类型检查的答案都是正确的.

instance Functor (StrangeT result inner) where
  fmap a2b (StrangeT strange) =
    StrangeT $ \trapDoor -> strange (\a -> trapDoor (a2b a))
             -- ^^^^^^^^
             -- b -> inner result

逻辑列表:

• trapDoor是建立inner result价值的唯一方法.

• 它需要一个类型的值b.

• 我们有a2b :: a -> b和a :: a.

  instance Applicative (StrangeT result inner) where
    pure :: a -> StrangeT result inner a
    pure a = StrangeT $ \trapDoor -> trapDoor a
  
    (<*>) :: StrangeT result inner (a -> b) ->
             StrangeT result inner a ->
             StrangeT result inner b
    (StrangeT strangeA2B) <*> (StrangeT strangeA) =
  --          ^^^^^^^^^^                ^^^^^^^^
  --          (b -> inner result) -> inner result
  --                                    (a -> inner result) -> inner result
      StrangeT (\trapDoorB -> strangeA2B (\a2b -> strangeA (\a -> trapDoorB (a2b a))))
  --             ^^^^^^^^                 
  --             b -> inner result
  

逻辑列表:

• 我们trapDoorB :: b -> inner result(构建内部结果的唯一方法)a2b :: a -> b,和a :: a.

• 我们需要构建一个StrangeT result inner b;

• 因此,我们必须在某一点评价trapDoorB (a2b a).

monadic实例同样困难:

    instance Monad (StrangeT result inner) where
      (StrangeT strangeA) >>= a2strangeB =
         --     ^^^^^^^^
         --     (a -> inner result) -> inner result
        StrangeT
          (\trapDoorB -> strangeA (\a -> let StrangeT strangeB = a2strangeB a in strangeB (\b -> trapDoorB b)))
         -- ^^^^^^^^^                                 ^^^^^^^^
         -- b -> inner result                         (b -> inner result) -> inner result

只有一种方法可以构建inner result,通过堕落trapDoorB,所以其他一切都是建立在这个单一的目标上.

第三幕:一个摸索

我们已经定义了一个monad变换器而不知道它的作用或工作方式!我们简单地将看起来正确的类型拼凑在一起.

那么我们应该在行动中看到它:

main :: IO ()
main = do
  _ <- runStrangeT (step1 >>= step2) (\a -> pure a)
  print "--done--"
  print result

这导致以下输出:

?> main
"step1 - A"
"step1 - B"
"--step1 result--"
"step2 - A"
"step2 - B"
"--done--"
"--step2 result--"

多么令人沮丧!我们是从我们开始的地方.

但是,如果我们定义这个函数,会发生一些奇怪的事情:

escape :: a -> StrangeT whatever IO a
escape x = StrangeT (\trapDoor -> trapDoor x)

escapeWeirdly :: a -> StrangeT whatever IO a
escapeWeirdly x = StrangeT (\trapDoor -> trapDoor x >> trapDoor x >> trapDoor x)

step1 :: StrangeT String IO String
step1 = do
  lift (print "step1 - A")
  escapeWeirdly "--step1 exit--"
  lift (print "step1 - B")
  pure "--step1 result--"

输出:

?> main
"step1 - A"
"step1 - B"               <- trap door call #1
"--step1 result--"
"step2 - A"
"step2 - B"
"step1 - B"               <- trap door call #2
"--step1 result--"
"step2 - A"
"step2 - B"
"step1 - B"               <- trap door call #3
"--step1 result--"
"step2 - A"
"step2 - B"
"--done--"
"--step2 result--"

step2跑了三次!似乎"trapDoor"编码了"控制流程中此点后的所有内容"的一些概念.调用它一次就可以运行一次.调用它三次后会运行三次.称之为零次......

cut :: a -> StrangeT a IO a
cut x = StrangeT (\_ -> return x)

step1 :: (String -> StrangeT String IO String) -> StrangeT String IO String
step1 exit = do
  lift (print "step1 - A")
  cut "--step1 exit--"
  lift (print "step1 - B")
  pure "--step1 result--"

main :: IO ()
main = do
  result <- runStrangeT (step1 undefined >>= step2) pure
  print "--done--"
  print result

输出:

?> main
"step1 - A"
"--done--"
"--step1 exit--"

什么都没有!这非常接近我们的需求.

第四幕:成功与价格

如果我们可以将StrangeT行动块标记为需要提前退出,该怎么办？与我们原来的逃生机制非常相似的东西:

step1 = withEscape $ \escape -> do
  lift (print "step1 - A")
  escape "--step1 exit--"
  lift (print "step1 - B")
  pure "--step1 result--"

什么withEscape是它运行do-block直到有人调用escape,此时计算的其余部分被中止,但是在此之外的任何计算withEscape(即这里的第二步)按原样运行.

此助手必须具有以下类型:

withEscape :: (??? -> StrangeT result inner a) -> StrangeT result inner a

几乎信仰完全相同的飞跃,我们提出,当我们从去m a到(a -> m a) -> m a.

由于我们传递一个Stringto escape并将该计算的结果绑定到do-block的下一行,我们现在可以填写这些问号:

withEscape :: ((a -> StrangeT result inner whatever) -> StrangeT result inner a)
              -> StrangeT result inner a

一个狡猾的类型!我们将不得不再次按类型导航以找到定义:

-- We have to call f at some point, and trapDoorA
-- is the only way to construct an inner result.
withEscape f =
  StrangeT (\trapDoorA -> let StrangeT strangeA = f ??? in strangeA trapDoorA)

-- f is passed the early exit value
withEscape f =
  StrangeT (\trapDoorA ->
    let StrangeT strangeA = f (\a -> ???) in strangeA trapDoorA)

-- We need to construct a StrangeT value
withEscape f =
  StrangeT (\trapDoorA ->
    let StrangeT strangeA = f (\a -> StrangeT (\trapDoorWhatever -> ???)) in
    strangeA trapDoorA)

-- We are going to *ignore* the trapDoorWhatever
-- we are supposed to fall into, and *instead*
-- fall through our original trapDoorA.
withEscape f =
  StrangeT (\trapDoorA ->
    let StrangeT strangeA = f (\a -> StrangeT (\_ -> trapDoor a)) in
    strangeA trapDoorA)

这里发生的事情是我们偶然发现了一个给我们两个陷阱门的解决方案.pure我们选择穿过我们为自己建造的原始门,而不是从第一扇门掉下来(这会让帮手熬到像恢复正常控制流的那样).电影" Primer"的粉丝们会认为这是原罪; 普通人可能只是在他们的脸上看起来很混乱.

无论如何,这有效:

step1 :: StrangeT String IO String
step1 =
  withEscape $ \escape -> do
    lift (print "step1 - A")
    escape "--step1 exit--"
    lift (print "step1 - B")
    pure "--step1 result--"

step2 :: String -> StrangeT String IO String
step2 result = do
  lift (print result)
  lift (print "step2 - A")
  lift (print "step2 - B")
  pure "--step2 result--"

main :: IO ()
main = do
  result <- runStrangeT (step1 >>= step2) pure
  print "--done--"
  print result

输出:

?> main
"step1 - A"              <- early exit
"--step1 exit--"         <- step2 runs
"step2 - A"
"step2 - B"
"--done--"               <- back to main
"--step2 result--"

摘要

• 通过电报,这是ContTmonad,可以在transfomers包中找到包装.我们所谓的陷阱门是真正的延续.

• withEscape更为人所知的是callCC(用当前继续调用); 它允许您在调用callCC名称时给出当前的延续(escape在我们的示例中); 当您激活延续时,它允许您立即返回值.

• 你可以用延续来实现很多东西,包括早期返回和异常以及生成器,而且上帝知道还有什么.我们甚至还没有谈论分隔的延续(转移和重置).它们代表了计算机编程结构的原始和基础.

• 有关更多信息,请参阅Oleg Kiselyov网站上链接的系列论文.关于延续还有很多话要说.

你真的应该在现实生活中这样做吗？

可能不是.ExceptT从长远来看,往往会减少头痛.

但ExceptT比凉爽ContT？

几乎不.

Answer 2

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"