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

时间:2015-09-04 06:59:00

标签: haskell monads monad-transformers state-monad

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

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

put1put2都读取系统状态并进行修改。 get可以简单地读取状态。 failImmediately应该突破无限循环并呈现一种类型的结果,succeedImmediately也应该突破但呈现不同的结果。

我尝试使用的是State Env Result,其中Env表示环境状态,而Result类似Either Failure Success表示某些自定义Failure和{Success 1}}。

我很难满足这样的要求:一旦产生了一个表达式(打破循环),整个结果表达式就会崩溃到Failure / Success中。否则就会继续前进。

我的一个想法是使用Either Exit () data Exit = Success | Failure,然后使用StateTLeft的{​​{1}}行事,就像Either一样是monad被链接,即忽略任何后续行动。

我非常感谢haskell代码的任何灵感或样本,它们将实现与上面代码段相同的行为。

修改精炼版移至单独的问题“Stateful computation with different types of short-circuit (Maybe, Either)”。

2 个答案:

答案 0 :(得分:6)

使用来自@ 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

答案 1 :(得分:4)

几乎是文字的,非优雅但有效的翻译。

我们利用ContT monad变换器来实现效果 “早日回归”。即,我们希望能够在任何时候打破我们的循环。这是通过使用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)

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

{{1}}