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

import           Data.Default
import           Data.Maybe                        (catMaybes, maybeToList)
import           Data.Text                         (Text)
import           Text.XML
import           Text.XML.Cursor

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

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
  { _chspTitle :: Maybe ChartTitle
  , _chspCharts :: [Chart]
  , _chspLegend :: Maybe Legend
  , _chspPlotVisOnly :: Maybe Bool
  , _chspDispBlanksAs :: Maybe DispBlanksAs
  } deriving (Eq, Show)

-- | Chart title
--
-- TODO: layout, overlay, spPr, txPr, extLst
newtype ChartTitle =
  ChartTitle TextBody
  deriving (Eq, Show)

-- | 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 (Eq, Show)

-- TODO: legendEntry, layout, overlay, spPr, txPr, extLst
data Legend = Legend
    { _legendPos     :: Maybe LegendPos
    , _legendOverlay :: Maybe Bool
    } deriving (Eq, Show)

-- 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 (Eq, Show)

-- | Specific Chart
-- TODO:
--   areaChart, area3DChart, line3DChart, stockChart, radarChart, scatterChart,
--   pieChart, pie3DChart, doughnutChart, barChart, bar3DChart, ofPieChart,
--   surfaceChart, surface3DChart, bubbleChart
data Chart = LineChart
  { _lnchGrouping :: ChartGrouping
  , _lnchSeries :: [LineSeries]
  , _lnchMarker :: Maybe Bool
    -- ^ specifies that the marker shall be shown
  , _lnchSmooth :: Maybe Bool
    -- ^ specifies the line connecting the points on the chart shall be
    -- smoothed using Catmull-Rom splines
  } deriving (Eq, Show)

-- | Possible groupings for a bar 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 (Eq, Show)

-- | Specifies common series options
-- TODO: spPr
--
-- See @EG_SerShared@ (p. 4063)
data Series = Series
  { _serTx :: Maybe Formula
    -- ^ specifies text for a series name, without rich text formatting
    -- currently only reference formula is supported
  } deriving (Eq, Show)

-- | A series on a line chart
--
-- TODO: dPt, trendline, errBars, cat, extLst
--
-- See @CT_LineSer@ (p. 4064)
data LineSeries = LineSeries
  { _lnserShared :: Series
  , _lnserMarker :: Maybe DataMarker
  , _lnserDataLblProps :: Maybe DataLblProps
  , _lnserVal :: Maybe Formula
    -- ^ currently only reference formula is supported
  , _lnserSmooth :: Maybe Bool
  } deriving (Eq, Show)

-- See @CT_Marker@ (p. 4061)
data DataMarker = DataMarker
  { _dmrkSymbol :: Maybe DataMarkerSymbol
  , _dmrkSize :: Maybe Int
    -- ^ integer between 2 and 72, specifying a size in points
  } deriving (Eq, Show)

data DataMarkerSymbol
  = DataMarkerCircle
  | DataMarkerDash
  | DataMarkerDiamond
  | DataMarkerDot
  | DataMarkerNone
  | DataMarkerPicture
  | DataMarkerPlus
  | DataMarkerSquare
  | DataMarkerStar
  | DataMarkerTriangle
  | DataMarkerX
  | DataMarkerAuto
  deriving (Eq, Show)

-- | 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
  { _dlblShowLegendKey :: Maybe Bool
  , _dlblShowVal :: Maybe Bool
  , _dlblShowCatName :: Maybe Bool
  , _dlblShowSerName :: Maybe Bool
  , _dlblShowPercent :: Maybe Bool
  } deriving (Eq, Show)

-- | 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 (Eq, Show)

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

instance FromCursor ChartSpace where
  fromCursor cur = do
    cur' <- cur $/ element (c_ "chart")
    _chspTitle <- maybeFromElement (c_ "title") cur'
    let _chspCharts =
          cur' $/ element (c_ "plotArea") &/ anyElement >=> chartFromNode . node
    _chspLegend <- maybeFromElement (c_ "legend") cur'
    _chspPlotVisOnly <- maybeBoolElementValue (c_ "plotVisOnly") cur'
    _chspDispBlanksAs <- maybeElementValue (c_ "dispBlanksAs") cur'
    return ChartSpace {..}

chartFromNode :: Node -> [Chart]
chartFromNode n
  | n `nodeElNameIs` (c_ "lineChart") = do
    _lnchGrouping <- fromElementValue (c_ "grouping") cur
    let _lnchSeries = cur $/ element (c_ "ser") >=> fromCursor
    _lnchMarker <- maybeBoolElementValue (c_ "marker") cur
    _lnchSmooth <- maybeBoolElementValue (c_ "smooth") cur
    return LineChart {..}
  | otherwise = fail "no matching chart node"
  where
    cur = fromNode n

instance FromCursor LineSeries where
  fromCursor cur = do
    _lnserShared <- fromCursor cur
    _lnserMarker <- maybeFromElement (c_ "marker") cur
    _lnserDataLblProps <- maybeFromElement (c_ "dLbls") cur
    _lnserVal <-
      cur $/ element (c_ "val") &/ element (c_ "numRef") >=>
      maybeFromElement (c_ "f")
    _lnserSmooth <- maybeElementValueDef (c_ "smooth") True cur
    return LineSeries {..}

-- should we respect idx and order?
instance FromCursor Series where
  fromCursor cur = do
    _serTx <-
      cur $/ element (c_ "tx") &/ element (c_ "strRef") >=>
      maybeFromElement (c_ "f")
    return Series {..}

instance FromCursor DataMarker where
  fromCursor cur = do
    _dmrkSymbol <- maybeElementValue (c_ "symbol") cur
    _dmrkSize <- maybeElementValue (c_ "size") cur
    return DataMarker {..}

instance FromAttrVal DataMarkerSymbol where
  fromAttrVal "circle" = readSuccess DataMarkerCircle
  fromAttrVal "dash" = readSuccess DataMarkerDash
  fromAttrVal "diamond" = readSuccess DataMarkerDiamond
  fromAttrVal "dot" = readSuccess DataMarkerDot
  fromAttrVal "none" = readSuccess DataMarkerNone
  fromAttrVal "picture" = readSuccess DataMarkerPicture
  fromAttrVal "plus" = readSuccess DataMarkerPlus
  fromAttrVal "square" = readSuccess DataMarkerSquare
  fromAttrVal "star" = readSuccess DataMarkerStar
  fromAttrVal "triangle" = readSuccess DataMarkerTriangle
  fromAttrVal "x" = readSuccess DataMarkerX
  fromAttrVal "auto" = readSuccess DataMarkerAuto
  fromAttrVal t = invalidText "DataMarkerSymbol" t

instance FromCursor DataLblProps where
  fromCursor cur = do
    _dlblShowLegendKey <- maybeBoolElementValue (c_ "showLegendKey") cur
    _dlblShowVal <- maybeBoolElementValue (c_ "showVal") cur
    _dlblShowCatName <- maybeBoolElementValue (c_ "showCatName") cur
    _dlblShowSerName <- maybeBoolElementValue (c_ "showSerName") cur
    _dlblShowPercent <- maybeBoolElementValue (c_ "showPercent") cur
    return DataLblProps {..}

instance FromAttrVal ChartGrouping where
  fromAttrVal "percentStacked" = readSuccess PercentStackedGrouping
  fromAttrVal "standard" = readSuccess StandardGrouping
  fromAttrVal "stacked" = readSuccess StackedGrouping
  fromAttrVal t = invalidText "ChartGrouping" t

instance FromCursor ChartTitle where
  fromCursor cur =
    cur $/ element (c_ "tx") &/ element (c_ "rich") >=> fmap ChartTitle . fromCursor

instance FromCursor Legend where
  fromCursor cur = do
    _legendPos <- maybeElementValue (c_ "legendPos") cur
    _legendOverlay <- maybeElementValueDef (c_ "overlay") True cur
    return Legend {..}

instance FromAttrVal LegendPos where
  fromAttrVal "b" = readSuccess LegendBottom
  fromAttrVal "l" = readSuccess LegendLeft
  fromAttrVal "r" = readSuccess LegendRight
  fromAttrVal "t" = readSuccess LegendTop
  fromAttrVal "tr" = readSuccess LegendTopRight
  fromAttrVal t = invalidText "LegendPos" t

instance FromAttrVal DispBlanksAs where
  fromAttrVal "gap" = readSuccess DispBlanksAsGap
  fromAttrVal "span" = readSuccess DispBlanksAsSpan
  fromAttrVal "zero" = readSuccess DispBlanksAsZero
  fromAttrVal t = invalidText "DispBlanksAs" t

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

instance Default Legend where
  def = Legend {_legendPos = Just LegendBottom, _legendOverlay = Just False}

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

instance ToDocument ChartSpace where
  toDocument =
    documentFromNsPrefElement "Charts generated by xlsx" chartNs (Just "c") .
    toElement "chartSpace"

instance ToElement ChartSpace where
  toElement nm ChartSpace {..} =
    elementListSimple nm [nonRounded, chartEl, chSpPr]
    where
      -- no such element gives a chart space with rounded corners
      nonRounded = elementValue "roundedCorners" False
      chSpPr = toElement "spPr" $ def {_spFill = Just SolidFill}
      chartEl = elementListSimple "chart" elements
      elements =
        catMaybes
          [ toElement "title" <$> _chspTitle
          -- LO?
          , Just $ elementValue "autoTitleDeleted" False
          , Just $ elementListSimple "plotArea" areaEls
          , toElement "legend" <$> _chspLegend
          , elementValue "plotVisOnly" <$> _chspPlotVisOnly
          , elementValue "dispBlanksAs" <$> _chspDispBlanksAs
          ]
      -- we reserve 2 axes - X and Y for line charts
      -- this needs to be reworked when other chart types will be added
      enumCharts = zip [1,3 ..] _chspCharts
      charts = [chartToElement ch i (i + 1) | (i, ch) <- enumCharts]
      areaEls = charts ++ valAxes ++ catAxes
      catAxes = [catAxEl i (i + 1) | (i, _) <- enumCharts]
      valAxes = [valAxEl (i + 1) i | (i, _) <- enumCharts]
      catAxEl :: Int -> Int -> Element
      catAxEl i cr =
        elementListSimple "catAx" $
        [ elementValue "axId" i
        , emptyElement "scaling"
        , elementValue "delete" False
        , elementValue "axPos" ("b" :: Text)
        , elementValue "majorTickMark" TickMarkNone
        , elementValue "minorTickMark" TickMarkNone
        , toElement "spPr" noFill
        , elementValue "crossAx" cr
        , elementValue "auto" True
        ]
      valAxEl :: Int -> Int -> Element
      valAxEl i cr =
        elementListSimple "valAx" $
        [ elementValue "axId" i
        , emptyElement "scaling"
        , elementValue "delete" False
        , elementValue "axPos" ("l" :: Text)
        , gridLinesEl
        , elementValue "majorTickMark" TickMarkNone
        , elementValue "minorTickMark" TickMarkNone
        , toElement "spPr" noFill
        , elementValue "crossAx" cr
        ]
      noFill =
        def
        { _spFill = Just NoFill
        , _spOutline = Just . LineProperties $ Just NoFill
        }
      gridLinesEl =
        elementListSimple "majorGridlines" [toElement "spPr" lineFill]
      lineFill = def { _spOutline = Just . LineProperties $ Just SolidFill }

chartToElement :: Chart -> Int -> Int -> Element
chartToElement LineChart {..} cId vId = elementListSimple "lineChart" elements
  where
    elements =
      (grouping : varyColors : series) ++
      catMaybes
        [ elementValue "marker" <$> _lnchMarker
        , elementValue "smooth" <$> _lnchSmooth
        ] ++
      map (elementValue "axId") [cId, vId]
    grouping = elementValue "grouping" _lnchGrouping
    -- no element seems to be equal to varyColors=true in Excel Online
    varyColors = elementValue "varyColors" False
    series = [indexedSeriesEl i s | (i, s) <- zip [0 ..] _lnchSeries]
    indexedSeriesEl :: Int -> LineSeries -> Element
    indexedSeriesEl i s = prependI i $ toElement "ser" s
    prependI i e@Element {..} = e {elementNodes = iNodes i ++ elementNodes}
    iNodes i = map NodeElement [elementValue n i | n <- ["idx", "order"]]

instance ToAttrVal ChartGrouping where
  toAttrVal PercentStackedGrouping = "percentStacked"
  toAttrVal StandardGrouping = "standard"
  toAttrVal StackedGrouping = "stacked"

instance ToElement LineSeries where
  toElement nm LineSeries {..} = serEl
      { elementNodes = elementNodes serEl ++
                     map NodeElement elements }
    where
      serEl = toElement nm _lnserShared
      elements =
        catMaybes
          [ toElement "marker" <$> _lnserMarker
          , toElement "dLbls" <$> _lnserDataLblProps
          , Just $ valEl _lnserVal
          , elementValue "smooth" <$> _lnserSmooth
          ]
      valEl v =
        elementListSimple
          "val"
          [elementListSimple "numRef" $ maybeToList (toElement "f" <$> v)]

instance ToElement DataMarker where
  toElement nm DataMarker {..} = elementListSimple nm elements
    where
      elements =
        catMaybes
          [ elementValue "symbol" <$> _dmrkSymbol
          , elementValue "size" <$> _dmrkSize
          ]

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

instance ToElement DataLblProps where
  toElement nm DataLblProps {..} = elementListSimple nm elements
    where
      elements =
        catMaybes
          [ elementValue "showLegendKey" <$> _dlblShowLegendKey
          , elementValue "showVal" <$> _dlblShowVal
          , elementValue "showCatName" <$> _dlblShowCatName
          , elementValue "showSerName" <$> _dlblShowSerName
          , elementValue "showPercent" <$> _dlblShowPercent
          ]

-- should we respect idx and order?
instance ToElement Series where
  toElement nm Series {..} =
    elementListSimple
      nm
      [ elementListSimple
          "tx"
          [elementListSimple "strRef" $ maybeToList (toElement "f" <$> _serTx)]
      ]

instance ToElement ChartTitle where
  toElement nm (ChartTitle body) =
    elementListSimple nm [txEl, elementValue "overlay" False]
    where
      txEl = elementListSimple "tx" [toElement (c_ "rich") body]

instance ToElement Legend where
  toElement nm Legend{..} = elementListSimple nm elements
    where
       elements = catMaybes [ elementValue "legendPos" <$> _legendPos
                            , elementValue "overlay" <$>_legendOverlay]

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

instance ToAttrVal DispBlanksAs where
  toAttrVal DispBlanksAsGap  = "gap"
  toAttrVal DispBlanksAsSpan = "span"
  toAttrVal DispBlanksAsZero = "zero"

instance ToAttrVal TickMark where
  toAttrVal TickMarkCross = "cross"
  toAttrVal TickMarkIn = "in"
  toAttrVal TickMarkNone = "none"
  toAttrVal TickMarkOut = "out"

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

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