@@ -0,0 +1,103 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Fold
3+-- Copyright : (c) 2018 Composewell
4+--
5+-- License : MIT
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+
10+module Main
11+ (
12+ main
13+ ) where
14+
15+import Control.DeepSeq (NFData(..))
16+import System.Random (randomRIO)
17+import Prelude hiding (any, all, take)
18+
19+import qualified Streamly as S hiding (runStream)
20+import qualified Streamly.Prelude as S
21+import qualified Streamly.Internal.Data.Fold as FL
22+import qualified Streamly.Internal.Data.Parse as PR
23+import qualified Streamly.Internal.Prelude as IP
24+
25+import Gauge
26+import Streamly hiding (runStream)
27+import Streamly.Benchmark.Common
28+
29+-------------------------------------------------------------------------------
30+-- Utilities
31+-------------------------------------------------------------------------------
32+
33+-- XXX these can be moved to the common module
34+
35+-- We need a monadic bind here to make sure that the function f does not get
36+-- completely optimized out by the compiler in some cases.
37+
38+{-# INLINE sourceUnfoldrM #-}
39+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
40+sourceUnfoldrM value n = S.unfoldrM step n
41+ where
42+ step cnt =
43+ if cnt > n + value
44+ then return Nothing
45+ else return (Just (cnt, cnt + 1))
46+
47+-- | Takes a fold method, and uses it with a default source.
48+{-# INLINE benchIOSink #-}
49+benchIOSink
50+ :: (IsStream t, NFData b)
51+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
52+benchIOSink value name f =
53+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
54+
55+-------------------------------------------------------------------------------
56+-- Parsers
57+-------------------------------------------------------------------------------
58+
59+any :: (Monad m, Ord a) => a -> SerialT m a -> m (Either String Bool)
60+any value = IP.parse (PR.any (> value))
61+
62+all :: (Monad m, Ord a) => a -> SerialT m a -> m (Either String Bool)
63+all value = IP.parse (PR.all (<= value))
64+
65+zipAllAny :: (Monad m, Ord a)
66+ => a -> SerialT m a -> m (Either String (Bool, Bool))
67+zipAllAny value = IP.parse ((,) <$> PR.all (<= value) <*> PR.any (> value))
68+
69+take :: Monad m => Int -> SerialT m a -> m (Either String ())
70+take value = IP.parse (FL.take value FL.drain)
71+
72+-------------------------------------------------------------------------------
73+-- Benchmarks
74+-------------------------------------------------------------------------------
75+
76+o_1_space_serial_parse :: Int -> [Benchmark]
77+o_1_space_serial_parse value =
78+ [ benchIOSink value "any" $ any value
79+ , benchIOSink value "all" $ all value
80+ , benchIOSink value "(all,any)" $ zipAllAny value
81+ , benchIOSink value "take" $ take value
82+ ]
83+
84+
85+-------------------------------------------------------------------------------
86+-- Driver
87+-------------------------------------------------------------------------------
88+
89+main :: IO ()
90+main = do
91+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
92+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
93+
94+ where
95+
96+ allBenchmarks value =
97+ [ bgroup "o1"
98+ [ bgroup "parser" $ concat
99+ [
100+ o_1_space_serial_parse value
101+ ]
102+ ]
103+ ]