Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
242 lines (208 sloc) 7.96 KB
{-# LANGUAGE NamedFieldPuns, RecordWildCards, DeriveDataTypeable #-}
import Graphics.BarChart hiding ( Intervals, BarChart )
import Graphics.BarChart.Types ( readColor )
import Data.Char ( toLower )
import Data.Maybe ( fromMaybe )
import Control.Monad ( when, forM_ )
import System.FilePath
import System.Console.CmdArgs
import qualified Graphics.Rendering.Diagrams as D
data BarChart
= Blocks { out_file, title, xlabel, ylabel :: String,
file_type :: FileType,
division, colors :: String,
width, height, label_size :: Int,
bar_width :: Double,
in_files :: [String] }
| Intervals { out_file, title, xlabel, ylabel :: String,
file_type :: FileType,
division, colors :: String,
width, height, label_size :: Int,
bar_width :: Double,
in_files :: [String] }
| Criterion { breakdown :: Breakdown,
out_file, title, xlabel, ylabel :: String,
file_type :: FileType,
division, colors :: String,
width, height, label_size :: Int,
bar_width :: Double,
in_files :: [String] }
| Progression { breakdown :: Breakdown,
out_file, title, xlabel, ylabel :: String,
file_type :: FileType,
division, colors :: String,
width, height, label_size :: Int,
bar_width :: Double,
in_files :: [String] }
deriving (Show,Data,Typeable)
data FileType = Guess_File_Type | PNG | SVG | PDF | PS
deriving (Eq,Show,Data,Typeable)
suffixOf :: FileType -> String
suffixOf PNG = "png"
suffixOf SVG = "svg"
suffixOf PDF = "pdf"
suffixOf PS = "ps"
suffixOf _ = ""
fromFileType :: FileType -> D.OutputType
fromFileType PNG = D.PNG
fromFileType SVG = D.SVG
fromFileType PDF = D.PDF
fromFileType PS = D.PS
fromFileType _ = error "fromFileType: cannot convert guessed file type"
replaceUnknownFileType :: FileType -> FileType -> FileType
replaceUnknownFileType Guess_File_Type t = t
replaceUnknownFileType t _ = t
data Breakdown = Summary | Summary_Comparison | Benchmark_Comparison
deriving (Eq,Show,Data,Typeable)
blocksMode :: BarChart
blocksMode =
Blocks {
out_file = outFile conf
&= help "Name of generated file"
&= typFile,
file_type = enum [Guess_File_Type
&= help "Guess output file type by name (default)",
PNG &= help "Generate .png file",
SVG &= help "Generate .svg file"
&= explicit
&= name "svg",
PDF &= help "Generate .pdf file",
PS &= help "Generate .ps file"],
title = caption conf
&= help "Title of bar chart"
&= typString,
xlabel = xLabel conf
&= help "Label of x axis"
&= typString,
ylabel = xLabel conf
&= help "Label of y axis"
&= typString,
division = "" &= help "Labels separated by whitespace"
&= typStrings,
colors = "" &= help "Color names separated by whitespace"
&= typStrings,
width = width
&= help "Width of generated bar chart"
&= typ "NUM",
height = height
&= help "Height of generated bar chart"
&= typ "NUM",
label_size = 12 &= help "Font size used for labels"
&= typ "NUM",
bar_width = barRatio conf
&= help "Bar width between 0 and 1"
&= name "W"
&= typ "FLOAT",
in_files = [] &= typ "FILES"
&= args }
where (width,height) = dimensions conf
intervalsMode :: BarChart
intervalsMode = Intervals {}
criterionMode :: BarChart
criterionMode =
Criterion {
breakdown = enum [Summary
&= help "Show benchmark summary (default)",
Summary_Comparison
&= help "Compare different benchmark summaries"
&= name "s",
Benchmark_Comparison
&= help "Compare different benchmarks"
&= name "b"] }
progressionMode :: BarChart
progressionMode =
Progression {
breakdown = enum [Summary_Comparison
&= help "Breakdown chart by benchmark summary (default)"
&= name "s",
Benchmark_Comparison
&= help "Breakdown chart by benchmarks"
&= name "b"] }
typString, typStrings :: Ann
typString = typ "STRING"
typStrings = typ "STRINGS"
execModes :: [BarChart]
execModes = [blocksMode &= auto,
intervalsMode, criterionMode, progressionMode]
exitIf :: String -> Bool -> IO ()
exitIf msg cond = when cond (error msg)
main :: IO ()
main = do execMode <- cmdArgs (modes execModes)
exitIf "no input files given" $ null (in_files execMode)
dispatch execMode
dispatch :: BarChart -> IO ()
dispatch mode@Blocks{..} =
forM_ in_files $ \in_file ->
writeMultiBarChart
(config (guessDefaults in_file mode))
in_file
(words division)
dispatch mode@Intervals{..} =
forM_ in_files $ \in_file ->
writeMultiBarIntervalChart
(config (guessDefaults in_file mode))
in_file
(words division)
dispatch mode@Criterion{..} =
case breakdown of
Summary ->
forM_ in_files $ \in_file ->
writeCriterionChart
(config (guessBenchmarkDefaults in_file mode))
in_file
Summary_Comparison ->
writeComparisonChart False
(config (guessBenchmarkDefaults "summaries.csv" mode))
in_files
Benchmark_Comparison ->
writeComparisonChart True
(config (guessBenchmarkDefaults "benchmarks.csv" mode))
in_files
dispatch mode@Progression{..} =
case breakdown of
Summary_Comparison ->
forM_ in_files $ \in_file ->
writeProgressionChart True
(config (guessBenchmarkDefaults in_file mode))
in_file
(words division)
Benchmark_Comparison ->
forM_ in_files $ \in_file ->
writeProgressionChart False
(config (guessBenchmarkDefaults in_file mode))
in_file
(words division)
guessDefaults :: FilePath -> BarChart -> BarChart
guessDefaults in_file = guessColors . guessTitle . guessFileType . guessOutFile
where
guessOutFile mode =
mode { out_file = out_file mode ? replaceExtension in_file suffix }
where suffix = suffixOf (file_type mode) ? ".png"
guessFileType mode =
mode { file_type = replaceUnknownFileType (file_type mode) $
fromMaybe (error $ "unsupported type: " ++ suffix) $
lookup suffix fileTypes }
where suffix = map toLower $ takeExtension (out_file mode)
fileTypes = [(".png",PNG),(".svg",SVG),(".pdf",PDF),(".ps",PS)]
guessTitle mode =
mode { title = title mode ? takeBaseName (out_file mode) }
guessColors mode =
mode { colors = colors mode ? "forestgreen firebrick midnightblue" }
guessBenchmarkDefaults :: FilePath -> BarChart -> BarChart
guessBenchmarkDefaults in_file = guessAxis . guessDefaults in_file
where
guessAxis mode = mode { xlabel = xlabel mode ? "benchmark",
ylabel = ylabel mode ? "run time" }
config :: BarChart -> Config
config mode = Config {
outFile = out_file mode,
outputType = fromFileType $ file_type mode,
caption = title mode, xLabel = xlabel mode, yLabel = ylabel mode,
barColors = map readColor . words $ colors mode,
dimensions = (width mode,height mode),
ratio = 1.0,
fontSize = fromIntegral $ label_size mode,
barRatio = bar_width mode }
(?) :: String -> String -> String
"" ? s = s
s ? _ = s