git.iko.soy/streamly
on ab6587b help sign in
streamly/src/Streamly/Benchmark/FileIO/Array.hs
241 lines 6.8 kB history raw
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
10{-# LANGUAGE CPP #-}
12#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#endif
16#ifdef INSPECTION
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21module Streamly.Benchmark.FileIO.Array
22 (
23 last
24 , countBytes
25 , countLines
26 , countWords
27 , sumBytes
28 , cat
29 , catOnException
30 , catBracket
31 , catBracketStream
32 , copy
33 , linesUnlinesCopy
34 , wordsUnwordsCopy
35 , decodeUtf8Lenient
36 , copyCodecUtf8Lenient
37 )
38where
40import Data.Functor.Identity (runIdentity)
41import Data.Word (Word8)
42import System.IO (Handle, hClose)
43import Prelude hiding (last)
45import qualified Streamly.FileSystem.Handle as FH
46import qualified Streamly.Memory.Array as A
47import qualified Streamly.Prelude as S
48import qualified Streamly.Data.Unicode.Stream as SS
50import qualified Streamly.Internal.FileSystem.Handle as IFH
51import qualified Streamly.Internal.Memory.Array as IA
52import qualified Streamly.Internal.Memory.ArrayStream as AS
53import qualified Streamly.Internal.Data.Unfold as IUF
55#ifdef INSPECTION
56import Foreign.Storable (Storable)
57import Streamly.Streams.StreamD.Type (Step(..))
58import Test.Inspection
59#endif
61-- | Get the last byte from a file bytestream.
62{-# INLINE last #-}
63last :: Handle -> IO (Maybe Word8)
64last inh = do
65 let s = IFH.toStreamArrays inh
66 larr <- S.last s
67 return $ case larr of
68 Nothing -> Nothing
69 Just arr -> A.readIndex arr (A.length arr - 1)
71#ifdef INSPECTION
72inspect $ hasNoTypeClasses 'last
73inspect $ 'last `hasNoType` ''Step
74#endif
76-- | Count the number of bytes in a file.
77{-# INLINE countBytes #-}
78countBytes :: Handle -> IO Int
79countBytes inh =
80 let s = IFH.toStreamArrays inh
81 in S.sum (S.map A.length s)
83#ifdef INSPECTION
84inspect $ hasNoTypeClasses 'countBytes
85inspect $ 'countBytes `hasNoType` ''Step
86#endif
88-- | Count the number of lines in a file.
89{-# INLINE countLines #-}
90countLines :: Handle -> IO Int
91countLines = S.length . AS.splitOnSuffix 10 . IFH.toStreamArrays
93#ifdef INSPECTION
94inspect $ hasNoTypeClasses 'countLines
95inspect $ 'countLines `hasNoType` ''Step
96#endif
98-- XXX use a word splitting combinator instead of splitOn and test it.
99-- | Count the number of lines in a file.
100{-# INLINE countWords #-}
101countWords :: Handle -> IO Int
102countWords = S.length . AS.splitOn 32 . IFH.toStreamArrays
104#ifdef INSPECTION
105inspect $ hasNoTypeClasses 'countWords
106inspect $ 'countWords `hasNoType` ''Step
107#endif
109-- | Sum the bytes in a file.
110{-# INLINE sumBytes #-}
111sumBytes :: Handle -> IO Word8
112sumBytes inh = do
113 let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream
114 let s = IFH.toStreamArrays inh
115 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117#ifdef INSPECTION
118inspect $ hasNoTypeClasses 'sumBytes
119inspect $ 'sumBytes `hasNoType` ''Step
120#endif
122-- | Send the file contents to /dev/null
123{-# INLINE cat #-}
124cat :: Handle -> Handle -> IO ()
125cat devNull inh =
126 S.fold (IFH.writeArrays devNull) $ IFH.toStreamArraysOf (256*1024) inh
128#ifdef INSPECTION
129inspect $ hasNoTypeClasses 'cat
130inspect $ 'cat `hasNoType` ''Step
131#endif
133-- | Send the file contents to /dev/null with exception handling
134{-# INLINE catBracket #-}
135catBracket :: Handle -> Handle -> IO ()
136catBracket devNull inh =
137 let readEx = IUF.bracket return (\_ -> hClose inh)
138 (IUF.supplyFirst FH.readArraysOf (256*1024))
139 in IUF.fold readEx (IFH.writeArrays devNull) inh
141#ifdef INSPECTION
142inspect $ hasNoTypeClasses 'catBracket
143-- inspect $ 'catBracket `hasNoType` ''Step
144#endif
146-- | Send the file contents to /dev/null with exception handling
147{-# INLINE catBracketStream #-}
148catBracketStream :: Handle -> Handle -> IO ()
149catBracketStream devNull inh =
150 let readEx = S.bracket (return ()) (\_ -> hClose inh)
151 (\_ -> IFH.toStreamArraysOf (256*1024) inh)
152 in S.fold (IFH.writeArrays devNull) $ readEx
154#ifdef INSPECTION
155inspect $ hasNoTypeClasses 'catBracketStream
156-- inspect $ 'catBracketStream `hasNoType` ''Step
157#endif
159-- | Send the file contents to /dev/null with exception handling
160{-# INLINE catOnException #-}
161catOnException :: Handle -> Handle -> IO ()
162catOnException devNull inh =
163 let readEx = IUF.onException (\_ -> hClose inh)
164 (IUF.supplyFirst FH.readArraysOf (256*1024))
165 in IUF.fold readEx (IFH.writeArrays devNull) inh
167#ifdef INSPECTION
168inspect $ hasNoTypeClasses 'catOnException
169-- inspect $ 'catOnException `hasNoType` ''Step
170#endif
172-- | Copy file
173{-# INLINE copy #-}
174copy :: Handle -> Handle -> IO ()
175copy inh outh =
176 let s = IFH.toStreamArrays inh
177 in S.fold (IFH.writeArrays outh) s
179#ifdef INSPECTION
180inspect $ hasNoTypeClasses 'copy
181inspect $ 'copy `hasNoType` ''Step
182#endif
184-- | Lines and unlines
185{-# INLINE linesUnlinesCopy #-}
186linesUnlinesCopy :: Handle -> Handle -> IO ()
187linesUnlinesCopy inh outh =
188 S.fold (IFH.writeInChunksOf (1024*1024) outh)
189 $ AS.interposeSuffix 10
190 $ AS.splitOnSuffix 10
191 $ IFH.toStreamArraysOf (1024*1024) inh
193#ifdef INSPECTION
194inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
195-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
196#endif
198-- | Words and unwords
199{-# INLINE wordsUnwordsCopy #-}
200wordsUnwordsCopy :: Handle -> Handle -> IO ()
201wordsUnwordsCopy inh outh =
202 S.fold (IFH.writeInChunksOf (1024*1024) outh)
203 $ AS.interpose 32
204 -- XXX this is not correct word splitting combinator
205 $ AS.splitOn 32
206 $ IFH.toStreamArraysOf (1024*1024) inh
208#ifdef INSPECTION
209inspect $ hasNoTypeClassesExcept 'wordsUnwordsCopy [''Storable]
210-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
211#endif
213{-# INLINE decodeUtf8Lenient #-}
214decodeUtf8Lenient :: Handle -> IO ()
215decodeUtf8Lenient inh =
216 S.drain
217 $ SS.decodeUtf8ArraysLenient
218 $ IFH.toStreamArraysOf (1024*1024) inh
220#ifdef INSPECTION
221inspect $ hasNoTypeClasses 'decodeUtf8Lenient
222-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
223-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
224-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
225#endif
227-- | Copy file
228{-# INLINE copyCodecUtf8Lenient #-}
229copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
230copyCodecUtf8Lenient inh outh =
231 S.fold (FH.write outh)
232 $ SS.encodeUtf8
233 $ SS.decodeUtf8ArraysLenient
234 $ IFH.toStreamArraysOf (1024*1024) inh
236#ifdef INSPECTION
237inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
238-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
239-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
240-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
241#endif