{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData          #-}
{-# LANGUAGE TemplateHaskell     #-}

-- | Writes Excel files from a stream, which allows creation of
--   large Excel files while remaining in constant memory.
module Codec.Xlsx.Writer.Stream
  ( writeXlsx
  , writeXlsxWithSharedStrings
  , SheetWriteSettings(..)
  , defaultSettings
  , wsSheetView
  , wsZip
  , wsColumnProperties
  , wsRowProperties
  , wsStyles
  -- *** Shared strings
  , 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.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 :: 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)
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
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. Prism (Maybe a) (Maybe b) a 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

-- | Process sheetItems into shared strings structure to be put into
--   'writeXlsxWithSharedStrings'
sharedStrings :: Monad m  => ConduitT Row b m (Map Text Int)
sharedStrings :: 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 ()
-> ConduitM (Text, Int) b m (Map Text Int)
-> ConduitT Row b m (Map Text Int)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((Text, Int) -> Map Text Int)
-> ConduitM (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)

-- | creates a unique number for every encountered string in the stream
--   This is used for creating a required structure in the xlsx format
--   called shared strings. Every string get's transformed into a number
--
--   exposed to allow further processing, we also know the map after processing
--   but I don't think conduit provides a way of getting that out.
--   use 'sharedStrings' to just get the map
sharedStringsStream :: Monad m  =>
  ConduitT Row (Text, Int) m (Map Text Int)
sharedStringsStream :: 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 (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

-- | Settings for writing a single sheet.
data SheetWriteSettings = MkSheetWriteSettings
  { SheetWriteSettings -> [SheetView]
_wsSheetView        :: [SheetView]
  , SheetWriteSettings -> ZipOptions
_wsZip              :: ZipOptions -- ^ Enable zipOpt64=True if you intend writing large xlsx files, zip needs 64bit for files over 4gb.
  , SheetWriteSettings -> [ColumnsProperties]
_wsColumnProperties :: [ColumnsProperties]
  , SheetWriteSettings -> Map Int RowProperties
_wsRowProperties    :: Map Int RowProperties
  , SheetWriteSettings -> Styles
_wsStyles           :: Styles
  }
instance Show  SheetWriteSettings where
  -- ZipOptions lacks a show instance-}
  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 :: [SheetView]
-> ZipOptions
-> [ColumnsProperties]
-> Map Int RowProperties
-> Styles
-> SheetWriteSettings
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 :: Bool
zipOpt64 = Bool
False
  -- There is a magick number in the zip archive package,
  -- https://hackage.haskell.org/package/zip-archive-0.4.1/docs/src/Codec.Archive.Zip.html#local-6989586621679055672
  -- if we enable 64bit the number doesn't align causing the test to fail.
  }
  }



-- | Transform a 'Row' stream into a stream that creates the xlsx file format
--   (to be consumed by sinkfile for example)
--  This first runs 'sharedStrings' and then 'writeXlsxWithSharedStrings'.
--  If you want xlsx files this is the most obvious function to use.
--  the others are exposed in case you can cache the shared strings for example.
--
--  Note that the current implementation concatenates everything into a single sheet.
--  In other words there is no support for writing multiple sheets
writeXlsx :: MonadThrow m
    => PrimMonad m
    => SheetWriteSettings -- ^ use 'defaultSettings'
    -> ConduitT () Row m () -- ^ the conduit producing sheetitems
    -> ConduitT () ByteString m Word64 -- ^ result conduit producing xlsx files
writeXlsx :: 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 ()
-> ConduitM Row ByteString m (Map Text Int)
-> ConduitM () ByteString m (Map Text Int)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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


-- TODO maybe should use bimap instead: https://hackage.haskell.org/package/bimap-0.4.0/docs/Data-Bimap.html
-- it guarantees uniqueness of both text and int
-- | This write Excel file with a shared strings lookup table.
--   It appears that it is optional.
--   Failed lookups will result in valid xlsx.
--   There are several conditions on shared strings,
--
--      1. Every text to int is unique on both text and int.
--      2. Every Int should have a gap no greater than 1. [("xx", 3), ("yy", 4)] is okay, whereas [("xx", 3), ("yy", 5)] is not.
--      3. It's expected this starts from 0.
--
--   Use 'sharedStringsStream' to get a good shared strings table.
--   This is provided because the user may have a more efficient way of
--   constructing this table than the library can provide,
--   for example through database operations.
writeXlsxWithSharedStrings :: MonadThrow m => PrimMonad m
    => SheetWriteSettings
    -> Map Text Int -- ^ shared strings table
    -> ConduitT () Row m ()
    -> ConduitT () ByteString m Word64
writeXlsxWithSharedStrings :: 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 ()
-> ConduitM (ZipEntry, ZipData m) ByteString m Word64
-> ConduitT () ByteString m Word64
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ZipOptions -> ConduitM (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)

-- massive amount of boilerplate needed for excel to function
boilerplate :: forall m . PrimMonad m  => SheetWriteSettings -> Map Text Int -> [(ZipEntry,  ZipData m)]
boilerplate :: 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 ()
-> ConduitM Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeContentTypes ConduitT () Event m ()
-> ConduitM Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbook ConduitT () Event m ()
-> ConduitM Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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
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 (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeWorkbookRels ConduitT () Event m ()
-> ConduitM Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 (m :: * -> *) i. Monad m => ConduitT i Event m ()
writeRootRels ConduitT () Event m ()
-> ConduitM Event ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 :: 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 ()
-> ConduitM Row ByteString m () -> ConduitM () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM 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 ()
-> ConduitM Event ByteString m () -> ConduitM Row ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 :: 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

--   Clark notation is used a lot for xml namespaces in this module:
--   <https://hackage.haskell.org/package/xml-types-0.3.8/docs/Data-XML-Types.html#t:Name>
--   Name has an IsString instance which parses it
override :: Monad m => Text -> Text -> forall i.  ConduitT i Event m ()
override :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | required by Excel.
writeContentTypes :: Monad m => forall i.  ConduitT i Event m ()
writeContentTypes :: forall i. 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"

-- | required by Excel.
writeWorkbook :: Monad m => forall i.  ConduitT i Event m ()
writeWorkbook :: forall i. 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

doc :: Monad m => Name ->  forall i.  ConduitT i Event m () -> ConduitT i Event m ()
doc :: 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 -> 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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

writeWorkbookRels :: Monad m => forall i.  ConduitT i Event m ()
writeWorkbookRels :: forall i. 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 i. 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 :: Either Text ByteString
-> LocalTime -> Maybe Word64 -> Maybe Word32 -> ZipEntry
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 :: ConduitT Event ByteString m ()
eventsToBS = ConduitT Event Builder m ()
forall (m :: * -> *). PrimMonad m => ConduitT Event Builder m ()
writeEvents ConduitT Event Builder m ()
-> ConduitM Builder ByteString m ()
-> ConduitT Event ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM 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 :: 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)
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 :: 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 :: Bool
rsPretty=Bool
False})

sheetViews :: forall m . MonadReader SheetWriteSettings m => forall i . ConduitT i Event m ()
sheetViews :: forall i. 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 (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 (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 :: Name
elementName = ((Element -> Name
elementName Element
xelm ){nameNamespace :: Maybe Text
nameNamespace =
                                    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
space })
      , elementNodes :: [Node]
elementNodes = Element -> [Node]
elementNodes Element
xelm [Node] -> (Node -> Node) -> [Node]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \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 :: 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 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 :: 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 (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 :: 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 Int
Index (Map Int RowProperties)
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. Prism (Maybe a) (Maybe b) a 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 (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)
itraverse (Map Text Int -> Int -> Int -> Cell -> ConduitT Row Event m ()
forall (m :: * -> *).
Monad m =>
Map Text Int -> Int -> Int -> Cell -> ConduitT Row Event m ()
mapCell Map Text Int
sharedStrings' Int
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 :: Int
rowIx = Row
sheetItem Row -> Getting Int Row Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Row Int
Lens' Row Int
ri_row_index
    ixAttr :: Attributes
ixAttr = Name -> Text -> Attributes
attr Name
"r" (Text -> Attributes) -> Text -> Attributes
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Int
rowIx

mapCell :: Monad m => Map Text Int -> Int -> Int -> Cell -> ConduitT Row Event m ()
mapCell :: Map Text Int -> Int -> Int -> Cell -> ConduitT Row Event m ()
mapCell Map Text Int
sharedStrings' Int
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. Prism (Maybe a) (Maybe b) a 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. Prism (Maybe a) (Maybe b) a 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. Prism (Maybe a) (Maybe b) a 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
    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 (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
coerce (CellRef -> Text) -> CellRef -> Text
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> CellRef
singleCellRef (Int
rix, Int
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. Prism (Maybe a) (Maybe b) a 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. Prism (Maybe a) (Maybe b) a b
_Just

renderValue :: Map Text Int -> CellValue -> Text
renderValue :: Map Text Int -> CellValue -> Text
renderValue Map Text Int
sharedStrings' = \case
  CellText Text
x ->
    -- if we can't find it in the sst, print the string
    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"