    {-# 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 :: (CacheId -> Maybe (Text, CellRef, [CacheField]))
    -> ByteString -> Maybe PivotTable
    parsePivotTable CacheId -> Maybe (Text, CellRef, [CacheField])
    srcByCacheId ByteString
    bs =
      [PivotTable] -> Maybe PivotTable
    forall a. [a] -> Maybe a
    listToMaybe ([PivotTable] -> Maybe PivotTable)
    -> (Document -> [PivotTable]) -> Document -> Maybe PivotTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> [PivotTable]
    parse (Cursor -> [PivotTable])
    -> (Document -> Cursor) -> Document -> [PivotTable]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document -> Cursor
    fromDocument (Document -> Maybe PivotTable) -> Document -> Maybe PivotTable
    forall a b. (a -> b) -> a -> b
    $ ParseSettings -> ByteString -> Document
    parseLBS_ ParseSettings
    forall a. Default a => a
    def ByteString
    bs
      where
        parse :: Cursor -> [PivotTable]
    parse Cursor
    cur = do
          cacheId <- Name -> Cursor -> [CacheId]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "cacheId" Cursor
    cur
          case srcByCacheId cacheId of
            Maybe (Text, CellRef, [CacheField])
    Nothing -> String -> [PivotTable]
    forall a. String -> [a]
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "no such cache"
            Just (Text
    _pvtSrcSheet, CellRef
    _pvtSrcRef, [CacheField]
    cacheFields) -> do
              _pvtDataCaption <- Name -> Cursor -> [Text]
    attribute Name
    "dataCaption" Cursor
    cur
              _pvtName <- attribute "name" cur
              _pvtLocation <- cur $/ element (n_ "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 =
                    Cursor
    cur Cursor
    -> (Cursor -> [(PivotFieldInfo, [Int])])
    -> [(PivotFieldInfo, [Int])]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "pivotFields") Axis
    -> (Cursor -> [(PivotFieldInfo, [Int])])
    -> Cursor
    -> [(PivotFieldInfo, [Int])]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "pivotField") Axis
    -> (Cursor -> [(PivotFieldInfo, [Int])])
    -> Cursor
    -> [(PivotFieldInfo, [Int])]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> \Cursor
    c -> do
                      -- actually gets overwritten from cache to have consistent field names
                      _pfiName <- Name -> Cursor -> [Maybe PivotFieldName]
    forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute Name
    "name" Cursor
    c
                      _pfiSortType <- fromAttributeDef "sortType" FieldSortManual c
                      _pfiOutline <- fromAttributeDef "outline" True c
                      let hidden =
                            Cursor
    c Cursor -> (Cursor -> [Int]) -> [Int]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "items") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "item") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                            Name -> Bool -> Axis
    forall a. (Eq a, FromAttrVal a) => Name -> a -> Axis
    attrValIs Name
    "h" Bool
    True Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Name -> Cursor -> [Int]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "x"
                          _pfiHiddenItems = []
                      return (PivotFieldInfo {..}, hidden)
                  _pvtFields = (((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
     -> [(Int, (PivotFieldInfo, [Int]))] -> [PivotFieldInfo])
    -> [(Int, (PivotFieldInfo, [Int]))]
    -> ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
    -> [PivotFieldInfo]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
    -> [(Int, (PivotFieldInfo, [Int]))] -> [PivotFieldInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int]
    -> [(PivotFieldInfo, [Int])] -> [(Int, (PivotFieldInfo, [Int]))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0.. ] [(PivotFieldInfo, [Int])]
    pvtFieldsWithHidden) (((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
     -> [PivotFieldInfo])
    -> ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
    -> [PivotFieldInfo]
    forall a b. (a -> b) -> a -> b
    $
                               \(Int
    i, (PivotFieldInfo {Bool
    [CellValue]
    Maybe PivotFieldName
    FieldSortType
    _pfiHiddenItems :: PivotFieldInfo -> [CellValue]
    _pfiSortType :: PivotFieldInfo -> FieldSortType
    _pfiOutline :: PivotFieldInfo -> Bool
    _pfiName :: PivotFieldInfo -> Maybe PivotFieldName
    _pfiName :: Maybe PivotFieldName
    _pfiOutline :: Bool
    _pfiSortType :: FieldSortType
    _pfiHiddenItems :: [CellValue]
    ..}, [Int]
    hidden)) ->
                                 let  _pfiHiddenItems :: [CellValue]
    _pfiHiddenItems =
                                        [CellValue
    item | (Int
    n, CellValue
    item) <- [Int] -> [CellValue] -> [(Int, CellValue)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Int
    0 :: Int) ..] [CellValue]
    items, Int
    n Int -> [Int] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int]
    hidden]
                                      (Maybe PivotFieldName
    _pfiName, [CellValue]
    items) = case [CacheField] -> Int -> Maybe CacheField
    forall a. [a] -> Int -> Maybe a
    atMay [CacheField]
    cacheFields Int
    i of
                                        Just CacheField{[CellValue]
    PivotFieldName
    cfName :: PivotFieldName
    cfItems :: [CellValue]
    cfItems :: CacheField -> [CellValue]
    cfName :: CacheField -> PivotFieldName
    ..} -> (PivotFieldName -> Maybe PivotFieldName
    forall a. a -> Maybe a
    Just PivotFieldName
    cfName, [CellValue]
    cfItems)
                                        Maybe CacheField
    Nothing -> (Maybe PivotFieldName
    forall a. Maybe a
    Nothing, [])
                                 in PivotFieldInfo {Bool
    [CellValue]
    Maybe PivotFieldName
    FieldSortType
    _pfiHiddenItems :: [CellValue]
    _pfiSortType :: FieldSortType
    _pfiOutline :: Bool
    _pfiName :: Maybe PivotFieldName
    _pfiOutline :: Bool
    _pfiSortType :: FieldSortType
    _pfiHiddenItems :: [CellValue]
    _pfiName :: Maybe PivotFieldName
    ..}
                  nToFieldName = [Int] -> [PivotFieldName] -> [(Int, PivotFieldName)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0 ..] ([PivotFieldName] -> [(Int, PivotFieldName)])
    -> [PivotFieldName] -> [(Int, PivotFieldName)]
    forall a b. (a -> b) -> a -> b
    $ (CacheField -> PivotFieldName) -> [CacheField] -> [PivotFieldName]
    forall a b. (a -> b) -> [a] -> [b]
    map CacheField -> PivotFieldName
    cfName [CacheField]
    cacheFields
                  fieldNameList Int
    fld = Maybe PivotFieldName -> [PivotFieldName]
    forall a. Maybe a -> [a]
    maybeToList (Maybe PivotFieldName -> [PivotFieldName])
    -> Maybe PivotFieldName -> [PivotFieldName]
    forall a b. (a -> b) -> a -> b
    $ Int -> [(Int, PivotFieldName)] -> Maybe PivotFieldName
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Int
    fld [(Int, PivotFieldName)]
    nToFieldName
                  _pvtRowFields =
                    Cursor
    cur Cursor -> (Cursor -> [PositionedField]) -> [PositionedField]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "rowFields") Axis
    -> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "field") Axis
    -> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                    Name -> Cursor -> [Int]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "x" (Cursor -> [Int])
    -> (Int -> [PositionedField]) -> Cursor -> [PositionedField]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Int -> [PositionedField]
    fieldPosition
                  _pvtColumnFields =
                    Cursor
    cur Cursor -> (Cursor -> [PositionedField]) -> [PositionedField]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "colFields") Axis
    -> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "field") Axis
    -> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                    Name -> Cursor -> [Int]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "x" (Cursor -> [Int])
    -> (Int -> [PositionedField]) -> Cursor -> [PositionedField]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Int -> [PositionedField]
    fieldPosition
                  _pvtDataFields =
                    Cursor
    cur Cursor -> (Cursor -> [DataField]) -> [DataField]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "dataFields") Axis -> (Cursor -> [DataField]) -> Cursor -> [DataField]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "dataField") Axis -> (Cursor -> [DataField]) -> Cursor -> [DataField]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> \Cursor
    c -> do
                      fld <- Name -> Cursor -> [Int]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "fld" Cursor
    c
                      _dfField <- fieldNameList fld
                      -- TOFIX
                      _dfName <- fromAttributeDef "name" "" c
                      _dfFunction <- fromAttributeDef "subtotal" ConsolidateSum c
                      return DataField {..}
                  fieldPosition :: Int -> [PositionedField]
                  fieldPosition (-2) = PositionedField -> [PositionedField]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return PositionedField
    DataPosition
                  fieldPosition Int
    n =
                    PivotFieldName -> PositionedField
    FieldPosition (PivotFieldName -> PositionedField)
    -> [PivotFieldName] -> [PositionedField]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> [PivotFieldName]
    fieldNameList Int
    n
              return PivotTable {..}

    parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
    parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
    parseCache ByteString
    bs = [(Text, CellRef, [CacheField], Maybe RefId)]
    -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
    forall a. [a] -> Maybe a
    listToMaybe ([(Text, CellRef, [CacheField], Maybe RefId)]
     -> Maybe (Text, CellRef, [CacheField], Maybe RefId))
    -> (Document -> [(Text, CellRef, [CacheField], Maybe RefId)])
    -> Document
    -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> [(Text, CellRef, [CacheField], Maybe RefId)]
    forall {a} {b} {a}.
    (FromAttrVal a, FromAttrVal b, FromCursor a) =>
    Cursor -> [(Text, b, [a], Maybe a)]
    parse (Cursor -> [(Text, CellRef, [CacheField], Maybe RefId)])
    -> (Document -> Cursor)
    -> Document
    -> [(Text, CellRef, [CacheField], Maybe RefId)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document -> Cursor
    fromDocument (Document -> Maybe (Text, CellRef, [CacheField], Maybe RefId))
    -> Document -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
    forall a b. (a -> b) -> a -> b
    $ ParseSettings -> ByteString -> Document
    parseLBS_ ParseSettings
    forall a. Default a => a
    def ByteString
    bs
      where
        parse :: Cursor -> [(Text, b, [a], Maybe a)]
    parse Cursor
    cur = do
          refId <- Name -> Cursor -> [Maybe a]
    forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute (Text -> Name
    odr Text
    "id") Cursor
    cur
          (sheet, ref) <-
            cur $/ element (n_ "cacheSource") &/ element (n_ "worksheetSource") >=>
            liftA2 (,) <$> attribute "sheet" <*> fromAttribute "ref"
          let fields =
                Cursor
    cur Cursor -> (Cursor -> [a]) -> [a]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "cacheFields") Axis -> (Cursor -> [a]) -> Cursor -> [a]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "cacheField") Axis -> (Cursor -> [a]) -> Cursor -> [a]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                Cursor -> [a]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor
          return (sheet, ref, fields, refId)

    fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField]
    fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField]
    fillCacheFieldsFromRecords [CacheField]
    fields [CacheRecord]
    recs =
      (CacheField -> CacheRecord -> CacheField)
    -> [CacheField] -> [CacheRecord] -> [CacheField]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith CacheField -> CacheRecord -> CacheField
    addValues [CacheField]
    fields ([CacheRecord] -> [CacheRecord]
    forall a. [[a]] -> [[a]]
    transpose [CacheRecord]
    recs)
      where
        addValues :: CacheField -> CacheRecord -> CacheField
    addValues CacheField
    field CacheRecord
    recVals =
          if [CellValue] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (CacheField -> [CellValue]
    cfItems CacheField
    field)
            then CacheField
    field {cfItems = mapMaybe recToCellValue recVals}
            else CacheField
    field
        recToCellValue :: CacheRecordValue -> Maybe CellValue
    recToCellValue (CacheText Text
    t) = CellValue -> Maybe CellValue
    forall a. a -> Maybe a
    Just (CellValue -> Maybe CellValue) -> CellValue -> Maybe CellValue
    forall a b. (a -> b) -> a -> b
    $ Text -> CellValue
    CellText Text
    t
        recToCellValue (CacheNumber Double
    n) = CellValue -> Maybe CellValue
    forall a. a -> Maybe a
    Just (CellValue -> Maybe CellValue) -> CellValue -> Maybe CellValue
    forall a b. (a -> b) -> a -> b
    $ Double -> CellValue
    CellDouble Double
    n
        recToCellValue (CacheIndex Int
    _) = Maybe CellValue
    forall a. Maybe a
    Nothing