git.iko.soy/streamly
on 294aa21 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs
162 lines 5.1 kB history raw
1-- |
2-- Module : Streamly.Benchmark.Data.ParserK
3-- Copyright : (c) 2020 Composewell Technologies
4--
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE FlexibleContexts #-}
10module Main
11 (
12 main
13 ) where
15import Control.DeepSeq (NFData(..))
16import Control.Monad.Catch (MonadCatch)
17import Data.Foldable (asum)
18import System.Random (randomRIO)
19import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21import qualified Control.Applicative as AP
22import qualified Data.Foldable as F
23import qualified Data.Traversable as TR
24import qualified Streamly as S hiding (runStream)
25import qualified Streamly.Prelude as S
26import qualified Streamly.Internal.Data.Parser.ParserK.Types as PR
27import qualified Streamly.Internal.Data.Parser.ParserD as PRD
28import qualified Streamly.Internal.Prelude as IP
30import Gauge
31import Streamly hiding (runStream)
32import Streamly.Benchmark.Common
34-------------------------------------------------------------------------------
35-- Utilities
36-------------------------------------------------------------------------------
38-- XXX these can be moved to the common module
40{-# INLINE sourceUnfoldrM #-}
41sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
42sourceUnfoldrM value n = S.unfoldrM step n
43 where
44 step cnt =
45 if cnt > n + value
46 then return Nothing
47 else return (Just (cnt, cnt + 1))
49-- | Takes a fold method, and uses it with a default source.
50{-# INLINE benchIOSink #-}
51benchIOSink
52 :: (IsStream t, NFData b)
53 => Int -> String -> (t IO Int -> IO b) -> Benchmark
54benchIOSink value name f =
55 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
57-------------------------------------------------------------------------------
58-- Parsers
59-------------------------------------------------------------------------------
61{-# INLINE satisfy #-}
62satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
63satisfy = PRD.toParserK . PRD.satisfy
65{-# INLINE any #-}
66any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
67any = PRD.toParserK . PRD.any
69{-# INLINE anyK #-}
70anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
71anyK value = IP.parseK (any (> value))
73{-# INLINE splitApp #-}
74splitApp :: MonadCatch m
75 => Int -> SerialT m Int -> m (Bool, Bool)
76splitApp value =
77 IP.parseK ((,) <$> any (>= (value `div` 2)) <*> any (> value))
79{-# INLINE sequenceA #-}
80sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
81sequenceA value xs = do
82 let parser = satisfy (> 0)
83 list = Prelude.replicate value parser
84 x <- IP.parseK (TR.sequenceA list) xs
85 return $ Prelude.length x
87{-# INLINE sequenceA_ #-}
88sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
89sequenceA_ value xs = do
90 let parser = satisfy (> 0)
91 list = Prelude.replicate value parser
92 IP.parseK (F.sequenceA_ list) xs
94{-# INLINE sequence #-}
95sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
96sequence value xs = do
97 let parser = satisfy (> 0)
98 list = Prelude.replicate value parser
99 x <- IP.parseK (TR.sequence list) xs
100 return $ Prelude.length x
102{-# INLINE manyAlt #-}
103manyAlt :: MonadCatch m => SerialT m Int -> m Int
104manyAlt xs = do
105 x <- IP.parseK (AP.many (satisfy (> 0))) xs
106 return $ Prelude.length x
108{-# INLINE someAlt #-}
109someAlt :: MonadCatch m => SerialT m Int -> m Int
110someAlt xs = do
111 x <- IP.parseK (AP.some (satisfy (> 0))) xs
112 return $ Prelude.length x
114{-# INLINE choice #-}
115choice :: MonadCatch m => Int -> SerialT m Int -> m Int
116choice value =
117 IP.parseK (asum (replicate value (satisfy (< 0)))
118 AP.<|> satisfy (> 0))
120-------------------------------------------------------------------------------
121-- Benchmarks
122-------------------------------------------------------------------------------
124moduleName :: String
125moduleName = "Data.Parser.ParserK"
127o_1_space_serial :: Int -> [Benchmark]
128o_1_space_serial value =
129 [ benchIOSink value "any" $ anyK value
130 , benchIOSink value "splitApp" $ splitApp value
131 ]
133-- O(n) heap beacuse of accumulation of the list in strict IO monad?
134o_n_heap_serial :: Int -> [Benchmark]
135o_n_heap_serial value =
136 [ benchIOSink value "sequenceA" $ sequenceA value
137 , benchIOSink value "sequenceA_" $ sequenceA_ value
138 , benchIOSink value "sequence" $ sequence value
139 , benchIOSink value "manyAlt" manyAlt
140 , benchIOSink value "someAlt" someAlt
141 , benchIOSink value "choice" $ choice value
142 ]
144-------------------------------------------------------------------------------
145-- Driver
146-------------------------------------------------------------------------------
148main :: IO ()
149main = do
150 (value, cfg, benches) <- parseCLIOpts defaultStreamSize
151 value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
153 where
155 allBenchmarks value =
156 [ bgroup (o_1_space_prefix moduleName) $ concat
157 [ o_1_space_serial value
158 ]
159 , bgroup (o_n_heap_prefix moduleName) $ concat
160 [ o_n_heap_serial value
161 ]
162 ]