{-# OPTIONS_GHC -Wall #-}
module Graphics.HappyHour (writeBarGraphSvgFile) where
import Data.List (genericLength)
import Graphics.Rendering.Chart.Easy hiding (bars)
import Graphics.Rendering.Chart.Backend.Diagrams (renderableToFile, FileOptions, fo_size)
writeBarGraphSvgFile
:: FilePath
-> [(String, Int)]
-> IO ()
writeBarGraphSvgFile path bars =
do
let layout = applyBarPlot bars def :: Layout PlotIndex Int
let r = toRenderable layout :: Renderable ()
let fo = applyFileOptions bars def :: FileOptions
_ <- renderableToFile fo path r
return ()
type Bars = [(String, Int)]
type Endo a = a -> a
foldEndo :: [a -> a] -> (a -> a)
foldEndo = foldr (.) id
applyFileOptions :: Bars -> Endo FileOptions
applyFileOptions bars =
set fo_size (maximum ([l x | (x, _) <- bars]) * l bars * 50, 600)
where
l = genericLength
applyBarPlot :: Bars -> Endo (Layout PlotIndex Int)
applyBarPlot bars =
foldEndo
[ applyLayoutStyle
, applyLabels bars
, set layout_plots [plotBars (( applyBarStyle . applyValues bars ) def)]
]
applyValues :: Bars -> Endo (PlotBars PlotIndex Int)
applyValues bars =
set plot_bars_values (addIndexes [ [y] | (_, y) <- bars ])
applyLabels :: Integral x => Bars -> Endo (Layout x y)
applyLabels bars =
set (layout_x_axis . laxis_generate) (autoIndexAxis [ x | (x, _) <- bars ])
applyLayoutStyle :: Endo (Layout x y)
applyLayoutStyle =
foldEndo
[ set layout_margin 40
, setAxisLineWidth 5
, over yGridStyle (set line_width 5 . set line_dashes [40, 20])
, set (layout_y_axis . laxis_style . axis_label_gap) 25
, set (layout_title_style . font_size) 80
, setAxisFontSize 40
]
yGridStyle :: Lens' (Layout x y) LineStyle
yGridStyle = layout_y_axis . laxis_style . axis_grid_style
axisLineWidth :: Lens' (LayoutAxis x) Double
axisLineWidth = laxis_style . axis_line_style . line_width
axisLabelSize :: Lens' (LayoutAxis x) Double
axisLabelSize = laxis_style . axis_label_style . font_size
setAxisLineWidth :: Double -> Endo (Layout x y)
setAxisLineWidth v =
foldEndo [ set l v | l <- [ layout_x_axis . axisLineWidth
, layout_y_axis . axisLineWidth ] ]
setAxisFontSize :: Double -> Endo (Layout x y)
setAxisFontSize v =
foldEndo [ set l v | l <- [ layout_x_axis . axisLabelSize
, layout_y_axis . axisLabelSize ] ]
applyBarStyle :: Endo (PlotBars x y)
applyBarStyle =
foldEndo
[ set plot_bars_spacing (BarsFixGap 80 20)
, set plot_bars_item_styles [(FillStyleSolid (opaque steelblue), Nothing)]
]