Contours of states with various types of discontinuities

Question

I am trying to convert the following stateful imperative code to Haskell.

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

Both put1 and put2 read the state of the system and change it. get can simply read the state for simplicity. failImmediately should break out of an infinite loop and present one type of result; succeedImmediately should break out, but present another result.

What I was trying to use was State Env Result , where Env represented the state of the environment, and Result was something like Either Failure Success for some custom Failure and Success .

I am struggling with the requirement that the whole resulting expression crashes in Failure / Success as soon as one of them is created (loop break), otherwise continue moving.

One of my ideas was to use Either Exit () , where data Exit = Success | Failure data Exit = Success | Failure and use StateT to somehow behave on Left Either , as if Either was a monad chained, i.e. ignoring any subsequent actions.

I would really appreciate any inspiration or sample Haskell code that would achieve the same behavior as the snippet above.

Edit: the revised version has been moved to a separate question, "Status Accounting" with various types of short circuit (possibly any) . "

Answer 1

Using the kit from @chi's answer, just by highlighting that you don't need the full power of the ContT , the ContT direct short circuit EitherT enough:

 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) ma -> 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 answeer 

Answer 2

Almost literal, not elegant, but effective translation.

We use a ContT monad transformer to achieve an early return effect. Ie, we want to be able to break our loops at any moment. This is achieved using callCC $ \exit -> ... , which roughly makes exit our magic function, which allows us to leave the internal blocks immediately.

 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 

We can also define some custom helpers to prefix the code:

 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 (tm)) => m Bool -> tm () -> tm () whenM condition a = do r <- lift condition when ra whileM :: (MonadTrans t, Monad m, Monad (tm)) => m Bool -> tm () -> tm () whileM condition a = whenM condition (a >> whileM condition a)