Proposal: add replay function to Control.Monad.Cont.Class

[Alexandre Esteves]

I'd like to propose adding the following function (method?) to
Control.Monad.Cont.Class, possibly with another name:

replay :: MonadCont m => m (m a)
replay = callCC $ pure . fix

Using this in a do-notation block allows one to bind a name to the
sub-block that starts immediately after.
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 https://jsdw.me/posts/haskell-cont-monad/ under the
name "goto".

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.

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.


{-# LANGUAGE LambdaCase #-}
import Control.Monad.Cont.Class (MonadCont(callCC))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Cont (evalContT)
import Data.Function (fix)
import Text.Read (readMaybe)

replay :: MonadCont m => m (m a)
replay = callCC $ pure . fix

prompt :: MonadIO m => String -> m String
prompt t = liftIO $ do
  putStrLn t
  putStr "> "
  getLine


flowContT :: IO ()
flowContT = evalContT $ do
  liftIO $ putStrLn "Welcome to the totally not contrived game"

  numberPromptStep <- replay
  readMaybe <$> prompt "Pick a number" >>= \case
    Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep
    Just n -> liftIO $ putStrLn $ "You picked " <> show (n :: Int)

  exitPromptStep <- replay
  prompt "Stop? y/n" >>= \case
    "y" -> pure ()
    "n" -> numberPromptStep
    _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep


flowFix :: IO ()
flowFix = do
  putStrLn "Welcome to the totally not contrived game"
  fix $ \numberPromptStep -> do
      readMaybe <$> prompt "Pick a number" >>= \case
        Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep
        Just n -> liftIO $ putStrLn $ "You picked " <> show (n :: Int)

      fix $ \exitPromptStep -> do
        prompt "Stop? y/n" >>= \case
          "y" -> pure ()
          "n" -> numberPromptStep
          _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep


flowWhere :: IO ()
flowWhere = do
  putStrLn "Welcome to the totally not contrived game"
  numberPromptStep
  where
    numberPromptStep = do
      readMaybe <$> prompt "Pick a number" >>= \case
        Nothing -> liftIO (putStrLn "Not a number") *> numberPromptStep
        Just n -> do
          liftIO $ putStrLn $ "You picked " <> show (n :: Int)
          exitPromptStep

    exitPromptStep = do
      prompt "Stop? y/n" >>= \case
        "y" -> pure ()
        "n" -> numberPromptStep
        _ -> liftIO (putStrLn "Invalid choice") *> exitPromptStep
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20210307/1d820523/attachment.html>