@@ -0,0 +1,207 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ParserD
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+
12+#ifdef __HADDOCK_VERSION__
13+#undef INSPECTION
14+#endif
15+
16+#ifdef INSPECTION
17+{-# LANGUAGE TemplateHaskell #-}
18+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19+#endif
20+
21+module Main
22+ (
23+ main
24+ ) where
25+
26+import Data.Functor.Identity (runIdentity)
27+import Data.Word (Word8)
28+import System.IO (Handle)
29+import Prelude hiding ()
30+
31+import qualified Streamly.Prelude as Stream
32+import qualified Streamly.Internal.Data.Array.Foreign as Array
33+import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
34+import qualified Streamly.Internal.FileSystem.Handle as Handle
35+import qualified Streamly.Internal.Unicode.Stream as Unicode
36+
37+import Gauge hiding (env)
38+import Streamly.Benchmark.Common
39+import Streamly.Benchmark.Common.Handle
40+
41+#ifdef INSPECTION
42+import Foreign.Storable (Storable)
43+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
44+import Test.Inspection
45+#endif
46+
47+-------------------------------------------------------------------------------
48+-- read chunked using toChunks
49+-------------------------------------------------------------------------------
50+
51+-- | Get the last byte from a file bytestream.
52+toChunksLast :: Handle -> IO (Maybe Word8)
53+toChunksLast inh = do
54+ let s = Handle.toChunks inh
55+ larr <- Stream.last s
56+ return $ case larr of
57+ Nothing -> Nothing
58+ Just arr -> Array.readIndex arr (Array.length arr - 1)
59+
60+#ifdef INSPECTION
61+inspect $ hasNoTypeClasses 'toChunksLast
62+inspect $ 'toChunksLast `hasNoType` ''Step
63+#endif
64+
65+-- | Count the number of bytes in a file.
66+toChunksSumLengths :: Handle -> IO Int
67+toChunksSumLengths inh =
68+ let s = Handle.toChunks inh
69+ in Stream.sum (Stream.map Array.length s)
70+
71+#ifdef INSPECTION
72+inspect $ hasNoTypeClasses 'toChunksSumLengths
73+inspect $ 'toChunksSumLengths `hasNoType` ''Step
74+#endif
75+
76+-- | Sum the bytes in a file.
77+toChunksCountBytes :: Handle -> IO Word8
78+toChunksCountBytes inh = do
79+ let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream
80+ let s = Handle.toChunks inh
81+ Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
82+
83+#ifdef INSPECTION
84+inspect $ hasNoTypeClasses 'toChunksCountBytes
85+inspect $ 'toChunksCountBytes `hasNoType` ''Step
86+#endif
87+
88+toChunksDecodeUtf8Arrays :: Handle -> IO ()
89+toChunksDecodeUtf8Arrays =
90+ Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
91+
92+#ifdef INSPECTION
93+inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
94+-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
95+#endif
96+
97+-------------------------------------------------------------------------------
98+-- Splitting
99+-------------------------------------------------------------------------------
100+
101+-- | Count the number of lines in a file.
102+toChunksSplitOnSuffix :: Handle -> IO Int
103+toChunksSplitOnSuffix =
104+ Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
105+
106+#ifdef INSPECTION
107+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
108+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
109+#endif
110+
111+-- XXX use a word splitting combinator instead of splitOn and test it.
112+-- | Count the number of words in a file.
113+toChunksSplitOn :: Handle -> IO Int
114+toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks
115+
116+#ifdef INSPECTION
117+inspect $ hasNoTypeClasses 'toChunksSplitOn
118+inspect $ 'toChunksSplitOn `hasNoType` ''Step
119+#endif
120+
121+o_1_space_read_chunked :: BenchEnv -> [Benchmark]
122+o_1_space_read_chunked env =
123+ -- read using toChunks instead of read
124+ [ bgroup "reduce/toChunks"
125+ [ mkBench "Stream.last" env $ \inH _ ->
126+ toChunksLast inH
127+ -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
128+ -- wc uses lseek to just determine the file size rather than reading
129+ -- and counting characters.
130+ , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
131+ toChunksSumLengths inH
132+ , mkBench "splitOnSuffix" env $ \inH _ ->
133+ toChunksSplitOnSuffix inH
134+ , mkBench "splitOn" env $ \inH _ ->
135+ toChunksSplitOn inH
136+ , mkBench "countBytes" env $ \inH _ ->
137+ toChunksCountBytes inH
138+ , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
139+ toChunksDecodeUtf8Arrays inH
140+ ]
141+ ]
142+
143+-------------------------------------------------------------------------------
144+-- copy with group/ungroup transformations
145+-------------------------------------------------------------------------------
146+
147+-- | Lines and unlines
148+{-# NOINLINE copyChunksSplitInterposeSuffix #-}
149+copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
150+copyChunksSplitInterposeSuffix inh outh =
151+ Stream.fold (Handle.write outh)
152+ $ ArrayStream.interposeSuffix 10
153+ $ ArrayStream.splitOnSuffix 10
154+ $ Handle.toChunks inh
155+
156+#ifdef INSPECTION
157+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
158+inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
159+#endif
160+
161+-- | Words and unwords
162+{-# NOINLINE copyChunksSplitInterpose #-}
163+copyChunksSplitInterpose :: Handle -> Handle -> IO ()
164+copyChunksSplitInterpose inh outh =
165+ Stream.fold (Handle.write outh)
166+ $ ArrayStream.interpose 32
167+ -- XXX this is not correct word splitting combinator
168+ $ ArrayStream.splitOn 32
169+ $ Handle.toChunks inh
170+
171+#ifdef INSPECTION
172+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
173+inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
174+#endif
175+
176+o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
177+o_1_space_copy_toChunks_group_ungroup env =
178+ [ bgroup "copy/toChunks/group-ungroup"
179+ [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
180+ copyChunksSplitInterposeSuffix inh outh
181+ , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
182+ copyChunksSplitInterpose inh outh
183+ ]
184+ ]
185+
186+-------------------------------------------------------------------------------
187+-- Driver
188+-------------------------------------------------------------------------------
189+
190+moduleName :: String
191+moduleName = "Data.Array.Stream.Foreign"
192+
193+main :: IO ()
194+main = do
195+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
196+ env <- mkHandleBenchEnv
197+ value `seq` runMode (mode cfg) cfg benches
198+ (allBenchmarks env)
199+
200+ where
201+
202+ allBenchmarks env =
203+ [ bgroup (o_1_space_prefix moduleName)
204+ ( o_1_space_read_chunked env
205+ ++ o_1_space_copy_toChunks_group_ungroup env
206+ )
207+ ]