{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Formatted
( FormattedCell(..)
, Formatted(..)
, Format(..)
, formatted
, formatWorkbook
, toFormattedCells
, CondFormatted(..)
, conditionallyFormatted
, formatAlignment
, formatBorder
, formatFill
, formatFont
, formatNumberFormat
, formatProtection
, formatPivotButton
, formatQuotePrefix
, formattedCell
, formattedFormat
, formattedColSpan
, formattedRowSpan
, 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
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]
}
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
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
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
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
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
data Formatted = Formatted {
Formatted -> CellMap
formattedCellMap :: CellMap
, Formatted -> StyleSheet
formattedStyleSheet :: StyleSheet
, 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)
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)
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 }
, _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 {
CondFormatted -> StyleSheet
condformattedStyleSheet :: StyleSheet
, 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
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})
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
, _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
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
}