Writer.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
-- | This module provides a function for serializing structured `Xlsx` into lazy bytestring
module Codec.Xlsx.Writer
  ( fromXlsx
  ) where

import qualified Codec.Archive.Zip as Zip
import Control.Arrow (second)
import Control.Lens hiding (transform, (.=))
import Control.Monad (forM)
import Control.Monad.ST
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.Maybe (maybeToList)
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)
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import Data.Tuple.Extra (fst3, snd3, thd3)
import GHC.Generics (Generic)
import Safe
import Text.XML

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

import Codec.Xlsx.Types
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 . to (map 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)
            , 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)

unsafeRefId :: Int -> RefId
unsafeRefId num = RefId $ "rId" <> txti num

sheetDataXml :: Cells -> Map Int RowProperties -> [Element]
sheetDataXml rows rh = map rowEl rows
  where
    rowEl (r, cells) = elementList "row"
                         (ht ++ s ++
                         [("r", txti r), ("hidden", txtb hidden), ("outlineLevel", "0"),
                          ("collapsed", "false"), ("customFormat", "true"),
                          ("customHeight", txtb hasHeight)])
                       $ map (cellEl r) cells
      where
        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
    cellEl r (icol, cell) =
      elementList "c" (cellAttrs (singleCellRef (r, icol)) cell)
              (catMaybes [ elementContent "v" . value <$> xlsxCellValue cell
                         , toElement "f" <$> xlsxCellFormula cell
                         ])
    cellAttrs ref cell = cellStyleAttr cell ++ [("r" .= ref), ("t" .= xlsxCellType cell)]
    cellStyleAttr XlsxCell{xlsxCellStyle=Nothing} = []
    cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)]

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
          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])

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 = [(Int, [(Int, 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
                    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 _ = "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"

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)

bookFiles :: Xlsx -> [FileData]
bookFiles xlsx = runST $ do
  ref <- newSTRef 1
  ssRId <- nextRefId ref
  let sheets = xlsx ^. xlSheets . to (map 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
      sheetNameByRId = zip (map fst sheetFiles) (xlsx ^. xlSheets . to (map fst))
      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 sheetNameByRId (xlsx ^. xlDefinedNames) cacheRefsById
      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)]
        -> DefinedNames
        -> [(CacheId, RefId)]
        -> L.ByteString
bookXml rIdNames (DefinedNames names) cacheIdRefs =
  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 <https://phpexcel.codeplex.com/workitem/2935>). 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"
        ([ elementListSimple "bookViews" [emptyElement "workbookView"]
         , elementListSimple
             "sheets"
             [ leafElement
               "sheet"
               ["name" .= name, "sheetId" .= i, (odr "id") .= rId]
             | (i, (rId, name)) <- zip [(1 :: Int) ..] rIdNames
             ]
         , 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"