monad-loops 0.3.0.2 → 0.3.1.0

raw patch · 3 files changed

+82/−35 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• monad-loops.cabal +2/−2
• src/Control/Monad/Loops.hs +72/−32
• src/Control/Monad/Loops/STM.hs +8/−1

@@ -1,5 +1,5 @@ name:                   monad-loops-version:                0.3.0.2+version:                0.3.1.0 stability:              provisional license:                BSD3 license-file:           LICENSE@@ -28,7 +28,7 @@   exposed-modules:      Control.Monad.Loops   if flag(base4)     cpp-options:        -Dbase4-    build-depends:      base >= 4+    build-depends:      base >= 4 && <5   else     build-depends:      base < 4 

@@ -111,12 +111,13 @@ -- returns True. The condition is evaluated before the loop body. -- Collects the results into an arbitrary 'MonadPlus' value. whileM' :: (Monad m, MonadPlus f) => m Bool -> m a -> m (f a)-whileM' p f = do-        x <- p-        if x+whileM' p f = go+    where go = do+            x <- p+            if x                 then do                         x  <- f-                        xs <- whileM' p f+                        xs <- go                         return (return x `mplus` xs)                 else return mzero @@ -124,22 +125,22 @@ -- returns True.  The condition is evaluated before the loop body. -- Discards results. whileM_ :: (Monad m) => m Bool -> m a -> m ()-whileM_ p f = do-        x <- p-        if x-                then do-                        f-                        whileM_ p f+whileM_ p f = go+    where go = do+            x <- p+            if x+                then f >> go                 else return ()  -- |Execute an action repeatedly until its result fails to satisfy a predicate, -- and return that result (discarding all others). iterateWhile :: Monad m => (a -> Bool) -> m a -> m a-iterateWhile p x = do-    y <- x-    if p y-        then iterateWhile p x-        else return y+iterateWhile p x = go+    where go = do+                y <- x+                if p y+                    then go+                    else return y  {-# SPECIALIZE untilM  :: IO a -> IO Bool -> IO [a] #-} {-# SPECIALIZE untilM' :: Monad m => m a -> m Bool -> m [a] #-}@@ -180,11 +181,12 @@ -- |Execute an action repeatedly until its result satisfies a predicate, -- and return that result (discarding all others). iterateUntil :: Monad m => (a -> Bool) -> m a -> m a-iterateUntil p x = do-    y <- x-    if p y-        then return y-        else iterateUntil p x+iterateUntil p x = go+    where go = do+            y <- x+            if p y+                then return y+                else go  -- |As long as the supplied "Maybe" expression returns "Just _", the loop -- body will be called and passed the value contained in the 'Just'.  Results@@ -196,27 +198,40 @@ -- body will be called and passed the value contained in the 'Just'.  Results -- are collected into an arbitrary MonadPlus container. whileJust' :: (Monad m, MonadPlus f) => m (Maybe a) -> (a -> m b) -> m (f b)-whileJust' p f = do-        x <- p-        case x of+whileJust' p f = go+    where go = do+            x <- p+            case x of                 Nothing -> return mzero                 Just x  -> do                         x  <- f x-                        xs <- whileJust' p f+                        xs <- go                         return (return x `mplus` xs)  -- |As long as the supplied "Maybe" expression returns "Just _", the loop -- body will be called and passed the value contained in the 'Just'.  Results -- are discarded. whileJust_ :: (Monad m) => m (Maybe a) -> (a -> m b) -> m ()-whileJust_ p f = do-        x <- p-        case x of+whileJust_ p f = go+    where go = do+            x <- p+            case x of                 Nothing -> return ()                 Just x  -> do                         f x-                        whileJust_ p f+                        go +-- |Run the supplied "Maybe" computation repeatedly until it returns a+-- value.  Returns that value.+untilJust :: Monad m => m (Maybe a) -> m a+untilJust m = go+    where+        go = do+            x <- m+            case x of+                Nothing -> go+                Just x  -> return x+ {-# SPECIALIZE unfoldM  :: IO (Maybe a) -> IO [a] #-} {-# SPECIALIZE unfoldM' :: (Monad m) => m (Maybe a) -> m [a] #-} {-# SPECIALIZE unfoldM' :: IO (Maybe a) -> IO [a] #-}@@ -238,6 +253,30 @@ unfoldM_ :: (Monad m) => m (Maybe a) -> m () unfoldM_ m = whileJust_ m return +-- |Repeatedly evaluates the second argument until the value satisfies+-- the given predicate, and returns a list of all values that satisfied the+-- predicate.  Discards the final one (which failed the predicate).+unfoldWhileM :: Monad m => (a -> Bool) -> m a -> m [a]+unfoldWhileM p m = loop id+    where+        loop f = do+            x <- m+            if p x+                then loop (f . (x:))+                else return (f [])++-- |Repeatedly evaluates the second argument until the value satisfies+-- the given predicate, and returns a 'MonadPlus' collection of all values+-- that satisfied the predicate.  Discards the final one (which failed the predicate).+unfoldWhileM' :: (Monad m, MonadPlus f) => (a -> Bool) -> m a -> m (f a)+unfoldWhileM' p m = loop mzero+    where+        loop xs = do+            x <- m+            if p x+                then loop (xs `mplus` return x)+                else return xs+ {-# SPECIALIZE unfoldrM  :: (a -> IO (Maybe (b,a))) -> a -> IO [b] #-} {-# SPECIALIZE unfoldrM' :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b] #-} {-# SPECIALIZE unfoldrM' :: (a -> IO (Maybe (b,a))) -> a -> IO [b] #-}@@ -250,12 +289,13 @@ -- twist.  Rather than returning a list, it returns any MonadPlus type of your -- choice. unfoldrM' :: (Monad m, MonadPlus f) => (a -> m (Maybe (b,a))) -> a -> m (f b)-unfoldrM' f z = do-        x <- f z-        case x of+unfoldrM' f z = go+    where go = do+            x <- f z+            case x of                 Nothing         -> return mzero                 Just (x, z)     -> do-                        xs <- unfoldrM' f z+                        xs <- go                         return (return x `mplus` xs)  {-# SPECIALIZE concatM :: [a -> IO a] -> (a -> IO a) #-}

@@ -9,11 +9,13 @@ import Control.Concurrent.STM  import Control.Monad (forever) -- for the benefit of haddock+import Data.Maybe  -- |'Control.Monad.forever' and 'Control.Concurrent.STM.atomically' rolled -- into one. atomLoop :: STM a -> IO ()-atomLoop x = atomically x >> atomLoop x+atomLoop x = go+    where go = atomically x >> go  -- |'atomLoop' with a 'forkIO' forkAtomLoop :: STM a -> IO ThreadId@@ -31,6 +33,11 @@ -- |'Control.Concurrent.STM.retry' until the given value is True. waitForTrue :: STM Bool -> STM () waitForTrue p = waitFor id p >> return ()++-- |'Control.Concurrent.STM.retry' until the given value is 'Just' _, returning+-- the contained value.+waitForJust :: STM (Maybe a) -> STM a+waitForJust m = fmap fromJust (waitFor isJust m)  -- |'waitFor' a value satisfying a condition to come out of a -- 'Control.Concurrent.STM.TChan', reading and discarding everything else.