<div dir="ltr"><div>I'd like to propose adding the following function (method?) to Control.Monad.Cont.Class, possibly with another name:</div><div><br></div>replay :: MonadCont m => m (m a)<br>replay = callCC $ pure . fix<br><div><br></div><div>Using this in a do-notation block allows one to bind a name to the sub-block that starts immediately after.</div><div></div><div>I reached for continuations to try to get this behavior for use with recursive flows without disrupting the reading of the main forward flow and found how to do it in <a href="https://jsdw.me/posts/haskell-cont-monad/">https://jsdw.me/posts/haskell-cont-monad/</a> under the name "goto". </div><div><br></div><div>While "goto" is as familiar as a name can be, I feel "replay" more accurately conveys, that you can only 'go back', by stating what actually is happening - that a sub-block we're currently evaluating is replayed from its beginning.</div><div><br></div><div>As a motivating example, here's the same recursive IO flow written in 3 ways - one with replay, one with fix, and one with where clauses.</div><div><br></div><div><br></div><div>{-# LANGUAGE LambdaCase #-}<br>import Control.Monad.Cont.Class (MonadCont(callCC))<br>import Control.Monad.IO.Class (MonadIO, liftIO)<br>import Control.Monad.Trans.Cont (evalContT)<br>import Data.Function (fix)<br>import Text.Read (readMaybe)<br><br>replay :: MonadCont m => m (m a)<br>replay = callCC $ pure . fix<br><br>prompt :: MonadIO m => String -> m String<br>prompt t = liftIO $ do<br>  putStrLn t<br>  putStr "> "<br>  getLine<br><br><br>flowContT :: IO ()<br>flowContT = evalContT $ do<br>  liftIO $ putStrLn "Welcome to the totally not contrived game"<br><br>  numberPromptStep <- replay<br>  readMaybe <$> prompt "Pick a number" >>= \case<br>    Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep<br>    Just n -> liftIO $ putStrLn $ "You picked " <> show (n :: Int)<br><br>  exitPromptStep <- replay<br>  prompt "Stop? y/n" >>= \case<br>    "y" -> pure ()<br>    "n" -> numberPromptStep<br>    _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep<br><br><br>flowFix :: IO ()<br>flowFix = do<br>  putStrLn "Welcome to the totally not contrived game"<br>  fix $ \numberPromptStep -> do<br>      readMaybe <$> prompt "Pick a number" >>= \case<br>        Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep<br>        Just n -> liftIO $ putStrLn $ "You picked " <> show (n :: Int)<br><br>      fix $ \exitPromptStep -> do<br>        prompt "Stop? y/n" >>= \case<br>          "y" -> pure ()<br>          "n" -> numberPromptStep<br>          _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep<br><br><br>flowWhere :: IO ()<br>flowWhere = do<br>  putStrLn "Welcome to the totally not contrived game"<br>  numberPromptStep<br>  where<br>    numberPromptStep = do<br>      readMaybe <$> prompt "Pick a number" >>= \case<br>        Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep<br>        Just n -> do<br>          liftIO $ putStrLn $ "You picked " <> show (n :: Int)<br>          exitPromptStep<br><br>    exitPromptStep = do<br>      prompt "Stop? y/n" >>= \case<br>        "y" -> pure ()<br>        "n" -> numberPromptStep<br>        _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep<br></div></div>