git.iko.soy/streamly
on master help sign in
Add inspection testing for fileio benchmarks
120175cHarendra Kumar
.travis.yml+1−1
compare with master
unifiedsplit
@@ -132,7 +132,7 @@ matrix:
132 #- env: BUILD=stack RESOLVER=nightly
132 #- env: BUILD=stack RESOLVER=nightly
133 # addons: {apt: {packages: [cabal-install-1.24], sources: [hvr-ghc]}}
133 # addons: {apt: {packages: [cabal-install-1.24], sources: [hvr-ghc]}}
134
134
135− - env: BUILD=stack RESOLVER=lts-13 GHCVER=8.6 STACK_BUILD_OPTIONS="--flag streamly:examples-sdl"
135+ - env: BUILD=stack RESOLVER=lts-13 GHCVER=8.6 STACK_BUILD_OPTIONS="--flag streamly:examples-sdl --flag streamly:benchmark"
136 addons: {apt: {packages: [cabal-install-2.4,libsdl1.2-dev], sources: [hvr-ghc]}}
136 addons: {apt: {packages: [cabal-install-2.4,libsdl1.2-dev], sources: [hvr-ghc]}}
137
137
138 #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
138 #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
benchmark/FileIO.hs+44−130
@@ -8,24 +8,14 @@
8{-# LANGUAGE CPP #-}
8{-# LANGUAGE CPP #-}
9
9
10import Control.DeepSeq (NFData)
10import Control.DeepSeq (NFData)
11−import Data.Functor.Identity (runIdentity)
12import System.IO (openFile, IOMode(..), Handle, hClose)
11import System.IO (openFile, IOMode(..), Handle, hClose)
13import System.Process.Typed (shell, runProcess_)
12import System.Process.Typed (shell, runProcess_)
14
13
15import Data.IORef
14import Data.IORef
16import Gauge
15import Gauge
17
16
18−import qualified Streamly.FileSystem.Handle as FH
17+import qualified Streamly.Benchmark.FileIO.Stream as BFS
19−import qualified Streamly.Memory.Array as A
18+import qualified Streamly.Benchmark.FileIO.Array as BFA
20−import qualified Streamly.Prelude as S
21−import qualified Streamly.Fold as FL
22−import qualified Streamly.Data.String as SS
23−import qualified Streamly.Internal as Internal
24−
25−#ifdef DEVBUILD
26−import Data.Char (ord, chr)
27−import qualified Streamly.Internal as Internal
28−#endif
29
19
30-- Input and output file handles
20-- Input and output file handles
31data Handles = Handles Handle Handle
21data Handles = Handles Handle Handle
@@ -51,23 +41,6 @@ infile = "benchmark/text-processing/gutenberg-500.txt"
51fileSize :: Int
41fileSize :: Int
52fileSize = blockSize * blockCount
42fileSize = blockSize * blockCount
53
43
54−foreign import ccall unsafe "u_iswspace"
55− iswspace :: Int -> Int
56−
57−-- Code copied from base/Data.Char to INLINE it
58−{-# INLINE isSpace #-}
59−isSpace :: Char -> Bool
60−-- isSpace includes non-breaking space
61−-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
62−-- at or below 0x377 have been assigned, so we shouldn't have to worry about
63−-- any new spaces appearing below there. It would probably be best to
64−-- use branchless ||, but currently the eqLit transformation will undo that,
65−-- so we'll do it like this until there's a way around that.
66−isSpace c
67− | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
68− | otherwise = iswspace (ord c) /= 0
69− where
70− uc = fromIntegral (ord c) :: Word
71#else
44#else
72infile :: String
45infile :: String
73infile = scratchDir ++ "in-100MB.txt"
46infile = scratchDir ++ "in-100MB.txt"
@@ -96,213 +69,154 @@ main = do
96 [ bgroup "readArray"
69 [ bgroup "readArray"
97 [ mkBench "last" href $ do
70 [ mkBench "last" href $ do
98 Handles inh _ <- readIORef href
71 Handles inh _ <- readIORef href
99− let s = FH.readArrays inh
100− larr <- S.last s
72+ BFA.last inh
101− return $ case larr of
102− Nothing -> Nothing
103− Just arr -> A.readIndex arr (A.length arr - 1)
104 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
73 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
105 -- wc uses lseek to just determine the file size rather than reading
74 -- wc uses lseek to just determine the file size rather than reading
106 -- and counting characters.
75 -- and counting characters.
107 , mkBench "length (bytecount)" href $ do
76 , mkBench "length (bytecount)" href $ do
108 Handles inh _ <- readIORef href
77 Handles inh _ <- readIORef href
109− let s = FH.readArrays inh
78+ BFA.countBytes inh
110− S.sum (S.map A.length s)
111 , mkBench "linecount" href $ do
79 , mkBench "linecount" href $ do
112 Handles inh _ <- readIORef href
80 Handles inh _ <- readIORef href
113− S.length $ A.splitOn 10 $ FH.readArrays inh
81+ BFA.countLines inh
114 , mkBench "sum" href $ do
82 , mkBench "sum" href $ do
115− let foldlArr' f z = runIdentity . S.foldl' f z . A.read
116 Handles inh _ <- readIORef href
83 Handles inh _ <- readIORef href
117− let s = FH.readArrays inh
84+ BFA.sumBytes inh
118− S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
119 , mkBench "cat" href $ do
85 , mkBench "cat" href $ do
120 Handles inh _ <- readIORef href
86 Handles inh _ <- readIORef href
121− S.runFold (FH.writeArrays devNull) $ FH.readArraysOf (256*1024) inh
87+ BFA.cat devNull inh
122 ]
88 ]
123 , bgroup "readStream"
89 , bgroup "readStream"
124 [ mkBench "last" href $ do
90 [ mkBench "last" href $ do
125 Handles inh _ <- readIORef href
91 Handles inh _ <- readIORef href
126− S.last $ FH.read inh
92+ BFS.last inh
127 , mkBench "length (bytecount)" href $ do
93 , mkBench "length (bytecount)" href $ do
128 Handles inh _ <- readIORef href
94 Handles inh _ <- readIORef href
129− S.length $ FH.read inh
95+ BFS.countBytes inh
130 , mkBench "linecount" href $ do
96 , mkBench "linecount" href $ do
131 Handles inh _ <- readIORef href
97 Handles inh _ <- readIORef href
132− S.length
98+ BFS.countLines inh
133− $ SS.foldLines FL.drain
134− $ SS.decodeChar8
135− $ FH.read inh
136 , mkBench "linecountU" href $ do
99 , mkBench "linecountU" href $ do
137 Handles inh _ <- readIORef href
100 Handles inh _ <- readIORef href
138− S.length
101+ BFS.countLinesU inh
139− $ SS.foldLines FL.drain
140− $ SS.decodeChar8
141− $ Internal.concatMapU Internal.readU (FH.readArrays inh)
142 , mkBench "sum" href $ do
102 , mkBench "sum" href $ do
143 Handles inh _ <- readIORef href
103 Handles inh _ <- readIORef href
144− S.sum $ FH.read inh
104+ BFS.sumBytes inh
145 , mkBench "cat" href $ do
105 , mkBench "cat" href $ do
146 Handles inh _ <- readIORef href
106 Handles inh _ <- readIORef href
147− S.runFold (FH.write devNull) $ FH.read inh
107+ BFS.cat devNull inh
148 , mkBench "catStream" href $ do
108 , mkBench "catStream" href $ do
149 Handles inh _ <- readIORef href
109 Handles inh _ <- readIORef href
150− Internal.writeS devNull $ FH.read inh
110+ BFS.catStreamWrite devNull inh
151 ]
111 ]
152 , bgroup "copyArray"
112 , bgroup "copyArray"
153 [ mkBench "copy" href $ do
113 [ mkBench "copy" href $ do
154 Handles inh outh <- readIORef href
114 Handles inh outh <- readIORef href
155− let s = FH.readArrays inh
115+ BFA.copy inh outh
156− S.runFold (FH.writeArrays outh) s
157 ]
116 ]
158#ifdef DEVBUILD
117#ifdef DEVBUILD
159 -- This takes a little longer therefore put under the dev conditional
118 -- This takes a little longer therefore put under the dev conditional
160 , bgroup "copyStream"
119 , bgroup "copyStream"
161 [ mkBench "fromToHandle" href $ do
120 [ mkBench "fromToHandle" href $ do
162 Handles inh outh <- readIORef href
121 Handles inh outh <- readIORef href
163− S.runFold (FH.write outh) (FH.read inh)
122+ BFS.copy inh outh
164 ]
123 ]
165 -- This needs an ascii file, as decode just errors out.
124 -- This needs an ascii file, as decode just errors out.
166 , bgroup "decode-encode"
125 , bgroup "decode-encode"
167 [ mkBench "char8" href $ do
126 [ mkBench "char8" href $ do
168 Handles inh outh <- readIORef href
127 Handles inh outh <- readIORef href
169− S.runFold (FH.write outh)
128+ BFS.copyCodecChar8 inh outh
170− $ SS.encodeChar8
171− $ SS.decodeChar8
172− $ FH.read inh
173 , mkBench "utf8" href $ do
129 , mkBench "utf8" href $ do
174 Handles inh outh <- readIORef href
130 Handles inh outh <- readIORef href
175− S.runFold (FH.write outh)
131+ BFS.copyCodecUtf8 inh outh
176− $ SS.encodeUtf8
177− $ SS.decodeUtf8
178− $ FH.read inh
179 ]
132 ]
180 , bgroup "grouping"
133 , bgroup "grouping"
181− [ mkBench "chunksOf 1 (A.writeNF)" href $ do
134+ [ mkBench "chunksOf 1 (A.writeN)" href $ do
182 Handles inh _ <- readIORef href
135 Handles inh _ <- readIORef href
183− S.length $ S.chunksOf fileSize (A.writeN fileSize)
136+ BFS.chunksOf fileSize inh
184− (FH.read inh)
185
137
186 , mkBench "chunksOf 1" href $ do
138 , mkBench "chunksOf 1" href $ do
187 Handles inh _ <- readIORef href
139 Handles inh _ <- readIORef href
188− S.length $ S.chunksOf 1 FL.drain (FH.read inh)
140+ BFS.chunksOf 1 inh
189 , mkBench "chunksOf 10" href $ do
141 , mkBench "chunksOf 10" href $ do
190 Handles inh _ <- readIORef href
142 Handles inh _ <- readIORef href
191− S.length $ S.chunksOf 10 FL.drain (FH.read inh)
143+ BFS.chunksOf 10 inh
192 , mkBench "chunksOf 1000" href $ do
144 , mkBench "chunksOf 1000" href $ do
193 Handles inh _ <- readIORef href
145 Handles inh _ <- readIORef href
194− S.length $ S.chunksOf 1000 FL.drain (FH.read inh)
146+ BFS.chunksOf 1000 inh
195 ]
147 ]
196 , bgroup "group-ungroup"
148 , bgroup "group-ungroup"
197 [ mkBench "lines-unlines" href $ do
149 [ mkBench "lines-unlines" href $ do
198 Handles inh outh <- readIORef href
150 Handles inh outh <- readIORef href
199− S.runFold (FH.write outh)
151+ BFS.linesUnlinesCopy inh outh
200− $ SS.encodeChar8
201− $ SS.unlines
202− $ SS.lines
203− $ SS.decodeChar8
204− $ FH.read inh
205 , mkBench "lines-unlines-arrays" href $ do
152 , mkBench "lines-unlines-arrays" href $ do
206 Handles inh outh <- readIORef href
153 Handles inh outh <- readIORef href
207− S.runFold (FH.writeArraysInChunksOf (1024*1024) outh)
154+ BFA.linesUnlinesCopy inh outh
208− $ Internal.insertAfterEach (return $ A.fromList [10])
209− $ A.splitOn 10
210− $ FH.readArraysOf (1024*1024) inh
211 , mkBench "words-unwords" href $ do
155 , mkBench "words-unwords" href $ do
212 Handles inh outh <- readIORef href
156 Handles inh outh <- readIORef href
213− S.runFold (FH.write outh)
157+ BFS.wordsUnwordsCopy inh outh
214− $ SS.encodeChar8
215− $ SS.unwords
216− $ SS.words
217− $ SS.decodeChar8
218− $ FH.read inh
219 ]
158 ]
220
159
221− , let lf = fromIntegral (ord '\n')
222− lfarr = A.fromList [lf]
223− isSp = isSpace . chr . fromIntegral
224− toarr = A.fromList . map (fromIntegral . ord)
225− in bgroup "splitting"
160+ , bgroup "splitting"
226 [ bgroup "predicate"
161 [ bgroup "predicate"
227 [ mkBench "splitOn \\n (line count)" href $ do
162 [ mkBench "splitOn \\n (line count)" href $ do
228 Handles inh _ <- readIORef href
163 Handles inh _ <- readIORef href
229− (S.length $ S.splitOn (== lf) FL.drain
164+ BFS.splitOn inh
230− $ FH.read inh) -- >>= print
231 , mkBench "splitOnSuffix \\n (line count)" href $ do
165 , mkBench "splitOnSuffix \\n (line count)" href $ do
232 Handles inh _ <- readIORef href
166 Handles inh _ <- readIORef href
233− (S.length $ S.splitOnSuffix (== lf) FL.drain
167+ BFS.splitOnSuffix inh
234− $ FH.read inh) -- >>= print
235 , mkBench "wordsBy isSpace (word count)" href $ do
168 , mkBench "wordsBy isSpace (word count)" href $ do
236 Handles inh _ <- readIORef href
169 Handles inh _ <- readIORef href
237− (S.length $ S.wordsBy isSp FL.drain
170+ BFS.wordsBy inh
238− $ FH.read inh) -- >>= print
239 ]
171 ]
240
172
241 , bgroup "empty-pattern"
173 , bgroup "empty-pattern"
242 [ mkBench "splitOnSeq \"\"" href $ do
174 [ mkBench "splitOnSeq \"\"" href $ do
243 Handles inh _ <- readIORef href
175 Handles inh _ <- readIORef href
244− (S.length $ Internal.splitOnSeq (A.fromList []) FL.drain
176+ BFS.splitOnSeq "" inh
245− $ FH.read inh) -- >>= print
246 , mkBench "splitOnSuffixSeq \"\"" href $ do
177 , mkBench "splitOnSuffixSeq \"\"" href $ do
247 Handles inh _ <- readIORef href
178 Handles inh _ <- readIORef href
248− (S.length $ Internal.splitOnSuffixSeq (A.fromList []) FL.drain
179+ BFS.splitOnSuffixSeq "" inh
249− $ FH.read inh) -- >>= print
250 ]
180 ]
251 , bgroup "short-pattern"
181 , bgroup "short-pattern"
252 [ mkBench "splitOnSeq \\n (line count)" href $ do
182 [ mkBench "splitOnSeq \\n (line count)" href $ do
253 Handles inh _ <- readIORef href
183 Handles inh _ <- readIORef href
254− (S.length $ Internal.splitOnSeq lfarr FL.drain
184+ BFS.splitOnSeq "\n" inh
255− $ FH.read inh) -- >>= print
256 , mkBench "splitOnSuffixSeq \\n (line count)" href $ do
185 , mkBench "splitOnSuffixSeq \\n (line count)" href $ do
257 Handles inh _ <- readIORef href
186 Handles inh _ <- readIORef href
258− (S.length $ Internal.splitOnSuffixSeq lfarr FL.drain
187+ BFS.splitOnSuffixSeq "\n" inh
259− $ FH.read inh) -- >>= print
260 , mkBench "splitOnSeq a" href $ do
188 , mkBench "splitOnSeq a" href $ do
261 Handles inh _ <- readIORef href
189 Handles inh _ <- readIORef href
262− (S.length $ Internal.splitOnSeq (toarr "a") FL.drain
190+ BFS.splitOnSeq "a" inh
263− $ FH.read inh) -- >>= print
264 , mkBench "splitOnSeq \\r\\n" href $ do
191 , mkBench "splitOnSeq \\r\\n" href $ do
265 Handles inh _ <- readIORef href
192 Handles inh _ <- readIORef href
266− (S.length $ Internal.splitOnSeq (toarr "\r\n") FL.drain
193+ BFS.splitOnSeq "\r\n" inh
267− $ FH.read inh) -- >>= print
268 , mkBench "splitOnSuffixSeq \\r\\n)" href $ do
194 , mkBench "splitOnSuffixSeq \\r\\n)" href $ do
269 Handles inh _ <- readIORef href
195 Handles inh _ <- readIORef href
270− (S.length $ Internal.splitOnSuffixSeq (toarr "\r\n") FL.drain
196+ BFS.splitOnSuffixSeq "\r\n" inh
271− $ FH.read inh) -- >>= print
272 , mkBench "splitOnSeq aa" href $ do
197 , mkBench "splitOnSeq aa" href $ do
273 Handles inh _ <- readIORef href
198 Handles inh _ <- readIORef href
274− (S.length $ Internal.splitOnSeq (toarr "aa") FL.drain
199+ BFS.splitOnSeq "aa" inh
275− $ FH.read inh) -- >>= print
276 , mkBench "splitOnSeq aaaa" href $ do
200 , mkBench "splitOnSeq aaaa" href $ do
277 Handles inh _ <- readIORef href
201 Handles inh _ <- readIORef href
278− (S.length $ Internal.splitOnSeq (toarr "aaaa") FL.drain
202+ BFS.splitOnSeq "aaaa" inh
279− $ FH.read inh) -- >>= print
280 , mkBench "splitOnSeq abcdefgh" href $ do
203 , mkBench "splitOnSeq abcdefgh" href $ do
281 Handles inh _ <- readIORef href
204 Handles inh _ <- readIORef href
282− (S.length $ Internal.splitOnSeq (toarr "abcdefgh") FL.drain
205+ BFS.splitOnSeq "abcdefgh" inh
283− $ FH.read inh) -- >>= print
284 ]
206 ]
285 , bgroup "long-pattern"
207 , bgroup "long-pattern"
286 [ mkBench "splitOnSeq abcdefghi" href $ do
208 [ mkBench "splitOnSeq abcdefghi" href $ do
287 Handles inh _ <- readIORef href
209 Handles inh _ <- readIORef href
288− (S.length $ Internal.splitOnSeq (toarr "abcdefghi") FL.drain
210+ BFS.splitOnSeq "abcdefghi" inh
289− $ FH.read inh) -- >>= print
290 , mkBench "splitOnSeq catcatcatcatcat" href $ do
211 , mkBench "splitOnSeq catcatcatcatcat" href $ do
291 Handles inh _ <- readIORef href
212 Handles inh _ <- readIORef href
292− (S.length $ Internal.splitOnSeq (toarr "catcatcatcatcat") FL.drain
213+ BFS.splitOnSeq "catcatcatcatcat" inh
293− $ FH.read inh) -- >>= print
294 , mkBench "splitOnSeq abc...xyz" href $ do
214 , mkBench "splitOnSeq abc...xyz" href $ do
295 Handles inh _ <- readIORef href
215 Handles inh _ <- readIORef href
296− (S.length $ Internal.splitOnSeq
297− (toarr "abcdefghijklmnopqrstuvwxyz")
216+ BFS.splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
298− FL.drain
299− $ FH.read inh) -- >>= print
300 , mkBench "splitOnSuffixSeq abc...xyz" href $ do
217 , mkBench "splitOnSuffixSeq abc...xyz" href $ do
301 Handles inh _ <- readIORef href
218 Handles inh _ <- readIORef href
302− (S.length $ Internal.splitOnSuffixSeq
303− (toarr "abcdefghijklmnopqrstuvwxyz")
219+ BFS.splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
304− FL.drain
305− $ FH.read inh) -- >>= print
306 ]
220 ]
307 ]
221 ]
308#endif
222#endif
src/Streamly/Benchmark/FileIO/Array.hsnew file+112
@@ -0,0 +1,112 @@
1+-- |
2+-- Module : Streamly.Benchmark.FileIO.Array
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : harendra.kumar@gmail.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE TemplateHaskell #-}
11+
12+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
13+
14+module Streamly.Benchmark.FileIO.Array
15+ (
16+ last
17+ , countBytes
18+ , countLines
19+ , sumBytes
20+ , cat
21+ , copy
22+ , linesUnlinesCopy
23+ )
24+where
25+
26+import Data.Functor.Identity (runIdentity)
27+import Data.Word (Word8)
28+import System.IO (Handle)
29+import Prelude hiding (last)
30+
31+import Streamly.Benchmark.Inspection (hinspect)
32+import Streamly.Streams.StreamD.Type (Step(..))
33+
34+import qualified Streamly.FileSystem.Handle as FH
35+import qualified Streamly.Memory.Array as A
36+import qualified Streamly.Prelude as S
37+import qualified Streamly.Internal as Internal
38+
39+import Test.Inspection
40+
41+-- | Get the last byte from a file bytestream.
42+{-# INLINE last #-}
43+last :: Handle -> IO (Maybe Word8)
44+last inh = do
45+ let s = FH.readArrays inh
46+ larr <- S.last s
47+ return $ case larr of
48+ Nothing -> Nothing
49+ Just arr -> A.readIndex arr (A.length arr - 1)
50+
51+hinspect $ hasNoTypeClasses 'last
52+hinspect $ 'last `hasNoType` ''Step
53+
54+-- | Count the number of bytes in a file.
55+{-# INLINE countBytes #-}
56+countBytes :: Handle -> IO Int
57+countBytes inh =
58+ let s = FH.readArrays inh
59+ in S.sum (S.map A.length s)
60+
61+hinspect $ hasNoTypeClasses 'countBytes
62+hinspect $ 'countBytes `hasNoType` ''Step
63+
64+-- | Count the number of lines in a file.
65+{-# INLINE countLines #-}
66+countLines :: Handle -> IO Int
67+countLines = S.length . A.splitOn 10 . FH.readArrays
68+
69+hinspect $ hasNoTypeClasses 'countLines
70+hinspect $ 'countLines `hasNoType` ''Step
71+
72+-- | Sum the bytes in a file.
73+{-# INLINE sumBytes #-}
74+sumBytes :: Handle -> IO Word8
75+sumBytes inh = do
76+ let foldlArr' f z = runIdentity . S.foldl' f z . A.read
77+ let s = FH.readArrays inh
78+ S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
79+
80+hinspect $ hasNoTypeClasses 'sumBytes
81+hinspect $ 'sumBytes `hasNoType` ''Step
82+
83+-- | Send the file contents to /dev/null
84+{-# INLINE cat #-}
85+cat :: Handle -> Handle -> IO ()
86+cat devNull inh =
87+ S.runFold (FH.writeArrays devNull) $ FH.readArraysOf (256*1024) inh
88+
89+hinspect $ hasNoTypeClasses 'cat
90+hinspect $ 'cat `hasNoType` ''Step
91+
92+-- | Copy file
93+{-# INLINE copy #-}
94+copy :: Handle -> Handle -> IO ()
95+copy inh outh =
96+ let s = FH.readArrays inh
97+ in S.runFold (FH.writeArrays outh) s
98+
99+hinspect $ hasNoTypeClasses 'copy
100+hinspect $ 'copy `hasNoType` ''Step
101+
102+-- | Lines and unlines
103+{-# INLINE linesUnlinesCopy #-}
104+linesUnlinesCopy :: Handle -> Handle -> IO ()
105+linesUnlinesCopy inh outh =
106+ S.runFold (FH.writeArraysInChunksOf (1024*1024) outh)
107+ $ Internal.insertAfterEach (return $ A.fromList [10])
108+ $ A.splitOn 10
109+ $ FH.readArraysOf (1024*1024) inh
110+
111+-- hinspect $ hasNoTypeClasses 'linesUnlinesCopy
112+-- hinspect $ 'linesUnlinesCopy `hasNoType` ''Step
src/Streamly/Benchmark/FileIO/Stream.hsnew file+263
@@ -0,0 +1,263 @@
1+-- |
2+-- Module : Streamly.Benchmark.FileIO.Stream
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : harendra.kumar@gmail.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE TemplateHaskell #-}
11+
12+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
13+
14+module Streamly.Benchmark.FileIO.Stream
15+ (
16+ -- * FileIO
17+ last
18+ , countBytes
19+ , countLines
20+ , countLinesU
21+ , sumBytes
22+ , cat
23+ , catStreamWrite
24+ , copy
25+ , linesUnlinesCopy
26+ , wordsUnwordsCopy
27+ , copyCodecChar8
28+ , copyCodecUtf8
29+ , chunksOf
30+ , splitOn
31+ , splitOnSuffix
32+ , wordsBy
33+ , splitOnSeq
34+ , splitOnSuffixSeq
35+ )
36+where
37+
38+import Data.Char (ord, chr)
39+import Data.Word (Word8)
40+import System.IO (Handle)
41+import Prelude hiding (last, length)
42+
43+import Streamly.Streams.StreamD.Type (Step(..))
44+import Streamly.Benchmark.Inspection (hinspect)
45+
46+import qualified Streamly.FileSystem.Handle as FH
47+import qualified Streamly.Memory.Array as A
48+import qualified Streamly.Prelude as S
49+import qualified Streamly.Fold as FL
50+import qualified Streamly.Data.String as SS
51+import qualified Streamly.Internal as Internal
52+
53+import Test.Inspection
54+
55+-- | Get the last byte from a file bytestream.
56+{-# INLINE last #-}
57+last :: Handle -> IO (Maybe Word8)
58+last = S.last . FH.read
59+
60+hinspect $ hasNoTypeClasses 'last
61+hinspect $ 'last `hasNoType` ''Step
62+
63+-- | Count the number of bytes in a file.
64+{-# INLINE countBytes #-}
65+countBytes :: Handle -> IO Int
66+countBytes = S.length . FH.read
67+
68+hinspect $ hasNoTypeClasses 'countBytes
69+hinspect $ 'countBytes `hasNoType` ''Step
70+
71+-- | Count the number of lines in a file.
72+{-# INLINE countLines #-}
73+countLines :: Handle -> IO Int
74+countLines =
75+ S.length
76+ . SS.foldLines FL.drain
77+ . SS.decodeChar8
78+ . FH.read
79+
80+hinspect $ hasNoTypeClasses 'countLines
81+hinspect $ 'countLines `hasNoType` ''Step
82+
83+-- | Count the number of lines in a file.
84+{-# INLINE countLinesU #-}
85+countLinesU :: Handle -> IO Int
86+countLinesU inh =
87+ S.length
88+ $ SS.foldLines FL.drain
89+ $ SS.decodeChar8
90+ $ Internal.concatMapU Internal.readU (FH.readArrays inh)
91+
92+hinspect $ hasNoTypeClasses 'countLinesU
93+hinspect $ 'countLinesU `hasNoType` ''Step
94+
95+-- | Sum the bytes in a file.
96+{-# INLINE sumBytes #-}
97+sumBytes :: Handle -> IO Word8
98+sumBytes = S.sum . FH.read
99+
100+hinspect $ hasNoTypeClasses 'sumBytes
101+hinspect $ 'sumBytes `hasNoType` ''Step
102+
103+-- | Send the file contents to /dev/null
104+{-# INLINE cat #-}
105+cat :: Handle -> Handle -> IO ()
106+cat devNull inh = S.runFold (FH.write devNull) $ FH.read inh
107+
108+hinspect $ hasNoTypeClasses 'cat
109+hinspect $ 'cat `hasNoType` ''Step
110+
111+-- | Send the file contents to /dev/null
112+{-# INLINE catStreamWrite #-}
113+catStreamWrite :: Handle -> Handle -> IO ()
114+catStreamWrite devNull inh = Internal.writeS devNull $ FH.read inh
115+
116+hinspect $ hasNoTypeClasses 'catStreamWrite
117+hinspect $ 'catStreamWrite `hasNoType` ''Step
118+
119+-- | Copy file
120+{-# INLINE copy #-}
121+copy :: Handle -> Handle -> IO ()
122+copy inh outh = S.runFold (FH.write outh) (FH.read inh)
123+
124+hinspect $ hasNoTypeClasses 'copy
125+hinspect $ 'copy `hasNoType` ''Step
126+
127+-- | Copy file
128+{-# INLINE copyCodecChar8 #-}
129+copyCodecChar8 :: Handle -> Handle -> IO ()
130+copyCodecChar8 inh outh =
131+ S.runFold (FH.write outh)
132+ $ SS.encodeChar8
133+ $ SS.decodeChar8
134+ $ FH.read inh
135+
136+hinspect $ hasNoTypeClasses 'copyCodecChar8
137+hinspect $ 'copyCodecChar8 `hasNoType` ''Step
138+
139+-- | Copy file
140+{-# INLINE copyCodecUtf8 #-}
141+copyCodecUtf8 :: Handle -> Handle -> IO ()
142+copyCodecUtf8 inh outh =
143+ S.runFold (FH.write outh)
144+ $ SS.encodeUtf8
145+ $ SS.decodeUtf8
146+ $ FH.read inh
147+
148+hinspect $ hasNoTypeClasses 'copyCodecUtf8
149+-- hinspect $ 'copyCodecUtf8 `hasNoType` ''Step
150+
151+-- | Slice in chunks of size n and get the count of chunks.
152+{-# INLINE chunksOf #-}
153+chunksOf :: Int -> Handle -> IO Int
154+chunksOf n inh =
155+ S.length $ S.chunksOf n (A.writeN n) (FH.read inh)
156+
157+hinspect $ hasNoTypeClasses 'chunksOf
158+-- hinspect $ 'chunksOf `hasNoType` ''Step
159+
160+-- | Lines and unlines
161+{-# INLINE linesUnlinesCopy #-}
162+linesUnlinesCopy :: Handle -> Handle -> IO ()
163+linesUnlinesCopy inh outh =
164+ S.runFold (FH.write outh)
165+ $ SS.encodeChar8
166+ $ SS.unlines
167+ $ SS.lines
168+ $ SS.decodeChar8
169+ $ FH.read inh
170+
171+-- hinspect $ hasNoTypeClasses 'linesUnlinesCopy
172+-- hinspect $ 'linesUnlinesCopy `hasNoType` ''Step
173+
174+-- | Word, unwords and copy
175+{-# INLINE wordsUnwordsCopy #-}
176+wordsUnwordsCopy :: Handle -> Handle -> IO ()
177+wordsUnwordsCopy inh outh =
178+ S.runFold (FH.write outh)
179+ $ SS.encodeChar8
180+ $ SS.unwords
181+ $ SS.words
182+ $ SS.decodeChar8
183+ $ FH.read inh
184+
185+-- hinspect $ hasNoTypeClasses 'wordsUnwordsCopy
186+-- hinspect $ 'wordsUnwordsCopy `hasNoType` ''Step
187+
188+lf :: Word8
189+lf = fromIntegral (ord '\n')
190+
191+toarr :: String -> A.Array Word8
192+toarr = A.fromList . map (fromIntegral . ord)
193+
194+foreign import ccall unsafe "u_iswspace"
195+ iswspace :: Int -> Int
196+
197+-- Code copied from base/Data.Char to INLINE it
198+{-# INLINE isSpace #-}
199+isSpace :: Char -> Bool
200+-- isSpace includes non-breaking space
201+-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
202+-- at or below 0x377 have been assigned, so we shouldn't have to worry about
203+-- any new spaces appearing below there. It would probably be best to
204+-- use branchless ||, but currently the eqLit transformation will undo that,
205+-- so we'll do it like this until there's a way around that.
206+isSpace c
207+ | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
208+ | otherwise = iswspace (ord c) /= 0
209+ where
210+ uc = fromIntegral (ord c) :: Word
211+
212+isSp :: Word8 -> Bool
213+isSp = isSpace . chr . fromIntegral
214+
215+-- | Split on line feed.
216+{-# INLINE splitOn #-}
217+splitOn :: Handle -> IO Int
218+splitOn inh =
219+ (S.length $ S.splitOn (== lf) FL.drain
220+ $ FH.read inh) -- >>= print
221+
222+hinspect $ hasNoTypeClasses 'splitOn
223+hinspect $ 'splitOn `hasNoType` ''Step
224+
225+-- | Split suffix on line feed.
226+{-# INLINE splitOnSuffix #-}
227+splitOnSuffix :: Handle -> IO Int
228+splitOnSuffix inh =
229+ (S.length $ S.splitOnSuffix (== lf) FL.drain
230+ $ FH.read inh) -- >>= print
231+
232+hinspect $ hasNoTypeClasses 'splitOnSuffix
233+hinspect $ 'splitOnSuffix `hasNoType` ''Step
234+
235+-- | Words by space
236+{-# INLINE wordsBy #-}
237+wordsBy :: Handle -> IO Int
238+wordsBy inh =
239+ (S.length $ S.wordsBy isSp FL.drain
240+ $ FH.read inh) -- >>= print
241+
242+hinspect $ hasNoTypeClasses 'wordsBy
243+hinspect $ 'wordsBy `hasNoType` ''Step
244+
245+-- | Split on a character sequence.
246+{-# INLINE splitOnSeq #-}
247+splitOnSeq :: String -> Handle -> IO Int
248+splitOnSeq str inh =
249+ (S.length $ Internal.splitOnSeq (toarr str) FL.drain
250+ $ FH.read inh) -- >>= print
251+
252+hinspect $ hasNoTypeClasses 'splitOnSeq
253+-- hinspect $ 'splitOnSeq `hasNoType` ''Step
254+
255+-- | Split on suffix sequence.
256+{-# INLINE splitOnSuffixSeq #-}
257+splitOnSuffixSeq :: String -> Handle -> IO Int
258+splitOnSuffixSeq str inh =
259+ (S.length $ Internal.splitOnSuffixSeq (toarr str) FL.drain
260+ $ FH.read inh) -- >>= print
261+
262+hinspect $ hasNoTypeClasses 'splitOnSuffixSeq
263+-- hinspect $ 'splitOnSuffixSeq `hasNoType` ''Step
src/Streamly/Benchmark/Inspection.hsnew file+29
@@ -0,0 +1,29 @@
1+-- |
2+-- Module : Streamly.Benchmark.Inspection
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : harendra.kumar@gmail.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE TemplateHaskell #-}
12+
13+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
14+
15+module Streamly.Benchmark.Inspection
16+ (
17+ hinspect
18+ )
19+where
20+
21+import Test.Inspection
22+import Language.Haskell.TH (Q, Dec)
23+
24+hinspect :: Obligation -> Q [Dec]
25+#ifdef __HADDOCK_VERSION__
26+hinspect _ = return []
27+#else
28+hinspect = inspect
29+#endif
streamly.cabal+27−7
@@ -131,6 +131,11 @@ source-repository head
131 type: git
131 type: git
132 location: https://github.com/composewell/streamly
132 location: https://github.com/composewell/streamly
133
133
134+flag benchmark
135+ description: Benchmark build
136+ manual: True
137+ default: False
138+
134flag dev
139flag dev
135 description: Development build
140 description: Development build
136 manual: True
141 manual: True
@@ -244,11 +249,17 @@ library
244 , Streamly.Tutorial
249 , Streamly.Tutorial
245 , Streamly.Internal
250 , Streamly.Internal
246 if !impl(ghcjs)
251 if !impl(ghcjs)
247− exposed-modules:
252+ exposed-modules:
248 Streamly.Network.Socket
253 Streamly.Network.Socket
249 , Streamly.Network.Server
254 , Streamly.Network.Server
250 , Streamly.Network.Client
255 , Streamly.Network.Client
251
256
257+ if flag(benchmark)
258+ exposed-modules:
259+ Streamly.Benchmark.Inspection
260+ , Streamly.Benchmark.FileIO.Array
261+ , Streamly.Benchmark.FileIO.Stream
262+
252 default-language: Haskell2010
263 default-language: Haskell2010
253 ghc-options: -Wall -fspec-constr-recursive=10
264 ghc-options: -Wall -fspec-constr-recursive=10
254
265
@@ -293,6 +304,10 @@ library
293 , transformers >= 0.4 && < 0.6
304 , transformers >= 0.4 && < 0.6
294 , transformers-base >= 0.4 && < 0.5
305 , transformers-base >= 0.4 && < 0.5
295
306
307+ if flag(benchmark)
308+ build-depends: inspection-testing >= 0.4 && < 0.5
309+ , template-haskell >= 2.14 && < 2.15
310+
296 if !impl(ghcjs)
311 if !impl(ghcjs)
297 build-depends:
312 build-depends:
298 network >= 2.6 && < 4
313 network >= 2.6 && < 4
@@ -738,12 +753,17 @@ benchmark fileio
738 -Wredundant-constraints
753 -Wredundant-constraints
739 -Wnoncanonical-monad-instances
754 -Wnoncanonical-monad-instances
740 -Wnoncanonical-monadfail-instances
755 -Wnoncanonical-monadfail-instances
756+ if flag(benchmark)
757+ buildable: True
741− build-depends:
758+ build-depends:
742− streamly
759+ streamly
743− , base >= 4.8 && < 5
760+ , base >= 4.8 && < 5
744− , gauge >= 0.2.4 && < 0.3
761+ , gauge >= 0.2.4 && < 0.3
762+ , inspection-testing >= 0.4 && < 0.5
745− , typed-process >= 0.2.3 && < 0.3
763+ , typed-process >= 0.2.3 && < 0.3
746− , deepseq >= 1.4.1 && < 1.5
764+ , deepseq >= 1.4.1 && < 1.5
765+ else
766+ buildable: False
747
767
748benchmark concurrent
768benchmark concurrent
749 type: exitcode-stdio-1.0
769 type: exitcode-stdio-1.0