Looping over a monadic predicate - haskell

Question

For looping over a function until a predicate holds there is
until :: (a -> Bool) -> (a -> a) -> a -> a
Yet, this falls short once the predicate has the form
Monad m => (a -> m b)
The only way I found out of this is via explicit recursion, e.g. when reading from a handle until EOF is reached:
(_, (Just stdout), _, _) <- createProcess (proc "task" (args fl)){ std_out = CreatePipe }
let readH :: IO [Either String Task] -> IO [Either String Task]
readH l = do eof <- hIsEOF stdout
if eof
then l
else do line <- hGetLine stdout
l' <- l
readH.return $ (eitherDecodeStrict' line) : l'
out <- readH $ return []
Is there a higher order function that simplifies this? Maybe together with sequence?

Answer 1

You can define a "monadic until" function yourself, for example
untilM :: Monad m => (a -> m Bool) -> (a -> m a) -> a -> m a
untilM p f = go
where
go x = do r <- p x
if r
then return x
else do a <- f x
go a
or perhaps, if your predicate doesn't need an argument,
untilM :: Monad m => m Bool -> (a -> m a) -> a -> m a
untilM p f = go
where
go x = do r <- p
if r
then return x
else do a <- f x
go a
or even, you don't want any arguments at all,
untilM :: Monad m => m Bool -> m a -> m ()
untilM p f = do r <- p
if r
then return ()
else do f
untilM p f

Answer 2

Let's refactor your code until we arrive at such a combinator.
let readH :: IO [Either String Task] -> IO [Either String Task]
readH l = do eof <- hIsEOF stdout
if eof
then l
else do line <- hGetLine stdout
l' <- l
readH.return $ (eitherDecodeStrict' line) : l'
out <- readH $ return []
First I want to point out the superfluous returns. In this code you never call readH without an accompanying return. The argument to readH can actually be pure by simply removing the unnecessary returns. Notice that we had to add return l on the then branch, and no longer have to "perform" l' <- l on the else branch.
let readH :: [Either String Task] -> IO [Either String Task]
readH l = do eof <- hIsEOF stdout
if eof
then return l
else do line <- hGetLine stdout
readH $ (eitherDecodeStrict' line) : l
out <- readH []
Okay, now I'm going to rename a few things for clarity and slightly reformat.
let -- how to check the stop condition
condition :: IO Bool
condition = hIsEOF stdout
let -- what IO to do at each iteration
takeOneStep :: IO ByteString
takeOneStep = hGetLine stdout
let -- what pure work to do at each iteration
pureTransform :: ByteString -> Either String Task
pureTransform = eitherDecodeStrict'
let readH :: [Either String Task] -> IO [Either String Task]
readH theRest = do
isDone <- condition
if isDone
then return theRest
else do
raw <- takeOneStep
readH (pureTransform raw : theRest)
out <- readH []
Make sure you understand how this version of the code is the same as the last version; it just has a few expressions renamed and factored out.
pureTransform is a bit of a red herring here. We can bundle it with takeOneStep instead.
let -- how to check the stop condition
condition :: IO Bool
condition = hIsEOF stdout
let -- what IO to do at each iteration
takeOneStep :: IO (Eiter String Task)
takeOneStep = do
line <- hGetLine stdout
return (eitherDecodeStrict' line)
let readH :: [Either String Task] -> IO [Either String Task]
readH theRest = do
isDone <- condition
if isDone
then return theRest
else do
thisStep <- takeOneStep
readH (thisStep : theRest)
out <- readH []
Re-read the body of readH at this point. Notice that none of it is specific to this particular task anymore. It now describes a general sort of looping over takeOneStep until condition holds. In fact, it had that generic structure the whole time! It's just that the generic structure can be seen now that we've renamed the task-specific bits. By making takeOneStep and condition arguments of the function, we arrive at the desired combinator.
untilIO :: IO Bool -> IO (Either String Task) -> [Either String Task] -> IO [Either String Task]
untilIO condition takeOneStep theRest = do
isDone <- condition
if isDone
then return theRest
else do
thisStep <- takeOneStep
untilIO (thisStep : theRest)
Notice that this combinator, as implemented, doesn't have to be constrained to Either String Task; it can work for any type a instead of Either String Task.
untilIO :: IO Bool -> IO a -> [a] -> IO [a]
Notice that this combinator, as implemented, doesn't have to even be constrained to IO. It can work for any Monad m instead of IO.
untilM :: Monad m => m Bool -> m a -> [a] -> m [a]
The moral of the story is this: by figuring how to write "looping over a monadic predicate" via explicit recursion for your particular use case, you have already written the general combinator! It's right there in the structure of your code, waiting to be discovered.
There are a couple ways this could be cleaned up further, such as removing the [] argument and building up the list in order (currently the list comes out reversed, you'll notice), but those are beyond the point I'm trying to make right now, and so are left as exercises to the reader. Assuming you've done both of those things, you end up with
untilM :: m Bool -> m a -> m [a]
Which I would use in your example like so:
(_, (Just stdout), _, _) <- createProcess (proc "task" (args fl)){ std_out = CreatePipe }
out <- untilM (hIsEof stdout) $ do
line <- hGetLine stdout
return (eitherDecodeStrict' line)
Looks a lot like an imperative-style "until" loop!
If you swap the argument order, then you end up with something nearly equivalent to Control.Monad.Loops.untilM. Note that unlike our solution here, Control.Monad.Loops.untilM (annoyingly!) always performs the action before checking the condition, so it's not quite safe for use in this case if you might be dealing with empty files. They apparently expect you to use untilM infix, which makes it look like a do-while, hence the flipped arguments and "body then condition" nonsense.
(do ...
...
) `untilM` someCondition