{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Drawing.Chart where

import GHC.Generics (Generic)

#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH
#endif
import Control.DeepSeq (NFData)
import Data.Default
import Data.Maybe (catMaybes, listToMaybe, maybeToList)
import Data.Text (Text)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.Drawing.Common
import Codec.Xlsx.Writer.Internal

-- | Main Chart holder, combines
-- TODO: title, autoTitleDeleted, pivotFmts
--  view3D, floor, sideWall, backWall, showDLblsOverMax, extLst
data ChartSpace = ChartSpace
  { ChartSpace -> Maybe ChartTitle
_chspTitle :: Maybe ChartTitle
  , ChartSpace -> [Chart]
_chspCharts :: [Chart]
  , ChartSpace -> Maybe Legend
_chspLegend :: Maybe Legend
  , ChartSpace -> Maybe Bool
_chspPlotVisOnly :: Maybe Bool
  , ChartSpace -> Maybe DispBlanksAs
_chspDispBlanksAs :: Maybe DispBlanksAs
  } deriving (ChartSpace -> ChartSpace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartSpace -> ChartSpace -> Bool
$c/= :: ChartSpace -> ChartSpace -> Bool
== :: ChartSpace -> ChartSpace -> Bool
$c== :: ChartSpace -> ChartSpace -> Bool
Eq, Int -> ChartSpace -> ShowS
[ChartSpace] -> ShowS
ChartSpace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartSpace] -> ShowS
$cshowList :: [ChartSpace] -> ShowS
show :: ChartSpace -> String
$cshow :: ChartSpace -> String
showsPrec :: Int -> ChartSpace -> ShowS
$cshowsPrec :: Int -> ChartSpace -> ShowS
Show, forall x. Rep ChartSpace x -> ChartSpace
forall x. ChartSpace -> Rep ChartSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartSpace x -> ChartSpace
$cfrom :: forall x. ChartSpace -> Rep ChartSpace x
Generic)
instance NFData ChartSpace

-- | Chart title
--
-- TODO: layout, overlay, spPr, txPr, extLst
newtype ChartTitle =
  ChartTitle (Maybe TextBody)
  deriving (ChartTitle -> ChartTitle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartTitle -> ChartTitle -> Bool
$c/= :: ChartTitle -> ChartTitle -> Bool
== :: ChartTitle -> ChartTitle -> Bool
$c== :: ChartTitle -> ChartTitle -> Bool
Eq, Int -> ChartTitle -> ShowS
[ChartTitle] -> ShowS
ChartTitle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartTitle] -> ShowS
$cshowList :: [ChartTitle] -> ShowS
show :: ChartTitle -> String
$cshow :: ChartTitle -> String
showsPrec :: Int -> ChartTitle -> ShowS
$cshowsPrec :: Int -> ChartTitle -> ShowS
Show, forall x. Rep ChartTitle x -> ChartTitle
forall x. ChartTitle -> Rep ChartTitle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartTitle x -> ChartTitle
$cfrom :: forall x. ChartTitle -> Rep ChartTitle x
Generic)
instance NFData ChartTitle

-- | This simple type specifies the possible ways to display blanks.
--
-- See 21.2.3.10 "ST_DispBlanksAs (Display Blanks As)" (p. 3444)
data DispBlanksAs
  = DispBlanksAsGap
    -- ^ Specifies that blank values shall be left as a gap.
  | DispBlanksAsSpan
    -- ^ Specifies that blank values shall be spanned with a line.
  | DispBlanksAsZero
    -- ^ Specifies that blank values shall be treated as zero.
  deriving (DispBlanksAs -> DispBlanksAs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispBlanksAs -> DispBlanksAs -> Bool
$c/= :: DispBlanksAs -> DispBlanksAs -> Bool
== :: DispBlanksAs -> DispBlanksAs -> Bool
$c== :: DispBlanksAs -> DispBlanksAs -> Bool
Eq, Int -> DispBlanksAs -> ShowS
[DispBlanksAs] -> ShowS
DispBlanksAs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispBlanksAs] -> ShowS
$cshowList :: [DispBlanksAs] -> ShowS
show :: DispBlanksAs -> String
$cshow :: DispBlanksAs -> String
showsPrec :: Int -> DispBlanksAs -> ShowS
$cshowsPrec :: Int -> DispBlanksAs -> ShowS
Show, forall x. Rep DispBlanksAs x -> DispBlanksAs
forall x. DispBlanksAs -> Rep DispBlanksAs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DispBlanksAs x -> DispBlanksAs
$cfrom :: forall x. DispBlanksAs -> Rep DispBlanksAs x
Generic)
instance NFData DispBlanksAs

-- TODO: legendEntry, layout, overlay, spPr, txPr, extLst
data Legend = Legend
    { Legend -> Maybe LegendPos
_legendPos     :: Maybe LegendPos
    , Legend -> Maybe Bool
_legendOverlay :: Maybe Bool
    } deriving (Legend -> Legend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Legend -> Legend -> Bool
$c/= :: Legend -> Legend -> Bool
== :: Legend -> Legend -> Bool
$c== :: Legend -> Legend -> Bool
Eq, Int -> Legend -> ShowS
[Legend] -> ShowS
Legend -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Legend] -> ShowS
$cshowList :: [Legend] -> ShowS
show :: Legend -> String
$cshow :: Legend -> String
showsPrec :: Int -> Legend -> ShowS
$cshowsPrec :: Int -> Legend -> ShowS
Show, forall x. Rep Legend x -> Legend
forall x. Legend -> Rep Legend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Legend x -> Legend
$cfrom :: forall x. Legend -> Rep Legend x
Generic)
instance NFData Legend

-- See 21.2.3.24 "ST_LegendPos (Legend Position)" (p. 3449)
data LegendPos
  = LegendBottom
    -- ^ b (Bottom) Specifies that the legend shall be drawn at the
    -- bottom of the chart.
  | LegendLeft
    -- ^ l (Left) Specifies that the legend shall be drawn at the left
    -- of the chart.
  | LegendRight
    -- ^ r (Right) Specifies that the legend shall be drawn at the
    -- right of the chart.
  | LegendTop
    -- ^ t (Top) Specifies that the legend shall be drawn at the top
    -- of the chart.
  | LegendTopRight
    -- ^ tr (Top Right) Specifies that the legend shall be drawn at
    -- the top right of the chart.
  deriving (LegendPos -> LegendPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegendPos -> LegendPos -> Bool
$c/= :: LegendPos -> LegendPos -> Bool
== :: LegendPos -> LegendPos -> Bool
$c== :: LegendPos -> LegendPos -> Bool
Eq, Int -> LegendPos -> ShowS
[LegendPos] -> ShowS
LegendPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendPos] -> ShowS
$cshowList :: [LegendPos] -> ShowS
show :: LegendPos -> String
$cshow :: LegendPos -> String
showsPrec :: Int -> LegendPos -> ShowS
$cshowsPrec :: Int -> LegendPos -> ShowS
Show, forall x. Rep LegendPos x -> LegendPos
forall x. LegendPos -> Rep LegendPos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendPos x -> LegendPos
$cfrom :: forall x. LegendPos -> Rep LegendPos x
Generic)
instance NFData LegendPos

-- | Specific Chart
-- TODO:
--   area3DChart, line3DChart, stockChart, radarChart,
--   pie3DChart, doughnutChart, bar3DChart, ofPieChart,
--   surfaceChart, surface3DChart, bubbleChart
data Chart
  = LineChart { Chart -> ChartGrouping
_lnchGrouping :: ChartGrouping
              , Chart -> [LineSeries]
_lnchSeries :: [LineSeries]
              , Chart -> Maybe Bool
_lnchMarker :: Maybe Bool
                -- ^ specifies that the marker shall be shown
              , Chart -> Maybe Bool
_lnchSmooth :: Maybe Bool
                -- ^ specifies the line connecting the points on the chart shall be
                -- smoothed using Catmull-Rom splines
              }
  | AreaChart { Chart -> Maybe ChartGrouping
_archGrouping :: Maybe ChartGrouping
              , Chart -> [AreaSeries]
_archSeries :: [AreaSeries]
              }
  | BarChart { Chart -> BarDirection
_brchDirection :: BarDirection
             , Chart -> Maybe BarChartGrouping
_brchGrouping :: Maybe BarChartGrouping
             , Chart -> [BarSeries]
_brchSeries :: [BarSeries]
             }
  | PieChart { Chart -> [PieSeries]
_pichSeries :: [PieSeries]
             }
  | ScatterChart { Chart -> ScatterStyle
_scchStyle :: ScatterStyle
                 , Chart -> [ScatterSeries]
_scchSeries :: [ScatterSeries]
                 }
  deriving (Chart -> Chart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chart -> Chart -> Bool
$c/= :: Chart -> Chart -> Bool
== :: Chart -> Chart -> Bool
$c== :: Chart -> Chart -> Bool
Eq, Int -> Chart -> ShowS
[Chart] -> ShowS
Chart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chart] -> ShowS
$cshowList :: [Chart] -> ShowS
show :: Chart -> String
$cshow :: Chart -> String
showsPrec :: Int -> Chart -> ShowS
$cshowsPrec :: Int -> Chart -> ShowS
Show, forall x. Rep Chart x -> Chart
forall x. Chart -> Rep Chart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Chart x -> Chart
$cfrom :: forall x. Chart -> Rep Chart x
Generic)
instance NFData Chart

-- | Possible groupings for a chart
--
-- See 21.2.3.17 "ST_Grouping (Grouping)" (p. 3446)
data ChartGrouping
  = PercentStackedGrouping
    -- ^ (100% Stacked) Specifies that the chart series are drawn next to each
    -- other along the value axis and scaled to total 100%.
  | StackedGrouping
    -- ^ (Stacked) Specifies that the chart series are drawn next to each
    -- other on the value axis.
  | StandardGrouping
    -- ^(Standard) Specifies that the chart series are drawn on the value
    -- axis.
  deriving (ChartGrouping -> ChartGrouping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartGrouping -> ChartGrouping -> Bool
$c/= :: ChartGrouping -> ChartGrouping -> Bool
== :: ChartGrouping -> ChartGrouping -> Bool
$c== :: ChartGrouping -> ChartGrouping -> Bool
Eq, Int -> ChartGrouping -> ShowS
[ChartGrouping] -> ShowS
ChartGrouping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartGrouping] -> ShowS
$cshowList :: [ChartGrouping] -> ShowS
show :: ChartGrouping -> String
$cshow :: ChartGrouping -> String
showsPrec :: Int -> ChartGrouping -> ShowS
$cshowsPrec :: Int -> ChartGrouping -> ShowS
Show, forall x. Rep ChartGrouping x -> ChartGrouping
forall x. ChartGrouping -> Rep ChartGrouping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartGrouping x -> ChartGrouping
$cfrom :: forall x. ChartGrouping -> Rep ChartGrouping x
Generic)
instance NFData ChartGrouping

-- | Possible groupings for a bar chart
--
-- See 21.2.3.4 "ST_BarGrouping (Bar Grouping)" (p. 3441)
data BarChartGrouping
  = BarClusteredGrouping
    -- ^ Specifies that the chart series are drawn next to each other
    -- along the category axis.
  | BarPercentStackedGrouping
    -- ^ (100% Stacked) Specifies that the chart series are drawn next to each
    -- other along the value axis and scaled to total 100%.
  | BarStackedGrouping
    -- ^ (Stacked) Specifies that the chart series are drawn next to each
    -- other on the value axis.
  | BarStandardGrouping
    -- ^(Standard) Specifies that the chart series are drawn on the value
    -- axis.
  deriving (BarChartGrouping -> BarChartGrouping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarChartGrouping -> BarChartGrouping -> Bool
$c/= :: BarChartGrouping -> BarChartGrouping -> Bool
== :: BarChartGrouping -> BarChartGrouping -> Bool
$c== :: BarChartGrouping -> BarChartGrouping -> Bool
Eq, Int -> BarChartGrouping -> ShowS
[BarChartGrouping] -> ShowS
BarChartGrouping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarChartGrouping] -> ShowS
$cshowList :: [BarChartGrouping] -> ShowS
show :: BarChartGrouping -> String
$cshow :: BarChartGrouping -> String
showsPrec :: Int -> BarChartGrouping -> ShowS
$cshowsPrec :: Int -> BarChartGrouping -> ShowS
Show, forall x. Rep BarChartGrouping x -> BarChartGrouping
forall x. BarChartGrouping -> Rep BarChartGrouping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarChartGrouping x -> BarChartGrouping
$cfrom :: forall x. BarChartGrouping -> Rep BarChartGrouping x
Generic)
instance NFData BarChartGrouping

-- | Possible directions for a bar chart
--
-- See 21.2.3.3 "ST_BarDir (Bar Direction)" (p. 3441)
data BarDirection
  = DirectionBar
  | DirectionColumn
  deriving (BarDirection -> BarDirection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarDirection -> BarDirection -> Bool
$c/= :: BarDirection -> BarDirection -> Bool
== :: BarDirection -> BarDirection -> Bool
$c== :: BarDirection -> BarDirection -> Bool
Eq, Int -> BarDirection -> ShowS
[BarDirection] -> ShowS
BarDirection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarDirection] -> ShowS
$cshowList :: [BarDirection] -> ShowS
show :: BarDirection -> String
$cshow :: BarDirection -> String
showsPrec :: Int -> BarDirection -> ShowS
$cshowsPrec :: Int -> BarDirection -> ShowS
Show, forall x. Rep BarDirection x -> BarDirection
forall x. BarDirection -> Rep BarDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarDirection x -> BarDirection
$cfrom :: forall x. BarDirection -> Rep BarDirection x
Generic)
instance NFData BarDirection

-- | Possible styles of scatter chart
--
-- /Note:/ It appears that even for 'ScatterMarker' style Exel draws a
-- line between chart points if otline fill for '_scserShared' isn't
-- set to so it's not quite clear how could Excel use this property
--
-- See 21.2.3.40 "ST_ScatterStyle (Scatter Style)" (p. 3455)
data ScatterStyle
  = ScatterNone
  | ScatterLine
  | ScatterLineMarker
  | ScatterMarker
  | ScatterSmooth
  | ScatterSmoothMarker
  deriving (ScatterStyle -> ScatterStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScatterStyle -> ScatterStyle -> Bool
$c/= :: ScatterStyle -> ScatterStyle -> Bool
== :: ScatterStyle -> ScatterStyle -> Bool
$c== :: ScatterStyle -> ScatterStyle -> Bool
Eq, Int -> ScatterStyle -> ShowS
[ScatterStyle] -> ShowS
ScatterStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScatterStyle] -> ShowS
$cshowList :: [ScatterStyle] -> ShowS
show :: ScatterStyle -> String
$cshow :: ScatterStyle -> String
showsPrec :: Int -> ScatterStyle -> ShowS
$cshowsPrec :: Int -> ScatterStyle -> ShowS
Show, forall x. Rep ScatterStyle x -> ScatterStyle
forall x. ScatterStyle -> Rep ScatterStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScatterStyle x -> ScatterStyle
$cfrom :: forall x. ScatterStyle -> Rep ScatterStyle x
Generic)
instance NFData ScatterStyle

-- | Single data point options
--
-- TODO:  invertIfNegative,  bubble3D, explosion, pictureOptions, extLst
--
-- See 21.2.2.52 "dPt (Data Point)" (p. 3384)
data DataPoint = DataPoint
  { DataPoint -> Maybe DataMarker
_dpMarker :: Maybe DataMarker
  , DataPoint -> Maybe ShapeProperties
_dpShapeProperties :: Maybe ShapeProperties
  } deriving (DataPoint -> DataPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataPoint -> DataPoint -> Bool
$c/= :: DataPoint -> DataPoint -> Bool
== :: DataPoint -> DataPoint -> Bool
$c== :: DataPoint -> DataPoint -> Bool
Eq, Int -> DataPoint -> ShowS
[DataPoint] -> ShowS
DataPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataPoint] -> ShowS
$cshowList :: [DataPoint] -> ShowS
show :: DataPoint -> String
$cshow :: DataPoint -> String
showsPrec :: Int -> DataPoint -> ShowS
$cshowsPrec :: Int -> DataPoint -> ShowS
Show, forall x. Rep DataPoint x -> DataPoint
forall x. DataPoint -> Rep DataPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataPoint x -> DataPoint
$cfrom :: forall x. DataPoint -> Rep DataPoint x
Generic)
instance NFData DataPoint

-- | Specifies common series options
-- TODO: spPr
--
-- See @EG_SerShared@ (p. 4063)
data Series = Series
  { Series -> Maybe Formula
_serTx :: Maybe Formula
    -- ^ specifies text for a series name, without rich text formatting
    -- currently only reference formula is supported
  , Series -> Maybe ShapeProperties
_serShapeProperties :: Maybe ShapeProperties
  } deriving (Series -> Series -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Series -> Series -> Bool
$c/= :: Series -> Series -> Bool
== :: Series -> Series -> Bool
$c== :: Series -> Series -> Bool
Eq, Int -> Series -> ShowS
[Series] -> ShowS
Series -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Series] -> ShowS
$cshowList :: [Series] -> ShowS
show :: Series -> String
$cshow :: Series -> String
showsPrec :: Int -> Series -> ShowS
$cshowsPrec :: Int -> Series -> ShowS
Show, forall x. Rep Series x -> Series
forall x. Series -> Rep Series x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Series x -> Series
$cfrom :: forall x. Series -> Rep Series x
Generic)
instance NFData Series

-- | A series on a line chart
--
-- TODO: dPt, trendline, errBars, cat, extLst
--
-- See @CT_LineSer@ (p. 4064)
data LineSeries = LineSeries
  { LineSeries -> Series
_lnserShared :: Series
  , LineSeries -> Maybe DataMarker
_lnserMarker :: Maybe DataMarker
  , LineSeries -> Maybe DataLblProps
_lnserDataLblProps :: Maybe DataLblProps
  , LineSeries -> Maybe Formula
_lnserVal :: Maybe Formula
    -- ^ currently only reference formula is supported
  , LineSeries -> Maybe Bool
_lnserSmooth :: Maybe Bool
  } deriving (LineSeries -> LineSeries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineSeries -> LineSeries -> Bool
$c/= :: LineSeries -> LineSeries -> Bool
== :: LineSeries -> LineSeries -> Bool
$c== :: LineSeries -> LineSeries -> Bool
Eq, Int -> LineSeries -> ShowS
[LineSeries] -> ShowS
LineSeries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineSeries] -> ShowS
$cshowList :: [LineSeries] -> ShowS
show :: LineSeries -> String
$cshow :: LineSeries -> String
showsPrec :: Int -> LineSeries -> ShowS
$cshowsPrec :: Int -> LineSeries -> ShowS
Show, forall x. Rep LineSeries x -> LineSeries
forall x. LineSeries -> Rep LineSeries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineSeries x -> LineSeries
$cfrom :: forall x. LineSeries -> Rep LineSeries x
Generic)
instance NFData LineSeries

-- | A series on an area chart
--
-- TODO: pictureOptions, dPt, trendline, errBars, cat, extLst
--
-- See @CT_AreaSer@ (p. 4065)
data AreaSeries = AreaSeries
  { AreaSeries -> Series
_arserShared :: Series
  , AreaSeries -> Maybe DataLblProps
_arserDataLblProps :: Maybe DataLblProps
  , AreaSeries -> Maybe Formula
_arserVal :: Maybe Formula
  } deriving (AreaSeries -> AreaSeries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AreaSeries -> AreaSeries -> Bool
$c/= :: AreaSeries -> AreaSeries -> Bool
== :: AreaSeries -> AreaSeries -> Bool
$c== :: AreaSeries -> AreaSeries -> Bool
Eq, Int -> AreaSeries -> ShowS
[AreaSeries] -> ShowS
AreaSeries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AreaSeries] -> ShowS
$cshowList :: [AreaSeries] -> ShowS
show :: AreaSeries -> String
$cshow :: AreaSeries -> String
showsPrec :: Int -> AreaSeries -> ShowS
$cshowsPrec :: Int -> AreaSeries -> ShowS
Show, forall x. Rep AreaSeries x -> AreaSeries
forall x. AreaSeries -> Rep AreaSeries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AreaSeries x -> AreaSeries
$cfrom :: forall x. AreaSeries -> Rep AreaSeries x
Generic)
instance NFData AreaSeries

-- | A series on a bar chart
--
-- TODO: invertIfNegative, pictureOptions, dPt, trendline, errBars,
-- cat, shape, extLst
--
-- See @CT_BarSer@ (p. 4064)
data BarSeries = BarSeries
  { BarSeries -> Series
_brserShared :: Series
  , BarSeries -> Maybe DataLblProps
_brserDataLblProps :: Maybe DataLblProps
  , BarSeries -> Maybe Formula
_brserVal :: Maybe Formula
  } deriving (BarSeries -> BarSeries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarSeries -> BarSeries -> Bool
$c/= :: BarSeries -> BarSeries -> Bool
== :: BarSeries -> BarSeries -> Bool
$c== :: BarSeries -> BarSeries -> Bool
Eq, Int -> BarSeries -> ShowS
[BarSeries] -> ShowS
BarSeries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarSeries] -> ShowS
$cshowList :: [BarSeries] -> ShowS
show :: BarSeries -> String
$cshow :: BarSeries -> String
showsPrec :: Int -> BarSeries -> ShowS
$cshowsPrec :: Int -> BarSeries -> ShowS
Show, forall x. Rep BarSeries x -> BarSeries
forall x. BarSeries -> Rep BarSeries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarSeries x -> BarSeries
$cfrom :: forall x. BarSeries -> Rep BarSeries x
Generic)
instance NFData BarSeries

-- | A series on a pie chart
--
-- TODO: explosion, cat, extLst
--
-- See @CT_PieSer@ (p. 4065)
data PieSeries = PieSeries
  { PieSeries -> Series
_piserShared :: Series
  , PieSeries -> [DataPoint]
_piserDataPoints :: [DataPoint]
  -- ^ normally you should set fill for chart datapoints to make them
  -- properly colored
  , PieSeries -> Maybe DataLblProps
_piserDataLblProps :: Maybe DataLblProps
  , PieSeries -> Maybe Formula
_piserVal :: Maybe Formula
  } deriving (PieSeries -> PieSeries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PieSeries -> PieSeries -> Bool
$c/= :: PieSeries -> PieSeries -> Bool
== :: PieSeries -> PieSeries -> Bool
$c== :: PieSeries -> PieSeries -> Bool
Eq, Int -> PieSeries -> ShowS
[PieSeries] -> ShowS
PieSeries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieSeries] -> ShowS
$cshowList :: [PieSeries] -> ShowS
show :: PieSeries -> String
$cshow :: PieSeries -> String
showsPrec :: Int -> PieSeries -> ShowS
$cshowsPrec :: Int -> PieSeries -> ShowS
Show, forall x. Rep PieSeries x -> PieSeries
forall x. PieSeries -> Rep PieSeries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PieSeries x -> PieSeries
$cfrom :: forall x. PieSeries -> Rep PieSeries x
Generic)
instance NFData PieSeries

-- | A series on a scatter chart
--
-- TODO: dPt, trendline, errBars, smooth, extLst
--
-- See @CT_ScatterSer@ (p. 4064)
data ScatterSeries = ScatterSeries
  { ScatterSeries -> Series
_scserShared :: Series
  , ScatterSeries -> Maybe DataMarker
_scserMarker :: Maybe DataMarker
  , ScatterSeries -> Maybe DataLblProps
_scserDataLblProps :: Maybe DataLblProps
  , ScatterSeries -> Maybe Formula
_scserXVal :: Maybe Formula
  , ScatterSeries -> Maybe Formula
_scserYVal :: Maybe Formula
  , ScatterSeries -> Maybe Bool
_scserSmooth :: Maybe Bool
  } deriving (ScatterSeries -> ScatterSeries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScatterSeries -> ScatterSeries -> Bool
$c/= :: ScatterSeries -> ScatterSeries -> Bool
== :: ScatterSeries -> ScatterSeries -> Bool
$c== :: ScatterSeries -> ScatterSeries -> Bool
Eq, Int -> ScatterSeries -> ShowS
[ScatterSeries] -> ShowS
ScatterSeries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScatterSeries] -> ShowS
$cshowList :: [ScatterSeries] -> ShowS
show :: ScatterSeries -> String
$cshow :: ScatterSeries -> String
showsPrec :: Int -> ScatterSeries -> ShowS
$cshowsPrec :: Int -> ScatterSeries -> ShowS
Show, forall x. Rep ScatterSeries x -> ScatterSeries
forall x. ScatterSeries -> Rep ScatterSeries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScatterSeries x -> ScatterSeries
$cfrom :: forall x. ScatterSeries -> Rep ScatterSeries x
Generic)
instance NFData ScatterSeries

-- See @CT_Marker@ (p. 4061)
data DataMarker = DataMarker
  { DataMarker -> Maybe DataMarkerSymbol
_dmrkSymbol :: Maybe DataMarkerSymbol
  , DataMarker -> Maybe Int
_dmrkSize :: Maybe Int
    -- ^ integer between 2 and 72, specifying a size in points
  } deriving (DataMarker -> DataMarker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataMarker -> DataMarker -> Bool
$c/= :: DataMarker -> DataMarker -> Bool
== :: DataMarker -> DataMarker -> Bool
$c== :: DataMarker -> DataMarker -> Bool
Eq, Int -> DataMarker -> ShowS
[DataMarker] -> ShowS
DataMarker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataMarker] -> ShowS
$cshowList :: [DataMarker] -> ShowS
show :: DataMarker -> String
$cshow :: DataMarker -> String
showsPrec :: Int -> DataMarker -> ShowS
$cshowsPrec :: Int -> DataMarker -> ShowS
Show, forall x. Rep DataMarker x -> DataMarker
forall x. DataMarker -> Rep DataMarker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataMarker x -> DataMarker
$cfrom :: forall x. DataMarker -> Rep DataMarker x
Generic)
instance NFData DataMarker

data DataMarkerSymbol
  = DataMarkerCircle
  | DataMarkerDash
  | DataMarkerDiamond
  | DataMarkerDot
  | DataMarkerNone
  | DataMarkerPicture
  | DataMarkerPlus
  | DataMarkerSquare
  | DataMarkerStar
  | DataMarkerTriangle
  | DataMarkerX
  | DataMarkerAuto
  deriving (DataMarkerSymbol -> DataMarkerSymbol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataMarkerSymbol -> DataMarkerSymbol -> Bool
$c/= :: DataMarkerSymbol -> DataMarkerSymbol -> Bool
== :: DataMarkerSymbol -> DataMarkerSymbol -> Bool
$c== :: DataMarkerSymbol -> DataMarkerSymbol -> Bool
Eq, Int -> DataMarkerSymbol -> ShowS
[DataMarkerSymbol] -> ShowS
DataMarkerSymbol -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataMarkerSymbol] -> ShowS
$cshowList :: [DataMarkerSymbol] -> ShowS
show :: DataMarkerSymbol -> String
$cshow :: DataMarkerSymbol -> String
showsPrec :: Int -> DataMarkerSymbol -> ShowS
$cshowsPrec :: Int -> DataMarkerSymbol -> ShowS
Show, forall x. Rep DataMarkerSymbol x -> DataMarkerSymbol
forall x. DataMarkerSymbol -> Rep DataMarkerSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataMarkerSymbol x -> DataMarkerSymbol
$cfrom :: forall x. DataMarkerSymbol -> Rep DataMarkerSymbol x
Generic)
instance NFData DataMarkerSymbol

-- | Settings for the data labels for an entire series or the
-- entire chart
--
-- TODO: numFmt, spPr, txPr, dLblPos, showBubbleSize,
-- separator, showLeaderLines, leaderLines
-- See 21.2.2.49 "dLbls (Data Labels)" (p. 3384)
data DataLblProps = DataLblProps
  { DataLblProps -> Maybe Bool
_dlblShowLegendKey :: Maybe Bool
  , DataLblProps -> Maybe Bool
_dlblShowVal :: Maybe Bool
  , DataLblProps -> Maybe Bool
_dlblShowCatName :: Maybe Bool
  , DataLblProps -> Maybe Bool
_dlblShowSerName :: Maybe Bool
  , DataLblProps -> Maybe Bool
_dlblShowPercent :: Maybe Bool
  } deriving (DataLblProps -> DataLblProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataLblProps -> DataLblProps -> Bool
$c/= :: DataLblProps -> DataLblProps -> Bool
== :: DataLblProps -> DataLblProps -> Bool
$c== :: DataLblProps -> DataLblProps -> Bool
Eq, Int -> DataLblProps -> ShowS
[DataLblProps] -> ShowS
DataLblProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataLblProps] -> ShowS
$cshowList :: [DataLblProps] -> ShowS
show :: DataLblProps -> String
$cshow :: DataLblProps -> String
showsPrec :: Int -> DataLblProps -> ShowS
$cshowsPrec :: Int -> DataLblProps -> ShowS
Show, forall x. Rep DataLblProps x -> DataLblProps
forall x. DataLblProps -> Rep DataLblProps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataLblProps x -> DataLblProps
$cfrom :: forall x. DataLblProps -> Rep DataLblProps x
Generic)
instance NFData DataLblProps

-- | Specifies the possible positions for tick marks.

-- See 21.2.3.48 "ST_TickMark (Tick Mark)" (p. 3467)
data TickMark
  = TickMarkCross
    -- ^ (Cross) Specifies the tick marks shall cross the axis.
  | TickMarkIn
    -- ^ (Inside) Specifies the tick marks shall be inside the plot area.
  | TickMarkNone
    -- ^ (None) Specifies there shall be no tick marks.
  | TickMarkOut
    -- ^ (Outside) Specifies the tick marks shall be outside the plot area.
  deriving (TickMark -> TickMark -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickMark -> TickMark -> Bool
$c/= :: TickMark -> TickMark -> Bool
== :: TickMark -> TickMark -> Bool
$c== :: TickMark -> TickMark -> Bool
Eq, Int -> TickMark -> ShowS
[TickMark] -> ShowS
TickMark -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickMark] -> ShowS
$cshowList :: [TickMark] -> ShowS
show :: TickMark -> String
$cshow :: TickMark -> String
showsPrec :: Int -> TickMark -> ShowS
$cshowsPrec :: Int -> TickMark -> ShowS
Show, forall x. Rep TickMark x -> TickMark
forall x. TickMark -> Rep TickMark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TickMark x -> TickMark
$cfrom :: forall x. TickMark -> Rep TickMark x
Generic)
instance NFData TickMark

makeLenses ''DataPoint

{-------------------------------------------------------------------------------
  Default instances
-------------------------------------------------------------------------------}

instance Default DataPoint where
    def :: DataPoint
def = Maybe DataMarker -> Maybe ShapeProperties -> DataPoint
DataPoint forall a. Maybe a
Nothing forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

instance FromCursor ChartSpace where
  fromCursor :: Cursor -> [ChartSpace]
fromCursor Cursor
cur = do
    Cursor
cur' <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"chart")
    Maybe ChartTitle
_chspTitle <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"title") Cursor
cur'
    let _chspCharts :: [Chart]
_chspCharts =
          Cursor
cur' forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"plotArea") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [Chart]
chartFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node
    Maybe Legend
_chspLegend <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"legend") Cursor
cur'
    Maybe Bool
_chspPlotVisOnly <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"plotVisOnly") Cursor
cur'
    Maybe DispBlanksAs
_chspDispBlanksAs <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
c_ Text
"dispBlanksAs") Cursor
cur'
    forall (m :: * -> *) a. Monad m => a -> m a
return ChartSpace {[Chart]
Maybe Bool
Maybe Legend
Maybe DispBlanksAs
Maybe ChartTitle
_chspDispBlanksAs :: Maybe DispBlanksAs
_chspPlotVisOnly :: Maybe Bool
_chspLegend :: Maybe Legend
_chspCharts :: [Chart]
_chspTitle :: Maybe ChartTitle
_chspDispBlanksAs :: Maybe DispBlanksAs
_chspPlotVisOnly :: Maybe Bool
_chspLegend :: Maybe Legend
_chspCharts :: [Chart]
_chspTitle :: Maybe ChartTitle
..}

chartFromNode :: Node -> [Chart]
chartFromNode :: Node -> [Chart]
chartFromNode Node
n
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
c_ Text
"lineChart") = do
    ChartGrouping
_lnchGrouping <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromElementValue (Text -> Name
c_ Text
"grouping") Cursor
cur
    let _lnchSeries :: [LineSeries]
_lnchSeries = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"ser") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    Maybe Bool
_lnchMarker <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"marker") Cursor
cur
    Maybe Bool
_lnchSmooth <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"smooth") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return LineChart {[LineSeries]
Maybe Bool
ChartGrouping
_lnchSmooth :: Maybe Bool
_lnchMarker :: Maybe Bool
_lnchSeries :: [LineSeries]
_lnchGrouping :: ChartGrouping
_lnchSmooth :: Maybe Bool
_lnchMarker :: Maybe Bool
_lnchSeries :: [LineSeries]
_lnchGrouping :: ChartGrouping
..}
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
c_ Text
"areaChart") = do
    Maybe ChartGrouping
_archGrouping <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
c_ Text
"grouping") Cursor
cur
    let _archSeries :: [AreaSeries]
_archSeries = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"ser") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return AreaChart {[AreaSeries]
Maybe ChartGrouping
_archSeries :: [AreaSeries]
_archGrouping :: Maybe ChartGrouping
_archSeries :: [AreaSeries]
_archGrouping :: Maybe ChartGrouping
..}
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
c_ Text
"barChart") = do
    BarDirection
_brchDirection <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromElementValue (Text -> Name
c_ Text
"barDir") Cursor
cur
    Maybe BarChartGrouping
_brchGrouping <-
      forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (Text -> Name
c_ Text
"grouping") BarChartGrouping
BarClusteredGrouping Cursor
cur
    let _brchSeries :: [BarSeries]
_brchSeries = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"ser") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return BarChart {[BarSeries]
Maybe BarChartGrouping
BarDirection
_brchSeries :: [BarSeries]
_brchGrouping :: Maybe BarChartGrouping
_brchDirection :: BarDirection
_brchSeries :: [BarSeries]
_brchGrouping :: Maybe BarChartGrouping
_brchDirection :: BarDirection
..}
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
c_ Text
"pieChart") = do
    let _pichSeries :: [PieSeries]
_pichSeries = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"ser") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return PieChart {[PieSeries]
_pichSeries :: [PieSeries]
_pichSeries :: [PieSeries]
..}
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
c_ Text
"scatterChart") = do
    ScatterStyle
_scchStyle <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromElementValue (Text -> Name
c_ Text
"scatterStyle") Cursor
cur
    let _scchSeries :: [ScatterSeries]
_scchSeries = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"ser") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return ScatterChart {[ScatterSeries]
ScatterStyle
_scchSeries :: [ScatterSeries]
_scchStyle :: ScatterStyle
_scchSeries :: [ScatterSeries]
_scchStyle :: ScatterStyle
..}
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching chart node"
  where
    cur :: Cursor
cur = Node -> Cursor
fromNode Node
n

instance FromCursor LineSeries where
  fromCursor :: Cursor -> [LineSeries]
fromCursor Cursor
cur = do
    Series
_lnserShared <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe DataMarker
_lnserMarker <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"marker") Cursor
cur
    Maybe DataLblProps
_lnserDataLblProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"dLbls") Cursor
cur
    Maybe Formula
_lnserVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"val") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    Maybe Bool
_lnserSmooth <- forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (Text -> Name
c_ Text
"smooth") Bool
True Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return LineSeries {Maybe Bool
Maybe Formula
Maybe DataLblProps
Maybe DataMarker
Series
_lnserSmooth :: Maybe Bool
_lnserVal :: Maybe Formula
_lnserDataLblProps :: Maybe DataLblProps
_lnserMarker :: Maybe DataMarker
_lnserShared :: Series
_lnserSmooth :: Maybe Bool
_lnserVal :: Maybe Formula
_lnserDataLblProps :: Maybe DataLblProps
_lnserMarker :: Maybe DataMarker
_lnserShared :: Series
..}

instance FromCursor AreaSeries where
  fromCursor :: Cursor -> [AreaSeries]
fromCursor Cursor
cur = do
    Series
_arserShared <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe DataLblProps
_arserDataLblProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"dLbls") Cursor
cur
    Maybe Formula
_arserVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"val") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    forall (m :: * -> *) a. Monad m => a -> m a
return AreaSeries {Maybe Formula
Maybe DataLblProps
Series
_arserVal :: Maybe Formula
_arserDataLblProps :: Maybe DataLblProps
_arserShared :: Series
_arserVal :: Maybe Formula
_arserDataLblProps :: Maybe DataLblProps
_arserShared :: Series
..}

instance FromCursor BarSeries where
  fromCursor :: Cursor -> [BarSeries]
fromCursor Cursor
cur = do
    Series
_brserShared <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe DataLblProps
_brserDataLblProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"dLbls") Cursor
cur
    Maybe Formula
_brserVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"val") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    forall (m :: * -> *) a. Monad m => a -> m a
return BarSeries {Maybe Formula
Maybe DataLblProps
Series
_brserVal :: Maybe Formula
_brserDataLblProps :: Maybe DataLblProps
_brserShared :: Series
_brserVal :: Maybe Formula
_brserDataLblProps :: Maybe DataLblProps
_brserShared :: Series
..}

instance FromCursor PieSeries where
  fromCursor :: Cursor -> [PieSeries]
fromCursor Cursor
cur = do
    Series
_piserShared <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    let _piserDataPoints :: [DataPoint]
_piserDataPoints = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"dPt") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    Maybe DataLblProps
_piserDataLblProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"dLbls") Cursor
cur
    Maybe Formula
_piserVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"val") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    forall (m :: * -> *) a. Monad m => a -> m a
return PieSeries {[DataPoint]
Maybe Formula
Maybe DataLblProps
Series
_piserVal :: Maybe Formula
_piserDataLblProps :: Maybe DataLblProps
_piserDataPoints :: [DataPoint]
_piserShared :: Series
_piserVal :: Maybe Formula
_piserDataLblProps :: Maybe DataLblProps
_piserDataPoints :: [DataPoint]
_piserShared :: Series
..}

instance FromCursor ScatterSeries where
  fromCursor :: Cursor -> [ScatterSeries]
fromCursor Cursor
cur = do
    Series
_scserShared <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe DataMarker
_scserMarker <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"marker") Cursor
cur
    Maybe DataLblProps
_scserDataLblProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"dLbls") Cursor
cur
    Maybe Formula
_scserXVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"xVal") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    Maybe Formula
_scserYVal <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"yVal") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"numRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    Maybe Bool
_scserSmooth <- forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (Text -> Name
c_ Text
"smooth") Bool
True Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return ScatterSeries {Maybe Bool
Maybe Formula
Maybe DataLblProps
Maybe DataMarker
Series
_scserSmooth :: Maybe Bool
_scserYVal :: Maybe Formula
_scserXVal :: Maybe Formula
_scserDataLblProps :: Maybe DataLblProps
_scserMarker :: Maybe DataMarker
_scserShared :: Series
_scserSmooth :: Maybe Bool
_scserYVal :: Maybe Formula
_scserXVal :: Maybe Formula
_scserDataLblProps :: Maybe DataLblProps
_scserMarker :: Maybe DataMarker
_scserShared :: Series
..}

-- should we respect idx and order?
instance FromCursor Series where
  fromCursor :: Cursor -> [Series]
fromCursor Cursor
cur = do
    Maybe Formula
_serTx <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"tx") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"strRef") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
      forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"f")
    Maybe ShapeProperties
_serShapeProperties <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"spPr") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return Series {Maybe ShapeProperties
Maybe Formula
_serShapeProperties :: Maybe ShapeProperties
_serTx :: Maybe Formula
_serShapeProperties :: Maybe ShapeProperties
_serTx :: Maybe Formula
..}

instance FromCursor DataMarker where
  fromCursor :: Cursor -> [DataMarker]
fromCursor Cursor
cur = do
    Maybe DataMarkerSymbol
_dmrkSymbol <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
c_ Text
"symbol") Cursor
cur
    Maybe Int
_dmrkSize <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
c_ Text
"size") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return DataMarker {Maybe Int
Maybe DataMarkerSymbol
_dmrkSize :: Maybe Int
_dmrkSymbol :: Maybe DataMarkerSymbol
_dmrkSize :: Maybe Int
_dmrkSymbol :: Maybe DataMarkerSymbol
..}

instance FromCursor DataPoint where
  fromCursor :: Cursor -> [DataPoint]
fromCursor Cursor
cur = do
    Maybe DataMarker
_dpMarker <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"marker") Cursor
cur
    Maybe ShapeProperties
_dpShapeProperties <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
c_ Text
"spPr") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return DataPoint {Maybe ShapeProperties
Maybe DataMarker
_dpShapeProperties :: Maybe ShapeProperties
_dpMarker :: Maybe DataMarker
_dpShapeProperties :: Maybe ShapeProperties
_dpMarker :: Maybe DataMarker
..}

instance FromAttrVal DataMarkerSymbol where
  fromAttrVal :: Reader DataMarkerSymbol
fromAttrVal Text
"circle" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerCircle
  fromAttrVal Text
"dash" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerDash
  fromAttrVal Text
"diamond" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerDiamond
  fromAttrVal Text
"dot" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerDot
  fromAttrVal Text
"none" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerNone
  fromAttrVal Text
"picture" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerPicture
  fromAttrVal Text
"plus" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerPlus
  fromAttrVal Text
"square" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerSquare
  fromAttrVal Text
"star" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerStar
  fromAttrVal Text
"triangle" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerTriangle
  fromAttrVal Text
"x" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerX
  fromAttrVal Text
"auto" = forall a. a -> Either String (a, Text)
readSuccess DataMarkerSymbol
DataMarkerAuto
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"DataMarkerSymbol" Text
t

instance FromAttrVal BarDirection where
  fromAttrVal :: Reader BarDirection
fromAttrVal Text
"bar" = forall a. a -> Either String (a, Text)
readSuccess BarDirection
DirectionBar
  fromAttrVal Text
"col" = forall a. a -> Either String (a, Text)
readSuccess BarDirection
DirectionColumn
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"BarDirection" Text
t

instance FromAttrVal ScatterStyle where
  fromAttrVal :: Reader ScatterStyle
fromAttrVal Text
"none" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterNone
  fromAttrVal Text
"line" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterLine
  fromAttrVal Text
"lineMarker" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterLineMarker
  fromAttrVal Text
"marker" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterMarker
  fromAttrVal Text
"smooth" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterSmooth
  fromAttrVal Text
"smoothMarker" = forall a. a -> Either String (a, Text)
readSuccess ScatterStyle
ScatterSmoothMarker
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"ScatterStyle" Text
t

instance FromCursor DataLblProps where
  fromCursor :: Cursor -> [DataLblProps]
fromCursor Cursor
cur = do
    Maybe Bool
_dlblShowLegendKey <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"showLegendKey") Cursor
cur
    Maybe Bool
_dlblShowVal <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"showVal") Cursor
cur
    Maybe Bool
_dlblShowCatName <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"showCatName") Cursor
cur
    Maybe Bool
_dlblShowSerName <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"showSerName") Cursor
cur
    Maybe Bool
_dlblShowPercent <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
c_ Text
"showPercent") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return DataLblProps {Maybe Bool
_dlblShowPercent :: Maybe Bool
_dlblShowSerName :: Maybe Bool
_dlblShowCatName :: Maybe Bool
_dlblShowVal :: Maybe Bool
_dlblShowLegendKey :: Maybe Bool
_dlblShowPercent :: Maybe Bool
_dlblShowSerName :: Maybe Bool
_dlblShowCatName :: Maybe Bool
_dlblShowVal :: Maybe Bool
_dlblShowLegendKey :: Maybe Bool
..}

instance FromAttrVal ChartGrouping where
  fromAttrVal :: Reader ChartGrouping
fromAttrVal Text
"percentStacked" = forall a. a -> Either String (a, Text)
readSuccess ChartGrouping
PercentStackedGrouping
  fromAttrVal Text
"standard" = forall a. a -> Either String (a, Text)
readSuccess ChartGrouping
StandardGrouping
  fromAttrVal Text
"stacked" = forall a. a -> Either String (a, Text)
readSuccess ChartGrouping
StackedGrouping
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"ChartGrouping" Text
t

instance FromAttrVal BarChartGrouping where
  fromAttrVal :: Reader BarChartGrouping
fromAttrVal Text
"clustered" = forall a. a -> Either String (a, Text)
readSuccess BarChartGrouping
BarClusteredGrouping
  fromAttrVal Text
"percentStacked" = forall a. a -> Either String (a, Text)
readSuccess BarChartGrouping
BarPercentStackedGrouping
  fromAttrVal Text
"standard" = forall a. a -> Either String (a, Text)
readSuccess BarChartGrouping
BarStandardGrouping
  fromAttrVal Text
"stacked" = forall a. a -> Either String (a, Text)
readSuccess BarChartGrouping
BarStackedGrouping
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"BarChartGrouping" Text
t

instance FromCursor ChartTitle where
  fromCursor :: Cursor -> [ChartTitle]
fromCursor Cursor
cur = do
    let mTitle :: Maybe TextBody
mTitle = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
          Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
c_ Text
"tx") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
c_ Text
"rich") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe TextBody -> ChartTitle
ChartTitle Maybe TextBody
mTitle

instance FromCursor Legend where
  fromCursor :: Cursor -> [Legend]
fromCursor Cursor
cur = do
    Maybe LegendPos
_legendPos <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
c_ Text
"legendPos") Cursor
cur
    Maybe Bool
_legendOverlay <- forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (Text -> Name
c_ Text
"overlay") Bool
True Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return Legend {Maybe Bool
Maybe LegendPos
_legendOverlay :: Maybe Bool
_legendPos :: Maybe LegendPos
_legendOverlay :: Maybe Bool
_legendPos :: Maybe LegendPos
..}

instance FromAttrVal LegendPos where
  fromAttrVal :: Reader LegendPos
fromAttrVal Text
"b" = forall a. a -> Either String (a, Text)
readSuccess LegendPos
LegendBottom
  fromAttrVal Text
"l" = forall a. a -> Either String (a, Text)
readSuccess LegendPos
LegendLeft
  fromAttrVal Text
"r" = forall a. a -> Either String (a, Text)
readSuccess LegendPos
LegendRight
  fromAttrVal Text
"t" = forall a. a -> Either String (a, Text)
readSuccess LegendPos
LegendTop
  fromAttrVal Text
"tr" = forall a. a -> Either String (a, Text)
readSuccess LegendPos
LegendTopRight
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"LegendPos" Text
t

instance FromAttrVal DispBlanksAs where
  fromAttrVal :: Reader DispBlanksAs
fromAttrVal Text
"gap" = forall a. a -> Either String (a, Text)
readSuccess DispBlanksAs
DispBlanksAsGap
  fromAttrVal Text
"span" = forall a. a -> Either String (a, Text)
readSuccess DispBlanksAs
DispBlanksAsSpan
  fromAttrVal Text
"zero" = forall a. a -> Either String (a, Text)
readSuccess DispBlanksAs
DispBlanksAsZero
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"DispBlanksAs" Text
t

{-------------------------------------------------------------------------------
  Default instances
-------------------------------------------------------------------------------}

instance Default Legend where
  def :: Legend
def = Legend {_legendPos :: Maybe LegendPos
_legendPos = forall a. a -> Maybe a
Just LegendPos
LegendBottom, _legendOverlay :: Maybe Bool
_legendOverlay = forall a. a -> Maybe a
Just Bool
False}

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToDocument ChartSpace where
  toDocument :: ChartSpace -> Document
toDocument =
    Text -> Text -> Maybe Text -> Element -> Document
documentFromNsPrefElement Text
"Charts generated by xlsx" Text
chartNs (forall a. a -> Maybe a
Just Text
"c") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. ToElement a => Name -> a -> Element
toElement Name
"chartSpace"

instance ToElement ChartSpace where
  toElement :: Name -> ChartSpace -> Element
toElement Name
nm ChartSpace {[Chart]
Maybe Bool
Maybe Legend
Maybe DispBlanksAs
Maybe ChartTitle
_chspDispBlanksAs :: Maybe DispBlanksAs
_chspPlotVisOnly :: Maybe Bool
_chspLegend :: Maybe Legend
_chspCharts :: [Chart]
_chspTitle :: Maybe ChartTitle
_chspDispBlanksAs :: ChartSpace -> Maybe DispBlanksAs
_chspPlotVisOnly :: ChartSpace -> Maybe Bool
_chspLegend :: ChartSpace -> Maybe Legend
_chspCharts :: ChartSpace -> [Chart]
_chspTitle :: ChartSpace -> Maybe ChartTitle
..} =
    Name -> [Element] -> Element
elementListSimple Name
nm [Element
nonRounded, Element
chartEl, Element
chSpPr]
    where
      -- no such element gives a chart space with rounded corners
      nonRounded :: Element
nonRounded = forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"roundedCorners" Bool
False
      chSpPr :: Element
chSpPr = forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {_spFill :: Maybe FillProperties
_spFill = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FillProperties
solidRgb Text
"ffffff"}
      chartEl :: Element
chartEl = Name -> [Element] -> Element
elementListSimple Name
"chart" [Element]
elements
      elements :: [Element]
elements =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToElement a => Name -> a -> Element
toElement Name
"title" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChartTitle
_chspTitle
          -- LO?
          , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"autoTitleDeleted" Bool
False
          , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> [Element] -> Element
elementListSimple Name
"plotArea" [Element]
areaEls
          , forall a. ToElement a => Name -> a -> Element
toElement Name
"legend" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Legend
_chspLegend
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"plotVisOnly" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_chspPlotVisOnly
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"dispBlanksAs" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DispBlanksAs
_chspDispBlanksAs
          ]
      areaEls :: [Element]
areaEls = [Element]
charts forall a. [a] -> [a] -> [a]
++ [Element]
axes
      (Int
_, [Element]
charts, [Element]
axes) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Chart -> (Int, [Element], [Element]) -> (Int, [Element], [Element])
addChart (Int
1, [], []) [Chart]
_chspCharts
      addChart :: Chart -> (Int, [Element], [Element]) -> (Int, [Element], [Element])
addChart Chart
ch (Int
i, [Element]
cs, [Element]
as) =
        let (Element
c, [Element]
as') = Chart -> Int -> (Element, [Element])
chartToElements Chart
ch Int
i
        in (Int
i forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
as', Element
c forall a. a -> [a] -> [a]
: [Element]
cs, [Element]
as' forall a. [a] -> [a] -> [a]
++ [Element]
as)

chartToElements :: Chart -> Int -> (Element, [Element])
chartToElements :: Chart -> Int -> (Element, [Element])
chartToElements Chart
chart Int
axId =
  case Chart
chart of
    LineChart {[LineSeries]
Maybe Bool
ChartGrouping
_lnchSmooth :: Maybe Bool
_lnchMarker :: Maybe Bool
_lnchSeries :: [LineSeries]
_lnchGrouping :: ChartGrouping
_lnchSmooth :: Chart -> Maybe Bool
_lnchMarker :: Chart -> Maybe Bool
_lnchSeries :: Chart -> [LineSeries]
_lnchGrouping :: Chart -> ChartGrouping
..} ->
      forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement
        Name
"lineChart"
        [Element]
stdAxes
        (forall a. a -> Maybe a
Just ChartGrouping
_lnchGrouping)
        [LineSeries]
_lnchSeries
        []
        (forall a. [Maybe a] -> [a]
catMaybes
           [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"marker" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_lnchMarker
           , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"smooth" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_lnchSmooth
           ])
    AreaChart {[AreaSeries]
Maybe ChartGrouping
_archSeries :: [AreaSeries]
_archGrouping :: Maybe ChartGrouping
_archSeries :: Chart -> [AreaSeries]
_archGrouping :: Chart -> Maybe ChartGrouping
..} ->
      forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement Name
"areaChart" [Element]
stdAxes Maybe ChartGrouping
_archGrouping [AreaSeries]
_archSeries [] []
    BarChart {[BarSeries]
Maybe BarChartGrouping
BarDirection
_brchSeries :: [BarSeries]
_brchGrouping :: Maybe BarChartGrouping
_brchDirection :: BarDirection
_brchSeries :: Chart -> [BarSeries]
_brchGrouping :: Chart -> Maybe BarChartGrouping
_brchDirection :: Chart -> BarDirection
..} ->
      forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement
        Name
"barChart"
        [Element]
stdAxes
        Maybe BarChartGrouping
_brchGrouping
        [BarSeries]
_brchSeries
        [forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"barDir" BarDirection
_brchDirection]
        []
    PieChart {[PieSeries]
_pichSeries :: [PieSeries]
_pichSeries :: Chart -> [PieSeries]
..} -> forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement Name
"pieChart" [] Maybe ChartGrouping
noGrouping [PieSeries]
_pichSeries [] []
    ScatterChart {[ScatterSeries]
ScatterStyle
_scchSeries :: [ScatterSeries]
_scchStyle :: ScatterStyle
_scchSeries :: Chart -> [ScatterSeries]
_scchStyle :: Chart -> ScatterStyle
..} ->
      forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement
        Name
"scatterChart"
        [Element]
xyAxes
        Maybe ChartGrouping
noGrouping
        [ScatterSeries]
_scchSeries
        [forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"scatterStyle" ScatterStyle
_scchStyle]
        []
  where
    noGrouping :: Maybe ChartGrouping
    noGrouping :: Maybe ChartGrouping
noGrouping = forall a. Maybe a
Nothing
    chartElement
      :: (ToElement s, ToAttrVal gr)
      => Name
      -> [Element]
      -> Maybe gr
      -> [s]
      -> [Element]
      -> [Element]
      -> (Element, [Element])
    chartElement :: forall s gr.
(ToElement s, ToAttrVal gr) =>
Name
-> [Element]
-> Maybe gr
-> [s]
-> [Element]
-> [Element]
-> (Element, [Element])
chartElement Name
nm [Element]
axes Maybe gr
mGrouping [s]
series [Element]
prepended [Element]
appended =
      ( Name -> [Element] -> Element
elementListSimple Name
nm forall a b. (a -> b) -> a -> b
$
        [Element]
prepended forall a. [a] -> [a] -> [a]
++
        (forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"grouping" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe gr
mGrouping) forall a. [a] -> [a] -> [a]
++
        (Element
varyColors forall a. a -> [a] -> [a]
: forall {a}. ToElement a => [a] -> [Element]
seriesEls [s]
series) forall a. [a] -> [a] -> [a]
++
        [Element]
appended forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n Element
_ -> forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"axId" Int
n) [Int
axId ..] [Element]
axes
      , [Element]
axes)
    -- no element seems to be equal to varyColors=true in Excel Online
    varyColors :: Element
varyColors = forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"varyColors" Bool
False
    seriesEls :: [a] -> [Element]
seriesEls [a]
series = [forall a. ToElement a => Int -> a -> Element
indexedSeriesEl Int
i a
s | (Int
i, a
s) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
series]
    indexedSeriesEl
      :: ToElement a
      => Int -> a -> Element
    indexedSeriesEl :: forall a. ToElement a => Int -> a -> Element
indexedSeriesEl Int
i a
s = forall {a}. ToAttrVal a => a -> Element -> Element
prependI Int
i forall a b. (a -> b) -> a -> b
$ forall a. ToElement a => Name -> a -> Element
toElement Name
"ser" a
s
    prependI :: a -> Element -> Element
prependI a
i e :: Element
e@Element {[Node]
Map Name Text
Name
elementName :: Element -> Name
elementAttributes :: Element -> Map Name Text
elementNodes :: Element -> [Node]
elementNodes :: [Node]
elementAttributes :: Map Name Text
elementName :: Name
..} = Element
e {elementNodes :: [Node]
elementNodes = forall {a}. ToAttrVal a => a -> [Node]
iNodes a
i forall a. [a] -> [a] -> [a]
++ [Node]
elementNodes}
    iNodes :: a -> [Node]
iNodes a
i = forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
n a
i | Name
n <- [Name
"idx", Name
"order"]]

    stdAxes :: [Element]
stdAxes = [Int -> Int -> Element
catAx Int
axId (Int
axId forall a. Num a => a -> a -> a
+ Int
1), Text -> Int -> Int -> Element
valAx Text
"l" (Int
axId forall a. Num a => a -> a -> a
+ Int
1) Int
axId]
    xyAxes :: [Element]
xyAxes = [Text -> Int -> Int -> Element
valAx Text
"b" Int
axId (Int
axId forall a. Num a => a -> a -> a
+ Int
1), Text -> Int -> Int -> Element
valAx Text
"l" (Int
axId forall a. Num a => a -> a -> a
+ Int
1) Int
axId]
    catAx :: Int -> Int -> Element
    catAx :: Int -> Int -> Element
catAx Int
i Int
cr =
      Name -> [Element] -> Element
elementListSimple Name
"catAx" forall a b. (a -> b) -> a -> b
$
      [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"axId" Int
i
      , Name -> Element
emptyElement Name
"scaling"
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"delete" Bool
False
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"axPos" (Text
"b" :: Text)
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"majorTickMark" TickMark
TickMarkNone
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"minorTickMark" TickMark
TickMarkNone
      , forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" ShapeProperties
grayLines
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"crossAx" Int
cr
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"auto" Bool
True
      ]
    valAx :: Text -> Int -> Int -> Element
    valAx :: Text -> Int -> Int -> Element
valAx Text
pos Int
i Int
cr =
      Name -> [Element] -> Element
elementListSimple Name
"valAx" forall a b. (a -> b) -> a -> b
$
      [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"axId" Int
i
      , Name -> Element
emptyElement Name
"scaling"
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"delete" Bool
False
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"axPos" Text
pos
      , Element
gridLinesEl
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"majorTickMark" TickMark
TickMarkNone
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"minorTickMark" TickMark
TickMarkNone
      , forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" ShapeProperties
grayLines
      , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"crossAx" Int
cr
      ]
    grayLines :: ShapeProperties
grayLines = forall a. Default a => a
def {_spOutline :: Maybe LineProperties
_spOutline = forall a. a -> Maybe a
Just forall a. Default a => a
def {_lnFill :: Maybe FillProperties
_lnFill = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FillProperties
solidRgb Text
"b3b3b3"}}
    gridLinesEl :: Element
gridLinesEl =
      Name -> [Element] -> Element
elementListSimple Name
"majorGridlines" [forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" ShapeProperties
grayLines]

instance ToAttrVal ChartGrouping where
  toAttrVal :: ChartGrouping -> Text
toAttrVal ChartGrouping
PercentStackedGrouping = Text
"percentStacked"
  toAttrVal ChartGrouping
StandardGrouping = Text
"standard"
  toAttrVal ChartGrouping
StackedGrouping = Text
"stacked"

instance ToAttrVal BarChartGrouping where
  toAttrVal :: BarChartGrouping -> Text
toAttrVal BarChartGrouping
BarClusteredGrouping = Text
"clustered"
  toAttrVal BarChartGrouping
BarPercentStackedGrouping = Text
"percentStacked"
  toAttrVal BarChartGrouping
BarStandardGrouping = Text
"standard"
  toAttrVal BarChartGrouping
BarStackedGrouping = Text
"stacked"

instance ToAttrVal BarDirection where
  toAttrVal :: BarDirection -> Text
toAttrVal BarDirection
DirectionBar = Text
"bar"
  toAttrVal BarDirection
DirectionColumn = Text
"col"

instance ToAttrVal ScatterStyle where
  toAttrVal :: ScatterStyle -> Text
toAttrVal ScatterStyle
ScatterNone = Text
"none"
  toAttrVal ScatterStyle
ScatterLine = Text
"line"
  toAttrVal ScatterStyle
ScatterLineMarker = Text
"lineMarker"
  toAttrVal ScatterStyle
ScatterMarker = Text
"marker"
  toAttrVal ScatterStyle
ScatterSmooth = Text
"smooth"
  toAttrVal ScatterStyle
ScatterSmoothMarker = Text
"smoothMarker"

instance ToElement LineSeries where
  toElement :: Name -> LineSeries -> Element
toElement Name
nm LineSeries {Maybe Bool
Maybe Formula
Maybe DataLblProps
Maybe DataMarker
Series
_lnserSmooth :: Maybe Bool
_lnserVal :: Maybe Formula
_lnserDataLblProps :: Maybe DataLblProps
_lnserMarker :: Maybe DataMarker
_lnserShared :: Series
_lnserSmooth :: LineSeries -> Maybe Bool
_lnserVal :: LineSeries -> Maybe Formula
_lnserDataLblProps :: LineSeries -> Maybe DataLblProps
_lnserMarker :: LineSeries -> Maybe DataMarker
_lnserShared :: LineSeries -> Series
..} = Name
-> Series -> Maybe Formula -> [Element] -> [Element] -> Element
simpleSeries Name
nm Series
_lnserShared Maybe Formula
_lnserVal [Element]
pr [Element]
ap
    where
      pr :: [Element]
pr =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToElement a => Name -> a -> Element
toElement Name
"marker" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataMarker
_lnserMarker
          , forall a. ToElement a => Name -> a -> Element
toElement Name
"dLbls" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataLblProps
_lnserDataLblProps
          ]
      ap :: [Element]
ap = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"smooth" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_lnserSmooth

simpleSeries :: Name
             -> Series
             -> Maybe Formula
             -> [Element]
             -> [Element]
             -> Element
simpleSeries :: Name
-> Series -> Maybe Formula -> [Element] -> [Element] -> Element
simpleSeries Name
nm Series
shared Maybe Formula
val [Element]
prepended [Element]
appended =
  Element
serEl {elementNodes :: [Node]
elementNodes = Element -> [Node]
elementNodes Element
serEl forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [Element]
elements}
  where
    serEl :: Element
serEl = forall a. ToElement a => Name -> a -> Element
toElement Name
nm Series
shared
    elements :: [Element]
elements = [Element]
prepended forall a. [a] -> [a] -> [a]
++ (forall {a}. ToElement a => Maybe a -> Element
valEl Maybe Formula
val forall a. a -> [a] -> [a]
: [Element]
appended)
    valEl :: Maybe a -> Element
valEl Maybe a
v =
      Name -> [Element] -> Element
elementListSimple
        Name
"val"
        [Name -> [Element] -> Element
elementListSimple Name
"numRef" forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList (forall a. ToElement a => Name -> a -> Element
toElement Name
"f" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
v)]

instance ToElement DataMarker where
  toElement :: Name -> DataMarker -> Element
toElement Name
nm DataMarker {Maybe Int
Maybe DataMarkerSymbol
_dmrkSize :: Maybe Int
_dmrkSymbol :: Maybe DataMarkerSymbol
_dmrkSize :: DataMarker -> Maybe Int
_dmrkSymbol :: DataMarker -> Maybe DataMarkerSymbol
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
      elements :: [Element]
elements =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"symbol" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataMarkerSymbol
_dmrkSymbol
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"size" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_dmrkSize
          ]

instance ToAttrVal DataMarkerSymbol where
  toAttrVal :: DataMarkerSymbol -> Text
toAttrVal DataMarkerSymbol
DataMarkerCircle = Text
"circle"
  toAttrVal DataMarkerSymbol
DataMarkerDash = Text
"dash"
  toAttrVal DataMarkerSymbol
DataMarkerDiamond = Text
"diamond"
  toAttrVal DataMarkerSymbol
DataMarkerDot = Text
"dot"
  toAttrVal DataMarkerSymbol
DataMarkerNone = Text
"none"
  toAttrVal DataMarkerSymbol
DataMarkerPicture = Text
"picture"
  toAttrVal DataMarkerSymbol
DataMarkerPlus = Text
"plus"
  toAttrVal DataMarkerSymbol
DataMarkerSquare = Text
"square"
  toAttrVal DataMarkerSymbol
DataMarkerStar = Text
"star"
  toAttrVal DataMarkerSymbol
DataMarkerTriangle = Text
"triangle"
  toAttrVal DataMarkerSymbol
DataMarkerX = Text
"x"
  toAttrVal DataMarkerSymbol
DataMarkerAuto = Text
"auto"

instance ToElement DataLblProps where
  toElement :: Name -> DataLblProps -> Element
toElement Name
nm DataLblProps {Maybe Bool
_dlblShowPercent :: Maybe Bool
_dlblShowSerName :: Maybe Bool
_dlblShowCatName :: Maybe Bool
_dlblShowVal :: Maybe Bool
_dlblShowLegendKey :: Maybe Bool
_dlblShowPercent :: DataLblProps -> Maybe Bool
_dlblShowSerName :: DataLblProps -> Maybe Bool
_dlblShowCatName :: DataLblProps -> Maybe Bool
_dlblShowVal :: DataLblProps -> Maybe Bool
_dlblShowLegendKey :: DataLblProps -> Maybe Bool
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
      elements :: [Element]
elements =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"showLegendKey" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_dlblShowLegendKey
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"showVal" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_dlblShowVal
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"showCatName" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_dlblShowCatName
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"showSerName" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_dlblShowSerName
          , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"showPercent" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_dlblShowPercent
          ]

instance ToElement AreaSeries where
  toElement :: Name -> AreaSeries -> Element
toElement Name
nm AreaSeries {Maybe Formula
Maybe DataLblProps
Series
_arserVal :: Maybe Formula
_arserDataLblProps :: Maybe DataLblProps
_arserShared :: Series
_arserVal :: AreaSeries -> Maybe Formula
_arserDataLblProps :: AreaSeries -> Maybe DataLblProps
_arserShared :: AreaSeries -> Series
..} = Name
-> Series -> Maybe Formula -> [Element] -> [Element] -> Element
simpleSeries Name
nm Series
_arserShared Maybe Formula
_arserVal [Element]
pr []
    where
      pr :: [Element]
pr = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToElement a => Name -> a -> Element
toElement Name
"dLbls") Maybe DataLblProps
_arserDataLblProps

instance ToElement BarSeries where
  toElement :: Name -> BarSeries -> Element
toElement Name
nm BarSeries {Maybe Formula
Maybe DataLblProps
Series
_brserVal :: Maybe Formula
_brserDataLblProps :: Maybe DataLblProps
_brserShared :: Series
_brserVal :: BarSeries -> Maybe Formula
_brserDataLblProps :: BarSeries -> Maybe DataLblProps
_brserShared :: BarSeries -> Series
..} = Name
-> Series -> Maybe Formula -> [Element] -> [Element] -> Element
simpleSeries Name
nm Series
_brserShared Maybe Formula
_brserVal [Element]
pr []
    where
      pr :: [Element]
pr = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToElement a => Name -> a -> Element
toElement Name
"dLbls") Maybe DataLblProps
_brserDataLblProps

instance ToElement PieSeries where
  toElement :: Name -> PieSeries -> Element
toElement Name
nm PieSeries {[DataPoint]
Maybe Formula
Maybe DataLblProps
Series
_piserVal :: Maybe Formula
_piserDataLblProps :: Maybe DataLblProps
_piserDataPoints :: [DataPoint]
_piserShared :: Series
_piserVal :: PieSeries -> Maybe Formula
_piserDataLblProps :: PieSeries -> Maybe DataLblProps
_piserDataPoints :: PieSeries -> [DataPoint]
_piserShared :: PieSeries -> Series
..} = Name
-> Series -> Maybe Formula -> [Element] -> [Element] -> Element
simpleSeries Name
nm Series
_piserShared Maybe Formula
_piserVal [Element]
pr []
    where
      pr :: [Element]
pr = [Element]
dPts forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToElement a => Name -> a -> Element
toElement Name
"dLbls") Maybe DataLblProps
_piserDataLblProps)
      dPts :: [Element]
dPts = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. ToAttrVal a => a -> DataPoint -> Element
dPtEl [(Int
0 :: Int) ..] [DataPoint]
_piserDataPoints
      dPtEl :: a -> DataPoint -> Element
dPtEl a
i DataPoint {Maybe ShapeProperties
Maybe DataMarker
_dpShapeProperties :: Maybe ShapeProperties
_dpMarker :: Maybe DataMarker
_dpShapeProperties :: DataPoint -> Maybe ShapeProperties
_dpMarker :: DataPoint -> Maybe DataMarker
..} =
        Name -> [Element] -> Element
elementListSimple
          Name
"dPt"
          (forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"idx" a
i forall a. a -> [a] -> [a]
:
           forall a. [Maybe a] -> [a]
catMaybes
             [ forall a. ToElement a => Name -> a -> Element
toElement Name
"marker" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataMarker
_dpMarker
             , forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShapeProperties
_dpShapeProperties
             ])

instance ToElement ScatterSeries where
  toElement :: Name -> ScatterSeries -> Element
toElement Name
nm ScatterSeries {Maybe Bool
Maybe Formula
Maybe DataLblProps
Maybe DataMarker
Series
_scserSmooth :: Maybe Bool
_scserYVal :: Maybe Formula
_scserXVal :: Maybe Formula
_scserDataLblProps :: Maybe DataLblProps
_scserMarker :: Maybe DataMarker
_scserShared :: Series
_scserSmooth :: ScatterSeries -> Maybe Bool
_scserYVal :: ScatterSeries -> Maybe Formula
_scserXVal :: ScatterSeries -> Maybe Formula
_scserDataLblProps :: ScatterSeries -> Maybe DataLblProps
_scserMarker :: ScatterSeries -> Maybe DataMarker
_scserShared :: ScatterSeries -> Series
..} =
    Element
serEl {elementNodes :: [Node]
elementNodes = Element -> [Node]
elementNodes Element
serEl forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [Element]
elements}
    where
      serEl :: Element
serEl = forall a. ToElement a => Name -> a -> Element
toElement Name
nm Series
_scserShared
      elements :: [Element]
elements =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToElement a => Name -> a -> Element
toElement Name
"marker" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataMarker
_scserMarker
          , forall a. ToElement a => Name -> a -> Element
toElement Name
"dLbls" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataLblProps
_scserDataLblProps
          ] forall a. [a] -> [a] -> [a]
++
        [forall {a}. ToElement a => Name -> Maybe a -> Element
valEl Name
"xVal" Maybe Formula
_scserXVal, forall {a}. ToElement a => Name -> Maybe a -> Element
valEl Name
"yVal" Maybe Formula
_scserYVal] forall a. [a] -> [a] -> [a]
++
        (forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"smooth") Maybe Bool
_scserSmooth)
      valEl :: Name -> Maybe a -> Element
valEl Name
vnm Maybe a
v =
        Name -> [Element] -> Element
elementListSimple
          Name
vnm
          [Name -> [Element] -> Element
elementListSimple Name
"numRef" forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList (forall a. ToElement a => Name -> a -> Element
toElement Name
"f" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
v)]

-- should we respect idx and order?
instance ToElement Series where
  toElement :: Name -> Series -> Element
toElement Name
nm Series {Maybe ShapeProperties
Maybe Formula
_serShapeProperties :: Maybe ShapeProperties
_serTx :: Maybe Formula
_serShapeProperties :: Series -> Maybe ShapeProperties
_serTx :: Series -> Maybe Formula
..} =
    Name -> [Element] -> Element
elementListSimple Name
nm forall a b. (a -> b) -> a -> b
$
    [ Name -> [Element] -> Element
elementListSimple
        Name
"tx"
        [Name -> [Element] -> Element
elementListSimple Name
"strRef" forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList (forall a. ToElement a => Name -> a -> Element
toElement Name
"f" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Formula
_serTx)]
    ] forall a. [a] -> [a] -> [a]
++
    forall a. Maybe a -> [a]
maybeToList (forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShapeProperties
_serShapeProperties)

instance ToElement ChartTitle where
  toElement :: Name -> ChartTitle -> Element
toElement Name
nm (ChartTitle Maybe TextBody
body) =
    Name -> [Element] -> Element
elementListSimple Name
nm [Element
txEl, forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"overlay" Bool
False]
    where
      txEl :: Element
txEl = Name -> [Element] -> Element
elementListSimple Name
"tx" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
c_ Text
"rich") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TextBody
body]

instance ToElement Legend where
  toElement :: Name -> Legend -> Element
toElement Name
nm Legend{Maybe Bool
Maybe LegendPos
_legendOverlay :: Maybe Bool
_legendPos :: Maybe LegendPos
_legendOverlay :: Legend -> Maybe Bool
_legendPos :: Legend -> Maybe LegendPos
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
       elements :: [Element]
elements = forall a. [Maybe a] -> [a]
catMaybes [ forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"legendPos" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LegendPos
_legendPos
                            , forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"overlay" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Maybe Bool
_legendOverlay]

instance ToAttrVal LegendPos where
  toAttrVal :: LegendPos -> Text
toAttrVal LegendPos
LegendBottom   = Text
"b"
  toAttrVal LegendPos
LegendLeft     = Text
"l"
  toAttrVal LegendPos
LegendRight    = Text
"r"
  toAttrVal LegendPos
LegendTop      = Text
"t"
  toAttrVal LegendPos
LegendTopRight = Text
"tr"

instance ToAttrVal DispBlanksAs where
  toAttrVal :: DispBlanksAs -> Text
toAttrVal DispBlanksAs
DispBlanksAsGap  = Text
"gap"
  toAttrVal DispBlanksAs
DispBlanksAsSpan = Text
"span"
  toAttrVal DispBlanksAs
DispBlanksAsZero = Text
"zero"

instance ToAttrVal TickMark where
  toAttrVal :: TickMark -> Text
toAttrVal TickMark
TickMarkCross = Text
"cross"
  toAttrVal TickMark
TickMarkIn = Text
"in"
  toAttrVal TickMark
TickMarkNone = Text
"none"
  toAttrVal TickMark
TickMarkOut = Text
"out"

-- | Add chart namespace to name
c_ :: Text -> Name
c_ :: Text -> Name
c_ Text
x =
  Name {nameLocalName :: Text
nameLocalName = Text
x, nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
chartNs, namePrefix :: Maybe Text
namePrefix = forall a. a -> Maybe a
Just Text
"c"}

chartNs :: Text
chartNs :: Text
chartNs = Text
"http://schemas.openxmlformats.org/drawingml/2006/chart"