{-# 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 :: POSIXTime -> Xlsx -> ByteString
fromXlsx POSIXTime
pt Xlsx
xlsx =
    Archive -> ByteString
Zip.fromArchive forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
Zip.addEntryToArchive Archive
Zip.emptyArchive [Entry]
entries
  where
    t :: Integer
t = forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
pt
    utcTime :: UTCTime
utcTime = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
pt
    entries :: [Entry]
entries = FilePath -> Integer -> ByteString -> Entry
Zip.toEntry FilePath
"[Content_Types].xml" Integer
t ([FileData] -> ByteString
contentTypesXml [FileData]
files) forall a. a -> [a] -> [a]
:
              forall a b. (a -> b) -> [a] -> [b]
map (\FileData
fd -> FilePath -> Integer -> ByteString -> Entry
Zip.toEntry (FileData -> FilePath
fdPath FileData
fd) Integer
t (FileData -> ByteString
fdContents FileData
fd)) [FileData]
files
    files :: [FileData]
files = [FileData]
workbookFiles forall a. [a] -> [a] -> [a]
++ [FileData]
customPropFiles forall a. [a] -> [a] -> [a]
++
      [ FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"docProps/core.xml"
        Text
"application/vnd.openxmlformats-package.core-properties+xml"
        Text
"metadata/core-properties" forall a b. (a -> b) -> a -> b
$ UTCTime -> Text -> ByteString
coreXml UTCTime
utcTime Text
"xlsxwriter"
      , FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"docProps/app.xml"
        Text
"application/vnd.openxmlformats-officedocument.extended-properties+xml"
        Text
"xtended-properties" forall a b. (a -> b) -> a -> b
$ [Text] -> ByteString
appXml [Text]
sheetNames
      , FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"_rels/.rels" Text
"application/vnd.openxmlformats-package.relationships+xml"
        Text
"relationships" ByteString
rootRelXml
      ]
    rootRelXml :: ByteString
rootRelXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument forall a b. (a -> b) -> a -> b
$ [(RefId, Relationship)] -> Relationships
Relationships.fromList [(RefId, Relationship)]
rootRels
    rootFiles :: [(Text, FilePath)]
rootFiles =  [(Text, FilePath)]
customPropFileRels forall a. [a] -> [a] -> [a]
++
        [ (Text
"officeDocument", FilePath
"xl/workbook.xml")
        , (Text
"metadata/core-properties", FilePath
"docProps/core.xml")
        , (Text
"extended-properties", FilePath
"docProps/app.xml") ]
    rootRels :: [(RefId, Relationship)]
rootRels = [ RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry (Int -> RefId
unsafeRefId Int
i) Text
typ FilePath
trg
               | (Int
i, (Text
typ, FilePath
trg)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Text, FilePath)]
rootFiles ]
    customProps :: Map Text Variant
customProps = Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx (Map Text Variant)
xlCustomProperties
    ([FileData]
customPropFiles, [(Text, FilePath)]
customPropFileRels) = case forall k a. Map k a -> Bool
M.null Map Text Variant
customProps of
        Bool
True  -> ([], [])
        Bool
False -> ([ FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"docProps/custom.xml"
                    Text
"application/vnd.openxmlformats-officedocument.custom-properties+xml"
                    Text
"custom-properties"
                    (CustomProperties -> ByteString
customPropsXml (Map Text Variant -> CustomProperties
CustomProperties Map Text Variant
customProps)) ],
                  [ (Text
"custom-properties", FilePath
"docProps/custom.xml") ])
    workbookFiles :: [FileData]
workbookFiles = Xlsx -> [FileData]
bookFiles Xlsx
xlsx
    sheetNames :: [Text]
sheetNames = Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx [(Text, Worksheet)]
xlSheets forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a b. (a, b) -> a
fst

singleSheetFiles :: Int
                 -> Cells
                 -> [FileData]
                 -> Worksheet
                 -> STRef s Int
                 -> ST s (FileData, [FileData])
singleSheetFiles :: forall s.
Int
-> Cells
-> [FileData]
-> Worksheet
-> STRef s Int
-> ST s (FileData, [FileData])
singleSheetFiles Int
n Cells
cells [FileData]
pivFileDatas Worksheet
ws STRef s Int
tblIdRef = do
    STRef s Int
ref <- forall a s. a -> ST s (STRef s a)
newSTRef Int
1
    Maybe (Element, [ReferencedFileData])
mCmntData <- forall s.
Int
-> Cells
-> STRef s Int
-> ST s (Maybe (Element, [ReferencedFileData]))
genComments Int
n Cells
cells STRef s Int
ref
    Maybe (Element, ReferencedFileData, [FileData])
mDrawingData <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s.
Int
-> STRef s Int
-> Drawing
-> ST s (Element, ReferencedFileData, [FileData])
genDrawing Int
n STRef s Int
ref) (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Maybe Drawing)
wsDrawing)
    [ReferencedFileData]
pivRefs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FileData]
pivFileDatas forall a b. (a -> b) -> a -> b
$ \FileData
fd -> do
      RefId
refId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
      forall (m :: * -> *) a. Monad m => a -> m a
return (RefId
refId, FileData
fd)
    [ReferencedFileData]
refTables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Worksheet -> [Table]
_wsTables Worksheet
ws) forall a b. (a -> b) -> a -> b
$ \Table
tbl -> do
      RefId
refId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
      Int
tblId <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
tblIdRef
      forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
tblIdRef (forall a. Num a => a -> a -> a
+Int
1)
      forall (m :: * -> *) a. Monad m => a -> m a
return (RefId
refId, Table -> Int -> FileData
genTable Table
tbl Int
tblId)
    let sheetFilePath :: FilePath
sheetFilePath = FilePath
"xl/worksheets/sheet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
        sheetFile :: FileData
sheetFile = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
sheetFilePath
            Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"
            Text
"worksheet" forall a b. (a -> b) -> a -> b
$
            ByteString
sheetXml
        nss :: [(Text, Text)]
nss = [ (Text
"r", Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships") ]
        sheetXml :: ByteString
sheetXml= RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
        root :: Element
root = Text -> Maybe Text -> Element -> Element
addNS Text
"http://schemas.openxmlformats.org/spreadsheetml/2006/main" forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
            Name -> [Element] -> Element
elementListSimple Name
"worksheet" [Element]
rootEls
        rootEls :: [Element]
rootEls = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
            [ Name -> [Element] -> Element
elementListSimple Name
"sheetViews" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToElement a => Name -> a -> Element
toElement Name
"sheetView") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Maybe [SheetView])
wsSheetViews
            , Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"cols" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToElement a => Name -> a -> Element
toElement Name
"col") forall a b. (a -> b) -> a -> b
$ Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet [ColumnsProperties]
wsColumnsProperties
            , forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Element] -> Element
elementListSimple Name
"sheetData" forall a b. (a -> b) -> a -> b
$
              Cells
-> Map RowIndex RowProperties
-> Map SharedFormulaIndex SharedFormulaOptions
-> [Element]
sheetDataXml Cells
cells (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Map RowIndex RowProperties)
wsRowPropertiesMap) (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Map SharedFormulaIndex SharedFormulaOptions)
wsSharedFormulas)
            , forall a. ToElement a => Name -> a -> Element
toElement Name
"sheetProtection" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Maybe SheetProtection)
wsProtection)
            , forall a. ToElement a => Name -> a -> Element
toElement Name
"autoFilter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Maybe AutoFilter)
wsAutoFilter)
            , Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"mergeCells" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. ToAttrVal a => a -> Element
mergeE1 forall a b. (a -> b) -> a -> b
$ Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet [Range]
wsMerges
            ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => Name -> a -> Element
toElement Name
"conditionalFormatting") [CfPair]
cfPairs forall a. [a] -> [a] -> [a]
++
            [ Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"dataValidations" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToElement a => Name -> a -> Element
toElement Name
"dataValidation") [DvPair]
dvPairs
            , forall a. ToElement a => Name -> a -> Element
toElement Name
"pageSetup" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Maybe PageSetup)
wsPageSetup
            , forall a b c. (a, b, c) -> a
fst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, ReferencedFileData, [FileData])
mDrawingData
            , forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, [ReferencedFileData])
mCmntData
            , Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"tableParts"
                [Name -> [(Name, Text)] -> Element
leafElement Name
"tablePart" [Text -> Name
odr Text
"id" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId] | (RefId
rId, FileData
_) <- [ReferencedFileData]
refTables]
            ]
        cfPairs :: [CfPair]
cfPairs = forall a b. (a -> b) -> [a] -> [b]
map (SqRef, ConditionalFormatting) -> CfPair
CfPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Map SqRef ConditionalFormatting)
wsConditionalFormattings
        dvPairs :: [DvPair]
dvPairs = forall a b. (a -> b) -> [a] -> [b]
map (SqRef, DataValidation) -> DvPair
DvPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet (Map SqRef DataValidation)
wsDataValidations
        mergeE1 :: a -> Element
mergeE1 a
r = Name -> [(Name, Text)] -> Element
leafElement Name
"mergeCell" [(Name
"ref" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= a
r)]

        sheetRels :: [FileData]
sheetRels = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileData]
referencedFiles
                    then []
                    else [ FilePath -> Text -> Text -> ByteString -> FileData
FileData (FilePath
"xl/worksheets/_rels/sheet" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
                           Text
"application/vnd.openxmlformats-package.relationships+xml"
                           Text
"relationships" ByteString
sheetRelsXml ]
        sheetRelsXml :: ByteString
sheetRelsXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList forall a b. (a -> b) -> a -> b
$
            [ RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry RefId
i Text
fdRelType (FilePath
fdPath FilePath -> FilePath -> FilePath
`relFrom` FilePath
sheetFilePath)
            | (RefId
i, FileData{FilePath
ByteString
Text
fdRelType :: FileData -> Text
fdContentType :: FileData -> Text
fdContents :: ByteString
fdContentType :: Text
fdPath :: FilePath
fdRelType :: Text
fdContents :: FileData -> ByteString
fdPath :: FileData -> FilePath
..}) <- [ReferencedFileData]
referenced ]
        referenced :: [ReferencedFileData]
referenced = forall a. a -> Maybe a -> a
fromMaybe [] (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, [ReferencedFileData])
mCmntData) forall a. [a] -> [a] -> [a]
++
                     forall a. [Maybe a] -> [a]
catMaybes [ forall a b c. (a, b, c) -> b
snd3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, ReferencedFileData, [FileData])
mDrawingData ] forall a. [a] -> [a] -> [a]
++
                     [ReferencedFileData]
pivRefs forall a. [a] -> [a] -> [a]
++
                     [ReferencedFileData]
refTables
        referencedFiles :: [FileData]
referencedFiles = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [ReferencedFileData]
referenced
        extraFiles :: [FileData]
extraFiles = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b c. (a, b, c) -> c
thd3 Maybe (Element, ReferencedFileData, [FileData])
mDrawingData
        otherFiles :: [FileData]
otherFiles = [FileData]
sheetRels forall a. [a] -> [a] -> [a]
++ [FileData]
referencedFiles forall a. [a] -> [a] -> [a]
++ [FileData]
extraFiles

    forall (m :: * -> *) a. Monad m => a -> m a
return (FileData
sheetFile, [FileData]
otherFiles)

nextRefId :: STRef s Int -> ST s RefId
nextRefId :: forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
r = do
  Int
num <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
r
  forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
r (forall a. Num a => a -> a -> a
+Int
1)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> RefId
unsafeRefId Int
num)

sheetDataXml ::
     Cells
  -> Map RowIndex RowProperties
  -> Map SharedFormulaIndex SharedFormulaOptions
  -> [Element]
sheetDataXml :: Cells
-> Map RowIndex RowProperties
-> Map SharedFormulaIndex SharedFormulaOptions
-> [Element]
sheetDataXml Cells
rows Map RowIndex RowProperties
rh Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas =
  forall s a. State s a -> s -> a
evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
MonadState (Map SharedFormulaIndex SharedFormulaOptions) m =>
(RowIndex, [(ColumnIndex, XlsxCell)]) -> m Element
rowEl Cells
rows) Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas
  where
    rowEl :: (RowIndex, [(ColumnIndex, XlsxCell)]) -> m Element
rowEl (RowIndex
r, [(ColumnIndex, XlsxCell)]
cells) = do
      let mProps :: Maybe RowProperties
mProps    = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RowIndex
r Map RowIndex RowProperties
rh
          hasHeight :: Bool
hasHeight = case RowProperties -> Maybe RowHeight
rowHeight forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RowProperties
mProps of
                        Just CustomHeight{} -> Bool
True
                        Maybe RowHeight
_                   -> Bool
False
          ht :: [(Name, Text)]
ht        = do Just RowHeight
height <- [RowProperties -> Maybe RowHeight
rowHeight forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RowProperties
mProps]
                         let h :: Double
h = case RowHeight
height of CustomHeight    Double
x -> Double
x
                                                AutomaticHeight Double
x -> Double
x
                         forall (m :: * -> *) a. Monad m => a -> m a
return (Name
"ht", Double -> Text
txtd Double
h)
          s :: [(Name, Text)]
s         = do Just Int
st <- [RowProperties -> Maybe Int
rowStyle forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RowProperties
mProps]
                         forall (m :: * -> *) a. Monad m => a -> m a
return (Name
"s", forall a. Integral a => a -> Text
txti Int
st)
          hidden :: Bool
hidden    = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ RowProperties -> Bool
rowHidden forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RowProperties
mProps
          attrs :: [(Name, Text)]
attrs = [(Name, Text)]
ht forall a. [a] -> [a] -> [a]
++
            [(Name, Text)]
s forall a. [a] -> [a] -> [a]
++
            [ (Name
"r", forall a. Integral a => a -> Text
txti RowIndex
r)
            , (Name
"hidden", Bool -> Text
txtb Bool
hidden)
            , (Name
"outlineLevel", Text
"0")
            , (Name
"collapsed", Text
"false")
            , (Name
"customFormat", Text
"true")
            , (Name
"customHeight", Bool -> Text
txtb Bool
hasHeight)
            ]
      [Element]
cellEls <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
MonadState (Map SharedFormulaIndex SharedFormulaOptions) m =>
RowIndex -> (ColumnIndex, XlsxCell) -> m Element
cellEl RowIndex
r) [(ColumnIndex, XlsxCell)]
cells
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
"row" [(Name, Text)]
attrs [Element]
cellEls
    cellEl :: RowIndex -> (ColumnIndex, XlsxCell) -> m Element
cellEl RowIndex
r (ColumnIndex
icol, XlsxCell
cell) = do
      let cellAttrs :: a -> XlsxCell -> [(Name, Text)]
cellAttrs a
ref XlsxCell
c =
            forall {a}. IsString a => XlsxCell -> [(a, Text)]
cellStyleAttr XlsxCell
c forall a. [a] -> [a] -> [a]
++ [(Name
"r" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= a
ref), (Name
"t" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= XlsxCell -> Text
xlsxCellType XlsxCell
c)]
          cellStyleAttr :: XlsxCell -> [(a, Text)]
cellStyleAttr XlsxCell{xlsxCellStyle :: XlsxCell -> Maybe Int
xlsxCellStyle=Maybe Int
Nothing} = []
          cellStyleAttr XlsxCell{xlsxCellStyle :: XlsxCell -> Maybe Int
xlsxCellStyle=Just Int
s} = [(a
"s", forall a. Integral a => a -> Text
txti Int
s)]
          formula :: Maybe CellFormula
formula = XlsxCell -> Maybe CellFormula
xlsxCellFormula XlsxCell
cell
          fEl0 :: Maybe Element
fEl0 = forall a. ToElement a => Name -> a -> Element
toElement Name
"f" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CellFormula
formula
      Maybe Element
fEl <- case Maybe CellFormula
formula of
        Just CellFormula{_cellfExpression :: CellFormula -> FormulaExpression
_cellfExpression=SharedFormula SharedFormulaIndex
si} -> do
          Map SharedFormulaIndex SharedFormulaOptions
shared <- forall s (m :: * -> *). MonadState s m => m s
get
          case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SharedFormulaIndex
si Map SharedFormulaIndex SharedFormulaOptions
shared of
            Just SharedFormulaOptions
fOpts -> do
              forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete SharedFormulaIndex
si Map SharedFormulaIndex SharedFormulaOptions
shared
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SharedFormulaOptions -> Element -> Element
applySharedFormulaOpts SharedFormulaOptions
fOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Element
fEl0
            Maybe SharedFormulaOptions
Nothing ->
              forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
fEl0
        Maybe CellFormula
_ ->
          forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
fEl0
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
"c" (forall {a}. ToAttrVal a => a -> XlsxCell -> [(Name, Text)]
cellAttrs ((RowIndex, ColumnIndex) -> Range
singleCellRef (RowIndex
r, ColumnIndex
icol)) XlsxCell
cell) forall a b. (a -> b) -> a -> b
$
        forall a. [Maybe a] -> [a]
catMaybes [Maybe Element
fEl, Name -> Text -> Element
elementContent Name
"v" forall b c a. (b -> c) -> (a -> b) -> a -> c
. XlsxCellData -> Text
value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XlsxCell -> Maybe XlsxCellData
xlsxCellValue XlsxCell
cell]

genComments :: Int -> Cells -> STRef s Int -> ST s (Maybe (Element, [ReferencedFileData]))
genComments :: forall s.
Int
-> Cells
-> STRef s Int
-> ST s (Maybe (Element, [ReferencedFileData]))
genComments Int
n Cells
cells STRef s Int
ref =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Comment)]
comments
    then do
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else do
        RefId
rId1 <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
        RefId
rId2 <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
        let el :: Element
el = Name -> RefId -> Element
refElement Name
"legacyDrawing" RefId
rId2
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Element
el, [(RefId
rId1, FileData
commentsFile), (RefId
rId2, FileData
vmlDrawingFile)])
  where
    comments :: [(Range, Comment)]
comments = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(RowIndex
row, [(ColumnIndex, XlsxCell)]
rowCells) -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RowIndex -> (ColumnIndex, XlsxCell) -> Maybe (Range, Comment)
maybeCellComment RowIndex
row) [(ColumnIndex, XlsxCell)]
rowCells) Cells
cells
    maybeCellComment :: RowIndex -> (ColumnIndex, XlsxCell) -> Maybe (Range, Comment)
maybeCellComment RowIndex
row (ColumnIndex
col, XlsxCell
cell) = do
        Comment
comment <- XlsxCell -> Maybe Comment
xlsxComment XlsxCell
cell
        forall (m :: * -> *) a. Monad m => a -> m a
return ((RowIndex, ColumnIndex) -> Range
singleCellRef (RowIndex
row, ColumnIndex
col), Comment
comment)
    commentTable :: CommentTable
commentTable = [(Range, Comment)] -> CommentTable
CommentTable.fromList [(Range, Comment)]
comments
    commentsFile :: FileData
commentsFile = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
commentsPath
        Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml"
        Text
"comments"
        ByteString
commentsBS
    commentsPath :: FilePath
commentsPath = FilePath
"xl/comments" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
    commentsBS :: ByteString
commentsBS = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ forall a. ToDocument a => a -> Document
toDocument CommentTable
commentTable
    vmlDrawingFile :: FileData
vmlDrawingFile = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
vmlPath
        Text
"application/vnd.openxmlformats-officedocument.vmlDrawing"
        Text
"vmlDrawing"
        ByteString
vmlDrawingBS
    vmlPath :: FilePath
vmlPath = FilePath
"xl/drawings/vmlDrawing" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".vml"
    vmlDrawingBS :: ByteString
vmlDrawingBS = CommentTable -> ByteString
CommentTable.renderShapes CommentTable
commentTable

genDrawing :: Int -> STRef s Int -> Drawing -> ST s (Element, ReferencedFileData, [FileData])
genDrawing :: forall s.
Int
-> STRef s Int
-> Drawing
-> ST s (Element, ReferencedFileData, [FileData])
genDrawing Int
n STRef s Int
ref Drawing
dr = do
  RefId
rId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
  let el :: Element
el = Name -> RefId -> Element
refElement Name
"drawing" RefId
rId
  forall (m :: * -> *) a. Monad m => a -> m a
return (Element
el, (RefId
rId, FileData
drawingFile), [FileData]
referenced)
  where
    drawingFilePath :: FilePath
drawingFilePath = FilePath
"xl/drawings/drawing" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
    drawingCT :: Text
drawingCT = Text
"application/vnd.openxmlformats-officedocument.drawing+xml"
    drawingFile :: FileData
drawingFile = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
drawingFilePath Text
drawingCT Text
"drawing" ByteString
drawingXml
    drawingXml :: ByteString
drawingXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} forall a b. (a -> b) -> a -> b
$ forall a. ToDocument a => a -> Document
toDocument GenericDrawing RefId RefId
dr'
    nss :: [(Text, Text)]
nss = [ (Text
"xdr", Text
"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing")
          , (Text
"a",   Text
"http://schemas.openxmlformats.org/drawingml/2006/main")
          , (Text
"r",   Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships") ]
    dr' :: GenericDrawing RefId RefId
dr' = Drawing{ _xdrAnchors :: [Anchor RefId RefId]
_xdrAnchors = forall a. [a] -> [a]
reverse [Anchor RefId RefId]
anchors' }
    ([Anchor RefId RefId]
anchors', [Maybe (Int, FileInfo)]
images, [(Int, ChartSpace)]
charts, Int
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
 [(Int, ChartSpace)], Int)
-> Anchor FileInfo ChartSpace
-> ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
    [(Int, ChartSpace)], Int)
collectFile ([], [], [], Int
1) (Drawing
dr forall s a. s -> Getting a s a -> a
^. forall p1 g1 p2 g2.
Iso
  (GenericDrawing p1 g1)
  (GenericDrawing p2 g2)
  [Anchor p1 g1]
  [Anchor p2 g2]
xdrAnchors)
    collectFile :: ([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int)
                -> Anchor FileInfo ChartSpace
                -> ([Anchor RefId RefId], [Maybe (Int, FileInfo)], [(Int, ChartSpace)], Int)
    collectFile :: ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
 [(Int, ChartSpace)], Int)
-> Anchor FileInfo ChartSpace
-> ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
    [(Int, ChartSpace)], Int)
collectFile ([Anchor RefId RefId]
as, [Maybe (Int, FileInfo)]
fis, [(Int, ChartSpace)]
chs, Int
i) Anchor FileInfo ChartSpace
anch0 =
        case Anchor FileInfo ChartSpace
anch0 forall s a. s -> Getting a s a -> a
^. forall p1 g1 p2 g2.
Lens
  (Anchor p1 g1)
  (Anchor p2 g2)
  (DrawingObject p1 g1)
  (DrawingObject p2 g2)
anchObject of
          Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties FileInfo
PicNonVisual
_picShapeProperties :: forall p g. DrawingObject p g -> ShapeProperties
_picBlipFill :: forall p g. DrawingObject p g -> BlipFillProperties p
_picNonVisual :: forall p g. DrawingObject p g -> PicNonVisual
_picPublished :: forall p g. DrawingObject p g -> Bool
_picMacro :: forall p g. DrawingObject p g -> Maybe Text
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties FileInfo
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
..} ->
            let fi :: Maybe (Int, FileInfo)
fi = (Int
i,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlipFillProperties FileInfo
_picBlipFill forall s a. s -> Getting a s a -> a
^. forall a1 a2.
Lens
  (BlipFillProperties a1)
  (BlipFillProperties a2)
  (Maybe a1)
  (Maybe a2)
bfpImageInfo
                pic' :: DrawingObject RefId g
pic' =
                  Picture
                  { _picMacro :: Maybe Text
_picMacro = Maybe Text
_picMacro
                  , _picPublished :: Bool
_picPublished = Bool
_picPublished
                  , _picNonVisual :: PicNonVisual
_picNonVisual = PicNonVisual
_picNonVisual
                  , _picBlipFill :: BlipFillProperties RefId
_picBlipFill =
                      (BlipFillProperties FileInfo
_picBlipFill forall a b. a -> (a -> b) -> b
& forall a1 a2.
Lens
  (BlipFillProperties a1)
  (BlipFillProperties a2)
  (Maybe a1)
  (Maybe a2)
bfpImageInfo forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> RefId
RefId (Text
"rId" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Text
txti Int
i))
                  , _picShapeProperties :: ShapeProperties
_picShapeProperties = ShapeProperties
_picShapeProperties
                  }
                anch :: Anchor RefId g
anch = Anchor FileInfo ChartSpace
anch0 {_anchObject :: DrawingObject RefId g
_anchObject = forall {g}. DrawingObject RefId g
pic'}
            in (forall {g}. Anchor RefId g
anch forall a. a -> [a] -> [a]
: [Anchor RefId RefId]
as, Maybe (Int, FileInfo)
fi forall a. a -> [a] -> [a]
: [Maybe (Int, FileInfo)]
fis, [(Int, ChartSpace)]
chs, Int
i forall a. Num a => a -> a -> a
+ Int
1)
          Graphic GraphNonVisual
nv ChartSpace
ch Transform2D
tr ->
            let gr' :: DrawingObject p RefId
gr' = forall p g. GraphNonVisual -> g -> Transform2D -> DrawingObject p g
Graphic GraphNonVisual
nv (Text -> RefId
RefId (Text
"rId" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Text
txti Int
i)) Transform2D
tr
                anch :: Anchor p RefId
anch = Anchor FileInfo ChartSpace
anch0 {_anchObject :: DrawingObject p RefId
_anchObject = forall {p}. DrawingObject p RefId
gr'}
            in (forall {p}. Anchor p RefId
anch forall a. a -> [a] -> [a]
: [Anchor RefId RefId]
as, [Maybe (Int, FileInfo)]
fis, (Int
i, ChartSpace
ch) forall a. a -> [a] -> [a]
: [(Int, ChartSpace)]
chs, Int
i forall a. Num a => a -> a -> a
+ Int
1)
    imageFiles :: [ReferencedFileData]
imageFiles =
      [ ( Int -> RefId
unsafeRefId Int
i
        , FilePath -> Text -> Text -> ByteString -> FileData
FileData (FilePath
"xl/media/" forall a. Semigroup a => a -> a -> a
<> FilePath
_fiFilename) Text
_fiContentType Text
"image" ByteString
_fiContents)
      | (Int
i, FileInfo {FilePath
ByteString
Text
_fiContents :: FileInfo -> ByteString
_fiContentType :: FileInfo -> Text
_fiFilename :: FileInfo -> FilePath
_fiContents :: ByteString
_fiContentType :: Text
_fiFilename :: FilePath
..}) <- forall a. [a] -> [a]
reverse (forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, FileInfo)]
images)
      ]

    chartFiles :: [ReferencedFileData]
chartFiles =
      [ (Int -> RefId
unsafeRefId Int
i, Int -> Int -> ChartSpace -> FileData
genChart Int
n Int
k ChartSpace
chart)
      | (Int
k, (Int
i, ChartSpace
chart)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (forall a. [a] -> [a]
reverse [(Int, ChartSpace)]
charts)
      ]

    innerFiles :: [ReferencedFileData]
innerFiles = [ReferencedFileData]
imageFiles forall a. [a] -> [a] -> [a]
++ [ReferencedFileData]
chartFiles

    drawingRels :: FileData
drawingRels =
      FilePath -> Text -> Text -> ByteString -> FileData
FileData
        (FilePath
"xl/drawings/_rels/drawing" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
        Text
relsCT
        Text
"relationships"
        ByteString
drawingRelsXml

    drawingRelsXml :: ByteString
drawingRelsXml =
      RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ReferencedFileData -> (RefId, Relationship)
refFileDataToRel FilePath
drawingFilePath) [ReferencedFileData]
innerFiles

    referenced :: [FileData]
referenced =
      case [ReferencedFileData]
innerFiles of
        [] -> []
        [ReferencedFileData]
_ -> FileData
drawingRels forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [ReferencedFileData]
innerFiles)

genChart :: Int -> Int -> ChartSpace -> FileData
genChart :: Int -> Int -> ChartSpace -> FileData
genChart Int
n Int
i ChartSpace
ch = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
path Text
contentType Text
relType ByteString
contents
  where
    path :: FilePath
path = FilePath
"xl/charts/chart" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
n forall a. Semigroup a => a -> a -> a
<> FilePath
"_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
i forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
    contentType :: Text
contentType =
      Text
"application/vnd.openxmlformats-officedocument.drawingml.chart+xml"
    relType :: Text
relType = Text
"chart"
    contents :: ByteString
contents = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def {rsNamespaces :: [(Text, Text)]
rsNamespaces = [(Text, Text)]
nss} forall a b. (a -> b) -> a -> b
$ forall a. ToDocument a => a -> Document
toDocument ChartSpace
ch
    nss :: [(Text, Text)]
nss =
      [ (Text
"c", Text
"http://schemas.openxmlformats.org/drawingml/2006/chart")
      , (Text
"a", Text
"http://schemas.openxmlformats.org/drawingml/2006/main")
      ]

data PvGenerated = PvGenerated
  { PvGenerated -> [(CacheId, FileData)]
pvgCacheFiles :: [(CacheId, FileData)]
  , PvGenerated -> [[FileData]]
pvgSheetTableFiles :: [[FileData]]
  , PvGenerated -> [FileData]
pvgOthers :: [FileData]
  }

generatePivotFiles :: [(CellMap, [PivotTable])] -> PvGenerated
generatePivotFiles :: [(CellMap, [PivotTable])] -> PvGenerated
generatePivotFiles [(CellMap, [PivotTable])]
cmTables = [(CacheId, FileData)] -> [[FileData]] -> [FileData] -> PvGenerated
PvGenerated [(CacheId, FileData)]
cacheFiles [[FileData]]
shTableFiles [FileData]
others
  where
    cacheFiles :: [(CacheId, FileData)]
cacheFiles = [(CacheId, FileData)
cacheFile | ((CacheId, FileData)
cacheFile, FileData
_, [FileData]
_) <- [((CacheId, FileData), FileData, [FileData])]
flatRendered]
    shTableFiles :: [[FileData]]
shTableFiles = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (\((CacheId, FileData)
_, FileData
tableFile, [FileData]
_) -> FileData
tableFile)) [[((CacheId, FileData), FileData, [FileData])]]
rendered
    others :: [FileData]
others = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FileData]
other | ((CacheId, FileData)
_, FileData
_, [FileData]
other) <- [((CacheId, FileData), FileData, [FileData])]
flatRendered]
    firstCacheId :: Int
firstCacheId = Int
1
    flatRendered :: [((CacheId, FileData), FileData, [FileData])]
flatRendered = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((CacheId, FileData), FileData, [FileData])]]
rendered
    (Int
_, [[((CacheId, FileData), FileData, [FileData])]]
rendered) =
      forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
        (\Int
c (CellMap
cm, [PivotTable]
ts) -> forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\Int
c' PivotTable
t -> (Int
c' forall a. Num a => a -> a -> a
+ Int
1, CellMap
-> Int -> PivotTable -> ((CacheId, FileData), FileData, [FileData])
render CellMap
cm Int
c' PivotTable
t)) Int
c [PivotTable]
ts)
        Int
firstCacheId
        [(CellMap, [PivotTable])]
cmTables
    render :: CellMap
-> Int -> PivotTable -> ((CacheId, FileData), FileData, [FileData])
render CellMap
cm Int
cacheIdRaw PivotTable
tbl =
      let PivotTableFiles {ByteString
pvtfCacheRecords :: PivotTableFiles -> ByteString
pvtfCacheDefinition :: PivotTableFiles -> ByteString
pvtfTable :: PivotTableFiles -> ByteString
pvtfCacheRecords :: ByteString
pvtfCacheDefinition :: ByteString
pvtfTable :: ByteString
..} = CellMap -> Int -> PivotTable -> PivotTableFiles
renderPivotTableFiles CellMap
cm Int
cacheIdRaw PivotTable
tbl
          cacheId :: CacheId
cacheId = Int -> CacheId
CacheId Int
cacheIdRaw
          cacheIdStr :: FilePath
cacheIdStr = forall a. Show a => a -> FilePath
show Int
cacheIdRaw
          cachePath :: FilePath
cachePath =
            FilePath
"xl/pivotCache/pivotCacheDefinition" forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
          cacheFile :: FileData
cacheFile =
            FilePath -> Text -> Text -> ByteString -> FileData
FileData
              FilePath
cachePath
              (Text -> Text
smlCT Text
"pivotCacheDefinition")
              Text
"pivotCacheDefinition"
              ByteString
pvtfCacheDefinition
          recordsPath :: FilePath
recordsPath =
            FilePath
"xl/pivotCache/pivotCacheRecords" forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
          recordsFile :: FileData
recordsFile =
            FilePath -> Text -> Text -> ByteString -> FileData
FileData
            FilePath
recordsPath
            (Text -> Text
smlCT Text
"pivotCacheRecords")
            Text
"pivotCacheRecords"
            ByteString
pvtfCacheRecords
          cacheRelsFile :: FileData
cacheRelsFile =
            FilePath -> Text -> Text -> ByteString -> FileData
FileData
            (FilePath
"xl/pivotCache/_rels/pivotCacheDefinition" forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
            Text
relsCT
            Text
"relationships" forall a b. (a -> b) -> a -> b
$
            [(RefId, Relationship)] -> ByteString
renderRels [FilePath -> ReferencedFileData -> (RefId, Relationship)
refFileDataToRel FilePath
cachePath (Int -> RefId
unsafeRefId Int
1, FileData
recordsFile)]
          renderRels :: [(RefId, Relationship)] -> ByteString
renderRels = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList
          tablePath :: FilePath
tablePath = FilePath
"xl/pivotTables/pivotTable" forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
          tableFile :: FileData
tableFile =
            FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
tablePath (Text -> Text
smlCT Text
"pivotTable") Text
"pivotTable" ByteString
pvtfTable
          tableRels :: FileData
tableRels =
            FilePath -> Text -> Text -> ByteString -> FileData
FileData
              (FilePath
"xl/pivotTables/_rels/pivotTable" forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
              Text
relsCT
              Text
"relationships" forall a b. (a -> b) -> a -> b
$
            [(RefId, Relationship)] -> ByteString
renderRels [FilePath -> ReferencedFileData -> (RefId, Relationship)
refFileDataToRel FilePath
tablePath (Int -> RefId
unsafeRefId Int
1, FileData
cacheFile)]
      in ((CacheId
cacheId, FileData
cacheFile), FileData
tableFile, [FileData
tableRels, FileData
cacheRelsFile, FileData
recordsFile])

genTable :: Table -> Int -> FileData
genTable :: Table -> Int -> FileData
genTable Table
tbl Int
tblId = FileData{FilePath
ByteString
Text
fdContents :: ByteString
fdRelType :: Text
fdContentType :: Text
fdPath :: FilePath
fdRelType :: Text
fdContentType :: Text
fdContents :: ByteString
fdPath :: FilePath
..}
  where
    fdPath :: FilePath
fdPath = FilePath
"xl/tables/table" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
tblId forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
    fdContentType :: Text
fdContentType = Text -> Text
smlCT Text
"table"
    fdRelType :: Text
fdRelType = Text
"table"
    fdContents :: ByteString
fdContents = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Table -> Int -> Document
tableToDocument Table
tbl Int
tblId

data FileData = FileData { FileData -> FilePath
fdPath        :: FilePath
                         , FileData -> Text
fdContentType :: Text
                         , FileData -> Text
fdRelType     :: Text
                         , FileData -> ByteString
fdContents    :: L.ByteString }

type ReferencedFileData = (RefId, FileData)

refFileDataToRel :: FilePath -> ReferencedFileData -> (RefId, Relationship)
refFileDataToRel :: FilePath -> ReferencedFileData -> (RefId, Relationship)
refFileDataToRel FilePath
basePath (RefId
i, FileData {FilePath
ByteString
Text
fdContents :: ByteString
fdRelType :: Text
fdContentType :: Text
fdPath :: FilePath
fdRelType :: FileData -> Text
fdContentType :: FileData -> Text
fdContents :: FileData -> ByteString
fdPath :: FileData -> FilePath
..}) =
    RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry RefId
i Text
fdRelType (FilePath
fdPath FilePath -> FilePath -> FilePath
`relFrom` FilePath
basePath)

type Cells = [(RowIndex, [(ColumnIndex, XlsxCell)])]

coreXml :: UTCTime -> Text -> L.ByteString
coreXml :: UTCTime -> Text -> ByteString
coreXml UTCTime
created Text
creator =
  RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
  where
    nss :: [(Text, Text)]
nss = [ (Text
"cp", Text
"http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
          , (Text
"dc", Text
"http://purl.org/dc/elements/1.1/")
          , (Text
"dcterms", Text
"http://purl.org/dc/terms/")
          , (Text
"xsi",Text
"http://www.w3.org/2001/XMLSchema-instance")
          ]
    namespaced :: Text -> Text -> Name
namespaced = [(Text, Text)] -> Text -> Text -> Name
nsName [(Text, Text)]
nss
    date :: Text
date = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%FT%T%QZ" UTCTime
created
    root :: Element
root = Name -> Map Name Text -> [Node] -> Element
Element (Text -> Text -> Name
namespaced Text
"cp" Text
"coreProperties") forall k a. Map k a
M.empty
           [ Name -> Map Name Text -> [Node] -> Node
nEl (Text -> Text -> Name
namespaced Text
"dcterms" Text
"created")
                     (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text -> Text -> Name
namespaced Text
"xsi" Text
"type", Text
"dcterms:W3CDTF")]) [Text -> Node
NodeContent Text
date]
           , Name -> Map Name Text -> [Node] -> Node
nEl (Text -> Text -> Name
namespaced Text
"dc" Text
"creator") forall k a. Map k a
M.empty [Text -> Node
NodeContent Text
creator]
           , Name -> Map Name Text -> [Node] -> Node
nEl (Text -> Text -> Name
namespaced Text
"cp" Text
"lastModifiedBy") forall k a. Map k a
M.empty [Text -> Node
NodeContent Text
creator]
           ]

appXml :: [Text] -> L.ByteString
appXml :: [Text] -> ByteString
appXml [Text]
sheetNames =
    RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
  where
    sheetCount :: Int
sheetCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sheetNames
    root :: Element
root = Name -> Map Name Text -> [Node] -> Element
Element (Text -> Name
extPropNm Text
"Properties") Map Name Text
nsAttrs
           [ Text -> [Node] -> Node
extPropEl Text
"TotalTime" [Text -> Node
NodeContent Text
"0"]
           , Text -> [Node] -> Node
extPropEl Text
"HeadingPairs" [
                   Text -> Map Name Text -> [Node] -> Node
vTypeEl Text
"vector" (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
"size", Text
"2")
                                                , (Name
"baseType", Text
"variant")])
                       [ Text -> [Node] -> Node
vTypeEl0 Text
"variant"
                           [Text -> [Node] -> Node
vTypeEl0 Text
"lpstr" [Text -> Node
NodeContent Text
"Worksheets"]]
                       , Text -> [Node] -> Node
vTypeEl0 Text
"variant"
                           [Text -> [Node] -> Node
vTypeEl0 Text
"i4" [Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Text
txti Int
sheetCount]]
                       ]
                   ]
           , Text -> [Node] -> Node
extPropEl Text
"TitlesOfParts" [
                   Text -> Map Name Text -> [Node] -> Node
vTypeEl Text
"vector" (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
"size",     forall a. Integral a => a -> Text
txti Int
sheetCount)
                                                , (Name
"baseType", Text
"lpstr")]) forall a b. (a -> b) -> a -> b
$
                       forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Node] -> Node
vTypeEl0 Text
"lpstr" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
NodeContent) [Text]
sheetNames
                   ]
           ]
    nsAttrs :: Map Name Text
nsAttrs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name
"xmlns:vt", Text
"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")]
    extPropNm :: Text -> Name
extPropNm Text
n = Text -> Text -> Name
nm Text
"http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" Text
n
    extPropEl :: Text -> [Node] -> Node
extPropEl Text
n = Name -> Map Name Text -> [Node] -> Node
nEl (Text -> Name
extPropNm Text
n) forall k a. Map k a
M.empty
    vTypeEl0 :: Text -> [Node] -> Node
vTypeEl0 Text
n = Text -> Map Name Text -> [Node] -> Node
vTypeEl Text
n forall k a. Map k a
M.empty
    vTypeEl :: Text -> Map Name Text -> [Node] -> Node
vTypeEl = Name -> Map Name Text -> [Node] -> Node
nEl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Name
nm Text
"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes"

data XlsxCellData
  = XlsxSS Int
  | XlsxDouble Double
  | XlsxBool Bool
  | XlsxError ErrorType
  deriving (XlsxCellData -> XlsxCellData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XlsxCellData -> XlsxCellData -> Bool
$c/= :: XlsxCellData -> XlsxCellData -> Bool
== :: XlsxCellData -> XlsxCellData -> Bool
$c== :: XlsxCellData -> XlsxCellData -> Bool
Eq, Int -> XlsxCellData -> FilePath -> FilePath
[XlsxCellData] -> FilePath -> FilePath
XlsxCellData -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [XlsxCellData] -> FilePath -> FilePath
$cshowList :: [XlsxCellData] -> FilePath -> FilePath
show :: XlsxCellData -> FilePath
$cshow :: XlsxCellData -> FilePath
showsPrec :: Int -> XlsxCellData -> FilePath -> FilePath
$cshowsPrec :: Int -> XlsxCellData -> FilePath -> FilePath
Show, forall x. Rep XlsxCellData x -> XlsxCellData
forall x. XlsxCellData -> Rep XlsxCellData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XlsxCellData x -> XlsxCellData
$cfrom :: forall x. XlsxCellData -> Rep XlsxCellData x
Generic)

data XlsxCell = XlsxCell
    { XlsxCell -> Maybe Int
xlsxCellStyle   :: Maybe Int
    , XlsxCell -> Maybe XlsxCellData
xlsxCellValue   :: Maybe XlsxCellData
    , XlsxCell -> Maybe Comment
xlsxComment     :: Maybe Comment
    , XlsxCell -> Maybe CellFormula
xlsxCellFormula :: Maybe CellFormula
    } deriving (XlsxCell -> XlsxCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XlsxCell -> XlsxCell -> Bool
$c/= :: XlsxCell -> XlsxCell -> Bool
== :: XlsxCell -> XlsxCell -> Bool
$c== :: XlsxCell -> XlsxCell -> Bool
Eq, Int -> XlsxCell -> FilePath -> FilePath
[XlsxCell] -> FilePath -> FilePath
XlsxCell -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [XlsxCell] -> FilePath -> FilePath
$cshowList :: [XlsxCell] -> FilePath -> FilePath
show :: XlsxCell -> FilePath
$cshow :: XlsxCell -> FilePath
showsPrec :: Int -> XlsxCell -> FilePath -> FilePath
$cshowsPrec :: Int -> XlsxCell -> FilePath -> FilePath
Show, forall x. Rep XlsxCell x -> XlsxCell
forall x. XlsxCell -> Rep XlsxCell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XlsxCell x -> XlsxCell
$cfrom :: forall x. XlsxCell -> Rep XlsxCell x
Generic)

xlsxCellType :: XlsxCell -> Text
xlsxCellType :: XlsxCell -> Text
xlsxCellType XlsxCell{xlsxCellValue :: XlsxCell -> Maybe XlsxCellData
xlsxCellValue=Just(XlsxSS Int
_)} = Text
"s"
xlsxCellType XlsxCell{xlsxCellValue :: XlsxCell -> Maybe XlsxCellData
xlsxCellValue=Just(XlsxBool Bool
_)} = Text
"b"
xlsxCellType XlsxCell{xlsxCellValue :: XlsxCell -> Maybe XlsxCellData
xlsxCellValue=Just(XlsxError ErrorType
_)} = Text
"e"
xlsxCellType XlsxCell
_ = Text
"n" -- default in SpreadsheetML schema, TODO: add other types

value :: XlsxCellData -> Text
value :: XlsxCellData -> Text
value (XlsxSS Int
i)       = forall a. Integral a => a -> Text
txti Int
i
value (XlsxDouble Double
d)   = Double -> Text
txtd Double
d
value (XlsxBool Bool
True)  = Text
"1"
value (XlsxBool Bool
False) = Text
"0"
value (XlsxError ErrorType
eType) = forall a. ToAttrVal a => a -> Text
toAttrVal ErrorType
eType

transformSheetData :: SharedStringTable -> Worksheet -> Cells
transformSheetData :: SharedStringTable -> Worksheet -> Cells
transformSheetData SharedStringTable
shared Worksheet
ws = forall a b. (a -> b) -> [a] -> [b]
map forall {d} {a}. (d, [(a, Cell)]) -> (d, [(a, XlsxCell)])
transformRow forall a b. (a -> b) -> a -> b
$ CellMap -> [(RowIndex, [(ColumnIndex, Cell)])]
toRows (Worksheet
ws forall s a. s -> Getting a s a -> a
^. Lens' Worksheet CellMap
wsCells)
  where
    transformRow :: (d, [(a, Cell)]) -> (d, [(a, XlsxCell)])
transformRow = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, Cell) -> (a, XlsxCell)
transformCell)
    transformCell :: (a, Cell) -> (a, XlsxCell)
transformCell (a
c, Cell{Maybe Int
Maybe CellValue
Maybe Comment
Maybe CellFormula
_cellFormula :: Cell -> Maybe CellFormula
_cellComment :: Cell -> Maybe Comment
_cellValue :: Cell -> Maybe CellValue
_cellStyle :: Cell -> Maybe Int
_cellFormula :: Maybe CellFormula
_cellComment :: Maybe Comment
_cellValue :: Maybe CellValue
_cellStyle :: Maybe Int
..}) =
        (a
c, Maybe Int
-> Maybe XlsxCellData
-> Maybe Comment
-> Maybe CellFormula
-> XlsxCell
XlsxCell Maybe Int
_cellStyle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CellValue -> XlsxCellData
transformValue Maybe CellValue
_cellValue) Maybe Comment
_cellComment Maybe CellFormula
_cellFormula)
    transformValue :: CellValue -> XlsxCellData
transformValue (CellText Text
t) = Int -> XlsxCellData
XlsxSS (SharedStringTable -> Text -> Int
sstLookupText SharedStringTable
shared Text
t)
    transformValue (CellDouble Double
dbl) =  Double -> XlsxCellData
XlsxDouble Double
dbl
    transformValue (CellBool Bool
b) = Bool -> XlsxCellData
XlsxBool Bool
b
    transformValue (CellRich [RichTextRun]
r) = Int -> XlsxCellData
XlsxSS (SharedStringTable -> [RichTextRun] -> Int
sstLookupRich SharedStringTable
shared [RichTextRun]
r)
    transformValue (CellError ErrorType
e) = ErrorType -> XlsxCellData
XlsxError ErrorType
e

bookFiles :: Xlsx -> [FileData]
bookFiles :: Xlsx -> [FileData]
bookFiles Xlsx
xlsx = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  STRef s Int
ref <- forall a s. a -> ST s (STRef s a)
newSTRef Int
1
  RefId
ssRId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
  let sheets :: [Worksheet]
sheets = Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx [(Text, Worksheet)]
xlSheets forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a b. (a, b) -> b
snd
      shared :: SharedStringTable
shared = [Worksheet] -> SharedStringTable
sstConstruct [Worksheet]
sheets
      sharedStrings :: ReferencedFileData
sharedStrings =
        (RefId
ssRId, FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"xl/sharedStrings.xml" (Text -> Text
smlCT Text
"sharedStrings") Text
"sharedStrings" forall a b. (a -> b) -> a -> b
$
              SharedStringTable -> ByteString
ssXml SharedStringTable
shared)
  RefId
stRId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
  let style :: ReferencedFileData
style =
        (RefId
stRId, FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"xl/styles.xml" (Text -> Text
smlCT Text
"styles") Text
"styles" forall a b. (a -> b) -> a -> b
$
              Styles -> ByteString
unStyles (Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx Styles
xlStyles))
  let PvGenerated { pvgCacheFiles :: PvGenerated -> [(CacheId, FileData)]
pvgCacheFiles = [(CacheId, FileData)]
cacheIdFiles
                  , pvgOthers :: PvGenerated -> [FileData]
pvgOthers = [FileData]
pivotOtherFiles
                  , pvgSheetTableFiles :: PvGenerated -> [[FileData]]
pvgSheetTableFiles = [[FileData]]
sheetPivotTables
                  } =
        [(CellMap, [PivotTable])] -> PvGenerated
generatePivotFiles
          [ (CellMap
_wsCells, [PivotTable]
_wsPivotTables)
          | (Text
_, Worksheet {[Range]
[PivotTable]
[Table]
[ColumnsProperties]
Maybe [SheetView]
Maybe SheetProtection
Maybe PageSetup
Maybe Drawing
Maybe AutoFilter
CellMap
Map SqRef ConditionalFormatting
Map SqRef DataValidation
Map RowIndex RowProperties
Map SharedFormulaIndex SharedFormulaOptions
SheetState
_wsState :: Worksheet -> SheetState
_wsSharedFormulas :: Worksheet -> Map SharedFormulaIndex SharedFormulaOptions
_wsProtection :: Worksheet -> Maybe SheetProtection
_wsAutoFilter :: Worksheet -> Maybe AutoFilter
_wsPivotTables :: Worksheet -> [PivotTable]
_wsDataValidations :: Worksheet -> Map SqRef DataValidation
_wsConditionalFormattings :: Worksheet -> Map SqRef ConditionalFormatting
_wsPageSetup :: Worksheet -> Maybe PageSetup
_wsSheetViews :: Worksheet -> Maybe [SheetView]
_wsMerges :: Worksheet -> [Range]
_wsDrawing :: Worksheet -> Maybe Drawing
_wsCells :: Worksheet -> CellMap
_wsRowPropertiesMap :: Worksheet -> Map RowIndex RowProperties
_wsColumnsProperties :: Worksheet -> [ColumnsProperties]
_wsState :: SheetState
_wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions
_wsProtection :: Maybe SheetProtection
_wsTables :: [Table]
_wsAutoFilter :: Maybe AutoFilter
_wsDataValidations :: Map SqRef DataValidation
_wsConditionalFormattings :: Map SqRef ConditionalFormatting
_wsPageSetup :: Maybe PageSetup
_wsSheetViews :: Maybe [SheetView]
_wsMerges :: [Range]
_wsDrawing :: Maybe Drawing
_wsRowPropertiesMap :: Map RowIndex RowProperties
_wsColumnsProperties :: [ColumnsProperties]
_wsPivotTables :: [PivotTable]
_wsCells :: CellMap
_wsTables :: Worksheet -> [Table]
..}) <- Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx [(Text, Worksheet)]
xlSheets
          ]
      sheetCells :: [Cells]
sheetCells = forall a b. (a -> b) -> [a] -> [b]
map (SharedStringTable -> Worksheet -> Cells
transformSheetData SharedStringTable
shared) [Worksheet]
sheets
      sheetInputs :: [(Cells, [FileData], Worksheet)]
sheetInputs = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Cells]
sheetCells [[FileData]]
sheetPivotTables [Worksheet]
sheets
  STRef s Int
tblIdRef <- forall a s. a -> ST s (STRef s a)
newSTRef Int
1
  [(ReferencedFileData, [FileData])]
allSheetFiles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Cells, [FileData], Worksheet)]
sheetInputs) forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cells
cells, [FileData]
pvTables, Worksheet
sheet)) -> do
    RefId
rId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
    (FileData
sheetFile, [FileData]
others) <- forall s.
Int
-> Cells
-> [FileData]
-> Worksheet
-> STRef s Int
-> ST s (FileData, [FileData])
singleSheetFiles Int
i Cells
cells [FileData]
pvTables Worksheet
sheet STRef s Int
tblIdRef
    forall (m :: * -> *) a. Monad m => a -> m a
return ((RefId
rId, FileData
sheetFile), [FileData]
others)
  let sheetFiles :: [ReferencedFileData]
sheetFiles = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ReferencedFileData, [FileData])]
allSheetFiles
      sheetAttrsByRId :: [(RefId, Text, SheetState)]
sheetAttrsByRId =
        forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(RefId
rId, FileData
_) (Text
name, Worksheet
sheet) -> (RefId
rId, Text
name, Worksheet
sheet forall s a. s -> Getting a s a -> a
^. Lens' Worksheet SheetState
wsState))
          [ReferencedFileData]
sheetFiles
          (Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx [(Text, Worksheet)]
xlSheets)
      sheetOthers :: [FileData]
sheetOthers = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(ReferencedFileData, [FileData])]
allSheetFiles
  [(CacheId, ReferencedFileData)]
cacheRefFDsById <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(CacheId, FileData)]
cacheIdFiles forall a b. (a -> b) -> a -> b
$ \(CacheId
cacheId, FileData
fd) -> do
      RefId
refId <- forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
      forall (m :: * -> *) a. Monad m => a -> m a
return (CacheId
cacheId, (RefId
refId, FileData
fd))
  let cacheRefsById :: [(CacheId, RefId)]
cacheRefsById = [ (CacheId
cId, RefId
rId) | (CacheId
cId, (RefId
rId, FileData
_)) <- [(CacheId, ReferencedFileData)]
cacheRefFDsById ]
      cacheRefs :: [ReferencedFileData]
cacheRefs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(CacheId, ReferencedFileData)]
cacheRefFDsById
      bookFile :: FileData
bookFile = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"xl/workbook.xml" (Text -> Text
smlCT Text
"sheet.main") Text
"officeDocument" forall a b. (a -> b) -> a -> b
$
                 [(RefId, Text, SheetState)]
-> DefinedNames -> [(CacheId, RefId)] -> DateBase -> ByteString
bookXml [(RefId, Text, SheetState)]
sheetAttrsByRId (Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx DefinedNames
xlDefinedNames) [(CacheId, RefId)]
cacheRefsById (Xlsx
xlsx forall s a. s -> Getting a s a -> a
^. Lens' Xlsx DateBase
xlDateBase)
      rels :: FileData
rels = FilePath -> Text -> Text -> ByteString -> FileData
FileData FilePath
"xl/_rels/workbook.xml.rels"
             Text
"application/vnd.openxmlformats-package.relationships+xml"
             Text
"relationships" ByteString
relsXml
      relsXml :: ByteString
relsXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList forall a b. (a -> b) -> a -> b
$
            [ RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry RefId
i Text
fdRelType (FilePath
fdPath FilePath -> FilePath -> FilePath
`relFrom` FilePath
"xl/workbook.xml")
            | (RefId
i, FileData{FilePath
ByteString
Text
fdContents :: ByteString
fdContentType :: Text
fdPath :: FilePath
fdRelType :: Text
fdRelType :: FileData -> Text
fdContentType :: FileData -> Text
fdContents :: FileData -> ByteString
fdPath :: FileData -> FilePath
..}) <- [ReferencedFileData]
referenced ]
      referenced :: [ReferencedFileData]
referenced = ReferencedFileData
sharedStringsforall a. a -> [a] -> [a]
:ReferencedFileData
styleforall a. a -> [a] -> [a]
:[ReferencedFileData]
sheetFiles forall a. [a] -> [a] -> [a]
++ [ReferencedFileData]
cacheRefs
      otherFiles :: [FileData]
otherFiles = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FileData
relsforall a. a -> [a] -> [a]
:(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [ReferencedFileData]
referenced), [FileData]
pivotOtherFiles, [FileData]
sheetOthers]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FileData
bookFileforall a. a -> [a] -> [a]
:[FileData]
otherFiles

bookXml :: [(RefId, Text, SheetState)]
        -> DefinedNames
        -> [(CacheId, RefId)]
        -> DateBase
        -> L.ByteString
bookXml :: [(RefId, Text, SheetState)]
-> DefinedNames -> [(CacheId, RefId)] -> DateBase -> ByteString
bookXml [(RefId, Text, SheetState)]
rIdAttrs (DefinedNames [(Text, Maybe Text, Text)]
names) [(CacheId, RefId)]
cacheIdRefs DateBase
dateBase =
  RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def {rsNamespaces :: [(Text, Text)]
rsNamespaces = [(Text, Text)]
nss} forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
  where
    nss :: [(Text, Text)]
nss = [ (Text
"r", Text
"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 :: Element
root =
      Text -> Maybe Text -> Element -> Element
addNS Text
"http://schemas.openxmlformats.org/spreadsheetml/2006/main" forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
      Name -> [Element] -> Element
elementListSimple
        Name
"workbook"
        ( [ Name -> [(Name, Text)] -> Element
leafElement Name
"workbookPr" (forall a. [Maybe a] -> [a]
catMaybes [Name
"date1904" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue (DateBase
dateBase forall a. Eq a => a -> a -> Bool
== DateBase
DateBase1904) ])
          , Name -> [Element] -> Element
elementListSimple Name
"bookViews" [Name -> Element
emptyElement Name
"workbookView"]
          , Name -> [Element] -> Element
elementListSimple
            Name
"sheets"
            [ Name -> [(Name, Text)] -> Element
leafElement
              Name
"sheet"
              [Name
"name" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name, Name
"sheetId" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
i, Name
"state" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= SheetState
state, (Text -> Name
odr Text
"id") forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId]
            | (Int
i, (RefId
rId, Text
name, SheetState
state)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [(RefId, Text, SheetState)]
rIdAttrs
            ]
          , Name -> [Element] -> Element
elementListSimple
            Name
"definedNames"
            [ Name -> [(Name, Text)] -> Text -> Element
elementContent0 Name
"definedName" (Text -> Maybe Text -> [(Name, Text)]
definedName Text
name Maybe Text
lsId) Text
val
            | (Text
name, Maybe Text
lsId, Text
val) <- [(Text, Maybe Text, Text)]
names
            ]
          ] forall a. [a] -> [a] -> [a]
++
          forall a. Maybe a -> [a]
maybeToList
          (Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"pivotCaches" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. ToAttrVal a => (CacheId, a) -> Element
pivotCacheEl [(CacheId, RefId)]
cacheIdRefs)
        )

    pivotCacheEl :: (CacheId, a) -> Element
pivotCacheEl (CacheId Int
cId, a
refId) =
      Name -> [(Name, Text)] -> Element
leafElement Name
"pivotCache" [Name
"cacheId" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
cId, (Text -> Name
odr Text
"id") forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= a
refId]

    definedName :: Text -> Maybe Text -> [(Name, Text)]
    definedName :: Text -> Maybe Text -> [(Name, Text)]
definedName Text
name Maybe Text
Nothing = [Name
"name" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name]
    definedName Text
name (Just Text
lsId) = [Name
"name" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name, Name
"localSheetId" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
lsId]

ssXml :: SharedStringTable -> L.ByteString
ssXml :: SharedStringTable -> ByteString
ssXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument

customPropsXml :: CustomProperties -> L.ByteString
customPropsXml :: CustomProperties -> ByteString
customPropsXml = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDocument a => a -> Document
toDocument

contentTypesXml :: [FileData] -> L.ByteString
contentTypesXml :: [FileData] -> ByteString
contentTypesXml [FileData]
fds = RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
  where
    root :: Element
root = Text -> Maybe Text -> Element -> Element
addNS Text
"http://schemas.openxmlformats.org/package/2006/content-types" forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
           Name -> Map Name Text -> [Node] -> Element
Element Name
"Types" forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$
           forall a b. (a -> b) -> [a] -> [b]
map (\FileData
fd -> Name -> Map Name Text -> [Node] -> Node
nEl Name
"Override" (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList  [(Name
"PartName", [Text] -> Text
T.concat [Text
"/", FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FileData -> FilePath
fdPath FileData
fd]),
                                       (Name
"ContentType", FileData -> Text
fdContentType FileData
fd)]) []) [FileData]
fds

-- | fully qualified XML name
qName :: Text -> Text -> Text -> Name
qName :: Text -> Text -> Text -> Name
qName Text
n Text
ns Text
p =
    Name
    { nameLocalName :: Text
nameLocalName = Text
n
    , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
ns
    , namePrefix :: Maybe Text
namePrefix = forall a. a -> Maybe a
Just Text
p
    }

-- | fully qualified XML name from prefix to ns URL mapping
nsName :: [(Text, Text)] -> Text -> Text -> Name
nsName :: [(Text, Text)] -> Text -> Text -> Name
nsName [(Text, Text)]
nss Text
p Text
n = Text -> Text -> Text -> Name
qName Text
n Text
ns Text
p
    where
      ns :: Text
ns = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"ns name lookup" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
p [(Text, Text)]
nss

nm :: Text -> Text -> Name
nm :: Text -> Text -> Name
nm Text
ns Text
n = Name
  { nameLocalName :: Text
nameLocalName = Text
n
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
ns
  , namePrefix :: Maybe Text
namePrefix = forall a. Maybe a
Nothing}

nEl :: Name -> Map Name Text -> [Node] -> Node
nEl :: Name -> Map Name Text -> [Node] -> Node
nEl Name
name Map Name Text
attrs [Node]
nodes = Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
Element Name
name Map Name Text
attrs [Node]
nodes

-- | Creates element holding reference to some linked file
refElement :: Name -> RefId -> Element
refElement :: Name -> RefId -> Element
refElement Name
name RefId
rId = Name -> [(Name, Text)] -> Element
leafElement Name
name [ Text -> Name
odr Text
"id" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId ]

smlCT :: Text -> Text
smlCT :: Text -> Text
smlCT Text
t =
  Text
"application/vnd.openxmlformats-officedocument.spreadsheetml." forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"+xml"

relsCT :: Text
relsCT :: Text
relsCT = Text
"application/vnd.openxmlformats-package.relationships+xml"