@@ -0,0 +1,207 @@
2+-- Module : Streamly.Benchmark.Data.ParserD
3+-- Copyright : (c) 2020 Composewell Technologies
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
12+#ifdef __HADDOCK_VERSION__
17+{-# LANGUAGE TemplateHaskell #-}
18+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
26+import Data.Functor.Identity (runIdentity)
27+import Data.Word (Word8)
28+import System.IO (Handle)
29+import Prelude hiding ()
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
37+import Gauge hiding (env)
38+import Streamly.Benchmark.Common
39+import Streamly.Benchmark.Common.Handle
42+import Foreign.Storable (Storable)
43+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
44+import Test.Inspection
47+-------------------------------------------------------------------------------
48+-- read chunked using toChunks
49+-------------------------------------------------------------------------------
51+-- | Get the last byte from a file bytestream.
52+toChunksLast :: Handle -> IO (Maybe Word8)
54+ let s = Handle.toChunks inh
55+ larr <- Stream.last s
56+ return $ case larr of
58+ Just arr -> Array.readIndex arr (Array.length arr - 1)
61+inspect $ hasNoTypeClasses 'toChunksLast
62+inspect $ 'toChunksLast `hasNoType` ''Step
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)
72+inspect $ hasNoTypeClasses 'toChunksSumLengths
73+inspect $ 'toChunksSumLengths `hasNoType` ''Step
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
84+inspect $ hasNoTypeClasses 'toChunksCountBytes
85+inspect $ 'toChunksCountBytes `hasNoType` ''Step
88+toChunksDecodeUtf8Arrays :: Handle -> IO ()
89+toChunksDecodeUtf8Arrays =
90+ Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
93+inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
94+-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
97+-------------------------------------------------------------------------------
99+-------------------------------------------------------------------------------
101+-- | Count the number of lines in a file.
102+toChunksSplitOnSuffix :: Handle -> IO Int
103+toChunksSplitOnSuffix =
104+ Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
107+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
108+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
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
117+inspect $ hasNoTypeClasses 'toChunksSplitOn
118+inspect $ 'toChunksSplitOn `hasNoType` ''Step
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 _ ->
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 _ ->
136+ , mkBench "countBytes" env $ \inH _ ->
137+ toChunksCountBytes inH
138+ , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
139+ toChunksDecodeUtf8Arrays inH
143+-------------------------------------------------------------------------------
144+-- copy with group/ungroup transformations
145+-------------------------------------------------------------------------------
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
157+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
158+inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
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
172+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
173+inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
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
186+-------------------------------------------------------------------------------
188+-------------------------------------------------------------------------------
191+moduleName = "Data.Array.Stream.Foreign"
195+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
196+ env <- mkHandleBenchEnv
197+ value `seq` runMode (mode cfg) cfg benches
203+ [ bgroup (o_1_space_prefix moduleName)
204+ ( o_1_space_read_chunked env
205+ ++ o_1_space_copy_toChunks_group_ungroup env