Этап состояния с различными типами разрывов

Question

Я пытаюсь преобразовать следующий императивный код состояния в Haskell.

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

И put1 и put2 читать состояние системы и изменить его. get может для простоты просто прочитать состояние. failImmediately должен вырваться из бесконечного цикла и представить один тип результата, succeedImmediately также должен вырваться, но представить другой результат.

То, что я пытался использовать было State Env Result где Env представлял состояние окружающей среды и Result было что-то вроде Either Failure Success для некоторых пользовательских Failure и Success.

Я борюсь с требованием, чтобы целое результирующее выражение рухнуло в Failure/Success, когда один из них был произведен (нарушая цикл) и в противном случае продолжал идти.

Одна идея у меня было использовать Either Exit() где data Exit = Success | Failure и использовать StateT как-то себя на Left из Either, как будто Either была монада будучи прикован, т.е. игнорируя любые последующие действия.

Я был бы очень признателен за любое вдохновение или образец кода хэскеля, который достигнет такого же поведения, что и фрагмент выше.

Редактировать: уточненная версия перенесена на отдельный вопрос «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

Почти буквальный, не элегантный, но эффективный перевод.

Мы используем трансформатор monad ContT для достижения эффекта «ранний возврат». I.e., мы хотим иметь возможность разбить наши петли в любой момент. Это достигается с помощью 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)