{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE DeriveGeneric #-} -- | This module provides a function for serializing structured `Xlsx` into lazy bytestring module Codec.Xlsx.Writer ( fromXlsx ) where import qualified "zip-archive" Codec.Archive.Zip as Zip import Control.Arrow (second) #ifdef USE_MICROLENS import Lens.Micro #else import Control.Lens hiding (transform, (.=)) #endif import Control.Monad (forM) import Control.Monad.ST import Control.Monad.State (evalState, get, put) import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8 () import Data.List (foldl', mapAccumL) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import Data.Monoid ((<>)) import Data.STRef import Data.Text (Text) import qualified Data.Text as T import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) import Data.Time.Format (formatTime) import Data.Time.Format (defaultTimeLocale) import Data.Tuple.Extra (fst3, snd3, thd3) import GHC.Generics (Generic) import Safe import Text.XML import Codec.Xlsx.Types import Codec.Xlsx.Types.Cell (applySharedFormulaOpts) import Codec.Xlsx.Types.Internal import Codec.Xlsx.Types.Internal.CfPair import qualified Codec.Xlsx.Types.Internal.CommentTable as CommentTable import Codec.Xlsx.Types.Internal.CustomProperties import Codec.Xlsx.Types.Internal.DvPair import Codec.Xlsx.Types.Internal.Relationships as Relationships hiding (lookup) import Codec.Xlsx.Types.Internal.SharedStringTable import Codec.Xlsx.Types.PivotTable.Internal import Codec.Xlsx.Writer.Internal import Codec.Xlsx.Writer.Internal.PivotTable -- | Writes `Xlsx' to raw data (lazy bytestring) fromXlsx :: POSIXTime -> Xlsx -> L.ByteString fromXlsx pt xlsx = Zip.fromArchive $ foldr Zip.addEntryToArchive Zip.emptyArchive entries where t = round pt utcTime = posixSecondsToUTCTime pt entries = Zip.toEntry "[Content_Types].xml" t (contentTypesXml files) : map (\fd -> Zip.toEntry (fdPath fd) t (fdContents fd)) files files = workbookFiles ++ customPropFiles ++ [ FileData "docProps/core.xml" "application/vnd.openxmlformats-package.core-properties+xml" "metadata/core-properties" $ coreXml utcTime "xlsxwriter" , FileData "docProps/app.xml" "application/vnd.openxmlformats-officedocument.extended-properties+xml" "xtended-properties" $ appXml sheetNames , FileData "_rels/.rels" "application/vnd.openxmlformats-package.relationships+xml" "relationships" rootRelXml ] rootRelXml = renderLBS def . toDocument $ Relationships.fromList rootRels rootFiles = customPropFileRels ++ [ ("officeDocument", "xl/workbook.xml") , ("metadata/core-properties", "docProps/core.xml") , ("extended-properties", "docProps/app.xml") ] rootRels = [ relEntry (unsafeRefId i) typ trg | (i, (typ, trg)) <- zip [1..] rootFiles ] customProps = xlsx ^. xlCustomProperties (customPropFiles, customPropFileRels) = case M.null customProps of True -> ([], []) False -> ([ FileData "docProps/custom.xml" "application/vnd.openxmlformats-officedocument.custom-properties+xml" "custom-properties" (customPropsXml (CustomProperties customProps)) ], [ ("custom-properties", "docProps/custom.xml") ]) workbookFiles = bookFiles xlsx sheetNames = xlsx ^. xlSheets & mapped %~ fst singleSheetFiles :: Int -> Cells -> [FileData] -> Worksheet -> STRef s Int -> ST s (FileData, [FileData]) singleSheetFiles n cells pivFileDatas ws tblIdRef = do ref <- newSTRef 1 mCmntData <- genComments n cells ref mDrawingData <- maybe (return Nothing) (fmap Just . genDrawing n ref) (ws ^. wsDrawing) pivRefs <- forM pivFileDatas $ \fd -> do refId <- nextRefId ref return (refId, fd) refTables <- forM (_wsTables ws) $ \tbl -> do refId <- nextRefId ref tblId <- readSTRef tblIdRef modifySTRef' tblIdRef (+1) return (refId, genTable tbl tblId) let sheetFilePath = "xl/worksheets/sheet" <> show n <> ".xml" sheetFile = FileData sheetFilePath "application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" "worksheet" $ sheetXml nss = [ ("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships") ] sheetXml= renderLBS def{rsNamespaces=nss} $ Document (Prologue [] Nothing []) root [] root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" Nothing $ elementListSimple "worksheet" rootEls rootEls = catMaybes $ [ elementListSimple "sheetViews" . map (toElement "sheetView") <$> ws ^. wsSheetViews , nonEmptyElListSimple "cols" . map (toElement "col") $ ws ^. wsColumnsProperties , Just . elementListSimple "sheetData" $ sheetDataXml cells (ws ^. wsRowPropertiesMap) (ws ^. wsSharedFormulas) , toElement "sheetProtection" <$> (ws ^. wsProtection) , toElement "autoFilter" <$> (ws ^. wsAutoFilter) , nonEmptyElListSimple "mergeCells" . map mergeE1 $ ws ^. wsMerges ] ++ map (Just . toElement "conditionalFormatting") cfPairs ++ [ nonEmptyElListSimple "dataValidations" $ map (toElement "dataValidation") dvPairs , toElement "pageSetup" <$> ws ^. wsPageSetup , fst3 <$> mDrawingData , fst <$> mCmntData , nonEmptyElListSimple "tableParts" [leafElement "tablePart" [odr "id" .= rId] | (rId, _) <- refTables] ] cfPairs = map CfPair . M.toList $ ws ^. wsConditionalFormattings dvPairs = map DvPair . M.toList $ ws ^. wsDataValidations mergeE1 r = leafElement "mergeCell" [("ref" .= r)] sheetRels = if null referencedFiles then [] else [ FileData ("xl/worksheets/_rels/sheet" <> show n <> ".xml.rels") "application/vnd.openxmlformats-package.relationships+xml" "relationships" sheetRelsXml ] sheetRelsXml = renderLBS def . toDocument . Relationships.fromList $ [ relEntry i fdRelType (fdPath `relFrom` sheetFilePath) | (i, FileData{..}) <- referenced ] referenced = fromMaybe [] (snd <$> mCmntData) ++ catMaybes [ snd3 <$> mDrawingData ] ++ pivRefs ++ refTables referencedFiles = map snd referenced extraFiles = maybe [] thd3 mDrawingData otherFiles = sheetRels ++ referencedFiles ++ extraFiles return (sheetFile, otherFiles) nextRefId :: STRef s Int -> ST s RefId nextRefId r = do num <- readSTRef r modifySTRef' r (+1) return (unsafeRefId num) sheetDataXml :: Cells -> Map RowIndex RowProperties -> Map SharedFormulaIndex SharedFormulaOptions -> [Element] sheetDataXml rows rh sharedFormulas = evalState (mapM rowEl rows) sharedFormulas where rowEl (r, cells) = do let mProps = M.lookup r rh hasHeight = case rowHeight =<< mProps of Just CustomHeight{} -> True _ -> False ht = do Just height <- [rowHeight =<< mProps] let h = case height of CustomHeight x -> x AutomaticHeight x -> x return ("ht", txtd h) s = do Just st <- [rowStyle =<< mProps] return ("s", txti st) hidden = fromMaybe False $ rowHidden <$> mProps attrs = ht ++ s ++ [ ("r", txti r) , ("hidden", txtb hidden) , ("outlineLevel", "0") , ("collapsed", "false") , ("customFormat", "true") , ("customHeight", txtb hasHeight) ] cellEls <- mapM (cellEl r) cells return $ elementList "row" attrs cellEls cellEl r (icol, cell) = do let cellAttrs ref c = cellStyleAttr c ++ [("r" .= ref), ("t" .= xlsxCellType c)] cellStyleAttr XlsxCell{xlsxCellStyle=Nothing} = [] cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)] formula = xlsxCellFormula cell fEl0 = toElement "f" <$> formula fEl <- case formula of Just CellFormula{_cellfExpression=SharedFormula si} -> do shared <- get case M.lookup si shared of Just fOpts -> do put $ M.delete si shared return $ applySharedFormulaOpts fOpts <$> fEl0 Nothing -> return fEl0 _ -> return fEl0 return $ elementList "c" (cellAttrs (singleCellRef (r, icol)) cell) $ catMaybes [fEl, elementContent "v" . value <$> xlsxCellValue cell] genComments :: Int -> Cells -> STRef s Int -> ST s (Maybe (Element, [ReferencedFileData])) genComments n cells ref = if null comments then do return Nothing else do rId1 <- nextRefId ref rId2 <- nextRefId ref let el = refElement "legacyDrawing" rId2 return $ Just (el, [(rId1, commentsFile), (rId2, vmlDrawingFile)]) where comments = concatMap (\(row, rowCells) -> mapMaybe (maybeCellComment row) rowCells) cells maybeCellComment row (col, cell) = do comment <- xlsxComment cell return (singleCellRef (row, col), comment) commentTable = CommentTable.fromList comments commentsFile = FileData commentsPath "application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml" "comments" commentsBS commentsPath = "xl/comments" <> show n <> ".xml" commentsBS = renderLBS def $ toDocument commentTable vmlDrawingFile = FileData vmlPath "application/vnd.openxmlformats-officedocument.vmlDrawing" "vmlDrawing" vmlDrawingBS vmlPath = "xl/drawings/vmlDrawing" <> show n <> ".vml" vmlDrawingBS = CommentTable.renderShapes commentTable genDrawing :: Int -> STRef s Int -> Drawing -> ST s (Element, ReferencedFileData, [FileData]) genDrawing n ref dr = do rId <- nextRefId ref let el = refElement "drawing" rId return (el, (rId, drawingFile), referenced) where drawingFilePath = "xl/drawings/drawing" <> show n <> ".xml" drawingCT = "application/vnd.openxmlformats-officedocument.drawing+xml" drawingFile = FileData drawingFilePath drawingCT "drawing" drawingXml drawingXml = renderLBS def{rsNamespaces=nss} $ toDocument dr' nss = [ ("xdr", "http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing") , ("a", "http://schemas.openxmlformats.org/drawingml/2006/main") , ("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships") ] dr' = Drawing{ _xdrAnchors = reverse anchors' } (anchors', images, charts, _) = foldl' collectFile ([], [], [], 1) (dr ^. xdrAnchors) collectFile :: ([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int) -> Anchor FileInfo ChartSpace -> ([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int) collectFile (as, fis, chs, i) anch0 = case anch0 ^. anchObject of Picture {..} -> let fi = (i,) <$> _picBlipFill ^. bfpImageInfo pic' = Picture { _picMacro = _picMacro , _picPublished = _picPublished , _picNonVisual = _picNonVisual , _picBlipFill = (_picBlipFill & bfpImageInfo ?~ RefId ("rId" <> txti i)) , _picShapeProperties = _picShapeProperties } anch = anch0 {_anchObject = pic'} in (anch : as, fi : fis, chs, i + 1) Graphic nv ch tr -> let gr' = Graphic nv (RefId ("rId" <> txti i)) tr anch = anch0 {_anchObject = gr'} in (anch : as, fis, (i, ch) : chs, i + 1) imageFiles = [ ( unsafeRefId i , FileData ("xl/media/" <> _fiFilename) _fiContentType "image" _fiContents) | (i, FileInfo {..}) <- reverse (catMaybes images) ] chartFiles = [ (unsafeRefId i, genChart n k chart) | (k, (i, chart)) <- zip [1 ..] (reverse charts) ] innerFiles = imageFiles ++ chartFiles drawingRels = FileData ("xl/drawings/_rels/drawing" <> show n <> ".xml.rels") relsCT "relationships" drawingRelsXml drawingRelsXml = renderLBS def . toDocument . Relationships.fromList $ map (refFileDataToRel drawingFilePath) innerFiles referenced = case innerFiles of [] -> [] _ -> drawingRels : (map snd innerFiles) genChart :: Int -> Int -> ChartSpace -> FileData genChart n i ch = FileData path contentType relType contents where path = "xl/charts/chart" <> show n <> "_" <> show i <> ".xml" contentType = "application/vnd.openxmlformats-officedocument.drawingml.chart+xml" relType = "chart" contents = renderLBS def {rsNamespaces = nss} $ toDocument ch nss = [ ("c", "http://schemas.openxmlformats.org/drawingml/2006/chart") , ("a", "http://schemas.openxmlformats.org/drawingml/2006/main") ] data PvGenerated = PvGenerated { pvgCacheFiles :: [(CacheId, FileData)] , pvgSheetTableFiles :: [[FileData]] , pvgOthers :: [FileData] } generatePivotFiles :: [(CellMap, [PivotTable])] -> PvGenerated generatePivotFiles cmTables = PvGenerated cacheFiles shTableFiles others where cacheFiles = [cacheFile | (cacheFile, _, _) <- flatRendered] shTableFiles = map (map (\(_, tableFile, _) -> tableFile)) rendered others = concat [other | (_, _, other) <- flatRendered] firstCacheId = 1 flatRendered = concat rendered (_, rendered) = mapAccumL (\c (cm, ts) -> mapAccumL (\c' t -> (c' + 1, render cm c' t)) c ts) firstCacheId cmTables render cm cacheIdRaw tbl = let PivotTableFiles {..} = renderPivotTableFiles cm cacheIdRaw tbl cacheId = CacheId cacheIdRaw cacheIdStr = show cacheIdRaw cachePath = "xl/pivotCache/pivotCacheDefinition" <> cacheIdStr <> ".xml" cacheFile = FileData cachePath (smlCT "pivotCacheDefinition") "pivotCacheDefinition" pvtfCacheDefinition recordsPath = "xl/pivotCache/pivotCacheRecords" <> cacheIdStr <> ".xml" recordsFile = FileData recordsPath (smlCT "pivotCacheRecords") "pivotCacheRecords" pvtfCacheRecords cacheRelsFile = FileData ("xl/pivotCache/_rels/pivotCacheDefinition" <> cacheIdStr <> ".xml.rels") relsCT "relationships" $ renderRels [refFileDataToRel cachePath (unsafeRefId 1, recordsFile)] renderRels = renderLBS def . toDocument . Relationships.fromList tablePath = "xl/pivotTables/pivotTable" <> cacheIdStr <> ".xml" tableFile = FileData tablePath (smlCT "pivotTable") "pivotTable" pvtfTable tableRels = FileData ("xl/pivotTables/_rels/pivotTable" <> cacheIdStr <> ".xml.rels") relsCT "relationships" $ renderRels [refFileDataToRel tablePath (unsafeRefId 1, cacheFile)] in ((cacheId, cacheFile), tableFile, [tableRels, cacheRelsFile, recordsFile]) genTable :: Table -> Int -> FileData genTable tbl tblId = FileData{..} where fdPath = "xl/tables/table" <> show tblId <> ".xml" fdContentType = smlCT "table" fdRelType = "table" fdContents = renderLBS def $ tableToDocument tbl tblId data FileData = FileData { fdPath :: FilePath , fdContentType :: Text , fdRelType :: Text , fdContents :: L.ByteString } type ReferencedFileData = (RefId, FileData) refFileDataToRel :: FilePath -> ReferencedFileData -> (RefId, Relationship) refFileDataToRel basePath (i, FileData {..}) = relEntry i fdRelType (fdPath `relFrom` basePath) type Cells = [(RowIndex, [(ColumnIndex, XlsxCell)])] coreXml :: UTCTime -> Text -> L.ByteString coreXml created creator = renderLBS def{rsNamespaces=nss} $ Document (Prologue [] Nothing []) root [] where nss = [ ("cp", "http://schemas.openxmlformats.org/package/2006/metadata/core-properties") , ("dc", "http://purl.org/dc/elements/1.1/") , ("dcterms", "http://purl.org/dc/terms/") , ("xsi","http://www.w3.org/2001/XMLSchema-instance") ] namespaced = nsName nss date = T.pack $ formatTime defaultTimeLocale "%FT%T%QZ" created root = Element (namespaced "cp" "coreProperties") M.empty [ nEl (namespaced "dcterms" "created") (M.fromList [(namespaced "xsi" "type", "dcterms:W3CDTF")]) [NodeContent date] , nEl (namespaced "dc" "creator") M.empty [NodeContent creator] , nEl (namespaced "cp" "lastModifiedBy") M.empty [NodeContent creator] ] appXml :: [Text] -> L.ByteString appXml sheetNames = renderLBS def $ Document (Prologue [] Nothing []) root [] where sheetCount = length sheetNames root = Element (extPropNm "Properties") nsAttrs [ extPropEl "TotalTime" [NodeContent "0"] , extPropEl "HeadingPairs" [ vTypeEl "vector" (M.fromList [ ("size", "2") , ("baseType", "variant")]) [ vTypeEl0 "variant" [vTypeEl0 "lpstr" [NodeContent "Worksheets"]] , vTypeEl0 "variant" [vTypeEl0 "i4" [NodeContent $ txti sheetCount]] ] ] , extPropEl "TitlesOfParts" [ vTypeEl "vector" (M.fromList [ ("size", txti sheetCount) , ("baseType", "lpstr")]) $ map (vTypeEl0 "lpstr" . return . NodeContent) sheetNames ] ] nsAttrs = M.fromList [("xmlns:vt", "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")] extPropNm n = nm "http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" n extPropEl n = nEl (extPropNm n) M.empty vTypeEl0 n = vTypeEl n M.empty vTypeEl = nEl . nm "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes" data XlsxCellData = XlsxSS Int | XlsxDouble Double | XlsxBool Bool | XlsxError ErrorType deriving (Eq, Show, Generic) data XlsxCell = XlsxCell { xlsxCellStyle :: Maybe Int , xlsxCellValue :: Maybe XlsxCellData , xlsxComment :: Maybe Comment , xlsxCellFormula :: Maybe CellFormula } deriving (Eq, Show, Generic) xlsxCellType :: XlsxCell -> Text xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxSS _)} = "s" xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxBool _)} = "b" xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxError _)} = "e" xlsxCellType _ = "n" -- default in SpreadsheetML schema, TODO: add other types value :: XlsxCellData -> Text value (XlsxSS i) = txti i value (XlsxDouble d) = txtd d value (XlsxBool True) = "1" value (XlsxBool False) = "0" value (XlsxError eType) = toAttrVal eType transformSheetData :: SharedStringTable -> Worksheet -> Cells transformSheetData shared ws = map transformRow $ toRows (ws ^. wsCells) where transformRow = second (map transformCell) transformCell (c, Cell{..}) = (c, XlsxCell _cellStyle (fmap transformValue _cellValue) _cellComment _cellFormula) transformValue (CellText t) = XlsxSS (sstLookupText shared t) transformValue (CellDouble dbl) = XlsxDouble dbl transformValue (CellBool b) = XlsxBool b transformValue (CellRich r) = XlsxSS (sstLookupRich shared r) transformValue (CellError e) = XlsxError e bookFiles :: Xlsx -> [FileData] bookFiles xlsx = runST $ do ref <- newSTRef 1 ssRId <- nextRefId ref let sheets = xlsx ^. xlSheets & mapped %~ snd shared = sstConstruct sheets sharedStrings = (ssRId, FileData "xl/sharedStrings.xml" (smlCT "sharedStrings") "sharedStrings" $ ssXml shared) stRId <- nextRefId ref let style = (stRId, FileData "xl/styles.xml" (smlCT "styles") "styles" $ unStyles (xlsx ^. xlStyles)) let PvGenerated { pvgCacheFiles = cacheIdFiles , pvgOthers = pivotOtherFiles , pvgSheetTableFiles = sheetPivotTables } = generatePivotFiles [ (_wsCells, _wsPivotTables) | (_, Worksheet {..}) <- xlsx ^. xlSheets ] sheetCells = map (transformSheetData shared) sheets sheetInputs = zip3 sheetCells sheetPivotTables sheets tblIdRef <- newSTRef 1 allSheetFiles <- forM (zip [1..] sheetInputs) $ \(i, (cells, pvTables, sheet)) -> do rId <- nextRefId ref (sheetFile, others) <- singleSheetFiles i cells pvTables sheet tblIdRef return ((rId, sheetFile), others) let sheetFiles = map fst allSheetFiles sheetAttrsByRId = zipWith (\(rId, _) (name, sheet) -> (rId, name, sheet ^. wsState)) sheetFiles (xlsx ^. xlSheets) sheetOthers = concatMap snd allSheetFiles cacheRefFDsById <- forM cacheIdFiles $ \(cacheId, fd) -> do refId <- nextRefId ref return (cacheId, (refId, fd)) let cacheRefsById = [ (cId, rId) | (cId, (rId, _)) <- cacheRefFDsById ] cacheRefs = map snd cacheRefFDsById bookFile = FileData "xl/workbook.xml" (smlCT "sheet.main") "officeDocument" $ bookXml sheetAttrsByRId (xlsx ^. xlDefinedNames) cacheRefsById (xlsx ^. xlDateBase) rels = FileData "xl/_rels/workbook.xml.rels" "application/vnd.openxmlformats-package.relationships+xml" "relationships" relsXml relsXml = renderLBS def . toDocument . Relationships.fromList $ [ relEntry i fdRelType (fdPath `relFrom` "xl/workbook.xml") | (i, FileData{..}) <- referenced ] referenced = sharedStrings:style:sheetFiles ++ cacheRefs otherFiles = concat [rels:(map snd referenced), pivotOtherFiles, sheetOthers] return $ bookFile:otherFiles bookXml :: [(RefId, Text, SheetState)] -> DefinedNames -> [(CacheId, RefId)] -> DateBase -> L.ByteString bookXml rIdAttrs (DefinedNames names) cacheIdRefs dateBase = renderLBS def {rsNamespaces = nss} $ Document (Prologue [] Nothing []) root [] where nss = [ ("r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships") ] -- The @bookViews@ element is not required according to the schema, but its -- absence can cause Excel to crash when opening the print preview -- (see ). It suffices however -- to define a bookViews with a single empty @workbookView@ element -- (the @bookViews@ must contain at least one @wookbookView@). root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" Nothing $ elementListSimple "workbook" ( [ leafElement "workbookPr" (catMaybes ["date1904" .=? justTrue (dateBase == DateBase1904) ]) , elementListSimple "bookViews" [emptyElement "workbookView"] , elementListSimple "sheets" [ leafElement "sheet" ["name" .= name, "sheetId" .= i, "state" .= state, (odr "id") .= rId] | (i, (rId, name, state)) <- zip [(1 :: Int) ..] rIdAttrs ] , elementListSimple "definedNames" [ elementContent0 "definedName" (definedName name lsId) val | (name, lsId, val) <- names ] ] ++ maybeToList (nonEmptyElListSimple "pivotCaches" $ map pivotCacheEl cacheIdRefs) ) pivotCacheEl (CacheId cId, refId) = leafElement "pivotCache" ["cacheId" .= cId, (odr "id") .= refId] definedName :: Text -> Maybe Text -> [(Name, Text)] definedName name Nothing = ["name" .= name] definedName name (Just lsId) = ["name" .= name, "localSheetId" .= lsId] ssXml :: SharedStringTable -> L.ByteString ssXml = renderLBS def . toDocument customPropsXml :: CustomProperties -> L.ByteString customPropsXml = renderLBS def . toDocument contentTypesXml :: [FileData] -> L.ByteString contentTypesXml fds = renderLBS def $ Document (Prologue [] Nothing []) root [] where root = addNS "http://schemas.openxmlformats.org/package/2006/content-types" Nothing $ Element "Types" M.empty $ map (\fd -> nEl "Override" (M.fromList [("PartName", T.concat ["/", T.pack $ fdPath fd]), ("ContentType", fdContentType fd)]) []) fds -- | fully qualified XML name qName :: Text -> Text -> Text -> Name qName n ns p = Name { nameLocalName = n , nameNamespace = Just ns , namePrefix = Just p } -- | fully qualified XML name from prefix to ns URL mapping nsName :: [(Text, Text)] -> Text -> Text -> Name nsName nss p n = qName n ns p where ns = fromJustNote "ns name lookup" $ lookup p nss nm :: Text -> Text -> Name nm ns n = Name { nameLocalName = n , nameNamespace = Just ns , namePrefix = Nothing} nEl :: Name -> Map Name Text -> [Node] -> Node nEl name attrs nodes = NodeElement $ Element name attrs nodes -- | Creates element holding reference to some linked file refElement :: Name -> RefId -> Element refElement name rId = leafElement name [ odr "id" .= rId ] smlCT :: Text -> Text smlCT t = "application/vnd.openxmlformats-officedocument.spreadsheetml." <> t <> "+xml" relsCT :: Text relsCT = "application/vnd.openxmlformats-package.relationships+xml"