darcs-benchmark-0.1.9: source/Graph.hs

module Graph where

import Data.List
import Graphics.GChart

import Definitions

graphRepoMemory :: RepoTable -> [String]
graphRepoMemory repo = map graphUrl rows
 where
  rows = [(title rowname, rtColumns repo, graphdata rowdata)
         | (rowname, (_, rowdata)) <- zip (rtRows repo) (rtTable repo)]
  title rowname = rowname ++ " (MiB)"
  graphdata rowdata = map selectMemory rowdata
  selectMemory (Just mt) = fromRational (mtMemMean mt) / (1024 * 1024)
  selectMemory _ = 0.0

graphRepoTime :: RepoTable -> [String]
graphRepoTime repo = map graphUrl rows
 where
  rows = [(title tu rowname, rtColumns repo, graphdata tu rowdata)
         | (rowname, (tu, rowdata)) <- zip (rtRows repo) (rtTable repo)]
  title Milliseconds rowname = rowname ++ " (ms)"
  title MinutesAndSeconds rowname = rowname ++ " (s)"
  graphdata tu rowdata = map (selectTime tu) rowdata
  selectTime Milliseconds (Just mt) = combineMeanStddev mt * 1000
  selectTime MinutesAndSeconds (Just mt) = combineMeanStddev mt
  selectTime _ _ = 0.0  

graphUrl :: (String, [String], [Double]) -> String
graphUrl (title, labels, results) = getChartUrl $ do
  setChartSize 200 200
  setDataEncoding simple
  setChartType BarVerticalGrouped
  setBarWidthSpacing $ barwidthspacing 23 5 20
  setChartTitle title
  addAxis $ makeAxis { axisType = AxisBottom, axisLabels = Just labels }
  addAxis $ makeAxis { axisType = AxisLeft,
    axisRange = Just $ Range (0, realToFrac range) Nothing }
  setColors palette
  addChartData row
 where
  range = case results of
    [] -> 1
    xs -> maximum xs
  row = [truncate (result * 61.0 / range) | result <- results] :: [Int]
-- Color palette for bars, based on the Tango palette (Butter, Orange, Choc)
  -- TODO: Adjust palette size based on actual number of results?
  palette = [intercalate "|" ["fce94f"
                            , "c4a000"
                            , "fcaf3e"
                            , "ce5c00"
                            , "e9b96e"
                            , "8f5902"]]