具有不同类型中断的状态循环

Stateful loop with different types of breaks

我正在尝试将以下有状态命令式代码转换为 Haskell。

while (true) {
  while (get()) {
    if (put1()) {
      failImmediately();
    }
  }
  if (put2()) {
    succeedImmediately();
  }
}

put1put2都读取系统状态并修改它。 get 可以为简单起见只读取状态。 failImmediately 应该跳出无限循环并呈现一种结果,succeedImmediately 也应该跳出但呈现不同的结果。

我尝试使用的是 State Env Result,其中 Env 代表环境状态,Result 类似于 Either Failure Success 用于某些自定义 FailureSuccess.

我很难满足这样的要求,即一旦产生其中一个表达式(打破循环),整个结果表达式就应该折叠成 Failure/Success,否则继续前进。

我的一个想法是在 data Exit = Success | Failure 处使用 Either Exit () 并使用 StateT 以某种方式对 EitherLeft 进行操作,就好像 [=28] =] 是被链接的 monad,即忽略任何后续操作。

如果能获得与上述代码段相同的行为,我将不胜感激 haskell 代码的任何灵感或示例。

编辑:精化版移至单独问题“”。

近乎字面的、不优雅但有效的翻译。

我们利用 ContT monad transformer 来实现的效果 "early return"。也就是说,我们希望能够在任何时候打破我们的循环。这是通过使用 callCC $ \exit -> ... 实现的,它大致使 exit 成为我们的魔法函数,让我们立即逃离内部块。

import Control.Monad.Cont

action :: IO String
action = flip runContT return $ callCC $ \exit -> 
   forever $ do                   -- while (true)
      let loop = do
             r1 <- lift $ get     -- if (get())
             when r1 $ do
                r2 <- lift $ put1
                when r2 $         -- if (put1())
                   exit "failImmediately"
                loop              -- "repeat while"
      loop
      r3 <- lift $ put2
      when r3 $
         exit "succeedImmediately"

get :: IO Bool
get = readLn

put1 :: IO Bool
put1 = putStrLn "put1 here" >> readLn

put2 :: IO Bool
put2 = putStrLn "put2 here" >> readLn

main :: IO ()
main = action >>= putStrLn

我们还可以定义一些自定义助手来美化代码:

action2 :: IO String
action2 = flip runContT return $ callCC $ \exit -> 
   forever $ do                -- while (true)
      whileM get $             -- while(get())
         whenM put1 $          -- if (put1())
            exit "failImmediately"
      whenM put2 $             -- if (put2())
         exit "succeedImmediately"

whenM :: (MonadTrans t, Monad m, Monad (t m)) => m Bool -> t m () -> t m ()
whenM condition a = do
   r <- lift condition
   when r a

whileM :: (MonadTrans t, Monad m, Monad (t m)) => m Bool -> t m () -> t m ()
whileM condition a = whenM condition (a >> whileM condition a)

使用@chi 的回答中的工具包,只是强调你不需要 ContT 的全部功能,EitherT 的直接短路语义就足够了:

import Control.Monad.Trans.Either

data Result a = Failure | Success a

foo :: EitherT (Result Int) IO Int
foo = forever $ do
    whileM get $ do
        whenM put1 $ do
            left Failure
    whenM put2 $ do
        left $ Success 42

run :: (Monad m) => EitherT (Result a) m a -> m (Maybe a)
run act = do
    res <- runEitherT act
    return $ case res of
        Left Failure -> Nothing
        Left (Success x) -> Just x
        Right x -> Just x

-- whenM / whileM and get/put1/put2 as per @chi's answeer