{-# 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