git.iko.soy/streamly
on master help sign in
Add diff-style and cutoff-percent to BenchReport
1200034Harendra Kumar
benchmark/bench-report/BenchReport.hs+62−11
compare with master
unifiedsplit
@@ -4,13 +4,15 @@
4module Main where
4module Main where
5
5
6import Control.Exception (catch, ErrorCall(..))
6import Control.Exception (catch, ErrorCall(..))
7−import Control.Monad.Trans.State
7+import Control.Monad (mzero)
8+import Control.Monad.IO.Class (liftIO)
8import Control.Monad.Trans.Maybe
9import Control.Monad.Trans.Maybe
10+import Control.Monad.Trans.State
9import Data.Char (toLower)
11import Data.Char (toLower)
10import Data.List
12import Data.List
13+import GHC.Real (infinity)
11import System.Environment (getArgs)
14import System.Environment (getArgs)
12−import Control.Monad.IO.Class (liftIO)
15+import Text.Read (readMaybe)
13−import Control.Monad (mzero)
14
16
15import BenchShow
17import BenchShow
16
18
@@ -28,10 +30,12 @@ data Options = Options
28 , sortByName :: Bool
30 , sortByName :: Bool
29 , benchType :: Maybe BenchType
31 , benchType :: Maybe BenchType
30 , fields :: [String]
32 , fields :: [String]
33+ , diffStyle :: GroupStyle
34+ , cutOffPercent :: Double
31 } deriving Show
35 } deriving Show
32
36
33defaultOptions :: Options
37defaultOptions :: Options
34−defaultOptions = Options False False Nothing ["time"]
38+defaultOptions = Options False False Nothing ["time"] PercentDiff 0
35
39
36setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
40setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
37setGenGraphs val = do
41setGenGraphs val = do
@@ -53,6 +57,24 @@ setFields val = do
53 (args, opts) <- get
57 (args, opts) <- get
54 put (args, opts { fields = val })
58 put (args, opts { fields = val })
55
59
60+setDiff :: Monad m => String -> StateT (a, Options) m ()
61+setDiff val = do
62+ (args, opts) <- get
63+ let cmpStyle =
64+ case val of
65+ "absolute" -> Absolute
66+ "multiples" -> Multiples
67+ "percent" -> PercentDiff
68+ x -> error $ "Unknown diff option: " ++ show x
69+ in put (args, opts { diffStyle = cmpStyle })
70+
71+setCutOff :: Monad m => String -> StateT (a, Options) m ()
72+setCutOff val = do
73+ (args, opts) <- get
74+ case readMaybe val of
75+ Just x -> put (args, opts { cutOffPercent = x })
76+ Nothing -> error $ "Invalid cutoff value: " ++ show val
77+
56-- Like the shell "shift" to shift the command line arguments
78-- Like the shell "shift" to shift the command line arguments
57shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
79shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
58shift = do
80shift = do
@@ -81,6 +103,24 @@ parseFields = do
81 "please provide a list of fields after --fields"
103 "please provide a list of fields after --fields"
82 mzero
104 mzero
83
105
106+parseDiff :: StateT ([String], Options) (MaybeT IO) ()
107+parseDiff = do
108+ x <- shift
109+ case x of
110+ Just str -> setDiff str
111+ Nothing -> do
112+ liftIO $ putStrLn "please provide a diff type"
113+ mzero
114+
115+parseCutOff :: StateT ([String], Options) (MaybeT IO) ()
116+parseCutOff = do
117+ x <- shift
118+ case x of
119+ Just str -> setCutOff str
120+ Nothing -> do
121+ liftIO $ putStrLn "please provide a cutoff percent"
122+ mzero
123+
84-- totally imperative style option parsing
124-- totally imperative style option parsing
85parseOptions :: IO (Maybe Options)
125parseOptions :: IO (Maybe Options)
86parseOptions = do
126parseOptions = do
@@ -93,10 +133,12 @@ parseOptions = do
93
133
94 parseOpt opt =
134 parseOpt opt =
95 case opt of
135 case opt of
96− "--graphs" -> setGenGraphs True
136+ "--graphs" -> setGenGraphs True
97 "--sort-by-name" -> setSortByName True
137 "--sort-by-name" -> setSortByName True
98 "--benchmark" -> parseBench
138 "--benchmark" -> parseBench
99− "--fields" -> parseFields
139+ "--fields" -> parseFields
140+ "--diff-style" -> parseDiff
141+ "--diff-cutoff-percent" -> parseCutOff
100 str -> do
142 str -> do
101 liftIO $ putStrLn $ "Unrecognized option " <> str
143 liftIO $ putStrLn $ "Unrecognized option " <> str
102 mzero
144 mzero
@@ -147,12 +189,13 @@ showComparisons Options{..} cfg inp out =
147------------------------------------------------------------------------------
189------------------------------------------------------------------------------
148
190
149selectBench
191selectBench
150− :: Bool
192+ :: Options
151 -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
193 -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
152 -> [String]
194 -> [String]
153−selectBench sortName f =
195+selectBench Options{..} f =
154 reverse
196 reverse
155 $ fmap fst
197 $ fmap fst
198+ $ filter (\(_,y) -> filterPred y)
156 $ either
199 $ either
157 (const $ either error sortFunc $ f (ColumnIndex 0) (Just PercentDiff))
200 (const $ either error sortFunc $ f (ColumnIndex 0) (Just PercentDiff))
158 sortFunc
201 sortFunc
@@ -160,7 +203,15 @@ selectBench sortName f =
160
203
161 where
204 where
162
205
163− sortFunc = if sortName then sortOn fst else sortOn snd
206+ sortFunc = if sortByName then sortOn fst else sortOn snd
207+
208+ cutOffMultiples = 1 + cutOffPercent / 100
209+
210+ filterPred x =
211+ case benchType of
212+ Just (Compare _) ->
213+ x <= (negate cutOffPercent) || x >= cutOffPercent
214+ _ -> True
164
215
165benchShow ::
216benchShow ::
166 Options
217 Options
@@ -183,8 +234,8 @@ main = do
183 return ()
234 return ()
184 Just opts@Options{fields = fs, benchType = btype} ->
235 Just opts@Options{fields = fs, benchType = btype} ->
185 let cfg = defaultConfig
236 let cfg = defaultConfig
186− { presentation = Groups PercentDiff
237+ { presentation = Groups (diffStyle opts)
187− , selectBenchmarks = selectBench (sortByName opts)
238+ , selectBenchmarks = selectBench opts
188 , selectFields = filter
239 , selectFields = filter
189 ( flip elem (fmap (fmap toLower) fs)
240 ( flip elem (fmap (fmap toLower) fs)
190 . fmap toLower
241 . fmap toLower