{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Xlsx.Writer.Stream
( writeXlsx
, writeXlsxWithSharedStrings
, SheetWriteSettings(..)
, defaultSettings
, wsSheetView
, wsZip
, wsColumnProperties
, wsRowProperties
, wsStyles
, sharedStrings
, sharedStringsStream
) where
import Codec.Archive.Zip.Conduit.UnZip
import Codec.Archive.Zip.Conduit.Zip
import Codec.Xlsx.Parser.Internal (n_)
import Codec.Xlsx.Parser.Stream
import Codec.Xlsx.Types (ColumnsProperties (..), RowProperties (..),
Styles (..), _AutomaticHeight, _CustomHeight,
emptyStyles, rowHeightLens)
import Codec.Xlsx.Types.Cell
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.Internal.Relationships (odr, pr)
import Codec.Xlsx.Types.SheetViews
import Codec.Xlsx.Writer.Internal (nonEmptyElListSimple, toAttrVal, toElement,
txtd, txti)
import Codec.Xlsx.Writer.Internal.Stream
import Conduit (PrimMonad, yield, (.|))
import qualified Conduit as C
#ifdef USE_MICROLENS
import Data.Traversable.WithIndex
import Lens.Micro.Platform
#else
import Control.Lens
#endif
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Reader.Class
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Coerce
import Data.Conduit (ConduitT)
import qualified Data.Conduit.List as CL
import Data.Foldable (fold, traverse_)
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Data.Word
import Data.XML.Types
import Text.Printf
import Text.XML (toXMLElement)
import qualified Text.XML as TXML
import Text.XML.Stream.Render
import Text.XML.Unresolved (elementToEvents)
upsertSharedStrings :: MonadState SharedStringState m => Row -> m [(Text,Int)]
upsertSharedStrings :: forall (m :: * -> *).
MonadState SharedStringState m =>
Row -> m [(Text, Int)]
upsertSharedStrings Row
row =
(Text -> m (Text, Int)) -> [Text] -> m [(Text, Int)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> m (Text, Int)
forall (m :: * -> *).
MonadState SharedStringState m =>
Text -> m (Text, Int)
upsertSharedString [Text]
items
where
items :: [Text]
items :: [Text]
items = Row
row Row -> Getting (Endo [Text]) Row Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (CellRow -> Const (Endo [Text]) CellRow)
-> Row -> Const (Endo [Text]) Row
Lens' Row CellRow
ri_cell_row ((CellRow -> Const (Endo [Text]) CellRow)
-> Row -> Const (Endo [Text]) Row)
-> ((Text -> Const (Endo [Text]) Text)
-> CellRow -> Const (Endo [Text]) CellRow)
-> Getting (Endo [Text]) Row Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Const (Endo [Text]) Cell)
-> CellRow -> Const (Endo [Text]) CellRow
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal Int CellRow CellRow Cell Cell
traversed ((Cell -> Const (Endo [Text]) Cell)
-> CellRow -> Const (Endo [Text]) CellRow)
-> ((Text -> Const (Endo [Text]) Text)
-> Cell -> Const (Endo [Text]) Cell)
-> (Text -> Const (Endo [Text]) Text)
-> CellRow
-> Const (Endo [Text]) CellRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CellValue -> Const (Endo [Text]) (Maybe CellValue))
-> Cell -> Const (Endo [Text]) Cell
Lens' Cell (Maybe CellValue)
cellValue ((Maybe CellValue -> Const (Endo [Text]) (Maybe CellValue))
-> Cell -> Const (Endo [Text]) Cell)
-> ((Text -> Const (Endo [Text]) Text)
-> Maybe CellValue -> Const (Endo [Text]) (Maybe CellValue))
-> (Text -> Const (Endo [Text]) Text)
-> Cell
-> Const (Endo [Text]) Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CellValue -> Const (Endo [Text]) CellValue)
-> Maybe CellValue -> Const (Endo [Text]) (Maybe CellValue)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CellValue -> Const (Endo [Text]) CellValue)
-> Maybe CellValue -> Const (Endo [Text]) (Maybe CellValue))
-> ((Text -> Const (Endo [Text]) Text)
-> CellValue -> Const (Endo [Text]) CellValue)
-> (Text -> Const (Endo [Text]) Text)
-> Maybe CellValue
-> Const (Endo [Text]) (Maybe CellValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> CellValue -> Const (Endo [Text]) CellValue
Prism' CellValue Text
_CellText
sharedStrings :: Monad m => ConduitT Row b m (Map Text Int)
sharedStrings :: forall (m :: * -> *) b. Monad m => ConduitT Row b m (Map Text Int)
sharedStrings = ConduitT Row (Text, Int) m (Map Text Int)
-> ConduitT Row (Text, Int) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ConduitT Row (Text, Int) m (Map Text Int)
forall (m :: * -> *).
Monad m =>
ConduitT Row (Text, Int) m (Map Text Int)
sharedStringsStream ConduitT Row (Text, Int) m ()
-> ConduitT (Text, Int) b m (Map Text Int)
-> ConduitT Row b m (Map Text Int)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((Text, Int) -> Map Text Int)
-> ConduitT (Text, Int) b m (Map Text Int)
forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
CL.foldMap ((Text -> Int -> Map Text Int) -> (Text, Int) -> Map Text Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Int -> Map Text Int
forall k a. k -> a -> Map k a
Map.singleton)
sharedStringsStream :: Monad m =>
ConduitT Row (Text, Int) m (Map Text Int)
sharedStringsStream :: forall (m :: * -> *).
Monad m =>
ConduitT Row (Text, Int) m (Map Text Int)
sharedStringsStream = (SharedStringState -> Map Text Int)
-> ConduitT Row (Text, Int) m SharedStringState
-> ConduitT Row (Text, Int) m (Map Text Int)
forall a b.
(a -> b)
-> ConduitT Row (Text, Int) m a -> ConduitT Row (Text, Int) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Map Text Int) SharedStringState (Map Text Int)
-> SharedStringState -> Map Text Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Text Int) SharedStringState (Map Text Int)
Iso' SharedStringState (Map Text Int)
string_map) (ConduitT Row (Text, Int) m SharedStringState
-> ConduitT Row (Text, Int) m (Map Text Int))
-> ConduitT Row (Text, Int) m SharedStringState
-> ConduitT Row (Text, Int) m (Map Text Int)
forall a b. (a -> b) -> a -> b
$ SharedStringState
-> ConduitT Row (Text, Int) (StateT SharedStringState m) ()
-> ConduitT Row (Text, Int) m SharedStringState
forall (m :: * -> *) s i o r.
Monad m =>
s -> ConduitT i o (StateT s m) r -> ConduitT i o m s
C.execStateC SharedStringState
initialSharedString (ConduitT Row (Text, Int) (StateT SharedStringState m) ()
-> ConduitT Row (Text, Int) m SharedStringState)
-> ConduitT Row (Text, Int) (StateT SharedStringState m) ()
-> ConduitT Row (Text, Int) m SharedStringState
forall a b. (a -> b) -> a -> b
$
(Row -> StateT SharedStringState m [(Text, Int)])
-> ConduitT Row (Text, Int) (StateT SharedStringState m) ()
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
(a -> m (f b)) -> ConduitT a b m ()
CL.mapFoldableM Row -> StateT SharedStringState m [(Text, Int)]
forall (m :: * -> *).
MonadState SharedStringState m =>
Row -> m [(Text, Int)]
upsertSharedStrings
data SheetWriteSettings = MkSheetWriteSettings
{ SheetWriteSettings -> [SheetView]
_wsSheetView :: [SheetView]
, SheetWriteSettings -> ZipOptions
_wsZip :: ZipOptions
, SheetWriteSettings -> [ColumnsProperties]
_wsColumnProperties :: [ColumnsProperties]
, SheetWriteSettings -> Map Int RowProperties
_wsRowProperties :: Map Int RowProperties
, SheetWriteSettings -> Styles
_wsStyles :: Styles
}
instance Show SheetWriteSettings where
show :: SheetWriteSettings -> String
show (MkSheetWriteSettings [SheetView]
s ZipOptions
_ [ColumnsProperties]
y Map Int RowProperties
r Styles
_) = String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"MkSheetWriteSettings{ _wsSheetView=%s, _wsColumnProperties=%s, _wsZip=defaultZipOptions, _wsRowProperties=%s }" ([SheetView] -> String
forall a. Show a => a -> String
show [SheetView]
s) ([ColumnsProperties] -> String
forall a. Show a => a -> String
show [ColumnsProperties]
y) (Map Int RowProperties -> String
forall a. Show a => a -> String
show Map Int RowProperties
r)
makeLenses ''SheetWriteSettings
defaultSettings :: SheetWriteSettings
defaultSettings :: SheetWriteSettings
defaultSettings = MkSheetWriteSettings
{ _wsSheetView :: [SheetView]
_wsSheetView = []
, _wsColumnProperties :: [ColumnsProperties]
_wsColumnProperties = []
, _wsRowProperties :: Map Int RowProperties
_wsRowProperties = Map Int RowProperties
forall a. Monoid a => a
mempty
, _wsStyles :: Styles
_wsStyles = Styles
emptyStyles
, _wsZip :: ZipOptions
_wsZip = ZipOptions
defaultZipOptions {
zipOpt64 = False
}
}
writeXlsx :: MonadThrow m
=> PrimMonad m
=> SheetWriteSettings
-> ConduitT () Row m ()
-> ConduitT () ByteString m Word64
writeXlsx :: forall (m :: * -> *).
(MonadThrow m, PrimMonad m) =>
SheetWriteSettings
-> ConduitT () Row m () -> ConduitT () ByteString m Word64
writeXlsx SheetWriteSettings
settings ConduitT () Row m ()
sheetC = do
Map Text Int
sstrings <- ConduitT () Row m ()
sheetC ConduitT () Row m ()
-> ConduitT Row ByteString m (Map Text Int)
-> ConduitT () ByteString m (Map Text Int)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Row ByteString m (Map Text Int)
forall (m :: * -> *) b. Monad m => ConduitT Row b m (Map Text Int)
sharedStrings
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () ByteString m Word64
forall (m :: * -> *).
(MonadThrow m, PrimMonad m) =>
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () ByteString m Word64
writeXlsxWithSharedStrings SheetWriteSettings
settings Map Text Int
sstrings ConduitT () Row m ()
sheetC
writeXlsxWithSharedStrings :: MonadThrow m => PrimMonad m
=> SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () ByteString m Word64
writeXlsxWithSharedStrings :: forall (m :: * -> *).
(MonadThrow m, PrimMonad m) =>
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () ByteString m Word64
writeXlsxWithSharedStrings SheetWriteSettings
settings Map Text Int
sharedStrings' ConduitT () Row m ()
items =
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () (ZipEntry, ZipData m) m ()
forall (m :: * -> *).
PrimMonad m =>
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () (ZipEntry, ZipData m) m ()
combinedFiles SheetWriteSettings
settings Map Text Int
sharedStrings' ConduitT () Row m ()
items ConduitT () (ZipEntry, ZipData m) m ()
-> ConduitT (ZipEntry, ZipData m) ByteString m Word64
-> ConduitT () ByteString m Word64
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ZipOptions -> ConduitT (ZipEntry, ZipData m) ByteString m Word64
forall (m :: * -> *).
(MonadThrow m, PrimMonad m) =>
ZipOptions -> ConduitM (ZipEntry, ZipData m) ByteString m Word64
zipStream (SheetWriteSettings
settings SheetWriteSettings
-> Getting ZipOptions SheetWriteSettings ZipOptions -> ZipOptions
forall s a. s -> Getting a s a -> a
^. Getting ZipOptions SheetWriteSettings ZipOptions
Lens' SheetWriteSettings ZipOptions
wsZip)
boilerplate :: forall m . PrimMonad m => SheetWriteSettings -> Map Text Int -> [(ZipEntry, ZipData m)]
boilerplate :: forall (m :: * -> *).
PrimMonad m =>
SheetWriteSettings -> Map Text Int -> [(ZipEntry, ZipData m)]
boilerplate SheetWriteSettings
settings Map Text Int
sharedStrings' =
[ (Text -> ZipEntry
zipEntry Text
"xl/sharedStrings.xml", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$ Map Text Int -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Map Text Int -> forall i. ConduitT i Event m ()
writeSst Map Text Int
sharedStrings' ConduitT () Event m ()
-> ConduitT Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS)
, (Text -> ZipEntry
zipEntry Text
"[Content_Types].xml", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$ ConduitT () Event m ()
forall i. ConduitT i Event m ()
forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeContentTypes ConduitT () Event m ()
-> ConduitT Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS)
, (Text -> ZipEntry
zipEntry Text
"xl/workbook.xml", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$ ConduitT () Event m ()
forall i. ConduitT i Event m ()
forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbook ConduitT () Event m ()
-> ConduitT Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS)
, (Text -> ZipEntry
zipEntry Text
"xl/styles.xml", ByteString -> ZipData m
forall (m :: * -> *). ByteString -> ZipData m
ZipDataByteString (ByteString -> ZipData m) -> ByteString -> ZipData m
forall a b. (a -> b) -> a -> b
$ Styles -> ByteString
forall a b. Coercible a b => a -> b
coerce (Styles -> ByteString) -> Styles -> ByteString
forall a b. (a -> b) -> a -> b
$ SheetWriteSettings
settings SheetWriteSettings
-> Getting Styles SheetWriteSettings Styles -> Styles
forall s a. s -> Getting a s a -> a
^. Getting Styles SheetWriteSettings Styles
Lens' SheetWriteSettings Styles
wsStyles)
, (Text -> ZipEntry
zipEntry Text
"xl/_rels/workbook.xml.rels", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$ ConduitT () Event m ()
forall i. ConduitT i Event m ()
forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbookRels ConduitT () Event m ()
-> ConduitT Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS)
, (Text -> ZipEntry
zipEntry Text
"_rels/.rels", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$ ConduitT () Event m ()
forall i. ConduitT i Event m ()
forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeRootRels ConduitT () Event m ()
-> ConduitT Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS)
]
combinedFiles :: PrimMonad m
=> SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () (ZipEntry, ZipData m) m ()
combinedFiles :: forall (m :: * -> *).
PrimMonad m =>
SheetWriteSettings
-> Map Text Int
-> ConduitT () Row m ()
-> ConduitT () (ZipEntry, ZipData m) m ()
combinedFiles SheetWriteSettings
settings Map Text Int
sharedStrings' ConduitT () Row m ()
items =
[(ZipEntry, ZipData m)]
-> ConduitT () (Element [(ZipEntry, ZipData m)]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
C.yieldMany ([(ZipEntry, ZipData m)]
-> ConduitT () (Element [(ZipEntry, ZipData m)]) m ())
-> [(ZipEntry, ZipData m)]
-> ConduitT () (Element [(ZipEntry, ZipData m)]) m ()
forall a b. (a -> b) -> a -> b
$
SheetWriteSettings -> Map Text Int -> [(ZipEntry, ZipData m)]
forall (m :: * -> *).
PrimMonad m =>
SheetWriteSettings -> Map Text Int -> [(ZipEntry, ZipData m)]
boilerplate SheetWriteSettings
settings Map Text Int
sharedStrings' [(ZipEntry, ZipData m)]
-> [(ZipEntry, ZipData m)] -> [(ZipEntry, ZipData m)]
forall a. Semigroup a => a -> a -> a
<>
[(Text -> ZipEntry
zipEntry Text
"xl/worksheets/sheet1.xml", ConduitM () ByteString m () -> ZipData m
forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource (ConduitM () ByteString m () -> ZipData m)
-> ConduitM () ByteString m () -> ZipData m
forall a b. (a -> b) -> a -> b
$
ConduitT () Row m ()
items ConduitT () Row m ()
-> ConduitT Row ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| SheetWriteSettings
-> ConduitT Row Event (ReaderT SheetWriteSettings m) ()
-> ConduitT Row Event m ()
forall (m :: * -> *) r i o res.
Monad m =>
r -> ConduitT i o (ReaderT r m) res -> ConduitT i o m res
C.runReaderC SheetWriteSettings
settings (Map Text Int
-> ConduitT Row Event (ReaderT SheetWriteSettings m) ()
forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
Map Text Int -> ConduitT Row Event m ()
writeWorkSheet Map Text Int
sharedStrings') ConduitT Row Event m ()
-> ConduitT Event ByteString m () -> ConduitT Row ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Event ByteString m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS )]
el :: Monad m => Name -> Monad m => forall i. ConduitT i Event m () -> ConduitT i Event m ()
el :: forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el Name
x = Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag Name
x Attributes
forall a. Monoid a => a
mempty
override :: Monad m => Text -> Text -> forall i. ConduitT i Event m ()
override :: forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
content' Text
part =
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag Name
"{http://schemas.openxmlformats.org/package/2006/content-types}Override"
(Name -> Text -> Attributes
attr Name
"ContentType" Text
content'
Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Name -> Text -> Attributes
attr Name
"PartName" Text
part) (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ () -> ConduitT i Event m ()
forall a. a -> ConduitT i Event m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
writeContentTypes :: Monad m => forall i. ConduitT i Event m ()
writeContentTypes :: forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeContentTypes = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc Name
"{http://schemas.openxmlformats.org/package/2006/content-types}Types" (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" Text
"/xl/workbook.xml"
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" Text
"/xl/sharedStrings.xml"
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" Text
"/xl/styles.xml"
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" Text
"/xl/worksheets/sheet1.xml"
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-package.relationships+xml" Text
"/xl/_rels/workbook.xml.rels"
Text -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Text -> forall i. ConduitT i Event m ()
override Text
"application/vnd.openxmlformats-package.relationships+xml" Text
"/_rels/.rels"
writeWorkbook :: Monad m => forall i. ConduitT i Event m ()
writeWorkbook :: forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbook = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc (Text -> Name
n_ Text
"workbook") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ do
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"sheets") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ do
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag (Text -> Name
n_ Text
"sheet")
(Name -> Text -> Attributes
attr Name
"name" Text
"Sheet1"
Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Name -> Text -> Attributes
attr Name
"sheetId" Text
"1" Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<>
Name -> Text -> Attributes
attr (Text -> Name
odr Text
"id") Text
"rId3") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$
() -> ConduitT i Event m ()
forall a. a -> ConduitT i Event m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
doc :: Monad m => Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc :: forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc Name
root ConduitT i Event m ()
docM = do
Event -> ConduitT i Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventBeginDocument
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el Name
root ConduitT i Event m ()
docM
Event -> ConduitT i Event m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventEndDocument
relationship :: Monad m => Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship :: forall (m :: * -> *).
Monad m =>
Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship Text
target Int
id' Text
type' =
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag (Text -> Name
pr Text
"Relationship")
(Name -> Text -> Attributes
attr Name
"Type" Text
type'
Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Name -> Text -> Attributes
attr Name
"Id" (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"rId" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
id')
Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Name -> Text -> Attributes
attr Name
"Target" Text
target
) (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ () -> ConduitT i Event m ()
forall a. a -> ConduitT i Event m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
writeWorkbookRels :: Monad m => forall i. ConduitT i Event m ()
writeWorkbookRels :: forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbookRels = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc (Text -> Name
pr Text
"Relationships") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Int -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship Text
"sharedStrings.xml" Int
1 Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings"
Text -> Int -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship Text
"worksheets/sheet1.xml" Int
3 Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet"
Text -> Int -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship Text
"styles.xml" Int
2 Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles"
writeRootRels :: Monad m => forall i. ConduitT i Event m ()
writeRootRels :: forall (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeRootRels = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc (Text -> Name
pr Text
"Relationships") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$
Text -> Int -> Text -> forall i. ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Text -> Int -> Text -> forall i. ConduitT i Event m ()
relationship Text
"xl/workbook.xml" Int
1 Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"
zipEntry :: Text -> ZipEntry
zipEntry :: Text -> ZipEntry
zipEntry Text
x = ZipEntry
{ zipEntryName :: Either Text ByteString
zipEntryName = Text -> Either Text ByteString
forall a b. a -> Either a b
Left Text
x
, zipEntryTime :: LocalTime
zipEntryTime = Day -> TimeOfDay -> LocalTime
LocalTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) TimeOfDay
midnight
, zipEntrySize :: Maybe Word64
zipEntrySize = Maybe Word64
forall a. Maybe a
Nothing
, zipEntryExternalAttributes :: Maybe Word32
zipEntryExternalAttributes = Maybe Word32
forall a. Maybe a
Nothing
}
eventsToBS :: PrimMonad m => ConduitT Event ByteString m ()
eventsToBS :: forall (m :: * -> *). PrimMonad m => ConduitT Event ByteString m ()
eventsToBS = ConduitT Event Builder m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event Builder m ()
writeEvents ConduitT Event Builder m ()
-> ConduitT Builder ByteString m ()
-> ConduitT Event ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Builder ByteString m ()
forall (m :: * -> *).
PrimMonad m =>
ConduitT Builder ByteString m ()
C.builderToByteString
writeSst :: Monad m => Map Text Int -> forall i. ConduitT i Event m ()
writeSst :: forall (m :: * -> *).
Monad m =>
Map Text Int -> forall i. ConduitT i Event m ()
writeSst Map Text Int
sharedStrings' = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc (Text -> Name
n_ Text
"sst") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$
ConduitT i Event m [()] -> ConduitT i Event m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT i Event m [()] -> ConduitT i Event m ())
-> ConduitT i Event m [()] -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ ((Text, Int) -> ConduitT i Event m ())
-> [(Text, Int)] -> ConduitT i Event m [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"si") (ConduitT i Event m () -> ConduitT i Event m ())
-> ((Text, Int) -> ConduitT i Event m ())
-> (Text, Int)
-> ConduitT i Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"t") (ConduitT i Event m () -> ConduitT i Event m ())
-> ((Text, Int) -> ConduitT i Event m ())
-> (Text, Int)
-> ConduitT i Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ConduitT i Event m ()
forall (m :: * -> *) i. Monad m => Text -> ConduitT i Event m ()
content (Text -> ConduitT i Event m ())
-> ((Text, Int) -> Text) -> (Text, Int) -> ConduitT i Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int) -> Text
forall a b. (a, b) -> a
fst
) ([(Text, Int)] -> ConduitT i Event m [()])
-> [(Text, Int)] -> ConduitT i Event m [()]
forall a b. (a -> b) -> a -> b
$ ((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Text
_, Int
i) (Text
_, Int
y :: Int) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
y) ([(Text, Int)] -> [(Text, Int)]) -> [(Text, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Int
sharedStrings'
writeEvents :: PrimMonad m => ConduitT Event Builder m ()
writeEvents :: forall (m :: * -> *). PrimMonad m => ConduitT Event Builder m ()
writeEvents = RenderSettings -> ConduitT Event Builder m ()
forall (m :: * -> *).
Monad m =>
RenderSettings -> ConduitT Event Builder m ()
renderBuilder (RenderSettings
forall a. Default a => a
def {rsPretty=False})
sheetViews :: forall m . MonadReader SheetWriteSettings m => forall i . ConduitT i Event m ()
sheetViews :: forall (m :: * -> *) i.
MonadReader SheetWriteSettings m =>
ConduitT i Event m ()
sheetViews = do
[SheetView]
sheetView <- Getting [SheetView] SheetWriteSettings [SheetView]
-> ConduitT i Event m [SheetView]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [SheetView] SheetWriteSettings [SheetView]
Lens' SheetWriteSettings [SheetView]
wsSheetView
Bool -> ConduitT i Event m () -> ConduitT i Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SheetView] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SheetView]
sheetView) (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"sheetViews") (ConduitT i Event m () -> ConduitT i Event m ())
-> ConduitT i Event m () -> ConduitT i Event m ()
forall a b. (a -> b) -> a -> b
$ do
let
view' :: [Element]
view' :: [Element]
view' = Text -> Element -> Element
setNameSpaceRec Text
spreadSheetNS (Element -> Element)
-> (SheetView -> Element) -> SheetView -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
toXMLElement (Element -> Element)
-> (SheetView -> Element) -> SheetView -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SheetView -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"sheetView") (SheetView -> Element) -> [SheetView] -> [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SheetView]
sheetView
[Event] -> ConduitT i (Element [Event]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
C.yieldMany ([Event] -> ConduitT i (Element [Event]) m ())
-> [Event] -> ConduitT i (Element [Event]) m ()
forall a b. (a -> b) -> a -> b
$ Element -> [Event]
elementToEvents (Element -> [Event]) -> [Element] -> [Event]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Element]
view'
spreadSheetNS :: Text
spreadSheetNS :: Text
spreadSheetNS = Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Text
nameNamespace (Name -> Maybe Text) -> Name -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Name
n_ Text
""
setNameSpaceRec :: Text -> Element -> Element
setNameSpaceRec :: Text -> Element -> Element
setNameSpaceRec Text
space Element
xelm =
Element
xelm {elementName = ((elementName xelm ){nameNamespace =
Just space })
, elementNodes = elementNodes xelm <&> \case
NodeElement Element
x -> Element -> Node
NodeElement (Text -> Element -> Element
setNameSpaceRec Text
space Element
x)
Node
y -> Node
y
}
columns :: MonadReader SheetWriteSettings m => ConduitT Row Event m ()
columns :: forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
ConduitT Row Event m ()
columns = do
[ColumnsProperties]
colProps <- Getting [ColumnsProperties] SheetWriteSettings [ColumnsProperties]
-> ConduitT Row Event m [ColumnsProperties]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ColumnsProperties] SheetWriteSettings [ColumnsProperties]
Lens' SheetWriteSettings [ColumnsProperties]
wsColumnProperties
let cols :: Maybe TXML.Element
cols :: Maybe Element
cols = Name -> [Element] -> Maybe Element
nonEmptyElListSimple (Text -> Name
n_ Text
"cols") ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ (ColumnsProperties -> Element) -> [ColumnsProperties] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> ColumnsProperties -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"col")) [ColumnsProperties]
colProps
(Element -> ConduitT Row Event m ())
-> Maybe Element -> ConduitT Row Event m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([Event] -> ConduitT Row (Element [Event]) m ()
[Event] -> ConduitT Row Event m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
C.yieldMany ([Event] -> ConduitT Row Event m ())
-> (Element -> [Event]) -> Element -> ConduitT Row Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Event]
elementToEvents (Element -> [Event]) -> (Element -> Element) -> Element -> [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
toXMLElement) Maybe Element
cols
writeWorkSheet :: MonadReader SheetWriteSettings m => Map Text Int -> ConduitT Row Event m ()
writeWorkSheet :: forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
Map Text Int -> ConduitT Row Event m ()
writeWorkSheet Map Text Int
sharedStrings' = Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name -> forall i. ConduitT i Event m () -> ConduitT i Event m ()
doc (Text -> Name
n_ Text
"worksheet") (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$ do
ConduitT Row Event m ()
forall i. ConduitT i Event m ()
forall (m :: * -> *) i.
MonadReader SheetWriteSettings m =>
ConduitT i Event m ()
sheetViews
ConduitT Row Event m ()
forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
ConduitT Row Event m ()
columns
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"sheetData") (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$ (Row -> ConduitT Row Event m ()) -> ConduitT Row Event m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
C.awaitForever (Map Text Int -> Row -> ConduitT Row Event m ()
forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
Map Text Int -> Row -> ConduitT Row Event m ()
mapRow Map Text Int
sharedStrings')
mapRow :: MonadReader SheetWriteSettings m => Map Text Int -> Row -> ConduitT Row Event m ()
mapRow :: forall (m :: * -> *).
MonadReader SheetWriteSettings m =>
Map Text Int -> Row -> ConduitT Row Event m ()
mapRow Map Text Int
sharedStrings' Row
sheetItem = do
Maybe Double
mRowProp <- Getting (First Double) SheetWriteSettings Double
-> ConduitT Row Event m (Maybe Double)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Double) SheetWriteSettings Double
-> ConduitT Row Event m (Maybe Double))
-> Getting (First Double) SheetWriteSettings Double
-> ConduitT Row Event m (Maybe Double)
forall a b. (a -> b) -> a -> b
$ (Map Int RowProperties
-> Const (First Double) (Map Int RowProperties))
-> SheetWriteSettings -> Const (First Double) SheetWriteSettings
Lens' SheetWriteSettings (Map Int RowProperties)
wsRowProperties ((Map Int RowProperties
-> Const (First Double) (Map Int RowProperties))
-> SheetWriteSettings -> Const (First Double) SheetWriteSettings)
-> ((Double -> Const (First Double) Double)
-> Map Int RowProperties
-> Const (First Double) (Map Int RowProperties))
-> Getting (First Double) SheetWriteSettings Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Int RowProperties)
-> Traversal'
(Map Int RowProperties) (IxValue (Map Int RowProperties))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (RowIndex -> Int
unRowIndex RowIndex
rowIx) ((RowProperties -> Const (First Double) RowProperties)
-> Map Int RowProperties
-> Const (First Double) (Map Int RowProperties))
-> ((Double -> Const (First Double) Double)
-> RowProperties -> Const (First Double) RowProperties)
-> (Double -> Const (First Double) Double)
-> Map Int RowProperties
-> Const (First Double) (Map Int RowProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe RowHeight -> Const (First Double) (Maybe RowHeight))
-> RowProperties -> Const (First Double) RowProperties
Lens' RowProperties (Maybe RowHeight)
rowHeightLens ((Maybe RowHeight -> Const (First Double) (Maybe RowHeight))
-> RowProperties -> Const (First Double) RowProperties)
-> ((Double -> Const (First Double) Double)
-> Maybe RowHeight -> Const (First Double) (Maybe RowHeight))
-> (Double -> Const (First Double) Double)
-> RowProperties
-> Const (First Double) RowProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RowHeight -> Const (First Double) RowHeight)
-> Maybe RowHeight -> Const (First Double) (Maybe RowHeight)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((RowHeight -> Const (First Double) RowHeight)
-> Maybe RowHeight -> Const (First Double) (Maybe RowHeight))
-> ((Double -> Const (First Double) Double)
-> RowHeight -> Const (First Double) RowHeight)
-> (Double -> Const (First Double) Double)
-> Maybe RowHeight
-> Const (First Double) (Maybe RowHeight)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversing
(->) (Const (First Double)) RowHeight RowHeight Double Double
-> ((Double -> Const (First Double) Double)
-> RowHeight -> Const (First Double) RowHeight)
-> (Double -> Const (First Double) Double)
-> RowHeight
-> Const (First Double) RowHeight
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
failing Traversing
(->) (Const (First Double)) RowHeight RowHeight Double Double
Prism' RowHeight Double
_CustomHeight (Double -> Const (First Double) Double)
-> RowHeight -> Const (First Double) RowHeight
Prism' RowHeight Double
_AutomaticHeight
let rowAttr :: Attributes
rowAttr :: Attributes
rowAttr = Attributes
ixAttr Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Maybe Attributes -> Attributes
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Name -> Text -> Attributes
attr Name
"ht" (Text -> Attributes) -> (Double -> Text) -> Double -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
txtd (Double -> Attributes) -> Maybe Double -> Maybe Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
mRowProp)
Name
-> Attributes -> ConduitT Row Event m () -> ConduitT Row Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag (Text -> Name
n_ Text
"row") Attributes
rowAttr (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$
ConduitT Row Event m (IntMap ()) -> ConduitT Row Event m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT Row Event m (IntMap ()) -> ConduitT Row Event m ())
-> ConduitT Row Event m (IntMap ()) -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$ (Int -> Cell -> ConduitT Row Event m ())
-> CellRow -> ConduitT Row Event m (IntMap ())
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> IntMap a -> f (IntMap b)
itraverse (Map Text Int -> RowIndex -> Int -> Cell -> ConduitT Row Event m ()
forall (m :: * -> *).
Monad m =>
Map Text Int -> RowIndex -> Int -> Cell -> ConduitT Row Event m ()
mapCell Map Text Int
sharedStrings' RowIndex
rowIx) (Row
sheetItem Row -> Getting CellRow Row CellRow -> CellRow
forall s a. s -> Getting a s a -> a
^. Getting CellRow Row CellRow
Lens' Row CellRow
ri_cell_row)
where
rowIx :: RowIndex
rowIx = Row
sheetItem Row -> Getting RowIndex Row RowIndex -> RowIndex
forall s a. s -> Getting a s a -> a
^. Getting RowIndex Row RowIndex
Lens' Row RowIndex
ri_row_index
ixAttr :: Attributes
ixAttr = Name -> Text -> Attributes
attr Name
"r" (Text -> Attributes) -> Text -> Attributes
forall a b. (a -> b) -> a -> b
$ RowIndex -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal RowIndex
rowIx
mapCell ::
Monad m => Map Text Int -> RowIndex -> Int -> Cell -> ConduitT Row Event m ()
mapCell :: forall (m :: * -> *).
Monad m =>
Map Text Int -> RowIndex -> Int -> Cell -> ConduitT Row Event m ()
mapCell Map Text Int
sharedStrings' RowIndex
rix Int
cix' Cell
cell =
Bool -> ConduitT Row Event m () -> ConduitT Row Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Any Cell CellValue -> Cell -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe CellValue -> Const Any (Maybe CellValue))
-> Cell -> Const Any Cell
Lens' Cell (Maybe CellValue)
cellValue ((Maybe CellValue -> Const Any (Maybe CellValue))
-> Cell -> Const Any Cell)
-> ((CellValue -> Const Any CellValue)
-> Maybe CellValue -> Const Any (Maybe CellValue))
-> Getting Any Cell CellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CellValue -> Const Any CellValue)
-> Maybe CellValue -> Const Any (Maybe CellValue)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) Cell
cell Bool -> Bool -> Bool
|| Getting Any Cell Int -> Cell -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Int -> Const Any (Maybe Int)) -> Cell -> Const Any Cell
Lens' Cell (Maybe Int)
cellStyle ((Maybe Int -> Const Any (Maybe Int)) -> Cell -> Const Any Cell)
-> ((Int -> Const Any Int) -> Maybe Int -> Const Any (Maybe Int))
-> Getting Any Cell Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Any Int) -> Maybe Int -> Const Any (Maybe Int)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) Cell
cell) (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$
Name
-> Attributes -> ConduitT Row Event m () -> ConduitT Row Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
tag (Text -> Name
n_ Text
"c") Attributes
celAttr (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$
Bool -> ConduitT Row Event m () -> ConduitT Row Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Any Cell CellValue -> Cell -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe CellValue -> Const Any (Maybe CellValue))
-> Cell -> Const Any Cell
Lens' Cell (Maybe CellValue)
cellValue ((Maybe CellValue -> Const Any (Maybe CellValue))
-> Cell -> Const Any Cell)
-> ((CellValue -> Const Any CellValue)
-> Maybe CellValue -> Const Any (Maybe CellValue))
-> Getting Any Cell CellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CellValue -> Const Any CellValue)
-> Maybe CellValue -> Const Any (Maybe CellValue)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) Cell
cell) (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
forall (m :: * -> *).
Monad m =>
Name
-> forall i.
Monad m =>
ConduitT i Event m () -> ConduitT i Event m ()
el (Text -> Name
n_ Text
"v") (ConduitT Row Event m () -> ConduitT Row Event m ())
-> ConduitT Row Event m () -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$
Text -> ConduitT Row Event m ()
forall (m :: * -> *) i. Monad m => Text -> ConduitT i Event m ()
content (Text -> ConduitT Row Event m ())
-> Text -> ConduitT Row Event m ()
forall a b. (a -> b) -> a -> b
$ Map Text Int -> Cell -> Text
renderCell Map Text Int
sharedStrings' Cell
cell
where
cix :: ColumnIndex
cix = Int -> ColumnIndex
ColumnIndex Int
cix'
celAttr :: Attributes
celAttr = Name -> Text -> Attributes
attr Name
"r" Text
ref Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<>
Map Text Int -> Cell -> Attributes
renderCellType Map Text Int
sharedStrings' Cell
cell
Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> (Int -> Attributes) -> Maybe Int -> Attributes
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Name -> Text -> Attributes
attr Name
"s" (Text -> Attributes) -> (Int -> Text) -> Int -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Integral a => a -> Text
txti) (Cell
cell Cell -> Getting (Maybe Int) Cell (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) Cell (Maybe Int)
Lens' Cell (Maybe Int)
cellStyle)
ref :: Text
ref :: Text
ref = CellRef -> Text
forall a b. Coercible a b => a -> b
coerce (CellRef -> Text) -> CellRef -> Text
forall a b. (a -> b) -> a -> b
$ (RowIndex, ColumnIndex) -> CellRef
singleCellRef (RowIndex
rix, ColumnIndex
cix)
renderCellType :: Map Text Int -> Cell -> Attributes
renderCellType :: Map Text Int -> Cell -> Attributes
renderCellType Map Text Int
sharedStrings' Cell
cell =
Attributes
-> (CellValue -> Attributes) -> Maybe CellValue -> Attributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Attributes
forall a. Monoid a => a
mempty
(Name -> Text -> Attributes
attr Name
"t" (Text -> Attributes)
-> (CellValue -> Text) -> CellValue -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Int -> CellValue -> Text
renderType Map Text Int
sharedStrings')
(Maybe CellValue -> Attributes) -> Maybe CellValue -> Attributes
forall a b. (a -> b) -> a -> b
$ Cell
cell Cell -> Getting (First CellValue) Cell CellValue -> Maybe CellValue
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Cell -> Const (First CellValue) Cell
Lens' Cell (Maybe CellValue)
cellValue ((Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Cell -> Const (First CellValue) Cell)
-> ((CellValue -> Const (First CellValue) CellValue)
-> Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Getting (First CellValue) Cell CellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CellValue -> Const (First CellValue) CellValue)
-> Maybe CellValue -> Const (First CellValue) (Maybe CellValue)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
renderCell :: Map Text Int -> Cell -> Text
renderCell :: Map Text Int -> Cell -> Text
renderCell Map Text Int
sharedStrings' Cell
cell = Map Text Int -> CellValue -> Text
renderValue Map Text Int
sharedStrings' CellValue
val
where
val :: CellValue
val :: CellValue
val = CellValue -> Maybe CellValue -> CellValue
forall a. a -> Maybe a -> a
fromMaybe (Text -> CellValue
CellText Text
forall a. Monoid a => a
mempty) (Maybe CellValue -> CellValue) -> Maybe CellValue -> CellValue
forall a b. (a -> b) -> a -> b
$ Cell
cell Cell -> Getting (First CellValue) Cell CellValue -> Maybe CellValue
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Cell -> Const (First CellValue) Cell
Lens' Cell (Maybe CellValue)
cellValue ((Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Cell -> Const (First CellValue) Cell)
-> ((CellValue -> Const (First CellValue) CellValue)
-> Maybe CellValue -> Const (First CellValue) (Maybe CellValue))
-> Getting (First CellValue) Cell CellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CellValue -> Const (First CellValue) CellValue)
-> Maybe CellValue -> Const (First CellValue) (Maybe CellValue)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
renderValue :: Map Text Int -> CellValue -> Text
renderValue :: Map Text Int -> CellValue -> Text
renderValue Map Text Int
sharedStrings' = \case
CellText Text
x ->
Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
x Int -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ Map Text Int
sharedStrings' Map Text Int -> Getting (First Int) (Map Text Int) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text Int)
-> Traversal' (Map Text Int) (IxValue (Map Text Int))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text Int)
x
CellDouble Double
x -> Double -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Double
x
CellBool Bool
b -> Bool -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Bool
b
CellRich [RichTextRun]
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"rich text is not supported yet"
CellError ErrorType
err -> ErrorType -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal ErrorType
err
renderType :: Map Text Int -> CellValue -> Text
renderType :: Map Text Int -> CellValue -> Text
renderType Map Text Int
sharedStrings' = \case
CellText Text
x ->
Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"str" (Text -> Int -> Text
forall a b. a -> b -> a
const Text
"s") (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ Map Text Int
sharedStrings' Map Text Int -> Getting (First Int) (Map Text Int) Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text Int)
-> Traversal' (Map Text Int) (IxValue (Map Text Int))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (Map Text Int)
x
CellDouble Double
_ -> Text
"n"
CellBool Bool
_ -> Text
"b"
CellRich [RichTextRun]
_ -> Text
"r"
CellError ErrorType
_ -> Text
"e"