on master help sign in
Fix a performance issue with File.read

We were using bracket on a loop which iterates very frequently. Instead use it on an outer loop which is much leass frequent. Also add FileIO.hs to test drive the performance of FileIO APIs.

commitfc6d77a025b16d12967def7f91945e2ba977e4ce authorHarendra Kumar <harendra.kumar@gmail.com> dateFri 31 May 2019, 09:49 (7 years ago) parente190032
3 files changed+67−1
examples/FileIO.hs+52 src/Streamly/FileSystem/File.hs+2−1 streamly.cabal+13
examples/FileIO.hsnew file+52
@@ -0,0 +1,52 @@
1+import qualified Streamly.Prelude as S
2+import qualified Streamly.Fold as FL
3+import qualified Streamly.Mem.Array as A
4+import qualified Streamly.FileSystem.File as File
5+
6+import Data.Char (ord)
7+import System.Environment (getArgs)
8+
9+cat :: FilePath -> IO ()
10+cat src = File.writeArrays "/dev/stdout" $ File.readArraysUpto (256*1024) src
11+
12+cp :: FilePath -> FilePath -> IO ()
13+cp src dst = File.writeArrays dst $ File.readArraysUpto (256*1024) src
14+
15+ord' :: Num a => Char -> a
16+ord' = (fromIntegral . ord)
17+
18+wcl :: FilePath -> IO ()
19+wcl src = print =<< (S.length
20+ $ FL.splitSuffixBy (== ord' '\n') FL.drain
21+ $ File.read src)
22+
23+grepc :: String -> FilePath -> IO ()
24+grepc pat src = print . (subtract 1) =<< (S.length
25+ $ FL.splitOn (A.fromList (map ord' pat)) FL.drain
26+ $ File.read src)
27+
28+avgll :: FilePath -> IO ()
29+avgll src = print =<< (FL.foldl' avg
30+ $ FL.splitSuffixBy (== ord' '\n') FL.length
31+ $ File.read src)
32+ where avg = (/) <$> toDouble FL.sum <*> toDouble FL.length
33+ toDouble = fmap (fromIntegral :: Int -> Double)
34+
35+llhisto :: FilePath -> IO ()
36+llhisto src = print =<< (FL.foldl' (FL.classify FL.length)
37+ $ S.map bucket
38+ $ FL.splitSuffixBy (== ord' '\n') FL.length
39+ $ File.read src)
40+ where
41+ bucket n = let i = n `div` 10 in if i > 9 then (9,n) else (i,n)
42+
43+main :: IO ()
44+main = do
45+ src <- fmap head getArgs
46+
47+ putStrLn "cat" >> cat src -- Unix cat program
48+ putStr "wcl " >> wcl src -- Unix wc -l program
49+ putStr "grepc " >> grepc "aaaa" src -- Unix grep -c program
50+ putStr "avgll " >> avgll src -- get average line length
51+ putStr "llhisto " >> llhisto src -- get line length histogram
52+ putStr "cp " >> cp src "dst-xyz.txt" -- Unix cp program
src/Streamly/FileSystem/File.hs+2−1
@@ -150,6 +150,7 @@ import qualified Streamly.Prelude as S
150150-- raising an exception. If closing the handle raises an exception, then
151151-- this exception will be raised by 'withFile' rather than any exception
152152-- raised by 'act'.
153+{-# INLINE withFile #-}
153154withFile :: (IsStream t, MonadCatch m, MonadIO m)
154155 => FilePath -> IOMode -> (Handle -> t m a) -> t m a
155156withFile file mode = S.bracket (liftIO $ openFile file mode) (liftIO . hClose)
@@ -232,7 +233,7 @@ readByChunksUpto chunkSize h = A.flattenArrays $ readArraysUpto chunkSize h
232233-- @since 0.7.0
233234{-# INLINE read #-}
234235read :: (IsStream t, MonadCatch m, MonadIO m) => FilePath -> t m Word8
235−read file = withFile file ReadMode FH.read
236+read file = A.flattenArrays $ withFile file ReadMode FH.readArrays
236237
237238{-
238239-- | Generate a stream of elements of the given type from a file 'Handle'. The
streamly.cabal+13
@@ -944,3 +944,16 @@ executable HandleIO
944944 , base >= 4.8 && < 5
945945 else
946946 buildable: False
947+
948+executable FileIO
949+ default-language: Haskell2010
950+ main-is: FileIO.hs
951+ hs-source-dirs: examples
952+ ghc-options: -Wall
953+ if flag(examples) || flag(examples-sdl)
954+ buildable: True
955+ build-Depends:
956+ streamly
957+ , base >= 4.8 && < 5
958+ else
959+ buildable: False