packages feed

monad-loops 0.4.2.1 → 0.4.3

raw patch · 3 files changed

+74/−3 lines, 3 filesdep +monad-loopsdep +tastydep +tasty-hunitdep ~base

Dependencies added: monad-loops, tasty, tasty-hunit

Dependency ranges changed: base

Files

+ 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,9 +1,9 @@ name:                   monad-loops-version:                0.4.2.1+version:                0.4.3 stability:              provisional license:                PublicDomain -cabal-version:          >= 1.6+cabal-version:          >= 1.8 build-type:             Simple  author:                 James Cook <mokus@deepbondi.net>@@ -36,6 +36,15 @@   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++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
@@ -367,6 +367,16 @@                 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 _ []     = return [] dropWhileM p (x:xs) = do