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