packages feed

monad-loops 0.3.3.0 → 0.4.3

raw patch · 5 files changed

Files

− 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.
+ Tests/test-monad-loops.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import Test.Tasty+import Test.Tasty.HUnit++import Control.Monad.Loops++testTakeWhileM :: Assertion+testTakeWhileM = do+    actual      <- takeWhileM (return . id) [True, True, False]+    let expected = takeWhile  (         id) [True, True, False]+    actual @?= expected++testTakeWhileMEdgeCase1 :: Assertion+testTakeWhileMEdgeCase1 = do+    actual      <- takeWhileM (return . id) []+    let expected = takeWhile  (         id) []+    actual @?= expected++testTakeWhileMEdgeCase2 :: Assertion+testTakeWhileMEdgeCase2 = do+    actual      <- takeWhileM (return . id) [False, False, False]+    let expected = takeWhile  (         id) [False, False, False]+    actual @?= expected++testTakeWhileMEdgeCase3 :: Assertion+testTakeWhileMEdgeCase3 = do+    let emptyList :: [Int] = []+    actual      <- takeWhileM (const undefined) emptyList+    let expected = takeWhile  (const undefined) emptyList+    actual @?= expected++tests :: TestTree+tests = testGroup "unit tests"+    [ testCase+        "Testing `takeWhileM`"+        testTakeWhileM+    , testCase+        "Testing `takeWhileM (edge case 1)`"+        testTakeWhileMEdgeCase1+    , testCase+        "Testing `takeWhileM (edge case 2)`"+        testTakeWhileMEdgeCase2+    , testCase+        "Testing `takeWhileM (edge case 3)`"+        testTakeWhileMEdgeCase3+    ]++main :: IO ()+main = defaultMain tests
monad-loops.cabal view
@@ -1,10 +1,9 @@ name:                   monad-loops-version:                0.3.3.0+version:                0.4.3 stability:              provisional-license:                BSD3-license-file:           LICENSE+license:                PublicDomain -cabal-version:          >= 1.6+cabal-version:          >= 1.8 build-type:             Simple  author:                 James Cook <mokus@deepbondi.net>@@ -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,26 @@   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+  if impl(ghc >= 7)+    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+    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+Test-Suite test-monad-loops+    type:       exitcode-stdio-1.0+    main-is:    Tests/test-monad-loops.hs+    if flag(base4)+      cpp-options:        -Dbase4+      build-depends:      base >= 4 && < 5, tasty, tasty-hunit, monad-loops+    else+      build-depends:      base >= 2 && < 4, tasty, tasty-hunit, monad-loops
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,15 +360,25 @@  -- |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                 then allM p xs                 else return False +-- | Monadic 'takeWhile'.+takeWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]+takeWhileM _ []     = return []+takeWhileM p (x:xs) = do+        q <- p x+        if q+                then (takeWhileM p xs) >>= (return . (:) x)+                else return []++-- | Monadic 'dropWhile'. 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 +394,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)