-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Bars
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Bar Charts
--
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module Graphics.Rendering.Chart.Plot.Bars(
    PlotBars(..),
    PlotBarsStyle(..),
    PlotBarsSpacing(..),
    PlotBarsAlignment(..),
    BarsPlotValue(..),
    BarHorizAnchor(..),
    BarVertAnchor(..),

    plotBars,
    plotHBars,

    plot_bars_style,
    plot_bars_item_styles,
    plot_bars_titles,
    plot_bars_spacing,
    plot_bars_alignment,
    plot_bars_singleton_width,
    plot_bars_label_bar_hanchor,
    plot_bars_label_bar_vanchor,
    plot_bars_label_text_hanchor,
    plot_bars_label_text_vanchor,
    plot_bars_label_angle,
    plot_bars_label_style,
    plot_bars_label_offset,

    plot_bars_values,

    plot_bars_settings,
    plot_bars_values_with_labels,

    addLabels
) where

import Control.Arrow
import Control.Lens
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (black)
import Data.Default.Class
import Data.Tuple(swap)
import Data.List(nub,sort)
import Graphics.Rendering.Chart.Axis
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Geometry hiding (x0, y0)
import Graphics.Rendering.Chart.Plot.Types
import Graphics.Rendering.Chart.Utils
class PlotValue a => BarsPlotValue a where
    barsIsNull    :: a -> Bool
    -- | The starting level for the chart, a function of some statistic
    --   (normally the lowest value or just const 0).
    barsReference :: [a] -> a
    barsAdd       :: a -> a -> a

instance BarsPlotValue Double where
    barsIsNull :: Double -> Bool
barsIsNull Double
a  = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0
    barsReference :: [Double] -> Double
barsReference = Double -> [Double] -> Double
forall a b. a -> b -> a
const Double
0
    barsAdd :: Double -> Double -> Double
barsAdd       = Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)

instance BarsPlotValue Int where
    barsIsNull :: Int -> Bool
barsIsNull Int
a  = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    barsReference :: [Int] -> Int
barsReference = Int -> [Int] -> Int
forall a b. a -> b -> a
const Int
0
    barsAdd :: Int -> Int -> Int
barsAdd       = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

instance BarsPlotValue LogValue where
    barsIsNull :: LogValue -> Bool
barsIsNull (LogValue Double
a) = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0
    barsReference :: [LogValue] -> LogValue
barsReference [LogValue]
as        =
      LogValue
10.0 LogValue -> Integer -> LogValue
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (LogValue -> Integer
forall b. Integral b => LogValue -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (LogValue -> LogValue
forall a. Floating a => a -> a
log10 (LogValue -> LogValue) -> LogValue -> LogValue
forall a b. (a -> b) -> a -> b
$ [LogValue] -> LogValue
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([LogValue] -> LogValue) -> [LogValue] -> LogValue
forall a b. (a -> b) -> a -> b
$ (LogValue -> Bool) -> [LogValue] -> [LogValue]
forall a. (a -> Bool) -> [a] -> [a]
filter (LogValue -> LogValue -> Bool
forall a. Eq a => a -> a -> Bool
/= LogValue
0.0) [LogValue]
as) :: Integer)
    barsAdd :: LogValue -> LogValue -> LogValue
barsAdd                 = LogValue -> LogValue -> LogValue
forall a. Num a => a -> a -> a
(+)

data PlotBarsStyle
    = BarsStacked   -- ^ Bars for a fixed x are stacked vertically
                    --   on top of each other.
    | BarsClustered -- ^ Bars for a fixed x are put horizontally
                    --   beside each other.
     deriving (Int -> PlotBarsStyle -> ShowS
[PlotBarsStyle] -> ShowS
PlotBarsStyle -> String
(Int -> PlotBarsStyle -> ShowS)
-> (PlotBarsStyle -> String)
-> ([PlotBarsStyle] -> ShowS)
-> Show PlotBarsStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlotBarsStyle -> ShowS
showsPrec :: Int -> PlotBarsStyle -> ShowS
$cshow :: PlotBarsStyle -> String
show :: PlotBarsStyle -> String
$cshowList :: [PlotBarsStyle] -> ShowS
showList :: [PlotBarsStyle] -> ShowS
Show)

data PlotBarsSpacing
    = BarsFixWidth Double       -- ^ All bars have the same width in pixels.
    | BarsFixGap Double Double  -- ^ (BarsFixGap g mw) means make the gaps between
                                --   the bars equal to g, but with a minimum bar width
                                --   of mw
     deriving (Int -> PlotBarsSpacing -> ShowS
[PlotBarsSpacing] -> ShowS
PlotBarsSpacing -> String
(Int -> PlotBarsSpacing -> ShowS)
-> (PlotBarsSpacing -> String)
-> ([PlotBarsSpacing] -> ShowS)
-> Show PlotBarsSpacing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlotBarsSpacing -> ShowS
showsPrec :: Int -> PlotBarsSpacing -> ShowS
$cshow :: PlotBarsSpacing -> String
show :: PlotBarsSpacing -> String
$cshowList :: [PlotBarsSpacing] -> ShowS
showList :: [PlotBarsSpacing] -> ShowS
Show)

-- | How bars for a given (x,[y]) are aligned with respect to screen
--   coordinate corresponding to x (deviceX).
data PlotBarsAlignment = BarsLeft      -- ^ The left edge of bars is at deviceX
                       | BarsCentered  -- ^ Bars are centered around deviceX
                       | BarsRight     -- ^ The right edge of bars is at deviceX
     deriving (Int -> PlotBarsAlignment -> ShowS
[PlotBarsAlignment] -> ShowS
PlotBarsAlignment -> String
(Int -> PlotBarsAlignment -> ShowS)
-> (PlotBarsAlignment -> String)
-> ([PlotBarsAlignment] -> ShowS)
-> Show PlotBarsAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlotBarsAlignment -> ShowS
showsPrec :: Int -> PlotBarsAlignment -> ShowS
$cshow :: PlotBarsAlignment -> String
show :: PlotBarsAlignment -> String
$cshowList :: [PlotBarsAlignment] -> ShowS
showList :: [PlotBarsAlignment] -> ShowS
Show)

data BarHorizAnchor
    = BHA_Left
    | BHA_Centre
    | BHA_Right
     deriving (Int -> BarHorizAnchor -> ShowS
[BarHorizAnchor] -> ShowS
BarHorizAnchor -> String
(Int -> BarHorizAnchor -> ShowS)
-> (BarHorizAnchor -> String)
-> ([BarHorizAnchor] -> ShowS)
-> Show BarHorizAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarHorizAnchor -> ShowS
showsPrec :: Int -> BarHorizAnchor -> ShowS
$cshow :: BarHorizAnchor -> String
show :: BarHorizAnchor -> String
$cshowList :: [BarHorizAnchor] -> ShowS
showList :: [BarHorizAnchor] -> ShowS
Show)

data BarVertAnchor
    = BVA_Bottom
    | BVA_Centre
    | BVA_Top
     deriving (Int -> BarVertAnchor -> ShowS
[BarVertAnchor] -> ShowS
BarVertAnchor -> String
(Int -> BarVertAnchor -> ShowS)
-> (BarVertAnchor -> String)
-> ([BarVertAnchor] -> ShowS)
-> Show BarVertAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarVertAnchor -> ShowS
showsPrec :: Int -> BarVertAnchor -> ShowS
$cshow :: BarVertAnchor -> String
show :: BarVertAnchor -> String
$cshowList :: [BarVertAnchor] -> ShowS
showList :: [BarVertAnchor] -> ShowS
Show)

-- | Value describing how to plot a set of bars.
--   Note that the input data is typed [(x,[y])], ie for each x value
--   we plot several y values. Typically the size of each [y] list would
--   be the same.
data BarsSettings = BarsSettings {
   -- | This value specifies whether each value from [y] should be
   --   shown beside or above the previous value.
   BarsSettings -> PlotBarsStyle
_bars_settings_style           :: PlotBarsStyle,

   -- | The style in which to draw each element of [y]. A fill style
   --   is required, and if a linestyle is given, each bar will be
   --   outlined.
   BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles     :: [ (FillStyle,Maybe LineStyle) ],

   -- | This value controls how the widths of the bars are
   --   calculated. Either the widths of the bars, or the gaps between
   --   them can be fixed.
   BarsSettings -> PlotBarsSpacing
_bars_settings_spacing         :: PlotBarsSpacing,

   -- | This value controls how bars for a fixed x are aligned with
   --   respect to the device coordinate corresponding to x.
   BarsSettings -> PlotBarsAlignment
_bars_settings_alignment       :: PlotBarsAlignment,

   BarsSettings -> Double
_bars_settings_singleton_width :: Double,

   -- | The point on the bar to horizontally anchor the label to
   BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor :: BarHorizAnchor,

   -- | The point on the bar to vertically anchor the label to
   BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor  :: BarVertAnchor,

    -- | The anchor point on the label.
   BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor :: HTextAnchor,

    -- | The anchor point on the label.
   BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor :: VTextAnchor,

   -- | Angle, in degrees, to rotate the label about the anchor point.
   BarsSettings -> Double
_bars_settings_label_angle   :: Double,

   -- | The style to use for the label.
   BarsSettings -> FontStyle
_bars_settings_label_style   :: FontStyle,

   -- | The offset from the anchor point to display the label at.
   BarsSettings -> Vector
_bars_settings_label_offset  :: Vector
}
instance Default BarsSettings where
  def :: BarsSettings
def = BarsSettings
    { _bars_settings_style :: PlotBarsStyle
_bars_settings_style              = PlotBarsStyle
BarsClustered
    , _bars_settings_item_styles :: [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles        = [(FillStyle, Maybe LineStyle)] -> [(FillStyle, Maybe LineStyle)]
forall a. HasCallStack => [a] -> [a]
cycle [(FillStyle, Maybe LineStyle)]
istyles
    , _bars_settings_spacing :: PlotBarsSpacing
_bars_settings_spacing            = Double -> Double -> PlotBarsSpacing
BarsFixGap Double
10 Double
2
    , _bars_settings_alignment :: PlotBarsAlignment
_bars_settings_alignment          = PlotBarsAlignment
BarsCentered
    , _bars_settings_singleton_width :: Double
_bars_settings_singleton_width    = Double
20
    , _bars_settings_label_bar_hanchor :: BarHorizAnchor
_bars_settings_label_bar_hanchor  = BarHorizAnchor
BHA_Centre
    , _bars_settings_label_bar_vanchor :: BarVertAnchor
_bars_settings_label_bar_vanchor  = BarVertAnchor
BVA_Top
    , _bars_settings_label_text_hanchor :: HTextAnchor
_bars_settings_label_text_hanchor = HTextAnchor
HTA_Centre
    , _bars_settings_label_text_vanchor :: VTextAnchor
_bars_settings_label_text_vanchor = VTextAnchor
VTA_Bottom
    , _bars_settings_label_angle :: Double
_bars_settings_label_angle        = Double
0
    , _bars_settings_label_style :: FontStyle
_bars_settings_label_style        = FontStyle
forall a. Default a => a
def
    , _bars_settings_label_offset :: Vector
_bars_settings_label_offset       = Double -> Double -> Vector
Vector Double
0 Double
0
    }
    where
      istyles :: [(FillStyle, Maybe LineStyle)]
istyles   = (AlphaColour Double -> (FillStyle, Maybe LineStyle))
-> [AlphaColour Double] -> [(FillStyle, Maybe LineStyle)]
forall a b. (a -> b) -> [a] -> [b]
map AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkstyle [AlphaColour Double]
defaultColorSeq
      mkstyle :: AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkstyle AlphaColour Double
c = (AlphaColour Double -> FillStyle
solidFillStyle AlphaColour Double
c, LineStyle -> Maybe LineStyle
forall a. a -> Maybe a
Just (Double -> AlphaColour Double -> LineStyle
solidLine Double
1.0 (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black))
data PlotBars x y = PlotBars {
   forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings :: BarsSettings,
   -- | The title of each element of [y]. These will be shown in the legend.
   forall x y. PlotBars x y -> [String]
_plot_bars_titles :: [String],
   -- | The actual points to be plotted, and their labels
   forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels :: [(x, [(y, String)])]
}
instance Default (PlotBars x y) where
  def :: PlotBars x y
def = PlotBars
    { _plot_bars_settings :: BarsSettings
_plot_bars_settings = BarsSettings
forall a. Default a => a
def
    , _plot_bars_titles :: [String]
_plot_bars_titles = []
    , _plot_bars_values_with_labels :: [(x, [(y, String)])]
_plot_bars_values_with_labels = []
    }

plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y
plotBars :: forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars PlotBars x y
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = \PointMapFn x y
pmap -> BarsSettings
-> [(x, [(y, String)])]
-> y
-> (Double -> Double -> x -> y -> y -> Rect)
-> (x -> Double)
-> BackendProgram ()
forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
s [(x, [(y, String)])]
vals y
yref0
                                      (PointMapFn x y -> Double -> Double -> x -> y -> y -> Rect
forall {x} {y}.
((Limit x, Limit y) -> Point)
-> Double -> Double -> x -> y -> y -> Rect
barRect PointMapFn x y
pmap) (PointMapFn x y -> x -> Double
forall {x}. PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap),
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [String]
-> [Rect -> BackendProgram ()]
-> [(String, Rect -> BackendProgram ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (PlotBars x y -> [String]
forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars x y
p)
                               (((FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ())
-> [(FillStyle, Maybe LineStyle)] -> [Rect -> BackendProgram ()]
forall a b. (a -> b) -> [a] -> [b]
map (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars
                                    (BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
        _plot_all_points :: ([x], [y])
_plot_all_points = BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(x, [(y, String)])]
vals
    }
  where
    s :: BarsSettings
s = PlotBars x y -> BarsSettings
forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars x y
p
    vals :: [(x, [(y, String)])]
vals = PlotBars x y -> [(x, [(y, String)])]
forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars x y
p
    yref0 :: y
yref0 = BarsSettings -> [(x, [(y, String)])] -> y
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(x, [(y, String)])]
vals

    barRect :: ((Limit x, Limit y) -> Point)
-> Double -> Double -> x -> y -> y -> Rect
barRect (Limit x, Limit y) -> Point
pmap Double
xos Double
width x
x y
y0 y
y1 = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
x'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xos) Double
y0') (Double -> Double -> Point
Point (Double
x'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xosDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
width) Double
y') where
      Point Double
x' Double
y' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x,y
y1)
      Point Double
_ Double
y0' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x,y
y0)

    mapX :: PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap x
x = Point -> Double
p_x (PointMapFn x y -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x, y
yref0))

plotHBars :: (BarsPlotValue x) => PlotBars y x -> Plot x y
plotHBars :: forall x y. BarsPlotValue x => PlotBars y x -> Plot x y
plotHBars PlotBars y x
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = \PointMapFn x y
pmap -> BarsSettings
-> [(y, [(x, String)])]
-> x
-> (Double -> Double -> y -> x -> x -> Rect)
-> (y -> Double)
-> BackendProgram ()
forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
s [(y, [(x, String)])]
vals x
xref0
                                      (PointMapFn x y -> Double -> Double -> y -> x -> x -> Rect
forall {x} {y}.
((Limit x, Limit y) -> Point)
-> Double -> Double -> y -> x -> x -> Rect
barRect PointMapFn x y
pmap) (PointMapFn x y -> y -> Double
forall {y}. PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap),
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [String]
-> [Rect -> BackendProgram ()]
-> [(String, Rect -> BackendProgram ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (PlotBars y x -> [String]
forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars y x
p)
                               (((FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ())
-> [(FillStyle, Maybe LineStyle)] -> [Rect -> BackendProgram ()]
forall a b. (a -> b) -> [a] -> [b]
map (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars
                                    (BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
        _plot_all_points :: ([x], [y])
_plot_all_points = ([y], [x]) -> ([x], [y])
forall a b. (a, b) -> (b, a)
swap (([y], [x]) -> ([x], [y])) -> ([y], [x]) -> ([x], [y])
forall a b. (a -> b) -> a -> b
$ BarsSettings -> [(y, [(x, String)])] -> ([y], [x])
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(y, [(x, String)])]
vals
    }
  where
    s :: BarsSettings
s = PlotBars y x -> BarsSettings
forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars y x
p
    vals :: [(y, [(x, String)])]
vals = PlotBars y x -> [(y, [(x, String)])]
forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars y x
p
    xref0 :: x
xref0 = BarsSettings -> [(y, [(x, String)])] -> x
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(y, [(x, String)])]
vals

    barRect :: ((Limit x, Limit y) -> Point)
-> Double -> Double -> y -> x -> x -> Rect
barRect (Limit x, Limit y) -> Point
pmap Double
yos Double
height y
y x
x0 x
x1 = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x0' (Double
y'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yos)) (Double -> Double -> Point
Point Double
x' (Double
y'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yosDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
height)) where
      Point Double
x' Double
y' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x1,y
y)
      Point Double
x0' Double
_ = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x0,y
y)

    mapY :: PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap y
y = Point -> Double
p_y (PointMapFn x y -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
xref0, y
y))

renderBars :: (BarsPlotValue v) =>
              BarsSettings
           -> [(k, [(v, String)])]
           -> v
           -> (Double -> Double -> k -> v -> v -> Rect)
           -> (k -> Double)
           -> BackendProgram ()
renderBars :: forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
p [(k, [(v, String)])]
vals v
vref0 Double -> Double -> k -> v -> v -> Rect
r k -> Double
mapk = case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
      PlotBarsStyle
BarsClustered -> [(k, [(v, String)])]
-> ((k, [(v, String)]) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(k, [(v, String)])]
vals (k, [(v, String)]) -> BackendProgram ()
clusteredBars
      PlotBarsStyle
BarsStacked   -> [(k, [(v, String)])]
-> ((k, [(v, String)]) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(k, [(v, String)])]
vals (k, [(v, String)]) -> BackendProgram ()
stackedBars
  where
    clusteredBars :: (k, [(v, String)]) -> BackendProgram ()
clusteredBars (k
k,[(v, String)]
vs) = do
       let offset :: Int -> Double
offset Int
i = case BarsSettings -> PlotBarsAlignment
_bars_settings_alignment BarsSettings
p of
             PlotBarsAlignment
BarsLeft     -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bsize
             PlotBarsAlignment
BarsRight    -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nvs) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bsize
             PlotBarsAlignment
BarsCentered -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nvs) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bsizeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
       [(Int, (v, String), (FillStyle, Maybe LineStyle))]
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
    -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(v, String)]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, (v, String), (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) (((Int, (v, String), (FillStyle, Maybe LineStyle))
  -> BackendProgram ())
 -> BackendProgram ())
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
    -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
fstyle,Maybe LineStyle
_)) ->
           Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
             Path -> BackendProgram Path
alignFillPath (Double -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
             BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall a b.
ProgramT ChartBackendInstr Identity a
-> (a -> ProgramT ChartBackendInstr Identity b)
-> ProgramT ChartBackendInstr Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       [(Int, (v, String), (FillStyle, Maybe LineStyle))]
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
    -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(v, String)]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, (v, String), (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) (((Int, (v, String), (FillStyle, Maybe LineStyle))
  -> BackendProgram ())
 -> BackendProgram ())
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
    -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
           Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           Maybe LineStyle
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle ((LineStyle -> BackendProgram ()) -> BackendProgram ())
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle ->
             LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
               Path -> BackendProgram Path
alignStrokePath (Double -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
               BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall a b.
ProgramT ChartBackendInstr Identity a
-> (a -> ProgramT ChartBackendInstr Identity b)
-> ProgramT ChartBackendInstr Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath
       FontStyle -> BackendProgram () -> BackendProgram ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           [(Int, (v, String))]
-> ((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(v, String)] -> [(Int, (v, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
1..] [(v, String)]
vs) (((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ())
-> ((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
txt)) ->
             Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
               let ha :: BarHorizAnchor
ha = BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor BarsSettings
p
               let va :: BarVertAnchor
va = BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor BarsSettings
p
               let pt :: Point
pt = BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
ha BarVertAnchor
va (Double -> Double -> k -> v -> v -> Rect
r (Int -> Double
offset Int
i) Double
bsize k
k v
vref0 v
v)
               HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR
                  (BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor BarsSettings
p)
                  (BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor BarsSettings
p)
                  (BarsSettings -> Double
_bars_settings_label_angle BarsSettings
p)
                  (Point -> Vector -> Point
pvadd Point
pt (Vector -> Point) -> Vector -> Point
forall a b. (a -> b) -> a -> b
$ BarsSettings -> Vector
_bars_settings_label_offset BarsSettings
p)
                  String
txt

    stackedBars :: (k, [(v, String)]) -> BackendProgram ()
stackedBars (k
k,[(v, String)]
vs) = do
       let ([v]
vs', [String]
lbls) = [(v, String)] -> ([v], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, String)]
vs
       let vs'' :: [v]
vs'' = (v -> v) -> [v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> if v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v then v
vref0 else v
v) ([v] -> [v]
forall y. BarsPlotValue y => [y] -> [y]
stack [v]
vs')
       let v2s :: [(v, v)]
v2s = [v] -> [v] -> [(v, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip (v
vref0v -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
vs'') [v]
vs''
       let ofs :: Double
ofs = case BarsSettings -> PlotBarsAlignment
_bars_settings_alignment BarsSettings
p of
             PlotBarsAlignment
BarsLeft     -> Double
0
             PlotBarsAlignment
BarsRight    -> -Double
bsize
             PlotBarsAlignment
BarsCentered -> -(Double
bsizeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
       [((v, v), (FillStyle, Maybe LineStyle))]
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)]
-> [(FillStyle, Maybe LineStyle)]
-> [((v, v), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) ((((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
fstyle,Maybe LineStyle
_)) ->
           Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
v1) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
             Path -> BackendProgram Path
alignFillPath (Double -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
             BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall a b.
ProgramT ChartBackendInstr Identity a
-> (a -> ProgramT ChartBackendInstr Identity b)
-> ProgramT ChartBackendInstr Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       [((v, v), (FillStyle, Maybe LineStyle))]
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)]
-> [(FillStyle, Maybe LineStyle)]
-> [((v, v), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) ((((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
           Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
v1) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           Maybe LineStyle
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle ((LineStyle -> BackendProgram ()) -> BackendProgram ())
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle ->
              LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
                Path -> BackendProgram Path
alignStrokePath (Double -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
                BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall a b.
ProgramT ChartBackendInstr Identity a
-> (a -> ProgramT ChartBackendInstr Identity b)
-> ProgramT ChartBackendInstr Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath
       FontStyle -> BackendProgram () -> BackendProgram ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
           [((v, v), String)]
-> (((v, v), String) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)] -> [String] -> [((v, v), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [String]
lbls) ((((v, v), String) -> BackendProgram ()) -> BackendProgram ())
-> (((v, v), String) -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0, v
v1), String
txt) ->
             Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
               let ha :: BarHorizAnchor
ha = BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor BarsSettings
p
               let va :: BarVertAnchor
va = BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor BarsSettings
p
               let pt :: Point
pt = BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
ha BarVertAnchor
va (Double -> Double -> k -> v -> v -> Rect
r Double
ofs Double
bsize k
k v
v0 v
v1)
               HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR
                  (BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor BarsSettings
p)
                  (BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor BarsSettings
p)
                  (BarsSettings -> Double
_bars_settings_label_angle BarsSettings
p)
                  (Point -> Vector -> Point
pvadd Point
pt (Vector -> Point) -> Vector -> Point
forall a b. (a -> b) -> a -> b
$ BarsSettings -> Vector
_bars_settings_label_offset BarsSettings
p)
                  String
txt

    styles :: [(FillStyle, Maybe LineStyle)]
styles = BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
p

    barPath :: Double -> k -> v -> v -> Path
barPath Double
os k
k v
v0 v
v1 = Rect -> Path
rectPath (Rect -> Path) -> Rect -> Path
forall a b. (a -> b) -> a -> b
$ Double -> Double -> k -> v -> v -> Rect
r Double
os Double
bsize k
k v
v0 v
v1

    bsize :: Double
bsize = case BarsSettings -> PlotBarsSpacing
_bars_settings_spacing BarsSettings
p of
        BarsFixGap Double
gap Double
minw -> let w :: Double
w = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
minKInterval Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gap) Double
minw in
            case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
                PlotBarsStyle
BarsClustered -> Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nvs
                PlotBarsStyle
BarsStacked -> Double
w
        BarsFixWidth Double
width' -> Double
width'

    minKInterval :: Double
minKInterval = let diffs :: [Double]
diffs = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
mks) [Double]
mks
                   in if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
diffs
                        then BarsSettings -> Double
_bars_settings_singleton_width BarsSettings
p
                        else [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
diffs
      where
        mks :: [Double]
mks = [Double] -> [Double]
forall a. Eq a => [a] -> [a]
nub ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. Ord a => [a] -> [a]
sort ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ ((k, [(v, String)]) -> Double) -> [(k, [(v, String)])] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (k -> Double
mapk (k -> Double)
-> ((k, [(v, String)]) -> k) -> (k, [(v, String)]) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [(v, String)]) -> k
forall a b. (a, b) -> a
fst) [(k, [(v, String)])]
vals

    nvs :: Int
nvs = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((k, [(v, String)]) -> Int) -> [(k, [(v, String)])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(v, String)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(v, String)] -> Int)
-> ((k, [(v, String)]) -> [(v, String)])
-> (k, [(v, String)])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [(v, String)]) -> [(v, String)]
forall a b. (a, b) -> b
snd) [(k, [(v, String)])]
vals

rectCorner :: BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner :: BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
h BarVertAnchor
v (Rect (Point Double
x0 Double
y0) (Point Double
x1 Double
y1)) = Double -> Double -> Point
Point Double
x' Double
y' where
    x' :: Double
x' = case BarHorizAnchor
h of
              BarHorizAnchor
BHA_Left   -> Double
x0
              BarHorizAnchor
BHA_Right  -> Double
x1
              BarHorizAnchor
BHA_Centre -> (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    y' :: Double
y' = case BarVertAnchor
v of
              BarVertAnchor
BVA_Bottom -> Double
y0
              BarVertAnchor
BVA_Top    -> Double
y1
              BarVertAnchor
BVA_Centre -> (Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

-- Helper function for printing bar values as labels
addLabels :: Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels :: forall y x. Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels = ((x, [y]) -> (x, [(y, String)]))
-> [(x, [y])] -> [(x, [(y, String)])]
forall a b. (a -> b) -> [a] -> [b]
map (((x, [y]) -> (x, [(y, String)]))
 -> [(x, [y])] -> [(x, [(y, String)])])
-> (([y] -> [(y, String)]) -> (x, [y]) -> (x, [(y, String)]))
-> ([y] -> [(y, String)])
-> [(x, [y])]
-> [(x, [(y, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([y] -> [(y, String)]) -> (x, [y]) -> (x, [(y, String)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([y] -> [(y, String)]) -> [(x, [y])] -> [(x, [(y, String)])])
-> ([y] -> [(y, String)]) -> [(x, [y])] -> [(x, [(y, String)])]
forall a b. (a -> b) -> a -> b
$ (y -> (y, String)) -> [y] -> [(y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\y
y -> (y
y, y -> String
forall a. Show a => a -> String
show y
y))

refVal :: (BarsPlotValue y) => BarsSettings -> [(x, [(y, String)])] -> y
refVal :: forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
p [(x, [(y, String)])]
vals = [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference ([y] -> y) -> [y] -> y
forall a b. (a -> b) -> a -> b
$ case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
    PlotBarsStyle
BarsClustered -> ((x, [(y, String)]) -> [y]) -> [(x, [(y, String)])] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst ([(y, String)] -> [y])
-> ((x, [(y, String)]) -> [(y, String)])
-> (x, [(y, String)])
-> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, [(y, String)]) -> [(y, String)]
forall a b. (a, b) -> b
snd) [(x, [(y, String)])]
vals
    PlotBarsStyle
BarsStacked   -> ((x, [(y, String)]) -> [y]) -> [(x, [(y, String)])] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [y] -> [y]
forall a. Int -> [a] -> [a]
take Int
1 ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile y -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst ([(y, String)] -> [y])
-> ((x, [(y, String)]) -> [(y, String)])
-> (x, [(y, String)])
-> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, [(y, String)]) -> [(y, String)]
forall a b. (a, b) -> b
snd) [(x, [(y, String)])]
vals

allBarPoints :: (BarsPlotValue y) => BarsSettings -> [(x, [(y, String)])] -> ([x],[y])
allBarPoints :: forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
p [(x, [(y, String)])]
vals = case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
    PlotBarsStyle
BarsClustered ->
      let ys :: [y]
ys = ([(y, String)] -> [y]) -> [[(y, String)]] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
      ( [x]
xs, [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference [y]
ysy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys )
    PlotBarsStyle
BarsStacked   ->
      let ys :: [[y]]
ys = ([(y, String)] -> [y]) -> [[(y, String)]] -> [[y]]
forall a b. (a -> b) -> [a] -> [b]
map ([y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack ([y] -> [y]) -> ([(y, String)] -> [y]) -> [(y, String)] -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
      ( [x]
xs, [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference (([y] -> [y]) -> [[y]] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [y] -> [y]
forall a. Int -> [a] -> [a]
take Int
1 ([y] -> [y]) -> ([y] -> [y]) -> [y] -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile y -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull) [[y]]
ys)y -> [y] -> [y]
forall a. a -> [a] -> [a]
:[[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[y]]
ys)
  where ([x]
xs, [[(y, String)]]
yls) = [(x, [(y, String)])] -> ([x], [[(y, String)]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(x, [(y, String)])]
vals

stack :: (BarsPlotValue y) => [y] -> [y]
stack :: forall y. BarsPlotValue y => [y] -> [y]
stack = (y -> y -> y) -> [y] -> [y]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 y -> y -> y
forall a. BarsPlotValue a => a -> a -> a
barsAdd

renderPlotLegendBars :: (FillStyle,Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars :: (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars (FillStyle
fstyle,Maybe LineStyle
_) Rect
r =
  FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
    Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath Rect
r)

$( makeLenses ''BarsSettings )
$( makeLenses ''PlotBars )

-- Lens provided for backward compat.

-- Note that this one does not satisfy the lens laws, as it discards/overwrites the labels.
plot_bars_values :: Lens' (PlotBars x y) [(x, [y])]
plot_bars_values :: forall x y (f :: * -> *).
Functor f =>
([(x, [y])] -> f [(x, [y])]) -> PlotBars x y -> f (PlotBars x y)
plot_bars_values = (PlotBars x y -> [(x, [y])])
-> (PlotBars x y -> [(x, [y])] -> PlotBars x y)
-> Lens (PlotBars x y) (PlotBars x y) [(x, [y])] [(x, [y])]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PlotBars x y -> [(x, [y])]
forall {c} {b}. PlotBars c b -> [(c, [b])]
getter PlotBars x y -> [(x, [y])] -> PlotBars x y
forall {x} {y} {x} {y}. PlotBars x y -> [(x, [y])] -> PlotBars x y
setter
  where
    getter :: PlotBars c b -> [(c, [b])]
getter = ((b, String) -> b) -> [(c, [(b, String)])] -> [(c, [b])]
forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs (b, String) -> b
forall a b. (a, b) -> a
fst ([(c, [(b, String)])] -> [(c, [b])])
-> (PlotBars c b -> [(c, [(b, String)])])
-> PlotBars c b
-> [(c, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlotBars c b -> [(c, [(b, String)])]
forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels
    setter :: PlotBars x y -> [(x, [y])] -> PlotBars x y
setter PlotBars x y
pb [(x, [y])]
vals' = PlotBars x y
pb { _plot_bars_values_with_labels = mapYs (, "") vals' }
    mapYs :: (a -> b) -> [(c, [a])] -> [(c, [b])]
    mapYs :: forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs a -> b
f = ((c, [a]) -> (c, [b])) -> [(c, [a])] -> [(c, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (c, [a]) (c, [b]) [a] [b]
-> ([a] -> [b]) -> (c, [a]) -> (c, [b])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (c, [a]) (c, [b]) [a] [b]
forall s t a b. Field2 s t a b => Lens s t a b
Lens (c, [a]) (c, [b]) [a] [b]
_2 (([a] -> [b]) -> (c, [a]) -> (c, [b]))
-> ([a] -> [b]) -> (c, [a]) -> (c, [b])
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f)

plot_bars_style :: Lens' (PlotBars x y) PlotBarsStyle
plot_bars_style :: forall x y (f :: * -> *).
Functor f =>
(PlotBarsStyle -> f PlotBarsStyle)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_style = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsStyle -> f PlotBarsStyle)
    -> BarsSettings -> f BarsSettings)
-> (PlotBarsStyle -> f PlotBarsStyle)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsStyle -> f PlotBarsStyle)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsStyle
bars_settings_style

plot_bars_item_styles :: Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles :: forall x y (f :: * -> *).
Functor f =>
([(FillStyle, Maybe LineStyle)]
 -> f [(FillStyle, Maybe LineStyle)])
-> PlotBars x y -> f (PlotBars x y)
plot_bars_item_styles = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> (([(FillStyle, Maybe LineStyle)]
     -> f [(FillStyle, Maybe LineStyle)])
    -> BarsSettings -> f BarsSettings)
-> ([(FillStyle, Maybe LineStyle)]
    -> f [(FillStyle, Maybe LineStyle)])
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(FillStyle, Maybe LineStyle)]
 -> f [(FillStyle, Maybe LineStyle)])
-> BarsSettings -> f BarsSettings
Lens' BarsSettings [(FillStyle, Maybe LineStyle)]
bars_settings_item_styles

plot_bars_spacing :: Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing :: forall x y (f :: * -> *).
Functor f =>
(PlotBarsSpacing -> f PlotBarsSpacing)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_spacing = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsSpacing -> f PlotBarsSpacing)
    -> BarsSettings -> f BarsSettings)
-> (PlotBarsSpacing -> f PlotBarsSpacing)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsSpacing -> f PlotBarsSpacing)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsSpacing
bars_settings_spacing

plot_bars_alignment :: Lens' (PlotBars x y) PlotBarsAlignment
plot_bars_alignment :: forall x y (f :: * -> *).
Functor f =>
(PlotBarsAlignment -> f PlotBarsAlignment)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_alignment =  (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsAlignment -> f PlotBarsAlignment)
    -> BarsSettings -> f BarsSettings)
-> (PlotBarsAlignment -> f PlotBarsAlignment)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsAlignment -> f PlotBarsAlignment)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsAlignment
bars_settings_alignment

plot_bars_singleton_width :: Lens' (PlotBars x y) Double
plot_bars_singleton_width :: forall x y (f :: * -> *).
Functor f =>
(Double -> f Double) -> PlotBars x y -> f (PlotBars x y)
plot_bars_singleton_width = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((Double -> f Double) -> BarsSettings -> f BarsSettings)
-> (Double -> f Double)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> BarsSettings -> f BarsSettings
Lens' BarsSettings Double
bars_settings_singleton_width

plot_bars_label_bar_hanchor :: Lens' (PlotBars x y) BarHorizAnchor
plot_bars_label_bar_hanchor :: forall x y (f :: * -> *).
Functor f =>
(BarHorizAnchor -> f BarHorizAnchor)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_label_bar_hanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((BarHorizAnchor -> f BarHorizAnchor)
    -> BarsSettings -> f BarsSettings)
-> (BarHorizAnchor -> f BarHorizAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarHorizAnchor -> f BarHorizAnchor)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings BarHorizAnchor
bars_settings_label_bar_hanchor

plot_bars_label_bar_vanchor :: Lens' (PlotBars x y) BarVertAnchor
plot_bars_label_bar_vanchor :: forall x y (f :: * -> *).
Functor f =>
(BarVertAnchor -> f BarVertAnchor)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_label_bar_vanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((BarVertAnchor -> f BarVertAnchor)
    -> BarsSettings -> f BarsSettings)
-> (BarVertAnchor -> f BarVertAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarVertAnchor -> f BarVertAnchor)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings BarVertAnchor
bars_settings_label_bar_vanchor

plot_bars_label_text_hanchor :: Lens' (PlotBars x y) HTextAnchor
plot_bars_label_text_hanchor :: forall x y (f :: * -> *).
Functor f =>
(HTextAnchor -> f HTextAnchor) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_text_hanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((HTextAnchor -> f HTextAnchor)
    -> BarsSettings -> f BarsSettings)
-> (HTextAnchor -> f HTextAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HTextAnchor -> f HTextAnchor) -> BarsSettings -> f BarsSettings
Lens' BarsSettings HTextAnchor
bars_settings_label_text_hanchor

plot_bars_label_text_vanchor :: Lens' (PlotBars x y) VTextAnchor
plot_bars_label_text_vanchor :: forall x y (f :: * -> *).
Functor f =>
(VTextAnchor -> f VTextAnchor) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_text_vanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((VTextAnchor -> f VTextAnchor)
    -> BarsSettings -> f BarsSettings)
-> (VTextAnchor -> f VTextAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VTextAnchor -> f VTextAnchor) -> BarsSettings -> f BarsSettings
Lens' BarsSettings VTextAnchor
bars_settings_label_text_vanchor

plot_bars_label_angle :: Lens' (PlotBars x y) Double
plot_bars_label_angle :: forall x y (f :: * -> *).
Functor f =>
(Double -> f Double) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_angle = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((Double -> f Double) -> BarsSettings -> f BarsSettings)
-> (Double -> f Double)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> BarsSettings -> f BarsSettings
Lens' BarsSettings Double
bars_settings_label_angle

plot_bars_label_style :: Lens' (PlotBars x y) FontStyle
plot_bars_label_style :: forall x y (f :: * -> *).
Functor f =>
(FontStyle -> f FontStyle) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_style = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((FontStyle -> f FontStyle) -> BarsSettings -> f BarsSettings)
-> (FontStyle -> f FontStyle)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStyle -> f FontStyle) -> BarsSettings -> f BarsSettings
Lens' BarsSettings FontStyle
bars_settings_label_style

plot_bars_label_offset :: Lens' (PlotBars x y) Vector
plot_bars_label_offset :: forall x y (f :: * -> *).
Functor f =>
(Vector -> f Vector) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_offset = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
 -> PlotBars x y -> f (PlotBars x y))
-> ((Vector -> f Vector) -> BarsSettings -> f BarsSettings)
-> (Vector -> f Vector)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector -> f Vector) -> BarsSettings -> f BarsSettings
Lens' BarsSettings Vector
bars_settings_label_offset