src/Streamly/Internal/Benchmark/FileIO/Array.hs · streamly

git.iko.soy/streamly

on 4e04eff help sign in

streamly/src/Streamly/Internal/Benchmark/FileIO/Array.hs

242 lines 6.9 kB history raw

1-- |

2-- Module : Streamly.Internal.Benchmark.FileIO.Array

4--

5-- License : BSD3

6-- Maintainer : streamly@composewell.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.Internal.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

49import qualified Streamly.Internal.Data.Unicode.Stream as IUS

51import qualified Streamly.Internal.FileSystem.Handle as IFH

52import qualified Streamly.Internal.Memory.Array as IA

53import qualified Streamly.Internal.Memory.ArrayStream as AS

54import qualified Streamly.Internal.Data.Unfold as IUF

56#ifdef INSPECTION

57import Foreign.Storable (Storable)

58import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))

59import Test.Inspection

60#endif

62-- | Get the last byte from a file bytestream.

63{-# INLINE last #-}

64last :: Handle -> IO (Maybe Word8)

65last inh = do

66 let s = IFH.toChunks inh

67 larr <- S.last s

68 return $ case larr of

69 Nothing -> Nothing

70 Just arr -> IA.readIndex arr (A.length arr - 1)

72#ifdef INSPECTION

73inspect $ hasNoTypeClasses 'last

74inspect $ 'last `hasNoType` ''Step

75#endif

77-- | Count the number of bytes in a file.

78{-# INLINE countBytes #-}

79countBytes :: Handle -> IO Int

80countBytes inh =

81 let s = IFH.toChunks inh

82 in S.sum (S.map A.length s)

84#ifdef INSPECTION

85inspect $ hasNoTypeClasses 'countBytes

86inspect $ 'countBytes `hasNoType` ''Step

87#endif

89-- | Count the number of lines in a file.

90{-# INLINE countLines #-}

91countLines :: Handle -> IO Int

92countLines = S.length . AS.splitOnSuffix 10 . IFH.toChunks

94#ifdef INSPECTION

95inspect $ hasNoTypeClasses 'countLines

96inspect $ 'countLines `hasNoType` ''Step

97#endif

99-- XXX use a word splitting combinator instead of splitOn and test it.

100-- | Count the number of lines in a file.

101{-# INLINE countWords #-}

102countWords :: Handle -> IO Int

103countWords = S.length . AS.splitOn 32 . IFH.toChunks

104

105#ifdef INSPECTION

106inspect $ hasNoTypeClasses 'countWords

107inspect $ 'countWords `hasNoType` ''Step

108#endif

109

110-- | Sum the bytes in a file.

111{-# INLINE sumBytes #-}

112sumBytes :: Handle -> IO Word8

113sumBytes inh = do

114 let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream

115 let s = IFH.toChunks inh

116 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s

117

118#ifdef INSPECTION

119inspect $ hasNoTypeClasses 'sumBytes

120inspect $ 'sumBytes `hasNoType` ''Step

121#endif

122

123-- | Send the file contents to /dev/null

124{-# INLINE cat #-}

125cat :: Handle -> Handle -> IO ()

126cat devNull inh =

127 S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh

128

129#ifdef INSPECTION

130inspect $ hasNoTypeClasses 'cat

131inspect $ 'cat `hasNoType` ''Step

132#endif

133

134-- | Send the file contents to /dev/null with exception handling

135{-# INLINE catBracket #-}

136catBracket :: Handle -> Handle -> IO ()

137catBracket devNull inh =

138 let readEx = IUF.bracket return (\_ -> hClose inh)

139 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))

140 in IUF.fold readEx (IFH.writeChunks devNull) inh

141

142#ifdef INSPECTION

143inspect $ hasNoTypeClasses 'catBracket

144-- inspect $ 'catBracket `hasNoType` ''Step

145#endif

146

147-- | Send the file contents to /dev/null with exception handling

148{-# INLINE catBracketStream #-}

149catBracketStream :: Handle -> Handle -> IO ()

150catBracketStream devNull inh =

151 let readEx = S.bracket (return ()) (\_ -> hClose inh)

152 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)

153 in S.fold (IFH.writeChunks devNull) $ readEx

154

155#ifdef INSPECTION

156inspect $ hasNoTypeClasses 'catBracketStream

157-- inspect $ 'catBracketStream `hasNoType` ''Step

158#endif

159

160-- | Send the file contents to /dev/null with exception handling

161{-# INLINE catOnException #-}

162catOnException :: Handle -> Handle -> IO ()

163catOnException devNull inh =

164 let readEx = IUF.onException (\_ -> hClose inh)

165 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))

166 in IUF.fold readEx (IFH.writeChunks devNull) inh

167

168#ifdef INSPECTION

169inspect $ hasNoTypeClasses 'catOnException

170-- inspect $ 'catOnException `hasNoType` ''Step

171#endif

172

173-- | Copy file

174{-# INLINE copy #-}

175copy :: Handle -> Handle -> IO ()

176copy inh outh =

177 let s = IFH.toChunks inh

178 in S.fold (IFH.writeChunks outh) s

179

180#ifdef INSPECTION

181inspect $ hasNoTypeClasses 'copy

182inspect $ 'copy `hasNoType` ''Step

183#endif

184

185-- | Lines and unlines

186{-# INLINE linesUnlinesCopy #-}

187linesUnlinesCopy :: Handle -> Handle -> IO ()

188linesUnlinesCopy inh outh =

189 S.fold (IFH.writeWithBufferOf (1024*1024) outh)

190 $ AS.interposeSuffix 10

191 $ AS.splitOnSuffix 10

192 $ IFH.toChunksWithBufferOf (1024*1024) inh

193

194#ifdef INSPECTION

195inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]

196-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step

197#endif

198

199-- | Words and unwords

200{-# INLINE wordsUnwordsCopy #-}

201wordsUnwordsCopy :: Handle -> Handle -> IO ()

202wordsUnwordsCopy inh outh =

203 S.fold (IFH.writeWithBufferOf (1024*1024) outh)

204 $ AS.interpose 32

205 -- XXX this is not correct word splitting combinator

206 $ AS.splitOn 32

207 $ IFH.toChunksWithBufferOf (1024*1024) inh

208

209#ifdef INSPECTION

210inspect $ hasNoTypeClassesExcept 'wordsUnwordsCopy [''Storable]

211-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step

212#endif

213

214{-# INLINE decodeUtf8Lenient #-}

215decodeUtf8Lenient :: Handle -> IO ()

216decodeUtf8Lenient inh =

217 S.drain

218 $ IUS.decodeUtf8ArraysLenient

219 $ IFH.toChunksWithBufferOf (1024*1024) inh

220

221#ifdef INSPECTION

222inspect $ hasNoTypeClasses 'decodeUtf8Lenient

223-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step

224-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState

225-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState

226#endif

227

228-- | Copy file

229{-# INLINE copyCodecUtf8Lenient #-}

230copyCodecUtf8Lenient :: Handle -> Handle -> IO ()

231copyCodecUtf8Lenient inh outh =

232 S.fold (FH.write outh)

233 $ SS.encodeUtf8

234 $ IUS.decodeUtf8ArraysLenient

235 $ IFH.toChunksWithBufferOf (1024*1024) inh

236

237#ifdef INSPECTION

238inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient

239-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step

240-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState

241-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState

242#endif