barchart-0.1.1.1: src/barchart.hs

{-# 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