-- | 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{
      _formattingBorders :: Map Border Int
_formattingBorders = forall a. Ord a => [a] -> Map a Int
fromValueList [Border]
_styleSheetBorders
    , _formattingCellXfs :: Map CellXf Int
_formattingCellXfs = forall a. Ord a => [a] -> Map a Int
fromValueList [CellXf]
_styleSheetCellXfs
    , _formattingFills :: Map Fill Int
_formattingFills   = forall a. Ord a => [a] -> Map a Int
fromValueList [Fill]
_styleSheetFills
    , _formattingFonts :: Map Font Int
_formattingFonts   = forall a. Ord a => [a] -> Map a Int
fromValueList [Font]
_styleSheetFonts
    , _formattingNumFmts :: Map Text Int
_formattingNumFmts = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Ord a => [a] -> Map a Int
fromValueList = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0..])

toValueList :: Map a Int -> [a]
toValueList :: forall a. Map a Int -> [a]
toValueList = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Map a Int -> [a]
toValueList Map Border Int
_formattingBorders
    , _styleSheetCellXfs :: [CellXf]
_styleSheetCellXfs = forall a. Map a Int -> [a]
toValueList Map CellXf Int
_formattingCellXfs
    , _styleSheetFills :: [Fill]
_styleSheetFills   = forall a. Map a Int -> [a]
toValueList Map Fill Int
_formattingFills
    , _styleSheetFonts :: [Font]
_styleSheetFonts   = forall a. Map a Int -> [a]
toValueList Map Font Int
_formattingFonts
    , _styleSheetNumFmts :: Map Int Text
_styleSheetNumFmts = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ 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 :: forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId = 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' :: forall a.
Ord a =>
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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' FormattingState (Map a Int)
f
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a Int
aMap of
      Just Int
anId -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
anId
      Maybe Int
Nothing  -> do let anId :: Int
anId = Int
k forall a. Num a => a -> a -> a
+ forall k a. Map k a -> Int
M.size Map a Int
aMap
                     Lens' FormattingState (Map a Int)
f forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
anId
                     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
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
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. 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
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
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. 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
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
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. 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
        { _formattedCell :: Cell
_formattedCell    = forall a. Default a => a
def
        , _formattedFormat :: Format
_formattedFormat  = forall a. Default a => a
def
        , _formattedColSpan :: Int
_formattedColSpan = Int
1
        , _formattedRowSpan :: Int
_formattedRowSpan = Int
1
        }

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

instance Default FormattedCondFmt where
  def :: FormattedCondFmt
def = Condition -> Dxf -> Int -> Maybe Bool -> FormattedCondFmt
FormattedCondFmt Condition
ContainsBlanks forall a. Default a => a
def Int
topCfPriority 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
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
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. 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 (RowIndex, ColumnIndex) FormattedCell -> StyleSheet -> Formatted
formatted :: Map (RowIndex, ColumnIndex) FormattedCell
-> StyleSheet -> Formatted
formatted Map (RowIndex, ColumnIndex) FormattedCell
cs StyleSheet
styleSheet =
   let initSt :: FormattingState
initSt         = StyleSheet -> FormattingState
stateFromStyleSheet StyleSheet
styleSheet
       ([[((RowIndex, ColumnIndex), Cell)]]
cs', FormattingState
finalSt) = forall s a. State s a -> s -> (a, s)
runState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (RowIndex, ColumnIndex)
-> FormattedCell
-> State FormattingState [((RowIndex, ColumnIndex), Cell)]
formatCell) (forall k a. Map k a -> [(k, a)]
M.toList Map (RowIndex, ColumnIndex) FormattedCell
cs)) FormattingState
initSt
       styleSheet' :: StyleSheet
styleSheet'    = StyleSheet -> FormattingState -> StyleSheet
updateStyleSheetFromState StyleSheet
styleSheet FormattingState
finalSt
   in Formatted {
          formattedCellMap :: CellMap
formattedCellMap    = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((RowIndex, ColumnIndex), Cell)]]
cs')
        , formattedStyleSheet :: StyleSheet
formattedStyleSheet = StyleSheet
styleSheet'
        , formattedMerges :: [Range]
formattedMerges     = forall a. [a] -> [a]
reverse (FormattingState
finalSt forall s a. s -> Getting a s a -> a
^. Lens' FormattingState [Range]
formattingMerges)
        }

-- | Build an 'Xlsx', render provided cells as per the 'StyleSheet'.
formatWorkbook ::
  [(Text, Map (RowIndex, ColumnIndex) FormattedCell)] -> StyleSheet -> Xlsx
formatWorkbook :: [(Text, Map (RowIndex, ColumnIndex) FormattedCell)]
-> StyleSheet -> Xlsx
formatWorkbook [(Text, Map (RowIndex, ColumnIndex) 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState FormattingState
initSt forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Map (RowIndex, ColumnIndex) FormattedCell)]
nfcss forall a b. (a -> b) -> a -> b
$ \(Text
name, Map (RowIndex, ColumnIndex) FormattedCell
fcs) -> do
        [[((RowIndex, ColumnIndex), Cell)]]
cs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
M.toList Map (RowIndex, ColumnIndex) FormattedCell
fcs) forall a b. (a -> b) -> a -> b
$ \((RowIndex, ColumnIndex)
rc, FormattedCell
fc) -> (RowIndex, ColumnIndex)
-> FormattedCell
-> State FormattingState [((RowIndex, ColumnIndex), Cell)]
formatCell (RowIndex, ColumnIndex)
rc FormattedCell
fc
        [Range]
merges <- forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattingState -> [Range]
_formattingMerges forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
        forall (m :: * -> *) a. Monad m => a -> m a
return ( Text
name
               , forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& Lens' Worksheet CellMap
wsCells  forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((RowIndex, ColumnIndex), Cell)]]
cs')
                     forall a b. a -> (a -> b) -> b
& Lens' Worksheet [Range]
wsMerges 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) =
      forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& Lens' Xlsx [(Text, Worksheet)]
xlSheets forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Worksheet)]
sheets
          forall a b. a -> (a -> b) -> b
& Lens' Xlsx Styles
xlStyles 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 (RowIndex, ColumnIndex) FormattedCell
toFormattedCells :: CellMap
-> [Range]
-> StyleSheet
-> Map (RowIndex, ColumnIndex) 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 (RowIndex, ColumnIndex) FormattedCell
-> Map (RowIndex, ColumnIndex) FormattedCell
applyMerges forall a b. (a -> b) -> a -> b
$ 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
        { _formattedCell :: Cell
_formattedCell    = Cell
cell{ _cellStyle :: Maybe Int
_cellStyle = forall a. Maybe a
Nothing } -- just to remove confusion
        , _formattedFormat :: Format
_formattedFormat  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def CellXf -> Format
formatFromStyle forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int CellXf
cellXfs 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
        { _formatAlignment :: Maybe Alignment
_formatAlignment    = 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       = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Border
borders forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                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         = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Fill
fills forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                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         = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int Font
fonts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                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 :: forall a. [a] -> Map Int a
idMapped = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
    cellXfs :: Map Int CellXf
cellXfs = forall a. [a] -> Map Int a
idMapped [CellXf]
_styleSheetCellXfs
    borders :: Map Int Border
borders = forall a. [a] -> Map Int a
idMapped [Border]
_styleSheetBorders
    fills :: Map Int Fill
fills = forall a. [a] -> Map Int a
idMapped [Fill]
_styleSheetFills
    fonts :: Map Int Font
fonts = forall a. [a] -> Map Int a
idMapped [Font]
_styleSheetFonts
    lookupNumFmt :: Int -> Maybe NumberFormat
lookupNumFmt Int
fId = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ ImpliedNumberFormat -> NumberFormat
StdNumberFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe ImpliedNumberFormat
idToStdNumberFormat Int
fId
        , Text -> NumberFormat
UserNumberFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall a.
(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 forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not applied"
    applyMerges :: Map (RowIndex, ColumnIndex) FormattedCell
-> Map (RowIndex, ColumnIndex) FormattedCell
applyMerges Map (RowIndex, ColumnIndex) FormattedCell
cells = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map (RowIndex, ColumnIndex) FormattedCell
-> Range -> Map (RowIndex, ColumnIndex) FormattedCell
onlyTopLeft Map (RowIndex, ColumnIndex) FormattedCell
cells [Range]
merges
    onlyTopLeft :: Map (RowIndex, ColumnIndex) FormattedCell
-> Range -> Map (RowIndex, ColumnIndex) FormattedCell
onlyTopLeft Map (RowIndex, ColumnIndex) FormattedCell
cells Range
range = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState Map (RowIndex, ColumnIndex) FormattedCell
cells forall a b. (a -> b) -> a -> b
$ do
        let ((RowIndex
r1, ColumnIndex
c1), (RowIndex
r2, ColumnIndex
c2)) =
              forall a. Partial => String -> Maybe a -> a
fromJustNote String
"fromRange" forall a b. (a -> b) -> a -> b
$ Range -> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex))
fromRange Range
range
            nonTopLeft :: [(RowIndex, ColumnIndex)]
nonTopLeft = forall a. [a] -> [a]
tail [(RowIndex
r, ColumnIndex
c) | RowIndex
r<-[RowIndex
r1..RowIndex
r2], ColumnIndex
c<-[ColumnIndex
c1..ColumnIndex
c2]]
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(RowIndex, ColumnIndex)]
nonTopLeft (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete)
        forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (RowIndex
r1, ColumnIndex
c1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FormattedCell Int
formattedRowSpan forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
          (RowIndex -> Int
unRowIndex RowIndex
r2 forall a. Num a => a -> a -> a
- RowIndex -> Int
unRowIndex RowIndex
r1 forall a. Num a => a -> a -> a
+ Int
1)
        forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (RowIndex
r1, ColumnIndex
c1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FormattedCell Int
formattedColSpan forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
          (ColumnIndex -> Int
unColumnIndex ColumnIndex
c2 forall a. Num a => a -> a -> a
- ColumnIndex -> Int
unColumnIndex ColumnIndex
c1 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
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
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. 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
    { condformattedStyleSheet :: StyleSheet
condformattedStyleSheet  = StyleSheet
styleSheet forall a b. a -> (a -> b) -> b
& Lens' StyleSheet [Dxf]
styleSheetDxfs 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) = forall s a. State s a -> s -> (a, s)
runState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FormattedCondFmt -> State (Map Dxf Int) CfRule
mapDxf) Map Range [FormattedCondFmt]
cfs) Map Dxf Int
dxf2id0
    dxf2id0 :: Map Dxf Int
dxf2id0 = forall a. Ord a => [a] -> Map a Int
fromValueList (StyleSheet
styleSheet forall s a. s -> Getting a s a -> a
^. Lens' StyleSheet [Dxf]
styleSheetDxfs)
    fmts :: Map SqRef ConditionalFormatting
fmts = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {b}. [(Range, b)] -> (SqRef, b)
mergeSqRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ 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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Range, b)]
cellRefs2fmt),
         forall a. Partial => String -> [a] -> a
headNote String
"fmt group should not be empty" (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Range, b)]
cellRefs2fmt))
    finalDxfs :: [Dxf]
finalDxfs = forall a. Map a Int -> [a]
toValueList Map Dxf Int
dxf2id

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

-- | Format a cell with (potentially) rowspan or colspan
formatCell :: (RowIndex, ColumnIndex) -> FormattedCell
  -> State FormattingState [((RowIndex, ColumnIndex), Cell)]
formatCell :: (RowIndex, ColumnIndex)
-> FormattedCell
-> State FormattingState [((RowIndex, ColumnIndex), Cell)]
formatCell (RowIndex
row, ColumnIndex
col) FormattedCell
cell = do
    let ([((RowIndex, ColumnIndex), FormattedCell)]
block, Maybe Range
mMerge) = (RowIndex, ColumnIndex)
-> FormattedCell
-> ([((RowIndex, ColumnIndex), FormattedCell)], Maybe Range)
cellBlock (RowIndex
row, ColumnIndex
col) FormattedCell
cell
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Range
mMerge forall a b. (a -> b) -> a -> b
$ \Range
merge -> Lens' FormattingState [Range]
formattingMerges forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (:) Range
merge
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((RowIndex, ColumnIndex), FormattedCell)
-> State FormattingState ((RowIndex, ColumnIndex), Cell)
go [((RowIndex, ColumnIndex), FormattedCell)]
block
  where
    go :: ((RowIndex, ColumnIndex), FormattedCell)
      -> State FormattingState ((RowIndex, ColumnIndex), Cell)
    go :: ((RowIndex, ColumnIndex), FormattedCell)
-> State FormattingState ((RowIndex, ColumnIndex), Cell)
go ((RowIndex, ColumnIndex)
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
      forall (m :: * -> *) a. Monad m => a -> m a
return ((RowIndex, ColumnIndex)
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 :: (RowIndex, ColumnIndex) -> FormattedCell
          -> ([((RowIndex, ColumnIndex), FormattedCell)], Maybe Range)
cellBlock :: (RowIndex, ColumnIndex)
-> FormattedCell
-> ([((RowIndex, ColumnIndex), FormattedCell)], Maybe Range)
cellBlock (RowIndex
row, ColumnIndex
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
..} = ([((RowIndex, ColumnIndex), FormattedCell)]
block, Maybe Range
merge)
  where
    block :: [((RowIndex, ColumnIndex), FormattedCell)]
    block :: [((RowIndex, ColumnIndex), FormattedCell)]
block = [ ((RowIndex
row', ColumnIndex
col'), (RowIndex, ColumnIndex) -> FormattedCell
cellAt (RowIndex
row', ColumnIndex
col'))
            | RowIndex
row' <- [RowIndex
topRow  .. RowIndex
bottomRow]
            , ColumnIndex
col' <- [ColumnIndex
leftCol .. ColumnIndex
rightCol]
            ]

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

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

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

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

    topRow, bottomRow :: RowIndex
    leftCol, rightCol :: ColumnIndex
    topRow :: RowIndex
topRow    = RowIndex
row
    bottomRow :: RowIndex
bottomRow = Int -> RowIndex
RowIndex forall a b. (a -> b) -> a -> b
$ RowIndex -> Int
unRowIndex RowIndex
row forall a. Num a => a -> a -> a
+ Int
_formattedRowSpan forall a. Num a => a -> a -> a
- Int
1
    leftCol :: ColumnIndex
leftCol   = ColumnIndex
col
    rightCol :: ColumnIndex
rightCol  = Int -> ColumnIndex
ColumnIndex forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Int
unColumnIndex ColumnIndex
col forall a. Num a => a -> a -> a
+ Int
_formattedColSpan forall a. Num a => a -> a -> a
- Int
1

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

constructCellXf :: FormattedCell -> State FormattingState (Maybe CellXf)
constructCellXf :: FormattedCell -> State FormattingState (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 <- forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Border Int)
formattingBorders forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe Border
_formatBorder
    Maybe Int
mFillId   <- forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Fill Int)
formattingFills   forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` Maybe Fill
_formatFill
    Maybe Int
mFontId   <- forall a.
Ord a =>
Lens' FormattingState (Map a Int) -> a -> State FormattingState Int
getId Lens' FormattingState (Map Font Int)
formattingFonts   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) = forall (m :: * -> *) a. Monad m => a -> m a
return (ImpliedNumberFormat -> Int
stdNumberFormatId ImpliedNumberFormat
fmt)
        getFmtId Lens' FormattingState (Map Text Int)
l (UserNumberFormat Text
fmt) = 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 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 {
            _cellXfApplyAlignment :: Maybe Bool
_cellXfApplyAlignment    = forall a. Maybe a -> Maybe Bool
apply Maybe Alignment
_formatAlignment
          , _cellXfApplyBorder :: Maybe Bool
_cellXfApplyBorder       = forall a. Maybe a -> Maybe Bool
apply Maybe Int
mBorderId
          , _cellXfApplyFill :: Maybe Bool
_cellXfApplyFill         = forall a. Maybe a -> Maybe Bool
apply Maybe Int
mFillId
          , _cellXfApplyFont :: Maybe Bool
_cellXfApplyFont         = forall a. Maybe a -> Maybe Bool
apply Maybe Int
mFontId
          , _cellXfApplyNumberFormat :: Maybe Bool
_cellXfApplyNumberFormat = forall a. Maybe a -> Maybe Bool
apply Maybe NumberFormat
_formatNumberFormat
          , _cellXfApplyProtection :: Maybe Bool
_cellXfApplyProtection   = 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                = forall a. Maybe a
Nothing -- TODO
          , _cellXfAlignment :: Maybe Alignment
_cellXfAlignment         = Maybe Alignment
_formatAlignment
          , _cellXfProtection :: Maybe Protection
_cellXfProtection        = Maybe Protection
_formatProtection
          }
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if CellXf
xf forall a. Eq a => a -> a -> Bool
== forall a. Default a => a
def then forall a. Maybe a
Nothing else 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 :: forall a. Maybe a -> Maybe Bool
apply Maybe a
Nothing  = forall a. Maybe a
Nothing
    apply (Just a
_) = forall a. a -> Maybe a
Just Bool
True

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