fold-debounce-conduit 0.1.0.3 → 0.1.0.4

raw patch · 3 files changed

+32/−17 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• fold-debounce-conduit.cabal +1/−1
• test/Data/Conduit/FoldDebounceSpec.hs +26/−16

@@ -1,5 +1,10 @@ # Revision history for fold-debounce-conduit +## 0.1.0.4  -- 2016-10-10++* Make the tests more stable.++ ## 0.1.0.3  -- 2016-10-09  * Confirmed build with hspec-2.3.0

@@ -1,5 +1,5 @@ name:                   fold-debounce-conduit-version:                0.1.0.3+version:                0.1.0.4 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3

@@ -2,17 +2,18 @@  import Test.Hspec -import Data.Maybe (isJust)-import Data.Monoid (Monoid)+import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay, myThreadId)+import Control.Concurrent.STM (atomically, TVar, newTVarIO, writeTVar, readTVar, retry) import Control.Monad (forM_, void)-import System.Timeout (timeout)-import qualified Data.Conduit.FoldDebounce as F-import Data.Conduit (Source, ConduitM, ($$), yield, addCleanup) import Control.Monad.IO.Class (liftIO)-import qualified Data.Conduit.List as CL-import Control.Concurrent.STM (atomically, TVar, newTVarIO, writeTVar, readTVar) import Control.Monad.Trans.Resource (ResourceT, runResourceT, register)+import Data.Conduit (Source, ConduitM, ($$), yield, addCleanup)+import qualified Data.Conduit.FoldDebounce as F+import qualified Data.Conduit.List as CL+import Data.Maybe (isJust)+import Data.Monoid (Monoid)+import System.Timeout (timeout)  main :: IO () main = hspec spec@@ -47,6 +48,18 @@ debMonoid :: Monoid i => Int -> Source (ResourceT IO) i -> Source (ResourceT IO) i debMonoid delay = F.debounce F.forMonoid F.def { F.delay = delay } +shouldSatisfyEventually :: Int -> TVar a -> (a -> Bool) -> IO ()+shouldSatisfyEventually timeout_usec got predicate = do+  eventually_got <- timeout timeout_usec $ atomically $ doCheck+  fmap predicate eventually_got `shouldBe` Just True+  where+    doCheck = do+      ret <- readTVar got+      if predicate ret then return ret else retry++shouldSatisfyEventually' :: TVar a -> (a -> Bool) -> IO ()+shouldSatisfyEventually' = shouldSatisfyEventually 20000000+ spec :: Spec spec = do   describe "debounce" $ do@@ -65,9 +78,8 @@       let orig_source = detector $ periodicSource 10000 (repeat "a")       ret <- runResourceT $ debMonoid 50000 orig_source $$ CL.take 4       length ret `shouldBe` 4-      forM_ ret (`shouldContain` "aaa")-      threadDelay 20000-      atomically (readTVar terminated) `shouldReturn` True+      forM_ ret (`shouldContain` "a")+      terminated `shouldSatisfyEventually'` (== True)     it "should terminate the debounced Source gracefully if the original Source throws exception" $ do       -- For now, the exception in the original Source is not handled,       -- i.e., we just let it terminate the thread. So we'll see the@@ -83,8 +95,7 @@             _ <- error "Exception in retSink"             return taken       runResourceT (debMonoid 50000 orig_source $$ ret_sink) `shouldThrow` errorCall "Exception in retSink"-      threadDelay 20000-      atomically (readTVar terminated) `shouldReturn` True+      terminated `shouldSatisfyEventually'` (== True)     it "should connect the original Source in another thread" $ do       this_thread <- myThreadId       orig_thread_t <- newTVarIO Nothing@@ -101,7 +112,7 @@       (released, orig_source) <- attachResource $ periodicSource 10000 [1,2,3,4]       ret <- runResourceT $ debSum 500000 orig_source $$ CL.consume       ret `shouldBe` [10]-      atomically (readTVar released) `shouldReturn` True+      released `shouldSatisfyEventually'` (== True)     it "should release the resource in the original Source when the downstream Sink throws exception" $ do       (released, orig_source) <- attachResource $ periodicSource 10000 $ repeat "a"       let sink = do@@ -109,8 +120,7 @@             _ <- error "Exception in downstream"             return taken       runResourceT (debMonoid 500000 orig_source $$ sink) `shouldThrow` errorCall "Exception in downstream"-      threadDelay 20000-      atomically (readTVar released) `shouldReturn` True+      released `shouldSatisfyEventually'` (== True)     it "should release the resource in the original Source when the original Source throws exception" $ do       -- Because the error is not handled, we'll see the error message       -- while running the test. (See above for the case "original@@ -118,6 +128,6 @@       (released, orig_source) <- attachResource (periodicSource 10000 ["a", "b"] >> error "Exception in source")       ret <- runResourceT $ debMonoid 500000 orig_source $$ CL.consume       ret `shouldBe` ["ab"]-      atomically (readTVar released) `shouldReturn` True+      released `shouldSatisfyEventually'` (== True)