git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/lib/Streamly/Benchmark/Common/Handle.hs
217 lines 6.1 kB history raw
1-- |
2-- Module : Streamly.Benchmark.Common.Handle
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9{-# LANGUAGE CPP #-}
10{-# LANGUAGE ScopedTypeVariables #-}
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.Common.Handle
22 ( BenchEnv (..)
23 , RefHandles (..)
24 , scratchDir
25 , inFileSmall
26 , inFileBig
27 , outfile
28 , mkBench
29 , mkBenchSmall
30 , isSpace
31 , isSp
32 , mkHandleBenchEnv
33 )
34where
36import Control.DeepSeq (NFData(rnf))
37import Data.Char (ord, chr)
38import Data.Word (Word8)
39import System.Directory (getFileSize)
40import System.Environment (lookupEnv)
41import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)
42import System.Process.Typed (shell, runProcess_)
44import Data.IORef
45import Prelude hiding (last, length)
46import Gauge hiding (env)
49scratchDir :: String
50scratchDir = "benchmark-tmp/"
52outfile :: String
53outfile = scratchDir ++ "out.txt"
55inFileSmall :: String
56inFileSmall = scratchDir ++ "in-10MB.txt"
58inFileBig :: String
59inFileBig = scratchDir ++ "in-100MB.txt"
61data RefHandles = RefHandles
62 { smallInH :: Handle
63 , bigInH :: Handle
64 , outputH :: Handle
65 }
67data Handles = Handles !Handle !Handle
69instance NFData Handles where
70 rnf _ = ()
72data BenchEnv = BenchEnv
73 { href :: IORef RefHandles
74 , smallSize :: Int
75 , bigSize :: Int
76 , nullH :: Handle
77 , smallInFile :: String
78 , bigInFile :: String
79 }
81withScaling :: BenchEnv -> String -> String
82withScaling env str =
83 let factor = round (fromIntegral (bigSize env)
84 / (fromIntegral (smallSize env) :: Double)) :: Int
85 in if factor == 1
86 then str
87 else str ++ " (1/" ++ show factor ++ ")"
89getHandles :: BenchEnv -> (RefHandles -> Handles) -> IO Handles
90getHandles env mkHandles = do
91 r <- readIORef $ href env
92 -- close old handles
93 hClose $ smallInH r
94 hClose $ bigInH r
95 hClose $ outputH r
97 -- reopen
98 smallInHandle <- openFile (smallInFile env) ReadMode
99 bigInHandle <- openFile (bigInFile env) ReadMode
100 outHandle <- openFile outfile WriteMode
102 let refHandles = RefHandles
103 { smallInH = smallInHandle
104 , bigInH = bigInHandle
105 , outputH = outHandle
106 }
108 -- update
109 writeIORef (href env) refHandles
110 return $ mkHandles refHandles
112mkBenchCommon ::
113 NFData b
114 => (RefHandles -> Handles)
115 -> String
116 -> BenchEnv
117 -> (Handle -> Handle -> IO b)
118 -> Benchmark
119mkBenchCommon mkHandles name env action =
120 bench name $ nfIO $ do
121 -- XXX adds significant cpu time to the benchmarks
122 -- tasty-bench should provide a better way to do this
123 (Handles h1 h2) <- getHandles env mkHandles
124 action h1 h2
126mkBench ::
127 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
128mkBench name env action = mkBenchCommon useBigH name env action
130 where
132 useBigH (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh
134mkBenchSmall ::
135 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
136mkBenchSmall name env action =
137 mkBenchCommon useSmallH (withScaling env name) env action
139 where
141 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
143foreign import ccall unsafe "u_iswspace"
144 iswspace :: Int -> Int
146-- Code copied from base/Data.Char to INLINE it
147{-# INLINE isSpace #-}
148isSpace :: Char -> Bool
149-- isSpace includes non-breaking space
150-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
151-- at or below 0x377 have been assigned, so we shouldn't have to worry about
152-- any new spaces appearing below there. It would probably be best to
153-- use branchless ||, but currently the eqLit transformation will undo that,
154-- so we'll do it like this until there's a way around that.
155isSpace c
156 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
157 | otherwise = iswspace (ord c) /= 0
158 where
159 uc = fromIntegral (ord c) :: Word
161{-# INLINE isSp #-}
162isSp :: Word8 -> Bool
163isSp = isSpace . chr . fromIntegral
165smallFileSize :: Int
166smallFileSize = 10 * 1024 * 1024
168bigFileSize :: Int
169bigFileSize = 100 * 1024 * 1024
171mkHandleBenchEnv :: IO BenchEnv
172mkHandleBenchEnv = do
173 r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"
174 (small, big) <-
175 case r of
176 Just inFileName -> return (inFileName, inFileName)
177 Nothing -> do
178 -- XXX will this work on windows/msys?
179 let cmd infile size =
180 "mkdir -p " ++ scratchDir
181 ++ "; test -e " ++ infile
182 ++ " || { echo \"creating input file " ++ infile
183 ++ "\" && head -c " ++ show size
184 ++ " </dev/urandom >" ++ infile
185 ++ ";}"
186 runProcess_ (shell (cmd inFileSmall smallFileSize))
187 runProcess_ (shell (cmd inFileBig bigFileSize))
188 return (inFileSmall, inFileBig)
190 hPutStrLn stderr $ "Using small input file: " ++ small
191 smallHandle <- openFile small ReadMode
193 hPutStrLn stderr $ "Using big input file: " ++ big
194 bigHandle <- openFile big ReadMode
196 hPutStrLn stderr $ "Using output file: " ++ outfile
197 outHandle <- openFile outfile WriteMode
198 devNull <- openFile "/dev/null" WriteMode
200 ssize <- fromIntegral <$> getFileSize small
201 bsize <- fromIntegral <$> getFileSize big
203 ref <- newIORef $ RefHandles
204 { smallInH = smallHandle
205 , bigInH = bigHandle
206 , outputH = outHandle
207 }
209 let env = BenchEnv
210 { href = ref
211 , smallSize = ssize
212 , bigSize = bsize
213 , nullH = devNull
214 , smallInFile = small
215 , bigInFile = big
216 }
217 return env