on 5.3 help sign in
vty/test/benchmark.hs
56 lines 1.7 kB history raw
1{-# LANGUAGE QuasiQuotes #-}
2module Main where
4import Graphics.Vty
6import qualified BenchImageFuzz
7import qualified BenchNoDiffOpt
8import qualified BenchRenderChar
9import qualified BenchVerticalScroll
11import Control.Monad
13import Data.Maybe
14import Data.List
16import System.Environment
17import System.Posix.Process
19import Verify
21main = do
22 args <- getArgs
23 let benches = [ ("no-diff-opt-0", BenchNoDiffOpt.bench0)
24 , ("render-char-0", BenchRenderChar.bench0)
25 , ("render-char-1", BenchRenderChar.bench1)
26 , ("vertical-scroll-0", BenchVerticalScroll.bench0)
27 , ("image-fuzz-0", BenchImageFuzz.bench0) ]
28 help = forM_ benches $ \(b,_) -> putStrLn $ "--" ++ b
29 case args of
30 ["--help"] -> help
31 ["-h" ] -> help
32 _ -> do
33 let args' = if args /= []
34 then map (drop 2) args
35 else map fst benches
36 -- drop the dash-dash "--"
37 results <- forM args' $ \bName -> do
38 case lookup bName benches of
39 Just b -> bench bName b
40 Nothing -> fail $ "No benchmark named " ++ bName
41 print results
42 return ()
44bench bName b = do
45 putStrLn $ "starting " ++ bName
46 Bench bDataGen bProc <- b
47 bData <- bDataGen
48 startTimes <- bData `deepseq` getProcessTimes
49 bProc bData
50 endTimes <- getProcessTimes
51 let ut = userTime endTimes - userTime startTimes
52 st = systemTime endTimes - systemTime startTimes
53 putStrLn $ "user time: " ++ show ut
54 putStrLn $ "system time: " ++ show st
55 return (bName, ut, st)