-- | Higher level interface for creating styled worksheets
{-# LANGUAGE CPP      #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Formatted
  ( FormattedCell(..)
  , Formatted(..)
  , Format(..)
  , formatted
  , formatWorkbook
  , toFormattedCells
  , CondFormatted(..)
  , conditionallyFormatted
    -- * Lenses
    -- ** Format
  , formatAlignment
  , formatBorder
  , formatFill
  , formatFont
  , formatNumberFormat
  , formatProtection
  , formatPivotButton
  , formatQuotePrefix
    -- ** FormattedCell
  , formattedCell
  , formattedFormat
  , formattedColSpan
  , formattedRowSpan
    -- ** FormattedCondFmt
  , condfmtCondition
  , condfmtDxf
  , condfmtPriority
  , condfmtStopIfTrue
  ) where

#ifdef USE_MICROLENS
import Lens.Micro
import Lens.Micro.Mtl
import Lens.Micro.TH
import Lens.Micro.GHC ()
#else
import Control.Lens
#endif
import Control.Monad.State hiding (forM_, mapM)
import Data.Default
import Data.Foldable (asum, forM_)
import Data.Function (on)
import Data.List (foldl', groupBy, sortBy, sortBy)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Traversable (mapM)
import Data.Tuple (swap)
import GHC.Generics (Generic)
import Prelude hiding (mapM)
import Safe (headNote, fromJustNote)

import Codec.Xlsx.Types

{-------------------------------------------------------------------------------
  Internal: formatting state
-------------------------------------------------------------------------------}

data FormattingState = FormattingState {
    FormattingState -> Map Border Int
_formattingBorders :: Map Border Int
  , FormattingState -> Map CellXf Int
_formattingCellXfs :: Map CellXf Int
  , FormattingState -> Map Fill Int
_formattingFills   :: Map Fill   Int
  , FormattingState -> Map Font Int
_formattingFonts   :: Map Font   Int
  , FormattingState -> Map Text Int
_formattingNumFmts :: Map Text   Int
  , FormattingState -> [Range]
_formattingMerges  :: [Range] -- ^ In reverse order
  }

makeLenses ''FormattingState

stateFromStyleSheet :: StyleSheet -> FormattingState
stateFromStyleSheet :: StyleSheet -> FormattingState
stateFromStyleSheet StyleSheet{[Dxf]
[Font]
[Fill]
[Border]
[CellXf]
Map Int Text
_styleSheetNumFmts :: StyleSheet -> Map Int Text
_styleSheetDxfs :: StyleSheet -> [Dxf]
_styleSheetFonts :: StyleSheet -> [Font]
_styleSheetFills :: StyleSheet -> [Fill]
_styleSheetCellXfs :: StyleSheet -> [CellXf]
_styleSheetBorders :: StyleSheet -> [Border]
_styleSheetNumFmts :: Map Int Text
_styleSheetDxfs :: [Dxf]
_styleSheetFonts :: [Font]
_styleSheetFills :: [Fill]
_styleSheetCellXfs :: [CellXf]
_styleSheetBorders :: [Border]
..} = FormattingState :: Map Border Int
-> Map CellXf Int
-> Map Fill Int
-> Map Font Int
-> Map Text Int
-> [Range]
-> FormattingState
FormattingState{
      _formattingBorders :: Map Border Int
_formattingBorders = [Border] -> Map Border Int
forall a. Ord a => [a] -> Map a Int
fromValueList [Border]
_styleSheetBorders
    , _formattingCellXfs :: Map CellXf Int
_formattingCellXfs = [CellXf] -> Map CellXf Int
forall a. Ord a => [a] -> Map a Int
fromValueList [CellXf]
_styleSheetCellXfs
    , _formattingFills :: Map Fill Int
_formattingFills   = [Fill] -> Map Fill Int
forall a. Ord a => [a] -> Map a Int
fromValueList [Fill]
_styleSheetFills
    , _formattingFonts :: Map Font Int
_formattingFonts   = [Font] -> Map Font Int
forall a. Ord a => [a] -> Map a Int
fromValueList [Font]
_styleSheetFonts
    , _formattingNumFmts :: Map Text Int
_formattingNumFmts = [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Int)] -> Map Text Int)
-> ([(Int, Text)] -> [(Text, Int)])
-> [(Int, Text)]
-> Map Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Text) -> (Text, Int)) -> [(Int, Text)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> (Text, Int)
forall a b. (a, b) -> (b, a)
swap ([(Int, Text)] -> Map Text Int) -> [(Int, Text)] -> Map Text Int
forall a b. (a -> b) -> a -> b
$ Map Int Text -> [(Int, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Int Text
_styleSheetNumFmts
    , _formattingMerges :: [Range]
_formattingMerges  = []
    }

fromValueList :: Ord a => [a] -> Map a Int
fromValueList :: [a] -> Map a Int
fromValueList = [(a, Int)] -> Map a Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Int)] -> Map a Int)
-> ([a] -> [(a, Int)]) -> [a] -> Map a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0..])

toValueList :: Map a Int -> [a]
toValueList :: Map a Int -> [a]
toValueList = ((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd ([(Int, a)] -> [a])
-> (Map a Int -> [(Int, a)]) -> Map a Int -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> (Int, a) -> Ordering) -> [(Int, a)] -> [(Int, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, a) -> Int) -> (Int, a) -> (Int, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, a) -> Int
forall a b. (a, b) -> a
fst) ([(Int, a)] -> [(Int, a)])
-> (Map a Int -> [(Int, a)]) -> Map a Int -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Int) -> (Int, a)) -> [(a, Int)] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> (Int, a)
forall a b. (a, b) -> (b, a)
swap ([(a, Int)] -> [(Int, a)])
-> (Map a Int -> [(a, Int)]) -> Map a Int -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toList

updateStyleSheetFromState :: StyleSheet -> FormattingState -> StyleSheet
updateStyleSheetFromState :: StyleSheet -> FormattingState -> StyleSheet
updateStyleSheetFromState StyleSheet
sSheet FormattingState{[Range]
Map Text Int
Map Font Int
Map Fill Int
Map Border Int
Map CellXf Int
_formattingMerges :: [Range]
_formattingNumFmts :: Map Text Int
_formattingFonts :: Map Font Int
_formattingFills :: Map Fill Int
_formattingCellXfs :: Map CellXf Int
_formattingBorders :: Map Border Int
_formattingMerges :: FormattingState -> [Range]
_formattingNumFmts :: FormattingState -> Map Text Int
_formattingFonts :: FormattingState -> Map Font Int
_formattingFills :: FormattingState -> Map Fill Int
_formattingCellXfs :: FormattingState -> Map CellXf Int
_formattingBorders :: FormattingState -> Map Border Int
..} = StyleSheet
sSheet
    { _styleSheetBorders :: [Border]
_styleSheetBorders = Map Border Int -> [Border]
forall a. Map a Int -> [a]
toValueList Map Border Int
_formattingBorders
    , _styleSheetCellXfs :: [CellXf]
_styleSheetCellXfs = Map CellXf Int -> [CellXf]
forall a. Map a Int -> [a]
toValueList Map CellXf Int
_formattingCellXfs
    , _styleSheetFills :: [Fill]
_styleSheetFills   = Map Fill Int -> [Fill]
forall a. Map a Int -> [a]
toValueList Map Fill Int
_formattingFills
    , _styleSheetFonts :: [Font]
_styleSheetFonts   = Map Font Int -> [Font]
forall a. Map a Int -> [a]
toValueList Map Font Int
_formattingFonts
    , _styleSheetNumFmts :: Map Int Text
_styleSheetNumFmts = [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Text)] -> Map Int Text)
-> ([(Text, Int)] -> [(Int, Text)])
-> [(Text, Int)]
-> Map Int Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> (Int, Text)) -> [(Text, Int)] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> (Int, Text)
forall a b. (a, b) -> (b, a)
swap ([(Text, Int)] -> Map Int Text) -> [(Text, Int)] -> Map Int Text
forall a b. (a -> b) -> a -> b
$ Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Int
_formattingNumFmts
    }

getId :: Ord a => Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId :: Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId = Int
-> Lens' FormattingState (Map a Int)
-> a
-> State FormattingState Int
forall a.
Ord a =>
Int
-> Lens' FormattingState (Map a Int)
-> a
-> State FormattingState Int
getId' Int
0

getId' :: Ord a
       => Int
       -> Lens' FormattingState (Map a Int)
       -> a
       -> State FormattingState Int
getId' :: Int
-> Lens' FormattingState (Map a Int)
-> a
-> State FormattingState Int
getId' Int
k Lens' FormattingState (Map a Int)
f a
v = do
    Map a Int
aMap <- Getting (Map a Int) FormattingState (Map a Int)
-> StateT FormattingState Identity (Map a Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map a Int) FormattingState (Map a Int)
Lens' FormattingState (Map a Int)
f
    case a -> Map a Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a Int
aMap of
      Just Int
anId -> Int -> State FormattingState Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
anId
      Maybe Int
Nothing  -> do let anId :: Int
anId = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map a Int -> Int
forall k a. Map k a -> Int
M.size Map a Int
aMap
                     (Map a Int -> Identity (Map a Int))
-> FormattingState -> Identity FormattingState
Lens' FormattingState (Map a Int)
f ((Map a Int -> Identity (Map a Int))
 -> FormattingState -> Identity FormattingState)
-> (Map a Int -> Map a Int) -> StateT FormattingState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
anId
                     Int -> State FormattingState Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
anId

{-------------------------------------------------------------------------------
  Unwrapped cell conditional formatting
-------------------------------------------------------------------------------}

data FormattedCondFmt = FormattedCondFmt
    { FormattedCondFmt -> Condition
_condfmtCondition  :: Condition
    , FormattedCondFmt -> Dxf
_condfmtDxf        :: Dxf
    , FormattedCondFmt -> Int
_condfmtPriority   :: Int
    , FormattedCondFmt -> Maybe Bool
_condfmtStopIfTrue :: Maybe Bool
    } deriving (FormattedCondFmt -> FormattedCondFmt -> Bool
(FormattedCondFmt -> FormattedCondFmt -> Bool)
-> (FormattedCondFmt -> FormattedCondFmt -> Bool)
-> Eq FormattedCondFmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedCondFmt -> FormattedCondFmt -> Bool
$c/= :: FormattedCondFmt -> FormattedCondFmt -> Bool
== :: FormattedCondFmt -> FormattedCondFmt -> Bool
$c== :: FormattedCondFmt -> FormattedCondFmt -> Bool
Eq, Int -> FormattedCondFmt -> ShowS
[FormattedCondFmt] -> ShowS
FormattedCondFmt -> String
(Int -> FormattedCondFmt -> ShowS)
-> (FormattedCondFmt -> String)
-> ([FormattedCondFmt] -> ShowS)
-> Show FormattedCondFmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattedCondFmt] -> ShowS
$cshowList :: [FormattedCondFmt] -> ShowS
show :: FormattedCondFmt -> String
$cshow :: FormattedCondFmt -> String
showsPrec :: Int -> FormattedCondFmt -> ShowS
$cshowsPrec :: Int -> FormattedCondFmt -> ShowS
Show, (forall x. FormattedCondFmt -> Rep FormattedCondFmt x)
-> (forall x. Rep FormattedCondFmt x -> FormattedCondFmt)
-> Generic FormattedCondFmt
forall x. Rep FormattedCondFmt x -> FormattedCondFmt
forall x. FormattedCondFmt -> Rep FormattedCondFmt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormattedCondFmt x -> FormattedCondFmt
$cfrom :: forall x. FormattedCondFmt -> Rep FormattedCondFmt x
Generic)

makeLenses ''FormattedCondFmt

{-------------------------------------------------------------------------------
  Cell with formatting
-------------------------------------------------------------------------------}

-- | Formatting options used to format cells
--
-- TODOs:
--
-- * Add a number format ('_cellXfApplyNumberFormat', '_cellXfNumFmtId')
-- * Add references to the named style sheets ('_cellXfId')
data Format = Format
    { Format -> Maybe Alignment
_formatAlignment    :: Maybe Alignment
    , Format -> Maybe Border
_formatBorder       :: Maybe Border
    , Format -> Maybe Fill
_formatFill         :: Maybe Fill
    , Format -> Maybe Font
_formatFont         :: Maybe Font
    , Format -> Maybe NumberFormat
_formatNumberFormat :: Maybe NumberFormat
    , Format -> Maybe Protection
_formatProtection   :: Maybe Protection
    , Format -> Maybe Bool
_formatPivotButton  :: Maybe Bool
    , Format -> Maybe Bool
_formatQuotePrefix  :: Maybe Bool
    } deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic)

makeLenses ''Format

-- | Cell with formatting. '_cellStyle' property of '_formattedCell' is ignored
--
-- See 'formatted' for more details.
data FormattedCell = FormattedCell
    { FormattedCell -> Cell
_formattedCell    :: Cell
    , FormattedCell -> Format
_formattedFormat  :: Format
    , FormattedCell -> Int
_formattedColSpan :: Int
    , FormattedCell -> Int
_formattedRowSpan :: Int
    } deriving (FormattedCell -> FormattedCell -> Bool
(FormattedCell -> FormattedCell -> Bool)
-> (FormattedCell -> FormattedCell -> Bool) -> Eq FormattedCell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedCell -> FormattedCell -> Bool
$c/= :: FormattedCell -> FormattedCell -> Bool
== :: FormattedCell -> FormattedCell -> Bool
$c== :: FormattedCell -> FormattedCell -> Bool
Eq, Int -> FormattedCell -> ShowS
[FormattedCell] -> ShowS
FormattedCell -> String
(Int -> FormattedCell -> ShowS)
-> (FormattedCell -> String)
-> ([FormattedCell] -> ShowS)
-> Show FormattedCell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattedCell] -> ShowS
$cshowList :: [FormattedCell] -> ShowS
show :: FormattedCell -> String
$cshow :: FormattedCell -> String
showsPrec :: Int -> FormattedCell -> ShowS
$cshowsPrec :: Int -> FormattedCell -> ShowS
Show, (forall x. FormattedCell -> Rep FormattedCell x)
-> (forall x. Rep FormattedCell x -> FormattedCell)
-> Generic FormattedCell
forall x. Rep FormattedCell x -> FormattedCell
forall x. FormattedCell -> Rep FormattedCell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormattedCell x -> FormattedCell
$cfrom :: forall x. FormattedCell -> Rep FormattedCell x
Generic)

makeLenses ''FormattedCell

{-------------------------------------------------------------------------------
  Default instances
-------------------------------------------------------------------------------}

instance Default FormattedCell where
  def :: FormattedCell
def = FormattedCell :: Cell -> Format -> Int -> Int -> FormattedCell
FormattedCell
        { _formattedCell :: Cell
_formattedCell    = Cell
forall a. Default a => a
def
        , _formattedFormat :: Format
_formattedFormat  = Format
forall a. Default a => a
def
        , _formattedColSpan :: Int
_formattedColSpan = Int
1
        , _formattedRowSpan :: Int
_formattedRowSpan = Int
1
        }

instance Default Format where
  def :: Format
def = Format :: Maybe Alignment
-> Maybe Border
-> Maybe Fill
-> Maybe Font
-> Maybe NumberFormat
-> Maybe Protection
-> Maybe Bool
-> Maybe Bool
-> Format
Format
        { _formatAlignment :: Maybe Alignment
_formatAlignment    = Maybe Alignment
forall a. Maybe a
Nothing
        , _formatBorder :: Maybe Border
_formatBorder       = Maybe Border
forall a. Maybe a
Nothing
        , _formatFill :: Maybe Fill
_formatFill         = Maybe Fill
forall a. Maybe a
Nothing
        , _formatFont :: Maybe Font
_formatFont         = Maybe Font
forall a. Maybe a
Nothing
        , _formatNumberFormat :: Maybe NumberFormat
_formatNumberFormat = Maybe NumberFormat
forall a. Maybe a
Nothing
        , _formatProtection :: Maybe Protection
_formatProtection   = Maybe Protection
forall a. Maybe a
Nothing
        , _formatPivotButton :: Maybe Bool
_formatPivotButton  = Maybe Bool
forall a. Maybe a
Nothing
        , _formatQuotePrefix :: Maybe Bool
_formatQuotePrefix  = Maybe Bool
forall a. Maybe a
Nothing
        }

instance Default FormattedCondFmt where
  def :: FormattedCondFmt
def = Condition -> Dxf -> Int -> Maybe Bool -> FormattedCondFmt
FormattedCondFmt Condition
ContainsBlanks Dxf
forall a. Default a => a
def Int
topCfPriority Maybe Bool
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Client-facing API
-------------------------------------------------------------------------------}

-- | Result of formatting
--
-- See 'formatted'
data Formatted = Formatted {
    -- | The final 'CellMap'; see '_wsCells'
    Formatted -> CellMap
formattedCellMap    :: CellMap

    -- | The final stylesheet; see '_xlStyles' (and 'renderStyleSheet')
  , Formatted -> StyleSheet
formattedStyleSheet :: StyleSheet

    -- | The final list of cell merges; see '_wsMerges'
  , Formatted -> [Range]
formattedMerges     :: [Range]
  } deriving (Formatted -> Formatted -> Bool
(Formatted -> Formatted -> Bool)
-> (Formatted -> Formatted -> Bool) -> Eq Formatted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Formatted -> Formatted -> Bool
$c/= :: Formatted -> Formatted -> Bool
== :: Formatted -> Formatted -> Bool
$c== :: Formatted -> Formatted -> Bool
Eq, Int -> Formatted -> ShowS
[Formatted] -> ShowS
Formatted -> String
(Int -> Formatted -> ShowS)
-> (Formatted -> String)
-> ([Formatted] -> ShowS)
-> Show Formatted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Formatted] -> ShowS
$cshowList :: [Formatted] -> ShowS
show :: Formatted -> String
$cshow :: Formatted -> String
showsPrec :: Int -> Formatted -> ShowS
$cshowsPrec :: Int -> Formatted -> ShowS
Show, (forall x. Formatted -> Rep Formatted x)
-> (forall x. Rep Formatted x -> Formatted) -> Generic Formatted
forall x. Rep Formatted x -> Formatted
forall x. Formatted -> Rep Formatted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Formatted x -> Formatted
$cfrom :: forall x. Formatted -> Rep Formatted x
Generic)

-- | Higher level API for creating formatted documents
--
-- Creating formatted Excel spreadsheets using the 'Cell' datatype directly,
-- even with the support for the 'StyleSheet' datatype, is fairly painful.
-- This has a number of causes:
--
-- * The 'Cell' datatype wants an 'Int' for the style, which is supposed to
--   point into the '_styleSheetCellXfs' part of a stylesheet. However, this can
--   be difficult to work with, as it requires manual tracking of cell style
--   IDs, which in turns requires manual tracking of font IDs, border IDs, etc.
-- * Row-span and column-span properties are set on the worksheet as a whole
--   ('wsMerges') rather than on individual cells.
-- * Excel does not correctly deal with borders on cells that span multiple
--   columns or rows. Instead, these rows must be set on all the edge cells
--   in the block. Again, this means that this becomes a global property of
--   the spreadsheet rather than properties of individual cells.
--
-- This function deals with all these problems. Given a map of 'FormattedCell's,
-- which refer directly to 'Font's, 'Border's, etc. (rather than font IDs,
-- border IDs, etc.), and an initial stylesheet, it recovers all possible
-- sharing, constructs IDs, and then constructs the final 'CellMap', as well as
-- the final stylesheet and list of merges.
--
-- If you don't already have a 'StyleSheet' you want to use as starting point
-- then 'minimalStyleSheet' is a good choice.
formatted :: Map (Int, Int) FormattedCell -> StyleSheet -> Formatted
formatted :: Map (Int, Int) FormattedCell -> StyleSheet -> Formatted
formatted Map (Int, Int) FormattedCell
cs StyleSheet
styleSheet =
   let initSt :: FormattingState
initSt         = StyleSheet -> FormattingState
stateFromStyleSheet StyleSheet
styleSheet
       ([[((Int, Int), Cell)]]
cs', FormattingState
finalSt) = State FormattingState [[((Int, Int), Cell)]]
-> FormattingState -> ([[((Int, Int), Cell)]], FormattingState)
forall s a. State s a -> s -> (a, s)
runState ((((Int, Int), FormattedCell)
 -> StateT FormattingState Identity [((Int, Int), Cell)])
-> [((Int, Int), FormattedCell)]
-> State FormattingState [[((Int, Int), Cell)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int, Int)
 -> FormattedCell
 -> StateT FormattingState Identity [((Int, Int), Cell)])
-> ((Int, Int), FormattedCell)
-> StateT FormattingState Identity [((Int, Int), Cell)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int, Int)
-> FormattedCell
-> StateT FormattingState Identity [((Int, Int), Cell)]
formatCell) (Map (Int, Int) FormattedCell -> [((Int, Int), FormattedCell)]
forall k a. Map k a -> [(k, a)]
M.toList Map (Int, Int) FormattedCell
cs)) FormattingState
initSt
       styleSheet' :: StyleSheet
styleSheet'    = StyleSheet -> FormattingState -> StyleSheet
updateStyleSheetFromState StyleSheet
styleSheet FormattingState
finalSt
   in Formatted :: CellMap -> StyleSheet -> [Range] -> Formatted
Formatted {
          formattedCellMap :: CellMap
formattedCellMap    = [((Int, Int), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([[((Int, Int), Cell)]] -> [((Int, Int), Cell)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((Int, Int), Cell)]]
cs')
        , formattedStyleSheet :: StyleSheet
formattedStyleSheet = StyleSheet
styleSheet'
        , formattedMerges :: [Range]
formattedMerges     = [Range] -> [Range]
forall a. [a] -> [a]
reverse (FormattingState
finalSt FormattingState
-> Getting [Range] FormattingState [Range] -> [Range]
forall s a. s -> Getting a s a -> a
^. Getting [Range] FormattingState [Range]
Lens' FormattingState [Range]
formattingMerges)
        }

formatWorkbook :: [(Text, Map (Int, Int) FormattedCell)] -> StyleSheet -> Xlsx
formatWorkbook :: [(Text, Map (Int, Int) FormattedCell)] -> StyleSheet -> Xlsx
formatWorkbook [(Text, Map (Int, Int) FormattedCell)]
nfcss StyleSheet
initStyle = ([(Text, Worksheet)], FormattingState) -> Xlsx
extract ([(Text, Worksheet)], FormattingState)
go
  where
    initSt :: FormattingState
initSt = StyleSheet -> FormattingState
stateFromStyleSheet StyleSheet
initStyle
    go :: ([(Text, Worksheet)], FormattingState)
go = (State FormattingState [(Text, Worksheet)]
 -> FormattingState -> ([(Text, Worksheet)], FormattingState))
-> FormattingState
-> State FormattingState [(Text, Worksheet)]
-> ([(Text, Worksheet)], FormattingState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State FormattingState [(Text, Worksheet)]
-> FormattingState -> ([(Text, Worksheet)], FormattingState)
forall s a. State s a -> s -> (a, s)
runState FormattingState
initSt (State FormattingState [(Text, Worksheet)]
 -> ([(Text, Worksheet)], FormattingState))
-> State FormattingState [(Text, Worksheet)]
-> ([(Text, Worksheet)], FormattingState)
forall a b. (a -> b) -> a -> b
$
      [(Text, Map (Int, Int) FormattedCell)]
-> ((Text, Map (Int, Int) FormattedCell)
    -> StateT FormattingState Identity (Text, Worksheet))
-> State FormattingState [(Text, Worksheet)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Map (Int, Int) FormattedCell)]
nfcss (((Text, Map (Int, Int) FormattedCell)
  -> StateT FormattingState Identity (Text, Worksheet))
 -> State FormattingState [(Text, Worksheet)])
-> ((Text, Map (Int, Int) FormattedCell)
    -> StateT FormattingState Identity (Text, Worksheet))
-> State FormattingState [(Text, Worksheet)]
forall a b. (a -> b) -> a -> b
$ \(Text
name, Map (Int, Int) FormattedCell
fcs) -> do
        [[((Int, Int), Cell)]]
cs' <- [((Int, Int), FormattedCell)]
-> (((Int, Int), FormattedCell)
    -> StateT FormattingState Identity [((Int, Int), Cell)])
-> State FormattingState [[((Int, Int), Cell)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map (Int, Int) FormattedCell -> [((Int, Int), FormattedCell)]
forall k a. Map k a -> [(k, a)]
M.toList Map (Int, Int) FormattedCell
fcs) ((((Int, Int), FormattedCell)
  -> StateT FormattingState Identity [((Int, Int), Cell)])
 -> State FormattingState [[((Int, Int), Cell)]])
-> (((Int, Int), FormattedCell)
    -> StateT FormattingState Identity [((Int, Int), Cell)])
-> State FormattingState [[((Int, Int), Cell)]]
forall a b. (a -> b) -> a -> b
$ \((Int, Int)
rc, FormattedCell
fc) -> (Int, Int)
-> FormattedCell
-> StateT FormattingState Identity [((Int, Int), Cell)]
formatCell (Int, Int)
rc FormattedCell
fc
        [Range]
merges <- [Range] -> [Range]
forall a. [a] -> [a]
reverse ([Range] -> [Range])
-> (FormattingState -> [Range]) -> FormattingState -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattingState -> [Range]
_formattingMerges (FormattingState -> [Range])
-> StateT FormattingState Identity FormattingState
-> StateT FormattingState Identity [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT FormattingState Identity FormattingState
forall s (m :: * -> *). MonadState s m => m s
get
        (Text, Worksheet)
-> StateT FormattingState Identity (Text, Worksheet)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
name
               , Worksheet
forall a. Default a => a
def Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& (CellMap -> Identity CellMap) -> Worksheet -> Identity Worksheet
Lens' Worksheet CellMap
wsCells  ((CellMap -> Identity CellMap) -> Worksheet -> Identity Worksheet)
-> CellMap -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [((Int, Int), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([[((Int, Int), Cell)]] -> [((Int, Int), Cell)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((Int, Int), Cell)]]
cs')
                     Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& ([Range] -> Identity [Range]) -> Worksheet -> Identity Worksheet
Lens' Worksheet [Range]
wsMerges (([Range] -> Identity [Range]) -> Worksheet -> Identity Worksheet)
-> [Range] -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Range]
merges)
    extract :: ([(Text, Worksheet)], FormattingState) -> Xlsx
extract ([(Text, Worksheet)]
sheets, FormattingState
st) =
      Xlsx
forall a. Default a => a
def Xlsx -> (Xlsx -> Xlsx) -> Xlsx
forall a b. a -> (a -> b) -> b
& ([(Text, Worksheet)] -> Identity [(Text, Worksheet)])
-> Xlsx -> Identity Xlsx
Lens' Xlsx [(Text, Worksheet)]
xlSheets (([(Text, Worksheet)] -> Identity [(Text, Worksheet)])
 -> Xlsx -> Identity Xlsx)
-> [(Text, Worksheet)] -> Xlsx -> Xlsx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Worksheet)]
sheets
          Xlsx -> (Xlsx -> Xlsx) -> Xlsx
forall a b. a -> (a -> b) -> b
& (Styles -> Identity Styles) -> Xlsx -> Identity Xlsx
Lens' Xlsx Styles
xlStyles ((Styles -> Identity Styles) -> Xlsx -> Identity Xlsx)
-> Styles -> Xlsx -> Xlsx
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StyleSheet -> Styles
renderStyleSheet (StyleSheet -> FormattingState -> StyleSheet
updateStyleSheetFromState StyleSheet
initStyle FormattingState
st)

-- | reverse to 'formatted' which allows to get a map of formatted cells
-- from an existing worksheet and its workbook's style sheet
toFormattedCells :: CellMap -> [Range] -> StyleSheet -> Map (Int, Int) FormattedCell
toFormattedCells :: CellMap -> [Range] -> StyleSheet -> Map (Int, Int) FormattedCell
toFormattedCells CellMap
m [Range]
merges StyleSheet{[Dxf]
[Font]
[Fill]
[Border]
[CellXf]
Map Int Text
_styleSheetNumFmts :: Map Int Text
_styleSheetDxfs :: [Dxf]
_styleSheetFonts :: [Font]
_styleSheetFills :: [Fill]
_styleSheetCellXfs :: [CellXf]
_styleSheetBorders :: [Border]
_styleSheetNumFmts :: StyleSheet -> Map Int Text
_styleSheetDxfs :: StyleSheet -> [Dxf]
_styleSheetFonts :: StyleSheet -> [Font]
_styleSheetFills :: StyleSheet -> [Fill]
_styleSheetCellXfs :: StyleSheet -> [CellXf]
_styleSheetBorders :: StyleSheet -> [Border]
..} = Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell
applyMerges (Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell)
-> Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell
forall a b. (a -> b) -> a -> b
$ (Cell -> FormattedCell) -> CellMap -> Map (Int, Int) FormattedCell
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Cell -> FormattedCell
toFormattedCell CellMap
m
  where
    toFormattedCell :: Cell -> FormattedCell
toFormattedCell cell :: Cell
cell@Cell{Maybe Int
Maybe CellValue
Maybe Comment
Maybe CellFormula
_cellFormula :: Cell -> Maybe CellFormula
_cellComment :: Cell -> Maybe Comment
_cellValue :: Cell -> Maybe CellValue
_cellStyle :: Cell -> Maybe Int
_cellFormula :: Maybe CellFormula
_cellComment :: Maybe Comment
_cellValue :: Maybe CellValue
_cellStyle :: Maybe Int
..} =
        FormattedCell :: Cell -> Format -> Int -> Int -> FormattedCell
FormattedCell
        { _formattedCell :: Cell
_formattedCell    = Cell
cell{ _cellStyle :: Maybe Int
_cellStyle = Maybe Int
forall a. Maybe a
Nothing } -- just to remove confusion
        , _formattedFormat :: Format
_formattedFormat  = Format -> (CellXf -> Format) -> Maybe CellXf -> Format
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Format
forall a. Default a => a
def CellXf -> Format
formatFromStyle (Maybe CellXf -> Format) -> Maybe CellXf -> Format
forall a b. (a -> b) -> a -> b
$ (Int -> Map Int CellXf -> Maybe CellXf)
-> Map Int CellXf -> Int -> Maybe CellXf
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int CellXf -> Maybe CellXf
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int CellXf
cellXfs (Int -> Maybe CellXf) -> Maybe Int -> Maybe CellXf
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
_cellStyle
        , _formattedColSpan :: Int
_formattedColSpan = Int
1
        , _formattedRowSpan :: Int
_formattedRowSpan = Int
1 }
    formatFromStyle :: CellXf -> Format
formatFromStyle CellXf
cellXf =
        Format :: Maybe Alignment
-> Maybe Border
-> Maybe Fill
-> Maybe Font
-> Maybe NumberFormat
-> Maybe Protection
-> Maybe Bool
-> Maybe Bool
-> Format
Format
        { _formatAlignment :: Maybe Alignment
_formatAlignment    = (CellXf -> Maybe Bool)
-> (CellXf -> Maybe Alignment) -> CellXf -> Maybe Alignment
forall a.
(CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
_cellXfApplyAlignment CellXf -> Maybe Alignment
_cellXfAlignment CellXf
cellXf
        , _formatBorder :: Maybe Border
_formatBorder       = (Int -> Map Int Border -> Maybe Border)
-> Map Int Border -> Int -> Maybe Border
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int Border -> Maybe Border
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Border
borders (Int -> Maybe Border) -> Maybe Int -> Maybe Border
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                (CellXf -> Maybe Bool)
-> (CellXf -> Maybe Int) -> CellXf -> Maybe Int
forall a.
(CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
_cellXfApplyBorder CellXf -> Maybe Int
_cellXfBorderId CellXf
cellXf
        , _formatFill :: Maybe Fill
_formatFill         = (Int -> Map Int Fill -> Maybe Fill)
-> Map Int Fill -> Int -> Maybe Fill
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int Fill -> Maybe Fill
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Fill
fills (Int -> Maybe Fill) -> Maybe Int -> Maybe Fill
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                (CellXf -> Maybe Bool)
-> (CellXf -> Maybe Int) -> CellXf -> Maybe Int
forall a.
(CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
_cellXfApplyFill CellXf -> Maybe Int
_cellXfFillId CellXf
cellXf
        , _formatFont :: Maybe Font
_formatFont         = (Int -> Map Int Font -> Maybe Font)
-> Map Int Font -> Int -> Maybe Font
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int Font -> Maybe Font
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Font
fonts (Int -> Maybe Font) -> Maybe Int -> Maybe Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                (CellXf -> Maybe Bool)
-> (CellXf -> Maybe Int) -> CellXf -> Maybe Int
forall a.
(CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
_cellXfApplyFont CellXf -> Maybe Int
_cellXfFontId CellXf
cellXf
        , _formatNumberFormat :: Maybe NumberFormat
_formatNumberFormat = Int -> Maybe NumberFormat
lookupNumFmt (Int -> Maybe NumberFormat) -> Maybe Int -> Maybe NumberFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                (CellXf -> Maybe Bool)
-> (CellXf -> Maybe Int) -> CellXf -> Maybe Int
forall a.
(CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
_cellXfApplyNumberFormat CellXf -> Maybe Int
_cellXfNumFmtId CellXf
cellXf
        , _formatProtection :: Maybe Protection
_formatProtection   = CellXf -> Maybe Protection
_cellXfProtection  CellXf
cellXf
        , _formatPivotButton :: Maybe Bool
_formatPivotButton  = CellXf -> Maybe Bool
_cellXfPivotButton CellXf
cellXf
        , _formatQuotePrefix :: Maybe Bool
_formatQuotePrefix  = CellXf -> Maybe Bool
_cellXfQuotePrefix CellXf
cellXf }
    idMapped :: [a] -> Map Int a
    idMapped :: [a] -> Map Int a
idMapped = [(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, a)] -> Map Int a)
-> ([a] -> [(Int, a)]) -> [a] -> Map Int a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
    cellXfs :: Map Int CellXf
cellXfs = [CellXf] -> Map Int CellXf
forall a. [a] -> Map Int a
idMapped [CellXf]
_styleSheetCellXfs
    borders :: Map Int Border
borders = [Border] -> Map Int Border
forall a. [a] -> Map Int a
idMapped [Border]
_styleSheetBorders
    fills :: Map Int Fill
fills = [Fill] -> Map Int Fill
forall a. [a] -> Map Int a
idMapped [Fill]
_styleSheetFills
    fonts :: Map Int Font
fonts = [Font] -> Map Int Font
forall a. [a] -> Map Int a
idMapped [Font]
_styleSheetFonts
    lookupNumFmt :: Int -> Maybe NumberFormat
lookupNumFmt Int
fId = [Maybe NumberFormat] -> Maybe NumberFormat
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ ImpliedNumberFormat -> NumberFormat
StdNumberFormat (ImpliedNumberFormat -> NumberFormat)
-> Maybe ImpliedNumberFormat -> Maybe NumberFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe ImpliedNumberFormat
idToStdNumberFormat Int
fId
        , Text -> NumberFormat
UserNumberFormat (Text -> NumberFormat) -> Maybe Text -> Maybe NumberFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Map Int Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
fId Map Int Text
_styleSheetNumFmts]
    applied :: (CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
    applied :: (CellXf -> Maybe Bool) -> (CellXf -> Maybe a) -> CellXf -> Maybe a
applied CellXf -> Maybe Bool
applyProp CellXf -> Maybe a
prop CellXf
cXf = do
        Bool
apply <- CellXf -> Maybe Bool
applyProp CellXf
cXf
        if Bool
apply then CellXf -> Maybe a
prop CellXf
cXf else String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not applied"
    applyMerges :: Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell
applyMerges Map (Int, Int) FormattedCell
cells = (Map (Int, Int) FormattedCell
 -> Range -> Map (Int, Int) FormattedCell)
-> Map (Int, Int) FormattedCell
-> [Range]
-> Map (Int, Int) FormattedCell
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map (Int, Int) FormattedCell
-> Range -> Map (Int, Int) FormattedCell
onlyTopLeft Map (Int, Int) FormattedCell
cells [Range]
merges
    onlyTopLeft :: Map (Int, Int) FormattedCell
-> Range -> Map (Int, Int) FormattedCell
onlyTopLeft Map (Int, Int) FormattedCell
cells Range
range = (State (Map (Int, Int) FormattedCell) ()
 -> Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell)
-> Map (Int, Int) FormattedCell
-> State (Map (Int, Int) FormattedCell) ()
-> Map (Int, Int) FormattedCell
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map (Int, Int) FormattedCell) ()
-> Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell
forall s a. State s a -> s -> s
execState Map (Int, Int) FormattedCell
cells (State (Map (Int, Int) FormattedCell) ()
 -> Map (Int, Int) FormattedCell)
-> State (Map (Int, Int) FormattedCell) ()
-> Map (Int, Int) FormattedCell
forall a b. (a -> b) -> a -> b
$ do
        let ((Int
r1, Int
c1), (Int
r2, Int
c2)) = String
-> Maybe ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int))
forall a. Partial => String -> Maybe a -> a
fromJustNote String
"fromRange" (Maybe ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int)))
-> Maybe ((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int))
forall a b. (a -> b) -> a -> b
$ Range -> Maybe ((Int, Int), (Int, Int))
fromRange Range
range
            nonTopLeft :: [(Int, Int)]
nonTopLeft = [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
tail [(Int
r, Int
c) | Int
r<-[Int
r1..Int
r2], Int
c<-[Int
c1..Int
c2]]
        [(Int, Int)]
-> ((Int, Int) -> State (Map (Int, Int) FormattedCell) ())
-> State (Map (Int, Int) FormattedCell) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Int)]
nonTopLeft ((Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell)
-> State (Map (Int, Int) FormattedCell) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell)
 -> State (Map (Int, Int) FormattedCell) ())
-> ((Int, Int)
    -> Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell)
-> (Int, Int)
-> State (Map (Int, Int) FormattedCell) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int)
-> Map (Int, Int) FormattedCell -> Map (Int, Int) FormattedCell
forall k a. Ord k => k -> Map k a -> Map k a
M.delete)
        Index (Map (Int, Int) FormattedCell)
-> Lens'
     (Map (Int, Int) FormattedCell)
     (Maybe (IxValue (Map (Int, Int) FormattedCell)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Int
r1, Int
c1) ((Maybe FormattedCell -> Identity (Maybe FormattedCell))
 -> Map (Int, Int) FormattedCell
 -> Identity (Map (Int, Int) FormattedCell))
-> ((Int -> Identity Int)
    -> Maybe FormattedCell -> Identity (Maybe FormattedCell))
-> (Int -> Identity Int)
-> Map (Int, Int) FormattedCell
-> Identity (Map (Int, Int) FormattedCell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedCell -> Iso' (Maybe FormattedCell) FormattedCell
forall a. Eq a => a -> Iso' (Maybe a) a
non FormattedCell
forall a. Default a => a
def ((FormattedCell -> Identity FormattedCell)
 -> Maybe FormattedCell -> Identity (Maybe FormattedCell))
-> ((Int -> Identity Int)
    -> FormattedCell -> Identity FormattedCell)
-> (Int -> Identity Int)
-> Maybe FormattedCell
-> Identity (Maybe FormattedCell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> FormattedCell -> Identity FormattedCell
Lens' FormattedCell Int
formattedRowSpan ((Int -> Identity Int)
 -> Map (Int, Int) FormattedCell
 -> Identity (Map (Int, Int) FormattedCell))
-> Int -> State (Map (Int, Int) FormattedCell) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Index (Map (Int, Int) FormattedCell)
-> Lens'
     (Map (Int, Int) FormattedCell)
     (Maybe (IxValue (Map (Int, Int) FormattedCell)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Int
r1, Int
c1) ((Maybe FormattedCell -> Identity (Maybe FormattedCell))
 -> Map (Int, Int) FormattedCell
 -> Identity (Map (Int, Int) FormattedCell))
-> ((Int -> Identity Int)
    -> Maybe FormattedCell -> Identity (Maybe FormattedCell))
-> (Int -> Identity Int)
-> Map (Int, Int) FormattedCell
-> Identity (Map (Int, Int) FormattedCell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedCell -> Iso' (Maybe FormattedCell) FormattedCell
forall a. Eq a => a -> Iso' (Maybe a) a
non FormattedCell
forall a. Default a => a
def ((FormattedCell -> Identity FormattedCell)
 -> Maybe FormattedCell -> Identity (Maybe FormattedCell))
-> ((Int -> Identity Int)
    -> FormattedCell -> Identity FormattedCell)
-> (Int -> Identity Int)
-> Maybe FormattedCell
-> Identity (Maybe FormattedCell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> FormattedCell -> Identity FormattedCell
Lens' FormattedCell Int
formattedColSpan ((Int -> Identity Int)
 -> Map (Int, Int) FormattedCell
 -> Identity (Map (Int, Int) FormattedCell))
-> Int -> State (Map (Int, Int) FormattedCell) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

data CondFormatted = CondFormatted {
    -- | The resulting stylesheet
    CondFormatted -> StyleSheet
condformattedStyleSheet    :: StyleSheet
    -- | The final map of conditional formatting rules applied to ranges
    , CondFormatted -> Map SqRef ConditionalFormatting
condformattedFormattings :: Map SqRef ConditionalFormatting
    } deriving (CondFormatted -> CondFormatted -> Bool
(CondFormatted -> CondFormatted -> Bool)
-> (CondFormatted -> CondFormatted -> Bool) -> Eq CondFormatted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CondFormatted -> CondFormatted -> Bool
$c/= :: CondFormatted -> CondFormatted -> Bool
== :: CondFormatted -> CondFormatted -> Bool
$c== :: CondFormatted -> CondFormatted -> Bool
Eq, Int -> CondFormatted -> ShowS
[CondFormatted] -> ShowS
CondFormatted -> String
(Int -> CondFormatted -> ShowS)
-> (CondFormatted -> String)
-> ([CondFormatted] -> ShowS)
-> Show CondFormatted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CondFormatted] -> ShowS
$cshowList :: [CondFormatted] -> ShowS
show :: CondFormatted -> String
$cshow :: CondFormatted -> String
showsPrec :: Int -> CondFormatted -> ShowS
$cshowsPrec :: Int -> CondFormatted -> ShowS
Show, (forall x. CondFormatted -> Rep CondFormatted x)
-> (forall x. Rep CondFormatted x -> CondFormatted)
-> Generic CondFormatted
forall x. Rep CondFormatted x -> CondFormatted
forall x. CondFormatted -> Rep CondFormatted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CondFormatted x -> CondFormatted
$cfrom :: forall x. CondFormatted -> Rep CondFormatted x
Generic)

conditionallyFormatted :: Map CellRef [FormattedCondFmt] -> StyleSheet -> CondFormatted
conditionallyFormatted :: Map Range [FormattedCondFmt] -> StyleSheet -> CondFormatted
conditionallyFormatted Map Range [FormattedCondFmt]
cfs StyleSheet
styleSheet = CondFormatted :: StyleSheet -> Map SqRef ConditionalFormatting -> CondFormatted
CondFormatted
    { condformattedStyleSheet :: StyleSheet
condformattedStyleSheet  = StyleSheet
styleSheet StyleSheet -> (StyleSheet -> StyleSheet) -> StyleSheet
forall a b. a -> (a -> b) -> b
& ([Dxf] -> Identity [Dxf]) -> StyleSheet -> Identity StyleSheet
Lens' StyleSheet [Dxf]
styleSheetDxfs (([Dxf] -> Identity [Dxf]) -> StyleSheet -> Identity StyleSheet)
-> [Dxf] -> StyleSheet -> StyleSheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Dxf]
finalDxfs
    , condformattedFormattings :: Map SqRef ConditionalFormatting
condformattedFormattings = Map SqRef ConditionalFormatting
fmts
    }
  where
    (Map Range ConditionalFormatting
cellFmts, Map Dxf Int
dxf2id) = State (Map Dxf Int) (Map Range ConditionalFormatting)
-> Map Dxf Int -> (Map Range ConditionalFormatting, Map Dxf Int)
forall s a. State s a -> s -> (a, s)
runState (([FormattedCondFmt]
 -> StateT (Map Dxf Int) Identity ConditionalFormatting)
-> Map Range [FormattedCondFmt]
-> State (Map Dxf Int) (Map Range ConditionalFormatting)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FormattedCondFmt -> StateT (Map Dxf Int) Identity CfRule)
-> [FormattedCondFmt]
-> StateT (Map Dxf Int) Identity ConditionalFormatting
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FormattedCondFmt -> StateT (Map Dxf Int) Identity CfRule
mapDxf) Map Range [FormattedCondFmt]
cfs) Map Dxf Int
dxf2id0
    dxf2id0 :: Map Dxf Int
dxf2id0 = [Dxf] -> Map Dxf Int
forall a. Ord a => [a] -> Map a Int
fromValueList (StyleSheet
styleSheet StyleSheet -> Getting [Dxf] StyleSheet [Dxf] -> [Dxf]
forall s a. s -> Getting a s a -> a
^. Getting [Dxf] StyleSheet [Dxf]
Lens' StyleSheet [Dxf]
styleSheetDxfs)
    fmts :: Map SqRef ConditionalFormatting
fmts = [(SqRef, ConditionalFormatting)] -> Map SqRef ConditionalFormatting
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SqRef, ConditionalFormatting)]
 -> Map SqRef ConditionalFormatting)
-> ([(Range, ConditionalFormatting)]
    -> [(SqRef, ConditionalFormatting)])
-> [(Range, ConditionalFormatting)]
-> Map SqRef ConditionalFormatting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Range, ConditionalFormatting)]
 -> (SqRef, ConditionalFormatting))
-> [[(Range, ConditionalFormatting)]]
-> [(SqRef, ConditionalFormatting)]
forall a b. (a -> b) -> [a] -> [b]
map [(Range, ConditionalFormatting)] -> (SqRef, ConditionalFormatting)
forall b. [(Range, b)] -> (SqRef, b)
mergeSqRef ([[(Range, ConditionalFormatting)]]
 -> [(SqRef, ConditionalFormatting)])
-> ([(Range, ConditionalFormatting)]
    -> [[(Range, ConditionalFormatting)]])
-> [(Range, ConditionalFormatting)]
-> [(SqRef, ConditionalFormatting)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Range, ConditionalFormatting)
 -> (Range, ConditionalFormatting) -> Bool)
-> [(Range, ConditionalFormatting)]
-> [[(Range, ConditionalFormatting)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (ConditionalFormatting -> ConditionalFormatting -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ConditionalFormatting -> ConditionalFormatting -> Bool)
-> ((Range, ConditionalFormatting) -> ConditionalFormatting)
-> (Range, ConditionalFormatting)
-> (Range, ConditionalFormatting)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Range, ConditionalFormatting) -> ConditionalFormatting
forall a b. (a, b) -> b
snd) ([(Range, ConditionalFormatting)]
 -> [[(Range, ConditionalFormatting)]])
-> ([(Range, ConditionalFormatting)]
    -> [(Range, ConditionalFormatting)])
-> [(Range, ConditionalFormatting)]
-> [[(Range, ConditionalFormatting)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           ((Range, ConditionalFormatting)
 -> (Range, ConditionalFormatting) -> Ordering)
-> [(Range, ConditionalFormatting)]
-> [(Range, ConditionalFormatting)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Range, ConditionalFormatting) -> ConditionalFormatting)
-> (Range, ConditionalFormatting)
-> (Range, ConditionalFormatting)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Range, ConditionalFormatting) -> ConditionalFormatting
forall a b. (a, b) -> b
snd) ([(Range, ConditionalFormatting)]
 -> Map SqRef ConditionalFormatting)
-> [(Range, ConditionalFormatting)]
-> Map SqRef ConditionalFormatting
forall a b. (a -> b) -> a -> b
$ Map Range ConditionalFormatting -> [(Range, ConditionalFormatting)]
forall k a. Map k a -> [(k, a)]
M.toList Map Range ConditionalFormatting
cellFmts
    mergeSqRef :: [(Range, b)] -> (SqRef, b)
mergeSqRef [(Range, b)]
cellRefs2fmt =
        ([Range] -> SqRef
SqRef (((Range, b) -> Range) -> [(Range, b)] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map (Range, b) -> Range
forall a b. (a, b) -> a
fst [(Range, b)]
cellRefs2fmt),
         String -> [b] -> b
forall a. Partial => String -> [a] -> a
headNote String
"fmt group should not be empty" (((Range, b) -> b) -> [(Range, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Range, b) -> b
forall a b. (a, b) -> b
snd [(Range, b)]
cellRefs2fmt))
    finalDxfs :: [Dxf]
finalDxfs = Map Dxf Int -> [Dxf]
forall a. Map a Int -> [a]
toValueList Map Dxf Int
dxf2id

{-------------------------------------------------------------------------------
  Implementation details
-------------------------------------------------------------------------------}

-- | Format a cell with (potentially) rowspan or colspan
formatCell :: (Int, Int) -> FormattedCell -> State FormattingState [((Int, Int), Cell)]
formatCell :: (Int, Int)
-> FormattedCell
-> StateT FormattingState Identity [((Int, Int), Cell)]
formatCell (Int
row, Int
col) FormattedCell
cell = do
    let ([((Int, Int), FormattedCell)]
block, Maybe Range
mMerge) = (Int, Int)
-> FormattedCell -> ([((Int, Int), FormattedCell)], Maybe Range)
cellBlock (Int
row, Int
col) FormattedCell
cell
    Maybe Range
-> (Range -> StateT FormattingState Identity ())
-> StateT FormattingState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Range
mMerge ((Range -> StateT FormattingState Identity ())
 -> StateT FormattingState Identity ())
-> (Range -> StateT FormattingState Identity ())
-> StateT FormattingState Identity ()
forall a b. (a -> b) -> a -> b
$ \Range
merge -> ([Range] -> Identity [Range])
-> FormattingState -> Identity FormattingState
Lens' FormattingState [Range]
formattingMerges (([Range] -> Identity [Range])
 -> FormattingState -> Identity FormattingState)
-> ([Range] -> [Range]) -> StateT FormattingState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (:) Range
merge
    (((Int, Int), FormattedCell)
 -> StateT FormattingState Identity ((Int, Int), Cell))
-> [((Int, Int), FormattedCell)]
-> StateT FormattingState Identity [((Int, Int), Cell)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int, Int), FormattedCell)
-> StateT FormattingState Identity ((Int, Int), Cell)
go [((Int, Int), FormattedCell)]
block
  where
    go :: ((Int, Int), FormattedCell) -> State FormattingState ((Int, Int), Cell)
    go :: ((Int, Int), FormattedCell)
-> StateT FormattingState Identity ((Int, Int), Cell)
go ((Int, Int)
pos, c :: FormattedCell
c@FormattedCell{Int
Cell
Format
_formattedRowSpan :: Int
_formattedColSpan :: Int
_formattedFormat :: Format
_formattedCell :: Cell
_formattedRowSpan :: FormattedCell -> Int
_formattedColSpan :: FormattedCell -> Int
_formattedFormat :: FormattedCell -> Format
_formattedCell :: FormattedCell -> Cell
..}) = do
      Maybe Int
styleId <- FormattedCell -> State FormattingState (Maybe Int)
cellStyleId FormattedCell
c
      ((Int, Int), Cell)
-> StateT FormattingState Identity ((Int, Int), Cell)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int)
pos, Cell
_formattedCell{_cellStyle :: Maybe Int
_cellStyle = Maybe Int
styleId})

-- | Cell block corresponding to a single 'FormattedCell'
--
-- A single 'FormattedCell' might have a colspan or rowspan greater than 1.
-- Although Excel obviously supports cell merges, it does not correctly apply
-- borders to the cells covered by the rowspan or colspan. Therefore we create
-- a block of cells in this function; the top-left is the cell proper, and the
-- remaining cells are the cells covered by the rowspan/colspan.
--
-- Also returns the cell merge instruction, if any.
cellBlock :: (Int, Int) -> FormattedCell
          -> ([((Int, Int), FormattedCell)], Maybe Range)
cellBlock :: (Int, Int)
-> FormattedCell -> ([((Int, Int), FormattedCell)], Maybe Range)
cellBlock (Int
row, Int
col) cell :: FormattedCell
cell@FormattedCell{Int
Cell
Format
_formattedRowSpan :: Int
_formattedColSpan :: Int
_formattedFormat :: Format
_formattedCell :: Cell
_formattedRowSpan :: FormattedCell -> Int
_formattedColSpan :: FormattedCell -> Int
_formattedFormat :: FormattedCell -> Format
_formattedCell :: FormattedCell -> Cell
..} = ([((Int, Int), FormattedCell)]
block, Maybe Range
merge)
  where
    block :: [((Int, Int), FormattedCell)]
    block :: [((Int, Int), FormattedCell)]
block = [ ((Int
row', Int
col'), (Int, Int) -> FormattedCell
cellAt (Int
row', Int
col'))
            | Int
row' <- [Int
topRow  .. Int
bottomRow]
            , Int
col' <- [Int
leftCol .. Int
rightCol]
            ]

    merge :: Maybe Range
    merge :: Maybe Range
merge = do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
topRow Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bottomRow Bool -> Bool -> Bool
|| Int
leftCol Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rightCol)
               Range -> Maybe Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int) -> Range
mkRange (Int
topRow, Int
leftCol) (Int
bottomRow, Int
rightCol)

    cellAt :: (Int, Int) -> FormattedCell
    cellAt :: (Int, Int) -> FormattedCell
cellAt (Int
row', Int
col') =
      if Int
row' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
row Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
col'
        then FormattedCell
cell
        else FormattedCell
forall a. Default a => a
def FormattedCell -> (FormattedCell -> FormattedCell) -> FormattedCell
forall a b. a -> (a -> b) -> b
& (Format -> Identity Format)
-> FormattedCell -> Identity FormattedCell
Lens' FormattedCell Format
formattedFormat ((Format -> Identity Format)
 -> FormattedCell -> Identity FormattedCell)
-> ((Maybe Border -> Identity (Maybe Border))
    -> Format -> Identity Format)
-> (Maybe Border -> Identity (Maybe Border))
-> FormattedCell
-> Identity FormattedCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Border -> Identity (Maybe Border))
-> Format -> Identity Format
Lens' Format (Maybe Border)
formatBorder ((Maybe Border -> Identity (Maybe Border))
 -> FormattedCell -> Identity FormattedCell)
-> Border -> FormattedCell -> FormattedCell
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Int, Int) -> Border
borderAt (Int
row', Int
col')

    border :: Maybe Border
border = Format -> Maybe Border
_formatBorder Format
_formattedFormat

    borderAt :: (Int, Int) -> Border
    borderAt :: (Int, Int) -> Border
borderAt (Int
row', Int
col') = Border
forall a. Default a => a
def
      Border -> (Border -> Border) -> Border
forall a b. a -> (a -> b) -> b
& (Maybe BorderStyle -> Identity (Maybe BorderStyle))
-> Border -> Identity Border
Lens' Border (Maybe BorderStyle)
borderTop    ((Maybe BorderStyle -> Identity (Maybe BorderStyle))
 -> Border -> Identity Border)
-> Maybe BorderStyle -> Border -> Border
forall s t a b. ASetter s t a b -> b -> s -> t
.~ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
row' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
topRow)    ; Border -> Maybe BorderStyle
_borderTop    (Border -> Maybe BorderStyle) -> Maybe Border -> Maybe BorderStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Border
border
      Border -> (Border -> Border) -> Border
forall a b. a -> (a -> b) -> b
& (Maybe BorderStyle -> Identity (Maybe BorderStyle))
-> Border -> Identity Border
Lens' Border (Maybe BorderStyle)
borderBottom ((Maybe BorderStyle -> Identity (Maybe BorderStyle))
 -> Border -> Identity Border)
-> Maybe BorderStyle -> Border -> Border
forall s t a b. ASetter s t a b -> b -> s -> t
.~ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
row' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bottomRow) ; Border -> Maybe BorderStyle
_borderBottom (Border -> Maybe BorderStyle) -> Maybe Border -> Maybe BorderStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Border
border
      Border -> (Border -> Border) -> Border
forall a b. a -> (a -> b) -> b
& (Maybe BorderStyle -> Identity (Maybe BorderStyle))
-> Border -> Identity Border
Lens' Border (Maybe BorderStyle)
borderLeft   ((Maybe BorderStyle -> Identity (Maybe BorderStyle))
 -> Border -> Identity Border)
-> Maybe BorderStyle -> Border -> Border
forall s t a b. ASetter s t a b -> b -> s -> t
.~ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
leftCol)   ; Border -> Maybe BorderStyle
_borderLeft   (Border -> Maybe BorderStyle) -> Maybe Border -> Maybe BorderStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Border
border
      Border -> (Border -> Border) -> Border
forall a b. a -> (a -> b) -> b
& (Maybe BorderStyle -> Identity (Maybe BorderStyle))
-> Border -> Identity Border
Lens' Border (Maybe BorderStyle)
borderRight  ((Maybe BorderStyle -> Identity (Maybe BorderStyle))
 -> Border -> Identity Border)
-> Maybe BorderStyle -> Border -> Border
forall s t a b. ASetter s t a b -> b -> s -> t
.~ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rightCol)  ; Border -> Maybe BorderStyle
_borderRight  (Border -> Maybe BorderStyle) -> Maybe Border -> Maybe BorderStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Border
border

    topRow, bottomRow, leftCol, rightCol :: Int
    topRow :: Int
topRow    = Int
row
    bottomRow :: Int
bottomRow = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
_formattedRowSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    leftCol :: Int
leftCol   = Int
col
    rightCol :: Int
rightCol  = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
_formattedColSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

cellStyleId :: FormattedCell -> State FormattingState (Maybe Int)
cellStyleId :: FormattedCell -> State FormattingState (Maybe Int)
cellStyleId FormattedCell
c = (CellXf -> State FormattingState Int)
-> Maybe CellXf -> State FormattingState (Maybe Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Lens' FormattingState (Map CellXf Int)
-> CellXf -> State FormattingState Int
forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map CellXf Int)
formattingCellXfs) (Maybe CellXf -> State FormattingState (Maybe Int))
-> StateT FormattingState Identity (Maybe CellXf)
-> State FormattingState (Maybe Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormattedCell -> StateT FormattingState Identity (Maybe CellXf)
constructCellXf FormattedCell
c

constructCellXf :: FormattedCell -> State FormattingState (Maybe CellXf)
constructCellXf :: FormattedCell -> StateT FormattingState Identity (Maybe CellXf)
constructCellXf FormattedCell{_formattedFormat :: FormattedCell -> Format
_formattedFormat=Format{Maybe Bool
Maybe Protection
Maybe NumberFormat
Maybe Font
Maybe Fill
Maybe Border
Maybe Alignment
_formatQuotePrefix :: Maybe Bool
_formatPivotButton :: Maybe Bool
_formatProtection :: Maybe Protection
_formatNumberFormat :: Maybe NumberFormat
_formatFont :: Maybe Font
_formatFill :: Maybe Fill
_formatBorder :: Maybe Border
_formatAlignment :: Maybe Alignment
_formatQuotePrefix :: Format -> Maybe Bool
_formatPivotButton :: Format -> Maybe Bool
_formatProtection :: Format -> Maybe Protection
_formatNumberFormat :: Format -> Maybe NumberFormat
_formatFont :: Format -> Maybe Font
_formatFill :: Format -> Maybe Fill
_formatBorder :: Format -> Maybe Border
_formatAlignment :: Format -> Maybe Alignment
..}} = do
    Maybe Int
mBorderId <- Lens' FormattingState (Map Border Int)
-> Border -> State FormattingState Int
forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Border Int)
formattingBorders (Border -> State FormattingState Int)
-> Maybe Border -> State FormattingState (Maybe Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe Border
_formatBorder
    Maybe Int
mFillId   <- Lens' FormattingState (Map Fill Int)
-> Fill -> State FormattingState Int
forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Fill Int)
formattingFills   (Fill -> State FormattingState Int)
-> Maybe Fill -> State FormattingState (Maybe Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe Fill
_formatFill
    Maybe Int
mFontId   <- Lens' FormattingState (Map Font Int)
-> Font -> State FormattingState Int
forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Font Int)
formattingFonts   (Font -> State FormattingState Int)
-> Maybe Font -> State FormattingState (Maybe Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe Font
_formatFont
    let getFmtId :: Lens' FormattingState (Map Text Int) -> NumberFormat -> State FormattingState Int
        getFmtId :: Lens' FormattingState (Map Text Int)
-> NumberFormat -> State FormattingState Int
getFmtId Lens' FormattingState (Map Text Int)
_ (StdNumberFormat  ImpliedNumberFormat
fmt) = Int -> State FormattingState Int
forall (m :: * -> *) a. Monad m => a -> m a
return (ImpliedNumberFormat -> Int
stdNumberFormatId ImpliedNumberFormat
fmt)
        getFmtId Lens' FormattingState (Map Text Int)
l (UserNumberFormat Text
fmt) = Int
-> Lens' FormattingState (Map Text Int)
-> Text
-> State FormattingState Int
forall a.
Ord a =>
Int
-> Lens' FormattingState (Map a Int)
-> a
-> State FormattingState Int
getId' Int
firstUserNumFmtId Lens' FormattingState (Map Text Int)
l Text
fmt
    Maybe Int
mNumFmtId <- Lens' FormattingState (Map Text Int)
-> NumberFormat -> State FormattingState Int
getFmtId Lens' FormattingState (Map Text Int)
formattingNumFmts (NumberFormat -> State FormattingState Int)
-> Maybe NumberFormat -> State FormattingState (Maybe Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe NumberFormat
_formatNumberFormat
    let xf :: CellXf
xf = CellXf :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Alignment
-> Maybe Protection
-> CellXf
CellXf {
            _cellXfApplyAlignment :: Maybe Bool
_cellXfApplyAlignment    = Maybe Alignment -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe Alignment
_formatAlignment
          , _cellXfApplyBorder :: Maybe Bool
_cellXfApplyBorder       = Maybe Int -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe Int
mBorderId
          , _cellXfApplyFill :: Maybe Bool
_cellXfApplyFill         = Maybe Int -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe Int
mFillId
          , _cellXfApplyFont :: Maybe Bool
_cellXfApplyFont         = Maybe Int -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe Int
mFontId
          , _cellXfApplyNumberFormat :: Maybe Bool
_cellXfApplyNumberFormat = Maybe NumberFormat -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe NumberFormat
_formatNumberFormat
          , _cellXfApplyProtection :: Maybe Bool
_cellXfApplyProtection   = Maybe Protection -> Maybe Bool
forall a. Maybe a -> Maybe Bool
apply Maybe Protection
_formatProtection
          , _cellXfBorderId :: Maybe Int
_cellXfBorderId          = Maybe Int
mBorderId
          , _cellXfFillId :: Maybe Int
_cellXfFillId            = Maybe Int
mFillId
          , _cellXfFontId :: Maybe Int
_cellXfFontId            = Maybe Int
mFontId
          , _cellXfNumFmtId :: Maybe Int
_cellXfNumFmtId          = Maybe Int
mNumFmtId
          , _cellXfPivotButton :: Maybe Bool
_cellXfPivotButton       = Maybe Bool
_formatPivotButton
          , _cellXfQuotePrefix :: Maybe Bool
_cellXfQuotePrefix       = Maybe Bool
_formatQuotePrefix
          , _cellXfId :: Maybe Int
_cellXfId                = Maybe Int
forall a. Maybe a
Nothing -- TODO
          , _cellXfAlignment :: Maybe Alignment
_cellXfAlignment         = Maybe Alignment
_formatAlignment
          , _cellXfProtection :: Maybe Protection
_cellXfProtection        = Maybe Protection
_formatProtection
          }
    Maybe CellXf -> StateT FormattingState Identity (Maybe CellXf)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CellXf -> StateT FormattingState Identity (Maybe CellXf))
-> Maybe CellXf -> StateT FormattingState Identity (Maybe CellXf)
forall a b. (a -> b) -> a -> b
$ if CellXf
xf CellXf -> CellXf -> Bool
forall a. Eq a => a -> a -> Bool
== CellXf
forall a. Default a => a
def then Maybe CellXf
forall a. Maybe a
Nothing else CellXf -> Maybe CellXf
forall a. a -> Maybe a
Just CellXf
xf
  where
    -- If we have formatting instructions, we want to set the corresponding
    -- applyXXX properties
    apply :: Maybe a -> Maybe Bool
    apply :: Maybe a -> Maybe Bool
apply Maybe a
Nothing  = Maybe Bool
forall a. Maybe a
Nothing
    apply (Just a
_) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True

mapDxf :: FormattedCondFmt -> State (Map Dxf Int) CfRule
mapDxf :: FormattedCondFmt -> StateT (Map Dxf Int) Identity CfRule
mapDxf FormattedCondFmt{Int
Maybe Bool
Dxf
Condition
_condfmtStopIfTrue :: Maybe Bool
_condfmtPriority :: Int
_condfmtDxf :: Dxf
_condfmtCondition :: Condition
_condfmtStopIfTrue :: FormattedCondFmt -> Maybe Bool
_condfmtPriority :: FormattedCondFmt -> Int
_condfmtDxf :: FormattedCondFmt -> Dxf
_condfmtCondition :: FormattedCondFmt -> Condition
..} = do
    Map Dxf Int
dxf2id <- StateT (Map Dxf Int) Identity (Map Dxf Int)
forall s (m :: * -> *). MonadState s m => m s
get
    Int
dxfId <- case Dxf -> Map Dxf Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Dxf
_condfmtDxf Map Dxf Int
dxf2id of
                 Just Int
i ->
                     Int -> StateT (Map Dxf Int) Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
                 Maybe Int
Nothing -> do
                     let newId :: Int
newId = Map Dxf Int -> Int
forall k a. Map k a -> Int
M.size Map Dxf Int
dxf2id
                     (Map Dxf Int -> Map Dxf Int) -> StateT (Map Dxf Int) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Dxf Int -> Map Dxf Int) -> StateT (Map Dxf Int) Identity ())
-> (Map Dxf Int -> Map Dxf Int) -> StateT (Map Dxf Int) Identity ()
forall a b. (a -> b) -> a -> b
$ Dxf -> Int -> Map Dxf Int -> Map Dxf Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Dxf
_condfmtDxf Int
newId
                     Int -> StateT (Map Dxf Int) Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
newId
    CfRule -> StateT (Map Dxf Int) Identity CfRule
forall (m :: * -> *) a. Monad m => a -> m a
return CfRule :: Condition -> Maybe Int -> Int -> Maybe Bool -> CfRule
CfRule
        { _cfrCondition :: Condition
_cfrCondition  = Condition
_condfmtCondition
        , _cfrDxfId :: Maybe Int
_cfrDxfId      = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dxfId
        , _cfrPriority :: Int
_cfrPriority   = Int
_condfmtPriority
        , _cfrStopIfTrue :: Maybe Bool
_cfrStopIfTrue = Maybe Bool
_condfmtStopIfTrue
        }