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 :: FilePath -> [(FilePath, Int)] -> IO ()
writeBarGraphSvgFile FilePath
path [(FilePath, Int)]
bars = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path Renderable ()
r
  where
    layout :: Layout PlotIndex Int
layout = [(FilePath, Int)] -> Endo (Layout PlotIndex Int)
applyBarPlot [(FilePath, Int)]
bars forall a. Default a => a
def :: Layout PlotIndex Int
    r :: Renderable ()
r = forall a. ToRenderable a => a -> Renderable ()
toRenderable Layout PlotIndex Int
layout :: Renderable ()
    fo :: FileOptions
fo = [(FilePath, Int)] -> Endo FileOptions
applyFileOptions [(FilePath, Int)]
bars forall a. Default a => a
def :: FileOptions

type Bars = [(String, Int)]

type Endo a = a -> a

foldEndo :: [a -> a] -> (a -> a)
foldEndo :: forall a. [a -> a] -> a -> a
foldEndo = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id

applyFileOptions :: Bars -> Endo FileOptions
applyFileOptions :: [(FilePath, Int)] -> Endo FileOptions
applyFileOptions [(FilePath, Int)]
bars =
    forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FileOptions (Double, Double)
fo_size (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([forall {a}. [a] -> Double
l FilePath
x | (FilePath
x, Int
_) <- [(FilePath, Int)]
bars]) forall a. Num a => a -> a -> a
* forall {a}. [a] -> Double
l [(FilePath, Int)]
bars forall a. Num a => a -> a -> a
* Double
50, Double
600)
  where
    l :: [a] -> Double
l = forall i a. Num i => [a] -> i
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 :: [(FilePath, Int)] -> Endo (Layout PlotIndex Int)
applyBarPlot [(FilePath, Int)]
bars = forall a. [a -> a] -> a -> a
foldEndo
    [ forall x y. Endo (Layout x y)
applyLayoutStyle
    , forall x y. Integral x => [(FilePath, Int)] -> Endo (Layout x y)
applyLabels [(FilePath, Int)]
bars
    , forall s t a b. ASetter s t a b -> b -> s -> t
set forall x y. Lens' (Layout x y) [Plot x y]
layout_plots [forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars (( forall x y. Endo (PlotBars x y)
applyBarStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Int)] -> Endo (PlotBars PlotIndex Int)
applyValues [(FilePath, Int)]
bars ) forall a. Default a => a
def)]
    ]

-- | Set the data values on a bar plot
applyValues :: Bars -> Endo (PlotBars PlotIndex Int)
applyValues :: [(FilePath, Int)] -> Endo (PlotBars PlotIndex Int)
applyValues [(FilePath, Int)]
bars =
    forall s t a b. ASetter s t a b -> b -> s -> t
set forall x1 y x2.
Lens (PlotBars x1 y) (PlotBars x2 y) [(x1, [y])] [(x2, [y])]
plot_bars_values (forall a. [a] -> [(PlotIndex, a)]
addIndexes [ [Int
y] | (FilePath
_, Int
y) <- [(FilePath, Int)]
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 :: forall x y. Integral x => [(FilePath, Int)] -> Endo (Layout x y)
applyLabels [(FilePath, Int)]
bars =
    forall s t a b. ASetter s t a b -> b -> s -> t
set (forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) (AxisFn x)
laxis_generate) (forall i. Integral i => [FilePath] -> [i] -> AxisData i
autoIndexAxis [ FilePath
x | (FilePath
x, Int
_) <- [(FilePath, Int)]
bars ])

-- | Set some layout styles that look nice
applyLayoutStyle :: Endo (Layout x y)
applyLayoutStyle :: forall x y. Endo (Layout x y)
applyLayoutStyle = forall a. [a -> a] -> a -> a
foldEndo
    [ forall s t a b. ASetter s t a b -> b -> s -> t
set forall x y. Lens' (Layout x y) Double
layout_margin Double
40
    , forall x y. Double -> Endo (Layout x y)
setAxisLineWidth Double
5
    , forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall x y. Lens' (Layout x y) LineStyle
yGridStyle (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' LineStyle Double
line_width Double
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' LineStyle [Double]
line_dashes [Double
40, Double
20])
    , forall s t a b. ASetter s t a b -> b -> s -> t
set (forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle Double
axis_label_gap) Double
25
    , forall s t a b. ASetter s t a b -> b -> s -> t
set (forall x y. Lens' (Layout x y) FontStyle
layout_title_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FontStyle Double
font_size) Double
80
    , forall x y. Double -> Endo (Layout x y)
setAxisFontSize Double
40
    ]

-- | Lens for the grid style on the Y axis
yGridStyle :: Lens' (Layout x y) LineStyle
yGridStyle :: forall x y. Lens' (Layout x y) LineStyle
yGridStyle = forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle LineStyle
axis_grid_style

-- | Lens for the width of an axis
axisLineWidth :: Lens' (LayoutAxis x) Double
axisLineWidth :: forall x. Lens' (LayoutAxis x) Double
axisLineWidth = forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle LineStyle
axis_line_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LineStyle Double
line_width

-- | Lens for the label font size of an axis
axisLabelSize :: Lens' (LayoutAxis x) Double
axisLabelSize :: forall x. Lens' (LayoutAxis x) Double
axisLabelSize = forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FontStyle Double
font_size

-- | Set the line width on both axes
setAxisLineWidth :: Double -> Endo (Layout x y)
setAxisLineWidth :: forall x y. Double -> Endo (Layout x y)
setAxisLineWidth Double
v =
  forall a. [a -> a] -> a -> a
foldEndo [ forall s t a b. ASetter s t a b -> b -> s -> t
set (Double -> Identity Double) -> Layout x y -> Identity (Layout x y)
l Double
v | (Double -> Identity Double) -> Layout x y -> Identity (Layout x y)
l <- [ forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) Double
axisLineWidth
                            , forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) Double
axisLineWidth ] ]

-- | Set the label size on both axes
setAxisFontSize :: Double -> Endo (Layout x y)
setAxisFontSize :: forall x y. Double -> Endo (Layout x y)
setAxisFontSize Double
v =
  forall a. [a -> a] -> a -> a
foldEndo [ forall s t a b. ASetter s t a b -> b -> s -> t
set (Double -> Identity Double) -> Layout x y -> Identity (Layout x y)
l Double
v | (Double -> Identity Double) -> Layout x y -> Identity (Layout x y)
l <- [ forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) Double
axisLabelSize
                            , forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) Double
axisLabelSize ] ]

-- | Set some bar styles that look nice
applyBarStyle :: Endo (PlotBars x y)
applyBarStyle :: forall x y. Endo (PlotBars x y)
applyBarStyle = forall a. [a -> a] -> a -> a
foldEndo
    [ forall s t a b. ASetter s t a b -> b -> s -> t
set forall x y. Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing (Double -> Double -> PlotBarsSpacing
BarsFixGap Double
80 Double
20)
    , forall s t a b. ASetter s t a b -> b -> s -> t
set forall x y. Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles [(AlphaColour Double -> FillStyle
FillStyleSolid (forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
steelblue), forall a. Maybe a
Nothing)]
    ]