bf81f70 · streamly · git.iko.soy

git.iko.soy/streamly

lint free tests

commitbf81f70a4e3643884e8298888b324fa978c3bdbd authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 13 Oct 2018, 10:36 (8 years ago) parentbf39d27

4 files changed+297−310

compare with master

unifiedsplit

test/Main.hs+101−103 test/MaxRate.hs+17−17 test/Prop.hs+178−189 test/rate-timestamp.hs+1−1

test/Main.hs+101−103

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

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

179179testFoldOpsCleanup name f = do

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

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

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

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

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

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

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

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

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

185185#endif

186186

187187parallelTests :: SpecWith ()

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

194194 it "simple serially with IO" $

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

196196

197− describe "Empty" $ do

197+ describe "Empty" $ -- do

198198 it "Monoid - mempty" $

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

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

200200 -- it "Alternative - empty" $

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

202202 -- it "MonadPlus - mzero" $

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

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

211211 -- construction via list fold construction method.

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

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

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

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

215215

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

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

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

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

219219

220220 ---------------------------------------------------------------------------

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

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

226226 -- construction via list fold construction method.

227227 it "Apply - serial composed first argument" $

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

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

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

230230

231231 it "Apply - serial composed second argument" $

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

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

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

234234

235235 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)

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

238238

239239 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))

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

242242

243243 ---------------------------------------------------------------------------

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

259259 ---------------------------------------------------------------------------

260260

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

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

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

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

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

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

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

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

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

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

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

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

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

266270

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

268272 serially

269273 wSerially

270− ([ [1 .. 9]

274+ [ [1 .. 9]

271275 , [1 .. 9]

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

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

274− ])

278+ ]

275279

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

277281 wSerially

278282 wSerially

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

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

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

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

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

283− ])

287+ ]

284288

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

286290 wSerially

287291 serially

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

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

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

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

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

292− ])

296+ ]

293297

294298 ---------------------------------------------------------------------------

295299 -- Monoidal composition recursion loops

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

514518takeCombined n t = do

515519 let constr = S.fromFoldable

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

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

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

518522 r `shouldBe` []

519523

520524checkFoldxStrictness :: IO ()

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

575579 `shouldReturn` "success"

576580

577581foldlM'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) ()

580583

581584foldxMStrictCheck :: 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

584586

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

586588checkFoldMStrictness f = do

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

590592 readIORef ref `shouldReturn` 1

591593

592594scanlM'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) ()

595596

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

597598checkScanlMStrictness f = do

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

601602 readIORef ref `shouldReturn` 1

602603

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

604−takeInfinite t = do

605+takeInfinite t =

605606 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)))

608608 `shouldReturn` ()

609609

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

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

612612-- error occurs.

613613

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

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

615615

616616instance Exception ExampleException

617617

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

624624 it "simple runExceptT with error" $ do

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

626626 -}

627− it "simple try" $ do

628− (try $ runStream $ return ())

627+ it "simple try" $

628+ try (runStream $ return ())

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

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

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

630+ it "simple try with throw error" $

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

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

633633

634634composeWithMonadThrow

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

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

640640composeWithMonadThrow t = do

641641 it "Compose throwM, nil" $

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

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

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

644644 it "Compose nil, throwM" $

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

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

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

647647 oneLevelNestedSum "serially" serially

648648 oneLevelNestedSum "wSerially" wSerially

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

658658 where

659659 tl = S.toList . t

660660 oneLevelNestedSum desc t1 =

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

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

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

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

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

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

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

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

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

666666

667667 oneLevelNestedProduct desc t1 =

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

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

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

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

671671 try $ tl (do

672672 x <- adapt s1

673673 y <- s2

674− if (x + y > 10)

674+ if x + y > 10

675675 then throwM (ExampleException "E")

676676 else return (x + y)

677677 )

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

686686_composeWithMonadError t = do

687687 let tl = S.toList . t

688688 it "Compose throwError, nil" $

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

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

690690 it "Compose nil, error" $

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

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

692692

693693nestTwoSerial :: Expectation

694694nestTwoSerial =

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

745745nestTwoAsync =

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

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

748− in (toListAsync (do

748+ in sort <$> toListAsync (do

749749 x <- s1

750750 y <- s2

751− return (x + y)

752− ) >>= return . sort)

751+ return (x + y))

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

754753

755754nestTwoAsyncApp :: Expectation

756755nestTwoAsyncApp =

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

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

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

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

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

761760

762761nestTwoWAsync :: Expectation

763762nestTwoWAsync =

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

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

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

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

767766 x <- s1

768767 y <- s2

769− return (x + y)

770− ) >>= return . sort)

768+ return (x + y))

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

772770

773771nestTwoParallel :: Expectation

774772nestTwoParallel =

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

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

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

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

778776 x <- s1

779777 y <- s2

780− return (x + y)

781− ) >>= return . sort)

778+ return (x + y))

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

783780

784781nestTwoWAsyncApp :: Expectation

785782nestTwoWAsyncApp =

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

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

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

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

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

790787

791788nestTwoParallelApp :: Expectation

792789nestTwoParallelApp =

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

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

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

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

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

797794

798795interleaveCheck :: IsStream t

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

802799interleaveCheck t f =

803800 it "Interleave four" $

804801 (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]

806803

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

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

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

811808parallelCheck t f = do

812809 it "Parallel ordering left associated" $

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

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

811+ `shouldReturn` [1..4]

815812

816813 it "Parallel ordering right associated" $

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

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

815+ `shouldReturn` [1..4]

819816

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

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

821818

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

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

824821compose t z srt = do

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

826823 it "Compose mempty, mempty" $

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

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

828825 it "Compose empty at the beginning" $

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

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

830827 it "Compose empty at the end" $

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

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

832829 it "Compose two" $

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

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

834831 `shouldReturn` [0, 1]

835832 it "Compose many" $

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

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

837834 `shouldReturn` [1..100]

838835

839836 -- These are not covered by the property tests

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

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

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

842839 `shouldReturn` [0, 1]

843840 it "Compose left associated" $

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

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

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

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

846843 it "Compose right associated" $

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

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

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

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

849846 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))

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

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

849+ `shouldReturn` [0..7]

853850 where tl = S.toList . t

854851

855852composeAndComposeSimple

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

865862composeAndComposeSimple t1 t2 answer = do

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

867864 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])))

869− `shouldReturn` (answer !! 0)

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

866+ `shouldReturn` head answer

870867

871868 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])

873870 `shouldReturn` (answer !! 1)

874871

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

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

876873 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]))

878875 `shouldReturn` (answer !! 2)

879876

880877 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])

882879 `shouldReturn` (answer !! 3)

883880

884881loops

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

888885 -> ([Int] -> [Int])

889886 -> Spec

890887loops 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))

892889 `shouldReturn` [0..3]

893890

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

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

895892 `shouldReturn` [0..3]

896893

897894 where

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

913910bindAndComposeSimple t1 t2 = do

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

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

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

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

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

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

915+ `shouldReturn` [1..10]

918916

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

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

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

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

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

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

920+ `shouldReturn` [1..10]

923921

924922bindAndComposeHierarchy

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

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

928926 -> (t2 IO Int -> t2 IO Int)

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

930928 -> Spec

931−bindAndComposeHierarchy t1 t2 g = do

929+bindAndComposeHierarchy t1 t2 g =

932930 it "Bind and compose nested" $

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

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

934932 `shouldReturn` (sort (

935933 [12, 18]

936− ++ replicate 3 13

937− ++ replicate 3 17

938− ++ replicate 6 14

939− ++ replicate 6 16

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

934+ <> replicate 3 13

935+ <> replicate 3 17

936+ <> replicate 6 14

937+ <> replicate 6 16

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

941939

942940 where

943941

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

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

961959

962960mixedOps :: Spec

963−mixedOps = do

961+mixedOps =

964962 it "Compose many ops" $

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

963+ (sort <$> toListSerial composeMixed)

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

967965 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

968966 ] :: [Int])

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

972970 composeMixed = do

973971 S.yieldM $ return ()

974972 S.yieldM $ putStr ""

975− x <- return 1

976− y <- return 2

973+ let x = 1

974+ let y = 2

977975 z <- do

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

979977 S.yieldM $ return ()

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

990988 return (x + y + z)

991989

992990mixedOpsAheadly :: Spec

993−mixedOpsAheadly = do

991+mixedOpsAheadly =

994992 it "Compose many ops" $

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

993+ (sort <$> toListSerial composeMixed)

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

997995 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13

998996 ] :: [Int])

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

10021000 composeMixed = do

10031001 S.yieldM $ return ()

10041002 S.yieldM $ putStr ""

1005− x <- return 1

1006− y <- return 2

1003+ let x = 1

1004+ let y = 2

10071005 z <- do

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

10091007 S.yieldM $ return ()

test/MaxRate.hs+17−17

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

1313 t0 <- getTime Monotonic

1414 action

1515 t1 <- getTime Monotonic

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

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

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

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

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

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

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

2121

2222toMicroSecs :: Num a => a -> a

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

3030 -> (Double, Double)

3131 -> (Double, Double)

3232 -> Spec

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

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

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

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

37− $ durationShouldBe dur $ do

33+measureRate' desc t rval consumerDelay producerDelay dur =

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

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

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

37+ $ durationShouldBe dur $

3838 runStream

3939 $ (if consumerDelay > 0

4040 then S.mapM $ \x ->

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

5151 then return $ round $ toMicroSecs t1

5252 else randomRIO ( round $ toMicroSecs t1

5353 , round $ toMicroSecs t2)

54− when (r > 0) $ do

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

5555 -- t1 <- getTime Monotonic

5656 threadDelay r

5757 -- t2 <- getTime Monotonic

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

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

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

6060 -- when (delta > 2) $ do

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

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

6262 return 1

6363

6464measureRate :: IsStream t

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

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

8383 -- 10 0.1 second.

8484 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" $

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

8787

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

8989 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" $

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

9292

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

9494 -- the spread of random producer latencies generated.

9595 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" $

9797 forM_ rates $ \r ->

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

9999

100100 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" $

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

103103

104104 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" $

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

107107

108108 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" $

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

111111

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

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

114114 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" $

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

117117

118118 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

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

4949 monitor

5050 (counterexample $

51− "stream " ++ show stream

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

51+ "stream " <> show stream

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

5353 )

5454 assert (stream `eq` list)

5555

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

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

5959listEquals eq stream list = do

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

61− "stream " ++ show stream

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

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

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

61+ "stream " <> show stream

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

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

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

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

6666 monitor

6767 (counterexample $

68− "stream " ++ show stream

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

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

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

68+ "stream " <> show stream

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

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

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

7272 )

7373 assert (stream `eq` list)

7474

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

100100

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

102102mvarExcHandler label BlockedIndefinitelyOnMVar =

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

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

104104

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

106106stmExcHandler label BlockedIndefinitelyOnSTM =

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

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

108108

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

110110dbgMVar label action =

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

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

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

117117mvarSequenceOp mv n x = do

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

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

119119 if x < n

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

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

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

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

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

123123

124124concurrentMapM

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

132132 let list = [0..n]

133133 stream <- run $ do

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

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

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

136136 listEquals eq stream list

137137

138138concurrentFromFoldable

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

146146 let list = [0..n]

147147 stream <- run $ do

148148 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))

150150 listEquals eq stream list

151151

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

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

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

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

157157 step cnt = do

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

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

159159 if cnt > fromIntegral n

160160 then return Nothing

161161 else do

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

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

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

164164

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

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

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

176176 let list = [0..n]

177177 stream <- run $ do

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

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

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

180180 cnt <- newIORef 0

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

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

188188 -- instead.

189189 i <- S.yieldM $ readIORef cnt

190190 S.yieldM $ modifyIORef cnt (+1)

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

192− S.yieldM $ do

193− if even i

194− then do

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

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

192+ S.yieldM $

193+ when (even i) $ do

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

196195 (takeMVar mv)

197− if n > i

198− then do

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

196+ when (n > i) $

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

200198 (takeMVar mv)

201− else return ()

202− else return ()

203199 return x

204200 listEquals eq stream list

205201

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

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

214210 let list = [0..n]

215211 stream <- run $ do

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

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

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

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

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

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

221− (S.toList . t) $ do

217+ (S.toList . t) $

222218 sourceUnfoldrM mv n |&

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

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

225− if even x

226− then do

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

219+ S.mapM (\x -> do

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

221+ when (even x) $ do

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

228223 (takeMVar mv)

229− if n > x

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

224+ when (n > x) $

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

231226 (takeMVar mv)

232− else return ()

233− else return ()

234227 return x)

235228 listEquals eq stream list

236229

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

239232 where

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

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

242− step cnt = do

235+ step cnt =

243236 if cnt > fromIntegral n

244237 then return Nothing

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

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

249242 monadicIO $ do

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

251244 let list = [0..n]

252− stream <- run $ do

245+ stream <- run $

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

254247 listEquals (==) (reverse stream) list

255248

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

258251 monadicIO $ do

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

260253 let list = [0..n]

261− stream <- run $ do

254+ stream <- run $

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

263256 listEquals (==) stream list

264257

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

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

288281 -> [Int]

289282 -> Property

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

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

291284

292285eliminateOp

293286 :: (Show a, Eq a)

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

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

324317 -> Spec

325318functorOps constr desc eq t = do

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

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

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

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

328321

329322transformOps

330323 :: IsStream t

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

336329transformOps constr desc eq t = do

337330 let transform = transformFromList constr eq

338331 -- Filtering

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

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

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

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

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

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

345−

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

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

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

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

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

351−

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

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

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

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

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

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

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

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

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

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

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

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

338+

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

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

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

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

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

344+

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

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

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

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

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

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

358351

359352 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

361354

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

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

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

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

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

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

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

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

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

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

367360

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

376369

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

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

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

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

379372

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

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

381374

382375

383376concurrentOps

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

390383concurrentOps constr desc eq t = do

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

392385

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

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

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

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

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

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

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

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

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

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

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

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

402395 concurrentMapM constr eq $ \n mv stream ->

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

404397

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

414407transformCombineOpsCommon constr desc eq t = do

415408 let transform = transformCombineFromList constr eq

416409 -- Filtering

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

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

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

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

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

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

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

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

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

423416

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

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

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

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

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

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

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

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

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

430423

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

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

432425 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)

434427

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

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

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

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

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

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

439432

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

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

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

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

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

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

444437

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

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

446439 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)

448441

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

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

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

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

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

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

453446

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

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

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

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

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

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

458451

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

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

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

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

461454

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

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

463456 (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

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

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

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

467460

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

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

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

470463

471464transformCombineOpsOrdered

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

478471transformCombineOpsOrdered constr desc eq t = do

479472 let transform = transformCombineFromList constr eq

480473 -- 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)

482475#ifdef DEVBUILD

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

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

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

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

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

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

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

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

487480#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)

489482

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

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

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

492485

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

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

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

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

495488

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

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

497490 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)

499492

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

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

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

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

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

503496

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

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

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

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

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

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

508501

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

510−wrapMaybe f =

511− \x ->

512− if x == []

513− then Nothing

514− else Just (f x)

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

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

515504

516505eliminationOps

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

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

520509 -> Spec

521510eliminationOps constr desc t = do

522511 -- Elimination

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

539528

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

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

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

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

542531

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

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

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

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

545534

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

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

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

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

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

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

550539

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

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

557546 -> Spec

558547serialEliminationOps constr desc t = do

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

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

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

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

561550 r <- S.tail (t x)

562551 case r of

563552 Nothing -> return Nothing

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

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

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

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

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

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

567556 r <- S.init (t x)

568557 case r of

569558 Nothing -> return Nothing

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

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

571560

572561transformOpsWord8

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

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

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

576565 -> Spec

577566transformOpsWord8 constr desc t = do

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

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

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

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

580569

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

582571semigroupOps

@@ -591,8 +580,8 @@ semigroupOps

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

592581 -> Spec

593582semigroupOps desc eq t = do

594− prop (desc ++ " <>") $ foldFromList (foldMapWith (<>) singleton) t eq

595− prop (desc ++ " mappend") $ foldFromList (foldMapWith mappend singleton) t eq

583+ prop (desc <> " <>") $ foldFromList (foldMapWith (<>) singleton) t eq

584+ prop (desc <> " mappend") $ foldFromList (foldMapWith mappend singleton) t eq

596585

597586applicativeOps

598587 :: Applicative (t IO)

@@ -603,7 +592,7 @@ applicativeOps

603592 -> Property

604593applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $

605594 monadicIO $ do

606− stream <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))

595+ stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))

607596 let list = (,) <$> a <*> b

608597 listEquals eq stream list

609598

@@ -616,8 +605,8 @@ zipApplicative

616605 -> Property

617606zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $

618607 monadicIO $ do

619− stream1 <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))

620− stream2 <- run ((S.toList . t) (pure (,) <*> (constr a) <*> (constr b)))

608+ stream1 <- run ((S.toList . t) ((,) <$> constr a <*> constr b))

609+ stream2 <- run ((S.toList . t) (pure (,) <*> constr a <*> constr b))

621610 stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))

622611 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

623612 listEquals eq stream1 list

@@ -636,7 +625,7 @@ zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

636625 stream1 <-

637626 run

638627 ((S.toList . t)

639− (S.zipWithM (\x y -> return (x, y)) (constr a) (constr b)))

628+ (S.zipWithM (curry return) (constr a) (constr b)))

640629 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

641630 listEquals eq stream1 list

642631

@@ -652,11 +641,11 @@ zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

652641 stream1 <-

653642 run

654643 ((S.toList . t)

655− (S.zipWithM (\x y -> return (x, y)) (constr a) (constr b)))

644+ (S.zipWithM (curry return) (constr a) (constr b)))

656645 stream2 <-

657646 run

658647 ((S.toList . t)

659− (S.zipAsyncWithM (\x y -> return (x, y)) (constr a) (constr b)))

648+ (S.zipAsyncWithM (curry return) (constr a) (constr b)))

660649 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

661650 listEquals eq stream1 list

662651 listEquals eq stream2 list

@@ -669,7 +658,7 @@ monadThen

669658 -> ([Int], [Int])

670659 -> Property

671660monadThen 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))

673662 let list = a >> b

674663 listEquals eq stream list

675664

@@ -685,19 +674,19 @@ monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $

685674 stream <-

686675 run

687676 ((S.toList . t)

688− ((constr a) >>= \x -> (constr b) >>= return . (+ x)))

689− let list = a >>= \x -> b >>= return . (+ x)

677+ (constr a >>= \x -> (+ x) <$> constr b))

678+ let list = a >>= \x -> (+ x) <$> b

690679 listEquals eq stream list

691680

692681constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec

693682constructWithIterate t = do

694683 it "iterate" $

695− (S.toList . t . (S.take 100) $ (S.iterate (+ 1) (0 :: Int)))

696− `shouldReturn` (take 100 $ iterate (+ 1) 0)

684+ (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))

685+ `shouldReturn` take 100 (iterate (+ 1) 0)

697686 it "iterateM" $ do

698− let addM = (\ y -> return (y + 1))

699− S.toList . t . (S.take 100) $ S.iterateM addM (0 :: Int)

700− `shouldReturn` (take 100 $ iterate (+ 1) 0)

687+ let addM y = return (y + 1)

688+ S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)

689+ `shouldReturn` take 100 (iterate (+ 1) 0)

701690

702691main :: IO ()

703692main = hspec

@@ -728,43 +717,43 @@ main = hspec

728717

729718 let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

730719 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

732721#ifndef COVERAGE_BUILD

733− ++ [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]

734− ++ [("maxBuffer -1", serially . maxBuffer (-1))]

722+ <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]

723+ <> [("maxBuffer -1", serially . maxBuffer (-1))]

735724#endif

736725 let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec

737726 wSerialOps spec = mapOps spec $ makeOps wSerially

738727#ifndef COVERAGE_BUILD

739− ++ [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

740− ++ [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

728+ <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

729+ <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

741730#endif

742731 let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec

743732 asyncOps spec = mapOps spec $ makeOps asyncly

744733#ifndef COVERAGE_BUILD

745− ++ [("maxBuffer (-1)", asyncly . maxBuffer (-1))]

734+ <> [("maxBuffer (-1)", asyncly . maxBuffer (-1))]

746735#endif

747736 let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec

748737 wAsyncOps spec = mapOps spec $ makeOps wAsyncly

749738#ifndef COVERAGE_BUILD

750− ++ [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]

739+ <> [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]

751740#endif

752741 let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec

753742 aheadOps spec = mapOps spec $ makeOps aheadly

754743#ifndef COVERAGE_BUILD

755− ++ [("maxBuffer (-1)", aheadly . maxBuffer (-1))]

744+ <> [("maxBuffer (-1)", aheadly . maxBuffer (-1))]

756745#endif

757746 let parallelOps :: IsStream t => ((ParallelT IO a -> t IO a) -> Spec) -> Spec

758747 parallelOps spec = mapOps spec $ makeOps parallely

759748#ifndef COVERAGE_BUILD

760− ++ [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]

761− ++ [("maxBuffer (-1)", parallely . maxBuffer (-1))]

749+ <> [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]

750+ <> [("maxBuffer (-1)", parallely . maxBuffer (-1))]

762751#endif

763752 let zipSerialOps :: IsStream t => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec

764753 zipSerialOps spec = mapOps spec $ makeOps zipSerially

765754#ifndef COVERAGE_BUILD

766− ++ [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]

767− ++ [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]

755+ <> [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]

756+ <> [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]

768757#endif

769758 -- Note, the "pure" of applicative Zip streams generates and infinite

770759 -- stream and therefore maxBuffer (-1) must not be used for that case.

@@ -943,9 +932,9 @@ main = hspec

943932 aheadOps $ prop "ahead" . concurrentApplication (==)

944933 parallelOps $ prop "parallel" . concurrentApplication sortEq

945934

946− prop "concurrent foldr application" $ withMaxSuccess maxTestCount $

935+ prop "concurrent foldr application" $ withMaxSuccess maxTestCount

947936 concurrentFoldrApplication

948− prop "concurrent foldl application" $ withMaxSuccess maxTestCount $

937+ prop "concurrent foldl application" $ withMaxSuccess maxTestCount

949938 concurrentFoldlApplication

950939

951940 -- These tests are specifically targeted towards detecting illegal sharing

test/rate-timestamp.hs+1−1

@@ -9,7 +9,7 @@ import System.Clock

99withTimeStamp msg = do

1010 t <- getTime Monotonic

1111 let ns = toNanoSecs t `mod` 10^11

12− putStrLn $ show (fromIntegral ns / 1.0e9) ++ " " ++ msg

12+ putStrLn $ show (fromIntegral ns / 1.0e9) <> " " <> msg

1313

1414-- acidRain :: MonadAsync m => SerialT m Event

1515producer =