git.iko.soy/streamly
on 5cbcd5b help sign in
streamly/benchmark/Chart.hs
200 lines 7.0 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 "operations" $ cfg
89 { title = Just "Streamly operations"
90 , classifyBenchmark = \b ->
91 if not ("serially/" `isPrefixOf` b)
92 || "/generation" `isInfixOf` b
93 || "/compose" `isInfixOf` b
94 || "/concat" `isSuffixOf` b
95 then Nothing
96 else Just ("Streamly", last $ splitOn "/" b)
97 }
99 ignoringErr $ graph inputFile "generation" $ cfg
100 { title = Just "Stream generation"
101 , classifyBenchmark = \b ->
102 if "serially/generation" `isPrefixOf` b
103 then Just ("Streamly", last $ splitOn "/" b)
104 else Nothing
105 }
107 ignoringErr $ graph inputFile "composition" $ cfg
108 { title = Just "Streamly composition performance"
109 , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose/"
110 }
112 ignoringErr $ graph inputFile "composition-scaling"
113 $ cfg
114 { title = Just "Streamly composition scaling"
115 , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose-"
116 }
118------------------------------------------------------------------------------
119-- Nested composition charts
120------------------------------------------------------------------------------
122makeNestedGraphs :: Config -> String -> IO ()
123makeNestedGraphs cfg inputFile =
124 ignoringErr $ graph inputFile "nested-serial-diff" $ cfg
125 { title = Just "Nested serial"
126 , classifyBenchmark = \b ->
127 let ls = splitOn "/" b
128 in case head ls of
129 "serially" -> Just (head ls, last ls)
130 _ -> Nothing
131 }
133------------------------------------------------------------------------------
134-- Charts for parallel streams
135------------------------------------------------------------------------------
137makeLinearAsyncGraphs :: Config -> String -> IO ()
138makeLinearAsyncGraphs cfg inputFile = do
139 putStrLn "Not implemented"
140 return ()
142makeLinearRateGraphs :: Config -> String -> IO ()
143makeLinearRateGraphs cfg inputFile = do
144 putStrLn "Not implemented"
145 return ()
147------------------------------------------------------------------------------
148-- Charts for base streams
149------------------------------------------------------------------------------
151makeBaseGraphs :: Config -> String -> IO ()
152makeBaseGraphs cfg inputFile = do
153 putStrLn "Not implemented"
154 return ()
156------------------------------------------------------------------------------
157-- text reports
158------------------------------------------------------------------------------
160benchShow Options{..} cfg func inp out =
161 if genGraphs
162 then func cfg {outputDir = Just out} inp
163 else
164 ignoringErr $ report inp Nothing $ cfg
165 { selectBenchmarks =
166 \f ->
167 reverse
168 $ fmap fst
169 $ either
170 (const $ either error id $ f $ ColumnIndex 0)
171 (sortOn snd)
172 $ f $ ColumnIndex 1
173 }
175main :: IO ()
176main = do
177 let cfg = defaultConfig { presentation = Groups PercentDiff }
178 res <- parseOptions
180 case res of
181 Nothing -> do
182 putStrLn "cannot parse options"
183 return ()
184 Just opts@Options{..} ->
185 case benchType of
186 Linear -> benchShow opts cfg makeLinearGraphs
187 "charts/linear/results.csv"
188 "charts/linear"
189 LinearAsync -> benchShow opts cfg makeLinearAsyncGraphs
190 "charts/linear-async/results.csv"
191 "charts/linear-async"
192 LinearRate -> benchShow opts cfg makeLinearRateGraphs
193 "charts/linear-rate/results.csv"
194 "charts/linear-rate"
195 Nested -> benchShow opts cfg makeNestedGraphs
196 "charts/nested/results.csv"
197 "charts/nested"
198 Base -> benchShow opts cfg makeBaseGraphs
199 "charts/base/results.csv"
200 "charts/base"