streamly/benchmark/NestedOps.hs
Harendra Kumar f1670f31ce Move some functions from Streamly to Streamly.Prelude
* `runStream`, `foldWith`, `foldMapWith`, `forEachWith` have been moved from
  "Streamly" module to "Streamly.Prelude" module.
2019-05-04 02:42:38 +05:30

149 lines
4.0 KiB
Haskell

-- |
-- Module : BenchmarkOps
-- Copyright : (c) 2018 Harendra Kumar
--
-- License : MIT
-- Maintainer : harendra.kumar@gmail.com
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module NestedOps where
import Control.Exception (try)
import GHC.Exception (ErrorCall)
import qualified Streamly as S hiding (runStream)
import qualified Streamly.Prelude as S
sumCount :: Int
sumCount = 1000000
prodCount :: Int
prodCount = 100
-------------------------------------------------------------------------------
-- Stream generation and elimination
-------------------------------------------------------------------------------
type Stream m a = S.SerialT m a
{-# INLINE source #-}
source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
source = sourceUnfoldrM
{-# INLINE sourceUnfoldrM #-}
sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
where
step cnt =
if cnt > n + value
then return Nothing
else return (Just (cnt, cnt + 1))
{-# INLINE sourceUnfoldr #-}
sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
sourceUnfoldr start n = S.unfoldr step start
where
step cnt =
if cnt > start + n
then Nothing
else Just (cnt, cnt + 1)
{-# INLINE runStream #-}
runStream :: Monad m => Stream m a -> m ()
runStream = S.runStream
{-# INLINE runToList #-}
runToList :: Monad m => Stream m a -> m [a]
runToList = S.toList
-------------------------------------------------------------------------------
-- Benchmark ops
-------------------------------------------------------------------------------
{-# INLINE toNullAp #-}
toNullAp
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
toNullAp t start = runStream . t $
(+) <$> source start prodCount <*> source start prodCount
{-# INLINE toNull #-}
toNull
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
toNull t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
return $ x + y
{-# INLINE toList #-}
toList
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
toList t start = runToList . t $ do
x <- source start prodCount
y <- source start prodCount
return $ x + y
{-# INLINE toListSome #-}
toListSome
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
toListSome t start =
runToList . t $ S.take 1000 $ do
x <- source start prodCount
y <- source start prodCount
return $ x + y
{-# INLINE filterAllOut #-}
filterAllOut
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
filterAllOut t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if s < 0
then return s
else S.nil
{-# INLINE filterAllIn #-}
filterAllIn
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
filterAllIn t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if s > 0
then return s
else S.nil
{-# INLINE filterSome #-}
filterSome
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
filterSome t start = runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if s > 1100000
then return s
else S.nil
{-# INLINE breakAfterSome #-}
breakAfterSome
:: (S.IsStream t, Monad (t IO))
=> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
breakAfterSome t start = do
(_ :: Either ErrorCall ()) <- try $ runStream . t $ do
x <- source start prodCount
y <- source start prodCount
let s = x + y
if s > 1100000
then error "break"
else return s
return ()