Ciclo di stato con diversi tipi di interruzioni

Question

Sto provando a convertire il seguente codice imperativo stato in Haskell.

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

Sia il put1 e put2 leggere lo stato del sistema e modificarlo. get può per semplicità solo leggere lo stato. failImmediately dovrebbe uscire dal ciclo infinito e presentare un tipo di risultato, succeedImmediately dovrebbe scoppiare ma presentare un risultato diverso.

Quello che ho cercato di usare era State Env Result dove Env rappresentavano lo stato dell'ambiente e Result era qualcosa come Either Failure Success per un po 'personalizzato Failure e Success.

Lotto con il requisito che l'intera espressione risultante dovrebbe collassare nel Failure/Success una volta che uno di essi viene prodotto (rompendo il ciclo) e altrimenti continua ad andare.

Un'idea che avevo era uso Either Exit() dove data Exit = Success | Failure e utilizzare StateT in qualche modo di comportarsi sul Left del Either come se Either stata la monade essere incatenato, cioè ignorando eventuali azioni successive.

Apprezzerei molto qualsiasi ispirazione o esempio di codice haskell che avrebbe lo stesso comportamento dello snippet precedente.

Modifica: versione perfezionata spostata in una domanda separata "Stateful computation with different types of short-circuit (Maybe, Either)".

Answer 1

Utilizzando il kit da risposta @ di chi, semplicemente mettendo in evidenza che non è necessario il pieno potere di ContT, la diretta -Short circuito semantica di EitherT basta:

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

Una traduzione quasi letterale, non elegante ma efficace.

Utilizziamo il trasformatore monad ContT per ottenere l'effetto di "early return". Io, vogliamo essere in grado di rompere i nostri anelli in qualsiasi momento. Questo risultato si ottiene usando callCC $ \exit -> ... che rende approssimativamente exit la nostra funzione magica che ci consente di uscire immediatamente dai blocchi interni.

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 

Possiamo anche definire alcuni aiutanti personalizzati per abbellire il codice:

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)