bf81f70 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

lint free tests

bf81f70Harendra Kumar8 years ago

test/Main.hs+101−103

compare with master

unifiedsplit

@@ -178,10 +178,10 @@ checkCleanupFold t op = do

178testFoldOpsCleanup :: String -> (SerialT IO Int -> IO a) -> Spec

179testFoldOpsCleanup name f = do

180 let testOp op x = op x >> return Nothing

181− it (name ++ " asyncly") $ checkCleanupFold asyncly (testOp f)

181+ it (name <> " asyncly") $ checkCleanupFold asyncly (testOp f)

182− it (name ++ " wAsyncly") $ checkCleanupFold wAsyncly (testOp f)

182+ it (name <> " wAsyncly") $ checkCleanupFold wAsyncly (testOp f)

183− it (name ++ " aheadly") $ checkCleanupFold aheadly (testOp f)

183+ it (name <> " aheadly") $ checkCleanupFold aheadly (testOp f)

184− it (name ++ " parallely") $ checkCleanupFold parallely (testOp f)

184+ it (name <> " parallely") $ checkCleanupFold parallely (testOp f)

185#endif

186

187parallelTests :: SpecWith ()

@@ -194,9 +194,9 @@ parallelTests = H.parallel $ do

194 it "simple serially with IO" $

195 (runStream . serially) (S.yieldM $ putStrLn "hello") `shouldReturn` ()

196

197− describe "Empty" $ do

197+ describe "Empty" $ -- do

198 it "Monoid - mempty" $

199− (toListSerial mempty) `shouldReturn` ([] :: [Int])

199+ toListSerial mempty `shouldReturn` ([] :: [Int])

200 -- it "Alternative - empty" $

201 -- (toListSerial empty) `shouldReturn` ([] :: [Int])

202 -- it "MonadPlus - mzero" $

@@ -210,11 +210,11 @@ parallelTests = H.parallel $ do

210 -- XXX we should do these through property tests by using a

211 -- construction via list fold construction method.

212 it "fmap on composed (<>)" $

213− (toListSerial $ fmap (+1) (return 1 <> return 2))

213+ toListSerial (fmap (+1) (return 1 <> return 2))

214 `shouldReturn` ([2,3] :: [Int])

215

216 it "fmap on composed (<>)" $

217− ((toListParallel $ fmap (+1) (return 1 <> return 2)) >>= return . sort)

217+ sort <$> toListParallel (fmap (+1) (return 1 <> return 2))

218 `shouldReturn` ([2,3] :: [Int])

219

220 ---------------------------------------------------------------------------

@@ -225,19 +225,19 @@ parallelTests = H.parallel $ do

225 -- XXX we should do these through property tests by using a

226 -- construction via list fold construction method.

227 it "Apply - serial composed first argument" $

228− (toListSerial $ (,) <$> (return 1 <> return 2) <*> (return 3))

228+ toListSerial ((,) <$> (return 1 <> return 2) <*> return 3)

229 `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])

230

231 it "Apply - serial composed second argument" $

232− (toListSerial $ (,) <$> (return 1) <*> (return 2 <> return 3))

232+ toListSerial ((,) <$> return 1 <*> (return 2 <> return 3))

233 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])

234

235 it "Apply - parallel composed first argument" $

236− (toListParallel ((,) <$> (return 1 <> return 2) <*> (return 3)) >>= return . sort)

236+ sort <$> toListParallel ((,) <$> (return 1 <> return 2) <*> return 3)

237 `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])

238

239 it "Apply - parallel composed second argument" $

240− (toListParallel ((,) <$> (return 1) <*> (return 2 <> return 3)) >>= return . sort)

240+ sort <$> toListParallel ((,) <$> return 1 <*> (return 2 <> return 3))

241 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])

242

243 ---------------------------------------------------------------------------

@@ -259,37 +259,41 @@ parallelTests = H.parallel $ do

259 ---------------------------------------------------------------------------

260

261 -- TBD need more such combinations to be tested.

262+ describe "serial <> and serial <>" $

262− describe "serial <> and serial <>" $ composeAndComposeSimple serially serially (cycle [[1 .. 9]])

263+ composeAndComposeSimple serially serially (repeat [1 .. 9])

264+ describe "ahead <> and ahead <>" $

263− describe "ahead <> and ahead <>" $ composeAndComposeSimple aheadly aheadly (cycle [[1 .. 9]])

265+ composeAndComposeSimple aheadly aheadly (repeat [1 .. 9])

266+ describe "ahead <> and serial <>" $

264− describe "ahead <> and serial <>" $ composeAndComposeSimple aheadly serially (cycle [[1 .. 9]])

267+ composeAndComposeSimple aheadly serially (repeat [1 .. 9])

268+ describe "serial <> and ahead <>" $

265− describe "serial <> and ahead <>" $ composeAndComposeSimple serially aheadly (cycle [[1 .. 9]])

269+ composeAndComposeSimple serially aheadly (repeat [1 .. 9])

266

270

267 describe "<> and <=>" $ composeAndComposeSimple

271 describe "<> and <=>" $ composeAndComposeSimple

268 serially

272 serially

269 wSerially

273 wSerially

270− ([ [1 .. 9]

274+ [ [1 .. 9]

271 , [1 .. 9]

275 , [1 .. 9]

272 , [1, 3, 2, 4, 6, 5, 7, 9, 8]

276 , [1, 3, 2, 4, 6, 5, 7, 9, 8]

273 , [1, 3, 2, 4, 6, 5, 7, 9, 8]

277 , [1, 3, 2, 4, 6, 5, 7, 9, 8]

274− ])

278+ ]

275

279

276 describe "<=> and <=>" $ composeAndComposeSimple

280 describe "<=> and <=>" $ composeAndComposeSimple

277 wSerially

281 wSerially

278 wSerially

282 wSerially

279− ([ [1, 4, 2, 7, 3, 5, 8, 6, 9]

283+ [ [1, 4, 2, 7, 3, 5, 8, 6, 9]

280 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

284 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

281 , [1, 4, 3, 7, 2, 6, 9, 5, 8]

285 , [1, 4, 3, 7, 2, 6, 9, 5, 8]

282 , [1, 7, 4, 9, 3, 8, 6, 2, 5]

286 , [1, 7, 4, 9, 3, 8, 6, 2, 5]

283− ])

287+ ]

284

288

285 describe "<=> and <>" $ composeAndComposeSimple

289 describe "<=> and <>" $ composeAndComposeSimple

286 wSerially

290 wSerially

287 serially

291 serially

288− ([ [1, 4, 2, 7, 3, 5, 8, 6, 9]

292+ [ [1, 4, 2, 7, 3, 5, 8, 6, 9]

289 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

293 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

290 , [1, 4, 2, 7, 3, 5, 8, 6, 9]

294 , [1, 4, 2, 7, 3, 5, 8, 6, 9]

291 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

295 , [1, 7, 4, 8, 2, 9, 5, 3, 6]

292− ])

296+ ]

293

297

294 ---------------------------------------------------------------------------

298 ---------------------------------------------------------------------------

295 -- Monoidal composition recursion loops

299 -- Monoidal composition recursion loops

@@ -514,7 +518,7 @@ takeCombined :: (Monad m, Semigroup (t m Int), Show a, Eq a, IsStream t)

514takeCombined n t = do

518takeCombined n t = do

515 let constr = S.fromFoldable

519 let constr = S.fromFoldable

516 r <- (S.toList . t) $

520 r <- (S.toList . t) $

517− S.take n ((constr ([] :: [Int])) <> constr ([] :: [Int]))

521+ S.take n (constr ([] :: [Int]) <> constr ([] :: [Int]))

518 r `shouldBe` []

522 r `shouldBe` []

519

523

520checkFoldxStrictness :: IO ()

524checkFoldxStrictness :: IO ()

@@ -575,12 +579,10 @@ checkScanl'Strictness = do

575 `shouldReturn` "success"

579 `shouldReturn` "success"

576

580

577foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()

581foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()

578−foldlM'StrictCheck ref s =

579− S.foldlM' (\_ _ -> writeIORef ref 1) () s

582+foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) ()

580

583

581foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()

584foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()

582−foldxMStrictCheck ref s =

583− S.foldxM (\_ _ -> writeIORef ref 1) (return ()) return s

585+foldxMStrictCheck ref = S.foldxM (\_ _ -> writeIORef ref 1) (return ()) return

584

586

585checkFoldMStrictness :: (IORef Int -> SerialT IO Int -> IO ()) -> IO ()

587checkFoldMStrictness :: (IORef Int -> SerialT IO Int -> IO ()) -> IO ()

586checkFoldMStrictness f = do

588checkFoldMStrictness f = do

@@ -590,8 +592,7 @@ checkFoldMStrictness f = do

590 readIORef ref `shouldReturn` 1

592 readIORef ref `shouldReturn` 1

591

593

592scanlM'StrictCheck :: IORef Int -> SerialT IO Int -> SerialT IO ()

594scanlM'StrictCheck :: IORef Int -> SerialT IO Int -> SerialT IO ()

593−scanlM'StrictCheck ref s =

594− S.scanlM' (\_ _ -> writeIORef ref 1) () s

595+scanlM'StrictCheck ref = S.scanlM' (\_ _ -> writeIORef ref 1) ()

595

596

596checkScanlMStrictness :: (IORef Int -> SerialT IO Int -> SerialT IO ()) -> IO ()

597checkScanlMStrictness :: (IORef Int -> SerialT IO Int -> SerialT IO ()) -> IO ()

597checkScanlMStrictness f = do

598checkScanlMStrictness f = do

@@ -601,17 +602,16 @@ checkScanlMStrictness f = do

601 readIORef ref `shouldReturn` 1

602 readIORef ref `shouldReturn` 1

602

603

603takeInfinite :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec

604takeInfinite :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec

604−takeInfinite t = do

605+takeInfinite t =

605 it "take 1" $

606 it "take 1" $

606− (runStream $ t $

607− S.take 1 $ S.repeatM (print "hello" >> return (1::Int)))

607+ runStream (t $ S.take 1 $ S.repeatM (print "hello" >> return (1::Int)))

608 `shouldReturn` ()

609

610-- XXX need to test that we have promptly cleaned up everything after the error

611-- XXX We can also check the output that we are expected to get before the

612-- error occurs.

613

614−data ExampleException = ExampleException String deriving (Eq, Show)

614+newtype ExampleException = ExampleException String deriving (Eq, Show)

615

616instance Exception ExampleException

617

@@ -624,11 +624,11 @@ simpleMonadError = do

624 it "simple runExceptT with error" $ do

625 (runExceptT $ runStream $ throwError "E") `shouldReturn` Left "E"

626 -}

627− it "simple try" $ do

627+ it "simple try" $

628− (try $ runStream $ return ())

628+ try (runStream $ return ())

629 `shouldReturn` (Right () :: Either ExampleException ())

630− it "simple try with throw error" $ do

630+ it "simple try with throw error" $

631− (try $ runStream $ throwM $ ExampleException "E")

631+ try (runStream $ throwM $ ExampleException "E")

632 `shouldReturn` (Left (ExampleException "E") :: Either ExampleException ())

633

634composeWithMonadThrow

@@ -639,10 +639,10 @@ composeWithMonadThrow

639 => (t IO Int -> SerialT IO Int) -> Spec

640composeWithMonadThrow t = do

641 it "Compose throwM, nil" $

642− (try $ tl (throwM (ExampleException "E") <> S.nil))

642+ try (tl (throwM (ExampleException "E") <> S.nil))

643 `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])

644 it "Compose nil, throwM" $

645− (try $ tl (S.nil <> throwM (ExampleException "E")))

645+ try (tl (S.nil <> throwM (ExampleException "E")))

646 `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])

647 oneLevelNestedSum "serially" serially

648 oneLevelNestedSum "wSerially" wSerially

@@ -658,20 +658,20 @@ composeWithMonadThrow t = do

658 where

659 tl = S.toList . t

660 oneLevelNestedSum desc t1 =

661− it ("One level nested sum " ++ desc) $ do

661+ it ("One level nested sum " <> desc) $ do

662− let nested = (S.fromFoldable [1..10] <> throwM (ExampleException "E")

662+ let nested = S.fromFoldable [1..10] <> throwM (ExampleException "E")

663− <> S.fromFoldable [1..10])

663+ <> S.fromFoldable [1..10]

664− (try $ tl (S.nil <> t1 nested <> S.fromFoldable [1..10]))

664+ try (tl (S.nil <> t1 nested <> S.fromFoldable [1..10]))

665 `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])

666

667 oneLevelNestedProduct desc t1 =

668− it ("One level nested product" ++ desc) $ do

668+ it ("One level nested product" <> desc) $ do

669 let s1 = t $ foldMapWith (<>) return [1..4]

670 s2 = t1 $ foldMapWith (<>) return [5..8]

671 try $ tl (do

672 x <- adapt s1

673 y <- s2

674− if (x + y > 10)

674+ if x + y > 10

675 then throwM (ExampleException "E")

676 else return (x + y)

677 )

@@ -686,9 +686,9 @@ _composeWithMonadError

686_composeWithMonadError t = do

687 let tl = S.toList . t

688 it "Compose throwError, nil" $

689− (runExceptT $ tl (throwError "E" <> S.nil)) `shouldReturn` Left "E"

689+ runExceptT (tl (throwError "E" <> S.nil)) `shouldReturn` Left "E"

690 it "Compose nil, error" $

691− (runExceptT $ tl (S.nil <> throwError "E")) `shouldReturn` Left "E"

691+ runExceptT (tl (S.nil <> throwError "E")) `shouldReturn` Left "E"

692

693nestTwoSerial :: Expectation

694nestTwoSerial =

@@ -745,54 +745,51 @@ nestTwoAsync :: Expectation

745nestTwoAsync =

746 let s1 = foldMapWith (<>) return [1..4]

747 s2 = foldMapWith (<>) return [5..8]

748− in (toListAsync (do

748+ in sort <$> toListAsync (do

749 x <- s1

750 y <- s2

751− return (x + y)

751+ return (x + y))

752− ) >>= return . sort)

753 `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])

752 `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])

754

753

755nestTwoAsyncApp :: Expectation

754nestTwoAsyncApp :: Expectation

756nestTwoAsyncApp =

755nestTwoAsyncApp =

757 let s1 = foldMapWith (<>) return [1..4]

756 let s1 = foldMapWith (<>) return [1..4]

758 s2 = foldMapWith (<>) return [5..8]

757 s2 = foldMapWith (<>) return [5..8]

759− in (toListAsync ((+) <$> s1 <*> s2) >>= return . sort)

758+ in sort <$> toListAsync ((+) <$> s1 <*> s2)

760 `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])

759 `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])

761

760

762nestTwoWAsync :: Expectation

761nestTwoWAsync :: Expectation

763nestTwoWAsync =

762nestTwoWAsync =

764 let s1 = foldMapWith (<>) return [1..4]

763 let s1 = foldMapWith (<>) return [1..4]

765 s2 = foldMapWith (<>) return [5..8]

764 s2 = foldMapWith (<>) return [5..8]

766− in ((S.toList . wAsyncly) (do

765+ in sort <$> (S.toList . wAsyncly) (do

767 x <- s1

766 x <- s1

768 y <- s2

767 y <- s2

769− return (x + y)

768+ return (x + y))

770− ) >>= return . sort)

771 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

769 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

772

770

773nestTwoParallel :: Expectation

771nestTwoParallel :: Expectation

774nestTwoParallel =

772nestTwoParallel =

775 let s1 = foldMapWith (<>) return [1..4]

773 let s1 = foldMapWith (<>) return [1..4]

776 s2 = foldMapWith (<>) return [5..8]

774 s2 = foldMapWith (<>) return [5..8]

777− in ((S.toList . parallely) (do

775+ in sort <$> (S.toList . parallely) (do

778 x <- s1

776 x <- s1

779 y <- s2

777 y <- s2

780− return (x + y)

778+ return (x + y))

781− ) >>= return . sort)

782 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

779 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

783

780

784nestTwoWAsyncApp :: Expectation

781nestTwoWAsyncApp :: Expectation

785nestTwoWAsyncApp =

782nestTwoWAsyncApp =

786 let s1 = foldMapWith (<>) return [1..4]

783 let s1 = foldMapWith (<>) return [1..4]

787 s2 = foldMapWith (<>) return [5..8]

784 s2 = foldMapWith (<>) return [5..8]

788− in ((S.toList . wAsyncly) ((+) <$> s1 <*> s2) >>= return . sort)

785+ in sort <$> (S.toList . wAsyncly) ((+) <$> s1 <*> s2)

789 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

786 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

790

787

791nestTwoParallelApp :: Expectation

788nestTwoParallelApp :: Expectation

792nestTwoParallelApp =

789nestTwoParallelApp =

793 let s1 = foldMapWith (<>) return [1..4]

790 let s1 = foldMapWith (<>) return [1..4]

794 s2 = foldMapWith (<>) return [5..8]

791 s2 = foldMapWith (<>) return [5..8]

795− in ((S.toList . parallely) ((+) <$> s1 <*> s2) >>= return . sort)

792+ in sort <$> (S.toList . parallely) ((+) <$> s1 <*> s2)

796 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

793 `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])

797

794

798interleaveCheck :: IsStream t

795interleaveCheck :: IsStream t

@@ -802,7 +799,7 @@ interleaveCheck :: IsStream t

802interleaveCheck t f =

799interleaveCheck t f =

803 it "Interleave four" $

800 it "Interleave four" $

804 (S.toList . t) ((singleton 0 `f` singleton 1) `f` (singleton 100 `f` singleton 101))

801 (S.toList . t) ((singleton 0 `f` singleton 1) `f` (singleton 100 `f` singleton 101))

805− `shouldReturn` ([0, 100, 1, 101])

802+ `shouldReturn` [0, 100, 1, 101]

806

803

807parallelCheck :: (IsStream t, Monad (t IO))

804parallelCheck :: (IsStream t, Monad (t IO))

808 => (t IO Int -> SerialT IO Int)

805 => (t IO Int -> SerialT IO Int)

@@ -811,45 +808,45 @@ parallelCheck :: (IsStream t, Monad (t IO))

811parallelCheck t f = do

808parallelCheck t f = do

812 it "Parallel ordering left associated" $

809 it "Parallel ordering left associated" $

813 (S.toList . t) (((event 4 `f` event 3) `f` event 2) `f` event 1)

810 (S.toList . t) (((event 4 `f` event 3) `f` event 2) `f` event 1)

814− `shouldReturn` ([1..4])

811+ `shouldReturn` [1..4]

815

812

816 it "Parallel ordering right associated" $

813 it "Parallel ordering right associated" $

817 (S.toList . t) (event 4 `f` (event 3 `f` (event 2 `f` event 1)))

814 (S.toList . t) (event 4 `f` (event 3 `f` (event 2 `f` event 1)))

818− `shouldReturn` ([1..4])

815+ `shouldReturn` [1..4]

819

816

820− where event n = (S.yieldM $ threadDelay (n * 200000)) >> (return n)

817+ where event n = S.yieldM (threadDelay (n * 200000)) >> return n

821

818

822compose :: (IsStream t, Semigroup (t IO Int))

819compose :: (IsStream t, Semigroup (t IO Int))

823 => (t IO Int -> SerialT IO Int) -> t IO Int -> ([Int] -> [Int]) -> Spec

820 => (t IO Int -> SerialT IO Int) -> t IO Int -> ([Int] -> [Int]) -> Spec

824compose t z srt = do

821compose t z srt = do

825 -- XXX these should get covered by the property tests

822 -- XXX these should get covered by the property tests

826 it "Compose mempty, mempty" $

823 it "Compose mempty, mempty" $

827− (tl (z <> z)) `shouldReturn` ([] :: [Int])

824+ tl (z <> z) `shouldReturn` ([] :: [Int])

828 it "Compose empty at the beginning" $

825 it "Compose empty at the beginning" $

829− (tl $ (z <> singleton 1)) `shouldReturn` [1]

826+ tl (z <> singleton 1) `shouldReturn` [1]

830 it "Compose empty at the end" $

827 it "Compose empty at the end" $

831− (tl $ (singleton 1 <> z)) `shouldReturn` [1]

828+ tl (singleton 1 <> z) `shouldReturn` [1]

832 it "Compose two" $

829 it "Compose two" $

833− (tl (singleton 0 <> singleton 1) >>= return . srt)

830+ srt <$> tl (singleton 0 <> singleton 1)

834 `shouldReturn` [0, 1]

831 `shouldReturn` [0, 1]

835 it "Compose many" $

832 it "Compose many" $

836− ((tl $ forEachWith (<>) [1..100] singleton) >>= return . srt)

833+ srt <$> tl (forEachWith (<>) [1..100] singleton)

837 `shouldReturn` [1..100]

834 `shouldReturn` [1..100]

838

835

839 -- These are not covered by the property tests

836 -- These are not covered by the property tests

840 it "Compose three - empty in the middle" $

837 it "Compose three - empty in the middle" $

841− ((tl $ (singleton 0 <> z <> singleton 1)) >>= return . srt)

838+ srt <$> tl (singleton 0 <> z <> singleton 1)

842 `shouldReturn` [0, 1]

839 `shouldReturn` [0, 1]

843 it "Compose left associated" $

840 it "Compose left associated" $

844− ((tl $ (((singleton 0 <> singleton 1) <> singleton 2) <> singleton 3))

841+ srt <$> tl (((singleton 0 <> singleton 1) <> singleton 2) <> singleton 3)

845− >>= return . srt) `shouldReturn` [0, 1, 2, 3]

842+ `shouldReturn` [0, 1, 2, 3]

846 it "Compose right associated" $

843 it "Compose right associated" $

847− ((tl $ (singleton 0 <> (singleton 1 <> (singleton 2 <> singleton 3))))

844+ srt <$> tl (singleton 0 <> (singleton 1 <> (singleton 2 <> singleton 3)))

848− >>= return . srt) `shouldReturn` [0, 1, 2, 3]

845+ `shouldReturn` [0, 1, 2, 3]

849 it "Compose hierarchical (multiple levels)" $

846 it "Compose hierarchical (multiple levels)" $

850− ((tl $ (((singleton 0 <> singleton 1) <> (singleton 2 <> singleton 3))

847+ srt <$> tl (((singleton 0 <> singleton 1) <> (singleton 2 <> singleton 3))

851 <> ((singleton 4 <> singleton 5) <> (singleton 6 <> singleton 7)))

848 <> ((singleton 4 <> singleton 5) <> (singleton 6 <> singleton 7)))

852− ) >>= return . srt) `shouldReturn` [0..7]

849+ `shouldReturn` [0..7]

853 where tl = S.toList . t

850 where tl = S.toList . t

854

851

855composeAndComposeSimple

852composeAndComposeSimple

@@ -865,20 +862,20 @@ composeAndComposeSimple

865composeAndComposeSimple t1 t2 answer = do

862composeAndComposeSimple t1 t2 answer = do

866 let rfold = adapt . t2 . foldMapWith (<>) return

863 let rfold = adapt . t2 . foldMapWith (<>) return

867 it "Compose right associated outer expr, right folded inner" $

864 it "Compose right associated outer expr, right folded inner" $

868− ((S.toList . t1) (rfold [1,2,3] <> (rfold [4,5,6] <> rfold [7,8,9])))

865+ (S.toList . t1) (rfold [1,2,3] <> (rfold [4,5,6] <> rfold [7,8,9]))

869− `shouldReturn` (answer !! 0)

866+ `shouldReturn` head answer

870

867

871 it "Compose left associated outer expr, right folded inner" $

868 it "Compose left associated outer expr, right folded inner" $

872− ((S.toList . t1) ((rfold [1,2,3] <> rfold [4,5,6]) <> rfold [7,8,9]))

869+ (S.toList . t1) ((rfold [1,2,3] <> rfold [4,5,6]) <> rfold [7,8,9])

873 `shouldReturn` (answer !! 1)

870 `shouldReturn` (answer !! 1)

874

871

875− let lfold xs = adapt $ t2 $ foldl (<>) mempty $ map return xs

872+ let lfold xs = adapt $ t2 $ foldl (<>) mempty $ fmap return xs

876 it "Compose right associated outer expr, left folded inner" $

873 it "Compose right associated outer expr, left folded inner" $

877− ((S.toList . t1) (lfold [1,2,3] <> (lfold [4,5,6] <> lfold [7,8,9])))

874+ (S.toList . t1) (lfold [1,2,3] <> (lfold [4,5,6] <> lfold [7,8,9]))

878 `shouldReturn` (answer !! 2)

875 `shouldReturn` (answer !! 2)

879

876

880 it "Compose left associated outer expr, left folded inner" $

877 it "Compose left associated outer expr, left folded inner" $

881− ((S.toList . t1) ((lfold [1,2,3] <> lfold [4,5,6]) <> lfold [7,8,9]))

878+ (S.toList . t1) ((lfold [1,2,3] <> lfold [4,5,6]) <> lfold [7,8,9])

882 `shouldReturn` (answer !! 3)

879 `shouldReturn` (answer !! 3)

883

880

884loops

881loops

@@ -888,10 +885,10 @@ loops

888 -> ([Int] -> [Int])

885 -> ([Int] -> [Int])

889 -> Spec

886 -> Spec

890loops t tsrt hsrt = do

887loops t tsrt hsrt = do

891− it "Tail recursive loop" $ ((S.toList . adapt) (loopTail 0) >>= return . tsrt)

888+ it "Tail recursive loop" $ (tsrt <$> (S.toList . adapt) (loopTail 0))

892 `shouldReturn` [0..3]

889 `shouldReturn` [0..3]

893

890

894− it "Head recursive loop" $ ((S.toList . adapt) (loopHead 0) >>= return . hsrt)

891+ it "Head recursive loop" $ (hsrt <$> (S.toList . adapt) (loopHead 0))

895 `shouldReturn` [0..3]

892 `shouldReturn` [0..3]

896

893

897 where

894 where

@@ -913,13 +910,14 @@ bindAndComposeSimple

913bindAndComposeSimple t1 t2 = do

910bindAndComposeSimple t1 t2 = do

914 -- XXX need a bind in the body of forEachWith instead of a simple return

911 -- XXX need a bind in the body of forEachWith instead of a simple return

915 it "Compose many (right fold) with bind" $

912 it "Compose many (right fold) with bind" $

913+ (sort <$> (S.toList . t1)

916− ((S.toList . t1) (adapt . t2 $ forEachWith (<>) [1..10 :: Int] return)

914+ (adapt . t2 $ forEachWith (<>) [1..10 :: Int] return))

917− >>= return . sort) `shouldReturn` [1..10]

915+ `shouldReturn` [1..10]

918

916

919 it "Compose many (left fold) with bind" $

917 it "Compose many (left fold) with bind" $

920− let forL xs k = foldl (<>) nil $ map k xs

918+ let forL xs k = foldl (<>) nil $ fmap k xs

921− in ((S.toList . t1) (adapt . t2 $ forL [1..10 :: Int] return)

919+ in (sort <$> (S.toList . t1) (adapt . t2 $ forL [1..10 :: Int] return))

922− >>= return . sort) `shouldReturn` [1..10]

920+ `shouldReturn` [1..10]

923

921

924bindAndComposeHierarchy

922bindAndComposeHierarchy

925 :: ( IsStream t1, Monad (t1 IO)

923 :: ( IsStream t1, Monad (t1 IO)

@@ -928,16 +926,16 @@ bindAndComposeHierarchy

928 -> (t2 IO Int -> t2 IO Int)

926 -> (t2 IO Int -> t2 IO Int)

929 -> ([t2 IO Int] -> t2 IO Int)

927 -> ([t2 IO Int] -> t2 IO Int)

930 -> Spec

928 -> Spec

931−bindAndComposeHierarchy t1 t2 g = do

929+bindAndComposeHierarchy t1 t2 g =

932 it "Bind and compose nested" $

930 it "Bind and compose nested" $

933− ((S.toList . t1) bindComposeNested >>= return . sort)

931+ (sort <$> (S.toList . t1) bindComposeNested)

934 `shouldReturn` (sort (

932 `shouldReturn` (sort (

935 [12, 18]

933 [12, 18]

936− ++ replicate 3 13

934+ <> replicate 3 13

937− ++ replicate 3 17

935+ <> replicate 3 17

938− ++ replicate 6 14

936+ <> replicate 6 14

939− ++ replicate 6 16

937+ <> replicate 6 16

940− ++ replicate 7 15) :: [Int])

938+ <> replicate 7 15) :: [Int])

941

939

942 where

940 where

943

941

@@ -960,9 +958,9 @@ bindAndComposeHierarchy t1 t2 g = do

960 >>= \z -> return (x + y + z)

958 >>= \z -> return (x + y + z)

961

959

962mixedOps :: Spec

960mixedOps :: Spec

963−mixedOps = do

961+mixedOps =

964 it "Compose many ops" $

962 it "Compose many ops" $

965− (toListSerial composeMixed >>= return . sort)

963+ (sort <$> toListSerial composeMixed)

966 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11

964 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11

967 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

965 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

968 ] :: [Int])

966 ] :: [Int])

@@ -972,8 +970,8 @@ mixedOps = do

972 composeMixed = do

970 composeMixed = do

973 S.yieldM $ return ()

971 S.yieldM $ return ()

974 S.yieldM $ putStr ""

972 S.yieldM $ putStr ""

975− x <- return 1

973+ let x = 1

976− y <- return 2

974+ let y = 2

977 z <- do

975 z <- do

978 x1 <- wAsyncly $ return 1 <> return 2

976 x1 <- wAsyncly $ return 1 <> return 2

979 S.yieldM $ return ()

977 S.yieldM $ return ()

@@ -990,9 +988,9 @@ mixedOps = do

990 return (x + y + z)

988 return (x + y + z)

991

989

992mixedOpsAheadly :: Spec

990mixedOpsAheadly :: Spec

993−mixedOpsAheadly = do

991+mixedOpsAheadly =

994 it "Compose many ops" $

992 it "Compose many ops" $

995− (toListSerial composeMixed >>= return . sort)

993+ (sort <$> toListSerial composeMixed)

996 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11

994 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11

997 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

995 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

998 ] :: [Int])

996 ] :: [Int])

@@ -1002,8 +1000,8 @@ mixedOpsAheadly = do

1002 composeMixed = do

1000 composeMixed = do

1003 S.yieldM $ return ()

1001 S.yieldM $ return ()

1004 S.yieldM $ putStr ""

1002 S.yieldM $ putStr ""

1005− x <- return 1

1003+ let x = 1

1006− y <- return 2

1004+ let y = 2

1007 z <- do

1005 z <- do

1008 x1 <- wAsyncly $ return 1 <> return 2

1006 x1 <- wAsyncly $ return 1 <> return 2

1009 S.yieldM $ return ()

1007 S.yieldM $ return ()

test/MaxRate.hs+17−17

@@ -13,10 +13,10 @@ durationShouldBe d@(tMin, tMax) action = do

13 t0 <- getTime Monotonic

14 action

15 t1 <- getTime Monotonic

16− let t = (fromIntegral $ toNanoSecs (t1 - t0)) / 1e9

16+ let t = fromIntegral (toNanoSecs (t1 - t0)) / 1e9

17 -- tMax = fromNanoSecs (round $ d*10^9*1.2)

18 -- tMin = fromNanoSecs (round $ d*10^9*0.8)

19− putStrLn $ "Expected: " ++ show d ++ " Took: " ++ show t

19+ putStrLn $ "Expected: " <> show d <> " Took: " <> show t

20 (t <= tMax && t >= tMin) `shouldBe` True

22toMicroSecs :: Num a => a -> a

@@ -30,11 +30,11 @@ measureRate' :: IsStream t

30 -> (Double, Double)

31 -> (Double, Double)

32 -> Spec

33−measureRate' desc t rval consumerDelay producerDelay dur = do

33+measureRate' desc t rval consumerDelay producerDelay dur =

34− it (desc ++ " rate: " ++ show rval

34+ it (desc <> " rate: " <> show rval

35− ++ ", consumer latency: " ++ show consumerDelay

35+ <> ", consumer latency: " <> show consumerDelay

36− ++ ", producer latency: " ++ show producerDelay)

36+ <> ", producer latency: " <> show producerDelay)

37− $ durationShouldBe dur $ do

37+ $ durationShouldBe dur $

38 runStream

39 $ (if consumerDelay > 0

40 then S.mapM $ \x ->

@@ -51,14 +51,14 @@ measureRate' desc t rval consumerDelay producerDelay dur = do

51 then return $ round $ toMicroSecs t1

52 else randomRIO ( round $ toMicroSecs t1

53 , round $ toMicroSecs t2)

54− when (r > 0) $ do

54+ when (r > 0) $ -- do

55 -- t1 <- getTime Monotonic

56 threadDelay r

57 -- t2 <- getTime Monotonic

58 -- let delta = fromIntegral (toNanoSecs (t2 - t1)) / 1000000000

59− -- putStrLn $ "delay took: " ++ show delta

59+ -- putStrLn $ "delay took: " <> show delta

60 -- when (delta > 2) $ do

61− -- putStrLn $ "delay took high: " ++ show delta

61+ -- putStrLn $ "delay took high: " <> show delta

62 return 1

64measureRate :: IsStream t

@@ -82,37 +82,37 @@ main = hspec $ do

82 -- lower (1 or lower). For rate 1 we lose 1 second in the end and for rate

83 -- 10 0.1 second.

84 let rates = [1, 10, 100, 1000, 10000, 100000, 1000000]

85− in describe "asyncly no consumer delay no producer delay" $ do

85+ in describe "asyncly no consumer delay no producer delay" $

86 forM_ rates (\r -> measureRate "asyncly" asyncly r 0 0 range)

88 -- XXX try staggering the dispatches to achieve higher rates

89 let rates = [1, 10, 100, 1000, 10000, 25000]

90− in describe "asyncly no consumer delay and 1 sec producer delay" $ do

90+ in describe "asyncly no consumer delay and 1 sec producer delay" $

91 forM_ rates (\r -> measureRate "asyncly" asyncly r 0 1 range)

93 -- At lower rates (1/10) this is likely to vary quite a bit depending on

94 -- the spread of random producer latencies generated.

95 let rates = [1, 10, 100, 1000, 10000, 25000]

96− in describe "asyncly no consumer delay and variable producer delay" $ do

96+ in describe "asyncly no consumer delay and variable producer delay" $

97 forM_ rates $ \r ->

98 measureRate' "asyncly" asyncly r 0 (0.1, 3) range

100 let rates = [1, 10, 100, 1000, 10000, 100000, 1000000]

101− in describe "wAsyncly no consumer delay no producer delay" $ do

101+ in describe "wAsyncly no consumer delay no producer delay" $

102 forM_ rates (\r -> measureRate "wAsyncly" wAsyncly r 0 0 range)

103

104 let rates = [1, 10, 100, 1000, 10000, 25000]

105− in describe "wAsyncly no consumer delay and 1 sec producer delay" $ do

105+ in describe "wAsyncly no consumer delay and 1 sec producer delay" $

106 forM_ rates (\r -> measureRate "wAsyncly" wAsyncly r 0 1 range)

107

108 let rates = [1, 10, 100, 1000, 10000, 100000, 1000000]

109− in describe "aheadly no consumer delay no producer delay" $ do

109+ in describe "aheadly no consumer delay no producer delay" $

110 forM_ rates (\r -> measureRate "aheadly" aheadly r 0 0 range)

111

112 -- XXX after the change to stop workers when the heap is clearing

113 -- thi does not work well at a 25000 ops per second, need to fix.

114 let rates = [1, 10, 100, 1000, 10000, 12500]

115− in describe "aheadly no consumer delay and 1 sec producer delay" $ do

115+ in describe "aheadly no consumer delay and 1 sec producer delay" $

116 forM_ rates (\r -> measureRate "aheadly" aheadly r 0 1 range)

117

118 describe "asyncly with 1 sec producer delay and some consumer delay" $ do

test/Prop.hs+178−189

@@ -48,8 +48,8 @@ equals eq stream list = do

48 when (not $ stream `eq` list) $

49 monitor

50 (counterexample $

51− "stream " ++ show stream

51+ "stream " <> show stream

52− ++ "\nlist " ++ show list

52+ <> "\nlist " <> show list

53 )

54 assert (stream `eq` list)

@@ -58,17 +58,17 @@ listEquals

58 => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()

59listEquals eq stream list = do

60 when (not $ stream `eq` list) $ liftIO $ putStrLn $

61− "stream " ++ show stream

61+ "stream " <> show stream

62− ++ "\nlist " ++ show list

62+ <> "\nlist " <> show list

63− ++ "\nstream \\\\ list " ++ show (stream \\ list)

63+ <> "\nstream \\\\ list " <> show (stream \\ list)

64− ++ "\nlist \\\\ stream " ++ show (list \\ stream)

64+ <> "\nlist \\\\ stream " <> show (list \\ stream)

65 when (not $ stream `eq` list) $

66 monitor

67 (counterexample $

68− "stream " ++ show stream

68+ "stream " <> show stream

69− ++ "\nlist " ++ show list

69+ <> "\nlist " <> show list

70− ++ "\nstream \\\\ list " ++ show (stream \\ list)

70+ <> "\nstream \\\\ list " <> show (stream \\ list)

71− ++ "\nlist \\\\ stream " ++ show (list \\ stream)

71+ <> "\nlist \\\\ stream " <> show (list \\ stream)

72 )

73 assert (stream `eq` list)

@@ -100,11 +100,11 @@ transformFromList constr eq listOp op a =

100

101mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO ()

102mvarExcHandler label BlockedIndefinitelyOnMVar =

103− error $ label ++ " " ++ "BlockedIndefinitelyOnMVar\n"

103+ error $ label <> " " <> "BlockedIndefinitelyOnMVar\n"

104

105stmExcHandler :: String -> BlockedIndefinitelyOnSTM -> IO ()

106stmExcHandler label BlockedIndefinitelyOnSTM =

107− error $ label ++ " " ++ "BlockedIndefinitelyOnSTM\n"

107+ error $ label <> " " <> "BlockedIndefinitelyOnSTM\n"

108

109dbgMVar :: String -> IO () -> IO ()

110dbgMVar label action =

@@ -115,10 +115,10 @@ dbgMVar label action =

115-- | first n actions takeMVar and the last action performs putMVar n times

116mvarSequenceOp :: MVar () -> Word8 -> Word8 -> IO Word8

117mvarSequenceOp mv n x = do

118− let msg = show x ++ "/" ++ show n

118+ let msg = show x <> "/" <> show n

119 if x < n

120− then dbgMVar ("take mvarSequenceOp " ++ msg) (takeMVar mv) >> return x

120+ then dbgMVar ("take mvarSequenceOp " <> msg) (takeMVar mv) >> return x

121− else dbgMVar ("put mvarSequenceOp" ++ msg)

121+ else dbgMVar ("put mvarSequenceOp" <> msg)

122 (replicateM_ (fromIntegral n) (putMVar mv ())) >> return x

123

124concurrentMapM

@@ -132,7 +132,7 @@ concurrentMapM constr eq op n =

132 let list = [0..n]

133 stream <- run $ do

134 mv <- newEmptyMVar :: IO (MVar ())

135− (S.toList . (op n mv)) (constr list)

135+ (S.toList . op n mv) (constr list)

136 listEquals eq stream list

137

138concurrentFromFoldable

@@ -146,7 +146,7 @@ concurrentFromFoldable eq op n =

146 let list = [0..n]

147 stream <- run $ do

148 mv <- newEmptyMVar :: IO (MVar ())

149− (S.toList . op) (S.fromFoldableM (map (mvarSequenceOp mv n) list))

149+ (S.toList . op) (S.fromFoldableM (fmap (mvarSequenceOp mv n) list))

150 listEquals eq stream list

151

152sourceUnfoldrM :: IsStream t => MVar () -> Word8 -> t IO Word8

@@ -155,11 +155,11 @@ sourceUnfoldrM mv n = S.unfoldrM step 0

155 -- argument must be integer to avoid overflow of word8 at 255

156 step :: Int -> IO (Maybe (Word8, Int))

157 step cnt = do

158− let msg = show cnt ++ "/" ++ show n

158+ let msg = show cnt <> "/" <> show n

159 if cnt > fromIntegral n

160 then return Nothing

161 else do

162− dbgMVar ("put sourceUnfoldrM " ++ msg) (putMVar mv ())

162+ dbgMVar ("put sourceUnfoldrM " <> msg) (putMVar mv ())

163 return (Just (fromIntegral cnt, cnt + 1))

164

165-- Note that this test is not guaranteed to succeed, because there is no

@@ -175,7 +175,7 @@ concurrentUnfoldrM eq op n =

175 -- XXX we should test empty list case as well

176 let list = [0..n]

177 stream <- run $ do

178− -- putStrLn $ "concurrentUnfoldrM: " ++ show n

178+ -- putStrLn $ "concurrentUnfoldrM: " <> show n

179 mv <- newEmptyMVar :: IO (MVar ())

180 cnt <- newIORef 0

181 -- since unfoldr happens in parallel with the stream processing we

@@ -188,18 +188,14 @@ concurrentUnfoldrM eq op n =

188 -- instead.

189 i <- S.yieldM $ readIORef cnt

190 S.yieldM $ modifyIORef cnt (+1)

191− let msg = show i ++ "/" ++ show n

191+ let msg = show i <> "/" <> show n

192− S.yieldM $ do

192+ S.yieldM $

193− if even i

193+ when (even i) $ do

194− then do

195− dbgMVar ("first take concurrentUnfoldrM " ++ msg)

194+ dbgMVar ("first take concurrentUnfoldrM " <> msg)

196 (takeMVar mv)

195 (takeMVar mv)

197− if n > i

196+ when (n > i) $

198− then do

199− dbgMVar ("second take concurrentUnfoldrM " ++ msg)

197+ dbgMVar ("second take concurrentUnfoldrM " <> msg)

200 (takeMVar mv)

198 (takeMVar mv)

201− else return ()

202− else return ()

203 return x

199 return x

204 listEquals eq stream list

200 listEquals eq stream list

205

201

@@ -213,24 +209,21 @@ concurrentApplication eq t n = withMaxSuccess maxTestCount $

213 -- XXX we should test empty list case as well

209 -- XXX we should test empty list case as well

214 let list = [0..n]

210 let list = [0..n]

215 stream <- run $ do

211 stream <- run $ do

216− -- putStrLn $ "concurrentApplication: " ++ show n

212+ -- putStrLn $ "concurrentApplication: " <> show n

217 mv <- newEmptyMVar :: IO (MVar ())

213 mv <- newEmptyMVar :: IO (MVar ())

218 -- since unfoldr happens in parallel with the stream processing we

214 -- since unfoldr happens in parallel with the stream processing we

219 -- can do two takeMVar in one iteration. If it is not parallel then

215 -- can do two takeMVar in one iteration. If it is not parallel then

220 -- this will not work and the test will fail.

216 -- this will not work and the test will fail.

221− (S.toList . t) $ do

217+ (S.toList . t) $

222 sourceUnfoldrM mv n |&

218 sourceUnfoldrM mv n |&

223− (S.mapM $ \x -> do

219+ S.mapM (\x -> do

224− let msg = show x ++ "/" ++ show n

220+ let msg = show x <> "/" <> show n

225− if even x

221+ when (even x) $ do

226− then do

227− dbgMVar ("first take concurrentApp " ++ msg)

222+ dbgMVar ("first take concurrentApp " <> msg)

228 (takeMVar mv)

223 (takeMVar mv)

229− if n > x

224+ when (n > x) $

230− then dbgMVar ("second take concurrentApp " ++ msg)

225+ dbgMVar ("second take concurrentApp " <> msg)

231 (takeMVar mv)

226 (takeMVar mv)

232− else return ()

233− else return ()

234 return x)

227 return x)

235 listEquals eq stream list

228 listEquals eq stream list

236

229

@@ -239,7 +232,7 @@ sourceUnfoldrM1 n = S.unfoldrM step 0

239 where

232 where

240 -- argument must be integer to avoid overflow of word8 at 255

233 -- argument must be integer to avoid overflow of word8 at 255

241 step :: Int -> IO (Maybe (Word8, Int))

234 step :: Int -> IO (Maybe (Word8, Int))

242− step cnt = do

235+ step cnt =

243 if cnt > fromIntegral n

236 if cnt > fromIntegral n

244 then return Nothing

237 then return Nothing

245 else return (Just (fromIntegral cnt, cnt + 1))

238 else return (Just (fromIntegral cnt, cnt + 1))

@@ -249,7 +242,7 @@ concurrentFoldlApplication n =

249 monadicIO $ do

242 monadicIO $ do

250 -- XXX we should test empty list case as well

243 -- XXX we should test empty list case as well

251 let list = [0..n]

244 let list = [0..n]

252− stream <- run $ do

245+ stream <- run $

253 sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []

246 sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []

254 listEquals (==) (reverse stream) list

247 listEquals (==) (reverse stream) list

255

248

@@ -258,7 +251,7 @@ concurrentFoldrApplication n =

258 monadicIO $ do

251 monadicIO $ do

259 -- XXX we should test empty list case as well

252 -- XXX we should test empty list case as well

260 let list = [0..n]

253 let list = [0..n]

261− stream <- run $ do

254+ stream <- run $

262 sourceUnfoldrM1 n |&. S.foldrM (\x xs -> return (x : xs)) []

255 sourceUnfoldrM1 n |&. S.foldrM (\x xs -> return (x : xs)) []

263 listEquals (==) stream list

256 listEquals (==) stream list

264

257

@@ -287,7 +280,7 @@ foldFromList

287 -> ([Int] -> [Int] -> Bool)

280 -> ([Int] -> [Int] -> Bool)

288 -> [Int]

281 -> [Int]

289 -> Property

282 -> Property

290−foldFromList constr op eq a = transformFromList constr eq id op a

283+foldFromList constr op eq = transformFromList constr eq id op

291

284

292eliminateOp

285eliminateOp

293 :: (Show a, Eq a)

286 :: (Show a, Eq a)

@@ -323,8 +316,8 @@ functorOps

323 -> (t IO Int -> SerialT IO Int)

316 -> (t IO Int -> SerialT IO Int)

324 -> Spec

317 -> Spec

325functorOps constr desc eq t = do

318functorOps constr desc eq t = do

326− prop (desc ++ " id") $ transformFromList constr eq id $ t

319+ prop (desc <> " id") $ transformFromList constr eq id t

327− prop (desc ++ " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . (fmap (+1))

320+ prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)

328

321

329transformOps

322transformOps

330 :: IsStream t

323 :: IsStream t

@@ -336,48 +329,48 @@ transformOps

336transformOps constr desc eq t = do

329transformOps constr desc eq t = do

337 let transform = transformFromList constr eq

330 let transform = transformFromList constr eq

338 -- Filtering

331 -- Filtering

339− prop (desc ++ " filter False") $

332+ prop (desc <> " filter False") $

340− transform (filter (const False)) $ t . (S.filter (const False))

333+ transform (filter (const False)) $ t . S.filter (const False)

341− prop (desc ++ " filter True") $

334+ prop (desc <> " filter True") $

342− transform (filter (const True)) $ t . (S.filter (const True))

335+ transform (filter (const True)) $ t . S.filter (const True)

343− prop (desc ++ " filter even") $

336+ prop (desc <> " filter even") $

344− transform (filter even) $ t . (S.filter even)

337+ transform (filter even) $ t . S.filter even

345−

338+

346− prop (desc ++ " take maxBound") $

339+ prop (desc <> " take maxBound") $

347− transform (take maxBound) $ t . (S.take maxBound)

340+ transform (take maxBound) $ t . S.take maxBound

348− prop (desc ++ " take 0") $ transform (take 0) $ t . (S.take 0)

341+ prop (desc <> " take 0") $ transform (take 0) $ t . S.take 0

349− prop (desc ++ " take 1") $ transform (take 1) $ t . (S.take 1)

342+ prop (desc <> " take 1") $ transform (take 1) $ t . S.take 1

350− prop (desc ++ " take 10") $ transform (take 10) $ t . (S.take 10)

343+ prop (desc <> " take 10") $ transform (take 10) $ t . S.take 10

351−

344+

352− prop (desc ++ " takeWhile True") $

345+ prop (desc <> " takeWhile True") $

353− transform (takeWhile (const True)) $ t . (S.takeWhile (const True))

346+ transform (takeWhile (const True)) $ t . S.takeWhile (const True)

354− prop (desc ++ " takeWhile False") $

347+ prop (desc <> " takeWhile False") $

355− transform (takeWhile (const False)) $ t . (S.takeWhile (const False))

348+ transform (takeWhile (const False)) $ t . S.takeWhile (const False)

356− prop (desc ++ " takeWhile > 0") $

349+ prop (desc <> " takeWhile > 0") $

357− transform (takeWhile (> 0)) $ t . (S.takeWhile (> 0))

350+ transform (takeWhile (> 0)) $ t . S.takeWhile (> 0)

358

351

359 let f x = if odd x then Just (x + 100) else Nothing

352 let f x = if odd x then Just (x + 100) else Nothing

360− prop (desc ++ " mapMaybe") $ transform (mapMaybe f) $ t . (S.mapMaybe f)

353+ prop (desc <> " mapMaybe") $ transform (mapMaybe f) $ t . S.mapMaybe f

361

354

362− prop (desc ++ " drop maxBound") $

355+ prop (desc <> " drop maxBound") $

363− transform (drop maxBound) $ t . (S.drop maxBound)

356+ transform (drop maxBound) $ t . S.drop maxBound

364− prop (desc ++ " drop 0") $ transform (drop 0) $ t . (S.drop 0)

357+ prop (desc <> " drop 0") $ transform (drop 0) $ t . S.drop 0

365− prop (desc ++ " drop 1") $ transform (drop 1) $ t . (S.drop 1)

358+ prop (desc <> " drop 1") $ transform (drop 1) $ t . S.drop 1

366− prop (desc ++ " drop 10") $ transform (drop 10) $ t . (S.drop 10)

359+ prop (desc <> " drop 10") $ transform (drop 10) $ t . S.drop 10

367

360

368− prop (desc ++ " dropWhile True") $

361+ prop (desc <> " dropWhile True") $

369− transform (dropWhile (const True)) $ t . (S.dropWhile (const True))

362+ transform (dropWhile (const True)) $ t . S.dropWhile (const True)

370− prop (desc ++ " dropWhile False") $

363+ prop (desc <> " dropWhile False") $

371− transform (dropWhile (const False)) $ t . (S.dropWhile (const False))

364+ transform (dropWhile (const False)) $ t . S.dropWhile (const False)

372− prop (desc ++ " dropWhile > 0") $

365+ prop (desc <> " dropWhile > 0") $

373− transform (dropWhile (> 0)) $ t . (S.dropWhile (> 0))

366+ transform (dropWhile (> 0)) $ t . S.dropWhile (> 0)

374− prop (desc ++ " scan") $ transform (scanl' (+) 0) $ t . (S.scanl' (+) 0)

367+ prop (desc <> " scan") $ transform (scanl' (+) 0) $ t . S.scanl' (+) 0

375− prop (desc ++ " reverse") $ transform reverse $ t . S.reverse

368+ prop (desc <> " reverse") $ transform reverse $ t . S.reverse

376

369

377− prop (desc ++ " findIndices") $ transform (findIndices odd) $ t . (S.findIndices odd)

370+ prop (desc <> " findIndices") $ transform (findIndices odd) $ t . S.findIndices odd

378− prop (desc ++ " elemIndices") $ transform (elemIndices 3) $ t . (S.elemIndices 3)

371+ prop (desc <> " elemIndices") $ transform (elemIndices 3) $ t . S.elemIndices 3

379

372

380− prop (desc ++ " intersperseM") $ transform (intersperse 3) $ t . (S.intersperseM (return 3))

373+ prop (desc <> " intersperseM") $ transform (intersperse 3) $ t . S.intersperseM (return 3)

381

374

382

375

383concurrentOps

376concurrentOps

@@ -390,15 +383,15 @@ concurrentOps

390concurrentOps constr desc eq t = do

383concurrentOps constr desc eq t = do

391 let prop1 d p = prop d $ withMaxSuccess maxTestCount p

384 let prop1 d p = prop d $ withMaxSuccess maxTestCount p

392

385

393− prop1 (desc ++ " fromFoldableM") $ concurrentFromFoldable eq t

386+ prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t

394− prop1 (desc ++ " unfoldrM") $ concurrentUnfoldrM eq t

387+ prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t

395 -- we pass it the length of the stream n and an mvar mv.

388 -- we pass it the length of the stream n and an mvar mv.

396 -- The stream is [0..n]. The threads communicate in such a way that the

389 -- The stream is [0..n]. The threads communicate in such a way that the

397 -- actions coming first in the stream are dependent on the last action. So

390 -- actions coming first in the stream are dependent on the last action. So

398 -- if the stream is not processed concurrently it will block forever.

391 -- if the stream is not processed concurrently it will block forever.

399 -- Note that if the size of the stream is bigger than the thread limit

392 -- Note that if the size of the stream is bigger than the thread limit

400 -- then it will block even if it is concurrent.

393 -- then it will block even if it is concurrent.

401− prop1 (desc ++ " mapM") $

394+ prop1 (desc <> " mapM") $

402 concurrentMapM constr eq $ \n mv stream ->

395 concurrentMapM constr eq $ \n mv stream ->

403 t $ S.mapM (mvarSequenceOp mv n) stream

396 t $ S.mapM (mvarSequenceOp mv n) stream

404

397

@@ -414,58 +407,58 @@ transformCombineOpsCommon

414transformCombineOpsCommon constr desc eq t = do

407transformCombineOpsCommon constr desc eq t = do

415 let transform = transformCombineFromList constr eq

408 let transform = transformCombineFromList constr eq

416 -- Filtering

409 -- Filtering

417− prop (desc ++ " filter False") $

410+ prop (desc <> " filter False") $

418 transform (filter (const False)) t (S.filter (const False))

411 transform (filter (const False)) t (S.filter (const False))

419− prop (desc ++ " filter True") $

412+ prop (desc <> " filter True") $

420 transform (filter (const True)) t (S.filter (const True))

413 transform (filter (const True)) t (S.filter (const True))

421− prop (desc ++ " filter even") $

414+ prop (desc <> " filter even") $

422 transform (filter even) t (S.filter even)

415 transform (filter even) t (S.filter even)

423

416

424− prop (desc ++ " filterM False") $

417+ prop (desc <> " filterM False") $

425 transform (filter (const False)) t (S.filterM (const $ return False))

418 transform (filter (const False)) t (S.filterM (const $ return False))

426− prop (desc ++ " filterM True") $

419+ prop (desc <> " filterM True") $

427 transform (filter (const True)) t (S.filterM (const $ return True))

420 transform (filter (const True)) t (S.filterM (const $ return True))

428− prop (desc ++ " filterM even") $

421+ prop (desc <> " filterM even") $

429 transform (filter even) t (S.filterM (return . even))

422 transform (filter even) t (S.filterM (return . even))

430

423

431− prop (desc ++ " take maxBound") $

424+ prop (desc <> " take maxBound") $

432 transform (take maxBound) t (S.take maxBound)

425 transform (take maxBound) t (S.take maxBound)

433− prop (desc ++ " take 0") $ transform (take 0) t (S.take 0)

426+ prop (desc <> " take 0") $ transform (take 0) t (S.take 0)

434

427

435− prop (desc ++ " takeWhile True") $

428+ prop (desc <> " takeWhile True") $

436 transform (takeWhile (const True)) t (S.takeWhile (const True))

429 transform (takeWhile (const True)) t (S.takeWhile (const True))

437− prop (desc ++ " takeWhile False") $

430+ prop (desc <> " takeWhile False") $

438 transform (takeWhile (const False)) t (S.takeWhile (const False))

431 transform (takeWhile (const False)) t (S.takeWhile (const False))

439

432

440− prop (desc ++ " takeWhileM True") $

433+ prop (desc <> " takeWhileM True") $

441 transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))

434 transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))

442− prop (desc ++ " takeWhileM False") $

435+ prop (desc <> " takeWhileM False") $

443 transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))

436 transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))

444

437

445− prop (desc ++ " drop maxBound") $

438+ prop (desc <> " drop maxBound") $

446 transform (drop maxBound) t (S.drop maxBound)

439 transform (drop maxBound) t (S.drop maxBound)

447− prop (desc ++ " drop 0") $ transform (drop 0) t (S.drop 0)

440+ prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)

448

441

449− prop (desc ++ " dropWhile True") $

442+ prop (desc <> " dropWhile True") $

450 transform (dropWhile (const True)) t (S.dropWhile (const True))

443 transform (dropWhile (const True)) t (S.dropWhile (const True))

451− prop (desc ++ " dropWhile False") $

444+ prop (desc <> " dropWhile False") $

452 transform (dropWhile (const False)) t (S.dropWhile (const False))

445 transform (dropWhile (const False)) t (S.dropWhile (const False))

453

446

454− prop (desc ++ " dropWhileM True") $

447+ prop (desc <> " dropWhileM True") $

455 transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))

448 transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))

456− prop (desc ++ " dropWhileM False") $

449+ prop (desc <> " dropWhileM False") $

457 transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))

450 transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))

458

451

459− prop (desc ++ " mapM (+1)") $

452+ prop (desc <> " mapM (+1)") $

460− transform (map (+1)) t (S.mapM (\x -> return (x + 1)))

453+ transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))

461

454

462− prop (desc ++ " scan") $ transform (scanl' (flip const) 0) t

455+ prop (desc <> " scan") $ transform (scanl' (flip const) 0) t

463 (S.scanl' (flip const) 0)

456 (S.scanl' (flip const) 0)

464− prop (desc ++ " scanlM'") $ transform (scanl' (flip const) 0) t

457+ prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t

465 (S.scanlM' (\_ a -> return a) 0)

458 (S.scanlM' (\_ a -> return a) 0)

466− prop (desc ++ " reverse") $ transform reverse t S.reverse

459+ prop (desc <> " reverse") $ transform reverse t S.reverse

467

460

468− prop (desc ++ " intersperseM") $

461+ prop (desc <> " intersperseM") $

469 transform (intersperse 3) t (S.intersperseM $ return 3)

462 transform (intersperse 3) t (S.intersperseM $ return 3)

470

463

471transformCombineOpsOrdered

464transformCombineOpsOrdered

@@ -478,40 +471,36 @@ transformCombineOpsOrdered

478transformCombineOpsOrdered constr desc eq t = do

471transformCombineOpsOrdered constr desc eq t = do

479 let transform = transformCombineFromList constr eq

472 let transform = transformCombineFromList constr eq

480 -- Filtering

473 -- Filtering

481− prop (desc ++ " take 1") $ transform (take 1) t (S.take 1)

474+ prop (desc <> " take 1") $ transform (take 1) t (S.take 1)

482#ifdef DEVBUILD

475#ifdef DEVBUILD

483− prop (desc ++ " take 2") $ transform (take 2) t (S.take 2)

476+ prop (desc <> " take 2") $ transform (take 2) t (S.take 2)

484− prop (desc ++ " take 3") $ transform (take 3) t (S.take 3)

477+ prop (desc <> " take 3") $ transform (take 3) t (S.take 3)

485− prop (desc ++ " take 4") $ transform (take 4) t (S.take 4)

478+ prop (desc <> " take 4") $ transform (take 4) t (S.take 4)

486− prop (desc ++ " take 5") $ transform (take 5) t (S.take 5)

479+ prop (desc <> " take 5") $ transform (take 5) t (S.take 5)

487#endif

480#endif

488− prop (desc ++ " take 10") $ transform (take 10) t (S.take 10)

481+ prop (desc <> " take 10") $ transform (take 10) t (S.take 10)

489

482

490− prop (desc ++ " takeWhile > 0") $

483+ prop (desc <> " takeWhile > 0") $

491 transform (takeWhile (> 0)) t (S.takeWhile (> 0))

484 transform (takeWhile (> 0)) t (S.takeWhile (> 0))

492

485

493− prop (desc ++ " drop 1") $ transform (drop 1) t (S.drop 1)

486+ prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)

494− prop (desc ++ " drop 10") $ transform (drop 10) t (S.drop 10)

487+ prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)

495

488

496− prop (desc ++ " dropWhile > 0") $

489+ prop (desc <> " dropWhile > 0") $

497 transform (dropWhile (> 0)) t (S.dropWhile (> 0))

490 transform (dropWhile (> 0)) t (S.dropWhile (> 0))

498− prop (desc ++ " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)

491+ prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)

499

492

500 -- XXX this does not fail when the SVar is shared, need to fix.

493 -- XXX this does not fail when the SVar is shared, need to fix.

501− prop (desc ++ " concurrent application") $

494+ prop (desc <> " concurrent application") $

502− transform (& (map (+1))) t (|& (S.map (+1)))

495+ transform (& fmap (+1)) t (|& S.map (+1))

503

496

504− prop (desc ++ " findIndices") $

497+ prop (desc <> " findIndices") $

505 transform (findIndices odd) t (S.findIndices odd)

498 transform (findIndices odd) t (S.findIndices odd)

506− prop (desc ++ " elemIndices") $

499+ prop (desc <> " elemIndices") $

507 transform (elemIndices 0) t (S.elemIndices 0)

500 transform (elemIndices 0) t (S.elemIndices 0)

508

501

509−wrapMaybe :: Eq a1 => ([a1] -> a2) -> [a1] -> Maybe a2

502+wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2

510−wrapMaybe f =

511− \x ->

512− if x == []

513− then Nothing

503+wrapMaybe f x = if null x then Nothing else Just (f x)

514− else Just (f x)

515

504

516eliminationOps

505eliminationOps

517 :: ([Int] -> t IO Int)

506 :: ([Int] -> t IO Int)

@@ -520,31 +509,31 @@ eliminationOps

520 -> Spec

509 -> Spec

521eliminationOps constr desc t = do

510eliminationOps constr desc t = do

522 -- Elimination

511 -- Elimination

523− prop (desc ++ " null") $ eliminateOp constr null $ S.null . t

512+ prop (desc <> " null") $ eliminateOp constr null $ S.null . t

524− prop (desc ++ " foldl'") $

513+ prop (desc <> " foldl'") $

525− eliminateOp constr (foldl' (+) 0) $ (S.foldl' (+) 0) . t

514+ eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t

526− prop (desc ++ " foldl1'") $

515+ prop (desc <> " foldl1'") $

527− eliminateOp constr (wrapMaybe $ foldl1' (+)) $ (S.foldl1' (+)) . t

516+ eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t

528− prop (desc ++ " foldr1") $

517+ prop (desc <> " foldr1") $

529− eliminateOp constr (wrapMaybe $ foldr1 (+)) $ (S.foldr1 (+)) . t

518+ eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t

530− prop (desc ++ " all") $ eliminateOp constr (all even) $ (S.all even) . t

519+ prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t

531− prop (desc ++ " any") $ eliminateOp constr (any even) $ (S.any even) . t

520+ prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t

532− prop (desc ++ " and") $ eliminateOp constr (and . map (> 0)) $

521+ prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $

533 (S.and . S.map (> 0)) . t

522 (S.and . S.map (> 0)) . t

534− prop (desc ++ " or") $ eliminateOp constr (or . map (> 0)) $

523+ prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $

535 (S.or . S.map (> 0)) . t

524 (S.or . S.map (> 0)) . t

536− prop (desc ++ " length") $ eliminateOp constr length $ S.length . t

525+ prop (desc <> " length") $ eliminateOp constr length $ S.length . t

537− prop (desc ++ " sum") $ eliminateOp constr sum $ S.sum . t

526+ prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t

538− prop (desc ++ " product") $ eliminateOp constr product $ S.product . t

527+ prop (desc <> " product") $ eliminateOp constr product $ S.product . t

539

528

540− prop (desc ++ " maximum") $ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t

529+ prop (desc <> " maximum") $ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t

541− prop (desc ++ " minimum") $ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t

530+ prop (desc <> " minimum") $ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t

542

531

543− prop (desc ++ " findIndex") $ eliminateOp constr (findIndex odd) $ (S.findIndex odd) . t

532+ prop (desc <> " findIndex") $ eliminateOp constr (findIndex odd) $ S.findIndex odd . t

544− prop (desc ++ " elemIndex") $ eliminateOp constr (elemIndex 3) $ (S.elemIndex 3) . t

533+ prop (desc <> " elemIndex") $ eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t

545

534

546− prop (desc ++ " find") $ eliminateOp constr (find even) $ (S.find even) . t

535+ prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t

547− prop (desc ++ " lookup") $

536+ prop (desc <> " lookup") $

548 eliminateOp constr (lookup 3 . flip zip [1..]) $

537 eliminateOp constr (lookup 3 . flip zip [1..]) $

549 S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t

538 S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t

550

539

@@ -556,18 +545,18 @@ serialEliminationOps

556 -> (t IO Int -> SerialT IO Int)

545 -> (t IO Int -> SerialT IO Int)

557 -> Spec

546 -> Spec

558serialEliminationOps constr desc t = do

547serialEliminationOps constr desc t = do

559− prop (desc ++ " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t

548+ prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t

560− prop (desc ++ " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do

549+ prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do

561 r <- S.tail (t x)

550 r <- S.tail (t x)

562 case r of

551 case r of

563 Nothing -> return Nothing

552 Nothing -> return Nothing

564− Just s -> S.toList s >>= return . Just

553+ Just s -> Just <$> S.toList s

565− prop (desc ++ " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t

554+ prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t

566− prop (desc ++ " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do

555+ prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do

567 r <- S.init (t x)

556 r <- S.init (t x)

568 case r of

557 case r of

569 Nothing -> return Nothing

558 Nothing -> return Nothing

570− Just s -> S.toList s >>= return . Just

559+ Just s -> Just <$> S.toList s

571

560

572transformOpsWord8

561transformOpsWord8

573 :: ([Word8] -> t IO Word8)

562 :: ([Word8] -> t IO Word8)

@@ -575,8 +564,8 @@ transformOpsWord8

575 -> (t IO Word8 -> SerialT IO Word8)

564 -> (t IO Word8 -> SerialT IO Word8)

576 -> Spec

565 -> Spec

577transformOpsWord8 constr desc t = do

566transformOpsWord8 constr desc t = do

578− prop (desc ++ " elem") $ elemOp constr t S.elem elem

567+ prop (desc <> " elem") $ elemOp constr t S.elem elem

579− prop (desc ++ " elem") $ elemOp constr t S.notElem notElem

568+ prop (desc <> " elem") $ elemOp constr t S.notElem notElem

580

569

581-- XXX concatenate streams of multiple elements rather than single elements

570-- XXX concatenate streams of multiple elements rather than single elements

582semigroupOps

571semigroupOps

@@ -591,8 +580,8 @@ semigroupOps

591 -> (t IO Int -> SerialT IO Int)

580 -> (t IO Int -> SerialT IO Int)

592 -> Spec

581 -> Spec

593semigroupOps desc eq t = do

582semigroupOps desc eq t = do

594− prop (desc ++ " <>") $ foldFromList (foldMapWith (<>) singleton) t eq

583+ prop (desc <> " <>") $ foldFromList (foldMapWith (<>) singleton) t eq

595− prop (desc ++ " mappend") $ foldFromList (foldMapWith mappend singleton) t eq

584+ prop (desc <> " mappend") $ foldFromList (foldMapWith mappend singleton) t eq

596

585

597applicativeOps

586applicativeOps

598 :: Applicative (t IO)

587 :: Applicative (t IO)

@@ -603,7 +592,7 @@ applicativeOps

603 -> Property

592 -> Property

604applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $

593applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $

605 monadicIO $ do

594 monadicIO $ do

606− stream <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))

595+ stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))

607 let list = (,) <$> a <*> b

596 let list = (,) <$> a <*> b

608 listEquals eq stream list

597 listEquals eq stream list

609

598

@@ -616,8 +605,8 @@ zipApplicative

616 -> Property

605 -> Property

617zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $

606zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $

618 monadicIO $ do

607 monadicIO $ do

619− stream1 <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))

608+ stream1 <- run ((S.toList . t) ((,) <$> constr a <*> constr b))

620− stream2 <- run ((S.toList . t) (pure (,) <*> (constr a) <*> (constr b)))

609+ stream2 <- run ((S.toList . t) (pure (,) <*> constr a <*> constr b))

621 stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))

610 stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))

622 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

611 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

623 listEquals eq stream1 list

612 listEquals eq stream1 list

@@ -636,7 +625,7 @@ zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

636 stream1 <-

625 stream1 <-

637 run

626 run

638 ((S.toList . t)

627 ((S.toList . t)

639− (S.zipWithM (\x y -> return (x, y)) (constr a) (constr b)))

628+ (S.zipWithM (curry return) (constr a) (constr b)))

640 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

629 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

641 listEquals eq stream1 list

630 listEquals eq stream1 list

642

631

@@ -652,11 +641,11 @@ zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

652 stream1 <-

641 stream1 <-

653 run

642 run

654 ((S.toList . t)

643 ((S.toList . t)

655− (S.zipWithM (\x y -> return (x, y)) (constr a) (constr b)))

644+ (S.zipWithM (curry return) (constr a) (constr b)))

656 stream2 <-

645 stream2 <-

657 run

646 run

658 ((S.toList . t)

647 ((S.toList . t)

659− (S.zipAsyncWithM (\x y -> return (x, y)) (constr a) (constr b)))

648+ (S.zipAsyncWithM (curry return) (constr a) (constr b)))

660 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

649 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

661 listEquals eq stream1 list

650 listEquals eq stream1 list

662 listEquals eq stream2 list

651 listEquals eq stream2 list

@@ -669,7 +658,7 @@ monadThen

669 -> ([Int], [Int])

658 -> ([Int], [Int])

670 -> Property

659 -> Property

671monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do

660monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do

672− stream <- run ((S.toList . t) ((constr a) >> (constr b)))

661+ stream <- run ((S.toList . t) (constr a >> constr b))

673 let list = a >> b

662 let list = a >> b

674 listEquals eq stream list

663 listEquals eq stream list

675

664

@@ -685,19 +674,19 @@ monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $

685 stream <-

674 stream <-

686 run

675 run

687 ((S.toList . t)

676 ((S.toList . t)

688− ((constr a) >>= \x -> (constr b) >>= return . (+ x)))

677+ (constr a >>= \x -> (+ x) <$> constr b))

689− let list = a >>= \x -> b >>= return . (+ x)

678+ let list = a >>= \x -> (+ x) <$> b

690 listEquals eq stream list

679 listEquals eq stream list

691

680

692constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec

681constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec

693constructWithIterate t = do

682constructWithIterate t = do

694 it "iterate" $

683 it "iterate" $

695− (S.toList . t . (S.take 100) $ (S.iterate (+ 1) (0 :: Int)))

684+ (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))

696− `shouldReturn` (take 100 $ iterate (+ 1) 0)

685+ `shouldReturn` take 100 (iterate (+ 1) 0)

697 it "iterateM" $ do

686 it "iterateM" $ do

698− let addM = (\ y -> return (y + 1))

687+ let addM y = return (y + 1)

699− S.toList . t . (S.take 100) $ S.iterateM addM (0 :: Int)

688+ S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)

700− `shouldReturn` (take 100 $ iterate (+ 1) 0)

689+ `shouldReturn` take 100 (iterate (+ 1) 0)

701

690

702main :: IO ()

691main :: IO ()

703main = hspec

692main = hspec

@@ -728,43 +717,43 @@ main = hspec

728

717

729 let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

718 let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

730 let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec

719 let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec

731− serialOps spec = mapOps spec $ (makeOps serially)

720+ serialOps spec = mapOps spec $ makeOps serially

732#ifndef COVERAGE_BUILD

721#ifndef COVERAGE_BUILD

733− ++ [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]

722+ <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]

734− ++ [("maxBuffer -1", serially . maxBuffer (-1))]

723+ <> [("maxBuffer -1", serially . maxBuffer (-1))]

735#endif

724#endif

736 let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec

725 let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec

737 wSerialOps spec = mapOps spec $ makeOps wSerially

726 wSerialOps spec = mapOps spec $ makeOps wSerially

738#ifndef COVERAGE_BUILD

727#ifndef COVERAGE_BUILD

739− ++ [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

728+ <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

740− ++ [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

729+ <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

741#endif

730#endif

742 let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec

731 let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec

743 asyncOps spec = mapOps spec $ makeOps asyncly

732 asyncOps spec = mapOps spec $ makeOps asyncly

744#ifndef COVERAGE_BUILD

733#ifndef COVERAGE_BUILD

745− ++ [("maxBuffer (-1)", asyncly . maxBuffer (-1))]

734+ <> [("maxBuffer (-1)", asyncly . maxBuffer (-1))]

746#endif

735#endif

747 let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec

736 let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec

748 wAsyncOps spec = mapOps spec $ makeOps wAsyncly

737 wAsyncOps spec = mapOps spec $ makeOps wAsyncly

749#ifndef COVERAGE_BUILD

738#ifndef COVERAGE_BUILD

750− ++ [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]

739+ <> [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]

751#endif

740#endif

752 let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec

741 let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec

753 aheadOps spec = mapOps spec $ makeOps aheadly

742 aheadOps spec = mapOps spec $ makeOps aheadly

754#ifndef COVERAGE_BUILD

743#ifndef COVERAGE_BUILD

755− ++ [("maxBuffer (-1)", aheadly . maxBuffer (-1))]

744+ <> [("maxBuffer (-1)", aheadly . maxBuffer (-1))]

756#endif

745#endif

757 let parallelOps :: IsStream t => ((ParallelT IO a -> t IO a) -> Spec) -> Spec

746 let parallelOps :: IsStream t => ((ParallelT IO a -> t IO a) -> Spec) -> Spec

758 parallelOps spec = mapOps spec $ makeOps parallely

747 parallelOps spec = mapOps spec $ makeOps parallely

759#ifndef COVERAGE_BUILD

748#ifndef COVERAGE_BUILD

760− ++ [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]

749+ <> [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]

761− ++ [("maxBuffer (-1)", parallely . maxBuffer (-1))]

750+ <> [("maxBuffer (-1)", parallely . maxBuffer (-1))]

762#endif

751#endif

763 let zipSerialOps :: IsStream t => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec

752 let zipSerialOps :: IsStream t => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec

764 zipSerialOps spec = mapOps spec $ makeOps zipSerially

753 zipSerialOps spec = mapOps spec $ makeOps zipSerially

765#ifndef COVERAGE_BUILD

754#ifndef COVERAGE_BUILD

766− ++ [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]

755+ <> [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]

767− ++ [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]

756+ <> [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]

768#endif

757#endif

769 -- Note, the "pure" of applicative Zip streams generates and infinite

758 -- Note, the "pure" of applicative Zip streams generates and infinite

770 -- stream and therefore maxBuffer (-1) must not be used for that case.

759 -- stream and therefore maxBuffer (-1) must not be used for that case.

@@ -943,9 +932,9 @@ main = hspec

943 aheadOps $ prop "ahead" . concurrentApplication (==)

932 aheadOps $ prop "ahead" . concurrentApplication (==)

944 parallelOps $ prop "parallel" . concurrentApplication sortEq

933 parallelOps $ prop "parallel" . concurrentApplication sortEq

945

934

946− prop "concurrent foldr application" $ withMaxSuccess maxTestCount $

935+ prop "concurrent foldr application" $ withMaxSuccess maxTestCount

947 concurrentFoldrApplication

936 concurrentFoldrApplication

948− prop "concurrent foldl application" $ withMaxSuccess maxTestCount $

937+ prop "concurrent foldl application" $ withMaxSuccess maxTestCount

949 concurrentFoldlApplication

938 concurrentFoldlApplication

950

939

951 -- These tests are specifically targeted towards detecting illegal sharing

940 -- These tests are specifically targeted towards detecting illegal sharing

test/rate-timestamp.hs+1−1

@@ -9,7 +9,7 @@ import System.Clock

9withTimeStamp msg = do

10 t <- getTime Monotonic

11 let ns = toNanoSecs t `mod` 10^11

12− putStrLn $ show (fromIntegral ns / 1.0e9) ++ " " ++ msg

12+ putStrLn $ show (fromIntegral ns / 1.0e9) <> " " <> msg

14-- acidRain :: MonadAsync m => SerialT m Event

15producer =