-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Layout
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- This module glues together axes and plots to actually create a renderable
-- for a chart.
--
-- Note that Template haskell is used to derive accessor functions
-- (see 'Control.Lens') for each field of the following data types:
--
--     * 'Layout'
--
--     * 'LayoutLR'
--
--     * 'StackedLayouts'
--
--     * 'LayoutAxis'
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}

module Graphics.Rendering.Chart.Layout
  ( -- * Types
    Layout(..)
  , LayoutLR(..)
  , LayoutAxis(..)
  , LayoutPick(..)
  , StackedLayouts(..)
  , StackedLayout(..)
  -- , LegendItem  haddock complains about this being missing, but from what?
  , MAxisFn

    -- * Rendering
  , layoutToRenderable
  , layoutToGrid
  , layoutLRToRenderable
  , layoutLRToGrid
  , renderStackedLayouts

    -- * LayoutAxis lenses
  , laxis_title_style
  , laxis_title
  , laxis_style
  , laxis_generate
  , laxis_override
  , laxis_reverse

    -- * Layout lenses
  , layout_background
  , layout_plot_background
  , layout_title
  , layout_title_style
  , layout_x_axis
  , layout_top_axis_visibility
  , layout_bottom_axis_visibility
  , layout_y_axis
  , layout_left_axis_visibility
  , layout_right_axis_visibility
  , layout_margin
  , layout_plots
  , layout_legend
  , layout_grid_last

  , layout_axes_styles
  , layout_axes_title_styles
  , layout_all_font_styles
  , layout_foreground

    -- * LayoutLR lenses
  , layoutlr_background
  , layoutlr_plot_background
  , layoutlr_title
  , layoutlr_title_style
  , layoutlr_x_axis
  , layoutlr_top_axis_visibility
  , layoutlr_bottom_axis_visibility
  , layoutlr_left_axis
  , layoutlr_right_axis
  , layoutlr_left_axis_visibility
  , layoutlr_right_axis_visibility
  , layoutlr_plots
  , layoutlr_legend
  , layoutlr_margin
  , layoutlr_grid_last

  , layoutlr_axes_styles
  , layoutlr_axes_title_styles
  , layoutlr_all_font_styles
  , layoutlr_foreground

    -- * StackedLayouts lenses
  , slayouts_layouts
  , slayouts_compress_legend
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

import Graphics.Rendering.Chart.Axis
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Utils
import Graphics.Rendering.Chart.Plot
import Graphics.Rendering.Chart.Legend
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Grid
import Control.Monad
import Control.Lens hiding (at)
import Data.Colour
import Data.Colour.Names (white)
import Data.Default.Class

-- | A @MAxisFn@ is a function that generates an (optional) axis
--   given the points plotted against that axis.
type MAxisFn t = [t] -> Maybe (AxisData t)

-- | Type of axis that is used in 'Layout' and 'LayoutLR'.
--
--   To generate the actual axis type ('AxisData' and 'AxisT')
--   the '_laxis_generate' function is called and custom settings
--   are applied with '_laxis_override'. Note that the 'AxisVisibility'
--   values in 'Layout' and 'LayoutLR' override visibility related
--   settings of the axis.
data LayoutAxis x = LayoutAxis
  { _laxis_title_style :: FontStyle
    -- ^ Font style to use for the axis title.
  , _laxis_title       :: String
    -- ^ Title displayed for the axis.
  , _laxis_style       :: AxisStyle
    -- ^ Axis style applied.

  , _laxis_generate    :: AxisFn x
    -- ^ Function that generates the axis data, based upon the
    --   points plotted. The default value is 'autoAxis'.

  , _laxis_override    :: AxisData x -> AxisData x
    -- ^ Function that can be used to override the generated axis data.
    --   The default value is 'id'.

  , _laxis_reverse     :: Bool
    -- ^ True if left to right (bottom to top) is to show descending values.

  }

-- | Information on what is at a specifc location of a 'Layout' or 'LayoutLR'.
--   This is delivered by the 'PickFn' of a 'Renderable'.
data LayoutPick x y1 y2 = LayoutPick_Legend String           -- ^ A legend entry.
                        | LayoutPick_Title String            -- ^ The title.
                        | LayoutPick_XTopAxisTitle String    -- ^ The title of the top x axis.
                        | LayoutPick_XBottomAxisTitle String -- ^ The title of the bottom x axis.
                        | LayoutPick_YLeftAxisTitle String   -- ^ The title of the left y axis.
                        | LayoutPick_YRightAxisTitle String  -- ^ The title of the right y axis.
                        | LayoutPick_PlotArea x y1 y2        -- ^ The plot area at the given plot coordinates.
                        | LayoutPick_XTopAxis x              -- ^ The top x axis at the given plot coordinate.
                        | LayoutPick_XBottomAxis x           -- ^ The bottom x axis at the given plot coordinate.
                        | LayoutPick_YLeftAxis y1            -- ^ The left y axis at the given plot coordinate.
                        | LayoutPick_YRightAxis y2           -- ^ The right y axis at the given plot coordinate.
                          deriving (Show)

type LegendItem = (String,Rect -> BackendProgram ())

-- | A Layout value is a single plot area, with single x and y
--   axis. The title is at the top and the legend at the bottom. It's
--   parametrized by the types of values to be plotted on the x
--   and y axes.
data Layout x y = Layout
  { _layout_background      :: FillStyle
    -- ^ How to fill the background of everything.
  , _layout_plot_background :: Maybe FillStyle
    -- ^ How to fill the background of the plot,
    --   if different from the overall background.

  , _layout_title           :: String
    -- ^ Title to display above the chart.
  , _layout_title_style     :: FontStyle
    -- ^ Font style to use for the title.

  , _layout_x_axis                 :: LayoutAxis x
    -- ^ Rules to generate the x axis.
  , _layout_top_axis_visibility    :: AxisVisibility
    -- ^ Visibility options for the top axis.
  , _layout_bottom_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the bottom axis.

  , _layout_y_axis                :: LayoutAxis y
    -- ^ Rules to generate the y axis.
  , _layout_left_axis_visibility  :: AxisVisibility
    -- ^ Visibility options for the left axis.
  , _layout_right_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the right axis.

  , _layout_plots           :: [Plot x y]
    -- ^ The data sets to plot in the chart.
    --   They are plotted over each other.

  , _layout_legend          :: Maybe LegendStyle
    -- ^ How to style the legend.
  , _layout_margin          :: Double
    -- ^ The margin distance to use.
  , _layout_grid_last       :: Bool
    -- ^ If the grid shall be rendered
    --   beneath (@False@) or over (@True@) all plots.
  }

instance (Ord x, Ord y) => ToRenderable (Layout x y) where
  toRenderable = setPickFn nullPickFn . layoutToRenderable

-- | Render the given 'Layout'.
layoutToRenderable :: forall x y . (Ord x, Ord y) => Layout x y -> Renderable (LayoutPick x y y)
layoutToRenderable l = fillBackground (_layout_background l) $ gridToRenderable (layoutToGrid l)

layoutToGrid :: forall x y . (Ord x, Ord y) => Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutToGrid l = grid
  where
    lp :: Grid a -> a -> Grid a
    lp = case maybe LegendBelow _legend_position $ _layout_legend l of
              LegendAbove -> flip wideAbove
              LegendBelow -> aboveWide
              LegendRight -> besideTall
              LegendLeft  -> flip tallBeside

    title = titleToRenderable lm (_layout_title_style l) (_layout_title l)
    plotArea = addMarginsToGrid (lm,lm,lm,lm) (layoutPlotAreaToGrid l)
    legend = renderLegend l (getLegendItems l)
    grid = title `wideAbove` (plotArea `lp` legend)
    lm = _layout_margin l

getLayoutXVals :: Layout x y -> [x]
getLayoutXVals l = concatMap (fst . _plot_all_points) (_layout_plots l)

-- | Extract all 'LegendItem's from the plots of a 'Layout'.
getLegendItems :: Layout x y -> [LegendItem]
getLegendItems l = concat [ _plot_legend p | p <- _layout_plots l ]

-- | Render the given 'LegendItem's for a 'Layout'.
renderLegend :: Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)
renderLegend l legItems = gridToRenderable g
  where
    g      = besideN [ tval $ mkLegend (_layout_legend l) (_layout_margin l) legItems
                     , weights (1,1) $ tval emptyRenderable ]

-- | Render the plot area of a 'Layout'. This consists of the
--   actual plot area with all plots, the axis and their titles.
layoutPlotAreaToGrid :: forall x y. (Ord x, Ord y) =>
                        Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutPlotAreaToGrid l = buildGrid LayoutGridElements{
  lge_plots = mfill (_layout_plot_background l) $ plotsToRenderable l,
  lge_taxis = (tAxis,_laxis_title $ _layout_x_axis l, _laxis_title_style $ _layout_x_axis l),
  lge_baxis = (bAxis,_laxis_title $ _layout_x_axis l, _laxis_title_style $ _layout_x_axis l),
  lge_laxis = (lAxis,_laxis_title $ _layout_y_axis l, _laxis_title_style $ _layout_y_axis l),
  lge_raxis = (rAxis,"", def),
  lge_margin = _layout_margin l
  }
  where
    xvals = [ x | p <- _layout_plots l, x <- fst $ _plot_all_points p]
    yvals = [ y | p <- _layout_plots l, y <- snd $ _plot_all_points p]

    bAxis = mkAxis E_Bottom (overrideAxisVisibility l _layout_x_axis _layout_bottom_axis_visibility) xvals
    tAxis = mkAxis E_Top    (overrideAxisVisibility l _layout_x_axis _layout_top_axis_visibility   ) xvals
    lAxis = mkAxis E_Left   (overrideAxisVisibility l _layout_y_axis _layout_left_axis_visibility  ) yvals
    rAxis = mkAxis E_Right  (overrideAxisVisibility l _layout_y_axis _layout_right_axis_visibility ) yvals
    axes = (bAxis,lAxis,tAxis,rAxis)

    plotsToRenderable lxy = Renderable {
        minsize = return (0,0),
        render  = renderPlots lxy
    }

    -- | Render the plots of a 'Layout' to a plot area of given size.
    renderPlots :: Layout x y -> RectSize -> BackendProgram (PickFn (LayoutPick x y y))
    renderPlots lxy sz@(w,h) = do
        unless (_layout_grid_last lxy) (renderGrids sz axes)
        withClipRegion (Rect (Point 0 0) (Point w h)) $
          mapM_ rPlot (_layout_plots lxy)
        when (_layout_grid_last lxy) (renderGrids sz axes)
        return pickfn
      where
        rPlot = renderSinglePlot sz bAxis lAxis

        xr = (0, w)
        yr = (h, 0)

        pickfn :: PickFn (LayoutPick x y y)
        pickfn (Point x y) = do  -- Maybe monad
            xat <- mxat
            yat <- myat
            return (LayoutPick_PlotArea (mapx xat x) (mapy yat y) (mapy yat y))
          where
            mxat = case (bAxis,tAxis) of
                (Just at,_)       -> Just at
                (_,Just at)       -> Just at
                (Nothing,Nothing) -> Nothing
            myat = case (lAxis,rAxis) of
                (Just at,_)   -> Just at
                (_,Just at)   -> Just at
                (Nothing,Nothing)   -> Nothing
            mapx (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev xr)
            mapy (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev yr)

-- | Empty 'Layout' without title and plots. The background is white and
--   the grid is drawn beneath all plots. There will be a legend. The top
--   and right axis will not be visible.
instance (PlotValue x, PlotValue y) => Default (Layout x y) where
  def = Layout
    { _layout_background      = solidFillStyle $ opaque white
    , _layout_plot_background = Nothing

    , _layout_title           = ""
    , _layout_title_style     = def { _font_size   = 15
                                    , _font_weight = FontWeightBold }

    , _layout_x_axis                 = def
    , _layout_top_axis_visibility    = def { _axis_show_line   = False
                                           , _axis_show_ticks  = False
                                           , _axis_show_labels = False }
    , _layout_bottom_axis_visibility = def
    , _layout_y_axis                 = def
    , _layout_left_axis_visibility   = def
    , _layout_right_axis_visibility  = def { _axis_show_line   = False
                                           , _axis_show_ticks  = False
                                           , _axis_show_labels = False }

    , _layout_margin          = 10
    , _layout_plots           = []
    , _layout_legend          = Just def
    , _layout_grid_last       = False
    }

----------------------------------------------------------------------

-- | A LayoutLR value is a single plot area, with an x axis and
--   independent left and right y axes, with a title at the top;
--   legend at the bottom. It's parametrized by the types of values
--   to be plotted on the x and two y axes.
data LayoutLR x y1 y2 = LayoutLR
  { _layoutlr_background      :: FillStyle
    -- ^ How to fill the background of everything.
  , _layoutlr_plot_background :: Maybe FillStyle
    -- ^ How to fill the background of the plot,
    --   if different from the overall background.

  , _layoutlr_title           :: String
    -- ^ Title to display above the chart.
  , _layoutlr_title_style     :: FontStyle
    -- ^ Font style to use for the title.

  , _layoutlr_x_axis                 :: LayoutAxis x
    -- ^ Rules to generate the x axis.
  , _layoutlr_top_axis_visibility    :: AxisVisibility
    -- ^ Visibility options for the top axis.
  , _layoutlr_bottom_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the bottom axis.

  , _layoutlr_left_axis             :: LayoutAxis y1
    -- ^ Rules to generate the left y axis.
  , _layoutlr_left_axis_visibility  :: AxisVisibility
    -- ^ Visibility options for the left axis.
  , _layoutlr_right_axis            :: LayoutAxis y2
    -- ^ Rules to generate the right y axis.
  , _layoutlr_right_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the right axis.

  , _layoutlr_plots      :: [Either (Plot x y1) (Plot x y2)]
    -- ^ The data sets to plot in the chart.
    --   They are plotted over each other.
    --   The either type associates the plot with the
    --   left or right y axis.

  , _layoutlr_legend          :: Maybe LegendStyle
    -- ^ How to style the legend.
  , _layoutlr_margin          :: Double
    -- ^ The margin distance to use.
  , _layoutlr_grid_last       :: Bool
    -- ^ If the grid shall be rendered
    --   beneath (@False@) or over (@True@) all plots.
  }

instance (Ord x, Ord yl, Ord yr) => ToRenderable (LayoutLR x yl yr) where
  toRenderable = setPickFn nullPickFn . layoutLRToRenderable

-- | Render the given 'LayoutLR'.
layoutLRToRenderable :: forall x yl yr . (Ord x, Ord yl, Ord yr)
                     => LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
layoutLRToRenderable l = fillBackground (_layoutlr_background l)
                       $ gridToRenderable (layoutLRToGrid l)

layoutLRToGrid :: forall x yl yr . (Ord x, Ord yl, Ord yr)
                     => LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRToGrid l = grid
  where
    grid = titleToRenderable lm (_layoutlr_title_style l) (_layoutlr_title l)
           `wideAbove`
           addMarginsToGrid (lm,lm,lm,lm) (layoutLRPlotAreaToGrid l)
           `aboveWide`
           renderLegendLR l (getLegendItemsLR l)
    lm = _layoutlr_margin l

getLayoutLRXVals :: LayoutLR x yl yr -> [x]
getLayoutLRXVals l = concatMap deEither $ _layoutlr_plots l
  where
    deEither :: Either (Plot x yl) (Plot x yr) -> [x]
    deEither (Left x)  = fst $ _plot_all_points x
    deEither (Right x) = fst $ _plot_all_points x

-- | Extract all 'LegendItem's from the plots of a 'LayoutLR'.
--   Left and right plot legend items are still separated.
getLegendItemsLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem])
getLegendItemsLR l = (
    concat [ _plot_legend p | (Left p ) <- _layoutlr_plots l ],
    concat [ _plot_legend p | (Right p) <- _layoutlr_plots l ]
    )

-- | Render the given 'LegendItem's for a 'LayoutLR'.
renderLegendLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem]) -> Renderable (LayoutPick x yl yr)
renderLegendLR l (lefts,rights) = gridToRenderable g
  where
    g      = besideN [ tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) lefts
                     , weights (1,1) $ tval emptyRenderable
                     , tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) rights ]
    -- lm     = _layoutlr_margin l

layoutLRPlotAreaToGrid :: forall x yl yr. (Ord x, Ord yl, Ord yr)
                       => LayoutLR x yl yr
                       -> Grid (Renderable (LayoutPick x yl yr))
layoutLRPlotAreaToGrid l = buildGrid LayoutGridElements{
  lge_plots = mfill (_layoutlr_plot_background l) $ plotsToRenderable l,
  lge_taxis = (tAxis,_laxis_title $ _layoutlr_x_axis l, _laxis_title_style $ _layoutlr_x_axis l),
  lge_baxis = (bAxis,_laxis_title $ _layoutlr_x_axis l, _laxis_title_style $ _layoutlr_x_axis l),
  lge_laxis = (lAxis,_laxis_title $ _layoutlr_left_axis l, _laxis_title_style $ _layoutlr_left_axis l),
  lge_raxis = (rAxis,_laxis_title $ _layoutlr_right_axis l, _laxis_title_style $ _layoutlr_right_axis l),
  lge_margin = _layoutlr_margin l
  }
  where
    xvals =  [ x | (Left p)  <- _layoutlr_plots l, x <- fst $ _plot_all_points p]
          ++ [ x | (Right p) <- _layoutlr_plots l, x <- fst $ _plot_all_points p]
    yvalsL = [ y | (Left p)  <- _layoutlr_plots l, y <- snd $ _plot_all_points p]
    yvalsR = [ y | (Right p) <- _layoutlr_plots l, y <- snd $ _plot_all_points p]

    bAxis = mkAxis E_Bottom (overrideAxisVisibility l _layoutlr_x_axis _layoutlr_bottom_axis_visibility) xvals
    tAxis = mkAxis E_Top    (overrideAxisVisibility l _layoutlr_x_axis _layoutlr_top_axis_visibility   ) xvals
    lAxis = mkAxis E_Left   (overrideAxisVisibility l _layoutlr_left_axis  _layoutlr_left_axis_visibility ) yvalsL
    rAxis = mkAxis E_Right  (overrideAxisVisibility l _layoutlr_right_axis _layoutlr_right_axis_visibility) yvalsR
    axes = (bAxis,lAxis,tAxis,rAxis)

    plotsToRenderable llr = Renderable {
        minsize = return (0,0),
        render  = renderPlots llr
    }

    renderPlots :: LayoutLR x yl yr -> RectSize -> BackendProgram (PickFn (LayoutPick x yl yr))
    renderPlots llr sz@(w,h) = do
        unless (_layoutlr_grid_last llr) (renderGrids sz axes)
        withClipRegion (Rect (Point 0 0) (Point w h)) $
          mapM_ rPlot (_layoutlr_plots llr)
        when (_layoutlr_grid_last llr) (renderGrids sz axes)
        return pickfn
      where
        rPlot (Left  p) = renderSinglePlot sz bAxis lAxis p
        rPlot (Right p) = renderSinglePlot sz bAxis rAxis p

        xr = (0, w)
        yr = (h, 0)

        pickfn (Point x y) = do  -- Maybe monad
            xat <- mxat
            (yatL,yatR) <- myats
            return (LayoutPick_PlotArea (mapx xat x) (mapy yatL y) (mapy yatR y))
          where
            mxat = case (bAxis,tAxis) of
                (Just at,_)       -> Just at
                (_,Just at)       -> Just at
                (Nothing,Nothing) -> Nothing
            myats = case (lAxis,rAxis) of
                (Just at1,Just at2) -> Just (at1,at2)
                (_,_)   -> Nothing
            mapx (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev xr)
            mapy (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev yr)

----------------------------------------------------------------------

-- | A layout with its y type hidden, so that it can be stacked
--   with other layouts with differing y axis, but the same x axis.
--   See 'StackedLayouts'.
data StackedLayout x = forall y     . (Ord y)          => StackedLayout (Layout x y)
                       -- ^ A 'Layout' to stack.
                     | forall yl yr . (Ord yl, Ord yr) => StackedLayoutLR (LayoutLR x yl yr)
                       -- ^ A 'LayoutLR' to stack.

-- | A container for a set of vertically 'StackedLayout's.
--   The x axis of the different layouts will be aligned.
data StackedLayouts x = StackedLayouts
  { _slayouts_layouts :: [StackedLayout x]
    -- ^ The stacked layouts from top (first element) to bottom (last element).
  , _slayouts_compress_legend :: Bool
    -- ^ If the different legends shall be combined in one legend at the bottom.
  }

-- | A empty 'StackedLayout' with compressions applied.
instance Default (StackedLayouts x) where
  def = StackedLayouts [] True



instance Ord x => ToRenderable (StackedLayouts x) where
  toRenderable = renderStackedLayouts


-- | Render several layouts with the same x-axis type and range,
--   vertically stacked so that their origins and x-values are aligned.
--
--   The legends from all the charts may be optionally combined, and shown
--   once on the bottom chart. See 'StackedLayouts' for further information.
renderStackedLayouts :: forall x. (Ord x) => StackedLayouts x -> Renderable ()
renderStackedLayouts (StackedLayouts{_slayouts_layouts=[]}) = emptyRenderable
renderStackedLayouts slp@(StackedLayouts{_slayouts_layouts=sls@(sl1:_)}) = gridToRenderable g
  where
    g = fullOverlayUnder (fillBackground bg emptyRenderable)
      $ foldr (above.mkGrid) nullt (zip sls [0,1..])

    mkGrid :: (StackedLayout x, Int) -> Grid (Renderable ())
    mkGrid (sl, i)
        = titleR
          `wideAbove`
          addMarginsToGrid (lm,lm,lm,lm) (mkPlotArea usedAxis)
          `aboveWide`
          (if showLegend then legendR else emptyRenderable)
      where
        titleR = case sl of
                   StackedLayout l -> noPickFn $ titleToRenderable (_layout_margin l) (_layout_title_style l) (_layout_title l)
                   StackedLayoutLR l -> noPickFn $ titleToRenderable (_layoutlr_margin l) (_layoutlr_title_style l) (_layoutlr_title l)
        legendR = case sl of
                    StackedLayout l -> noPickFn $ renderLegend l $ fst legenditems
                    StackedLayoutLR l -> noPickFn $ renderLegendLR l legenditems

        legenditems = case (_slayouts_compress_legend slp,isBottomPlot) of
            (False,_) -> case sl of
                           StackedLayout l -> (getLegendItems l, [])
                           StackedLayoutLR l -> getLegendItemsLR l
            (True,True) -> allLegendItems
            (True,False) -> ([],[])

        mkPlotArea :: LayoutAxis x -> Grid (Renderable ())
        mkPlotArea axis = case sl of
          StackedLayout l -> fmap noPickFn
                           $ layoutPlotAreaToGrid
                           $ l { _layout_x_axis = axis }
          StackedLayoutLR l -> fmap noPickFn
                             $ layoutLRPlotAreaToGrid
                             $ l { _layoutlr_x_axis = axis }

        showLegend = not (null (fst legenditems)) || not (null (snd legenditems))

        isBottomPlot = i == length sls - 1

        lm = case sl of
          StackedLayout l -> _layout_margin l
          StackedLayoutLR l -> _layoutlr_margin l

        xAxis :: LayoutAxis x
        xAxis = case sl of
          StackedLayout l -> _layout_x_axis l
          StackedLayoutLR l -> _layoutlr_x_axis l

        usedAxis :: LayoutAxis x
        usedAxis = xAxis
          { _laxis_generate = const (_laxis_generate xAxis all_xvals) }

    bg = case sl1 of
           StackedLayout l -> _layout_background l
           StackedLayoutLR l -> _layoutlr_background l

    getXVals :: StackedLayout x -> [x]
    getXVals (StackedLayout l) = getLayoutXVals l
    getXVals (StackedLayoutLR l) = getLayoutLRXVals l

    all_xvals = concatMap getXVals sls

    allLegendItems = (concatMap (fst.legendItems) sls, concatMap (snd.legendItems) sls)

    legendItems :: StackedLayout x -> ([LegendItem], [LegendItem])
    legendItems (StackedLayout l)   = (getLegendItems l, [])
    legendItems (StackedLayoutLR l) = getLegendItemsLR l

    noPickFn :: Renderable a -> Renderable ()
    noPickFn = mapPickFn (const ())

----------------------------------------------------------------------

addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a)
                 -> Grid (Renderable a)
addMarginsToGrid (t,b,l,r) g = aboveN [
     besideN [er, ts, er],
     besideN [ls, g,  rs],
     besideN [er, bs, er]
  ]
  where
    er = empty
    ts = tval $ spacer (0,t)
    ls = tval $ spacer (l,0)
    bs = tval $ spacer (0,b)
    rs = tval $ spacer (r,0)

titleToRenderable :: Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable _  _  "" = emptyRenderable
titleToRenderable lm fs s = addMargins (lm/2,0,0,0) (mapPickFn LayoutPick_Title title)
  where
    title = label fs HTA_Centre VTA_Centre s

mkLegend :: Maybe LegendStyle -> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend mls lm vals = case mls of
    Nothing -> emptyRenderable
    Just ls ->  case filter ((/="").fst) vals of
        []  -> emptyRenderable ;
        lvs -> addMargins (0,lm,lm,lm) $
                   mapPickFn LayoutPick_Legend $ legendToRenderable (Legend ls lvs)


data LayoutGridElements x yl yr = LayoutGridElements {
  lge_plots :: Renderable (LayoutPick x yl yr),

  lge_taxis :: (Maybe (AxisT x),String,FontStyle),
  lge_baxis :: (Maybe (AxisT x),String,FontStyle),
  lge_laxis :: (Maybe (AxisT yl),String,FontStyle),
  lge_raxis :: (Maybe (AxisT yr),String,FontStyle),

  lge_margin :: Double
}

buildGrid :: (Ord x, Ord yl, Ord yr) => LayoutGridElements x yl yr -> Grid (Renderable (LayoutPick x yl yr))
buildGrid lge = layer2 `overlay` layer1
  where
    layer1 = aboveN
         [ besideN [er,     er,  er,    er   ]
         , besideN [er,     er,  er,    weights (1,1) plots ]
         ]

    layer2 = aboveN
         [ besideN [er,     er,  tl,    taxis,  tr,    er,  er       ]
         , besideN [ltitle, lam, laxis, er,     raxis, ram, rtitle   ]
         , besideN [er,     er,  bl,    baxis,  br,    er,  er       ]
         , besideN [er,     er,  er,    btitle, er,    er,  er       ]
         ]

    er = tval emptyRenderable

    plots = tval $ lge_plots lge

    (tdata,_,_)         = lge_taxis lge
    (bdata,blbl,bstyle) = lge_baxis lge
    (ldata,llbl,lstyle) = lge_laxis lge
    (rdata,rlbl,rstyle) = lge_raxis lge

    -- (ttitle,_) = mktitle HTA_Centre VTA_Bottom   0 tlbl tstyle LayoutPick_XTopAxisTitle
    (btitle,_) = mktitle HTA_Centre VTA_Top      0 blbl bstyle LayoutPick_XBottomAxisTitle
    (ltitle,lam) = mktitle HTA_Right  VTA_Centre 270 llbl lstyle LayoutPick_YLeftAxisTitle
    (rtitle,ram) = mktitle HTA_Left   VTA_Centre 270 rlbl rstyle LayoutPick_YRightAxisTitle

    baxis = tval $ maybe emptyRenderable
                         (mapPickFn LayoutPick_XBottomAxis . axisToRenderable) bdata
    taxis = tval $ maybe emptyRenderable
                         (mapPickFn LayoutPick_XTopAxis . axisToRenderable) tdata
    laxis = tval $ maybe emptyRenderable
                         (mapPickFn LayoutPick_YLeftAxis . axisToRenderable) ldata
    raxis = tval $ maybe emptyRenderable
                         (mapPickFn LayoutPick_YRightAxis . axisToRenderable) rdata

    tl = tval $ axesSpacer fst tdata fst ldata
    bl = tval $ axesSpacer fst bdata snd ldata
    tr = tval $ axesSpacer snd tdata fst rdata
    br = tval $ axesSpacer snd bdata snd rdata

    mktitle :: HTextAnchor -> VTextAnchor
            -> Double
            -> String -> FontStyle
            -> (String -> LayoutPick x yl yr)
            -> ( Grid (Renderable (LayoutPick x yl yr))
               , Grid (Renderable (LayoutPick x yl yr)) )
    mktitle ha va rot lbl style pf = if lbl == "" then (er,er) else (labelG,gapG)
      where
        labelG = tval $ mapPickFn pf $ rlabel style ha va rot lbl
        gapG = tval $ spacer (lge_margin lge,0)

-- | Render the grids of the given axis to a plot area of given size.
renderGrids :: RectSize -> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x), Maybe (AxisT yr)) -> BackendProgram ()
renderGrids sz (bAxis, lAxis, tAxis, rAxis) = do
  maybeM () (renderAxisGrid sz) tAxis
  maybeM () (renderAxisGrid sz) bAxis
  maybeM () (renderAxisGrid sz) lAxis
  maybeM () (renderAxisGrid sz) rAxis

-- | Swap the contents of the pair depending on the flag.
optPairReverse :: Bool -> (a,a) -> (a,a)
optPairReverse rev (a,b) = if rev then (b,a) else (a,b)

-- | Render a single set of plot data onto a plot area of given size using
--   the given x and y axis.
renderSinglePlot :: RectSize -> Maybe (AxisT x) -> Maybe (AxisT y) -> Plot x y -> BackendProgram ()
renderSinglePlot (w, h) (Just (AxisT _ _ xrev xaxis)) (Just (AxisT _ _ yrev yaxis)) p =
  let xr = optPairReverse xrev (0, w)
      yr = optPairReverse yrev (h, 0)
      -- yrange = if yrev then (0, h) else (h, 0)
      pmfn (x,y) = Point (mapv xr (_axis_viewport xaxis xr) x)
                         (mapv yr (_axis_viewport yaxis yr) y)
      mapv lims _ LMin       = fst lims
      mapv lims _ LMax       = snd lims
      mapv _    f (LValue v) = f v
  in _plot_render p pmfn
renderSinglePlot _ _ _ _ = return ()

axesSpacer :: (Ord x, Ord y)
           => ((Double, Double) -> Double) -> Maybe (AxisT x)
           -> ((Double, Double) -> Double) -> Maybe (AxisT y)
           -> Renderable a
axesSpacer f1 a1 f2 a2 = embedRenderable $ do
    oh1 <- maybeM (0,0) axisOverhang a1
    oh2 <- maybeM (0,0) axisOverhang a2
    return (spacer (f1 oh1, f2 oh2))

-- | Construct a axis for the given edge using the attributes
--   from a 'LayoutAxis' the given values.
mkAxis :: RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis edge laxis vals = if axisVisible
                           then Just $ AxisT edge style rev adata
                           else Nothing
  where
    style = _laxis_style laxis
    rev   = _laxis_reverse laxis
    adata = _laxis_override laxis (_laxis_generate laxis vals)
    vis   = _axis_visibility adata
    axisVisible = _axis_show_labels vis || _axis_show_line vis || _axis_show_ticks vis

-- | Override the visibility of a selected axis with the selected 'AxisVisibility'.
overrideAxisVisibility :: layout
                       -> (layout -> LayoutAxis z)
                       -> (layout -> AxisVisibility)
                       -> LayoutAxis z
overrideAxisVisibility ly selAxis selVis =
  let vis = selVis ly
  in (selAxis ly) { _laxis_override = (\ad -> ad { _axis_visibility = vis })
                                    . _laxis_override (selAxis ly)
                  }

mfill :: Maybe FillStyle -> Renderable a -> Renderable a
mfill Nothing   = id
mfill (Just fs) = fillBackground fs

-- | Empty 'LayoutLR' without title and plots. The background is white and
--   the grid is drawn beneath all plots. There will be a legend. The top
--   axis will not be visible.
instance (PlotValue x, PlotValue y1, PlotValue y2) => Default (LayoutLR x y1 y2) where
  def = LayoutLR
    { _layoutlr_background      = solidFillStyle $ opaque white
    , _layoutlr_plot_background = Nothing

    , _layoutlr_title           = ""
    , _layoutlr_title_style     = def { _font_size   = 15
                                      , _font_weight = FontWeightBold }

    , _layoutlr_x_axis                 = def
    , _layoutlr_top_axis_visibility    = def { _axis_show_line   = False
                                             , _axis_show_ticks  = False
                                             , _axis_show_labels = False }
    , _layoutlr_bottom_axis_visibility = def

    , _layoutlr_left_axis           = def
    , _layoutlr_left_axis_visibility  = def
    , _layoutlr_right_axis          = def
    , _layoutlr_right_axis_visibility = def

    , _layoutlr_plots      = []

    , _layoutlr_legend          = Just def
    , _layoutlr_margin          = 10
    , _layoutlr_grid_last       = False
    }

instance PlotValue t => Default (LayoutAxis t) where
  def = LayoutAxis
    { _laxis_title_style = def { _font_size=10 }
    , _laxis_title       = ""
    , _laxis_style       = def
    , _laxis_generate    = autoAxis
    , _laxis_override    = id
    , _laxis_reverse     = False
    }

----------------------------------------------------------------------
-- Template haskell to derive an instance of Data.Accessor.Accessor
-- for each field.
$( makeLenses ''Layout )
$( makeLenses ''LayoutLR )
$( makeLenses ''LayoutAxis )
$( makeLenses ''StackedLayouts )

-- | Setter to update all axis styles on a `Layout`
layout_axes_styles :: Setter' (Layout x y) AxisStyle
layout_axes_styles = sets $ \af ->
    (layout_x_axis . laxis_style %~ af) .
    (layout_y_axis . laxis_style %~ af)

-- | Setter to update all the axes title styles on a `Layout`
layout_axes_title_styles :: Setter' (Layout x y) FontStyle
layout_axes_title_styles = sets $ \af ->
    (layout_x_axis . laxis_title_style %~ af) .
    (layout_y_axis . laxis_title_style %~ af)

-- | Setter to update all the font styles on a `Layout`
layout_all_font_styles :: Setter' (Layout x y) FontStyle
layout_all_font_styles = sets $ \af ->
    (layout_axes_title_styles %~ af) .
    (layout_x_axis . laxis_style . axis_label_style %~ af) .
    (layout_y_axis . laxis_style . axis_label_style %~ af) .
    (layout_legend . _Just . legend_label_style %~ af) .
    (layout_title_style %~ af)

-- | Setter to update the foreground color of core chart elements on a `Layout`
layout_foreground ::  Setter' (Layout x y) (AlphaColour Double)
layout_foreground = sets $ \af ->
    (layout_all_font_styles . font_color %~ af) .
    (layout_axes_styles . axis_line_style . line_color %~ af)

-- | Setter to update all axis styles on a `LayoutLR`
layoutlr_axes_styles :: Setter' (LayoutLR x y1 y2) AxisStyle
layoutlr_axes_styles = sets $ \af ->
    (layoutlr_x_axis . laxis_style %~ af) .
    (layoutlr_left_axis . laxis_style %~ af) .
    (layoutlr_right_axis . laxis_style %~ af)

-- | Setter to update all the axes title styles on a `LayoutLR`
layoutlr_axes_title_styles :: Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_axes_title_styles = sets $ \af ->
    (layoutlr_x_axis . laxis_title_style %~ af) .
    (layoutlr_left_axis . laxis_title_style %~ af) .
    (layoutlr_right_axis . laxis_title_style %~ af)

-- | Setter to update all the font styles on a `LayoutLR`
layoutlr_all_font_styles :: Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_all_font_styles = sets $ \af ->
    (layoutlr_axes_title_styles %~ af) .
    (layoutlr_x_axis . laxis_style . axis_label_style %~ af) .
    (layoutlr_left_axis . laxis_style . axis_label_style %~ af) .
    (layoutlr_right_axis . laxis_style . axis_label_style %~ af) .
    (layoutlr_legend . _Just . legend_label_style %~ af) .
    (layoutlr_title_style %~ af)

-- | Setter to update the foreground color of core chart elements on a `LayoutLR`
layoutlr_foreground ::  Setter' (LayoutLR x y1 y2) (AlphaColour Double)
layoutlr_foreground = sets $ \af ->
    (layoutlr_all_font_styles . font_color %~ af) .
    (layoutlr_axes_styles . axis_line_style . line_color %~ af)