content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE DeriveGeneric #-}
  module Codec.Xlsx.Parser.Internal.PivotTable
    ( parsePivotTable
    , parseCache
    , fillCacheFieldsFromRecords
    ) where
  
  import Control.Applicative
  import Data.ByteString.Lazy (ByteString)
  import Data.List (transpose)
  import Data.Maybe (listToMaybe, mapMaybe, maybeToList)
  import Data.Text (Text)
  import Safe (atMay)
  import Text.XML
  import Text.XML.Cursor
  
  import Codec.Xlsx.Parser.Internal
  import Codec.Xlsx.Types.Common
  import Codec.Xlsx.Types.Internal
  import Codec.Xlsx.Types.Internal.Relationships (odr)
  import Codec.Xlsx.Types.PivotTable
  import Codec.Xlsx.Types.PivotTable.Internal
  
  parsePivotTable
    :: (CacheId -> Maybe (Text, Range, [CacheField]))
    -> ByteString
    -> Maybe PivotTable
  parsePivotTable srcByCacheId bs =
    listToMaybe . parse . fromDocument $ parseLBS_ def bs
    where
      parse cur = do
        cacheId <- fromAttribute "cacheId" cur
        case srcByCacheId cacheId of
          Nothing -> fail "no such cache"
          Just (_pvtSrcSheet, _pvtSrcRef, cacheFields) -> do
            _pvtDataCaption <- attribute "dataCaption" cur
            _pvtName <- attribute "name" cur
            _pvtLocation <- cur $/ element (addSmlNamespace "location") >=> fromAttribute "ref"
            _pvtRowGrandTotals <- fromAttributeDef "rowGrandTotals" True cur
            _pvtColumnGrandTotals <- fromAttributeDef "colGrandTotals" True cur
            _pvtOutline <- fromAttributeDef "outline" False cur
            _pvtOutlineData <- fromAttributeDef "outlineData" False cur
            let pvtFieldsWithHidden =
                  cur $/ element (addSmlNamespace "pivotFields") &/ element (addSmlNamespace "pivotField") >=> \c -> do
                    -- actually gets overwritten from cache to have consistent field names
                    _pfiName <- maybeAttribute "name" c
                    _pfiSortType <- fromAttributeDef "sortType" FieldSortManual c
                    _pfiOutline <- fromAttributeDef "outline" True c
                    let hidden =
                          c $/ element (addSmlNamespace "items") &/ element (addSmlNamespace "item") >=>
                          attrValIs "h" True >=> fromAttribute "x"
                        _pfiHiddenItems = []
                    return (PivotFieldInfo {..}, hidden)
                _pvtFields = flip map (zip [0.. ] pvtFieldsWithHidden) $
                             \(i, (PivotFieldInfo {..}, hidden)) ->
                               let  _pfiHiddenItems =
                                      [item | (n, item) <- zip [(0 :: Int) ..] items, n `elem` hidden]
                                    (_pfiName, items) = case atMay cacheFields i of
                                      Just CacheField{..} -> (Just cfName, cfItems)
                                      Nothing -> (Nothing, [])
                               in PivotFieldInfo {..}
                nToFieldName = zip [0 ..] $ map cfName cacheFields
                fieldNameList fld = maybeToList $ lookup fld nToFieldName
                _pvtRowFields =
                  cur $/ element (addSmlNamespace "rowFields") &/ element (addSmlNamespace "field") >=>
                  fromAttribute "x" >=> fieldPosition
                _pvtColumnFields =
                  cur $/ element (addSmlNamespace "colFields") &/ element (addSmlNamespace "field") >=>
                  fromAttribute "x" >=> fieldPosition
                _pvtDataFields =
                  cur $/ element (addSmlNamespace "dataFields") &/ element (addSmlNamespace "dataField") >=> \c -> do
                    fld <- fromAttribute "fld" c
                    _dfField <- fieldNameList fld
                    -- TOFIX
                    _dfName <- fromAttributeDef "name" "" c
                    _dfFunction <- fromAttributeDef "subtotal" ConsolidateSum c
                    return DataField {..}
                fieldPosition :: Int -> [PositionedField]
                fieldPosition (-2) = return DataPosition
                fieldPosition n =
                  FieldPosition <$> fieldNameList n
            return PivotTable {..}
  
  parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
  parseCache bs = listToMaybe . parse . fromDocument $ parseLBS_ def bs
    where
      parse cur = do
        refId <- maybeAttribute (odr "id") cur
        (sheet, ref) <-
          cur $/ element (addSmlNamespace "cacheSource") &/ element (addSmlNamespace "worksheetSource") >=>
          liftA2 (,) <$> attribute "sheet" <*> fromAttribute "ref"
        let fields =
              cur $/ element (addSmlNamespace "cacheFields") &/ element (addSmlNamespace "cacheField") >=>
              fromCursor
        return (sheet, ref, fields, refId)
  
  fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField]
  fillCacheFieldsFromRecords fields recs =
    zipWith addValues fields (transpose recs)
    where
      addValues field recVals =
        if null (cfItems field)
          then field {cfItems = mapMaybe recToCellValue recVals}
          else field
      recToCellValue (CacheText t) = Just $ CellText t
      recToCellValue (CacheNumber n) = Just $ CellDouble n
      recToCellValue (CacheIndex _) = Nothing
  