monad-loops 0.3.3.0 → 0.4.2
raw patch · 4 files changed
+33/−128 lines, 4 filesdep −stm
Dependencies removed: stm
Files
- LICENSE +0/−28
- monad-loops.cabal +6/−12
- src/Control/Monad/Loops.hs +27/−42
- src/Control/Monad/Loops/STM.hs +0/−46
− LICENSE
@@ -1,28 +0,0 @@-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:--1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.--2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE-POSSIBILITY OF SUCH DAMAGE.
monad-loops.cabal view
@@ -1,8 +1,7 @@ name: monad-loops-version: 0.3.3.0+version: 0.4.2 stability: provisional-license: BSD3-license-file: LICENSE+license: PublicDomain cabal-version: >= 1.6 build-type: Simple@@ -15,6 +14,9 @@ synopsis: Monadic loops description: Some useful control operators for looping. .+ New in 0.4: STM loop operators have been split into a+ new package instead of being conditionally-built.+ . New in 0.3.2.0: various functions for traversing lists and computing minima/maxima using arbitrary procedures to compare or score the elements.@@ -23,24 +25,16 @@ type: git location: git://github.com/mokus0/monad-loops.git -Flag useSTM- Description: Include instances for STM types- Default: True- Flag base4 Description: Build using base >= 4 Default: True Library hs-source-dirs: src+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing exposed-modules: Control.Monad.Loops if flag(base4) cpp-options: -Dbase4 build-depends: base >= 4 && <5 else build-depends: base >= 2 && < 4-- if flag(useSTM)- build-depends: stm- other-modules: Control.Monad.Loops.STM- cpp-options: -DuseSTM
src/Control/Monad/Loops.hs view
@@ -1,9 +1,4 @@-{-- - ``Control/Monad/Loops''- -}-{-# LANGUAGE- CPP- #-}+{-# LANGUAGE CPP #-} -- |A collection of loop operators for use in monads (mostly in stateful ones). -- @@ -21,9 +16,6 @@ module Control.Monad.Loops ( module Control.Monad.Loops-#ifdef useSTM- , module Control.Monad.Loops.STM-#endif ) where import Control.Monad@@ -35,12 +27,6 @@ #define SomeException Exception #endif -#ifdef useSTM-import Control.Monad.Loops.STM-#endif--import Data.Maybe (listToMaybe)- -- possibly-useful addition? : -- concatMapM :: (Monad m, Traversable f, Monoid w) => (a -> m w) -> (f a) -> m w @@ -90,7 +76,7 @@ -- in base >=4, need to nail down the type of 'handle' let handleAny :: (SomeException -> IO a) -> IO a -> IO a handleAny = handle- handleAny (\e -> return ()) $ do+ handleAny (\_ -> return ()) $ do f x return () putMVar mvar ()@@ -137,12 +123,7 @@ -- |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 = go- where go = do- y <- x- if p y- then go- else return y+iterateWhile p = iterateUntil (not . p) {-# SPECIALIZE iterateM_ :: (a -> IO a) -> a -> IO b #-} -- |Execute an action forever, feeding the result of each execution as the@@ -159,6 +140,7 @@ infixr 0 `untilM` infixr 0 `untilM'` infixr 0 `untilM_`+infixr 0 `iterateUntilM` -- |Execute an action repeatedly until the condition expression returns True. -- The condition is evaluated after the loop body. Collects results into a list.@@ -182,21 +164,24 @@ untilM_ :: (Monad m) => m a -> m Bool -> m () f `untilM_` p = f >> whileM_ (liftM not p) f -{-# SPECIALIZE whileJust :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}-{-# SPECIALIZE whileJust' :: Monad m => m (Maybe a) -> (a -> m b) -> m [b] #-}-{-# SPECIALIZE whileJust' :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}-{-# SPECIALIZE whileJust_ :: IO (Maybe a) -> (a -> IO b) -> IO () #-} +-- | Analogue of @('Prelude.until')@+-- Yields the result of applying f until p holds.+iterateUntilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a+iterateUntilM p f v + | p v = return v+ | otherwise = f v >>= iterateUntilM p f+ -- |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 = go- where go = do- y <- x- if p y- then return y- else go+iterateUntil p x = x >>= iterateUntilM p (const x) +{-# SPECIALIZE whileJust :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}+{-# SPECIALIZE whileJust' :: Monad m => m (Maybe a) -> (a -> m b) -> m [b] #-}+{-# SPECIALIZE whileJust' :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}+{-# SPECIALIZE whileJust_ :: IO (Maybe a) -> (a -> IO b) -> IO () #-}+ -- |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 collected into a list.@@ -298,13 +283,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 = go- where go = do+unfoldrM' f = go+ where go z = do x <- f z case x of Nothing -> return mzero- Just (x, z) -> do- xs <- go+ Just (x, z') -> do+ xs <- go z' return (return x `mplus` xs) {-# SPECIALIZE concatM :: [a -> IO a] -> (a -> IO a) #-}@@ -343,7 +328,7 @@ -- value presented against each predicate in turn until one passes, then -- returns True without any further processing. If none passes, returns False. anyPM :: (Monad m) => [a -> m Bool] -> (a -> m Bool)-anyPM [] x = return False+anyPM [] _ = return False anyPM (p:ps) x = do q <- p x if q@@ -354,7 +339,7 @@ -- presented against each predicate in turn until one fails, then returns False. -- if none fail, returns True. allPM :: (Monad m) => [a -> m Bool] -> (a -> m Bool)-allPM [] x = return True+allPM [] _ = return True allPM (p:ps) x = do q <- p x if q@@ -366,7 +351,7 @@ -- |short-circuit 'any' with a \"monadic predicate\". anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool-anyM p [] = return False+anyM _ [] = return False anyM p (x:xs) = do q <- p x if q@@ -375,7 +360,7 @@ -- |short-circuit 'all' with a \"monadic predicate\". allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool-allM p [] = return True+allM _ [] = return True allM p (x:xs) = do q <- p x if q@@ -383,7 +368,7 @@ else return False dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]-dropWhileM p [] = return []+dropWhileM _ [] = return [] dropWhileM p (x:xs) = do q <- p x if q@@ -399,7 +384,7 @@ -- |return the first value from a list, if any, satisfying the given predicate. firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)-firstM p [] = return Nothing+firstM _ [] = return Nothing firstM p (x:xs) = do q <- p x if q
− src/Control/Monad/Loops/STM.hs
@@ -1,46 +0,0 @@-{-- - ``Control/Monad/Loops/STM''- - (c) 2008 Cook, J. MR SSD, Inc.- -}--module Control.Monad.Loops.STM where--import Control.Concurrent-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 = go- where go = atomically x >> go---- |'atomLoop' with a 'forkIO'-forkAtomLoop :: STM a -> IO ThreadId-forkAtomLoop = forkIO . atomLoop---- |'Control.Concurrent.STM.retry' until the given condition is true of--- the given value. Then return the value that satisfied the condition.-waitFor :: (a -> Bool) -> STM a -> STM a-waitFor p events = do- event <- events- if p event- then return event- else retry---- |'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.--- Returns the winner.-waitForEvent :: (a -> Bool) -> TChan a -> STM a-waitForEvent p events = waitFor p (readTChan events)