{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Writer.Internal.PivotTable
( PivotTableFiles(..)
, renderPivotTableFiles
) where
import Data.ByteString.Lazy (ByteString)
import Data.List (elemIndex, transpose)
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.Internal
import Codec.Xlsx.Types.Internal.Relationships (odr)
import Codec.Xlsx.Types.PivotTable
import Codec.Xlsx.Types.PivotTable.Internal
import Codec.Xlsx.Writer.Internal
data PivotTableFiles = PivotTableFiles
{ pvtfTable :: ByteString
, pvtfCacheDefinition :: ByteString
, pvtfCacheRecords :: 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
(cacheDoc, cacheRecordsDoc) = writeCache cache
pvtfCacheDefinition = renderLBS def cacheDoc
pvtfCacheRecords = renderLBS def cacheRecordsDoc
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 (mapMaybe _pfiName _pvtFields) [0 ..]
mapFieldToX f = fromJustNote "no field" $ M.lookup f name2x
pivotFields = elementListSimple "pivotFields" $ map pFieldEl _pvtFields
maybeFieldIn Nothing _ = False
maybeFieldIn (Just name) positions = FieldPosition name `elem` positions
pFieldEl PivotFieldInfo { _pfiName = fName
, _pfiOutline = outline
, _pfiSortType = sortType
, _pfiHiddenItems = hidden
}
| fName `maybeFieldIn` _pvtRowFields =
pFieldEl' fName outline ("axisRow" :: Text) hidden sortType
| fName `maybeFieldIn` _pvtColumnFields =
pFieldEl' fName outline ("axisCol" :: Text) hidden sortType
| otherwise =
leafElement "pivotField" $
[ "dataField" .= True
, "showAll" .= False
, "outline" .= outline] ++
catMaybes ["name" .=? fName]
pFieldEl' fName outline axis hidden sortType =
elementList
"pivotField"
([ "axis" .= axis
, "showAll" .= False
, "outline" .= outline
] ++
catMaybes [ "name" .=? fName
, "sortType" .=? justNonDef FieldSortManual sortType])
[ elementListSimple "items" $
items fName hidden ++
[leafElement "item" ["t" .= ("default" :: Text)]]
]
items Nothing _ = []
items (Just 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 = mapMaybe (fmap 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)
writeCache :: CacheDefinition -> (Document, Document)
writeCache CacheDefinition {..} = (cacheDefDoc, cacheRecordsDoc)
where
cacheDefDoc =
documentFromElement "Pivot cache definition generated by xlsx" $
elementList "pivotCacheDefinition" attrs elements
attrs = ["invalid" .= True, "refreshOnLoad" .= True, odr "id" .= unsafeRefId 1]
elements = [worksheetSource, cacheFields]
worksheetSource =
elementList
"cacheSource"
["type" .= ("worksheet" :: Text)]
[ leafElement
"worksheetSource"
["ref" .= cdSourceRef, "sheet" .= cdSourceSheet]
]
cacheFields =
elementListSimple "cacheFields" $ map (toElement "cacheField") cdFields
cacheRecordsDoc =
documentFromElement "Pivot cache records generated by xlsx" .
elementListSimple "pivotCacheRecords" $
map (elementListSimple "r" . map recordValueToEl) cacheRecords
recordValueToEl (CacheText t) = leafElement "s" ["v" .= t]
recordValueToEl (CacheNumber n) = leafElement "n" ["v" .= n]
recordValueToEl (CacheIndex i) = leafElement "x" ["v" .= i]
cacheRecords = transpose $ map (itemsToRecordValues . cfItems) cdFields
itemsToRecordValues vals =
if all isText vals
then indexes vals
else map itemToRecordValue vals
isText (CellText _) = True
isText _ = False
indexes vals =
[ CacheIndex . fromJustNote "inconsistend definition" $ elemIndex v vals
| v <- vals
]
itemToRecordValue (CellDouble d) = CacheNumber d
itemToRecordValue (CellText t) = CacheText t
itemToRecordValue v = error $ "Unsupported value for pivot tables: " ++ show v