module Codec.Xlsx.Writer.Internal.PivotTable
( PivotTableFiles(..)
, renderPivotTableFiles
) where
import Data.ByteString.Lazy (ByteString)
import Data.List.Extra (nubOrd)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Text (Text)
import GHC.Generics (Generic)
import Safe (fromJustNote)
import Text.XML
import Codec.Xlsx.Types.Cell
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.PivotTable
import Codec.Xlsx.Types.PivotTable.Internal
import Codec.Xlsx.Writer.Internal
data PivotTableFiles = PivotTableFiles
{ pvtfTable :: ByteString
, pvtfCacheDefinition :: ByteString
} deriving (Eq, Show, Generic)
data CacheDefinition = CacheDefinition
{ cdSourceRef :: CellRef
, cdSourceSheet :: Text
, cdFields :: [CacheField]
} deriving (Eq, Show, Generic)
renderPivotTableFiles :: CellMap -> Int -> PivotTable -> PivotTableFiles
renderPivotTableFiles cm cacheId t = PivotTableFiles {..}
where
pvtfTable = renderLBS def $ ptDefinitionDocument cacheId cache t
cache = generateCache cm t
pvtfCacheDefinition = renderLBS def $ toDocument cache
ptDefinitionDocument :: Int -> CacheDefinition -> PivotTable -> Document
ptDefinitionDocument cacheId cache t =
documentFromElement "Pivot table generated by xlsx" $
ptDefinitionElement "pivotTableDefinition" cacheId cache t
ptDefinitionElement :: Name -> Int -> CacheDefinition -> PivotTable -> Element
ptDefinitionElement nm cacheId cache PivotTable {..} =
elementList nm attrs elements
where
attrs =
catMaybes
[ "colGrandTotals" .=? justFalse _pvtColumnGrandTotals
, "rowGrandTotals" .=? justFalse _pvtRowGrandTotals
, "outline" .=? justTrue _pvtOutline
, "outlineData" .=? justTrue _pvtOutlineData
] ++
[ "name" .= _pvtName
, "dataCaption" .= _pvtDataCaption
, "cacheId" .= cacheId
, "dataOnRows" .= (DataPosition `elem` _pvtRowFields)
]
elements = [location, pivotFields, rowFields, colFields, dataFields]
location =
leafElement
"location"
[ "ref" .= _pvtLocation
, "firstHeaderRow" .= (1 :: Int)
, "firstDataRow" .= (2 :: Int)
, "firstDataCol" .= (1 :: Int)
]
name2x = M.fromList $ zip (map _pfiName _pvtFields) [0 ..]
mapFieldToX f = fromJustNote "no field" $ M.lookup f name2x
pivotFields = elementListSimple "pivotFields" $ map pFieldEl _pvtFields
pFieldEl PivotFieldInfo { _pfiName = fName
, _pfiOutline = outline
, _pfiSortType = sortType
, _pfiHiddenItems = hidden
}
| FieldPosition fName `elem` _pvtRowFields =
pFieldEl' fName outline ("axisRow" :: Text) hidden sortType
| FieldPosition fName `elem` _pvtColumnFields =
pFieldEl' fName outline ("axisCol" :: Text) hidden sortType
| otherwise =
leafElement
"pivotField"
[ "name" .= fName
, "dataField" .= True
, "showAll" .= False
, "outline" .= outline
]
pFieldEl' fName outline axis hidden sortType =
elementList
"pivotField"
([ "name" .= fName
, "axis" .= axis
, "showAll" .= False
, "outline" .= outline
] ++
catMaybes ["sortType" .=? justNonDef FieldSortManual sortType])
[ elementListSimple "items" $
items fName hidden ++
[leafElement "item" ["t" .= ("default" :: Text)]]
]
items fName hidden =
[ itemEl x item hidden
| (x, item) <- zip [0 ..] . fromMaybe [] $ M.lookup fName cachedItems
]
itemEl x item hidden =
leafElement "item" $
["x" .= (x :: Int)] ++ catMaybes ["h" .=? justTrue (item `elem` hidden)]
cachedItems =
M.fromList $ [(cfName, cfItems) | CacheField {..} <- cdFields cache]
rowFields =
elementListSimple "rowFields" . map fieldEl $
if length _pvtDataFields > 1
then _pvtRowFields
else filter (/= DataPosition) _pvtRowFields
colFields = elementListSimple "colFields" $ map fieldEl _pvtColumnFields
fieldEl p = leafElement "field" ["x" .= fieldPos p]
fieldPos DataPosition = (2) :: Int
fieldPos (FieldPosition f) = mapFieldToX f
dataFields = elementListSimple "dataFields" $ map dFieldEl _pvtDataFields
dFieldEl DataField {..} =
leafElement "dataField" $
catMaybes
[ "name" .=? Just _dfName
, "fld" .=? Just (mapFieldToX _dfField)
, "subtotal" .=? justNonDef ConsolidateSum _dfFunction
]
generateCache :: CellMap -> PivotTable -> CacheDefinition
generateCache cm PivotTable {..} =
CacheDefinition
{ cdSourceRef = _pvtSrcRef
, cdSourceSheet = _pvtSrcSheet
, cdFields = cachedFields
}
where
cachedFields = map (cache . _pfiName) _pvtFields
cache name =
CacheField
{ cfName = name
, cfItems =
fromJustNote "specified pivot table field does not exist" $
M.lookup name itemsByName
}
((r1, c1), (r2, c2)) =
fromJustNote "Invalid src ref of pivot table " $ fromRange _pvtSrcRef
getCellValue ix = M.lookup ix cm >>= _cellValue
itemsByName =
M.fromList $
flip mapMaybe [c1 .. c2] $ \c -> do
CellText nm <- getCellValue (r1, c)
let values = mapMaybe (\r -> getCellValue (r, c)) [(r1 + 1) .. r2]
return (PivotFieldName nm, nubOrd values)
instance ToDocument CacheDefinition where
toDocument =
documentFromElement "Pivot cache definition generated by xlsx" .
toElement "pivotCacheDefinition"
instance ToElement CacheDefinition where
toElement nm CacheDefinition {..} = elementList nm attrs elements
where
attrs = ["invalid" .= True, "refreshOnLoad" .= True]
elements = [worksheetSource, cacheFields]
worksheetSource =
elementList
"cacheSource"
["type" .= ("worksheet" :: Text)]
[ leafElement
"worksheetSource"
["ref" .= cdSourceRef, "sheet" .= cdSourceSheet]
]
cacheFields =
elementListSimple "cacheFields" $ map (toElement "cacheField") cdFields