{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} 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 -- TODO : set proper , "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]