有狀態循環與不同類型的休息

Question

我想將以下狀態命令式代碼轉換成Haskell。

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

無論是put1和put2讀取系統的狀態，並對其進行修改。爲了簡單起見，只需閱讀狀態即可。 failImmediately應該跳出無限循環並呈現一種類型的結果，succeedImmediately也應該爆發，但呈現不同的結果。

我試圖用爲State Env Result其中Env代表的環境狀況和Result是像Either Failure Success一些定製Failure和Success。

我一直在努力解決這個問題，即一旦生成一個表達式（斷開循環）並繼續前進，整個結果表達式就應該摺疊成爲Failure/Success。

我有一個想法是使用Either Exit()其中data Exit = Success | Failure和使用StateT在某種程度上的Left表現的Either彷彿Either是被鏈接的單子，即忽略任何後續行動。

我真的很感激任何靈感或樣本的haskell代碼，將實現與上面的代碼片段相同的行爲。

編輯：精緻版本轉移到單獨的問題「Stateful computation with different types of short-circuit (Maybe, Either)」。

Answer 1

運用@綺的回答套件，只是強調，你不需要的ContT全部力量，直接-short-短路的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 

Answer 2

幾乎文字，非優雅但有效的翻譯。

我們利用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)