@@ -4,13 +4,15 @@
44module Main where
55
66import Control.Exception (catch, ErrorCall(..))
7−import Control.Monad.Trans.State
7+import Control.Monad (mzero)
8+import Control.Monad.IO.Class (liftIO)
89import Control.Monad.Trans.Maybe
10+import Control.Monad.Trans.State
911import Data.Char (toLower)
1012import Data.List
13+import GHC.Real (infinity)
1114import System.Environment (getArgs)
12−import Control.Monad.IO.Class (liftIO)
13−import Control.Monad (mzero)
15+import Text.Read (readMaybe)
1416
1517import BenchShow
1618
@@ -28,10 +30,12 @@ data Options = Options
2830 , sortByName :: Bool
2931 , benchType :: Maybe BenchType
3032 , fields :: [String]
33+ , diffStyle :: GroupStyle
34+ , cutOffPercent :: Double
3135 } deriving Show
3236
3337defaultOptions :: Options
34−defaultOptions = Options False False Nothing ["time"]
38+defaultOptions = Options False False Nothing ["time"] PercentDiff 0
3539
3640setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
3741setGenGraphs val = do
@@ -53,6 +57,24 @@ setFields val = do
5357 (args, opts) <- get
5458 put (args, opts { fields = val })
5559
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+
5678-- Like the shell "shift" to shift the command line arguments
5779shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
5880shift = do
@@ -81,6 +103,24 @@ parseFields = do
81103 "please provide a list of fields after --fields"
82104 mzero
83105
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+
84124-- totally imperative style option parsing
85125parseOptions :: IO (Maybe Options)
86126parseOptions = do
@@ -93,10 +133,12 @@ parseOptions = do
93133
94134 parseOpt opt =
95135 case opt of
96− "--graphs" -> setGenGraphs True
136+ "--graphs" -> setGenGraphs True
97137 "--sort-by-name" -> setSortByName True
98138 "--benchmark" -> parseBench
99− "--fields" -> parseFields
139+ "--fields" -> parseFields
140+ "--diff-style" -> parseDiff
141+ "--diff-cutoff-percent" -> parseCutOff
100142 str -> do
101143 liftIO $ putStrLn $ "Unrecognized option " <> str
102144 mzero
@@ -147,12 +189,13 @@ showComparisons Options{..} cfg inp out =
147189------------------------------------------------------------------------------
148190
149191selectBench
150− :: Bool
192+ :: Options
151193 -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
152194 -> [String]
153−selectBench sortName f =
195+selectBench Options{..} f =
154196 reverse
155197 $ fmap fst
198+ $ filter (\(_,y) -> filterPred y)
156199 $ either
157200 (const $ either error sortFunc $ f (ColumnIndex 0) (Just PercentDiff))
158201 sortFunc
@@ -160,7 +203,15 @@ selectBench sortName f =
160203
161204 where
162205
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
164215
165216benchShow ::
166217 Options
@@ -183,8 +234,8 @@ main = do
183234 return ()
184235 Just opts@Options{fields = fs, benchType = btype} ->
185236 let cfg = defaultConfig
186− { presentation = Groups PercentDiff
187− , selectBenchmarks = selectBench (sortByName opts)
237+ { presentation = Groups (diffStyle opts)
238+ , selectBenchmarks = selectBench opts
188239 , selectFields = filter
189240 ( flip elem (fmap (fmap toLower) fs)
190241 . fmap toLower