HappyHour.hs

module Graphics.HappyHour (writeBarGraphSvgFile) where

import Data.Functor (void)
import Data.List (genericLength)
import Graphics.Rendering.Chart.Easy hiding (bars)
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 = void $ renderableToFile fo path r
  where
    layout = applyBarPlot bars def :: Layout PlotIndex Int
    r = toRenderable layout :: Renderable ()
    fo = applyFileOptions bars def :: FileOptions

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)]
    ]