{-# 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 <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"
        ( [ 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"
