ブレークの種類が異なるステートフルループ

Question

以下のステートフル命令コードをHaskellに変換しようとしています。

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

両方put1とput2システムの状態を読み取り、それを修正します。 getは簡単に状態を読み取ることができます。 failImmediatelyはエンドレスループから抜け出し、あるタイプの結果を提示する必要があります。succeedImmediatelyもまた別の結果を提示する必要があります。私が使用しようとした何

は

Envは、環境の状態を表現してResultは、いくつかのカスタムFailureとSuccessためEither Failure SuccessのようなものだったState Env Resultました。

結果の表現全体がFailure/Successに折りたたまれ、そのうちの1つが生成されたら（ループを壊す）、そうでなければ続行する必要があるという苦労があります。私が持っていた

ひとつのアイデアは、Either Exit()どこdata Exit = Success | Failureを使用し、すなわち、任意の後続のアクションを無視して、チェーンされたモナドたEitherかのようにEitherのLeft時に動作するように何とかStateTを使用しました。

上記のスニペットと同じ動作を実現するヒントやヒントのサンプルをいただきありがとうございます。

編集：洗練されたバージョンを別の質問 "Stateful computation with different types of short-circuit (Maybe, Either)"に移動しました。

Answer 1

EitherTの-shortサーキットのセマンティクスは十分である：

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モナドトランスを利用して、 「早期復帰」の効果を達成します。私たちは、いつでもループを壊すことができるようにしたいと考えています。これは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 

我々はまた、コードを飾り立てるためにいくつかのカスタムヘルパーを定義することができます。

、ちょうどあなたが ContTのフルパワーを必要としないことを強調し、@カイの答えからの直接のキットを使用して

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)