git.iko.soy/streamly
on 769ce84 help sign in
streamly/benchmark/NestedOps.hs
141 lines 3.8 kB history raw
1-- |
2-- Module : BenchmarkOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : harendra.kumar@gmail.com
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11module NestedOps where
13import Control.Exception (try)
14import GHC.Exception (ErrorCall)
16import qualified Streamly as S
17import qualified Streamly.Prelude as S
19sumCount :: Int
20sumCount = 1000000
22prodCount :: Int
23prodCount = 100
25-------------------------------------------------------------------------------
26-- Stream generation and elimination
27-------------------------------------------------------------------------------
29type Stream m a = S.SerialT m a
31{-# INLINE source #-}
32source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
33source = sourceUnfoldrM
35{-# INLINE sourceUnfoldrM #-}
36sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
37sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
38 where
39 step cnt =
40 if cnt > n + value
41 then return Nothing
42 else return (Just (cnt, cnt + 1))
44{-# INLINE sourceUnfoldr #-}
45sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
46sourceUnfoldr start n = S.unfoldr step start
47 where
48 step cnt =
49 if cnt > start + n
50 then Nothing
51 else Just (cnt, cnt + 1)
53{-# INLINE runStream #-}
54runStream :: Monad m => Stream m a -> m ()
55runStream = S.runStream
57{-# INLINE runToList #-}
58runToList :: Monad m => Stream m a -> m [a]
59runToList = S.toList
61-------------------------------------------------------------------------------
62-- Benchmark ops
63-------------------------------------------------------------------------------
65{-# INLINE toNull #-}
66toNull
67 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
68 => (t m Int -> S.SerialT m Int) -> Int -> m ()
69toNull t start = runStream . t $ do
70 x <- source start prodCount
71 y <- source start prodCount
72 return $ x + y
74{-# INLINE toList #-}
75toList
76 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
77 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
78toList t start = runToList . t $ do
79 x <- source start prodCount
80 y <- source start prodCount
81 return $ x + y
83{-# INLINE toListSome #-}
84toListSome
85 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
86 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
87toListSome t start =
88 runToList . t $ S.take 1000 $ do
89 x <- source start prodCount
90 y <- source start prodCount
91 return $ x + y
93{-# INLINE filterAllOut #-}
94filterAllOut
95 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
96 => (t m Int -> S.SerialT m Int) -> Int -> m ()
97filterAllOut t start = runStream . t $ do
98 x <- source start prodCount
99 y <- source start prodCount
100 let s = x + y
101 if s < 0
102 then return s
103 else S.nil
105{-# INLINE filterAllIn #-}
106filterAllIn
107 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
108 => (t m Int -> S.SerialT m Int) -> Int -> m ()
109filterAllIn t start = runStream . t $ do
110 x <- source start prodCount
111 y <- source start prodCount
112 let s = x + y
113 if s > 0
114 then return s
115 else S.nil
117{-# INLINE filterSome #-}
118filterSome
119 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
120 => (t m Int -> S.SerialT m Int) -> Int -> m ()
121filterSome t start = runStream . t $ do
122 x <- source start prodCount
123 y <- source start prodCount
124 let s = x + y
125 if s > 1100000
126 then return s
127 else S.nil
129{-# INLINE breakAfterSome #-}
130breakAfterSome
131 :: (S.IsStream t, Monad (t IO))
132 => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
133breakAfterSome t start = do
134 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
135 x <- source start prodCount
136 y <- source start prodCount
137 let s = x + y
138 if s > 1100000
139 then error "break"
140 else return s
141 return ()