Can I use StateT/MaybeT/forever to eliminate explicit recursion from this IO action?

Question

I have a program like this,

start :: [Q] -> R -> IO R
start qs = fix $ \recurse r -> do
  q <- select qs
  (r', exit) <- askQ q r
  (if exit
    then return
    else recurse) r'

that takes a list of Questions, a Report, and returns a new Report, in the IO monad because select needs it to pick a question at random (and also because askQ will wait for user keyboard input); however, the user did not choose to exit while executing askQ, start will recursively call itself. (fix $ \recurse is the trick to write a recursive lambda.)

The above code smells a lot like a few things:

• the State monad, or, more appropriately, the StateT monad transformer, because R is evolving during start's recursion;
• the forever applicative combinator, because start is recursive and could potentially run forever, if the user wants it to (i.e. if they never ask to exit);
• the MaybeT monad transformer, because Maybe implements MonadPlus that should be able to short-circuit forever, based on what I read just before forever's implementation.

But can't really tell if any or more of those abstractions can be used to write the above code in a more idiomatic way, most importantly avoiding the explicit recursion.

---

This is just some experiment I've done in GHCi to gather a better understanding of the accepted answer.

Here's some utils for the following,

type M = MaybeT (StateT [String] IO) Int
printAndRet rs@(r, s) = putStrLn ("result: " ++ show r ++ ", state: " ++ show s)
                        >> return rs

Here's 4 computations happening in the MaybeT-StateT-composed monad defined there,

c1 = (MaybeT $ StateT $ \s -> printAndRet (Just 1, "again":s)) :: M
c2 = (MaybeT $ StateT $ \s -> printAndRet (Just 2, "once more":s)) :: M
c3 = (MaybeT $ StateT $ \s -> printAndRet (Nothing, "a final time":s)) :: M
c4 = (MaybeT $ StateT $ \s -> printAndRet (Just 10, "and never again":s)) :: M

and here's what happens when we chain them together with >> and run the resulting action:

flip runStateT ["some initial state"] $ runMaybeT $ (c1 >> c2 >> c3 >> c4)
result: Just 1, state: ["again","some initial state"]
result: Just 2, state: ["once more","again","some initial state"]
result: Nothing, state: ["a final time","once more","again","some initial state"]
(Nothing,["a final time","once more","again","some initial state"])

Answer 1

Because I've been playing around with recursion schemes lately, I thought I'd take a shot at a monadic hylomorphism

import Data.Functor.Foldable.Exotic
import Data.Functor.Base (NonEmptyF(..))

start qs = hyloM alg coalg where
  -- Build up a non-empty list ending with the final report.
  coalg r = do q <- select qs
               (r', exit) <- askQ q r
               return $ NonEmptyF r' (if exit then Nothing else Just r')

  -- Wade through the "other" reports to get to the last one.
  alg (NonEmptyF _ (Just x)) = return x
  alg (NonEmptyF r Nothing) = return r

There's almost certainly room for improvement here. (Off the top of my head, I'm fairly certain the list of bad reports isn't "fused" away.)

Answer 2

Well, the result would be something like:

type M = MaybeT (StateT R IO)

start :: [Q] -> M ()
start qs = forever (select qs >>= askQ)

This presumes that select and askQ will be rewritten to run in the M monad instead of IO:

select :: [Q] -> M Q
askQ :: Q -> M ()

The result is very... succinct.

A standalone example, for posterity...

import Data.Coerce
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Maybe
import System.Random

newtype Q = Q String deriving (Show)
newtype R = R [String] deriving (Show)

type M = MaybeT (StateT R IO)

runM :: M a -> IO (Maybe a, R)
runM = flip runStateT (R []) . runMaybeT

select :: [Q] -> M Q
select qs = (qs !!) <$> randomRIO (0, length qs - 1)

askQ :: Q -> M ()
askQ (Q q) = do
  liftIO $ putStrLn q
  r <- liftIO getLine
  if r == "exit" then mzero
    else modify (coerce (r:))

start :: [Q] -> M ()
start qs = forever (select qs >>= askQ)

main :: IO ()
main = do
  result <- runM $ start [ Q "Is this idiomatic?"
                         , Q "Seriously, what's wrong with recursion?"
                         ]
  print result

It seems to work:

λ> main
Seriously, what's wrong with recursion?
nothing
Is this idiomatic?
yes
Is this idiomatic?
exit
(Nothing,R ["yes","nothing"])