{-# 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 :: FilePath -> [(FilePath, Int)] -> IO ()
writeBarGraphSvgFile FilePath
path [(FilePath, Int)]
bars =
do
let layout :: Layout PlotIndex Int
layout = [(FilePath, Int)] -> Endo (Layout PlotIndex Int)
applyBarPlot [(FilePath, Int)]
bars Layout PlotIndex Int
forall a. Default a => a
def :: Layout PlotIndex Int
let r :: Renderable ()
r = Layout PlotIndex Int -> Renderable ()
forall a. ToRenderable a => a -> Renderable ()
toRenderable Layout PlotIndex Int
layout :: Renderable ()
let fo :: FileOptions
fo = [(FilePath, Int)] -> Endo FileOptions
applyFileOptions [(FilePath, Int)]
bars FileOptions
forall a. Default a => a
def :: FileOptions
PickFn ()
_ <- FileOptions -> FilePath -> Renderable () -> IO (PickFn ())
forall a. FileOptions -> FilePath -> Renderable a -> IO (PickFn a)
renderableToFile FileOptions
fo FilePath
path Renderable ()
r
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
type Bars = [(String, Int)]
type Endo a = a -> a
foldEndo :: [a -> a] -> (a -> a)
foldEndo :: [a -> a] -> a -> a
foldEndo = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> [a -> a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> a
forall a. a -> a
id
applyFileOptions :: Bars -> Endo FileOptions
applyFileOptions :: [(FilePath, Int)] -> Endo FileOptions
applyFileOptions [(FilePath, Int)]
bars =
ASetter FileOptions FileOptions (Double, Double) (Double, Double)
-> (Double, Double) -> Endo FileOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FileOptions FileOptions (Double, Double) (Double, Double)
Lens' FileOptions (Double, Double)
fo_size ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([FilePath -> Double
forall a. [a] -> Double
l FilePath
x | (FilePath
x, Int
_) <- [(FilePath, Int)]
bars]) Double -> Double -> Double
forall a. Num a => a -> a -> a
* [(FilePath, Int)] -> Double
forall a. [a] -> Double
l [(FilePath, Int)]
bars Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
50, Double
600)
where
l :: [a] -> Double
l = [a] -> Double
forall i a. Num i => [a] -> i
genericLength
applyBarPlot :: Bars -> Endo (Layout PlotIndex Int)
applyBarPlot :: [(FilePath, Int)] -> Endo (Layout PlotIndex Int)
applyBarPlot [(FilePath, Int)]
bars =
[Endo (Layout PlotIndex Int)] -> Endo (Layout PlotIndex Int)
forall a. [a -> a] -> a -> a
foldEndo
[ Endo (Layout PlotIndex Int)
forall x y. Endo (Layout x y)
applyLayoutStyle
, [(FilePath, Int)] -> Endo (Layout PlotIndex Int)
forall x y. Integral x => [(FilePath, Int)] -> Endo (Layout x y)
applyLabels [(FilePath, Int)]
bars
, ASetter
(Layout PlotIndex Int)
(Layout PlotIndex Int)
[Plot PlotIndex Int]
[Plot PlotIndex Int]
-> [Plot PlotIndex Int] -> Endo (Layout PlotIndex Int)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(Layout PlotIndex Int)
(Layout PlotIndex Int)
[Plot PlotIndex Int]
[Plot PlotIndex Int]
forall x y. Lens' (Layout x y) [Plot x y]
layout_plots [PlotBars PlotIndex Int -> Plot PlotIndex Int
forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars (( Endo (PlotBars PlotIndex Int)
forall x y. Endo (PlotBars x y)
applyBarStyle Endo (PlotBars PlotIndex Int)
-> Endo (PlotBars PlotIndex Int) -> Endo (PlotBars PlotIndex Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, Int)] -> Endo (PlotBars PlotIndex Int)
applyValues [(FilePath, Int)]
bars ) PlotBars PlotIndex Int
forall a. Default a => a
def)]
]
applyValues :: Bars -> Endo (PlotBars PlotIndex Int)
applyValues :: [(FilePath, Int)] -> Endo (PlotBars PlotIndex Int)
applyValues [(FilePath, Int)]
bars =
ASetter
(PlotBars PlotIndex Int)
(PlotBars PlotIndex Int)
[(PlotIndex, [Int])]
[(PlotIndex, [Int])]
-> [(PlotIndex, [Int])] -> Endo (PlotBars PlotIndex Int)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(PlotBars PlotIndex Int)
(PlotBars PlotIndex Int)
[(PlotIndex, [Int])]
[(PlotIndex, [Int])]
forall x1 y x2.
Lens (PlotBars x1 y) (PlotBars x2 y) [(x1, [y])] [(x2, [y])]
plot_bars_values ([[Int]] -> [(PlotIndex, [Int])]
forall a. [a] -> [(PlotIndex, a)]
addIndexes [ [Int
y] | (FilePath
_, Int
y) <- [(FilePath, Int)]
bars ])
applyLabels :: Integral x => Bars -> Endo (Layout x y)
applyLabels :: [(FilePath, Int)] -> Endo (Layout x y)
applyLabels [(FilePath, Int)]
bars =
ASetter (Layout x y) (Layout x y) (AxisFn x) (AxisFn x)
-> AxisFn x -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis ((LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y))
-> ((AxisFn x -> Identity (AxisFn x))
-> LayoutAxis x -> Identity (LayoutAxis x))
-> ASetter (Layout x y) (Layout x y) (AxisFn x) (AxisFn x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisFn x -> Identity (AxisFn x))
-> LayoutAxis x -> Identity (LayoutAxis x)
forall x. Lens' (LayoutAxis x) (AxisFn x)
laxis_generate) ([FilePath] -> AxisFn x
forall i. Integral i => [FilePath] -> [i] -> AxisData i
autoIndexAxis [ FilePath
x | (FilePath
x, Int
_) <- [(FilePath, Int)]
bars ])
applyLayoutStyle :: Endo (Layout x y)
applyLayoutStyle :: Endo (Layout x y)
applyLayoutStyle =
[Endo (Layout x y)] -> Endo (Layout x y)
forall a. [a -> a] -> a -> a
foldEndo
[ ASetter (Layout x y) (Layout x y) Double Double
-> Double -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Layout x y) (Layout x y) Double Double
forall x y. Lens' (Layout x y) Double
layout_margin Double
40
, Double -> Endo (Layout x y)
forall x y. Double -> Endo (Layout x y)
setAxisLineWidth Double
5
, ASetter (Layout x y) (Layout x y) LineStyle LineStyle
-> (LineStyle -> LineStyle) -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Layout x y) (Layout x y) LineStyle LineStyle
forall x y. Lens' (Layout x y) LineStyle
yGridStyle (ASetter LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter LineStyle LineStyle Double Double
Lens' LineStyle Double
line_width Double
5 (LineStyle -> LineStyle)
-> (LineStyle -> LineStyle) -> LineStyle -> LineStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter LineStyle LineStyle [Double] [Double]
-> [Double] -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter LineStyle LineStyle [Double] [Double]
Lens' LineStyle [Double]
line_dashes [Double
40, Double
20])
, ASetter (Layout x y) (Layout x y) Double Double
-> Double -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double)
-> LayoutAxis y -> Identity (LayoutAxis y))
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisStyle -> Identity AxisStyle)
-> LayoutAxis y -> Identity (LayoutAxis y)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> Identity AxisStyle)
-> LayoutAxis y -> Identity (LayoutAxis y))
-> ((Double -> Identity Double) -> AxisStyle -> Identity AxisStyle)
-> (Double -> Identity Double)
-> LayoutAxis y
-> Identity (LayoutAxis y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> AxisStyle -> Identity AxisStyle
Lens' AxisStyle Double
axis_label_gap) Double
25
, ASetter (Layout x y) (Layout x y) Double Double
-> Double -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((FontStyle -> Identity FontStyle)
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) FontStyle
layout_title_style ((FontStyle -> Identity FontStyle)
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double) -> FontStyle -> Identity FontStyle)
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> FontStyle -> Identity FontStyle
Lens' FontStyle Double
font_size) Double
80
, Double -> Endo (Layout x y)
forall x y. Double -> Endo (Layout x y)
setAxisFontSize Double
40
]
yGridStyle :: Lens' (Layout x y) LineStyle
yGridStyle :: (LineStyle -> f LineStyle) -> Layout x y -> f (Layout x y)
yGridStyle = (LayoutAxis y -> f (LayoutAxis y)) -> Layout x y -> f (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis y -> f (LayoutAxis y))
-> Layout x y -> f (Layout x y))
-> ((LineStyle -> f LineStyle) -> LayoutAxis y -> f (LayoutAxis y))
-> (LineStyle -> f LineStyle)
-> Layout x y
-> f (Layout x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisStyle -> f AxisStyle) -> LayoutAxis y -> f (LayoutAxis y)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> f AxisStyle) -> LayoutAxis y -> f (LayoutAxis y))
-> ((LineStyle -> f LineStyle) -> AxisStyle -> f AxisStyle)
-> (LineStyle -> f LineStyle)
-> LayoutAxis y
-> f (LayoutAxis y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineStyle -> f LineStyle) -> AxisStyle -> f AxisStyle
Lens' AxisStyle LineStyle
axis_grid_style
axisLineWidth :: Lens' (LayoutAxis x) Double
axisLineWidth :: (Double -> f Double) -> LayoutAxis x -> f (LayoutAxis x)
axisLineWidth = (AxisStyle -> f AxisStyle) -> LayoutAxis x -> f (LayoutAxis x)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> f AxisStyle) -> LayoutAxis x -> f (LayoutAxis x))
-> ((Double -> f Double) -> AxisStyle -> f AxisStyle)
-> (Double -> f Double)
-> LayoutAxis x
-> f (LayoutAxis x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineStyle -> f LineStyle) -> AxisStyle -> f AxisStyle
Lens' AxisStyle LineStyle
axis_line_style ((LineStyle -> f LineStyle) -> AxisStyle -> f AxisStyle)
-> ((Double -> f Double) -> LineStyle -> f LineStyle)
-> (Double -> f Double)
-> AxisStyle
-> f AxisStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> LineStyle -> f LineStyle
Lens' LineStyle Double
line_width
axisLabelSize :: Lens' (LayoutAxis x) Double
axisLabelSize :: (Double -> f Double) -> LayoutAxis x -> f (LayoutAxis x)
axisLabelSize = (AxisStyle -> f AxisStyle) -> LayoutAxis x -> f (LayoutAxis x)
forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style ((AxisStyle -> f AxisStyle) -> LayoutAxis x -> f (LayoutAxis x))
-> ((Double -> f Double) -> AxisStyle -> f AxisStyle)
-> (Double -> f Double)
-> LayoutAxis x
-> f (LayoutAxis x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStyle -> f FontStyle) -> AxisStyle -> f AxisStyle
Lens' AxisStyle FontStyle
axis_label_style ((FontStyle -> f FontStyle) -> AxisStyle -> f AxisStyle)
-> ((Double -> f Double) -> FontStyle -> f FontStyle)
-> (Double -> f Double)
-> AxisStyle
-> f AxisStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> FontStyle -> f FontStyle
Lens' FontStyle Double
font_size
setAxisLineWidth :: Double -> Endo (Layout x y)
setAxisLineWidth :: Double -> Endo (Layout x y)
setAxisLineWidth Double
v =
[Endo (Layout x y)] -> Endo (Layout x y)
forall a. [a -> a] -> a -> a
foldEndo [ ASetter (Layout x y) (Layout x y) Double Double
-> Double -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Layout x y) (Layout x y) Double Double
l Double
v | ASetter (Layout x y) (Layout x y) Double Double
l <- [ (LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis ((LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double)
-> LayoutAxis x -> Identity (LayoutAxis x))
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double)
-> LayoutAxis x -> Identity (LayoutAxis x)
forall x. Lens' (LayoutAxis x) Double
axisLineWidth
, (LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double)
-> LayoutAxis y -> Identity (LayoutAxis y))
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double)
-> LayoutAxis y -> Identity (LayoutAxis y)
forall x. Lens' (LayoutAxis x) Double
axisLineWidth ] ]
setAxisFontSize :: Double -> Endo (Layout x y)
setAxisFontSize :: Double -> Endo (Layout x y)
setAxisFontSize Double
v =
[Endo (Layout x y)] -> Endo (Layout x y)
forall a. [a -> a] -> a -> a
foldEndo [ ASetter (Layout x y) (Layout x y) Double Double
-> Double -> Endo (Layout x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Layout x y) (Layout x y) Double Double
l Double
v | ASetter (Layout x y) (Layout x y) Double Double
l <- [ (LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis ((LayoutAxis x -> Identity (LayoutAxis x))
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double)
-> LayoutAxis x -> Identity (LayoutAxis x))
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double)
-> LayoutAxis x -> Identity (LayoutAxis x)
forall x. Lens' (LayoutAxis x) Double
axisLabelSize
, (LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y)
forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis ((LayoutAxis y -> Identity (LayoutAxis y))
-> Layout x y -> Identity (Layout x y))
-> ((Double -> Identity Double)
-> LayoutAxis y -> Identity (LayoutAxis y))
-> ASetter (Layout x y) (Layout x y) Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double)
-> LayoutAxis y -> Identity (LayoutAxis y)
forall x. Lens' (LayoutAxis x) Double
axisLabelSize ] ]
applyBarStyle :: Endo (PlotBars x y)
applyBarStyle :: Endo (PlotBars x y)
applyBarStyle =
[Endo (PlotBars x y)] -> Endo (PlotBars x y)
forall a. [a -> a] -> a -> a
foldEndo
[ ASetter
(PlotBars x y) (PlotBars x y) PlotBarsSpacing PlotBarsSpacing
-> PlotBarsSpacing -> Endo (PlotBars x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(PlotBars x y) (PlotBars x y) PlotBarsSpacing PlotBarsSpacing
forall x y. Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing (Double -> Double -> PlotBarsSpacing
BarsFixGap Double
80 Double
20)
, ASetter
(PlotBars x y)
(PlotBars x y)
[(FillStyle, Maybe LineStyle)]
[(FillStyle, Maybe LineStyle)]
-> [(FillStyle, Maybe LineStyle)] -> Endo (PlotBars x y)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(PlotBars x y)
(PlotBars x y)
[(FillStyle, Maybe LineStyle)]
[(FillStyle, Maybe LineStyle)]
forall x y. Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles [(AlphaColour Double -> FillStyle
FillStyleSolid (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
steelblue), Maybe LineStyle
forall a. Maybe a
Nothing)]
]