git.iko.soy/streamly
on 4300a9f help sign in
streamly/benchmark/lib/Streamly/Benchmark/Common/Handle.hs
226 lines 6.3 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)
38#if MIN_VERSION_base(4,17,0)
39import Data.Char (generalCategory, GeneralCategory(Space))
40#endif
41import Data.Word (Word8)
42import System.Directory (getFileSize)
43import System.Environment (lookupEnv)
44import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)
45import System.Process (callCommand)
47import Data.IORef
48import Prelude hiding (last, length)
49import Gauge hiding (env)
52scratchDir :: String
53scratchDir = "benchmark-tmp/"
55outfile :: String
56outfile = scratchDir ++ "out.txt"
58inFileSmall :: String
59inFileSmall = scratchDir ++ "in-10MB.txt"
61inFileBig :: String
62inFileBig = scratchDir ++ "in-100MB.txt"
64data RefHandles = RefHandles
65 { smallInH :: Handle
66 , bigInH :: Handle
67 , outputH :: Handle
68 }
70data Handles = Handles !Handle !Handle
72instance NFData Handles where
73 rnf _ = ()
75data BenchEnv = BenchEnv
76 { href :: IORef RefHandles
77 , smallSize :: Int
78 , bigSize :: Int
79 , nullH :: Handle
80 , smallInFile :: String
81 , bigInFile :: String
82 }
84withScaling :: BenchEnv -> String -> String
85withScaling env str =
86 let factor = round (fromIntegral (bigSize env)
87 / (fromIntegral (smallSize env) :: Double)) :: Int
88 in if factor == 1
89 then str
90 else str ++ " (1/" ++ show factor ++ ")"
92getHandles :: BenchEnv -> (RefHandles -> Handles) -> IO Handles
93getHandles env mkHandles = do
94 r <- readIORef $ href env
95 -- close old handles
96 hClose $ smallInH r
97 hClose $ bigInH r
98 hClose $ outputH r
100 -- reopen
101 smallInHandle <- openFile (smallInFile env) ReadMode
102 bigInHandle <- openFile (bigInFile env) ReadMode
103 outHandle <- openFile outfile WriteMode
105 let refHandles = RefHandles
106 { smallInH = smallInHandle
107 , bigInH = bigInHandle
108 , outputH = outHandle
109 }
111 -- update
112 writeIORef (href env) refHandles
113 return $ mkHandles refHandles
115mkBenchCommon ::
116 NFData b
117 => (RefHandles -> Handles)
118 -> String
119 -> BenchEnv
120 -> (Handle -> Handle -> IO b)
121 -> Benchmark
122mkBenchCommon mkHandles name env action =
123 bench name $ nfIO $ do
124 -- XXX adds significant cpu time to the benchmarks
125 -- tasty-bench should provide a better way to do this
126 (Handles h1 h2) <- getHandles env mkHandles
127 action h1 h2
129mkBench ::
130 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
131mkBench name env action = mkBenchCommon useBigH name env action
133 where
135 useBigH (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh
137mkBenchSmall ::
138 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
139mkBenchSmall name env action =
140 mkBenchCommon useSmallH (withScaling env name) env action
142 where
144 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
146#if !MIN_VERSION_base(4,17,0)
147foreign import ccall unsafe "u_iswspace"
148 iswspace :: Int -> Int
149#endif
151-- Code copied from base/Data.Char to INLINE it
152{-# INLINE isSpace #-}
153isSpace :: Char -> Bool
154-- isSpace includes non-breaking space
155-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
156-- at or below 0x377 have been assigned, so we shouldn't have to worry about
157-- any new spaces appearing below there. It would probably be best to
158-- use branchless ||, but currently the eqLit transformation will undo that,
159-- so we'll do it like this until there's a way around that.
160isSpace c
161 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
162#if MIN_VERSION_base(4,17,0)
163 | otherwise = generalCategory c == Space
164#else
165 | otherwise = iswspace (ord c) /= 0
166#endif
167 where
168 uc = fromIntegral (ord c) :: Word
170{-# INLINE isSp #-}
171isSp :: Word8 -> Bool
172isSp = isSpace . chr . fromIntegral
174smallFileSize :: Int
175smallFileSize = 10 * 1024 * 1024
177bigFileSize :: Int
178bigFileSize = 100 * 1024 * 1024
180mkHandleBenchEnv :: IO BenchEnv
181mkHandleBenchEnv = do
182 r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"
183 (small, big) <-
184 case r of
185 Just inFileName -> return (inFileName, inFileName)
186 Nothing -> do
187 -- XXX will this work on windows/msys?
188 let cmd infile size =
189 "mkdir -p " ++ scratchDir
190 ++ "; test -e " ++ infile
191 ++ " || { echo \"creating input file " ++ infile
192 ++ "\" && head -c " ++ show size
193 ++ " </dev/urandom >" ++ infile
194 ++ ";}"
195 callCommand (cmd inFileSmall smallFileSize)
196 callCommand (cmd inFileBig bigFileSize)
197 return (inFileSmall, inFileBig)
199 hPutStrLn stderr $ "Using small input file: " ++ small
200 smallHandle <- openFile small ReadMode
202 hPutStrLn stderr $ "Using big input file: " ++ big
203 bigHandle <- openFile big ReadMode
205 hPutStrLn stderr $ "Using output file: " ++ outfile
206 outHandle <- openFile outfile WriteMode
207 devNull <- openFile "/dev/null" WriteMode
209 ssize <- fromIntegral <$> getFileSize small
210 bsize <- fromIntegral <$> getFileSize big
212 ref <- newIORef $ RefHandles
213 { smallInH = smallHandle
214 , bigInH = bigHandle
215 , outputH = outHandle
216 }
218 let env = BenchEnv
219 { href = ref
220 , smallSize = ssize
221 , bigSize = bsize
222 , nullH = devNull
223 , smallInFile = small
224 , bigInFile = big
225 }
226 return env