{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Writer
( fromXlsx
) where
import qualified 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
fromXlsx :: POSIXTime -> Xlsx -> L.ByteString
fromXlsx :: POSIXTime -> Xlsx -> ByteString
fromXlsx POSIXTime
pt Xlsx
xlsx =
Archive -> ByteString
Zip.fromArchive (Archive -> ByteString) -> Archive -> ByteString
forall a b. (a -> b) -> a -> b
$ (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
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 = POSIXTime -> Integer
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) Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:
(FileData -> Entry) -> [FileData] -> [Entry]
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 [FileData] -> [FileData] -> [FileData]
forall a. [a] -> [a] -> [a]
++ [FileData]
customPropFiles [FileData] -> [FileData] -> [FileData]
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" (ByteString -> FileData) -> ByteString -> FileData
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" (ByteString -> FileData) -> ByteString -> FileData
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> (Relationships -> Document) -> Relationships -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Document
forall a. ToDocument a => a -> Document
toDocument (Relationships -> ByteString) -> Relationships -> ByteString
forall a b. (a -> b) -> a -> b
$ [(RefId, Relationship)] -> Relationships
Relationships.fromList [(RefId, Relationship)]
rootRels
rootFiles :: [(Text, FilePath)]
rootFiles = [(Text, FilePath)]
customPropFileRels [(Text, FilePath)] -> [(Text, FilePath)] -> [(Text, FilePath)]
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)) <- [Int] -> [(Text, FilePath)] -> [(Int, (Text, FilePath))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Text, FilePath)]
rootFiles ]
customProps :: Map Text Variant
customProps = Xlsx
xlsx Xlsx
-> Getting (Map Text Variant) Xlsx (Map Text Variant)
-> Map Text Variant
forall s a. s -> Getting a s a -> a
^. Getting (Map Text Variant) Xlsx (Map Text Variant)
Lens' Xlsx (Map Text Variant)
xlCustomProperties
([FileData]
customPropFiles, [(Text, FilePath)]
customPropFileRels) = case Map Text Variant -> Bool
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 Xlsx -> Getting [Text] Xlsx [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. ([(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Xlsx -> Const [Text] Xlsx
Lens' Xlsx [(Text, Worksheet)]
xlSheets (([(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Xlsx -> Const [Text] Xlsx)
-> (([Text] -> Const [Text] [Text])
-> [(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Getting [Text] Xlsx [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Worksheet)] -> [Text])
-> ([Text] -> Const [Text] [Text])
-> [(Text, Worksheet)]
-> Const [Text] [(Text, Worksheet)]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (((Text, Worksheet) -> Text) -> [(Text, Worksheet)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Worksheet) -> Text
forall a b. (a, b) -> a
fst)
singleSheetFiles :: Int
-> Cells
-> [FileData]
-> Worksheet
-> STRef s Int
-> ST s (FileData, [FileData])
singleSheetFiles :: 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 <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
1
Maybe (Element, [ReferencedFileData])
mCmntData <- Int
-> Cells
-> STRef s Int
-> ST s (Maybe (Element, [ReferencedFileData]))
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 <- ST s (Maybe (Element, ReferencedFileData, [FileData]))
-> (Drawing
-> ST s (Maybe (Element, ReferencedFileData, [FileData])))
-> Maybe Drawing
-> ST s (Maybe (Element, ReferencedFileData, [FileData]))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Element, ReferencedFileData, [FileData])
-> ST s (Maybe (Element, ReferencedFileData, [FileData]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Element, ReferencedFileData, [FileData])
forall a. Maybe a
Nothing) (((Element, ReferencedFileData, [FileData])
-> Maybe (Element, ReferencedFileData, [FileData]))
-> ST s (Element, ReferencedFileData, [FileData])
-> ST s (Maybe (Element, ReferencedFileData, [FileData]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element, ReferencedFileData, [FileData])
-> Maybe (Element, ReferencedFileData, [FileData])
forall a. a -> Maybe a
Just (ST s (Element, ReferencedFileData, [FileData])
-> ST s (Maybe (Element, ReferencedFileData, [FileData])))
-> (Drawing -> ST s (Element, ReferencedFileData, [FileData]))
-> Drawing
-> ST s (Maybe (Element, ReferencedFileData, [FileData]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> STRef s Int
-> Drawing
-> ST s (Element, ReferencedFileData, [FileData])
forall s.
Int
-> STRef s Int
-> Drawing
-> ST s (Element, ReferencedFileData, [FileData])
genDrawing Int
n STRef s Int
ref) (Worksheet
ws Worksheet
-> Getting (Maybe Drawing) Worksheet (Maybe Drawing)
-> Maybe Drawing
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Drawing) Worksheet (Maybe Drawing)
Lens' Worksheet (Maybe Drawing)
wsDrawing)
[ReferencedFileData]
pivRefs <- [FileData]
-> (FileData -> ST s ReferencedFileData)
-> ST s [ReferencedFileData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FileData]
pivFileDatas ((FileData -> ST s ReferencedFileData)
-> ST s [ReferencedFileData])
-> (FileData -> ST s ReferencedFileData)
-> ST s [ReferencedFileData]
forall a b. (a -> b) -> a -> b
$ \FileData
fd -> do
RefId
refId <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
ReferencedFileData -> ST s ReferencedFileData
forall (m :: * -> *) a. Monad m => a -> m a
return (RefId
refId, FileData
fd)
[ReferencedFileData]
refTables <- [Table]
-> (Table -> ST s ReferencedFileData) -> ST s [ReferencedFileData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Worksheet -> [Table]
_wsTables Worksheet
ws) ((Table -> ST s ReferencedFileData) -> ST s [ReferencedFileData])
-> (Table -> ST s ReferencedFileData) -> ST s [ReferencedFileData]
forall a b. (a -> b) -> a -> b
$ \Table
tbl -> do
RefId
refId <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
Int
tblId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
tblIdRef
STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
tblIdRef (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
ReferencedFileData -> ST s ReferencedFileData
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
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" (ByteString -> FileData) -> ByteString -> FileData
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 RenderSettings
forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
root :: Element
root = Text -> Maybe Text -> Element -> Element
addNS Text
"http://schemas.openxmlformats.org/spreadsheetml/2006/main" Maybe Text
forall a. Maybe a
Nothing (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Name -> [Element] -> Element
elementListSimple Name
"worksheet" [Element]
rootEls
rootEls :: [Element]
rootEls = [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Element]
forall a b. (a -> b) -> a -> b
$
[ Name -> [Element] -> Element
elementListSimple Name
"sheetViews" ([Element] -> Element)
-> ([SheetView] -> [Element]) -> [SheetView] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SheetView -> Element) -> [SheetView] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> SheetView -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"sheetView") ([SheetView] -> Element) -> Maybe [SheetView] -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Worksheet
ws Worksheet
-> Getting (Maybe [SheetView]) Worksheet (Maybe [SheetView])
-> Maybe [SheetView]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [SheetView]) Worksheet (Maybe [SheetView])
Lens' Worksheet (Maybe [SheetView])
wsSheetViews
, Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"cols" ([Element] -> Maybe Element)
-> ([ColumnsProperties] -> [Element])
-> [ColumnsProperties]
-> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnsProperties -> Element) -> [ColumnsProperties] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> ColumnsProperties -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"col") ([ColumnsProperties] -> Maybe Element)
-> [ColumnsProperties] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Worksheet
ws Worksheet
-> Getting [ColumnsProperties] Worksheet [ColumnsProperties]
-> [ColumnsProperties]
forall s a. s -> Getting a s a -> a
^. Getting [ColumnsProperties] Worksheet [ColumnsProperties]
Lens' Worksheet [ColumnsProperties]
wsColumnsProperties
, Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> ([Element] -> Element) -> [Element] -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Element] -> Element
elementListSimple Name
"sheetData" ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$
Cells
-> Map Int RowProperties
-> Map SharedFormulaIndex SharedFormulaOptions
-> [Element]
sheetDataXml Cells
cells (Worksheet
ws Worksheet
-> Getting
(Map Int RowProperties) Worksheet (Map Int RowProperties)
-> Map Int RowProperties
forall s a. s -> Getting a s a -> a
^. Getting (Map Int RowProperties) Worksheet (Map Int RowProperties)
Lens' Worksheet (Map Int RowProperties)
wsRowPropertiesMap) (Worksheet
ws Worksheet
-> Getting
(Map SharedFormulaIndex SharedFormulaOptions)
Worksheet
(Map SharedFormulaIndex SharedFormulaOptions)
-> Map SharedFormulaIndex SharedFormulaOptions
forall s a. s -> Getting a s a -> a
^. Getting
(Map SharedFormulaIndex SharedFormulaOptions)
Worksheet
(Map SharedFormulaIndex SharedFormulaOptions)
Lens' Worksheet (Map SharedFormulaIndex SharedFormulaOptions)
wsSharedFormulas)
, Name -> SheetProtection -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"sheetProtection" (SheetProtection -> Element)
-> Maybe SheetProtection -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Worksheet
ws Worksheet
-> Getting
(Maybe SheetProtection) Worksheet (Maybe SheetProtection)
-> Maybe SheetProtection
forall s a. s -> Getting a s a -> a
^. Getting (Maybe SheetProtection) Worksheet (Maybe SheetProtection)
Lens' Worksheet (Maybe SheetProtection)
wsProtection)
, Name -> AutoFilter -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"autoFilter" (AutoFilter -> Element) -> Maybe AutoFilter -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Worksheet
ws Worksheet
-> Getting (Maybe AutoFilter) Worksheet (Maybe AutoFilter)
-> Maybe AutoFilter
forall s a. s -> Getting a s a -> a
^. Getting (Maybe AutoFilter) Worksheet (Maybe AutoFilter)
Lens' Worksheet (Maybe AutoFilter)
wsAutoFilter)
, Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"mergeCells" ([Element] -> Maybe Element)
-> ([Range] -> [Element]) -> [Range] -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> Element) -> [Range] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Element
forall a. ToAttrVal a => a -> Element
mergeE1 ([Range] -> Maybe Element) -> [Range] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Worksheet
ws Worksheet -> Getting [Range] Worksheet [Range] -> [Range]
forall s a. s -> Getting a s a -> a
^. Getting [Range] Worksheet [Range]
Lens' Worksheet [Range]
wsMerges
] [Maybe Element] -> [Maybe Element] -> [Maybe Element]
forall a. [a] -> [a] -> [a]
++ (CfPair -> Maybe Element) -> [CfPair] -> [Maybe Element]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> (CfPair -> Element) -> CfPair -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CfPair -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"conditionalFormatting") [CfPair]
cfPairs [Maybe Element] -> [Maybe Element] -> [Maybe Element]
forall a. [a] -> [a] -> [a]
++
[ Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"dataValidations" ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ (DvPair -> Element) -> [DvPair] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> DvPair -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"dataValidation") [DvPair]
dvPairs
, Name -> PageSetup -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"pageSetup" (PageSetup -> Element) -> Maybe PageSetup -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Worksheet
ws Worksheet
-> Getting (Maybe PageSetup) Worksheet (Maybe PageSetup)
-> Maybe PageSetup
forall s a. s -> Getting a s a -> a
^. Getting (Maybe PageSetup) Worksheet (Maybe PageSetup)
Lens' Worksheet (Maybe PageSetup)
wsPageSetup
, (Element, ReferencedFileData, [FileData]) -> Element
forall a b c. (a, b, c) -> a
fst3 ((Element, ReferencedFileData, [FileData]) -> Element)
-> Maybe (Element, ReferencedFileData, [FileData]) -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, ReferencedFileData, [FileData])
mDrawingData
, (Element, [ReferencedFileData]) -> Element
forall a b. (a, b) -> a
fst ((Element, [ReferencedFileData]) -> Element)
-> Maybe (Element, [ReferencedFileData]) -> Maybe Element
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" Name -> RefId -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId] | (RefId
rId, FileData
_) <- [ReferencedFileData]
refTables]
]
cfPairs :: [CfPair]
cfPairs = ((SqRef, ConditionalFormatting) -> CfPair)
-> [(SqRef, ConditionalFormatting)] -> [CfPair]
forall a b. (a -> b) -> [a] -> [b]
map (SqRef, ConditionalFormatting) -> CfPair
CfPair ([(SqRef, ConditionalFormatting)] -> [CfPair])
-> (Map SqRef ConditionalFormatting
-> [(SqRef, ConditionalFormatting)])
-> Map SqRef ConditionalFormatting
-> [CfPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SqRef ConditionalFormatting -> [(SqRef, ConditionalFormatting)]
forall k a. Map k a -> [(k, a)]
M.toList (Map SqRef ConditionalFormatting -> [CfPair])
-> Map SqRef ConditionalFormatting -> [CfPair]
forall a b. (a -> b) -> a -> b
$ Worksheet
ws Worksheet
-> Getting
(Map SqRef ConditionalFormatting)
Worksheet
(Map SqRef ConditionalFormatting)
-> Map SqRef ConditionalFormatting
forall s a. s -> Getting a s a -> a
^. Getting
(Map SqRef ConditionalFormatting)
Worksheet
(Map SqRef ConditionalFormatting)
Lens' Worksheet (Map SqRef ConditionalFormatting)
wsConditionalFormattings
dvPairs :: [DvPair]
dvPairs = ((SqRef, DataValidation) -> DvPair)
-> [(SqRef, DataValidation)] -> [DvPair]
forall a b. (a -> b) -> [a] -> [b]
map (SqRef, DataValidation) -> DvPair
DvPair ([(SqRef, DataValidation)] -> [DvPair])
-> (Map SqRef DataValidation -> [(SqRef, DataValidation)])
-> Map SqRef DataValidation
-> [DvPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SqRef DataValidation -> [(SqRef, DataValidation)]
forall k a. Map k a -> [(k, a)]
M.toList (Map SqRef DataValidation -> [DvPair])
-> Map SqRef DataValidation -> [DvPair]
forall a b. (a -> b) -> a -> b
$ Worksheet
ws Worksheet
-> Getting
(Map SqRef DataValidation) Worksheet (Map SqRef DataValidation)
-> Map SqRef DataValidation
forall s a. s -> Getting a s a -> a
^. Getting
(Map SqRef DataValidation) Worksheet (Map SqRef DataValidation)
Lens' Worksheet (Map SqRef DataValidation)
wsDataValidations
mergeE1 :: a -> Element
mergeE1 a
r = Name -> [(Name, Text)] -> Element
leafElement Name
"mergeCell" [(Name
"ref" Name -> a -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= a
r)]
sheetRels :: [FileData]
sheetRels = if [FileData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileData]
referencedFiles
then []
else [ FilePath -> Text -> Text -> ByteString -> FileData
FileData (FilePath
"xl/worksheets/_rels/sheet" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> ([(RefId, Relationship)] -> Document)
-> [(RefId, Relationship)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Document
forall a. ToDocument a => a -> Document
toDocument (Relationships -> Document)
-> ([(RefId, Relationship)] -> Relationships)
-> [(RefId, Relationship)]
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList ([(RefId, Relationship)] -> ByteString)
-> [(RefId, Relationship)] -> ByteString
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 = [ReferencedFileData]
-> Maybe [ReferencedFileData] -> [ReferencedFileData]
forall a. a -> Maybe a -> a
fromMaybe [] ((Element, [ReferencedFileData]) -> [ReferencedFileData]
forall a b. (a, b) -> b
snd ((Element, [ReferencedFileData]) -> [ReferencedFileData])
-> Maybe (Element, [ReferencedFileData])
-> Maybe [ReferencedFileData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, [ReferencedFileData])
mCmntData) [ReferencedFileData]
-> [ReferencedFileData] -> [ReferencedFileData]
forall a. [a] -> [a] -> [a]
++
[Maybe ReferencedFileData] -> [ReferencedFileData]
forall a. [Maybe a] -> [a]
catMaybes [ (Element, ReferencedFileData, [FileData]) -> ReferencedFileData
forall a b c. (a, b, c) -> b
snd3 ((Element, ReferencedFileData, [FileData]) -> ReferencedFileData)
-> Maybe (Element, ReferencedFileData, [FileData])
-> Maybe ReferencedFileData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Element, ReferencedFileData, [FileData])
mDrawingData ] [ReferencedFileData]
-> [ReferencedFileData] -> [ReferencedFileData]
forall a. [a] -> [a] -> [a]
++
[ReferencedFileData]
pivRefs [ReferencedFileData]
-> [ReferencedFileData] -> [ReferencedFileData]
forall a. [a] -> [a] -> [a]
++
[ReferencedFileData]
refTables
referencedFiles :: [FileData]
referencedFiles = (ReferencedFileData -> FileData)
-> [ReferencedFileData] -> [FileData]
forall a b. (a -> b) -> [a] -> [b]
map ReferencedFileData -> FileData
forall a b. (a, b) -> b
snd [ReferencedFileData]
referenced
extraFiles :: [FileData]
extraFiles = [FileData]
-> ((Element, ReferencedFileData, [FileData]) -> [FileData])
-> Maybe (Element, ReferencedFileData, [FileData])
-> [FileData]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element, ReferencedFileData, [FileData]) -> [FileData]
forall a b c. (a, b, c) -> c
thd3 Maybe (Element, ReferencedFileData, [FileData])
mDrawingData
otherFiles :: [FileData]
otherFiles = [FileData]
sheetRels [FileData] -> [FileData] -> [FileData]
forall a. [a] -> [a] -> [a]
++ [FileData]
referencedFiles [FileData] -> [FileData] -> [FileData]
forall a. [a] -> [a] -> [a]
++ [FileData]
extraFiles
(FileData, [FileData]) -> ST s (FileData, [FileData])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileData
sheetFile, [FileData]
otherFiles)
nextRefId :: STRef s Int -> ST s RefId
nextRefId :: STRef s Int -> ST s RefId
nextRefId STRef s Int
r = do
Int
num <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
r
STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
r (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
RefId -> ST s RefId
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> RefId
unsafeRefId Int
num)
sheetDataXml ::
Cells
-> Map Int RowProperties
-> Map SharedFormulaIndex SharedFormulaOptions
-> [Element]
sheetDataXml :: Cells
-> Map Int RowProperties
-> Map SharedFormulaIndex SharedFormulaOptions
-> [Element]
sheetDataXml Cells
rows Map Int RowProperties
rh Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas =
State (Map SharedFormulaIndex SharedFormulaOptions) [Element]
-> Map SharedFormulaIndex SharedFormulaOptions -> [Element]
forall s a. State s a -> s -> a
evalState (((Int, [(Int, XlsxCell)])
-> StateT
(Map SharedFormulaIndex SharedFormulaOptions) Identity Element)
-> Cells
-> State (Map SharedFormulaIndex SharedFormulaOptions) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, [(Int, XlsxCell)])
-> StateT
(Map SharedFormulaIndex SharedFormulaOptions) Identity Element
forall (m :: * -> *).
MonadState (Map SharedFormulaIndex SharedFormulaOptions) m =>
(Int, [(Int, XlsxCell)]) -> m Element
rowEl Cells
rows) Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas
where
rowEl :: (Int, [(Int, XlsxCell)]) -> m Element
rowEl (Int
r, [(Int, XlsxCell)]
cells) = do
let mProps :: Maybe RowProperties
mProps = Int -> Map Int RowProperties -> Maybe RowProperties
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
r Map Int RowProperties
rh
hasHeight :: Bool
hasHeight = case RowProperties -> Maybe RowHeight
rowHeight (RowProperties -> Maybe RowHeight)
-> Maybe RowProperties -> Maybe 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 (RowProperties -> Maybe RowHeight)
-> Maybe RowProperties -> Maybe 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
(Name, Text) -> [(Name, Text)]
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 (RowProperties -> Maybe Int) -> Maybe RowProperties -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RowProperties
mProps]
(Name, Text) -> [(Name, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
"s", Int -> Text
forall a. Integral a => a -> Text
txti Int
st)
hidden :: Bool
hidden = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RowProperties -> Bool
rowHidden (RowProperties -> Bool) -> Maybe RowProperties -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RowProperties
mProps
attrs :: [(Name, Text)]
attrs = [(Name, Text)]
ht [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++
[(Name, Text)]
s [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++
[ (Name
"r", Int -> Text
forall a. Integral a => a -> Text
txti Int
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 <- ((Int, XlsxCell) -> m Element) -> [(Int, XlsxCell)] -> m [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> (Int, XlsxCell) -> m Element
forall (m :: * -> *).
MonadState (Map SharedFormulaIndex SharedFormulaOptions) m =>
Int -> (Int, XlsxCell) -> m Element
cellEl Int
r) [(Int, XlsxCell)]
cells
Element -> m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> m Element) -> Element -> m Element
forall a b. (a -> b) -> a -> b
$ Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
"row" [(Name, Text)]
attrs [Element]
cellEls
cellEl :: Int -> (Int, XlsxCell) -> m Element
cellEl Int
r (Int
icol, XlsxCell
cell) = do
let cellAttrs :: a -> XlsxCell -> [(Name, Text)]
cellAttrs a
ref XlsxCell
c =
XlsxCell -> [(Name, Text)]
forall a. IsString a => XlsxCell -> [(a, Text)]
cellStyleAttr XlsxCell
c [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++ [(Name
"r" Name -> a -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= a
ref), (Name
"t" Name -> Text -> (Name, Text)
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", Int -> Text
forall a. Integral a => a -> Text
txti Int
s)]
formula :: Maybe CellFormula
formula = XlsxCell -> Maybe CellFormula
xlsxCellFormula XlsxCell
cell
fEl0 :: Maybe Element
fEl0 = Name -> CellFormula -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"f" (CellFormula -> Element) -> Maybe CellFormula -> Maybe Element
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 <- m (Map SharedFormulaIndex SharedFormulaOptions)
forall s (m :: * -> *). MonadState s m => m s
get
case SharedFormulaIndex
-> Map SharedFormulaIndex SharedFormulaOptions
-> Maybe SharedFormulaOptions
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SharedFormulaIndex
si Map SharedFormulaIndex SharedFormulaOptions
shared of
Just SharedFormulaOptions
fOpts -> do
Map SharedFormulaIndex SharedFormulaOptions -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map SharedFormulaIndex SharedFormulaOptions -> m ())
-> Map SharedFormulaIndex SharedFormulaOptions -> m ()
forall a b. (a -> b) -> a -> b
$ SharedFormulaIndex
-> Map SharedFormulaIndex SharedFormulaOptions
-> Map SharedFormulaIndex SharedFormulaOptions
forall k a. Ord k => k -> Map k a -> Map k a
M.delete SharedFormulaIndex
si Map SharedFormulaIndex SharedFormulaOptions
shared
Maybe Element -> m (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> m (Maybe Element))
-> Maybe Element -> m (Maybe Element)
forall a b. (a -> b) -> a -> b
$ SharedFormulaOptions -> Element -> Element
applySharedFormulaOpts SharedFormulaOptions
fOpts (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Element
fEl0
Maybe SharedFormulaOptions
Nothing ->
Maybe Element -> m (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
fEl0
Maybe CellFormula
_ ->
Maybe Element -> m (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
fEl0
Element -> m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> m Element) -> Element -> m Element
forall a b. (a -> b) -> a -> b
$ Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
"c" (Range -> XlsxCell -> [(Name, Text)]
forall a. ToAttrVal a => a -> XlsxCell -> [(Name, Text)]
cellAttrs ((Int, Int) -> Range
singleCellRef (Int
r, Int
icol)) XlsxCell
cell) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Element
fEl, Name -> Text -> Element
elementContent Name
"v" (Text -> Element)
-> (XlsxCellData -> Text) -> XlsxCellData -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XlsxCellData -> Text
value (XlsxCellData -> Element) -> Maybe XlsxCellData -> Maybe Element
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]))
Int
n Cells
cells STRef s Int
ref =
if [(Range, Comment)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Comment)]
comments
then do
Maybe (Element, [ReferencedFileData])
-> ST s (Maybe (Element, [ReferencedFileData]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Element, [ReferencedFileData])
forall a. Maybe a
Nothing
else do
RefId
rId1 <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
RefId
rId2 <- STRef s Int -> ST s RefId
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
Maybe (Element, [ReferencedFileData])
-> ST s (Maybe (Element, [ReferencedFileData]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Element, [ReferencedFileData])
-> ST s (Maybe (Element, [ReferencedFileData])))
-> Maybe (Element, [ReferencedFileData])
-> ST s (Maybe (Element, [ReferencedFileData]))
forall a b. (a -> b) -> a -> b
$ (Element, [ReferencedFileData])
-> Maybe (Element, [ReferencedFileData])
forall a. a -> Maybe a
Just (Element
el, [(RefId
rId1, FileData
commentsFile), (RefId
rId2, FileData
vmlDrawingFile)])
where
comments :: [(Range, Comment)]
comments = ((Int, [(Int, XlsxCell)]) -> [(Range, Comment)])
-> Cells -> [(Range, Comment)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
row, [(Int, XlsxCell)]
rowCells) -> ((Int, XlsxCell) -> Maybe (Range, Comment))
-> [(Int, XlsxCell)] -> [(Range, Comment)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> (Int, XlsxCell) -> Maybe (Range, Comment)
maybeCellComment Int
row) [(Int, XlsxCell)]
rowCells) Cells
cells
maybeCellComment :: Int -> (Int, XlsxCell) -> Maybe (Range, Comment)
maybeCellComment Int
row (Int
col, XlsxCell
cell) = do
Comment
comment <- XlsxCell -> Maybe Comment
xlsxComment XlsxCell
cell
(Range, Comment) -> Maybe (Range, Comment)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> Range
singleCellRef (Int
row, Int
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml"
commentsBS :: ByteString
commentsBS = RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ CommentTable -> Document
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
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 :: Int
-> STRef s Int
-> Drawing
-> ST s (Element, ReferencedFileData, [FileData])
genDrawing Int
n STRef s Int
ref Drawing
dr = do
RefId
rId <- STRef s Int -> ST s RefId
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
(Element, ReferencedFileData, [FileData])
-> ST s (Element, ReferencedFileData, [FileData])
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
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 RenderSettings
forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ GenericDrawing RefId RefId -> Document
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 :: forall p1 g1. [Anchor p1 g1] -> GenericDrawing p1 g1
Drawing{ _xdrAnchors :: [Anchor RefId RefId]
_xdrAnchors = [Anchor RefId RefId] -> [Anchor RefId RefId]
forall a. [a] -> [a]
reverse [Anchor RefId RefId]
anchors' }
([Anchor RefId RefId]
anchors', [Maybe (Int, FileInfo)]
images, [(Int, ChartSpace)]
charts, Int
_) = (([Anchor RefId RefId], [Maybe (Int, FileInfo)],
[(Int, ChartSpace)], Int)
-> Anchor FileInfo ChartSpace
-> ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
[(Int, ChartSpace)], Int))
-> ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
[(Int, ChartSpace)], Int)
-> [Anchor FileInfo ChartSpace]
-> ([Anchor RefId RefId], [Maybe (Int, FileInfo)],
[(Int, ChartSpace)], 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 Drawing
-> Getting
[Anchor FileInfo ChartSpace] Drawing [Anchor FileInfo ChartSpace]
-> [Anchor FileInfo ChartSpace]
forall s a. s -> Getting a s a -> a
^. Getting
[Anchor FileInfo ChartSpace] Drawing [Anchor FileInfo ChartSpace]
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 Anchor FileInfo ChartSpace
-> Getting
(DrawingObject FileInfo ChartSpace)
(Anchor FileInfo ChartSpace)
(DrawingObject FileInfo ChartSpace)
-> DrawingObject FileInfo ChartSpace
forall s a. s -> Getting a s a -> a
^. Getting
(DrawingObject FileInfo ChartSpace)
(Anchor FileInfo ChartSpace)
(DrawingObject FileInfo ChartSpace)
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,) (FileInfo -> (Int, FileInfo))
-> Maybe FileInfo -> Maybe (Int, FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlipFillProperties FileInfo
_picBlipFill BlipFillProperties FileInfo
-> Getting
(Maybe FileInfo) (BlipFillProperties FileInfo) (Maybe FileInfo)
-> Maybe FileInfo
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe FileInfo) (BlipFillProperties FileInfo) (Maybe FileInfo)
forall a1 a2.
Lens
(BlipFillProperties a1)
(BlipFillProperties a2)
(Maybe a1)
(Maybe a2)
bfpImageInfo
pic' :: DrawingObject RefId g
pic' =
Picture :: forall p g.
Maybe Text
-> Bool
-> PicNonVisual
-> BlipFillProperties p
-> ShapeProperties
-> DrawingObject p g
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 BlipFillProperties FileInfo
-> (BlipFillProperties FileInfo -> BlipFillProperties RefId)
-> BlipFillProperties RefId
forall a b. a -> (a -> b) -> b
& (Maybe FileInfo -> Identity (Maybe RefId))
-> BlipFillProperties FileInfo
-> Identity (BlipFillProperties RefId)
forall a1 a2.
Lens
(BlipFillProperties a1)
(BlipFillProperties a2)
(Maybe a1)
(Maybe a2)
bfpImageInfo ((Maybe FileInfo -> Identity (Maybe RefId))
-> BlipFillProperties FileInfo
-> Identity (BlipFillProperties RefId))
-> RefId -> BlipFillProperties FileInfo -> BlipFillProperties RefId
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> RefId
RefId (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
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 = DrawingObject RefId g
forall g. DrawingObject RefId g
pic'}
in (Anchor RefId RefId
forall g. Anchor RefId g
anch Anchor RefId RefId -> [Anchor RefId RefId] -> [Anchor RefId RefId]
forall a. a -> [a] -> [a]
: [Anchor RefId RefId]
as, Maybe (Int, FileInfo)
fi Maybe (Int, FileInfo)
-> [Maybe (Int, FileInfo)] -> [Maybe (Int, FileInfo)]
forall a. a -> [a] -> [a]
: [Maybe (Int, FileInfo)]
fis, [(Int, ChartSpace)]
chs, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Graphic GraphNonVisual
nv ChartSpace
ch Transform2D
tr ->
let gr' :: DrawingObject p RefId
gr' = GraphNonVisual -> RefId -> Transform2D -> DrawingObject p RefId
forall p g. GraphNonVisual -> g -> Transform2D -> DrawingObject p g
Graphic GraphNonVisual
nv (Text -> RefId
RefId (Text
"rId" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
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 = DrawingObject p RefId
forall p. DrawingObject p RefId
gr'}
in (Anchor RefId RefId
forall p. Anchor p RefId
anch Anchor RefId RefId -> [Anchor RefId RefId] -> [Anchor RefId RefId]
forall a. a -> [a] -> [a]
: [Anchor RefId RefId]
as, [Maybe (Int, FileInfo)]
fis, (Int
i, ChartSpace
ch) (Int, ChartSpace) -> [(Int, ChartSpace)] -> [(Int, ChartSpace)]
forall a. a -> [a] -> [a]
: [(Int, ChartSpace)]
chs, Int
i Int -> Int -> Int
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/" FilePath -> FilePath -> FilePath
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
..}) <- [(Int, FileInfo)] -> [(Int, FileInfo)]
forall a. [a] -> [a]
reverse ([Maybe (Int, FileInfo)] -> [(Int, FileInfo)]
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)) <- [Int] -> [(Int, ChartSpace)] -> [(Int, (Int, ChartSpace))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([(Int, ChartSpace)] -> [(Int, ChartSpace)]
forall a. [a] -> [a]
reverse [(Int, ChartSpace)]
charts)
]
innerFiles :: [ReferencedFileData]
innerFiles = [ReferencedFileData]
imageFiles [ReferencedFileData]
-> [ReferencedFileData] -> [ReferencedFileData]
forall a. [a] -> [a] -> [a]
++ [ReferencedFileData]
chartFiles
drawingRels :: FileData
drawingRels =
FilePath -> Text -> Text -> ByteString -> FileData
FileData
(FilePath
"xl/drawings/_rels/drawing" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
Text
relsCT
Text
"relationships"
ByteString
drawingRelsXml
drawingRelsXml :: ByteString
drawingRelsXml =
RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> ([(RefId, Relationship)] -> Document)
-> [(RefId, Relationship)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Document
forall a. ToDocument a => a -> Document
toDocument (Relationships -> Document)
-> ([(RefId, Relationship)] -> Relationships)
-> [(RefId, Relationship)]
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList ([(RefId, Relationship)] -> ByteString)
-> [(RefId, Relationship)] -> ByteString
forall a b. (a -> b) -> a -> b
$
(ReferencedFileData -> (RefId, Relationship))
-> [ReferencedFileData] -> [(RefId, Relationship)]
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 FileData -> [FileData] -> [FileData]
forall a. a -> [a] -> [a]
: ((ReferencedFileData -> FileData)
-> [ReferencedFileData] -> [FileData]
forall a b. (a -> b) -> [a] -> [b]
map ReferencedFileData -> FileData
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i FilePath -> FilePath -> FilePath
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 RenderSettings
forall a. Default a => a
def {rsNamespaces :: [(Text, Text)]
rsNamespaces = [(Text, Text)]
nss} (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ ChartSpace -> Document
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 = ([((CacheId, FileData), FileData, [FileData])] -> [FileData])
-> [[((CacheId, FileData), FileData, [FileData])]] -> [[FileData]]
forall a b. (a -> b) -> [a] -> [b]
map ((((CacheId, FileData), FileData, [FileData]) -> FileData)
-> [((CacheId, FileData), FileData, [FileData])] -> [FileData]
forall a b. (a -> b) -> [a] -> [b]
map (\((CacheId, FileData)
_, FileData
tableFile, [FileData]
_) -> FileData
tableFile)) [[((CacheId, FileData), FileData, [FileData])]]
rendered
others :: [FileData]
others = [[FileData]] -> [FileData]
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 = [[((CacheId, FileData), FileData, [FileData])]]
-> [((CacheId, FileData), FileData, [FileData])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((CacheId, FileData), FileData, [FileData])]]
rendered
(Int
_, [[((CacheId, FileData), FileData, [FileData])]]
rendered) =
(Int
-> (CellMap, [PivotTable])
-> (Int, [((CacheId, FileData), FileData, [FileData])]))
-> Int
-> [(CellMap, [PivotTable])]
-> (Int, [[((CacheId, FileData), FileData, [FileData])]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
(\Int
c (CellMap
cm, [PivotTable]
ts) -> (Int
-> PivotTable
-> (Int, ((CacheId, FileData), FileData, [FileData])))
-> Int
-> [PivotTable]
-> (Int, [((CacheId, FileData), FileData, [FileData])])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Int
c' PivotTable
t -> (Int
c' Int -> Int -> Int
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 = Int -> FilePath
forall a. Show a => a -> FilePath
show Int
cacheIdRaw
cachePath :: FilePath
cachePath =
FilePath
"xl/pivotCache/pivotCacheDefinition" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr FilePath -> FilePath -> FilePath
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr FilePath -> FilePath -> FilePath
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
Text
relsCT
Text
"relationships" (ByteString -> FileData) -> ByteString -> FileData
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> ([(RefId, Relationship)] -> Document)
-> [(RefId, Relationship)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Document
forall a. ToDocument a => a -> Document
toDocument (Relationships -> Document)
-> ([(RefId, Relationship)] -> Relationships)
-> [(RefId, Relationship)]
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList
tablePath :: FilePath
tablePath = FilePath
"xl/pivotTables/pivotTable" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr FilePath -> FilePath -> FilePath
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cacheIdStr FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".xml.rels")
Text
relsCT
Text
"relationships" (ByteString -> FileData) -> ByteString -> FileData
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 -> Text -> Text -> ByteString -> FileData
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" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
tblId FilePath -> FilePath -> FilePath
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString) -> Document -> ByteString
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 = [(Int, [(Int, XlsxCell)])]
coreXml :: UTCTime -> Text -> L.ByteString
coreXml :: UTCTime -> Text -> ByteString
coreXml UTCTime
created Text
creator =
RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def{rsNamespaces :: [(Text, Text)]
rsNamespaces=[(Text, Text)]
nss} (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
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 (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> UTCTime -> FilePath
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") Map Name Text
forall k a. Map k a
M.empty
[ Name -> Map Name Text -> [Node] -> Node
nEl (Text -> Text -> Name
namespaced Text
"dcterms" Text
"created")
([(Name, Text)] -> Map Name Text
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") Map Name Text
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") Map Name Text
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
where
sheetCount :: Int
sheetCount = [Text] -> Int
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" ([(Name, Text)] -> Map Name Text
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 (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Integral a => a -> Text
txti Int
sheetCount]]
]
]
, Text -> [Node] -> Node
extPropEl Text
"TitlesOfParts" [
Text -> Map Name Text -> [Node] -> Node
vTypeEl Text
"vector" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Name
"size", Int -> Text
forall a. Integral a => a -> Text
txti Int
sheetCount)
, (Name
"baseType", Text
"lpstr")]) ([Node] -> Node) -> [Node] -> Node
forall a b. (a -> b) -> a -> b
$
(Text -> Node) -> [Text] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Node] -> Node
vTypeEl0 Text
"lpstr" ([Node] -> Node) -> (Text -> [Node]) -> Text -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> [Node]) -> (Text -> Node) -> Text -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
NodeContent) [Text]
sheetNames
]
]
nsAttrs :: Map Name Text
nsAttrs = [(Name, Text)] -> Map Name Text
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) Map Name Text
forall k a. Map k a
M.empty
vTypeEl0 :: Text -> [Node] -> Node
vTypeEl0 Text
n = Text -> Map Name Text -> [Node] -> Node
vTypeEl Text
n Map Name Text
forall k a. Map k a
M.empty
vTypeEl :: Text -> Map Name Text -> [Node] -> Node
vTypeEl = Name -> Map Name Text -> [Node] -> Node
nEl (Name -> Map Name Text -> [Node] -> Node)
-> (Text -> Name) -> Text -> Map Name Text -> [Node] -> Node
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
(XlsxCellData -> XlsxCellData -> Bool)
-> (XlsxCellData -> XlsxCellData -> Bool) -> Eq XlsxCellData
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
(Int -> XlsxCellData -> FilePath -> FilePath)
-> (XlsxCellData -> FilePath)
-> ([XlsxCellData] -> FilePath -> FilePath)
-> Show XlsxCellData
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. XlsxCellData -> Rep XlsxCellData x)
-> (forall x. Rep XlsxCellData x -> XlsxCellData)
-> Generic XlsxCellData
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
, :: Maybe Comment
, XlsxCell -> Maybe CellFormula
xlsxCellFormula :: Maybe CellFormula
} deriving (XlsxCell -> XlsxCell -> Bool
(XlsxCell -> XlsxCell -> Bool)
-> (XlsxCell -> XlsxCell -> Bool) -> Eq XlsxCell
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
(Int -> XlsxCell -> FilePath -> FilePath)
-> (XlsxCell -> FilePath)
-> ([XlsxCell] -> FilePath -> FilePath)
-> Show XlsxCell
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. XlsxCell -> Rep XlsxCell x)
-> (forall x. Rep XlsxCell x -> XlsxCell) -> Generic XlsxCell
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"
value :: XlsxCellData -> Text
value :: XlsxCellData -> Text
value (XlsxSS Int
i) = Int -> Text
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) = ErrorType -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal ErrorType
eType
transformSheetData :: SharedStringTable -> Worksheet -> Cells
transformSheetData :: SharedStringTable -> Worksheet -> Cells
transformSheetData SharedStringTable
shared Worksheet
ws = ((Int, [(Int, Cell)]) -> (Int, [(Int, XlsxCell)]))
-> [(Int, [(Int, Cell)])] -> Cells
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(Int, Cell)]) -> (Int, [(Int, XlsxCell)])
forall d a. (d, [(a, Cell)]) -> (d, [(a, XlsxCell)])
transformRow ([(Int, [(Int, Cell)])] -> Cells)
-> [(Int, [(Int, Cell)])] -> Cells
forall a b. (a -> b) -> a -> b
$ CellMap -> [(Int, [(Int, Cell)])]
toRows (Worksheet
ws Worksheet -> Getting CellMap Worksheet CellMap -> CellMap
forall s a. s -> Getting a s a -> a
^. Getting CellMap Worksheet CellMap
Lens' Worksheet CellMap
wsCells)
where
transformRow :: (d, [(a, Cell)]) -> (d, [(a, XlsxCell)])
transformRow = ([(a, Cell)] -> [(a, XlsxCell)])
-> (d, [(a, Cell)]) -> (d, [(a, XlsxCell)])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((a, Cell) -> (a, XlsxCell)) -> [(a, Cell)] -> [(a, XlsxCell)]
forall a b. (a -> b) -> [a] -> [b]
map (a, Cell) -> (a, XlsxCell)
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 ((CellValue -> XlsxCellData)
-> Maybe CellValue -> Maybe XlsxCellData
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 s. ST s [FileData]) -> [FileData]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [FileData]) -> [FileData])
-> (forall s. ST s [FileData]) -> [FileData]
forall a b. (a -> b) -> a -> b
$ do
STRef s Int
ref <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
1
RefId
ssRId <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
let sheets :: [Worksheet]
sheets = Xlsx
xlsx Xlsx -> Getting [Worksheet] Xlsx [Worksheet] -> [Worksheet]
forall s a. s -> Getting a s a -> a
^. ([(Text, Worksheet)] -> Const [Worksheet] [(Text, Worksheet)])
-> Xlsx -> Const [Worksheet] Xlsx
Lens' Xlsx [(Text, Worksheet)]
xlSheets (([(Text, Worksheet)] -> Const [Worksheet] [(Text, Worksheet)])
-> Xlsx -> Const [Worksheet] Xlsx)
-> (([Worksheet] -> Const [Worksheet] [Worksheet])
-> [(Text, Worksheet)] -> Const [Worksheet] [(Text, Worksheet)])
-> Getting [Worksheet] Xlsx [Worksheet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Worksheet)] -> [Worksheet])
-> ([Worksheet] -> Const [Worksheet] [Worksheet])
-> [(Text, Worksheet)]
-> Const [Worksheet] [(Text, Worksheet)]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (((Text, Worksheet) -> Worksheet)
-> [(Text, Worksheet)] -> [Worksheet]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Worksheet) -> Worksheet
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" (ByteString -> FileData) -> ByteString -> FileData
forall a b. (a -> b) -> a -> b
$
SharedStringTable -> ByteString
ssXml SharedStringTable
shared)
RefId
stRId <- STRef s Int -> ST s RefId
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" (ByteString -> FileData) -> ByteString -> FileData
forall a b. (a -> b) -> a -> b
$
Styles -> ByteString
unStyles (Xlsx
xlsx Xlsx -> Getting Styles Xlsx Styles -> Styles
forall s a. s -> Getting a s a -> a
^. Getting Styles Xlsx Styles
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
Map Int RowProperties
CellMap
Map SqRef ConditionalFormatting
Map SqRef DataValidation
Map SharedFormulaIndex SharedFormulaOptions
_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 Int RowProperties
_wsColumnsProperties :: Worksheet -> [ColumnsProperties]
_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 Int RowProperties
_wsColumnsProperties :: [ColumnsProperties]
_wsPivotTables :: [PivotTable]
_wsCells :: CellMap
_wsTables :: Worksheet -> [Table]
..}) <- Xlsx
xlsx Xlsx
-> Getting [(Text, Worksheet)] Xlsx [(Text, Worksheet)]
-> [(Text, Worksheet)]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, Worksheet)] Xlsx [(Text, Worksheet)]
Lens' Xlsx [(Text, Worksheet)]
xlSheets
]
sheetCells :: [Cells]
sheetCells = (Worksheet -> Cells) -> [Worksheet] -> [Cells]
forall a b. (a -> b) -> [a] -> [b]
map (SharedStringTable -> Worksheet -> Cells
transformSheetData SharedStringTable
shared) [Worksheet]
sheets
sheetInputs :: [(Cells, [FileData], Worksheet)]
sheetInputs = [Cells]
-> [[FileData]] -> [Worksheet] -> [(Cells, [FileData], Worksheet)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Cells]
sheetCells [[FileData]]
sheetPivotTables [Worksheet]
sheets
STRef s Int
tblIdRef <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
1
[(ReferencedFileData, [FileData])]
allSheetFiles <- [(Int, (Cells, [FileData], Worksheet))]
-> ((Int, (Cells, [FileData], Worksheet))
-> ST s (ReferencedFileData, [FileData]))
-> ST s [(ReferencedFileData, [FileData])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int]
-> [(Cells, [FileData], Worksheet)]
-> [(Int, (Cells, [FileData], Worksheet))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Cells, [FileData], Worksheet)]
sheetInputs) (((Int, (Cells, [FileData], Worksheet))
-> ST s (ReferencedFileData, [FileData]))
-> ST s [(ReferencedFileData, [FileData])])
-> ((Int, (Cells, [FileData], Worksheet))
-> ST s (ReferencedFileData, [FileData]))
-> ST s [(ReferencedFileData, [FileData])]
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cells
cells, [FileData]
pvTables, Worksheet
sheet)) -> do
RefId
rId <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
(FileData
sheetFile, [FileData]
others) <- Int
-> Cells
-> [FileData]
-> Worksheet
-> STRef s Int
-> ST s (FileData, [FileData])
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
(ReferencedFileData, [FileData])
-> ST s (ReferencedFileData, [FileData])
forall (m :: * -> *) a. Monad m => a -> m a
return ((RefId
rId, FileData
sheetFile), [FileData]
others)
let sheetFiles :: [ReferencedFileData]
sheetFiles = ((ReferencedFileData, [FileData]) -> ReferencedFileData)
-> [(ReferencedFileData, [FileData])] -> [ReferencedFileData]
forall a b. (a -> b) -> [a] -> [b]
map (ReferencedFileData, [FileData]) -> ReferencedFileData
forall a b. (a, b) -> a
fst [(ReferencedFileData, [FileData])]
allSheetFiles
sheetNameByRId :: [(RefId, Text)]
sheetNameByRId = [RefId] -> [Text] -> [(RefId, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((ReferencedFileData -> RefId) -> [ReferencedFileData] -> [RefId]
forall a b. (a -> b) -> [a] -> [b]
map ReferencedFileData -> RefId
forall a b. (a, b) -> a
fst [ReferencedFileData]
sheetFiles) (Xlsx
xlsx Xlsx -> Getting [Text] Xlsx [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. ([(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Xlsx -> Const [Text] Xlsx
Lens' Xlsx [(Text, Worksheet)]
xlSheets (([(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Xlsx -> Const [Text] Xlsx)
-> (([Text] -> Const [Text] [Text])
-> [(Text, Worksheet)] -> Const [Text] [(Text, Worksheet)])
-> Getting [Text] Xlsx [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Worksheet)] -> [Text])
-> ([Text] -> Const [Text] [Text])
-> [(Text, Worksheet)]
-> Const [Text] [(Text, Worksheet)]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (((Text, Worksheet) -> Text) -> [(Text, Worksheet)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Worksheet) -> Text
forall a b. (a, b) -> a
fst))
sheetOthers :: [FileData]
sheetOthers = ((ReferencedFileData, [FileData]) -> [FileData])
-> [(ReferencedFileData, [FileData])] -> [FileData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ReferencedFileData, [FileData]) -> [FileData]
forall a b. (a, b) -> b
snd [(ReferencedFileData, [FileData])]
allSheetFiles
[(CacheId, ReferencedFileData)]
cacheRefFDsById <- [(CacheId, FileData)]
-> ((CacheId, FileData) -> ST s (CacheId, ReferencedFileData))
-> ST s [(CacheId, ReferencedFileData)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(CacheId, FileData)]
cacheIdFiles (((CacheId, FileData) -> ST s (CacheId, ReferencedFileData))
-> ST s [(CacheId, ReferencedFileData)])
-> ((CacheId, FileData) -> ST s (CacheId, ReferencedFileData))
-> ST s [(CacheId, ReferencedFileData)]
forall a b. (a -> b) -> a -> b
$ \(CacheId
cacheId, FileData
fd) -> do
RefId
refId <- STRef s Int -> ST s RefId
forall s. STRef s Int -> ST s RefId
nextRefId STRef s Int
ref
(CacheId, ReferencedFileData) -> ST s (CacheId, ReferencedFileData)
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 = ((CacheId, ReferencedFileData) -> ReferencedFileData)
-> [(CacheId, ReferencedFileData)] -> [ReferencedFileData]
forall a b. (a -> b) -> [a] -> [b]
map (CacheId, ReferencedFileData) -> ReferencedFileData
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" (ByteString -> FileData) -> ByteString -> FileData
forall a b. (a -> b) -> a -> b
$
[(RefId, Text)]
-> DefinedNames -> [(CacheId, RefId)] -> DateBase -> ByteString
bookXml [(RefId, Text)]
sheetNameByRId (Xlsx
xlsx Xlsx -> Getting DefinedNames Xlsx DefinedNames -> DefinedNames
forall s a. s -> Getting a s a -> a
^. Getting DefinedNames Xlsx DefinedNames
Lens' Xlsx DefinedNames
xlDefinedNames) [(CacheId, RefId)]
cacheRefsById (Xlsx
xlsx Xlsx -> Getting DateBase Xlsx DateBase -> DateBase
forall s a. s -> Getting a s a -> a
^. Getting DateBase Xlsx DateBase
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 RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> ([(RefId, Relationship)] -> Document)
-> [(RefId, Relationship)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Document
forall a. ToDocument a => a -> Document
toDocument (Relationships -> Document)
-> ([(RefId, Relationship)] -> Relationships)
-> [(RefId, Relationship)]
-> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RefId, Relationship)] -> Relationships
Relationships.fromList ([(RefId, Relationship)] -> ByteString)
-> [(RefId, Relationship)] -> ByteString
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
sharedStringsReferencedFileData -> [ReferencedFileData] -> [ReferencedFileData]
forall a. a -> [a] -> [a]
:ReferencedFileData
styleReferencedFileData -> [ReferencedFileData] -> [ReferencedFileData]
forall a. a -> [a] -> [a]
:[ReferencedFileData]
sheetFiles [ReferencedFileData]
-> [ReferencedFileData] -> [ReferencedFileData]
forall a. [a] -> [a] -> [a]
++ [ReferencedFileData]
cacheRefs
otherFiles :: [FileData]
otherFiles = [[FileData]] -> [FileData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FileData
relsFileData -> [FileData] -> [FileData]
forall a. a -> [a] -> [a]
:((ReferencedFileData -> FileData)
-> [ReferencedFileData] -> [FileData]
forall a b. (a -> b) -> [a] -> [b]
map ReferencedFileData -> FileData
forall a b. (a, b) -> b
snd [ReferencedFileData]
referenced), [FileData]
pivotOtherFiles, [FileData]
sheetOthers]
[FileData] -> ST s [FileData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileData] -> ST s [FileData]) -> [FileData] -> ST s [FileData]
forall a b. (a -> b) -> a -> b
$ FileData
bookFileFileData -> [FileData] -> [FileData]
forall a. a -> [a] -> [a]
:[FileData]
otherFiles
bookXml :: [(RefId, Text)]
-> DefinedNames
-> [(CacheId, RefId)]
-> DateBase
-> L.ByteString
bookXml :: [(RefId, Text)]
-> DefinedNames -> [(CacheId, RefId)] -> DateBase -> ByteString
bookXml [(RefId, Text)]
rIdNames (DefinedNames [(Text, Maybe Text, Text)]
names) [(CacheId, RefId)]
cacheIdRefs DateBase
dateBase =
RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def {rsNamespaces :: [(Text, Text)]
rsNamespaces = [(Text, Text)]
nss} (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
where
nss :: [(Text, Text)]
nss = [ (Text
"r", Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships") ]
root :: Element
root =
Text -> Maybe Text -> Element -> Element
addNS Text
"http://schemas.openxmlformats.org/spreadsheetml/2006/main" Maybe Text
forall a. Maybe a
Nothing (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Name -> [Element] -> Element
elementListSimple
Name
"workbook"
( [ Name -> [(Name, Text)] -> Element
leafElement Name
"workbookPr" ([Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"date1904" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue (DateBase
dateBase DateBase -> DateBase -> Bool
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" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name, Name
"sheetId" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
i, (Text -> Name
odr Text
"id") Name -> RefId -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId]
| (Int
i, (RefId
rId, Text
name)) <- [Int] -> [(RefId, Text)] -> [(Int, (RefId, Text))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [(RefId, Text)]
rIdNames
]
, 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
]
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList
(Name -> [Element] -> Maybe Element
nonEmptyElListSimple Name
"pivotCaches" ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ ((CacheId, RefId) -> Element) -> [(CacheId, RefId)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (CacheId, RefId) -> Element
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" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
cId, (Text -> Name
odr Text
"id") Name -> a -> (Name, Text)
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" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name]
definedName Text
name (Just Text
lsId) = [Name
"name" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
name, Name
"localSheetId" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
lsId]
ssXml :: SharedStringTable -> L.ByteString
ssXml :: SharedStringTable -> ByteString
ssXml = RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> (SharedStringTable -> Document)
-> SharedStringTable
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedStringTable -> Document
forall a. ToDocument a => a -> Document
toDocument
customPropsXml :: CustomProperties -> L.ByteString
customPropsXml :: CustomProperties -> ByteString
customPropsXml = RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString)
-> (CustomProperties -> Document) -> CustomProperties -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomProperties -> Document
forall a. ToDocument a => a -> Document
toDocument
contentTypesXml :: [FileData] -> L.ByteString
contentTypesXml :: [FileData] -> ByteString
contentTypesXml [FileData]
fds = RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
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" Maybe Text
forall a. Maybe a
Nothing (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
Name -> Map Name Text -> [Node] -> Element
Element Name
"Types" Map Name Text
forall k a. Map k a
M.empty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
(FileData -> Node) -> [FileData] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (\FileData
fd -> Name -> Map Name Text -> [Node] -> Node
nEl Name
"Override" ([(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name
"PartName", [Text] -> Text
T.concat [Text
"/", FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FileData -> FilePath
fdPath FileData
fd]),
(Name
"ContentType", FileData -> Text
fdContentType FileData
fd)]) []) [FileData]
fds
qName :: Text -> Text -> Text -> Name
qName :: Text -> Text -> Text -> Name
qName Text
n Text
ns Text
p =
Name :: Text -> Maybe Text -> Maybe Text -> Name
Name
{ nameLocalName :: Text
nameLocalName = Text
n
, nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns
, namePrefix :: Maybe Text
namePrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p
}
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 = FilePath -> Maybe Text -> Text
forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"ns name lookup" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
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 :: Text -> Maybe Text -> Maybe Text -> Name
Name
{ nameLocalName :: Text
nameLocalName = Text
n
, nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns
, namePrefix :: Maybe Text
namePrefix = Maybe Text
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 (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
Element Name
name Map Name Text
attrs [Node]
nodes
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" Name -> RefId -> (Name, Text)
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." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+xml"
relsCT :: Text
relsCT :: Text
relsCT = Text
"application/vnd.openxmlformats-package.relationships+xml"