module Codec.Xlsx.Writer.Internal.PivotTable
( PivotTableFiles(..)
, renderPivotTableFiles
) where
import Data.ByteString.Lazy (ByteString)
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Safe (fromJustNote)
import Text.XML
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.PivotTable
import Codec.Xlsx.Writer.Internal
data PivotTableFiles = PivotTableFiles
{ pvtfTable :: ByteString
, pvtfCacheDefinition :: ByteString
} deriving (Eq, Show)
newtype CacheField =
CacheField Text
deriving (Eq, Show)
data CacheDefinition = CacheDefinition
{ cdSourceRef :: CellRef
, cdSourceSheet :: Text
, cdFields :: [CacheField]
} deriving (Eq, Show)
renderPivotTableFiles :: Int -> PivotTable -> PivotTableFiles
renderPivotTableFiles cacheId t = PivotTableFiles {..}
where
pvtfTable = renderLBS def $ ptDefinitionDocument cacheId t
cacheDefinition = generateCache t
pvtfCacheDefinition = renderLBS def $ toDocument cacheDefinition
ptDefinitionDocument :: Int -> PivotTable -> Document
ptDefinitionDocument cacheId t =
documentFromElement "Pivot table generated by xlsx" $
ptDefinitionElement "pivotTableDefinition" cacheId t
ptDefinitionElement :: Name -> Int -> PivotTable -> Element
ptDefinitionElement nm cacheId 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}
| FieldPosition fName `elem` _pvtRowFields =
pFieldEl' fName outline ("axisRow" :: Text)
| FieldPosition fName `elem` _pvtColumnFields =
pFieldEl' fName outline ("axisCol" :: Text)
| otherwise =
leafElement
"pivotField"
[ "name" .= fName
, "dataField" .= True
, "showAll" .= False
, "outline" .= outline
]
pFieldEl' fName outline axis =
elementList
"pivotField"
[ "name" .= fName
, "axis" .= axis
, "showAll" .= False
, "outline" .= outline
]
[ elementListSimple "items" $
[leafElement "item" ["t" .= ("default" :: Text)]]
]
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 :: PivotTable -> CacheDefinition
generateCache PivotTable {..} =
CacheDefinition
{ cdSourceRef = _pvtSrcRef
, cdSourceSheet = _pvtSrcSheet
, cdFields = cachedFields
}
where
cachedFields = map (cache . _pfiName) _pvtFields
cache (PivotFieldName name) = CacheField name
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
instance ToElement CacheField where
toElement nm (CacheField fieldName) = leafElement nm ["name" .= fieldName]