Merge pull request ndmitchell#59 from infinity0/master

Add whileJustM, untilJustM to Control.Monad.Extra

Author: ndmitchell

src/Control/Monad/Extra.hs

@@ -11,7 +11,7 @@ module Control.Monad.Extra(
     unit,
     maybeM, fromMaybeM, eitherM,
     -- * Loops
-    loop, loopM, whileM,
+    loop, loopM, whileM, whileJustM, untilJustM,
     -- * Lists
     partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM,
     fold1M, fold1M_,
@@ -160,6 +160,26 @@ whileM act = do
     b <- act
     when b $ whileM act
 
+-- | Keep running an operation until it becomes a 'Nothing', accumulating the
+--   monoid results inside the 'Just's as the result of the overall loop.
+whileJustM :: (Monad m, Monoid a) => m (Maybe a) -> m a
+whileJustM act = go mempty
+  where
+    go accum = do
+        res <- act
+        case res of
+            Nothing -> pure accum
+            Just r -> go $! (accum <> r) -- strict apply, otherwise space leaks
+
+-- | Keep running an operation until it becomes a 'Just', then return the value
+--   inside the 'Just' as the result of the overall loop.
+untilJustM :: Monad m => m (Maybe a) -> m a
+untilJustM act = do
+    res <- act
+    case res of
+        Just r  -> pure r
+        Nothing -> untilJustM act
+
 -- Booleans
 
 -- | Like 'when', but where the test can be monadic.

src/Extra.hs

@@ -14,7 +14,7 @@ module Extra {-# DEPRECATED "This module is provided as documentation of all new
     Partial, retry, retryBool, errorWithoutStackTrace, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,
     -- * Control.Monad.Extra
     -- | Extra functions available in @"Control.Monad.Extra"@.
-    whenJust, whenJustM, whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM, loop, loopM, whileM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,
+    whenJust, whenJustM, whenMaybe, whenMaybeM, unit, maybeM, fromMaybeM, eitherM, loop, loopM, whileM, whileJustM, untilJustM, partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM, fold1M, fold1M_, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,
     -- * Data.Either.Extra
     -- | Extra functions available in @"Data.Either.Extra"@.
     fromLeft, fromRight, fromEither, fromLeft', fromRight', eitherToMaybe, maybeToEither, mapLeft, mapRight,