mirror of
https://github.com/ilyakooo0/streamly.git
synced 2024-09-11 08:25:40 +03:00
122 lines
4.8 KiB
Haskell
122 lines
4.8 KiB
Haskell
{-# OPTIONS_GHC -Wno-deprecations #-}
|
|
|
|
-- |
|
|
-- Module : Streamly.Test.Prelude.Parallel
|
|
-- Copyright : (c) 2020 Composewell Technologies
|
|
--
|
|
-- License : BSD-3-Clause
|
|
-- Maintainer : streamly@composewell.com
|
|
-- Stability : experimental
|
|
-- Portability : GHC
|
|
|
|
module Streamly.Test.Prelude.Parallel (main) where
|
|
|
|
import Data.List (sort)
|
|
import Test.Hspec.QuickCheck
|
|
import Test.Hspec as H
|
|
|
|
import Streamly.Prelude
|
|
import qualified Streamly.Prelude as S
|
|
|
|
import Streamly.Test.Prelude.Common
|
|
|
|
moduleName :: String
|
|
moduleName = "Prelude.Parallel"
|
|
|
|
main :: IO ()
|
|
main = hspec
|
|
$ H.parallel
|
|
#ifdef COVERAGE_BUILD
|
|
$ modifyMaxSuccess (const 10)
|
|
#endif
|
|
$ describe moduleName $ do
|
|
let
|
|
#ifndef COVERAGE_BUILD
|
|
parallelCommonOps :: IsStream t => [(String, ParallelT m a -> t m a)]
|
|
#endif
|
|
parallelCommonOps = []
|
|
#ifndef COVERAGE_BUILD
|
|
<> [("rate AvgRate 0.00000001", fromParallel . avgRate 0.00000001)]
|
|
<> [("maxBuffer (-1)", fromParallel . maxBuffer (-1))]
|
|
#endif
|
|
let parallelOps :: IsStream t
|
|
=> ((ParallelT IO a -> t IO a) -> Spec) -> Spec
|
|
parallelOps spec = mapOps spec $ makeOps fromParallel <> parallelCommonOps
|
|
|
|
describe "Construction" $ do
|
|
parallelOps $ prop "parallely replicateM" . constructWithReplicateM
|
|
parallelOps $ prop "parallely cons" . constructWithCons S.cons
|
|
-- parallelOps $ prop "parallely consM" . constructWithConsM S.consM sort
|
|
parallelOps $ prop "parallely (.:)" . constructWithCons (S..:)
|
|
-- parallelOps $ prop "parallely (|:)" . constructWithConsM (S.|:) sort
|
|
|
|
describe "Functor operations" $ do
|
|
parallelOps $ functorOps S.fromFoldable "parallely" sortEq
|
|
parallelOps $ functorOps folded "parallely folded" sortEq
|
|
|
|
describe "Monoid operations" $ do
|
|
parallelOps $ monoidOps "parallely" mempty sortEq
|
|
|
|
describe "Parallel loops" $ loops fromParallel sort sort
|
|
|
|
describe "Bind and Monoidal composition combinations" $ do
|
|
-- XXX Taking a long time when parallelOps is used.
|
|
bindAndComposeSimpleOps "Parallel" sortEq fromParallel
|
|
bindAndComposeHierarchyOps "Parallel" fromParallel
|
|
parallelOps $ nestTwoStreams "Parallel" sort sort
|
|
parallelOps $ nestTwoStreamsApp "Parallel" sort sort
|
|
|
|
describe "Semigroup operations" $ do
|
|
parallelOps $ semigroupOps "parallely" sortEq
|
|
|
|
describe "Applicative operations" $ do
|
|
parallelOps $ applicativeOps folded "parallely applicative folded" sortEq
|
|
|
|
-- XXX add tests for indexed/indexedR
|
|
describe "Zip operations" $ do
|
|
-- We test only the serial zip with serial streams and the parallel
|
|
-- stream, because the rate setting in these streams can slow down
|
|
-- zipAsync.
|
|
parallelOps $ prop "zip monadic parallely" . zipMonadic S.fromFoldable (==)
|
|
parallelOps $ prop "zip monadic parallely folded" . zipMonadic 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
|
|
parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq
|
|
parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq
|
|
parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq
|
|
parallelOps $ prop "parallely monad bind folded" . monadBind folded sortEq
|
|
|
|
describe "Stream transform and combine operations" $ do
|
|
parallelOps $ transformCombineOpsCommon S.fromFoldable "parallely" sortEq
|
|
parallelOps $ transformCombineOpsCommon folded "parallely" sortEq
|
|
|
|
describe "Stream elimination operations" $ do
|
|
parallelOps $ eliminationOps S.fromFoldable "parallely"
|
|
parallelOps $ eliminationOps folded "parallely folded"
|
|
parallelOps $ eliminationOpsWord8 S.fromFoldable "parallely"
|
|
parallelOps $ eliminationOpsWord8 folded "parallely folded"
|
|
|
|
-- test both (<>) and mappend to make sure we are using correct instance
|
|
-- for Monoid that is using the right version of semigroup. Instance
|
|
-- deriving can cause us to pick wrong instances sometimes.
|
|
|
|
#ifdef DEVBUILD
|
|
describe "Parallel (<>) time order check" $ parallelCheck fromParallel (<>)
|
|
describe "Parallel mappend time order check" $ parallelCheck fromParallel mappend
|
|
#endif
|
|
|
|
describe "Tests for exceptions" $ parallelOps $ exceptionOps "parallely"
|
|
describe "Composed MonadThrow parallely" $ composeWithMonadThrow fromParallel
|
|
|
|
#ifdef DEVBUILD
|
|
-- fromParallel fails on CI machines, may need more difference in times of
|
|
-- the events, but that would make tests even slower.
|
|
it "take 1 parallely" $ checkCleanup 3 fromParallel (S.take 1)
|
|
it "takeWhile (< 0) parallely" $ checkCleanup 3 fromParallel (S.takeWhile (< 0))
|
|
#endif
|