HappyHour.hs

{-# OPTIONS_GHC -Wall #-}

module Graphics.HappyHour (writeBarGraphSvgFile) where

-- base
import Data.List (genericLength)

-- Chart
import Graphics.Rendering.Chart.Easy hiding (bars)

-- Chart-diagrams
import Graphics.Rendering.Chart.Backend.Diagrams (renderableToFile, FileOptions, fo_size)

-- | Create an SVG file containing a bar graph.

writeBarGraphSvgFile
    :: FilePath
          -- ^ Where the file will be written. The containing directory must already exist. If there already exists a file at this path, it will be overwritten. If there exists a directory at this path, the action will fail.
    -> [(String, Int)]
          -- ^ The data to visualize. Each list entry represents a bar on the plot, ordered from left to right. The @String@ is the label on the X axis, and the @Int@ is the height of the bar.
    -> 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

-- | Add a single bar plot to a layout, configure its X axis labels to match the data, and style the layout to look nice with a bar plot.
applyBarPlot :: Bars -> Endo (Layout PlotIndex Int)
applyBarPlot bars =
  foldEndo
    [ applyLayoutStyle
    , applyLabels bars
    , set layout_plots [plotBars (( applyBarStyle . applyValues bars ) def)]
    ]

-- | Set the data values on a bar plot.
applyValues :: Bars -> Endo (PlotBars PlotIndex Int)
applyValues bars =
    set plot_bars_values (addIndexes [ [y] | (_, y) <- bars ])

-- | Set up the X axis of a layout in preparation for adding the bar plot.
applyLabels :: Integral x => Bars -> Endo (Layout x y)
applyLabels bars =
    set (layout_x_axis . laxis_generate) (autoIndexAxis [ x | (x, _) <- bars ])

-- | Set some layout styles that look nice.
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
    ]

-- | Lens for the grid style on the Y axis
yGridStyle :: Lens' (Layout x y) LineStyle
yGridStyle = layout_y_axis . laxis_style . axis_grid_style

-- | Lens for the width of an axis
axisLineWidth :: Lens' (LayoutAxis x) Double
axisLineWidth = laxis_style . axis_line_style . line_width

-- | Lens for the label font size of an axis
axisLabelSize :: Lens' (LayoutAxis x) Double
axisLabelSize = laxis_style . axis_label_style . font_size

-- | Set the line width on both axes.
setAxisLineWidth :: Double -> Endo (Layout x y)
setAxisLineWidth v =
  foldEndo [ set l v | l <- [ layout_x_axis . axisLineWidth
                            , layout_y_axis . axisLineWidth ] ]

-- | Set the label size on both axes.
setAxisFontSize :: Double -> Endo (Layout x y)
setAxisFontSize v =
  foldEndo [ set l v | l <- [ layout_x_axis . axisLabelSize
                            , layout_y_axis . axisLabelSize ] ]

-- | Set some bar styles that look nice.
applyBarStyle :: Endo (PlotBars x y)
applyBarStyle =
  foldEndo
    [ set plot_bars_spacing (BarsFixGap 80 20)
    , set plot_bars_item_styles [(FillStyleSolid (opaque steelblue), Nothing)]
    ]