mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
223 lines
8.0 KiB
Haskell
223 lines
8.0 KiB
Haskell
{-# OPTIONS_GHC -Wno-deprecations #-}
|
|
|
|
-- |
|
|
-- Module : Streamly.Test.Prelude.WAsync
|
|
-- Copyright : (c) 2020 Composewell Technologies
|
|
--
|
|
-- License : BSD-3-Clause
|
|
-- Maintainer : streamly@composewell.com
|
|
-- Stability : experimental
|
|
-- Portability : GHC
|
|
|
|
module Streamly.Test.Prelude.WAsync (main) where
|
|
|
|
#ifdef DEVBUILD
|
|
import Control.Concurrent ( threadDelay )
|
|
#endif
|
|
import Data.List (sort)
|
|
import Test.Hspec.QuickCheck
|
|
import Test.QuickCheck (Property, withMaxSuccess)
|
|
import Test.QuickCheck.Monadic (monadicIO, run)
|
|
import Test.Hspec as H
|
|
|
|
import Streamly.Prelude
|
|
import qualified Streamly.Prelude as S
|
|
|
|
import Streamly.Test.Common
|
|
import Streamly.Test.Prelude.Common
|
|
|
|
moduleName :: String
|
|
moduleName = "Prelude.WAsync"
|
|
|
|
constructfromWAsync ::
|
|
S.WAsyncT IO Int -> S.WAsyncT IO Int-> [Int] -> Property
|
|
constructfromWAsync s1 s2 res =
|
|
withMaxSuccess maxTestCount $
|
|
monadicIO $ do
|
|
x <- run
|
|
$ S.toList
|
|
$ S.fromWAsync
|
|
$ S.maxThreads 1
|
|
$ s1 `S.wAsync` s2
|
|
equals (==) x res
|
|
|
|
main :: IO ()
|
|
main = hspec
|
|
$ H.parallel
|
|
#ifdef COVERAGE_BUILD
|
|
$ modifyMaxSuccess (const 10)
|
|
#endif
|
|
$ describe moduleName $ do
|
|
let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec
|
|
wAsyncOps spec = mapOps spec $ makeOps fromWAsync
|
|
#ifndef COVERAGE_BUILD
|
|
<> [("maxBuffer (-1)", fromWAsync . maxBuffer (-1))]
|
|
#endif
|
|
|
|
describe "Construction" $ do
|
|
wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM
|
|
-- XXX add tests for fromIndices
|
|
wAsyncOps $ prop "wAsyncly cons" . constructWithCons S.cons
|
|
wAsyncOps $ prop "wAsyncly consM" . constructWithConsM S.consM sort
|
|
wAsyncOps $ prop "wAsyncly (.:)" . constructWithCons (S..:)
|
|
wAsyncOps $ prop "wAsyncly (|:)" . constructWithConsM (S.|:) sort
|
|
prop "wAsync1" $
|
|
constructfromWAsync
|
|
(S.fromList [1,2,3,4,5])
|
|
(S.fromList [6,7,8,9,10])
|
|
[1,6,2,7,3,8,4,9,5,10]
|
|
|
|
prop "wAsync2" $
|
|
constructfromWAsync
|
|
(S.fromList [1,2,3,4,5,6,7])
|
|
(S.fromList [8,9,10])
|
|
[1,8,2,9,3,10,4,5,6,7]
|
|
|
|
prop "wAsync3" $
|
|
constructfromWAsync
|
|
(S.fromList [1,2,3,4])
|
|
(S.fromList [5,6,7,8,9,10])
|
|
[1,5,2,6,3,7,4,8,9,10]
|
|
|
|
prop "wAsync4" $
|
|
constructfromWAsync
|
|
(S.fromList [])
|
|
(S.fromList [5,6,7,8,9,10])
|
|
[5,6,7,8,9,10]
|
|
|
|
prop "wAsync5" $
|
|
constructfromWAsync
|
|
(S.fromList [1,2,3,4])
|
|
(S.fromList [])
|
|
[1,2,3,4]
|
|
|
|
prop "wAsync6" $
|
|
constructfromWAsync
|
|
(S.fromList [])
|
|
(S.fromList [])
|
|
[]
|
|
|
|
|
|
describe "Functor operations" $ do
|
|
wAsyncOps $ functorOps S.fromFoldable "wAsyncly" sortEq
|
|
wAsyncOps $ functorOps folded "wAsyncly folded" sortEq
|
|
|
|
describe "Monoid operations" $ do
|
|
wAsyncOps $ monoidOps "wAsyncly" mempty sortEq
|
|
|
|
describe "WAsync loops" $ loops fromWAsync sort sort
|
|
|
|
describe "Bind and Monoidal composition combinations" $ do
|
|
wAsyncOps $ bindAndComposeSimpleOps "WAsync" sortEq
|
|
wAsyncOps $ bindAndComposeHierarchyOps "WAsync"
|
|
wAsyncOps $ nestTwoStreams "WAsync" sort sort
|
|
wAsyncOps $ nestTwoStreamsApp "WAsync" sort sort
|
|
|
|
describe "Semigroup operations" $ do
|
|
wAsyncOps $ semigroupOps "wAsyncly" sortEq
|
|
|
|
describe "Applicative operations" $ do
|
|
wAsyncOps $ applicativeOps S.fromFoldable "wAsyncly applicative" sortEq
|
|
wAsyncOps $ applicativeOps folded "wAsyncly applicative folded" sortEq
|
|
|
|
-- XXX add tests for indexed/indexedR
|
|
describe "Zip operations" $
|
|
-- We test only the serial zip with serial streams and the parallel
|
|
-- stream, because the rate setting in these streams can slow down
|
|
-- zipAsync.
|
|
do
|
|
wAsyncOps $ prop "zip applicative wAsyncly" . zipAsyncApplicative S.fromFoldable (==)
|
|
wAsyncOps $ prop "zip applicative wAsyncly folded" . zipAsyncApplicative folded (==)
|
|
wAsyncOps $
|
|
prop "zip monadic wAsyncly" . zipAsyncMonadic S.fromFoldable (==)
|
|
wAsyncOps $ prop "zip monadic wAsyncly folded" . zipAsyncMonadic folded (==)
|
|
|
|
-- XXX add merge tests like zip tests
|
|
-- for mergeBy, we can split a list randomly into two lists and
|
|
-- then merge them, it should result in original list
|
|
-- describe "Merge operations" $ do
|
|
|
|
describe "Monad operations" $ do
|
|
wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq
|
|
wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq
|
|
wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq
|
|
wAsyncOps $ prop "wAsyncly monad bind folded" . monadBind folded sortEq
|
|
|
|
describe "Stream transform and combine operations" $ do
|
|
wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq
|
|
wAsyncOps $ transformCombineOpsCommon folded "wAsyncly" sortEq
|
|
|
|
describe "Stream elimination operations" $ do
|
|
wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"
|
|
wAsyncOps $ eliminationOps folded "wAsyncly folded"
|
|
wAsyncOps $ eliminationOpsWord8 S.fromFoldable "wAsyncly"
|
|
wAsyncOps $ eliminationOpsWord8 folded "wAsyncly folded"
|
|
|
|
-- describe "WAsync interleaved (<>) ordering check" $
|
|
-- interleaveCheck fromWAsync (<>)
|
|
-- describe "WAsync interleaved mappend ordering check" $
|
|
-- interleaveCheck fromWAsync mappend
|
|
|
|
-- XXX this keeps failing intermittently, need to investigate
|
|
-- describe "WAsync (<>) time order check" $
|
|
-- parallelCheck fromWAsync (<>)
|
|
-- describe "WAsync mappend time order check" $
|
|
-- parallelCheck fromWAsync mappend
|
|
|
|
describe "Tests for exceptions" $ wAsyncOps $ exceptionOps "wAsyncly"
|
|
describe "Composed MonadThrow wAsyncly" $ composeWithMonadThrow fromWAsync
|
|
|
|
-- Ad-hoc tests
|
|
it "takes n from stream of streams" (takeCombined 3 fromWAsync)
|
|
|
|
#ifdef DEVBUILD
|
|
let timed :: (IsStream t, Monad (t IO)) => Int -> t IO Int
|
|
timed x = S.fromEffect (threadDelay (x * 100000)) >> return x
|
|
|
|
-- These are not run fromParallel because the timing gets affected
|
|
-- unpredictably when other tests are running on the same machine.
|
|
--
|
|
-- Also, they fail intermittently due to scheduling delays, so not run on
|
|
-- CI machines.
|
|
describe "Nested parallel and serial compositions" $ do
|
|
let t = timed
|
|
p = fromWAsync
|
|
s = fromSerial
|
|
{-
|
|
-- This is not correct, the result can also be [4,4,8,0,8,0,2,2]
|
|
-- because of parallelism of [8,0] and [8,0].
|
|
it "Nest <|>, <>, <|> (1)" $
|
|
let t = timed
|
|
in toListSerial (
|
|
((t 8 <|> t 4) <> (t 2 <|> t 0))
|
|
<|> ((t 8 <|> t 4) <> (t 2 <|> t 0)))
|
|
`shouldReturn` ([4,4,8,8,0,0,2,2])
|
|
-}
|
|
it "Nest <|>, <>, <|> (2)" $
|
|
(S.toList . fromWAsync) (
|
|
s (p (t 4 <> t 8) <> p (t 1 <> t 2))
|
|
<> s (p (t 4 <> t 8) <> p (t 1 <> t 2)))
|
|
`shouldReturn` ([4,4,8,8,1,1,2,2])
|
|
-- FIXME: These two keep failing intermittently on Mac OS X
|
|
-- Need to examine and fix the tests.
|
|
{-
|
|
it "Nest <|>, <=>, <|> (1)" $
|
|
let t = timed
|
|
in toListSerial (
|
|
((t 8 <|> t 4) <=> (t 2 <|> t 0))
|
|
<|> ((t 9 <|> t 4) <=> (t 2 <|> t 0)))
|
|
`shouldReturn` ([4,4,0,0,8,2,9,2])
|
|
it "Nest <|>, <=>, <|> (2)" $
|
|
let t = timed
|
|
in toListSerial (
|
|
((t 4 <|> t 8) <=> (t 1 <|> t 2))
|
|
<|> ((t 4 <|> t 9) <=> (t 1 <|> t 2)))
|
|
`shouldReturn` ([4,4,1,1,8,2,9,2])
|
|
-}
|
|
it "Nest <|>, <|>, <|>" $
|
|
(S.toList . fromWAsync) (
|
|
((t 4 <> t 8) <> (t 0 <> t 2))
|
|
<> ((t 4 <> t 8) <> (t 0 <> t 2)))
|
|
`shouldReturn` ([0,0,2,2,4,4,8,8])
|
|
#endif
|