git.iko.soy/streamly
on 81cf15b help sign in
streamly/benchmark/Chart.hs
240 lines 8.1 kB history raw
1{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5module Main where
7import Control.Exception (handle, catch, SomeException, ErrorCall(..))
8import Control.Monad.Trans.State
9import Control.Monad.Trans.Maybe
10import Data.List
11import Data.List.Split
12import Data.Ord (comparing)
13import System.Environment (getArgs)
14import Control.Monad.IO.Class (liftIO)
15import Control.Monad (mzero)
17import BenchShow
19------------------------------------------------------------------------------
20-- Command line parsing
21------------------------------------------------------------------------------
23data BenchType = Linear | LinearAsync | LinearRate | Nested | Base
25data Options = Options
26 { genGraphs :: Bool
27 , benchType :: BenchType
28 }
30defaultOptions = Options False Linear
32setGenGraphs val = do
33 (args, opts) <- get
34 put (args, opts { genGraphs = val })
36setBenchType val = do
37 (args, opts) <- get
38 put (args, opts { benchType = val })
40-- Like the shell "shift" to shift the command line arguments
41shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
42shift = do
43 s <- get
44 case s of
45 ([], _) -> return Nothing
46 (x : xs, opts) -> put (xs, opts) >> return (Just x)
48parseBench :: StateT ([String], Options) (MaybeT IO) ()
49parseBench = do
50 x <- shift
51 case x of
52 Just "linear" -> setBenchType Linear
53 Just "linear-async" -> setBenchType LinearAsync
54 Just "linear-rate" -> setBenchType LinearRate
55 Just "nested" -> setBenchType Nested
56 Just "base" -> setBenchType Base
57 Just str -> do
58 liftIO $ putStrLn $ "unrecognized benchmark type " <> str
59 mzero
60 Nothing -> do
61 liftIO $ putStrLn "please provide a benchmark type "
62 mzero
64-- totally imperative style option parsing
65parseOptions :: IO (Maybe Options)
66parseOptions = do
67 args <- getArgs
68 runMaybeT $ flip evalStateT (args, defaultOptions) $ do
69 x <- shift
70 case x of
71 Just "--graphs" -> setGenGraphs True
72 Just "--benchmark" -> parseBench
73 Just str -> do
74 liftIO $ putStrLn $ "Unrecognized option " <> str
75 mzero
76 Nothing -> return ()
77 fmap snd get
79ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
80 putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
82------------------------------------------------------------------------------
83-- Linear composition charts
84------------------------------------------------------------------------------
86makeLinearGraphs :: Config -> String -> IO ()
87makeLinearGraphs cfg inputFile = do
88 ignoringErr $ graph inputFile "generation" $ cfg
89 { title = Just "Generation"
90 , classifyBenchmark =
91 fmap ("Streamly",) . stripPrefix "serially/generation/"
92 }
94 ignoringErr $ graph inputFile "elimination" $ cfg
95 { title = Just "Elimination"
96 , classifyBenchmark =
97 fmap ("Streamly",) . stripPrefix "serially/elimination/"
98 }
100 ignoringErr $ graph inputFile "transformation-zip" $ cfg
101 { title = Just "Transformation & Zip"
102 , classifyBenchmark = \b ->
103 if "serially/transformation/" `isPrefixOf` b
104 || "serially/zip" `isPrefixOf` b
105 then Just ("Streamly", last $ splitOn "/" b)
106 else Nothing
107 }
109 ignoringErr $ graph inputFile "filtering" $ cfg
110 { title = Just "Filtering"
111 , classifyBenchmark =
112 fmap ("Streamly",) . stripPrefix "serially/filtering/"
113 }
115 ignoringErr $ graph inputFile "composed-transformation" $ cfg
116 { title = Just "Composed Transformation"
117 , classifyBenchmark =
118 fmap ("Streamly",) . stripPrefix "serially/transformationN/"
119 }
121 ignoringErr $ graph inputFile "composed-filtering"
122 $ cfg
123 { title = Just "Composed Filtering"
124 , classifyBenchmark =
125 fmap ("Streamly",) . stripPrefix "serially/filteringN/"
126 }
128 ignoringErr $ graph inputFile "composed-mixed"
129 $ cfg
130 { title = Just "Composed Mixed"
131 , classifyBenchmark =
132 fmap ("Streamly",) . stripPrefix "serially/composed/"
133 }
135 ignoringErr $ graph inputFile "iterated"
136 $ cfg
137 { title = Just "Iterated Ops"
138 , classifyBenchmark =
139 fmap ("Streamly",) . stripPrefix "serially/iterated/"
140 }
142------------------------------------------------------------------------------
143-- Nested composition charts
144------------------------------------------------------------------------------
146makeNestedGraphs :: Config -> String -> IO ()
147makeNestedGraphs cfg inputFile =
148 ignoringErr $ graph inputFile "nested-serial" $ cfg
149 { title = Just "Nested serial"
150 , classifyBenchmark = \b ->
151 let ls = splitOn "/" b
152 in case head ls of
153 "serially" -> Just (head ls, last ls)
154 _ -> Nothing
155 }
157------------------------------------------------------------------------------
158-- Charts for parallel streams
159------------------------------------------------------------------------------
161makeLinearAsyncGraphs :: Config -> String -> IO ()
162makeLinearAsyncGraphs cfg inputFile = do
163 putStrLn "Not implemented"
164 return ()
166makeLinearRateGraphs :: Config -> String -> IO ()
167makeLinearRateGraphs cfg inputFile = do
168 putStrLn "Not implemented"
169 return ()
171------------------------------------------------------------------------------
172-- Charts for base streams
173------------------------------------------------------------------------------
175makeBaseGraphs :: Config -> String -> IO ()
176makeBaseGraphs cfg inputFile = do
177 putStrLn "Not implemented"
178 return ()
180------------------------------------------------------------------------------
181-- text reports
182------------------------------------------------------------------------------
184selectBench :: (SortColumn -> Either String [(String, Double)]) -> [String]
185selectBench f =
186 reverse
187 $ fmap fst
188 $ either
189 (const $ either error (sortOn snd) $ f $ ColumnIndex 0)
190 (sortOn snd)
191 $ f $ ColumnIndex 1
193benchShow Options{..} cfg func inp out =
194 if genGraphs
195 then func cfg {outputDir = Just out} inp
196 else ignoringErr $ report inp Nothing cfg
198showStreamDVsK Options{..} cfg func inp out =
199 let cfg' = cfg { classifyBenchmark = classify }
200 in if genGraphs
201 then ignoringErr $ graph inp "streamD-vs-streamK"
202 cfg' {outputDir = Just out}
203 else ignoringErr $ report inp Nothing cfg'
205 where
207 classify b
208 | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
209 | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
210 | otherwise = Nothing
212main :: IO ()
213main = do
214 let cfg = defaultConfig
215 { presentation = Groups PercentDiff
216 , selectBenchmarks = selectBench
217 }
218 res <- parseOptions
220 case res of
221 Nothing -> do
222 putStrLn "cannot parse options"
223 return ()
224 Just opts@Options{..} ->
225 case benchType of
226 Linear -> benchShow opts cfg makeLinearGraphs
227 "charts/linear/results.csv"
228 "charts/linear"
229 LinearAsync -> benchShow opts cfg makeLinearAsyncGraphs
230 "charts/linear-async/results.csv"
231 "charts/linear-async"
232 LinearRate -> benchShow opts cfg makeLinearRateGraphs
233 "charts/linear-rate/results.csv"
234 "charts/linear-rate"
235 Nested -> benchShow opts cfg makeNestedGraphs
236 "charts/nested/results.csv"
237 "charts/nested"
238 Base -> showStreamDVsK opts cfg makeBaseGraphs
239 "charts/base/results.csv"
240 "charts/base"