{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE DeriveGeneric #-}
-- | Support for writing (but not reading) style sheets
module Codec.Xlsx.Types.StyleSheet (
    -- * The main two types
    StyleSheet(..)
  , CellXf(..)
  , minimalStyleSheet
    -- * Supporting record types
  , Alignment(..)
  , Border(..)
  , BorderStyle(..)
  , Color(..)
  , Dxf(..)
  , Fill(..)
  , FillPattern(..)
  , Font(..)
  , NumberFormat(..)
  , NumFmt(..)
  , ImpliedNumberFormat (..)
  , FormatCode
  , Protection(..)
    -- * Supporting enumerations
  , CellHorizontalAlignment(..)
  , CellVerticalAlignment(..)
  , FontFamily(..)
  , FontScheme(..)
  , FontUnderline(..)
  , FontVerticalAlignment(..)
  , LineStyle(..)
  , PatternType(..)
  , ReadingOrder(..)
    -- * Lenses
    -- ** StyleSheet
  , styleSheetBorders
  , styleSheetFonts
  , styleSheetFills
  , styleSheetCellXfs
  , styleSheetDxfs
  , styleSheetNumFmts
    -- ** CellXf
  , cellXfApplyAlignment
  , cellXfApplyBorder
  , cellXfApplyFill
  , cellXfApplyFont
  , cellXfApplyNumberFormat
  , cellXfApplyProtection
  , cellXfBorderId
  , cellXfFillId
  , cellXfFontId
  , cellXfNumFmtId
  , cellXfPivotButton
  , cellXfQuotePrefix
  , cellXfId
  , cellXfAlignment
  , cellXfProtection
    -- ** Dxf
  , dxfAlignment
  , dxfBorder
  , dxfFill
  , dxfFont
  , dxfNumFmt
  , dxfProtection
    -- ** Alignment
  , alignmentHorizontal
  , alignmentIndent
  , alignmentJustifyLastLine
  , alignmentReadingOrder
  , alignmentRelativeIndent
  , alignmentShrinkToFit
  , alignmentTextRotation
  , alignmentVertical
  , alignmentWrapText
    -- ** Border
  , borderDiagonalDown
  , borderDiagonalUp
  , borderOutline
  , borderBottom
  , borderDiagonal
  , borderEnd
  , borderHorizontal
  , borderStart
  , borderTop
  , borderVertical
  , borderLeft
  , borderRight
    -- ** BorderStyle
  , borderStyleColor
  , borderStyleLine
    -- ** Color
  , colorAutomatic
  , colorARGB
  , colorTheme
  , colorTint
    -- ** Fill
  , fillPattern
    -- ** FillPattern
  , fillPatternBgColor
  , fillPatternFgColor
  , fillPatternType
    -- ** Font
  , fontBold
  , fontCharset
  , fontColor
  , fontCondense
  , fontExtend
  , fontFamily
  , fontItalic
  , fontName
  , fontOutline
  , fontScheme
  , fontShadow
  , fontStrikeThrough
  , fontSize
  , fontUnderline
  , fontVertAlign
    -- ** Protection
  , protectionHidden
  , protectionLocked
    -- * Helpers
    -- ** Number formats
  , fmtDecimals
  , fmtDecimalsZeroes
  , stdNumberFormatId
  , idToStdNumberFormat
  , firstUserNumFmtId
  ) where

#ifdef USE_MICROLENS
import Lens.Micro
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens hiding (element, elements, (.=))
#endif
import Control.DeepSeq (NFData)
import Data.Default
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, maybeToList)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Writer.Internal

{-------------------------------------------------------------------------------
  The main types
-------------------------------------------------------------------------------}

-- | StyleSheet for an XML document
--
-- Relevant parts of the EMCA standard (4th edition, part 1,
-- <http://www.ecma-international.org/publications/standards/Ecma-376.htm>),
-- page numbers refer to the page in the PDF rather than the page number as
-- printed on the page):
--
-- * Chapter 12, \"SpreadsheetML\" (p. 74)
--   In particular Section 12.3.20, "Styles Part" (p. 104)
-- * Chapter 18, \"SpreadsheetML Reference Material\" (p. 1528)
--   In particular Section 18.8, \"Styles\" (p. 1754) and Section 18.8.39
--   \"styleSheet\" (Style Sheet)\" (p. 1796); it is the latter section that
--   specifies the top-level style sheet format.
--
-- TODO: the following child elements:
--
-- * cellStyles
-- * cellStyleXfs
-- * colors
-- * extLst
-- * tableStyles
--
-- NOTE: Because of undocumented Excel requirements you will probably want to base
-- your style sheet on 'minimalStyleSheet' (a proper style sheet should have some
-- contents for details see
-- <https://stackoverflow.com/questions/26050708/minimal-style-sheet-for-excel-open-xml-with-dates SO post>).
-- 'def' for 'StyleSheet' includes no contents at all and this could be a problem
-- for Excel.
--
-- See also:
--
-- * 'Codec.Xlsx.Types.renderStyleSheet' to translate a 'StyleSheet' to 'Styles'
-- * 'Codec.Xlsx.Formatted.formatted' for a higher level interface.
-- * 'Codec.Xlsx.Types.parseStyleSheet' to translate a raw 'StyleSheet' into 'Styles'
data StyleSheet = StyleSheet
    { StyleSheet -> [Border]
_styleSheetBorders :: [Border]
    -- ^ This element contains borders formatting information, specifying all
    -- border definitions for all cells in the workbook.
    --
    -- Section 18.8.5, "borders (Borders)" (p. 1760)

    , StyleSheet -> [CellXf]
_styleSheetCellXfs :: [CellXf]
    -- ^ Cell formats
    --
    -- This element contains the master formatting records (xf) which define the
    -- formatting applied to cells in this workbook. These records are the
    -- starting point for determining the formatting for a cell. Cells in the
    -- Sheet Part reference the xf records by zero-based index.
    --
    -- Section 18.8.10, "cellXfs (Cell Formats)" (p. 1764)

    , StyleSheet -> [Fill]
_styleSheetFills   :: [Fill]
    -- ^ This element defines the cell fills portion of the Styles part,
    -- consisting of a sequence of fill records. A cell fill consists of a
    -- background color, foreground color, and pattern to be applied across the
    -- cell.
    --
    -- Section 18.8.21, "fills (Fills)" (p. 1768)

    , StyleSheet -> [Font]
_styleSheetFonts   :: [Font]
    -- ^ This element contains all font definitions for this workbook.
    --
    -- Section 18.8.23 "fonts (Fonts)" (p. 1769)

    , StyleSheet -> [Dxf]
_styleSheetDxfs    :: [Dxf]
    -- ^ Differential formatting
    --
    -- This element contains the master differential formatting records (dxf's)
    -- which define formatting for all non-cell formatting in this workbook.
    -- Whereas xf records fully specify a particular aspect of formatting (e.g.,
    -- cell borders) by referencing those formatting definitions elsewhere in
    -- the Styles part, dxf records specify incremental (or differential) aspects
    -- of formatting directly inline within the dxf element. The dxf formatting
    -- is to be applied on top of or in addition to any formatting already
    -- present on the object using the dxf record.
    --
    -- Section 18.8.15, "dxfs (Formats)" (p. 1765)

    , StyleSheet -> Map Int FormatCode
_styleSheetNumFmts :: Map Int FormatCode
    -- ^ Number formats
    --
    -- This element contains custom number formats defined in this style sheet
    --
    -- Section 18.8.31, "numFmts (Number Formats)" (p. 1784)
    } deriving (StyleSheet -> StyleSheet -> Bool
(StyleSheet -> StyleSheet -> Bool)
-> (StyleSheet -> StyleSheet -> Bool) -> Eq StyleSheet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleSheet -> StyleSheet -> Bool
$c/= :: StyleSheet -> StyleSheet -> Bool
== :: StyleSheet -> StyleSheet -> Bool
$c== :: StyleSheet -> StyleSheet -> Bool
Eq, Eq StyleSheet
Eq StyleSheet
-> (StyleSheet -> StyleSheet -> Ordering)
-> (StyleSheet -> StyleSheet -> Bool)
-> (StyleSheet -> StyleSheet -> Bool)
-> (StyleSheet -> StyleSheet -> Bool)
-> (StyleSheet -> StyleSheet -> Bool)
-> (StyleSheet -> StyleSheet -> StyleSheet)
-> (StyleSheet -> StyleSheet -> StyleSheet)
-> Ord StyleSheet
StyleSheet -> StyleSheet -> Bool
StyleSheet -> StyleSheet -> Ordering
StyleSheet -> StyleSheet -> StyleSheet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StyleSheet -> StyleSheet -> StyleSheet
$cmin :: StyleSheet -> StyleSheet -> StyleSheet
max :: StyleSheet -> StyleSheet -> StyleSheet
$cmax :: StyleSheet -> StyleSheet -> StyleSheet
>= :: StyleSheet -> StyleSheet -> Bool
$c>= :: StyleSheet -> StyleSheet -> Bool
> :: StyleSheet -> StyleSheet -> Bool
$c> :: StyleSheet -> StyleSheet -> Bool
<= :: StyleSheet -> StyleSheet -> Bool
$c<= :: StyleSheet -> StyleSheet -> Bool
< :: StyleSheet -> StyleSheet -> Bool
$c< :: StyleSheet -> StyleSheet -> Bool
compare :: StyleSheet -> StyleSheet -> Ordering
$ccompare :: StyleSheet -> StyleSheet -> Ordering
$cp1Ord :: Eq StyleSheet
Ord, Int -> StyleSheet -> ShowS
[StyleSheet] -> ShowS
StyleSheet -> String
(Int -> StyleSheet -> ShowS)
-> (StyleSheet -> String)
-> ([StyleSheet] -> ShowS)
-> Show StyleSheet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleSheet] -> ShowS
$cshowList :: [StyleSheet] -> ShowS
show :: StyleSheet -> String
$cshow :: StyleSheet -> String
showsPrec :: Int -> StyleSheet -> ShowS
$cshowsPrec :: Int -> StyleSheet -> ShowS
Show, (forall x. StyleSheet -> Rep StyleSheet x)
-> (forall x. Rep StyleSheet x -> StyleSheet) -> Generic StyleSheet
forall x. Rep StyleSheet x -> StyleSheet
forall x. StyleSheet -> Rep StyleSheet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StyleSheet x -> StyleSheet
$cfrom :: forall x. StyleSheet -> Rep StyleSheet x
Generic)

instance NFData StyleSheet

-- | Cell formatting
--
-- TODO: The @extLst@ field is currently unsupported.
--
-- Section 18.8.45 "xf (Format)" (p. 1800)
data CellXf = CellXf {
    -- | A boolean value indicating whether the alignment formatting specified
    -- for this xf should be applied.
    CellXf -> Maybe Bool
_cellXfApplyAlignment    :: Maybe Bool

    -- | A boolean value indicating whether the border formatting specified for
    -- this xf should be applied.
  , CellXf -> Maybe Bool
_cellXfApplyBorder       :: Maybe Bool

    -- | A boolean value indicating whether the fill formatting specified for
    -- this xf should be applied.
  , CellXf -> Maybe Bool
_cellXfApplyFill         :: Maybe Bool

    -- | A boolean value indicating whether the font formatting specified for
    -- this xf should be applied.
  , CellXf -> Maybe Bool
_cellXfApplyFont         :: Maybe Bool

    -- | A boolean value indicating whether the number formatting specified for
    -- this xf should be applied.
  , CellXf -> Maybe Bool
_cellXfApplyNumberFormat :: Maybe Bool

    -- | A boolean value indicating whether the protection formatting specified
    -- for this xf should be applied.
  , CellXf -> Maybe Bool
_cellXfApplyProtection   :: Maybe Bool

    -- | Zero-based index of the border record used by this cell format.
    --
    -- (18.18.2, p. 2437).
  , CellXf -> Maybe Int
_cellXfBorderId          :: Maybe Int

    -- | Zero-based index of the fill record used by this cell format.
    --
    -- (18.18.30, p. 2455)
  , CellXf -> Maybe Int
_cellXfFillId            :: Maybe Int

    -- | Zero-based index of the font record used by this cell format.
    --
    -- An integer that represents a zero based index into the `styleSheetFonts`
    -- collection in the style sheet (18.18.32, p. 2456).
  , CellXf -> Maybe Int
_cellXfFontId            :: Maybe Int

    -- | Id of the number format (numFmt) record used by this cell format.
    --
    -- This simple type defines the identifier to a style sheet number format
    -- entry in CT_NumFmts. Number formats are written to the styles part
    -- (18.18.47, p. 2468). See also 18.8.31 (p. 1784) for more information on
    -- number formats.
    --
  , CellXf -> Maybe Int
_cellXfNumFmtId          :: Maybe Int

    -- | A boolean value indicating whether the cell rendering includes a pivot
    -- table dropdown button.
  , CellXf -> Maybe Bool
_cellXfPivotButton       :: Maybe Bool

    -- | A boolean value indicating whether the text string in a cell should be
    -- prefixed by a single quote mark (e.g., 'text). In these cases, the quote
    -- is not stored in the Shared Strings Part.
  , CellXf -> Maybe Bool
_cellXfQuotePrefix       :: Maybe Bool

    -- | For xf records contained in cellXfs this is the zero-based index of an
    -- xf record contained in cellStyleXfs corresponding to the cell style
    -- applied to the cell.
    --
    -- Not present for xf records contained in cellStyleXfs.
    --
    -- Used by xf records and cellStyle records to reference xf records defined
    -- in the cellStyleXfs collection. (18.18.10, p. 2442)
    -- TODO: the cellStyleXfs field of a style sheet not currently implemented.
  , CellXf -> Maybe Int
_cellXfId                :: Maybe Int

    -- | Formatting information pertaining to text alignment in cells. There are
    -- a variety of choices for how text is aligned both horizontally and
    -- vertically, as well as indentation settings, and so on.
  , CellXf -> Maybe Alignment
_cellXfAlignment         :: Maybe Alignment

    -- | Contains protection properties associated with the cell. Each cell has
    -- protection properties that can be set. The cell protection properties do
    -- not take effect unless the sheet has been protected.
  , CellXf -> Maybe Protection
_cellXfProtection        :: Maybe Protection
  }
  deriving (CellXf -> CellXf -> Bool
(CellXf -> CellXf -> Bool)
-> (CellXf -> CellXf -> Bool) -> Eq CellXf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellXf -> CellXf -> Bool
$c/= :: CellXf -> CellXf -> Bool
== :: CellXf -> CellXf -> Bool
$c== :: CellXf -> CellXf -> Bool
Eq, Eq CellXf
Eq CellXf
-> (CellXf -> CellXf -> Ordering)
-> (CellXf -> CellXf -> Bool)
-> (CellXf -> CellXf -> Bool)
-> (CellXf -> CellXf -> Bool)
-> (CellXf -> CellXf -> Bool)
-> (CellXf -> CellXf -> CellXf)
-> (CellXf -> CellXf -> CellXf)
-> Ord CellXf
CellXf -> CellXf -> Bool
CellXf -> CellXf -> Ordering
CellXf -> CellXf -> CellXf
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CellXf -> CellXf -> CellXf
$cmin :: CellXf -> CellXf -> CellXf
max :: CellXf -> CellXf -> CellXf
$cmax :: CellXf -> CellXf -> CellXf
>= :: CellXf -> CellXf -> Bool
$c>= :: CellXf -> CellXf -> Bool
> :: CellXf -> CellXf -> Bool
$c> :: CellXf -> CellXf -> Bool
<= :: CellXf -> CellXf -> Bool
$c<= :: CellXf -> CellXf -> Bool
< :: CellXf -> CellXf -> Bool
$c< :: CellXf -> CellXf -> Bool
compare :: CellXf -> CellXf -> Ordering
$ccompare :: CellXf -> CellXf -> Ordering
$cp1Ord :: Eq CellXf
Ord, Int -> CellXf -> ShowS
[CellXf] -> ShowS
CellXf -> String
(Int -> CellXf -> ShowS)
-> (CellXf -> String) -> ([CellXf] -> ShowS) -> Show CellXf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellXf] -> ShowS
$cshowList :: [CellXf] -> ShowS
show :: CellXf -> String
$cshow :: CellXf -> String
showsPrec :: Int -> CellXf -> ShowS
$cshowsPrec :: Int -> CellXf -> ShowS
Show, (forall x. CellXf -> Rep CellXf x)
-> (forall x. Rep CellXf x -> CellXf) -> Generic CellXf
forall x. Rep CellXf x -> CellXf
forall x. CellXf -> Rep CellXf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellXf x -> CellXf
$cfrom :: forall x. CellXf -> Rep CellXf x
Generic)

instance NFData CellXf

{-------------------------------------------------------------------------------
  Supporting record types
-------------------------------------------------------------------------------}

-- | Alignment
--
-- See 18.8.1 "alignment (Alignment)" (p. 1754)
data Alignment = Alignment {
    -- | Specifies the type of horizontal alignment in cells.
    Alignment -> Maybe CellHorizontalAlignment
_alignmentHorizontal      :: Maybe CellHorizontalAlignment

    -- | An integer value, where an increment of 1 represents 3 spaces.
    -- Indicates the number of spaces (of the normal style font) of indentation
    -- for text in a cell.
  , Alignment -> Maybe Int
_alignmentIndent          :: Maybe Int

    -- | A boolean value indicating if the cells justified or distributed
    -- alignment should be used on the last line of text. (This is typical for
    -- East Asian alignments but not typical in other contexts.)
  , Alignment -> Maybe Bool
_alignmentJustifyLastLine :: Maybe Bool

    -- | An integer value indicating whether the reading order
    -- (bidirectionality) of the cell is leftto- right, right-to-left, or
    -- context dependent.
  , Alignment -> Maybe ReadingOrder
_alignmentReadingOrder    :: Maybe ReadingOrder

    -- | An integer value (used only in a dxf element) to indicate the
    -- additional number of spaces of indentation to adjust for text in a cell.
  , Alignment -> Maybe Int
_alignmentRelativeIndent  :: Maybe Int

    -- | A boolean value indicating if the displayed text in the cell should be
    -- shrunk to fit the cell width. Not applicable when a cell contains
    -- multiple lines of text.
  , Alignment -> Maybe Bool
_alignmentShrinkToFit     :: Maybe Bool

    -- | Text rotation in cells. Expressed in degrees. Values range from 0 to
    -- 180. The first letter of the text is considered the center-point of the
    -- arc.
  , Alignment -> Maybe Int
_alignmentTextRotation    :: Maybe Int

    -- | Vertical alignment in cells.
  , Alignment -> Maybe CellVerticalAlignment
_alignmentVertical        :: Maybe CellVerticalAlignment

    -- | A boolean value indicating if the text in a cell should be line-wrapped
    -- within the cell.
  , Alignment -> Maybe Bool
_alignmentWrapText        :: Maybe Bool
  }
  deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment
-> (Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
$cp1Ord :: Eq Alignment
Ord, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, (forall x. Alignment -> Rep Alignment x)
-> (forall x. Rep Alignment x -> Alignment) -> Generic Alignment
forall x. Rep Alignment x -> Alignment
forall x. Alignment -> Rep Alignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alignment x -> Alignment
$cfrom :: forall x. Alignment -> Rep Alignment x
Generic)

instance NFData Alignment

-- | Expresses a single set of cell border formats (left, right, top, bottom,
-- diagonal). Color is optional. When missing, 'automatic' is implied.
--
-- See 18.8.4 "border (Border)" (p. 1759)
data Border = Border {
    -- | A boolean value indicating if the cell's diagonal border includes a
    -- diagonal line, starting at the top left corner of the cell and moving
    -- down to the bottom right corner of the cell.
    Border -> Maybe Bool
_borderDiagonalDown :: Maybe Bool

    -- | A boolean value indicating if the cell's diagonal border includes a
    -- diagonal line, starting at the bottom left corner of the cell and moving
    -- up to the top right corner of the cell.
  , Border -> Maybe Bool
_borderDiagonalUp   :: Maybe Bool

    -- | A boolean value indicating if left, right, top, and bottom borders
    -- should be applied only to outside borders of a cell range.
  , Border -> Maybe Bool
_borderOutline      :: Maybe Bool

    -- | Bottom border
  , Border -> Maybe BorderStyle
_borderBottom       :: Maybe BorderStyle

    -- | Diagonal
  , Border -> Maybe BorderStyle
_borderDiagonal     :: Maybe BorderStyle

    -- | Trailing edge border
    --
    -- See also 'borderRight'
  , Border -> Maybe BorderStyle
_borderEnd          :: Maybe BorderStyle

    -- | Horizontal inner borders
  , Border -> Maybe BorderStyle
_borderHorizontal   :: Maybe BorderStyle

    -- | Left border
    --
    -- NOTE: The spec does not formally list a 'left' border element, but the
    -- examples do mention 'left' and the scheme contains it too. See also 'borderStart'.
  , Border -> Maybe BorderStyle
_borderLeft         :: Maybe BorderStyle

    -- | Right border
    --
    -- NOTE: The spec does not formally list a 'right' border element, but the
    -- examples do mention 'right' and the scheme contains it too. See also 'borderEnd'.
  , Border -> Maybe BorderStyle
_borderRight        :: Maybe BorderStyle

    -- | Leading edge border
    --
    -- See also 'borderLeft'
  , Border -> Maybe BorderStyle
_borderStart        :: Maybe BorderStyle

    -- | Top border
  , Border -> Maybe BorderStyle
_borderTop          :: Maybe BorderStyle

    -- | Vertical inner border
  , Border -> Maybe BorderStyle
_borderVertical     :: Maybe BorderStyle
  }
  deriving (Border -> Border -> Bool
(Border -> Border -> Bool)
-> (Border -> Border -> Bool) -> Eq Border
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c== :: Border -> Border -> Bool
Eq, Eq Border
Eq Border
-> (Border -> Border -> Ordering)
-> (Border -> Border -> Bool)
-> (Border -> Border -> Bool)
-> (Border -> Border -> Bool)
-> (Border -> Border -> Bool)
-> (Border -> Border -> Border)
-> (Border -> Border -> Border)
-> Ord Border
Border -> Border -> Bool
Border -> Border -> Ordering
Border -> Border -> Border
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Border -> Border -> Border
$cmin :: Border -> Border -> Border
max :: Border -> Border -> Border
$cmax :: Border -> Border -> Border
>= :: Border -> Border -> Bool
$c>= :: Border -> Border -> Bool
> :: Border -> Border -> Bool
$c> :: Border -> Border -> Bool
<= :: Border -> Border -> Bool
$c<= :: Border -> Border -> Bool
< :: Border -> Border -> Bool
$c< :: Border -> Border -> Bool
compare :: Border -> Border -> Ordering
$ccompare :: Border -> Border -> Ordering
$cp1Ord :: Eq Border
Ord, Int -> Border -> ShowS
[Border] -> ShowS
Border -> String
(Int -> Border -> ShowS)
-> (Border -> String) -> ([Border] -> ShowS) -> Show Border
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Border] -> ShowS
$cshowList :: [Border] -> ShowS
show :: Border -> String
$cshow :: Border -> String
showsPrec :: Int -> Border -> ShowS
$cshowsPrec :: Int -> Border -> ShowS
Show, (forall x. Border -> Rep Border x)
-> (forall x. Rep Border x -> Border) -> Generic Border
forall x. Rep Border x -> Border
forall x. Border -> Rep Border x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Border x -> Border
$cfrom :: forall x. Border -> Rep Border x
Generic)

instance NFData Border

-- | Border style
-- See @CT_BorderPr@ (p. 3934)
data BorderStyle = BorderStyle {
    BorderStyle -> Maybe Color
_borderStyleColor :: Maybe Color
  , BorderStyle -> Maybe LineStyle
_borderStyleLine  :: Maybe LineStyle
  }
  deriving (BorderStyle -> BorderStyle -> Bool
(BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> Bool) -> Eq BorderStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BorderStyle -> BorderStyle -> Bool
$c/= :: BorderStyle -> BorderStyle -> Bool
== :: BorderStyle -> BorderStyle -> Bool
$c== :: BorderStyle -> BorderStyle -> Bool
Eq, Eq BorderStyle
Eq BorderStyle
-> (BorderStyle -> BorderStyle -> Ordering)
-> (BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> Bool)
-> (BorderStyle -> BorderStyle -> BorderStyle)
-> (BorderStyle -> BorderStyle -> BorderStyle)
-> Ord BorderStyle
BorderStyle -> BorderStyle -> Bool
BorderStyle -> BorderStyle -> Ordering
BorderStyle -> BorderStyle -> BorderStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BorderStyle -> BorderStyle -> BorderStyle
$cmin :: BorderStyle -> BorderStyle -> BorderStyle
max :: BorderStyle -> BorderStyle -> BorderStyle
$cmax :: BorderStyle -> BorderStyle -> BorderStyle
>= :: BorderStyle -> BorderStyle -> Bool
$c>= :: BorderStyle -> BorderStyle -> Bool
> :: BorderStyle -> BorderStyle -> Bool
$c> :: BorderStyle -> BorderStyle -> Bool
<= :: BorderStyle -> BorderStyle -> Bool
$c<= :: BorderStyle -> BorderStyle -> Bool
< :: BorderStyle -> BorderStyle -> Bool
$c< :: BorderStyle -> BorderStyle -> Bool
compare :: BorderStyle -> BorderStyle -> Ordering
$ccompare :: BorderStyle -> BorderStyle -> Ordering
$cp1Ord :: Eq BorderStyle
Ord, Int -> BorderStyle -> ShowS
[BorderStyle] -> ShowS
BorderStyle -> String
(Int -> BorderStyle -> ShowS)
-> (BorderStyle -> String)
-> ([BorderStyle] -> ShowS)
-> Show BorderStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BorderStyle] -> ShowS
$cshowList :: [BorderStyle] -> ShowS
show :: BorderStyle -> String
$cshow :: BorderStyle -> String
showsPrec :: Int -> BorderStyle -> ShowS
$cshowsPrec :: Int -> BorderStyle -> ShowS
Show, (forall x. BorderStyle -> Rep BorderStyle x)
-> (forall x. Rep BorderStyle x -> BorderStyle)
-> Generic BorderStyle
forall x. Rep BorderStyle x -> BorderStyle
forall x. BorderStyle -> Rep BorderStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BorderStyle x -> BorderStyle
$cfrom :: forall x. BorderStyle -> Rep BorderStyle x
Generic)

instance NFData BorderStyle

-- | One of the colors associated with the data bar or color scale.
--
-- The 'indexed' attribute (used for backwards compatibility only) is not
-- modelled here.
--
-- See 18.3.1.15 "color (Data Bar Color)" (p. 1608)
data Color = Color {
    -- | A boolean value indicating the color is automatic and system color
    -- dependent.
    Color -> Maybe Bool
_colorAutomatic :: Maybe Bool

    -- | Standard Alpha Red Green Blue color value (ARGB).
    --
    -- This simple type's contents have a length of exactly 8 hexadecimal
    -- digit(s); see "18.18.86 ST_UnsignedIntHex (Hex Unsigned Integer)" (p.
    -- 2511).
  , Color -> Maybe FormatCode
_colorARGB      :: Maybe Text

    -- | A zero-based index into the <clrScheme> collection (20.1.6.2),
    -- referencing a particular <sysClr> or <srgbClr> value expressed in the
    -- Theme part.
  , Color -> Maybe Int
_colorTheme     :: Maybe Int

    -- | Specifies the tint value applied to the color.
    --
    -- If tint is supplied, then it is applied to the RGB value of the color to
    -- determine the final color applied.
    --
    -- The tint value is stored as a double from -1.0 .. 1.0, where -1.0 means
    -- 100% darken and 1.0 means 100% lighten. Also, 0.0 means no change.
  , Color -> Maybe Double
_colorTint      :: Maybe Double
  }
  deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic)

instance NFData Color

-- | This element specifies fill formatting.
--
-- TODO: Gradient fills (18.8.4) are currently unsupported. If we add them,
-- then the spec says (@CT_Fill@, p. 3935), _either_ a gradient _or_ a solid
-- fill pattern should be specified.
--
-- Section 18.8.20, "fill (Fill)" (p. 1768)
data Fill = Fill {
    Fill -> Maybe FillPattern
_fillPattern :: Maybe FillPattern
  }
  deriving (Fill -> Fill -> Bool
(Fill -> Fill -> Bool) -> (Fill -> Fill -> Bool) -> Eq Fill
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fill -> Fill -> Bool
$c/= :: Fill -> Fill -> Bool
== :: Fill -> Fill -> Bool
$c== :: Fill -> Fill -> Bool
Eq, Eq Fill
Eq Fill
-> (Fill -> Fill -> Ordering)
-> (Fill -> Fill -> Bool)
-> (Fill -> Fill -> Bool)
-> (Fill -> Fill -> Bool)
-> (Fill -> Fill -> Bool)
-> (Fill -> Fill -> Fill)
-> (Fill -> Fill -> Fill)
-> Ord Fill
Fill -> Fill -> Bool
Fill -> Fill -> Ordering
Fill -> Fill -> Fill
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fill -> Fill -> Fill
$cmin :: Fill -> Fill -> Fill
max :: Fill -> Fill -> Fill
$cmax :: Fill -> Fill -> Fill
>= :: Fill -> Fill -> Bool
$c>= :: Fill -> Fill -> Bool
> :: Fill -> Fill -> Bool
$c> :: Fill -> Fill -> Bool
<= :: Fill -> Fill -> Bool
$c<= :: Fill -> Fill -> Bool
< :: Fill -> Fill -> Bool
$c< :: Fill -> Fill -> Bool
compare :: Fill -> Fill -> Ordering
$ccompare :: Fill -> Fill -> Ordering
$cp1Ord :: Eq Fill
Ord, Int -> Fill -> ShowS
[Fill] -> ShowS
Fill -> String
(Int -> Fill -> ShowS)
-> (Fill -> String) -> ([Fill] -> ShowS) -> Show Fill
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fill] -> ShowS
$cshowList :: [Fill] -> ShowS
show :: Fill -> String
$cshow :: Fill -> String
showsPrec :: Int -> Fill -> ShowS
$cshowsPrec :: Int -> Fill -> ShowS
Show, (forall x. Fill -> Rep Fill x)
-> (forall x. Rep Fill x -> Fill) -> Generic Fill
forall x. Rep Fill x -> Fill
forall x. Fill -> Rep Fill x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fill x -> Fill
$cfrom :: forall x. Fill -> Rep Fill x
Generic)

instance NFData Fill

-- | This element is used to specify cell fill information for pattern and solid
-- color cell fills. For solid cell fills (no pattern), fgColor is used. For
-- cell fills with patterns specified, then the cell fill color is specified by
-- the bgColor element.
--
-- Section 18.8.32 "patternFill (Pattern)" (p. 1793)
data FillPattern = FillPattern {
    FillPattern -> Maybe Color
_fillPatternBgColor :: Maybe Color
  , FillPattern -> Maybe Color
_fillPatternFgColor :: Maybe Color
  , FillPattern -> Maybe PatternType
_fillPatternType    :: Maybe PatternType
  }
  deriving (FillPattern -> FillPattern -> Bool
(FillPattern -> FillPattern -> Bool)
-> (FillPattern -> FillPattern -> Bool) -> Eq FillPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillPattern -> FillPattern -> Bool
$c/= :: FillPattern -> FillPattern -> Bool
== :: FillPattern -> FillPattern -> Bool
$c== :: FillPattern -> FillPattern -> Bool
Eq, Eq FillPattern
Eq FillPattern
-> (FillPattern -> FillPattern -> Ordering)
-> (FillPattern -> FillPattern -> Bool)
-> (FillPattern -> FillPattern -> Bool)
-> (FillPattern -> FillPattern -> Bool)
-> (FillPattern -> FillPattern -> Bool)
-> (FillPattern -> FillPattern -> FillPattern)
-> (FillPattern -> FillPattern -> FillPattern)
-> Ord FillPattern
FillPattern -> FillPattern -> Bool
FillPattern -> FillPattern -> Ordering
FillPattern -> FillPattern -> FillPattern
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FillPattern -> FillPattern -> FillPattern
$cmin :: FillPattern -> FillPattern -> FillPattern
max :: FillPattern -> FillPattern -> FillPattern
$cmax :: FillPattern -> FillPattern -> FillPattern
>= :: FillPattern -> FillPattern -> Bool
$c>= :: FillPattern -> FillPattern -> Bool
> :: FillPattern -> FillPattern -> Bool
$c> :: FillPattern -> FillPattern -> Bool
<= :: FillPattern -> FillPattern -> Bool
$c<= :: FillPattern -> FillPattern -> Bool
< :: FillPattern -> FillPattern -> Bool
$c< :: FillPattern -> FillPattern -> Bool
compare :: FillPattern -> FillPattern -> Ordering
$ccompare :: FillPattern -> FillPattern -> Ordering
$cp1Ord :: Eq FillPattern
Ord, Int -> FillPattern -> ShowS
[FillPattern] -> ShowS
FillPattern -> String
(Int -> FillPattern -> ShowS)
-> (FillPattern -> String)
-> ([FillPattern] -> ShowS)
-> Show FillPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillPattern] -> ShowS
$cshowList :: [FillPattern] -> ShowS
show :: FillPattern -> String
$cshow :: FillPattern -> String
showsPrec :: Int -> FillPattern -> ShowS
$cshowsPrec :: Int -> FillPattern -> ShowS
Show, (forall x. FillPattern -> Rep FillPattern x)
-> (forall x. Rep FillPattern x -> FillPattern)
-> Generic FillPattern
forall x. Rep FillPattern x -> FillPattern
forall x. FillPattern -> Rep FillPattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FillPattern x -> FillPattern
$cfrom :: forall x. FillPattern -> Rep FillPattern x
Generic)

instance NFData FillPattern

-- | This element defines the properties for one of the fonts used in this
-- workbook.
--
-- Section 18.2.22 "font (Font)" (p. 1769)
data Font = Font {
    -- | Displays characters in bold face font style.
    Font -> Maybe Bool
_fontBold          :: Maybe Bool

    -- | This element defines the font character set of this font.
    --
    -- This field is used in font creation and selection if a font of the given
    -- facename is not available on the system. Although it is not required to
    -- have around when resolving font facename, the information can be stored
    -- for when needed to help resolve which font face to use of all available
    -- fonts on a system.
    --
    -- Charset represents the basic set of characters associated with a font
    -- (that it can display), and roughly corresponds to the ANSI codepage
    -- (8-bit or DBCS) of that character set used by a given language. Given
    -- more common use of Unicode where many fonts support more than one of the
    -- traditional charset categories, and the use of font linking, using
    -- charset to resolve font name is less and less common, but still can be
    -- useful.
    --
    -- These are operating-system-dependent values.
    --
    -- Section 18.4.1 "charset (Character Set)" provides some example values.
  , Font -> Maybe Int
_fontCharset       :: Maybe Int

    -- | Color
  , Font -> Maybe Color
_fontColor         :: Maybe Color

    -- | Macintosh compatibility setting. Represents special word/character
    -- rendering on Macintosh, when this flag is set. The effect is to condense
    -- the text (squeeze it together). SpreadsheetML applications are not
    -- required to render according to this flag.
  , Font -> Maybe Bool
_fontCondense      :: Maybe Bool

    -- | This element specifies a compatibility setting used for previous
    -- spreadsheet applications, resulting in special word/character rendering
    -- on those legacy applications, when this flag is set. The effect extends
    -- or stretches out the text. SpreadsheetML applications are not required to
    -- render according to this flag.
  , Font -> Maybe Bool
_fontExtend        :: Maybe Bool

    -- | The font family this font belongs to. A font family is a set of fonts
    -- having common stroke width and serif characteristics. This is system
    -- level font information. The font name overrides when there are
    -- conflicting values.
  , Font -> Maybe FontFamily
_fontFamily        :: Maybe FontFamily

    -- | Displays characters in italic font style. The italic style is defined
    -- by the font at a system level and is not specified by ECMA-376.
  , Font -> Maybe Bool
_fontItalic        :: Maybe Bool

    -- | This element specifies the face name of this font.
    --
    -- A string representing the name of the font. If the font doesn't exist
    -- (because it isn't installed on the system), or the charset not supported
    -- by that font, then another font should be substituted.
    --
    -- The string length for this attribute shall be 0 to 31 characters.
  , Font -> Maybe FormatCode
_fontName          :: Maybe Text

    -- | This element displays only the inner and outer borders of each
    -- character. This is very similar to Bold in behavior.
  , Font -> Maybe Bool
_fontOutline       :: Maybe Bool

    -- | Defines the font scheme, if any, to which this font belongs. When a
    -- font definition is part of a theme definition, then the font is
    -- categorized as either a major or minor font scheme component. When a new
    -- theme is chosen, every font that is part of a theme definition is updated
    -- to use the new major or minor font definition for that theme. Usually
    -- major fonts are used for styles like headings, and minor fonts are used
    -- for body and paragraph text.
  , Font -> Maybe FontScheme
_fontScheme        :: Maybe FontScheme

    -- | Macintosh compatibility setting. Represents special word/character
    -- rendering on Macintosh, when this flag is set. The effect is to render a
    -- shadow behind, beneath and to the right of the text. SpreadsheetML
    -- applications are not required to render according to this flag.
  , Font -> Maybe Bool
_fontShadow        :: Maybe Bool

    -- | This element draws a strikethrough line through the horizontal middle
    -- of the text.
  , Font -> Maybe Bool
_fontStrikeThrough :: Maybe Bool

    -- | This element represents the point size (1/72 of an inch) of the Latin
    -- and East Asian text.
  , Font -> Maybe Double
_fontSize          :: Maybe Double

    -- | This element represents the underline formatting style.
  , Font -> Maybe FontUnderline
_fontUnderline     :: Maybe FontUnderline

    -- | This element adjusts the vertical position of the text relative to the
    -- text's default appearance for this run. It is used to get 'superscript'
    -- or 'subscript' texts, and shall reduce the font size (if a smaller size
    -- is available) accordingly.
  , Font -> Maybe FontVerticalAlignment
_fontVertAlign     :: Maybe FontVerticalAlignment
  }
  deriving (Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Eq Font
Eq Font
-> (Font -> Font -> Ordering)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Font)
-> (Font -> Font -> Font)
-> Ord Font
Font -> Font -> Bool
Font -> Font -> Ordering
Font -> Font -> Font
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Font -> Font -> Font
$cmin :: Font -> Font -> Font
max :: Font -> Font -> Font
$cmax :: Font -> Font -> Font
>= :: Font -> Font -> Bool
$c>= :: Font -> Font -> Bool
> :: Font -> Font -> Bool
$c> :: Font -> Font -> Bool
<= :: Font -> Font -> Bool
$c<= :: Font -> Font -> Bool
< :: Font -> Font -> Bool
$c< :: Font -> Font -> Bool
compare :: Font -> Font -> Ordering
$ccompare :: Font -> Font -> Ordering
$cp1Ord :: Eq Font
Ord, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> String
$cshow :: Font -> String
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show, (forall x. Font -> Rep Font x)
-> (forall x. Rep Font x -> Font) -> Generic Font
forall x. Rep Font x -> Font
forall x. Font -> Rep Font x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Font x -> Font
$cfrom :: forall x. Font -> Rep Font x
Generic)

instance NFData Font

-- | A single dxf record, expressing incremental formatting to be applied.
--
-- Section 18.8.14, "dxf (Formatting)" (p. 1765)
data Dxf = Dxf
    { Dxf -> Maybe Font
_dxfFont       :: Maybe Font
      -- | It seems to be required that this number format entry is duplicated
      -- in '_styleSheetNumFmts' of the style sheet, though the spec says
      -- nothing explicitly about it.
    , Dxf -> Maybe NumFmt
_dxfNumFmt     :: Maybe NumFmt
    , Dxf -> Maybe Fill
_dxfFill       :: Maybe Fill
    , Dxf -> Maybe Alignment
_dxfAlignment  :: Maybe Alignment
    , Dxf -> Maybe Border
_dxfBorder     :: Maybe Border
    , Dxf -> Maybe Protection
_dxfProtection :: Maybe Protection
    -- TODO: extList
    } deriving (Dxf -> Dxf -> Bool
(Dxf -> Dxf -> Bool) -> (Dxf -> Dxf -> Bool) -> Eq Dxf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dxf -> Dxf -> Bool
$c/= :: Dxf -> Dxf -> Bool
== :: Dxf -> Dxf -> Bool
$c== :: Dxf -> Dxf -> Bool
Eq, Eq Dxf
Eq Dxf
-> (Dxf -> Dxf -> Ordering)
-> (Dxf -> Dxf -> Bool)
-> (Dxf -> Dxf -> Bool)
-> (Dxf -> Dxf -> Bool)
-> (Dxf -> Dxf -> Bool)
-> (Dxf -> Dxf -> Dxf)
-> (Dxf -> Dxf -> Dxf)
-> Ord Dxf
Dxf -> Dxf -> Bool
Dxf -> Dxf -> Ordering
Dxf -> Dxf -> Dxf
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dxf -> Dxf -> Dxf
$cmin :: Dxf -> Dxf -> Dxf
max :: Dxf -> Dxf -> Dxf
$cmax :: Dxf -> Dxf -> Dxf
>= :: Dxf -> Dxf -> Bool
$c>= :: Dxf -> Dxf -> Bool
> :: Dxf -> Dxf -> Bool
$c> :: Dxf -> Dxf -> Bool
<= :: Dxf -> Dxf -> Bool
$c<= :: Dxf -> Dxf -> Bool
< :: Dxf -> Dxf -> Bool
$c< :: Dxf -> Dxf -> Bool
compare :: Dxf -> Dxf -> Ordering
$ccompare :: Dxf -> Dxf -> Ordering
$cp1Ord :: Eq Dxf
Ord, Int -> Dxf -> ShowS
[Dxf] -> ShowS
Dxf -> String
(Int -> Dxf -> ShowS)
-> (Dxf -> String) -> ([Dxf] -> ShowS) -> Show Dxf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dxf] -> ShowS
$cshowList :: [Dxf] -> ShowS
show :: Dxf -> String
$cshow :: Dxf -> String
showsPrec :: Int -> Dxf -> ShowS
$cshowsPrec :: Int -> Dxf -> ShowS
Show, (forall x. Dxf -> Rep Dxf x)
-> (forall x. Rep Dxf x -> Dxf) -> Generic Dxf
forall x. Rep Dxf x -> Dxf
forall x. Dxf -> Rep Dxf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dxf x -> Dxf
$cfrom :: forall x. Dxf -> Rep Dxf x
Generic)

instance NFData Dxf

-- | A number format code.
--
-- Section 18.8.30, "numFmt (Number Format)" (p. 1777)
type FormatCode = Text

-- | This element specifies number format properties which indicate
-- how to format and render the numeric value of a cell.
--
-- Section 18.8.30 "numFmt (Number Format)" (p. 1777)
data NumFmt = NumFmt
  { NumFmt -> Int
_numFmtId :: Int
  , NumFmt -> FormatCode
_numFmtCode :: FormatCode
  } deriving (NumFmt -> NumFmt -> Bool
(NumFmt -> NumFmt -> Bool)
-> (NumFmt -> NumFmt -> Bool) -> Eq NumFmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumFmt -> NumFmt -> Bool
$c/= :: NumFmt -> NumFmt -> Bool
== :: NumFmt -> NumFmt -> Bool
$c== :: NumFmt -> NumFmt -> Bool
Eq, Eq NumFmt
Eq NumFmt
-> (NumFmt -> NumFmt -> Ordering)
-> (NumFmt -> NumFmt -> Bool)
-> (NumFmt -> NumFmt -> Bool)
-> (NumFmt -> NumFmt -> Bool)
-> (NumFmt -> NumFmt -> Bool)
-> (NumFmt -> NumFmt -> NumFmt)
-> (NumFmt -> NumFmt -> NumFmt)
-> Ord NumFmt
NumFmt -> NumFmt -> Bool
NumFmt -> NumFmt -> Ordering
NumFmt -> NumFmt -> NumFmt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumFmt -> NumFmt -> NumFmt
$cmin :: NumFmt -> NumFmt -> NumFmt
max :: NumFmt -> NumFmt -> NumFmt
$cmax :: NumFmt -> NumFmt -> NumFmt
>= :: NumFmt -> NumFmt -> Bool
$c>= :: NumFmt -> NumFmt -> Bool
> :: NumFmt -> NumFmt -> Bool
$c> :: NumFmt -> NumFmt -> Bool
<= :: NumFmt -> NumFmt -> Bool
$c<= :: NumFmt -> NumFmt -> Bool
< :: NumFmt -> NumFmt -> Bool
$c< :: NumFmt -> NumFmt -> Bool
compare :: NumFmt -> NumFmt -> Ordering
$ccompare :: NumFmt -> NumFmt -> Ordering
$cp1Ord :: Eq NumFmt
Ord, Int -> NumFmt -> ShowS
[NumFmt] -> ShowS
NumFmt -> String
(Int -> NumFmt -> ShowS)
-> (NumFmt -> String) -> ([NumFmt] -> ShowS) -> Show NumFmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumFmt] -> ShowS
$cshowList :: [NumFmt] -> ShowS
show :: NumFmt -> String
$cshow :: NumFmt -> String
showsPrec :: Int -> NumFmt -> ShowS
$cshowsPrec :: Int -> NumFmt -> ShowS
Show, (forall x. NumFmt -> Rep NumFmt x)
-> (forall x. Rep NumFmt x -> NumFmt) -> Generic NumFmt
forall x. Rep NumFmt x -> NumFmt
forall x. NumFmt -> Rep NumFmt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumFmt x -> NumFmt
$cfrom :: forall x. NumFmt -> Rep NumFmt x
Generic)

instance NFData NumFmt

mkNumFmtPair :: NumFmt -> (Int, FormatCode)
mkNumFmtPair :: NumFmt -> (Int, FormatCode)
mkNumFmtPair NumFmt{Int
FormatCode
_numFmtCode :: FormatCode
_numFmtId :: Int
_numFmtCode :: NumFmt -> FormatCode
_numFmtId :: NumFmt -> Int
..} = (Int
_numFmtId, FormatCode
_numFmtCode)

-- | This type gives a high-level version of representation of number format
-- used in 'Codec.Xlsx.Formatted.Format'.
data NumberFormat
    = StdNumberFormat ImpliedNumberFormat
    | UserNumberFormat FormatCode
    deriving (NumberFormat -> NumberFormat -> Bool
(NumberFormat -> NumberFormat -> Bool)
-> (NumberFormat -> NumberFormat -> Bool) -> Eq NumberFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberFormat -> NumberFormat -> Bool
$c/= :: NumberFormat -> NumberFormat -> Bool
== :: NumberFormat -> NumberFormat -> Bool
$c== :: NumberFormat -> NumberFormat -> Bool
Eq, Eq NumberFormat
Eq NumberFormat
-> (NumberFormat -> NumberFormat -> Ordering)
-> (NumberFormat -> NumberFormat -> Bool)
-> (NumberFormat -> NumberFormat -> Bool)
-> (NumberFormat -> NumberFormat -> Bool)
-> (NumberFormat -> NumberFormat -> Bool)
-> (NumberFormat -> NumberFormat -> NumberFormat)
-> (NumberFormat -> NumberFormat -> NumberFormat)
-> Ord NumberFormat
NumberFormat -> NumberFormat -> Bool
NumberFormat -> NumberFormat -> Ordering
NumberFormat -> NumberFormat -> NumberFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumberFormat -> NumberFormat -> NumberFormat
$cmin :: NumberFormat -> NumberFormat -> NumberFormat
max :: NumberFormat -> NumberFormat -> NumberFormat
$cmax :: NumberFormat -> NumberFormat -> NumberFormat
>= :: NumberFormat -> NumberFormat -> Bool
$c>= :: NumberFormat -> NumberFormat -> Bool
> :: NumberFormat -> NumberFormat -> Bool
$c> :: NumberFormat -> NumberFormat -> Bool
<= :: NumberFormat -> NumberFormat -> Bool
$c<= :: NumberFormat -> NumberFormat -> Bool
< :: NumberFormat -> NumberFormat -> Bool
$c< :: NumberFormat -> NumberFormat -> Bool
compare :: NumberFormat -> NumberFormat -> Ordering
$ccompare :: NumberFormat -> NumberFormat -> Ordering
$cp1Ord :: Eq NumberFormat
Ord, Int -> NumberFormat -> ShowS
[NumberFormat] -> ShowS
NumberFormat -> String
(Int -> NumberFormat -> ShowS)
-> (NumberFormat -> String)
-> ([NumberFormat] -> ShowS)
-> Show NumberFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberFormat] -> ShowS
$cshowList :: [NumberFormat] -> ShowS
show :: NumberFormat -> String
$cshow :: NumberFormat -> String
showsPrec :: Int -> NumberFormat -> ShowS
$cshowsPrec :: Int -> NumberFormat -> ShowS
Show, (forall x. NumberFormat -> Rep NumberFormat x)
-> (forall x. Rep NumberFormat x -> NumberFormat)
-> Generic NumberFormat
forall x. Rep NumberFormat x -> NumberFormat
forall x. NumberFormat -> Rep NumberFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberFormat x -> NumberFormat
$cfrom :: forall x. NumberFormat -> Rep NumberFormat x
Generic)

instance NFData NumberFormat

-- | Basic number format with predefined number of decimals
-- as format code of number format in xlsx should be less than 255 characters
-- number of decimals shouldn't be more than 253
fmtDecimals :: Int -> NumberFormat
fmtDecimals :: Int -> NumberFormat
fmtDecimals Int
k = FormatCode -> NumberFormat
UserNumberFormat (FormatCode -> NumberFormat) -> FormatCode -> NumberFormat
forall a b. (a -> b) -> a -> b
$ FormatCode
"0." FormatCode -> FormatCode -> FormatCode
forall a. Semigroup a => a -> a -> a
<> Int -> FormatCode -> FormatCode
T.replicate Int
k FormatCode
"#"

-- | Basic number format with predefined number of decimals.
-- Works like 'fmtDecimals' with the only difference that extra zeroes are
-- displayed when number of digits after the point is less than the number
-- of digits specified in the format
fmtDecimalsZeroes :: Int -> NumberFormat
fmtDecimalsZeroes :: Int -> NumberFormat
fmtDecimalsZeroes Int
k = FormatCode -> NumberFormat
UserNumberFormat (FormatCode -> NumberFormat) -> FormatCode -> NumberFormat
forall a b. (a -> b) -> a -> b
$ FormatCode
"0." FormatCode -> FormatCode -> FormatCode
forall a. Semigroup a => a -> a -> a
<> Int -> FormatCode -> FormatCode
T.replicate Int
k FormatCode
"0"

-- | Implied number formats
--
-- /Note:/ This only implements the predefined values for 18.2.30 "All Languages",
-- other built-in format ids (with id < 'firstUserNumFmtId') are stored in 'NfOtherBuiltin'
data ImpliedNumberFormat =
    NfGeneral                         -- ^> 0 General
  | NfZero                            -- ^> 1 0
  | Nf2Decimal                        -- ^> 2 0.00
  | NfMax3Decimal                     -- ^> 3 #,##0
  | NfThousandSeparator2Decimal       -- ^> 4 #,##0.00
  | NfPercent                         -- ^> 9 0%
  | NfPercent2Decimal                 -- ^> 10 0.00%
  | NfExponent2Decimal                -- ^> 11 0.00E+00
  | NfSingleSpacedFraction            -- ^> 12 # ?/?
  | NfDoubleSpacedFraction            -- ^> 13 # ??/??
  | NfMmDdYy                          -- ^> 14 mm-dd-yy
  | NfDMmmYy                          -- ^> 15 d-mmm-yy
  | NfDMmm                            -- ^> 16 d-mmm
  | NfMmmYy                           -- ^> 17 mmm-yy
  | NfHMm12Hr                         -- ^> 18 h:mm AM/PM
  | NfHMmSs12Hr                       -- ^> 19 h:mm:ss AM/PM
  | NfHMm                             -- ^> 20 h:mm
  | NfHMmSs                           -- ^> 21 h:mm:ss
  | NfMdyHMm                          -- ^> 22 m/d/yy h:mm
  | NfThousandsNegativeParens         -- ^> 37 #,##0 ;(#,##0)
  | NfThousandsNegativeRed            -- ^> 38 #,##0 ;[Red](#,##0)
  | NfThousands2DecimalNegativeParens -- ^> 39 #,##0.00;(#,##0.00)
  | NfThousands2DecimalNegativeRed    -- ^> 40 #,##0.00;[Red](#,##0.00)
  | NfMmSs                            -- ^> 45 mm:ss
  | NfOptHMmSs                        -- ^> 46 [h]:mm:ss
  | NfMmSs1Decimal                    -- ^> 47 mmss.0
  | NfExponent1Decimal                -- ^> 48 ##0.0E+0
  | NfTextPlaceHolder                 -- ^> 49 @
  | NfOtherImplied Int                -- ^ other (non local-neutral?) built-in format (id < 164)
  deriving (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
(ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> Eq ImpliedNumberFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c/= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
== :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c== :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
Eq, Eq ImpliedNumberFormat
Eq ImpliedNumberFormat
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Ordering)
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> (ImpliedNumberFormat -> ImpliedNumberFormat -> Bool)
-> (ImpliedNumberFormat
    -> ImpliedNumberFormat -> ImpliedNumberFormat)
-> (ImpliedNumberFormat
    -> ImpliedNumberFormat -> ImpliedNumberFormat)
-> Ord ImpliedNumberFormat
ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
ImpliedNumberFormat -> ImpliedNumberFormat -> Ordering
ImpliedNumberFormat -> ImpliedNumberFormat -> ImpliedNumberFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImpliedNumberFormat -> ImpliedNumberFormat -> ImpliedNumberFormat
$cmin :: ImpliedNumberFormat -> ImpliedNumberFormat -> ImpliedNumberFormat
max :: ImpliedNumberFormat -> ImpliedNumberFormat -> ImpliedNumberFormat
$cmax :: ImpliedNumberFormat -> ImpliedNumberFormat -> ImpliedNumberFormat
>= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c>= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
> :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c> :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
<= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c<= :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
< :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
$c< :: ImpliedNumberFormat -> ImpliedNumberFormat -> Bool
compare :: ImpliedNumberFormat -> ImpliedNumberFormat -> Ordering
$ccompare :: ImpliedNumberFormat -> ImpliedNumberFormat -> Ordering
$cp1Ord :: Eq ImpliedNumberFormat
Ord, Int -> ImpliedNumberFormat -> ShowS
[ImpliedNumberFormat] -> ShowS
ImpliedNumberFormat -> String
(Int -> ImpliedNumberFormat -> ShowS)
-> (ImpliedNumberFormat -> String)
-> ([ImpliedNumberFormat] -> ShowS)
-> Show ImpliedNumberFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImpliedNumberFormat] -> ShowS
$cshowList :: [ImpliedNumberFormat] -> ShowS
show :: ImpliedNumberFormat -> String
$cshow :: ImpliedNumberFormat -> String
showsPrec :: Int -> ImpliedNumberFormat -> ShowS
$cshowsPrec :: Int -> ImpliedNumberFormat -> ShowS
Show, (forall x. ImpliedNumberFormat -> Rep ImpliedNumberFormat x)
-> (forall x. Rep ImpliedNumberFormat x -> ImpliedNumberFormat)
-> Generic ImpliedNumberFormat
forall x. Rep ImpliedNumberFormat x -> ImpliedNumberFormat
forall x. ImpliedNumberFormat -> Rep ImpliedNumberFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImpliedNumberFormat x -> ImpliedNumberFormat
$cfrom :: forall x. ImpliedNumberFormat -> Rep ImpliedNumberFormat x
Generic)

instance NFData ImpliedNumberFormat

stdNumberFormatId :: ImpliedNumberFormat -> Int
stdNumberFormatId :: ImpliedNumberFormat -> Int
stdNumberFormatId ImpliedNumberFormat
NfGeneral                         = Int
0 -- General
stdNumberFormatId ImpliedNumberFormat
NfZero                            = Int
1 -- 0
stdNumberFormatId ImpliedNumberFormat
Nf2Decimal                        = Int
2 -- 0.00
stdNumberFormatId ImpliedNumberFormat
NfMax3Decimal                     = Int
3 -- #,##0
stdNumberFormatId ImpliedNumberFormat
NfThousandSeparator2Decimal       = Int
4 -- #,##0.00
stdNumberFormatId ImpliedNumberFormat
NfPercent                         = Int
9 -- 0%
stdNumberFormatId ImpliedNumberFormat
NfPercent2Decimal                 = Int
10 -- 0.00%
stdNumberFormatId ImpliedNumberFormat
NfExponent2Decimal                = Int
11 -- 0.00E+00
stdNumberFormatId ImpliedNumberFormat
NfSingleSpacedFraction            = Int
12 -- # ?/?
stdNumberFormatId ImpliedNumberFormat
NfDoubleSpacedFraction            = Int
13 -- # ??/??
stdNumberFormatId ImpliedNumberFormat
NfMmDdYy                          = Int
14 -- mm-dd-yy
stdNumberFormatId ImpliedNumberFormat
NfDMmmYy                          = Int
15 -- d-mmm-yy
stdNumberFormatId ImpliedNumberFormat
NfDMmm                            = Int
16 -- d-mmm
stdNumberFormatId ImpliedNumberFormat
NfMmmYy                           = Int
17 -- mmm-yy
stdNumberFormatId ImpliedNumberFormat
NfHMm12Hr                         = Int
18 -- h:mm AM/PM
stdNumberFormatId ImpliedNumberFormat
NfHMmSs12Hr                       = Int
19 -- h:mm:ss AM/PM
stdNumberFormatId ImpliedNumberFormat
NfHMm                             = Int
20 -- h:mm
stdNumberFormatId ImpliedNumberFormat
NfHMmSs                           = Int
21 -- h:mm:ss
stdNumberFormatId ImpliedNumberFormat
NfMdyHMm                          = Int
22 -- m/d/yy h:mm
stdNumberFormatId ImpliedNumberFormat
NfThousandsNegativeParens         = Int
37 -- #,##0 ;(#,##0)
stdNumberFormatId ImpliedNumberFormat
NfThousandsNegativeRed            = Int
38 -- #,##0 ;[Red](#,##0)
stdNumberFormatId ImpliedNumberFormat
NfThousands2DecimalNegativeParens = Int
39 -- #,##0.00;(#,##0.00)
stdNumberFormatId ImpliedNumberFormat
NfThousands2DecimalNegativeRed    = Int
40 -- #,##0.00;[Red](#,##0.00)
stdNumberFormatId ImpliedNumberFormat
NfMmSs                            = Int
45 -- mm:ss
stdNumberFormatId ImpliedNumberFormat
NfOptHMmSs                        = Int
46 -- [h]:mm:ss
stdNumberFormatId ImpliedNumberFormat
NfMmSs1Decimal                    = Int
47 -- mmss.0
stdNumberFormatId ImpliedNumberFormat
NfExponent1Decimal                = Int
48 -- ##0.0E+0
stdNumberFormatId ImpliedNumberFormat
NfTextPlaceHolder                 = Int
49 -- @
stdNumberFormatId (NfOtherImplied Int
i)                = Int
i

idToStdNumberFormat :: Int -> Maybe ImpliedNumberFormat
idToStdNumberFormat :: Int -> Maybe ImpliedNumberFormat
idToStdNumberFormat Int
0  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfGeneral                         -- General
idToStdNumberFormat Int
1  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfZero                            -- 0
idToStdNumberFormat Int
2  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
Nf2Decimal                        -- 0.00
idToStdNumberFormat Int
3  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMax3Decimal                     -- #,##0
idToStdNumberFormat Int
4  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfThousandSeparator2Decimal       -- #,##0.00
idToStdNumberFormat Int
9  = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfPercent                         -- 0%
idToStdNumberFormat Int
10 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfPercent2Decimal                 -- 0.00%
idToStdNumberFormat Int
11 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfExponent2Decimal                -- 0.00E+00
idToStdNumberFormat Int
12 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfSingleSpacedFraction            -- # ?/?
idToStdNumberFormat Int
13 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfDoubleSpacedFraction            -- # ??/??
idToStdNumberFormat Int
14 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMmDdYy                          -- mm-dd-yy
idToStdNumberFormat Int
15 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfDMmmYy                          -- d-mmm-yy
idToStdNumberFormat Int
16 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfDMmm                            -- d-mmm
idToStdNumberFormat Int
17 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMmmYy                           -- mmm-yy
idToStdNumberFormat Int
18 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfHMm12Hr                         -- h:mm AM/PM
idToStdNumberFormat Int
19 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfHMmSs12Hr                       -- h:mm:ss AM/PM
idToStdNumberFormat Int
20 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfHMm                             -- h:mm
idToStdNumberFormat Int
21 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfHMmSs                           -- h:mm:ss
idToStdNumberFormat Int
22 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMdyHMm                          -- m/d/yy h:mm
idToStdNumberFormat Int
37 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfThousandsNegativeParens         -- #,##0 ;(#,##0)
idToStdNumberFormat Int
38 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfThousandsNegativeRed            -- #,##0 ;[Red](#,##0)
idToStdNumberFormat Int
39 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfThousands2DecimalNegativeParens -- #,##0.00;(#,##0.00)
idToStdNumberFormat Int
40 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfThousands2DecimalNegativeRed    -- #,##0.00;[Red](#,##0.00)
idToStdNumberFormat Int
45 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMmSs                            -- mm:ss
idToStdNumberFormat Int
46 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfOptHMmSs                        -- [h]:mm:ss
idToStdNumberFormat Int
47 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfMmSs1Decimal                    -- mmss.0
idToStdNumberFormat Int
48 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfExponent1Decimal                -- ##0.0E+0
idToStdNumberFormat Int
49 = ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just ImpliedNumberFormat
NfTextPlaceHolder                 -- @
idToStdNumberFormat Int
i  = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
firstUserNumFmtId then ImpliedNumberFormat -> Maybe ImpliedNumberFormat
forall a. a -> Maybe a
Just (Int -> ImpliedNumberFormat
NfOtherImplied Int
i) else Maybe ImpliedNumberFormat
forall a. Maybe a
Nothing

firstUserNumFmtId :: Int
firstUserNumFmtId :: Int
firstUserNumFmtId = Int
164

-- | Protection properties
--
-- Contains protection properties associated with the cell. Each cell has
-- protection properties that can be set. The cell protection properties do not
-- take effect unless the sheet has been protected.
--
-- Section 18.8.33, "protection (Protection Properties)", p. 1793
data Protection = Protection {
    Protection -> Maybe Bool
_protectionHidden :: Maybe Bool
  , Protection -> Maybe Bool
_protectionLocked :: Maybe Bool
  }
  deriving (Protection -> Protection -> Bool
(Protection -> Protection -> Bool)
-> (Protection -> Protection -> Bool) -> Eq Protection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protection -> Protection -> Bool
$c/= :: Protection -> Protection -> Bool
== :: Protection -> Protection -> Bool
$c== :: Protection -> Protection -> Bool
Eq, Eq Protection
Eq Protection
-> (Protection -> Protection -> Ordering)
-> (Protection -> Protection -> Bool)
-> (Protection -> Protection -> Bool)
-> (Protection -> Protection -> Bool)
-> (Protection -> Protection -> Bool)
-> (Protection -> Protection -> Protection)
-> (Protection -> Protection -> Protection)
-> Ord Protection
Protection -> Protection -> Bool
Protection -> Protection -> Ordering
Protection -> Protection -> Protection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Protection -> Protection -> Protection
$cmin :: Protection -> Protection -> Protection
max :: Protection -> Protection -> Protection
$cmax :: Protection -> Protection -> Protection
>= :: Protection -> Protection -> Bool
$c>= :: Protection -> Protection -> Bool
> :: Protection -> Protection -> Bool
$c> :: Protection -> Protection -> Bool
<= :: Protection -> Protection -> Bool
$c<= :: Protection -> Protection -> Bool
< :: Protection -> Protection -> Bool
$c< :: Protection -> Protection -> Bool
compare :: Protection -> Protection -> Ordering
$ccompare :: Protection -> Protection -> Ordering
$cp1Ord :: Eq Protection
Ord, Int -> Protection -> ShowS
[Protection] -> ShowS
Protection -> String
(Int -> Protection -> ShowS)
-> (Protection -> String)
-> ([Protection] -> ShowS)
-> Show Protection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protection] -> ShowS
$cshowList :: [Protection] -> ShowS
show :: Protection -> String
$cshow :: Protection -> String
showsPrec :: Int -> Protection -> ShowS
$cshowsPrec :: Int -> Protection -> ShowS
Show, (forall x. Protection -> Rep Protection x)
-> (forall x. Rep Protection x -> Protection) -> Generic Protection
forall x. Rep Protection x -> Protection
forall x. Protection -> Rep Protection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Protection x -> Protection
$cfrom :: forall x. Protection -> Rep Protection x
Generic)
instance NFData Protection

{-------------------------------------------------------------------------------
  Enumerations
-------------------------------------------------------------------------------}

-- | Horizontal alignment in cells
--
-- See 18.18.40 "ST_HorizontalAlignment (Horizontal Alignment Type)" (p. 2459)
data CellHorizontalAlignment =
    CellHorizontalAlignmentCenter
  | CellHorizontalAlignmentCenterContinuous
  | CellHorizontalAlignmentDistributed
  | CellHorizontalAlignmentFill
  | CellHorizontalAlignmentGeneral
  | CellHorizontalAlignmentJustify
  | CellHorizontalAlignmentLeft
  | CellHorizontalAlignmentRight
  deriving (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
(CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> Eq CellHorizontalAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c/= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
== :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c== :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
Eq, Eq CellHorizontalAlignment
Eq CellHorizontalAlignment
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Ordering)
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> (CellHorizontalAlignment -> CellHorizontalAlignment -> Bool)
-> (CellHorizontalAlignment
    -> CellHorizontalAlignment -> CellHorizontalAlignment)
-> (CellHorizontalAlignment
    -> CellHorizontalAlignment -> CellHorizontalAlignment)
-> Ord CellHorizontalAlignment
CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
CellHorizontalAlignment -> CellHorizontalAlignment -> Ordering
CellHorizontalAlignment
-> CellHorizontalAlignment -> CellHorizontalAlignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CellHorizontalAlignment
-> CellHorizontalAlignment -> CellHorizontalAlignment
$cmin :: CellHorizontalAlignment
-> CellHorizontalAlignment -> CellHorizontalAlignment
max :: CellHorizontalAlignment
-> CellHorizontalAlignment -> CellHorizontalAlignment
$cmax :: CellHorizontalAlignment
-> CellHorizontalAlignment -> CellHorizontalAlignment
>= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c>= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
> :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c> :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
<= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c<= :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
< :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
$c< :: CellHorizontalAlignment -> CellHorizontalAlignment -> Bool
compare :: CellHorizontalAlignment -> CellHorizontalAlignment -> Ordering
$ccompare :: CellHorizontalAlignment -> CellHorizontalAlignment -> Ordering
$cp1Ord :: Eq CellHorizontalAlignment
Ord, Int -> CellHorizontalAlignment -> ShowS
[CellHorizontalAlignment] -> ShowS
CellHorizontalAlignment -> String
(Int -> CellHorizontalAlignment -> ShowS)
-> (CellHorizontalAlignment -> String)
-> ([CellHorizontalAlignment] -> ShowS)
-> Show CellHorizontalAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellHorizontalAlignment] -> ShowS
$cshowList :: [CellHorizontalAlignment] -> ShowS
show :: CellHorizontalAlignment -> String
$cshow :: CellHorizontalAlignment -> String
showsPrec :: Int -> CellHorizontalAlignment -> ShowS
$cshowsPrec :: Int -> CellHorizontalAlignment -> ShowS
Show, (forall x.
 CellHorizontalAlignment -> Rep CellHorizontalAlignment x)
-> (forall x.
    Rep CellHorizontalAlignment x -> CellHorizontalAlignment)
-> Generic CellHorizontalAlignment
forall x. Rep CellHorizontalAlignment x -> CellHorizontalAlignment
forall x. CellHorizontalAlignment -> Rep CellHorizontalAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellHorizontalAlignment x -> CellHorizontalAlignment
$cfrom :: forall x. CellHorizontalAlignment -> Rep CellHorizontalAlignment x
Generic)
instance NFData CellHorizontalAlignment

-- | Vertical alignment in cells
--
-- See 18.18.88 "ST_VerticalAlignment (Vertical Alignment Types)" (p. 2512)
data CellVerticalAlignment =
    CellVerticalAlignmentBottom
  | CellVerticalAlignmentCenter
  | CellVerticalAlignmentDistributed
  | CellVerticalAlignmentJustify
  | CellVerticalAlignmentTop
  deriving (CellVerticalAlignment -> CellVerticalAlignment -> Bool
(CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> (CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> Eq CellVerticalAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c/= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
== :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c== :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
Eq, Eq CellVerticalAlignment
Eq CellVerticalAlignment
-> (CellVerticalAlignment -> CellVerticalAlignment -> Ordering)
-> (CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> (CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> (CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> (CellVerticalAlignment -> CellVerticalAlignment -> Bool)
-> (CellVerticalAlignment
    -> CellVerticalAlignment -> CellVerticalAlignment)
-> (CellVerticalAlignment
    -> CellVerticalAlignment -> CellVerticalAlignment)
-> Ord CellVerticalAlignment
CellVerticalAlignment -> CellVerticalAlignment -> Bool
CellVerticalAlignment -> CellVerticalAlignment -> Ordering
CellVerticalAlignment
-> CellVerticalAlignment -> CellVerticalAlignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CellVerticalAlignment
-> CellVerticalAlignment -> CellVerticalAlignment
$cmin :: CellVerticalAlignment
-> CellVerticalAlignment -> CellVerticalAlignment
max :: CellVerticalAlignment
-> CellVerticalAlignment -> CellVerticalAlignment
$cmax :: CellVerticalAlignment
-> CellVerticalAlignment -> CellVerticalAlignment
>= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c>= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
> :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c> :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
<= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c<= :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
< :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
$c< :: CellVerticalAlignment -> CellVerticalAlignment -> Bool
compare :: CellVerticalAlignment -> CellVerticalAlignment -> Ordering
$ccompare :: CellVerticalAlignment -> CellVerticalAlignment -> Ordering
$cp1Ord :: Eq CellVerticalAlignment
Ord, Int -> CellVerticalAlignment -> ShowS
[CellVerticalAlignment] -> ShowS
CellVerticalAlignment -> String
(Int -> CellVerticalAlignment -> ShowS)
-> (CellVerticalAlignment -> String)
-> ([CellVerticalAlignment] -> ShowS)
-> Show CellVerticalAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellVerticalAlignment] -> ShowS
$cshowList :: [CellVerticalAlignment] -> ShowS
show :: CellVerticalAlignment -> String
$cshow :: CellVerticalAlignment -> String
showsPrec :: Int -> CellVerticalAlignment -> ShowS
$cshowsPrec :: Int -> CellVerticalAlignment -> ShowS
Show, (forall x. CellVerticalAlignment -> Rep CellVerticalAlignment x)
-> (forall x. Rep CellVerticalAlignment x -> CellVerticalAlignment)
-> Generic CellVerticalAlignment
forall x. Rep CellVerticalAlignment x -> CellVerticalAlignment
forall x. CellVerticalAlignment -> Rep CellVerticalAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellVerticalAlignment x -> CellVerticalAlignment
$cfrom :: forall x. CellVerticalAlignment -> Rep CellVerticalAlignment x
Generic)
instance NFData CellVerticalAlignment

-- | Font family
--
-- See 18.8.18 "family (Font Family)" (p. 1766)
-- and 17.18.30 "ST_FontFamily (Font Family Value)" (p. 1388)
data FontFamily =
    -- | Family is not applicable
    FontFamilyNotApplicable

    -- | Proportional font with serifs
  | FontFamilyRoman

    -- | Proportional font without serifs
  | FontFamilySwiss

    -- | Monospace font with or without serifs
  | FontFamilyModern

    -- | Script font designed to mimic the appearance of handwriting
  | FontFamilyScript

    -- | Novelty font
  | FontFamilyDecorative
  deriving (FontFamily -> FontFamily -> Bool
(FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool) -> Eq FontFamily
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c== :: FontFamily -> FontFamily -> Bool
Eq, Eq FontFamily
Eq FontFamily
-> (FontFamily -> FontFamily -> Ordering)
-> (FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> FontFamily)
-> (FontFamily -> FontFamily -> FontFamily)
-> Ord FontFamily
FontFamily -> FontFamily -> Bool
FontFamily -> FontFamily -> Ordering
FontFamily -> FontFamily -> FontFamily
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontFamily -> FontFamily -> FontFamily
$cmin :: FontFamily -> FontFamily -> FontFamily
max :: FontFamily -> FontFamily -> FontFamily
$cmax :: FontFamily -> FontFamily -> FontFamily
>= :: FontFamily -> FontFamily -> Bool
$c>= :: FontFamily -> FontFamily -> Bool
> :: FontFamily -> FontFamily -> Bool
$c> :: FontFamily -> FontFamily -> Bool
<= :: FontFamily -> FontFamily -> Bool
$c<= :: FontFamily -> FontFamily -> Bool
< :: FontFamily -> FontFamily -> Bool
$c< :: FontFamily -> FontFamily -> Bool
compare :: FontFamily -> FontFamily -> Ordering
$ccompare :: FontFamily -> FontFamily -> Ordering
$cp1Ord :: Eq FontFamily
Ord, Int -> FontFamily -> ShowS
[FontFamily] -> ShowS
FontFamily -> String
(Int -> FontFamily -> ShowS)
-> (FontFamily -> String)
-> ([FontFamily] -> ShowS)
-> Show FontFamily
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontFamily] -> ShowS
$cshowList :: [FontFamily] -> ShowS
show :: FontFamily -> String
$cshow :: FontFamily -> String
showsPrec :: Int -> FontFamily -> ShowS
$cshowsPrec :: Int -> FontFamily -> ShowS
Show, (forall x. FontFamily -> Rep FontFamily x)
-> (forall x. Rep FontFamily x -> FontFamily) -> Generic FontFamily
forall x. Rep FontFamily x -> FontFamily
forall x. FontFamily -> Rep FontFamily x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontFamily x -> FontFamily
$cfrom :: forall x. FontFamily -> Rep FontFamily x
Generic)
instance NFData FontFamily

-- | Font scheme
--
-- See 18.18.33 "ST_FontScheme (Font scheme Styles)" (p. 2456)
data FontScheme =
    -- | This font is the major font for this theme.
    FontSchemeMajor

    -- | This font is the minor font for this theme.
  | FontSchemeMinor

    -- | This font is not a theme font.
  | FontSchemeNone
  deriving (FontScheme -> FontScheme -> Bool
(FontScheme -> FontScheme -> Bool)
-> (FontScheme -> FontScheme -> Bool) -> Eq FontScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontScheme -> FontScheme -> Bool
$c/= :: FontScheme -> FontScheme -> Bool
== :: FontScheme -> FontScheme -> Bool
$c== :: FontScheme -> FontScheme -> Bool
Eq, Eq FontScheme
Eq FontScheme
-> (FontScheme -> FontScheme -> Ordering)
-> (FontScheme -> FontScheme -> Bool)
-> (FontScheme -> FontScheme -> Bool)
-> (FontScheme -> FontScheme -> Bool)
-> (FontScheme -> FontScheme -> Bool)
-> (FontScheme -> FontScheme -> FontScheme)
-> (FontScheme -> FontScheme -> FontScheme)
-> Ord FontScheme
FontScheme -> FontScheme -> Bool
FontScheme -> FontScheme -> Ordering
FontScheme -> FontScheme -> FontScheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontScheme -> FontScheme -> FontScheme
$cmin :: FontScheme -> FontScheme -> FontScheme
max :: FontScheme -> FontScheme -> FontScheme
$cmax :: FontScheme -> FontScheme -> FontScheme
>= :: FontScheme -> FontScheme -> Bool
$c>= :: FontScheme -> FontScheme -> Bool
> :: FontScheme -> FontScheme -> Bool
$c> :: FontScheme -> FontScheme -> Bool
<= :: FontScheme -> FontScheme -> Bool
$c<= :: FontScheme -> FontScheme -> Bool
< :: FontScheme -> FontScheme -> Bool
$c< :: FontScheme -> FontScheme -> Bool
compare :: FontScheme -> FontScheme -> Ordering
$ccompare :: FontScheme -> FontScheme -> Ordering
$cp1Ord :: Eq FontScheme
Ord, Int -> FontScheme -> ShowS
[FontScheme] -> ShowS
FontScheme -> String
(Int -> FontScheme -> ShowS)
-> (FontScheme -> String)
-> ([FontScheme] -> ShowS)
-> Show FontScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontScheme] -> ShowS
$cshowList :: [FontScheme] -> ShowS
show :: FontScheme -> String
$cshow :: FontScheme -> String
showsPrec :: Int -> FontScheme -> ShowS
$cshowsPrec :: Int -> FontScheme -> ShowS
Show, (forall x. FontScheme -> Rep FontScheme x)
-> (forall x. Rep FontScheme x -> FontScheme) -> Generic FontScheme
forall x. Rep FontScheme x -> FontScheme
forall x. FontScheme -> Rep FontScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontScheme x -> FontScheme
$cfrom :: forall x. FontScheme -> Rep FontScheme x
Generic)
instance NFData FontScheme

-- | Font underline property
--
-- See 18.4.13 "u (Underline)", p 1728
data FontUnderline =
    FontUnderlineSingle
  | FontUnderlineDouble
  | FontUnderlineSingleAccounting
  | FontUnderlineDoubleAccounting
  | FontUnderlineNone
  deriving (FontUnderline -> FontUnderline -> Bool
(FontUnderline -> FontUnderline -> Bool)
-> (FontUnderline -> FontUnderline -> Bool) -> Eq FontUnderline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontUnderline -> FontUnderline -> Bool
$c/= :: FontUnderline -> FontUnderline -> Bool
== :: FontUnderline -> FontUnderline -> Bool
$c== :: FontUnderline -> FontUnderline -> Bool
Eq, Eq FontUnderline
Eq FontUnderline
-> (FontUnderline -> FontUnderline -> Ordering)
-> (FontUnderline -> FontUnderline -> Bool)
-> (FontUnderline -> FontUnderline -> Bool)
-> (FontUnderline -> FontUnderline -> Bool)
-> (FontUnderline -> FontUnderline -> Bool)
-> (FontUnderline -> FontUnderline -> FontUnderline)
-> (FontUnderline -> FontUnderline -> FontUnderline)
-> Ord FontUnderline
FontUnderline -> FontUnderline -> Bool
FontUnderline -> FontUnderline -> Ordering
FontUnderline -> FontUnderline -> FontUnderline
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontUnderline -> FontUnderline -> FontUnderline
$cmin :: FontUnderline -> FontUnderline -> FontUnderline
max :: FontUnderline -> FontUnderline -> FontUnderline
$cmax :: FontUnderline -> FontUnderline -> FontUnderline
>= :: FontUnderline -> FontUnderline -> Bool
$c>= :: FontUnderline -> FontUnderline -> Bool
> :: FontUnderline -> FontUnderline -> Bool
$c> :: FontUnderline -> FontUnderline -> Bool
<= :: FontUnderline -> FontUnderline -> Bool
$c<= :: FontUnderline -> FontUnderline -> Bool
< :: FontUnderline -> FontUnderline -> Bool
$c< :: FontUnderline -> FontUnderline -> Bool
compare :: FontUnderline -> FontUnderline -> Ordering
$ccompare :: FontUnderline -> FontUnderline -> Ordering
$cp1Ord :: Eq FontUnderline
Ord, Int -> FontUnderline -> ShowS
[FontUnderline] -> ShowS
FontUnderline -> String
(Int -> FontUnderline -> ShowS)
-> (FontUnderline -> String)
-> ([FontUnderline] -> ShowS)
-> Show FontUnderline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontUnderline] -> ShowS
$cshowList :: [FontUnderline] -> ShowS
show :: FontUnderline -> String
$cshow :: FontUnderline -> String
showsPrec :: Int -> FontUnderline -> ShowS
$cshowsPrec :: Int -> FontUnderline -> ShowS
Show, (forall x. FontUnderline -> Rep FontUnderline x)
-> (forall x. Rep FontUnderline x -> FontUnderline)
-> Generic FontUnderline
forall x. Rep FontUnderline x -> FontUnderline
forall x. FontUnderline -> Rep FontUnderline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontUnderline x -> FontUnderline
$cfrom :: forall x. FontUnderline -> Rep FontUnderline x
Generic)
instance NFData FontUnderline

-- | Vertical alignment
--
-- See 22.9.2.17 "ST_VerticalAlignRun (Vertical Positioning Location)" (p. 3794)
data FontVerticalAlignment =
    FontVerticalAlignmentBaseline
  | FontVerticalAlignmentSubscript
  | FontVerticalAlignmentSuperscript
  deriving (FontVerticalAlignment -> FontVerticalAlignment -> Bool
(FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> (FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> Eq FontVerticalAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c/= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
== :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c== :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
Eq, Eq FontVerticalAlignment
Eq FontVerticalAlignment
-> (FontVerticalAlignment -> FontVerticalAlignment -> Ordering)
-> (FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> (FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> (FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> (FontVerticalAlignment -> FontVerticalAlignment -> Bool)
-> (FontVerticalAlignment
    -> FontVerticalAlignment -> FontVerticalAlignment)
-> (FontVerticalAlignment
    -> FontVerticalAlignment -> FontVerticalAlignment)
-> Ord FontVerticalAlignment
FontVerticalAlignment -> FontVerticalAlignment -> Bool
FontVerticalAlignment -> FontVerticalAlignment -> Ordering
FontVerticalAlignment
-> FontVerticalAlignment -> FontVerticalAlignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontVerticalAlignment
-> FontVerticalAlignment -> FontVerticalAlignment
$cmin :: FontVerticalAlignment
-> FontVerticalAlignment -> FontVerticalAlignment
max :: FontVerticalAlignment
-> FontVerticalAlignment -> FontVerticalAlignment
$cmax :: FontVerticalAlignment
-> FontVerticalAlignment -> FontVerticalAlignment
>= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c>= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
> :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c> :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
<= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c<= :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
< :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
$c< :: FontVerticalAlignment -> FontVerticalAlignment -> Bool
compare :: FontVerticalAlignment -> FontVerticalAlignment -> Ordering
$ccompare :: FontVerticalAlignment -> FontVerticalAlignment -> Ordering
$cp1Ord :: Eq FontVerticalAlignment
Ord, Int -> FontVerticalAlignment -> ShowS
[FontVerticalAlignment] -> ShowS
FontVerticalAlignment -> String
(Int -> FontVerticalAlignment -> ShowS)
-> (FontVerticalAlignment -> String)
-> ([FontVerticalAlignment] -> ShowS)
-> Show FontVerticalAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontVerticalAlignment] -> ShowS
$cshowList :: [FontVerticalAlignment] -> ShowS
show :: FontVerticalAlignment -> String
$cshow :: FontVerticalAlignment -> String
showsPrec :: Int -> FontVerticalAlignment -> ShowS
$cshowsPrec :: Int -> FontVerticalAlignment -> ShowS
Show, (forall x. FontVerticalAlignment -> Rep FontVerticalAlignment x)
-> (forall x. Rep FontVerticalAlignment x -> FontVerticalAlignment)
-> Generic FontVerticalAlignment
forall x. Rep FontVerticalAlignment x -> FontVerticalAlignment
forall x. FontVerticalAlignment -> Rep FontVerticalAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontVerticalAlignment x -> FontVerticalAlignment
$cfrom :: forall x. FontVerticalAlignment -> Rep FontVerticalAlignment x
Generic)
instance NFData FontVerticalAlignment

data LineStyle =
    LineStyleDashDot
  | LineStyleDashDotDot
  | LineStyleDashed
  | LineStyleDotted
  | LineStyleDouble
  | LineStyleHair
  | LineStyleMedium
  | LineStyleMediumDashDot
  | LineStyleMediumDashDotDot
  | LineStyleMediumDashed
  | LineStyleNone
  | LineStyleSlantDashDot
  | LineStyleThick
  | LineStyleThin
  deriving (LineStyle -> LineStyle -> Bool
(LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool) -> Eq LineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq, Eq LineStyle
Eq LineStyle
-> (LineStyle -> LineStyle -> Ordering)
-> (LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> LineStyle)
-> (LineStyle -> LineStyle -> LineStyle)
-> Ord LineStyle
LineStyle -> LineStyle -> Bool
LineStyle -> LineStyle -> Ordering
LineStyle -> LineStyle -> LineStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineStyle -> LineStyle -> LineStyle
$cmin :: LineStyle -> LineStyle -> LineStyle
max :: LineStyle -> LineStyle -> LineStyle
$cmax :: LineStyle -> LineStyle -> LineStyle
>= :: LineStyle -> LineStyle -> Bool
$c>= :: LineStyle -> LineStyle -> Bool
> :: LineStyle -> LineStyle -> Bool
$c> :: LineStyle -> LineStyle -> Bool
<= :: LineStyle -> LineStyle -> Bool
$c<= :: LineStyle -> LineStyle -> Bool
< :: LineStyle -> LineStyle -> Bool
$c< :: LineStyle -> LineStyle -> Bool
compare :: LineStyle -> LineStyle -> Ordering
$ccompare :: LineStyle -> LineStyle -> Ordering
$cp1Ord :: Eq LineStyle
Ord, Int -> LineStyle -> ShowS
[LineStyle] -> ShowS
LineStyle -> String
(Int -> LineStyle -> ShowS)
-> (LineStyle -> String)
-> ([LineStyle] -> ShowS)
-> Show LineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineStyle] -> ShowS
$cshowList :: [LineStyle] -> ShowS
show :: LineStyle -> String
$cshow :: LineStyle -> String
showsPrec :: Int -> LineStyle -> ShowS
$cshowsPrec :: Int -> LineStyle -> ShowS
Show, (forall x. LineStyle -> Rep LineStyle x)
-> (forall x. Rep LineStyle x -> LineStyle) -> Generic LineStyle
forall x. Rep LineStyle x -> LineStyle
forall x. LineStyle -> Rep LineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineStyle x -> LineStyle
$cfrom :: forall x. LineStyle -> Rep LineStyle x
Generic)
instance NFData LineStyle

-- | Indicates the style of fill pattern being used for a cell format.
--
-- Section 18.18.55 "ST_PatternType (Pattern Type)" (p. 2472)
data PatternType =
    PatternTypeDarkDown
  | PatternTypeDarkGray
  | PatternTypeDarkGrid
  | PatternTypeDarkHorizontal
  | PatternTypeDarkTrellis
  | PatternTypeDarkUp
  | PatternTypeDarkVertical
  | PatternTypeGray0625
  | PatternTypeGray125
  | PatternTypeLightDown
  | PatternTypeLightGray
  | PatternTypeLightGrid
  | PatternTypeLightHorizontal
  | PatternTypeLightTrellis
  | PatternTypeLightUp
  | PatternTypeLightVertical
  | PatternTypeMediumGray
  | PatternTypeNone
  | PatternTypeSolid
  deriving (PatternType -> PatternType -> Bool
(PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> Bool) -> Eq PatternType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternType -> PatternType -> Bool
$c/= :: PatternType -> PatternType -> Bool
== :: PatternType -> PatternType -> Bool
$c== :: PatternType -> PatternType -> Bool
Eq, Eq PatternType
Eq PatternType
-> (PatternType -> PatternType -> Ordering)
-> (PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> Bool)
-> (PatternType -> PatternType -> PatternType)
-> (PatternType -> PatternType -> PatternType)
-> Ord PatternType
PatternType -> PatternType -> Bool
PatternType -> PatternType -> Ordering
PatternType -> PatternType -> PatternType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PatternType -> PatternType -> PatternType
$cmin :: PatternType -> PatternType -> PatternType
max :: PatternType -> PatternType -> PatternType
$cmax :: PatternType -> PatternType -> PatternType
>= :: PatternType -> PatternType -> Bool
$c>= :: PatternType -> PatternType -> Bool
> :: PatternType -> PatternType -> Bool
$c> :: PatternType -> PatternType -> Bool
<= :: PatternType -> PatternType -> Bool
$c<= :: PatternType -> PatternType -> Bool
< :: PatternType -> PatternType -> Bool
$c< :: PatternType -> PatternType -> Bool
compare :: PatternType -> PatternType -> Ordering
$ccompare :: PatternType -> PatternType -> Ordering
$cp1Ord :: Eq PatternType
Ord, Int -> PatternType -> ShowS
[PatternType] -> ShowS
PatternType -> String
(Int -> PatternType -> ShowS)
-> (PatternType -> String)
-> ([PatternType] -> ShowS)
-> Show PatternType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatternType] -> ShowS
$cshowList :: [PatternType] -> ShowS
show :: PatternType -> String
$cshow :: PatternType -> String
showsPrec :: Int -> PatternType -> ShowS
$cshowsPrec :: Int -> PatternType -> ShowS
Show, (forall x. PatternType -> Rep PatternType x)
-> (forall x. Rep PatternType x -> PatternType)
-> Generic PatternType
forall x. Rep PatternType x -> PatternType
forall x. PatternType -> Rep PatternType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PatternType x -> PatternType
$cfrom :: forall x. PatternType -> Rep PatternType x
Generic)
instance NFData PatternType

-- | Reading order
--
-- See 18.8.1 "alignment (Alignment)" (p. 1754, esp. p. 1755)
data ReadingOrder =
    ReadingOrderContextDependent
  | ReadingOrderLeftToRight
  | ReadingOrderRightToLeft
  deriving (ReadingOrder -> ReadingOrder -> Bool
(ReadingOrder -> ReadingOrder -> Bool)
-> (ReadingOrder -> ReadingOrder -> Bool) -> Eq ReadingOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadingOrder -> ReadingOrder -> Bool
$c/= :: ReadingOrder -> ReadingOrder -> Bool
== :: ReadingOrder -> ReadingOrder -> Bool
$c== :: ReadingOrder -> ReadingOrder -> Bool
Eq, Eq ReadingOrder
Eq ReadingOrder
-> (ReadingOrder -> ReadingOrder -> Ordering)
-> (ReadingOrder -> ReadingOrder -> Bool)
-> (ReadingOrder -> ReadingOrder -> Bool)
-> (ReadingOrder -> ReadingOrder -> Bool)
-> (ReadingOrder -> ReadingOrder -> Bool)
-> (ReadingOrder -> ReadingOrder -> ReadingOrder)
-> (ReadingOrder -> ReadingOrder -> ReadingOrder)
-> Ord ReadingOrder
ReadingOrder -> ReadingOrder -> Bool
ReadingOrder -> ReadingOrder -> Ordering
ReadingOrder -> ReadingOrder -> ReadingOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadingOrder -> ReadingOrder -> ReadingOrder
$cmin :: ReadingOrder -> ReadingOrder -> ReadingOrder
max :: ReadingOrder -> ReadingOrder -> ReadingOrder
$cmax :: ReadingOrder -> ReadingOrder -> ReadingOrder
>= :: ReadingOrder -> ReadingOrder -> Bool
$c>= :: ReadingOrder -> ReadingOrder -> Bool
> :: ReadingOrder -> ReadingOrder -> Bool
$c> :: ReadingOrder -> ReadingOrder -> Bool
<= :: ReadingOrder -> ReadingOrder -> Bool
$c<= :: ReadingOrder -> ReadingOrder -> Bool
< :: ReadingOrder -> ReadingOrder -> Bool
$c< :: ReadingOrder -> ReadingOrder -> Bool
compare :: ReadingOrder -> ReadingOrder -> Ordering
$ccompare :: ReadingOrder -> ReadingOrder -> Ordering
$cp1Ord :: Eq ReadingOrder
Ord, Int -> ReadingOrder -> ShowS
[ReadingOrder] -> ShowS
ReadingOrder -> String
(Int -> ReadingOrder -> ShowS)
-> (ReadingOrder -> String)
-> ([ReadingOrder] -> ShowS)
-> Show ReadingOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadingOrder] -> ShowS
$cshowList :: [ReadingOrder] -> ShowS
show :: ReadingOrder -> String
$cshow :: ReadingOrder -> String
showsPrec :: Int -> ReadingOrder -> ShowS
$cshowsPrec :: Int -> ReadingOrder -> ShowS
Show, (forall x. ReadingOrder -> Rep ReadingOrder x)
-> (forall x. Rep ReadingOrder x -> ReadingOrder)
-> Generic ReadingOrder
forall x. Rep ReadingOrder x -> ReadingOrder
forall x. ReadingOrder -> Rep ReadingOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadingOrder x -> ReadingOrder
$cfrom :: forall x. ReadingOrder -> Rep ReadingOrder x
Generic)
instance NFData ReadingOrder

{-------------------------------------------------------------------------------
  Lenses
-------------------------------------------------------------------------------}

makeLenses ''StyleSheet
makeLenses ''CellXf
makeLenses ''Dxf

makeLenses ''Alignment
makeLenses ''Border
makeLenses ''BorderStyle
makeLenses ''Color
makeLenses ''Fill
makeLenses ''FillPattern
makeLenses ''Font
makeLenses ''Protection

{-------------------------------------------------------------------------------
  Minimal stylesheet
-------------------------------------------------------------------------------}

-- | Minimal style sheet
--
-- Excel expects some minimal definitions in the stylesheet; you probably want
-- to define your own stylesheets based on this one.
--
-- This more-or-less follows the recommendations at
-- <http://stackoverflow.com/questions/26050708/minimal-style-sheet-for-excel-open-xml-with-dates>,
-- but with some additions based on experimental evidence.
minimalStyleSheet :: StyleSheet
minimalStyleSheet :: StyleSheet
minimalStyleSheet = StyleSheet
forall a. Default a => a
def
    StyleSheet -> (StyleSheet -> StyleSheet) -> StyleSheet
forall a b. a -> (a -> b) -> b
& ([Border] -> Identity [Border])
-> StyleSheet -> Identity StyleSheet
Lens' StyleSheet [Border]
styleSheetBorders (([Border] -> Identity [Border])
 -> StyleSheet -> Identity StyleSheet)
-> [Border] -> StyleSheet -> StyleSheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Border
defaultBorder]
    StyleSheet -> (StyleSheet -> StyleSheet) -> StyleSheet
forall a b. a -> (a -> b) -> b
& ([Font] -> Identity [Font]) -> StyleSheet -> Identity StyleSheet
Lens' StyleSheet [Font]
styleSheetFonts   (([Font] -> Identity [Font]) -> StyleSheet -> Identity StyleSheet)
-> [Font] -> StyleSheet -> StyleSheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Font
defaultFont]
    StyleSheet -> (StyleSheet -> StyleSheet) -> StyleSheet
forall a b. a -> (a -> b) -> b
& ([Fill] -> Identity [Fill]) -> StyleSheet -> Identity StyleSheet
Lens' StyleSheet [Fill]
styleSheetFills   (([Fill] -> Identity [Fill]) -> StyleSheet -> Identity StyleSheet)
-> [Fill] -> StyleSheet -> StyleSheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Fill
fillNone, Fill
fillGray125]
    StyleSheet -> (StyleSheet -> StyleSheet) -> StyleSheet
forall a b. a -> (a -> b) -> b
& ([CellXf] -> Identity [CellXf])
-> StyleSheet -> Identity StyleSheet
Lens' StyleSheet [CellXf]
styleSheetCellXfs (([CellXf] -> Identity [CellXf])
 -> StyleSheet -> Identity StyleSheet)
-> [CellXf] -> StyleSheet -> StyleSheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [CellXf
defaultCellXf]
  where
    -- The 'Default' instance for 'Border' uses 'left' and 'right' rather than
    -- 'start' and 'end', because this is what Excel does (even though the spec
    -- says different)
    defaultBorder :: Border
    defaultBorder :: Border
defaultBorder = 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)
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
.~ BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
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
.~ BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
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)
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
.~ BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
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)
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
.~ BorderStyle -> Maybe BorderStyle
forall a. a -> Maybe a
Just BorderStyle
forall a. Default a => a
def

    defaultFont :: Font
    defaultFont :: Font
defaultFont = Font
forall a. Default a => a
def
      Font -> (Font -> Font) -> Font
forall a b. a -> (a -> b) -> b
& (Maybe FontFamily -> Identity (Maybe FontFamily))
-> Font -> Identity Font
Lens' Font (Maybe FontFamily)
fontFamily ((Maybe FontFamily -> Identity (Maybe FontFamily))
 -> Font -> Identity Font)
-> Maybe FontFamily -> Font -> Font
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontFamily -> Maybe FontFamily
forall a. a -> Maybe a
Just FontFamily
FontFamilySwiss
      Font -> (Font -> Font) -> Font
forall a b. a -> (a -> b) -> b
& (Maybe Double -> Identity (Maybe Double)) -> Font -> Identity Font
Lens' Font (Maybe Double)
fontSize   ((Maybe Double -> Identity (Maybe Double))
 -> Font -> Identity Font)
-> Maybe Double -> Font -> Font
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
11

    fillNone, fillGray125 :: Fill
    fillNone :: Fill
fillNone = Fill
forall a. Default a => a
def
      Fill -> (Fill -> Fill) -> Fill
forall a b. a -> (a -> b) -> b
& (Maybe FillPattern -> Identity (Maybe FillPattern))
-> Fill -> Identity Fill
Iso' Fill (Maybe FillPattern)
fillPattern ((Maybe FillPattern -> Identity (Maybe FillPattern))
 -> Fill -> Identity Fill)
-> Maybe FillPattern -> Fill -> Fill
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FillPattern -> Maybe FillPattern
forall a. a -> Maybe a
Just (FillPattern
forall a. Default a => a
def FillPattern -> (FillPattern -> FillPattern) -> FillPattern
forall a b. a -> (a -> b) -> b
& (Maybe PatternType -> Identity (Maybe PatternType))
-> FillPattern -> Identity FillPattern
Lens' FillPattern (Maybe PatternType)
fillPatternType ((Maybe PatternType -> Identity (Maybe PatternType))
 -> FillPattern -> Identity FillPattern)
-> Maybe PatternType -> FillPattern -> FillPattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
PatternTypeNone)
    fillGray125 :: Fill
fillGray125 = Fill
forall a. Default a => a
def
      Fill -> (Fill -> Fill) -> Fill
forall a b. a -> (a -> b) -> b
& (Maybe FillPattern -> Identity (Maybe FillPattern))
-> Fill -> Identity Fill
Iso' Fill (Maybe FillPattern)
fillPattern ((Maybe FillPattern -> Identity (Maybe FillPattern))
 -> Fill -> Identity Fill)
-> Maybe FillPattern -> Fill -> Fill
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FillPattern -> Maybe FillPattern
forall a. a -> Maybe a
Just (FillPattern
forall a. Default a => a
def FillPattern -> (FillPattern -> FillPattern) -> FillPattern
forall a b. a -> (a -> b) -> b
& (Maybe PatternType -> Identity (Maybe PatternType))
-> FillPattern -> Identity FillPattern
Lens' FillPattern (Maybe PatternType)
fillPatternType ((Maybe PatternType -> Identity (Maybe PatternType))
 -> FillPattern -> Identity FillPattern)
-> Maybe PatternType -> FillPattern -> FillPattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PatternType -> Maybe PatternType
forall a. a -> Maybe a
Just PatternType
PatternTypeGray125)

    defaultCellXf :: CellXf
    defaultCellXf :: CellXf
defaultCellXf = CellXf
forall a. Default a => a
def
      CellXf -> (CellXf -> CellXf) -> CellXf
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf
Lens' CellXf (Maybe Int)
cellXfBorderId ((Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf)
-> Maybe Int -> CellXf -> CellXf
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      CellXf -> (CellXf -> CellXf) -> CellXf
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf
Lens' CellXf (Maybe Int)
cellXfFillId   ((Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf)
-> Maybe Int -> CellXf -> CellXf
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
      CellXf -> (CellXf -> CellXf) -> CellXf
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf
Lens' CellXf (Maybe Int)
cellXfFontId   ((Maybe Int -> Identity (Maybe Int)) -> CellXf -> Identity CellXf)
-> Maybe Int -> CellXf -> CellXf
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0

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

instance Default StyleSheet where
  def :: StyleSheet
def = StyleSheet :: [Border]
-> [CellXf]
-> [Fill]
-> [Font]
-> [Dxf]
-> Map Int FormatCode
-> StyleSheet
StyleSheet {
      _styleSheetBorders :: [Border]
_styleSheetBorders = []
    , _styleSheetFonts :: [Font]
_styleSheetFonts   = []
    , _styleSheetFills :: [Fill]
_styleSheetFills   = []
    , _styleSheetCellXfs :: [CellXf]
_styleSheetCellXfs = []
    , _styleSheetDxfs :: [Dxf]
_styleSheetDxfs    = []
    , _styleSheetNumFmts :: Map Int FormatCode
_styleSheetNumFmts = Map Int FormatCode
forall k a. Map k a
M.empty
    }

instance Default CellXf where
  def :: CellXf
def = 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 Bool
forall a. Maybe a
Nothing
    , _cellXfApplyBorder :: Maybe Bool
_cellXfApplyBorder       = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfApplyFill :: Maybe Bool
_cellXfApplyFill         = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfApplyFont :: Maybe Bool
_cellXfApplyFont         = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfApplyNumberFormat :: Maybe Bool
_cellXfApplyNumberFormat = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfApplyProtection :: Maybe Bool
_cellXfApplyProtection   = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfBorderId :: Maybe Int
_cellXfBorderId          = Maybe Int
forall a. Maybe a
Nothing
    , _cellXfFillId :: Maybe Int
_cellXfFillId            = Maybe Int
forall a. Maybe a
Nothing
    , _cellXfFontId :: Maybe Int
_cellXfFontId            = Maybe Int
forall a. Maybe a
Nothing
    , _cellXfNumFmtId :: Maybe Int
_cellXfNumFmtId          = Maybe Int
forall a. Maybe a
Nothing
    , _cellXfPivotButton :: Maybe Bool
_cellXfPivotButton       = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfQuotePrefix :: Maybe Bool
_cellXfQuotePrefix       = Maybe Bool
forall a. Maybe a
Nothing
    , _cellXfId :: Maybe Int
_cellXfId                = Maybe Int
forall a. Maybe a
Nothing
    , _cellXfAlignment :: Maybe Alignment
_cellXfAlignment         = Maybe Alignment
forall a. Maybe a
Nothing
    , _cellXfProtection :: Maybe Protection
_cellXfProtection        = Maybe Protection
forall a. Maybe a
Nothing
    }

instance Default Dxf where
    def :: Dxf
def = Dxf :: Maybe Font
-> Maybe NumFmt
-> Maybe Fill
-> Maybe Alignment
-> Maybe Border
-> Maybe Protection
-> Dxf
Dxf
          { _dxfFont :: Maybe Font
_dxfFont       = Maybe Font
forall a. Maybe a
Nothing
          , _dxfNumFmt :: Maybe NumFmt
_dxfNumFmt     = Maybe NumFmt
forall a. Maybe a
Nothing
          , _dxfFill :: Maybe Fill
_dxfFill       = Maybe Fill
forall a. Maybe a
Nothing
          , _dxfAlignment :: Maybe Alignment
_dxfAlignment  = Maybe Alignment
forall a. Maybe a
Nothing
          , _dxfBorder :: Maybe Border
_dxfBorder     = Maybe Border
forall a. Maybe a
Nothing
          , _dxfProtection :: Maybe Protection
_dxfProtection = Maybe Protection
forall a. Maybe a
Nothing
          }

instance Default Alignment where
  def :: Alignment
def = Alignment :: Maybe CellHorizontalAlignment
-> Maybe Int
-> Maybe Bool
-> Maybe ReadingOrder
-> Maybe Int
-> Maybe Bool
-> Maybe Int
-> Maybe CellVerticalAlignment
-> Maybe Bool
-> Alignment
Alignment {
     _alignmentHorizontal :: Maybe CellHorizontalAlignment
_alignmentHorizontal      = Maybe CellHorizontalAlignment
forall a. Maybe a
Nothing
   , _alignmentIndent :: Maybe Int
_alignmentIndent          = Maybe Int
forall a. Maybe a
Nothing
   , _alignmentJustifyLastLine :: Maybe Bool
_alignmentJustifyLastLine = Maybe Bool
forall a. Maybe a
Nothing
   , _alignmentReadingOrder :: Maybe ReadingOrder
_alignmentReadingOrder    = Maybe ReadingOrder
forall a. Maybe a
Nothing
   , _alignmentRelativeIndent :: Maybe Int
_alignmentRelativeIndent  = Maybe Int
forall a. Maybe a
Nothing
   , _alignmentShrinkToFit :: Maybe Bool
_alignmentShrinkToFit     = Maybe Bool
forall a. Maybe a
Nothing
   , _alignmentTextRotation :: Maybe Int
_alignmentTextRotation    = Maybe Int
forall a. Maybe a
Nothing
   , _alignmentVertical :: Maybe CellVerticalAlignment
_alignmentVertical        = Maybe CellVerticalAlignment
forall a. Maybe a
Nothing
   , _alignmentWrapText :: Maybe Bool
_alignmentWrapText        = Maybe Bool
forall a. Maybe a
Nothing
   }

instance Default Border where
  def :: Border
def = Border :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Border
Border {
      _borderDiagonalDown :: Maybe Bool
_borderDiagonalDown = Maybe Bool
forall a. Maybe a
Nothing
    , _borderDiagonalUp :: Maybe Bool
_borderDiagonalUp   = Maybe Bool
forall a. Maybe a
Nothing
    , _borderOutline :: Maybe Bool
_borderOutline      = Maybe Bool
forall a. Maybe a
Nothing
    , _borderBottom :: Maybe BorderStyle
_borderBottom       = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderDiagonal :: Maybe BorderStyle
_borderDiagonal     = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderEnd :: Maybe BorderStyle
_borderEnd          = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderHorizontal :: Maybe BorderStyle
_borderHorizontal   = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderStart :: Maybe BorderStyle
_borderStart        = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderTop :: Maybe BorderStyle
_borderTop          = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderVertical :: Maybe BorderStyle
_borderVertical     = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderLeft :: Maybe BorderStyle
_borderLeft         = Maybe BorderStyle
forall a. Maybe a
Nothing
    , _borderRight :: Maybe BorderStyle
_borderRight        = Maybe BorderStyle
forall a. Maybe a
Nothing
    }

instance Default BorderStyle where
  def :: BorderStyle
def = BorderStyle :: Maybe Color -> Maybe LineStyle -> BorderStyle
BorderStyle {
      _borderStyleColor :: Maybe Color
_borderStyleColor = Maybe Color
forall a. Maybe a
Nothing
    , _borderStyleLine :: Maybe LineStyle
_borderStyleLine  = Maybe LineStyle
forall a. Maybe a
Nothing
    }

instance Default Color where
  def :: Color
def = Color :: Maybe Bool
-> Maybe FormatCode -> Maybe Int -> Maybe Double -> Color
Color {
    _colorAutomatic :: Maybe Bool
_colorAutomatic = Maybe Bool
forall a. Maybe a
Nothing
  , _colorARGB :: Maybe FormatCode
_colorARGB      = Maybe FormatCode
forall a. Maybe a
Nothing
  , _colorTheme :: Maybe Int
_colorTheme     = Maybe Int
forall a. Maybe a
Nothing
  , _colorTint :: Maybe Double
_colorTint      = Maybe Double
forall a. Maybe a
Nothing
  }

instance Default Fill where
  def :: Fill
def = Fill :: Maybe FillPattern -> Fill
Fill {
      _fillPattern :: Maybe FillPattern
_fillPattern = Maybe FillPattern
forall a. Maybe a
Nothing
    }

instance Default FillPattern where
  def :: FillPattern
def = FillPattern :: Maybe Color -> Maybe Color -> Maybe PatternType -> FillPattern
FillPattern {
      _fillPatternBgColor :: Maybe Color
_fillPatternBgColor = Maybe Color
forall a. Maybe a
Nothing
    , _fillPatternFgColor :: Maybe Color
_fillPatternFgColor = Maybe Color
forall a. Maybe a
Nothing
    , _fillPatternType :: Maybe PatternType
_fillPatternType    = Maybe PatternType
forall a. Maybe a
Nothing
    }

instance Default Font where
  def :: Font
def = Font :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe FormatCode
-> Maybe Bool
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> Font
Font {
      _fontBold :: Maybe Bool
_fontBold          = Maybe Bool
forall a. Maybe a
Nothing
    , _fontCharset :: Maybe Int
_fontCharset       = Maybe Int
forall a. Maybe a
Nothing
    , _fontColor :: Maybe Color
_fontColor         = Maybe Color
forall a. Maybe a
Nothing
    , _fontCondense :: Maybe Bool
_fontCondense      = Maybe Bool
forall a. Maybe a
Nothing
    , _fontExtend :: Maybe Bool
_fontExtend        = Maybe Bool
forall a. Maybe a
Nothing
    , _fontFamily :: Maybe FontFamily
_fontFamily        = Maybe FontFamily
forall a. Maybe a
Nothing
    , _fontItalic :: Maybe Bool
_fontItalic        = Maybe Bool
forall a. Maybe a
Nothing
    , _fontName :: Maybe FormatCode
_fontName          = Maybe FormatCode
forall a. Maybe a
Nothing
    , _fontOutline :: Maybe Bool
_fontOutline       = Maybe Bool
forall a. Maybe a
Nothing
    , _fontScheme :: Maybe FontScheme
_fontScheme        = Maybe FontScheme
forall a. Maybe a
Nothing
    , _fontShadow :: Maybe Bool
_fontShadow        = Maybe Bool
forall a. Maybe a
Nothing
    , _fontStrikeThrough :: Maybe Bool
_fontStrikeThrough = Maybe Bool
forall a. Maybe a
Nothing
    , _fontSize :: Maybe Double
_fontSize          = Maybe Double
forall a. Maybe a
Nothing
    , _fontUnderline :: Maybe FontUnderline
_fontUnderline     = Maybe FontUnderline
forall a. Maybe a
Nothing
    , _fontVertAlign :: Maybe FontVerticalAlignment
_fontVertAlign     = Maybe FontVerticalAlignment
forall a. Maybe a
Nothing
    }

instance Default Protection where
  def :: Protection
def = Protection :: Maybe Bool -> Maybe Bool -> Protection
Protection {
      _protectionHidden :: Maybe Bool
_protectionHidden = Maybe Bool
forall a. Maybe a
Nothing
    , _protectionLocked :: Maybe Bool
_protectionLocked = Maybe Bool
forall a. Maybe a
Nothing
    }

{-------------------------------------------------------------------------------
  Rendering record types

  NOTE: Excel is sensitive to the order of the child nodes, so we are careful
  to follow the XML schema here. We are also careful to follow the ordering
  for attributes, although this is actually pointless, as xml-conduit stores
  these as a Map, so we lose the ordering. But if we change representation,
  at least they are in the right order (hopefully) in the source code.
-------------------------------------------------------------------------------}

instance ToDocument StyleSheet where
  toDocument :: StyleSheet -> Document
toDocument = FormatCode -> Element -> Document
documentFromElement FormatCode
"Stylesheet generated by xlsx"
             (Element -> Document)
-> (StyleSheet -> Element) -> StyleSheet -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> StyleSheet -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"styleSheet"

-- | See @CT_Stylesheet@, p. 4482
instance ToElement StyleSheet where
  toElement :: Name -> StyleSheet -> Element
toElement Name
nm StyleSheet{[Dxf]
[Font]
[Fill]
[Border]
[CellXf]
Map Int FormatCode
_styleSheetNumFmts :: Map Int FormatCode
_styleSheetDxfs :: [Dxf]
_styleSheetFonts :: [Font]
_styleSheetFills :: [Fill]
_styleSheetCellXfs :: [CellXf]
_styleSheetBorders :: [Border]
_styleSheetNumFmts :: StyleSheet -> Map Int FormatCode
_styleSheetDxfs :: StyleSheet -> [Dxf]
_styleSheetFonts :: StyleSheet -> [Font]
_styleSheetFills :: StyleSheet -> [Fill]
_styleSheetCellXfs :: StyleSheet -> [CellXf]
_styleSheetBorders :: StyleSheet -> [Border]
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
      countedElementList' :: Name -> [Element] -> [Element]
countedElementList' Name
nm' [Element]
xs = Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList (Maybe Element -> [Element]) -> Maybe Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Name -> [Element] -> Maybe Element
nonEmptyCountedElementList Name
nm' [Element]
xs
      elements :: [Element]
elements = Name -> [Element] -> [Element]
countedElementList' Name
"numFmts" ((NumFmt -> Element) -> [NumFmt] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> NumFmt -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"numFmt") [NumFmt]
numFmts) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                 Name -> [Element] -> [Element]
countedElementList' Name
"fonts"   ((Font -> Element) -> [Font] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Font -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"font")   [Font]
_styleSheetFonts) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                 Name -> [Element] -> [Element]
countedElementList' Name
"fills"   ((Fill -> Element) -> [Fill] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Fill -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"fill")   [Fill]
_styleSheetFills) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                 Name -> [Element] -> [Element]
countedElementList' Name
"borders" ((Border -> Element) -> [Border] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Border -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"border") [Border]
_styleSheetBorders) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                   -- TODO: cellStyleXfs
                 Name -> [Element] -> [Element]
countedElementList' Name
"cellXfs" ((CellXf -> Element) -> [CellXf] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> CellXf -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"xf")     [CellXf]
_styleSheetCellXfs) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                 -- TODO: cellStyles
                 Name -> [Element] -> [Element]
countedElementList' Name
"dxfs"    ((Dxf -> Element) -> [Dxf] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Dxf -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"dxf")    [Dxf]
_styleSheetDxfs)
                 -- TODO: tableStyles
                 -- TODO: colors
                 -- TODO: extLst
      numFmts :: [NumFmt]
numFmts = ((Int, FormatCode) -> NumFmt) -> [(Int, FormatCode)] -> [NumFmt]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> FormatCode -> NumFmt) -> (Int, FormatCode) -> NumFmt
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> FormatCode -> NumFmt
NumFmt) ([(Int, FormatCode)] -> [NumFmt])
-> [(Int, FormatCode)] -> [NumFmt]
forall a b. (a -> b) -> a -> b
$ Map Int FormatCode -> [(Int, FormatCode)]
forall k a. Map k a -> [(k, a)]
M.toList Map Int FormatCode
_styleSheetNumFmts

-- | See @CT_Xf@, p. 4486
instance ToElement CellXf where
  toElement :: Name -> CellXf -> Element
toElement Name
nm CellXf{Maybe Bool
Maybe Int
Maybe Protection
Maybe Alignment
_cellXfProtection :: Maybe Protection
_cellXfAlignment :: Maybe Alignment
_cellXfId :: Maybe Int
_cellXfQuotePrefix :: Maybe Bool
_cellXfPivotButton :: Maybe Bool
_cellXfNumFmtId :: Maybe Int
_cellXfFontId :: Maybe Int
_cellXfFillId :: Maybe Int
_cellXfBorderId :: Maybe Int
_cellXfApplyProtection :: Maybe Bool
_cellXfApplyNumberFormat :: Maybe Bool
_cellXfApplyFont :: Maybe Bool
_cellXfApplyFill :: Maybe Bool
_cellXfApplyBorder :: Maybe Bool
_cellXfApplyAlignment :: Maybe Bool
_cellXfProtection :: CellXf -> Maybe Protection
_cellXfAlignment :: CellXf -> Maybe Alignment
_cellXfId :: CellXf -> Maybe Int
_cellXfQuotePrefix :: CellXf -> Maybe Bool
_cellXfPivotButton :: CellXf -> Maybe Bool
_cellXfNumFmtId :: CellXf -> Maybe Int
_cellXfFontId :: CellXf -> Maybe Int
_cellXfFillId :: CellXf -> Maybe Int
_cellXfBorderId :: CellXf -> Maybe Int
_cellXfApplyProtection :: CellXf -> Maybe Bool
_cellXfApplyNumberFormat :: CellXf -> Maybe Bool
_cellXfApplyFont :: CellXf -> Maybe Bool
_cellXfApplyFill :: CellXf -> Maybe Bool
_cellXfApplyBorder :: CellXf -> Maybe Bool
_cellXfApplyAlignment :: CellXf -> Maybe Bool
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> Alignment -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"alignment"  (Alignment -> Element) -> Maybe Alignment -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alignment
_cellXfAlignment
        , Name -> Protection -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"protection" (Protection -> Element) -> Maybe Protection -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Protection
_cellXfProtection
          -- TODO: extLst
        ]
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"numFmtId"          Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_cellXfNumFmtId
        , Name
"fontId"            Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_cellXfFontId
        , Name
"fillId"            Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_cellXfFillId
        , Name
"borderId"          Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_cellXfBorderId
        , Name
"xfId"              Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_cellXfId
        , Name
"quotePrefix"       Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfQuotePrefix
        , Name
"pivotButton"       Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfPivotButton
        , Name
"applyNumberFormat" Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyNumberFormat
        , Name
"applyFont"         Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyFont
        , Name
"applyFill"         Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyFill
        , Name
"applyBorder"       Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyBorder
        , Name
"applyAlignment"    Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyAlignment
        , Name
"applyProtection"   Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_cellXfApplyProtection
        ]
    }

-- | See @CT_Dxf@, p. 3937
instance ToElement Dxf where
    toElement :: Name -> Dxf -> Element
toElement Name
nm Dxf{Maybe Protection
Maybe NumFmt
Maybe Font
Maybe Fill
Maybe Border
Maybe Alignment
_dxfProtection :: Maybe Protection
_dxfBorder :: Maybe Border
_dxfAlignment :: Maybe Alignment
_dxfFill :: Maybe Fill
_dxfNumFmt :: Maybe NumFmt
_dxfFont :: Maybe Font
_dxfProtection :: Dxf -> Maybe Protection
_dxfBorder :: Dxf -> Maybe Border
_dxfAlignment :: Dxf -> Maybe Alignment
_dxfFill :: Dxf -> Maybe Fill
_dxfNumFmt :: Dxf -> Maybe NumFmt
_dxfFont :: Dxf -> Maybe Font
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element
        { elementName :: Name
elementName       = Name
nm
        , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node]) -> [Element] -> [Node]
forall a b. (a -> b) -> a -> b
$
                              [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes [ Name -> Font -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"font"       (Font -> Element) -> Maybe Font -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Font
_dxfFont
                                        , Name -> NumFmt -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"numFmt"     (NumFmt -> Element) -> Maybe NumFmt -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NumFmt
_dxfNumFmt
                                        , Name -> Fill -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"fill"       (Fill -> Element) -> Maybe Fill -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Fill
_dxfFill
                                        , Name -> Alignment -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"alignment"  (Alignment -> Element) -> Maybe Alignment -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alignment
_dxfAlignment
                                        , Name -> Border -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"border"     (Border -> Element) -> Maybe Border -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Border
_dxfBorder
                                        , Name -> Protection -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"protection" (Protection -> Element) -> Maybe Protection -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Protection
_dxfProtection
                                        ]
        , elementAttributes :: Map Name FormatCode
elementAttributes = Map Name FormatCode
forall k a. Map k a
M.empty
        }

-- | See @CT_CellAlignment@, p. 4482
instance ToElement Alignment where
  toElement :: Name -> Alignment -> Element
toElement Name
nm Alignment{Maybe Bool
Maybe Int
Maybe ReadingOrder
Maybe CellVerticalAlignment
Maybe CellHorizontalAlignment
_alignmentWrapText :: Maybe Bool
_alignmentVertical :: Maybe CellVerticalAlignment
_alignmentTextRotation :: Maybe Int
_alignmentShrinkToFit :: Maybe Bool
_alignmentRelativeIndent :: Maybe Int
_alignmentReadingOrder :: Maybe ReadingOrder
_alignmentJustifyLastLine :: Maybe Bool
_alignmentIndent :: Maybe Int
_alignmentHorizontal :: Maybe CellHorizontalAlignment
_alignmentWrapText :: Alignment -> Maybe Bool
_alignmentVertical :: Alignment -> Maybe CellVerticalAlignment
_alignmentTextRotation :: Alignment -> Maybe Int
_alignmentShrinkToFit :: Alignment -> Maybe Bool
_alignmentRelativeIndent :: Alignment -> Maybe Int
_alignmentReadingOrder :: Alignment -> Maybe ReadingOrder
_alignmentJustifyLastLine :: Alignment -> Maybe Bool
_alignmentIndent :: Alignment -> Maybe Int
_alignmentHorizontal :: Alignment -> Maybe CellHorizontalAlignment
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = []
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"horizontal"      Name -> Maybe CellHorizontalAlignment -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe CellHorizontalAlignment
_alignmentHorizontal
        , Name
"vertical"        Name -> Maybe CellVerticalAlignment -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe CellVerticalAlignment
_alignmentVertical
        , Name
"textRotation"    Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_alignmentTextRotation
        , Name
"wrapText"        Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_alignmentWrapText
        , Name
"relativeIndent"  Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_alignmentRelativeIndent
        , Name
"indent"          Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_alignmentIndent
        , Name
"justifyLastLine" Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_alignmentJustifyLastLine
        , Name
"shrinkToFit"     Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_alignmentShrinkToFit
        , Name
"readingOrder"    Name -> Maybe ReadingOrder -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe ReadingOrder
_alignmentReadingOrder
        ]
    }

-- | See @CT_Border@, p. 4483
instance ToElement Border where
  toElement :: Name -> Border -> Element
toElement Name
nm Border{Maybe Bool
Maybe BorderStyle
_borderVertical :: Maybe BorderStyle
_borderTop :: Maybe BorderStyle
_borderStart :: Maybe BorderStyle
_borderRight :: Maybe BorderStyle
_borderLeft :: Maybe BorderStyle
_borderHorizontal :: Maybe BorderStyle
_borderEnd :: Maybe BorderStyle
_borderDiagonal :: Maybe BorderStyle
_borderBottom :: Maybe BorderStyle
_borderOutline :: Maybe Bool
_borderDiagonalUp :: Maybe Bool
_borderDiagonalDown :: Maybe Bool
_borderVertical :: Border -> Maybe BorderStyle
_borderTop :: Border -> Maybe BorderStyle
_borderStart :: Border -> Maybe BorderStyle
_borderRight :: Border -> Maybe BorderStyle
_borderLeft :: Border -> Maybe BorderStyle
_borderHorizontal :: Border -> Maybe BorderStyle
_borderEnd :: Border -> Maybe BorderStyle
_borderDiagonal :: Border -> Maybe BorderStyle
_borderBottom :: Border -> Maybe BorderStyle
_borderOutline :: Border -> Maybe Bool
_borderDiagonalUp :: Border -> Maybe Bool
_borderDiagonalDown :: Border -> Maybe Bool
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"diagonalUp"   Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_borderDiagonalUp
        , Name
"diagonalDown" Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_borderDiagonalDown
        , Name
"outline"      Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_borderOutline
        ]
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"start"      (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderStart
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"end"        (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderEnd
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"left"       (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderLeft
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"right"      (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderRight
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"top"        (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderTop
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"bottom"     (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderBottom
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"diagonal"   (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderDiagonal
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"vertical"   (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderVertical
        , Name -> BorderStyle -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"horizontal" (BorderStyle -> Element) -> Maybe BorderStyle -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BorderStyle
_borderHorizontal
        ]
    }

-- | See @CT_BorderPr@, p. 4483
instance ToElement BorderStyle where
  toElement :: Name -> BorderStyle -> Element
toElement Name
nm BorderStyle{Maybe LineStyle
Maybe Color
_borderStyleLine :: Maybe LineStyle
_borderStyleColor :: Maybe Color
_borderStyleLine :: BorderStyle -> Maybe LineStyle
_borderStyleColor :: BorderStyle -> Maybe Color
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"style" Name -> Maybe LineStyle -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe LineStyle
_borderStyleLine
        ]
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> Color -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"color" (Color -> Element) -> Maybe Color -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
_borderStyleColor
        ]
    }

-- | See @CT_Color@, p. 4484
instance ToElement Color where
  toElement :: Name -> Color -> Element
toElement Name
nm Color{Maybe Bool
Maybe Double
Maybe Int
Maybe FormatCode
_colorTint :: Maybe Double
_colorTheme :: Maybe Int
_colorARGB :: Maybe FormatCode
_colorAutomatic :: Maybe Bool
_colorTint :: Color -> Maybe Double
_colorTheme :: Color -> Maybe Int
_colorARGB :: Color -> Maybe FormatCode
_colorAutomatic :: Color -> Maybe Bool
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = []
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"auto"  Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_colorAutomatic
        , Name
"rgb"   Name -> Maybe FormatCode -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe FormatCode
_colorARGB
        , Name
"theme" Name -> Maybe Int -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Int
_colorTheme
        , Name
"tint"  Name -> Maybe Double -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Double
_colorTint
        ]
    }

-- | See @CT_Fill@, p. 4484
instance ToElement Fill where
  toElement :: Name -> Fill -> Element
toElement Name
nm Fill{Maybe FillPattern
_fillPattern :: Maybe FillPattern
_fillPattern :: Fill -> Maybe FillPattern
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name FormatCode
elementAttributes = Map Name FormatCode
forall k a. Map k a
M.empty
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> FillPattern -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"patternFill" (FillPattern -> Element) -> Maybe FillPattern -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FillPattern
_fillPattern
        ]
    }

-- | See @CT_PatternFill@, p. 4484
instance ToElement FillPattern where
  toElement :: Name -> FillPattern -> Element
toElement Name
nm FillPattern{Maybe PatternType
Maybe Color
_fillPatternType :: Maybe PatternType
_fillPatternFgColor :: Maybe Color
_fillPatternBgColor :: Maybe Color
_fillPatternType :: FillPattern -> Maybe PatternType
_fillPatternFgColor :: FillPattern -> Maybe Color
_fillPatternBgColor :: FillPattern -> Maybe Color
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"patternType" Name -> Maybe PatternType -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe PatternType
_fillPatternType
        ]
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> Color -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"fgColor" (Color -> Element) -> Maybe Color -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
_fillPatternFgColor
        , Name -> Color -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"bgColor" (Color -> Element) -> Maybe Color -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
_fillPatternBgColor
        ]
    }

-- | See @CT_Font@, p. 4489
instance ToElement Font where
  toElement :: Name -> Font -> Element
toElement Name
nm Font{Maybe Bool
Maybe Double
Maybe Int
Maybe FormatCode
Maybe FontVerticalAlignment
Maybe FontUnderline
Maybe FontScheme
Maybe FontFamily
Maybe Color
_fontVertAlign :: Maybe FontVerticalAlignment
_fontUnderline :: Maybe FontUnderline
_fontSize :: Maybe Double
_fontStrikeThrough :: Maybe Bool
_fontShadow :: Maybe Bool
_fontScheme :: Maybe FontScheme
_fontOutline :: Maybe Bool
_fontName :: Maybe FormatCode
_fontItalic :: Maybe Bool
_fontFamily :: Maybe FontFamily
_fontExtend :: Maybe Bool
_fontCondense :: Maybe Bool
_fontColor :: Maybe Color
_fontCharset :: Maybe Int
_fontBold :: Maybe Bool
_fontVertAlign :: Font -> Maybe FontVerticalAlignment
_fontUnderline :: Font -> Maybe FontUnderline
_fontSize :: Font -> Maybe Double
_fontStrikeThrough :: Font -> Maybe Bool
_fontShadow :: Font -> Maybe Bool
_fontScheme :: Font -> Maybe FontScheme
_fontOutline :: Font -> Maybe Bool
_fontName :: Font -> Maybe FormatCode
_fontItalic :: Font -> Maybe Bool
_fontFamily :: Font -> Maybe FontFamily
_fontExtend :: Font -> Maybe Bool
_fontCondense :: Font -> Maybe Bool
_fontColor :: Font -> Maybe Color
_fontCharset :: Font -> Maybe Int
_fontBold :: Font -> Maybe Bool
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name FormatCode
elementAttributes = Map Name FormatCode
forall k a. Map k a
M.empty -- all properties specified as child nodes
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> FormatCode -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"name"      (FormatCode -> Element) -> Maybe FormatCode -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FormatCode
_fontName
        , Name -> Int -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"charset"   (Int -> Element) -> Maybe Int -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_fontCharset
        , Name -> FontFamily -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"family"    (FontFamily -> Element) -> Maybe FontFamily -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontFamily
_fontFamily
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"b"         (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontBold
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"i"         (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontItalic
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"strike"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontStrikeThrough
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"outline"   (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontOutline
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"shadow"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontShadow
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"condense"  (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontCondense
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"extend"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_fontExtend
        , Name -> Color -> Element
forall a. ToElement a => Name -> a -> Element
toElement    Name
"color"     (Color -> Element) -> Maybe Color -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
_fontColor
        , Name -> Double -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"sz"        (Double -> Element) -> Maybe Double -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
_fontSize
        , Name -> FontUnderline -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"u"         (FontUnderline -> Element) -> Maybe FontUnderline -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontUnderline
_fontUnderline
        , Name -> FontVerticalAlignment -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"vertAlign" (FontVerticalAlignment -> Element)
-> Maybe FontVerticalAlignment -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontVerticalAlignment
_fontVertAlign
        , Name -> FontScheme -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"scheme"    (FontScheme -> Element) -> Maybe FontScheme -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontScheme
_fontScheme
        ]
    }

-- | See @CT_NumFmt@, p. 3936
instance ToElement NumFmt where
  toElement :: Name -> NumFmt -> Element
toElement Name
nm (NumFmt {Int
FormatCode
_numFmtCode :: FormatCode
_numFmtId :: Int
_numFmtCode :: NumFmt -> FormatCode
_numFmtId :: NumFmt -> Int
..}) =
    Name -> [(Name, FormatCode)] -> Element
leafElement Name
nm
      [ Name
"numFmtId"   Name -> FormatCode -> (Name, FormatCode)
forall a. ToAttrVal a => Name -> a -> (Name, FormatCode)
.= Int -> FormatCode
forall a. ToAttrVal a => a -> FormatCode
toAttrVal Int
_numFmtId
      , Name
"formatCode" Name -> FormatCode -> (Name, FormatCode)
forall a. ToAttrVal a => Name -> a -> (Name, FormatCode)
.= FormatCode -> FormatCode
forall a. ToAttrVal a => a -> FormatCode
toAttrVal FormatCode
_numFmtCode
      ]

-- | See @CT_CellProtection@, p. 4484
instance ToElement Protection where
  toElement :: Name -> Protection -> Element
toElement Name
nm Protection{Maybe Bool
_protectionLocked :: Maybe Bool
_protectionHidden :: Maybe Bool
_protectionLocked :: Protection -> Maybe Bool
_protectionHidden :: Protection -> Maybe Bool
..} = Element :: Name -> Map Name FormatCode -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = []
    , elementAttributes :: Map Name FormatCode
elementAttributes = [(Name, FormatCode)] -> Map Name FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, FormatCode)] -> Map Name FormatCode)
-> ([Maybe (Name, FormatCode)] -> [(Name, FormatCode)])
-> [Maybe (Name, FormatCode)]
-> Map Name FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, FormatCode)] -> [(Name, FormatCode)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, FormatCode)] -> Map Name FormatCode)
-> [Maybe (Name, FormatCode)] -> Map Name FormatCode
forall a b. (a -> b) -> a -> b
$ [
          Name
"locked" Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_protectionLocked
        , Name
"hidden" Name -> Maybe Bool -> Maybe (Name, FormatCode)
forall a.
ToAttrVal a =>
Name -> Maybe a -> Maybe (Name, FormatCode)
.=? Maybe Bool
_protectionHidden
        ]
    }

{-------------------------------------------------------------------------------
  Rendering attribute values
-------------------------------------------------------------------------------}

instance ToAttrVal CellHorizontalAlignment where
  toAttrVal :: CellHorizontalAlignment -> FormatCode
toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentCenter           = FormatCode
"center"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentCenterContinuous = FormatCode
"centerContinuous"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentDistributed      = FormatCode
"distributed"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentFill             = FormatCode
"fill"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentGeneral          = FormatCode
"general"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentJustify          = FormatCode
"justify"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentLeft             = FormatCode
"left"
  toAttrVal CellHorizontalAlignment
CellHorizontalAlignmentRight            = FormatCode
"right"

instance ToAttrVal CellVerticalAlignment where
  toAttrVal :: CellVerticalAlignment -> FormatCode
toAttrVal CellVerticalAlignment
CellVerticalAlignmentBottom      = FormatCode
"bottom"
  toAttrVal CellVerticalAlignment
CellVerticalAlignmentCenter      = FormatCode
"center"
  toAttrVal CellVerticalAlignment
CellVerticalAlignmentDistributed = FormatCode
"distributed"
  toAttrVal CellVerticalAlignment
CellVerticalAlignmentJustify     = FormatCode
"justify"
  toAttrVal CellVerticalAlignment
CellVerticalAlignmentTop         = FormatCode
"top"

instance ToAttrVal FontFamily where
  toAttrVal :: FontFamily -> FormatCode
toAttrVal FontFamily
FontFamilyNotApplicable = FormatCode
"0"
  toAttrVal FontFamily
FontFamilyRoman         = FormatCode
"1"
  toAttrVal FontFamily
FontFamilySwiss         = FormatCode
"2"
  toAttrVal FontFamily
FontFamilyModern        = FormatCode
"3"
  toAttrVal FontFamily
FontFamilyScript        = FormatCode
"4"
  toAttrVal FontFamily
FontFamilyDecorative    = FormatCode
"5"

instance ToAttrVal FontScheme where
  toAttrVal :: FontScheme -> FormatCode
toAttrVal FontScheme
FontSchemeMajor = FormatCode
"major"
  toAttrVal FontScheme
FontSchemeMinor = FormatCode
"minor"
  toAttrVal FontScheme
FontSchemeNone  = FormatCode
"none"

-- See @ST_UnderlineValues@, p. 3940
instance ToAttrVal FontUnderline where
  toAttrVal :: FontUnderline -> FormatCode
toAttrVal FontUnderline
FontUnderlineSingle           = FormatCode
"single"
  toAttrVal FontUnderline
FontUnderlineDouble           = FormatCode
"double"
  toAttrVal FontUnderline
FontUnderlineSingleAccounting = FormatCode
"singleAccounting"
  toAttrVal FontUnderline
FontUnderlineDoubleAccounting = FormatCode
"doubleAccounting"
  toAttrVal FontUnderline
FontUnderlineNone             = FormatCode
"none"

instance ToAttrVal FontVerticalAlignment where
  toAttrVal :: FontVerticalAlignment -> FormatCode
toAttrVal FontVerticalAlignment
FontVerticalAlignmentBaseline    = FormatCode
"baseline"
  toAttrVal FontVerticalAlignment
FontVerticalAlignmentSubscript   = FormatCode
"subscript"
  toAttrVal FontVerticalAlignment
FontVerticalAlignmentSuperscript = FormatCode
"superscript"

instance ToAttrVal LineStyle where
  toAttrVal :: LineStyle -> FormatCode
toAttrVal LineStyle
LineStyleDashDot          = FormatCode
"dashDot"
  toAttrVal LineStyle
LineStyleDashDotDot       = FormatCode
"dashDotDot"
  toAttrVal LineStyle
LineStyleDashed           = FormatCode
"dashed"
  toAttrVal LineStyle
LineStyleDotted           = FormatCode
"dotted"
  toAttrVal LineStyle
LineStyleDouble           = FormatCode
"double"
  toAttrVal LineStyle
LineStyleHair             = FormatCode
"hair"
  toAttrVal LineStyle
LineStyleMedium           = FormatCode
"medium"
  toAttrVal LineStyle
LineStyleMediumDashDot    = FormatCode
"mediumDashDot"
  toAttrVal LineStyle
LineStyleMediumDashDotDot = FormatCode
"mediumDashDotDot"
  toAttrVal LineStyle
LineStyleMediumDashed     = FormatCode
"mediumDashed"
  toAttrVal LineStyle
LineStyleNone             = FormatCode
"none"
  toAttrVal LineStyle
LineStyleSlantDashDot     = FormatCode
"slantDashDot"
  toAttrVal LineStyle
LineStyleThick            = FormatCode
"thick"
  toAttrVal LineStyle
LineStyleThin             = FormatCode
"thin"

instance ToAttrVal PatternType where
  toAttrVal :: PatternType -> FormatCode
toAttrVal PatternType
PatternTypeDarkDown        = FormatCode
"darkDown"
  toAttrVal PatternType
PatternTypeDarkGray        = FormatCode
"darkGray"
  toAttrVal PatternType
PatternTypeDarkGrid        = FormatCode
"darkGrid"
  toAttrVal PatternType
PatternTypeDarkHorizontal  = FormatCode
"darkHorizontal"
  toAttrVal PatternType
PatternTypeDarkTrellis     = FormatCode
"darkTrellis"
  toAttrVal PatternType
PatternTypeDarkUp          = FormatCode
"darkUp"
  toAttrVal PatternType
PatternTypeDarkVertical    = FormatCode
"darkVertical"
  toAttrVal PatternType
PatternTypeGray0625        = FormatCode
"gray0625"
  toAttrVal PatternType
PatternTypeGray125         = FormatCode
"gray125"
  toAttrVal PatternType
PatternTypeLightDown       = FormatCode
"lightDown"
  toAttrVal PatternType
PatternTypeLightGray       = FormatCode
"lightGray"
  toAttrVal PatternType
PatternTypeLightGrid       = FormatCode
"lightGrid"
  toAttrVal PatternType
PatternTypeLightHorizontal = FormatCode
"lightHorizontal"
  toAttrVal PatternType
PatternTypeLightTrellis    = FormatCode
"lightTrellis"
  toAttrVal PatternType
PatternTypeLightUp         = FormatCode
"lightUp"
  toAttrVal PatternType
PatternTypeLightVertical   = FormatCode
"lightVertical"
  toAttrVal PatternType
PatternTypeMediumGray      = FormatCode
"mediumGray"
  toAttrVal PatternType
PatternTypeNone            = FormatCode
"none"
  toAttrVal PatternType
PatternTypeSolid           = FormatCode
"solid"

instance ToAttrVal ReadingOrder where
  toAttrVal :: ReadingOrder -> FormatCode
toAttrVal ReadingOrder
ReadingOrderContextDependent = FormatCode
"0"
  toAttrVal ReadingOrder
ReadingOrderLeftToRight      = FormatCode
"1"
  toAttrVal ReadingOrder
ReadingOrderRightToLeft      = FormatCode
"2"

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}
-- | See @CT_Stylesheet@, p. 4482
instance FromCursor StyleSheet where
  fromCursor :: Cursor -> [StyleSheet]
fromCursor Cursor
cur = do
    let
      _styleSheetFonts :: [Font]
_styleSheetFonts = Cursor
cur Cursor -> (Cursor -> [Font]) -> [Font]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"fonts") Axis -> (Cursor -> [Font]) -> Cursor -> [Font]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"font") Axis -> (Cursor -> [Font]) -> Cursor -> [Font]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Font]
forall a. FromCursor a => Cursor -> [a]
fromCursor
      _styleSheetFills :: [Fill]
_styleSheetFills = Cursor
cur Cursor -> (Cursor -> [Fill]) -> [Fill]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"fills") Axis -> (Cursor -> [Fill]) -> Cursor -> [Fill]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"fill") Axis -> (Cursor -> [Fill]) -> Cursor -> [Fill]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Fill]
forall a. FromCursor a => Cursor -> [a]
fromCursor
      _styleSheetBorders :: [Border]
_styleSheetBorders = Cursor
cur Cursor -> (Cursor -> [Border]) -> [Border]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"borders") Axis -> (Cursor -> [Border]) -> Cursor -> [Border]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"border") Axis -> (Cursor -> [Border]) -> Cursor -> [Border]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Border]
forall a. FromCursor a => Cursor -> [a]
fromCursor
         -- TODO: cellStyleXfs
      _styleSheetCellXfs :: [CellXf]
_styleSheetCellXfs = Cursor
cur Cursor -> (Cursor -> [CellXf]) -> [CellXf]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"cellXfs") Axis -> (Cursor -> [CellXf]) -> Cursor -> [CellXf]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"xf") Axis -> (Cursor -> [CellXf]) -> Cursor -> [CellXf]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [CellXf]
forall a. FromCursor a => Cursor -> [a]
fromCursor
         -- TODO: cellStyles
      _styleSheetDxfs :: [Dxf]
_styleSheetDxfs = Cursor
cur Cursor -> (Cursor -> [Dxf]) -> [Dxf]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"dxfs") Axis -> (Cursor -> [Dxf]) -> Cursor -> [Dxf]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"dxf") Axis -> (Cursor -> [Dxf]) -> Cursor -> [Dxf]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Dxf]
forall a. FromCursor a => Cursor -> [a]
fromCursor
      _styleSheetNumFmts :: Map Int FormatCode
_styleSheetNumFmts = [(Int, FormatCode)] -> Map Int FormatCode
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, FormatCode)] -> Map Int FormatCode)
-> ([NumFmt] -> [(Int, FormatCode)])
-> [NumFmt]
-> Map Int FormatCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NumFmt -> (Int, FormatCode)) -> [NumFmt] -> [(Int, FormatCode)]
forall a b. (a -> b) -> [a] -> [b]
map NumFmt -> (Int, FormatCode)
mkNumFmtPair ([NumFmt] -> Map Int FormatCode) -> [NumFmt] -> Map Int FormatCode
forall a b. (a -> b) -> a -> b
$
          Cursor
cur Cursor -> (Cursor -> [NumFmt]) -> [NumFmt]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"numFmts")Axis -> (Cursor -> [NumFmt]) -> Cursor -> [NumFmt]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (FormatCode -> Name
n_ FormatCode
"numFmt") Axis -> (Cursor -> [NumFmt]) -> Cursor -> [NumFmt]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [NumFmt]
forall a. FromCursor a => Cursor -> [a]
fromCursor
         -- TODO: tableStyles
         -- TODO: colors
         -- TODO: extLst
    StyleSheet -> [StyleSheet]
forall (m :: * -> *) a. Monad m => a -> m a
return StyleSheet :: [Border]
-> [CellXf]
-> [Fill]
-> [Font]
-> [Dxf]
-> Map Int FormatCode
-> StyleSheet
StyleSheet{[Dxf]
[Font]
[Fill]
[Border]
[CellXf]
Map Int FormatCode
_styleSheetNumFmts :: Map Int FormatCode
_styleSheetDxfs :: [Dxf]
_styleSheetCellXfs :: [CellXf]
_styleSheetBorders :: [Border]
_styleSheetFills :: [Fill]
_styleSheetFonts :: [Font]
_styleSheetNumFmts :: Map Int FormatCode
_styleSheetDxfs :: [Dxf]
_styleSheetFonts :: [Font]
_styleSheetFills :: [Fill]
_styleSheetCellXfs :: [CellXf]
_styleSheetBorders :: [Border]
..}

-- | See @CT_Font@, p. 4489
instance FromCursor Font where
  fromCursor :: Cursor -> [Font]
fromCursor Cursor
cur = do
    Maybe FormatCode
_fontName         <- Name -> Cursor -> [Maybe FormatCode]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"name") Cursor
cur
    Maybe Int
_fontCharset      <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"charset") Cursor
cur
    Maybe FontFamily
_fontFamily       <- Name -> Cursor -> [Maybe FontFamily]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"family") Cursor
cur
    Maybe Bool
_fontBold         <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"b") Cursor
cur
    Maybe Bool
_fontItalic       <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"i") Cursor
cur
    Maybe Bool
_fontStrikeThrough<- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"strike") Cursor
cur
    Maybe Bool
_fontOutline      <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"outline") Cursor
cur
    Maybe Bool
_fontShadow       <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"shadow") Cursor
cur
    Maybe Bool
_fontCondense     <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"condense") Cursor
cur
    Maybe Bool
_fontExtend       <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (FormatCode -> Name
n_ FormatCode
"extend") Cursor
cur
    Maybe Color
_fontColor        <- Name -> Cursor -> [Maybe Color]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement  (FormatCode -> Name
n_ FormatCode
"color") Cursor
cur
    Maybe Double
_fontSize         <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"sz") Cursor
cur
    Maybe FontUnderline
_fontUnderline    <- Name -> FontUnderline -> Cursor -> [Maybe FontUnderline]
forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (FormatCode -> Name
n_ FormatCode
"u") FontUnderline
FontUnderlineSingle Cursor
cur
    Maybe FontVerticalAlignment
_fontVertAlign    <- Name -> Cursor -> [Maybe FontVerticalAlignment]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"vertAlign") Cursor
cur
    Maybe FontScheme
_fontScheme       <- Name -> Cursor -> [Maybe FontScheme]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (FormatCode -> Name
n_ FormatCode
"scheme") Cursor
cur
    Font -> [Font]
forall (m :: * -> *) a. Monad m => a -> m a
return Font :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe FormatCode
-> Maybe Bool
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> Font
Font{Maybe Bool
Maybe Double
Maybe Int
Maybe FormatCode
Maybe FontVerticalAlignment
Maybe FontUnderline
Maybe FontScheme
Maybe FontFamily
Maybe Color
_fontScheme :: Maybe FontScheme
_fontVertAlign :: Maybe FontVerticalAlignment
_fontUnderline :: Maybe FontUnderline
_fontSize :: Maybe Double
_fontColor :: Maybe Color
_fontExtend :: Maybe Bool
_fontCondense :: Maybe Bool
_fontShadow :: Maybe Bool
_fontOutline :: Maybe Bool
_fontStrikeThrough :: Maybe Bool
_fontItalic :: Maybe Bool
_fontBold :: Maybe Bool
_fontFamily :: Maybe FontFamily
_fontCharset :: Maybe Int
_fontName :: Maybe FormatCode
_fontVertAlign :: Maybe FontVerticalAlignment
_fontUnderline :: Maybe FontUnderline
_fontSize :: Maybe Double
_fontStrikeThrough :: Maybe Bool
_fontShadow :: Maybe Bool
_fontScheme :: Maybe FontScheme
_fontOutline :: Maybe Bool
_fontName :: Maybe FormatCode
_fontItalic :: Maybe Bool
_fontFamily :: Maybe FontFamily
_fontExtend :: Maybe Bool
_fontCondense :: Maybe Bool
_fontColor :: Maybe Color
_fontCharset :: Maybe Int
_fontBold :: Maybe Bool
..}

-- | See 18.18.94 "ST_FontFamily (Font Family)" (p. 2517)
instance FromAttrVal FontFamily where
  fromAttrVal :: Reader FontFamily
fromAttrVal FormatCode
"0" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilyNotApplicable
  fromAttrVal FormatCode
"1" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilyRoman
  fromAttrVal FormatCode
"2" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilySwiss
  fromAttrVal FormatCode
"3" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilyModern
  fromAttrVal FormatCode
"4" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilyScript
  fromAttrVal FormatCode
"5" = FontFamily -> Either String (FontFamily, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontFamily
FontFamilyDecorative
  fromAttrVal FormatCode
t   = FormatCode -> Reader FontFamily
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"FontFamily" FormatCode
t

instance FromAttrBs FontFamily where
  fromAttrBs :: ByteString -> Either FormatCode FontFamily
fromAttrBs ByteString
"0" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilyNotApplicable
  fromAttrBs ByteString
"1" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilyRoman
  fromAttrBs ByteString
"2" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilySwiss
  fromAttrBs ByteString
"3" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilyModern
  fromAttrBs ByteString
"4" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilyScript
  fromAttrBs ByteString
"5" = FontFamily -> Either FormatCode FontFamily
forall (m :: * -> *) a. Monad m => a -> m a
return FontFamily
FontFamilyDecorative
  fromAttrBs ByteString
x   = FormatCode -> ByteString -> Either FormatCode FontFamily
forall a. FormatCode -> ByteString -> Either FormatCode a
unexpectedAttrBs FormatCode
"FontFamily" ByteString
x

-- | See @CT_Color@, p. 4484
instance FromCursor Color where
  fromCursor :: Cursor -> [Color]
fromCursor Cursor
cur = do
    Maybe Bool
_colorAutomatic <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"auto" Cursor
cur
    Maybe FormatCode
_colorARGB      <- Name -> Cursor -> [Maybe FormatCode]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"rgb" Cursor
cur
    Maybe Int
_colorTheme     <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"theme" Cursor
cur
    Maybe Double
_colorTint      <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"tint" Cursor
cur
    Color -> [Color]
forall (m :: * -> *) a. Monad m => a -> m a
return Color :: Maybe Bool
-> Maybe FormatCode -> Maybe Int -> Maybe Double -> Color
Color{Maybe Bool
Maybe Double
Maybe Int
Maybe FormatCode
_colorTint :: Maybe Double
_colorTheme :: Maybe Int
_colorARGB :: Maybe FormatCode
_colorAutomatic :: Maybe Bool
_colorTint :: Maybe Double
_colorTheme :: Maybe Int
_colorARGB :: Maybe FormatCode
_colorAutomatic :: Maybe Bool
..}

instance FromXenoNode Color where
  fromXenoNode :: Node -> Either FormatCode Color
fromXenoNode Node
root =
    Node -> AttrParser Color -> Either FormatCode Color
forall a. Node -> AttrParser a -> Either FormatCode a
parseAttributes Node
root (AttrParser Color -> Either FormatCode Color)
-> AttrParser Color -> Either FormatCode Color
forall a b. (a -> b) -> a -> b
$ do
      Maybe Bool
_colorAutomatic <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"auto"
      Maybe FormatCode
_colorARGB <- ByteString -> AttrParser (Maybe FormatCode)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"rgb"
      Maybe Int
_colorTheme <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"theme"
      Maybe Double
_colorTint <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"tint"
      Color -> AttrParser Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color :: Maybe Bool
-> Maybe FormatCode -> Maybe Int -> Maybe Double -> Color
Color {Maybe Bool
Maybe Double
Maybe Int
Maybe FormatCode
_colorTint :: Maybe Double
_colorTheme :: Maybe Int
_colorARGB :: Maybe FormatCode
_colorAutomatic :: Maybe Bool
_colorTint :: Maybe Double
_colorTheme :: Maybe Int
_colorARGB :: Maybe FormatCode
_colorAutomatic :: Maybe Bool
..}

-- See @ST_UnderlineValues@, p. 3940
instance FromAttrVal FontUnderline where
  fromAttrVal :: Reader FontUnderline
fromAttrVal FormatCode
"single"           = FontUnderline -> Either String (FontUnderline, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontUnderline
FontUnderlineSingle
  fromAttrVal FormatCode
"double"           = FontUnderline -> Either String (FontUnderline, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontUnderline
FontUnderlineDouble
  fromAttrVal FormatCode
"singleAccounting" = FontUnderline -> Either String (FontUnderline, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontUnderline
FontUnderlineSingleAccounting
  fromAttrVal FormatCode
"doubleAccounting" = FontUnderline -> Either String (FontUnderline, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontUnderline
FontUnderlineDoubleAccounting
  fromAttrVal FormatCode
"none"             = FontUnderline -> Either String (FontUnderline, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontUnderline
FontUnderlineNone
  fromAttrVal FormatCode
t                  = FormatCode -> Reader FontUnderline
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"FontUnderline" FormatCode
t

instance FromAttrBs FontUnderline where
  fromAttrBs :: ByteString -> Either FormatCode FontUnderline
fromAttrBs ByteString
"single"           = FontUnderline -> Either FormatCode FontUnderline
forall (m :: * -> *) a. Monad m => a -> m a
return FontUnderline
FontUnderlineSingle
  fromAttrBs ByteString
"double"           = FontUnderline -> Either FormatCode FontUnderline
forall (m :: * -> *) a. Monad m => a -> m a
return FontUnderline
FontUnderlineDouble
  fromAttrBs ByteString
"singleAccounting" = FontUnderline -> Either FormatCode FontUnderline
forall (m :: * -> *) a. Monad m => a -> m a
return FontUnderline
FontUnderlineSingleAccounting
  fromAttrBs ByteString
"doubleAccounting" = FontUnderline -> Either FormatCode FontUnderline
forall (m :: * -> *) a. Monad m => a -> m a
return FontUnderline
FontUnderlineDoubleAccounting
  fromAttrBs ByteString
"none"             = FontUnderline -> Either FormatCode FontUnderline
forall (m :: * -> *) a. Monad m => a -> m a
return FontUnderline
FontUnderlineNone
  fromAttrBs ByteString
x                  = FormatCode -> ByteString -> Either FormatCode FontUnderline
forall a. FormatCode -> ByteString -> Either FormatCode a
unexpectedAttrBs FormatCode
"FontUnderline" ByteString
x

instance FromAttrVal FontVerticalAlignment where
  fromAttrVal :: Reader FontVerticalAlignment
fromAttrVal FormatCode
"baseline"    = FontVerticalAlignment
-> Either String (FontVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontVerticalAlignment
FontVerticalAlignmentBaseline
  fromAttrVal FormatCode
"subscript"   = FontVerticalAlignment
-> Either String (FontVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontVerticalAlignment
FontVerticalAlignmentSubscript
  fromAttrVal FormatCode
"superscript" = FontVerticalAlignment
-> Either String (FontVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontVerticalAlignment
FontVerticalAlignmentSuperscript
  fromAttrVal FormatCode
t             = FormatCode -> Reader FontVerticalAlignment
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"FontVerticalAlignment" FormatCode
t

instance FromAttrBs FontVerticalAlignment where
  fromAttrBs :: ByteString -> Either FormatCode FontVerticalAlignment
fromAttrBs ByteString
"baseline"    = FontVerticalAlignment -> Either FormatCode FontVerticalAlignment
forall (m :: * -> *) a. Monad m => a -> m a
return FontVerticalAlignment
FontVerticalAlignmentBaseline
  fromAttrBs ByteString
"subscript"   = FontVerticalAlignment -> Either FormatCode FontVerticalAlignment
forall (m :: * -> *) a. Monad m => a -> m a
return FontVerticalAlignment
FontVerticalAlignmentSubscript
  fromAttrBs ByteString
"superscript" = FontVerticalAlignment -> Either FormatCode FontVerticalAlignment
forall (m :: * -> *) a. Monad m => a -> m a
return FontVerticalAlignment
FontVerticalAlignmentSuperscript
  fromAttrBs ByteString
x             = FormatCode -> ByteString -> Either FormatCode FontVerticalAlignment
forall a. FormatCode -> ByteString -> Either FormatCode a
unexpectedAttrBs FormatCode
"FontVerticalAlignment" ByteString
x

instance FromAttrVal FontScheme where
  fromAttrVal :: Reader FontScheme
fromAttrVal FormatCode
"major" = FontScheme -> Either String (FontScheme, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontScheme
FontSchemeMajor
  fromAttrVal FormatCode
"minor" = FontScheme -> Either String (FontScheme, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontScheme
FontSchemeMinor
  fromAttrVal FormatCode
"none"  = FontScheme -> Either String (FontScheme, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess FontScheme
FontSchemeNone
  fromAttrVal FormatCode
t       = FormatCode -> Reader FontScheme
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"FontScheme" FormatCode
t

instance FromAttrBs FontScheme where
  fromAttrBs :: ByteString -> Either FormatCode FontScheme
fromAttrBs ByteString
"major" = FontScheme -> Either FormatCode FontScheme
forall (m :: * -> *) a. Monad m => a -> m a
return FontScheme
FontSchemeMajor
  fromAttrBs ByteString
"minor" = FontScheme -> Either FormatCode FontScheme
forall (m :: * -> *) a. Monad m => a -> m a
return FontScheme
FontSchemeMinor
  fromAttrBs ByteString
"none"  = FontScheme -> Either FormatCode FontScheme
forall (m :: * -> *) a. Monad m => a -> m a
return FontScheme
FontSchemeNone
  fromAttrBs ByteString
x       = FormatCode -> ByteString -> Either FormatCode FontScheme
forall a. FormatCode -> ByteString -> Either FormatCode a
unexpectedAttrBs FormatCode
"FontScheme" ByteString
x

-- | See @CT_Fill@, p. 4484
instance FromCursor Fill where
  fromCursor :: Cursor -> [Fill]
fromCursor Cursor
cur = do
    Maybe FillPattern
_fillPattern <- Name -> Cursor -> [Maybe FillPattern]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"patternFill") Cursor
cur
    Fill -> [Fill]
forall (m :: * -> *) a. Monad m => a -> m a
return Fill :: Maybe FillPattern -> Fill
Fill{Maybe FillPattern
_fillPattern :: Maybe FillPattern
_fillPattern :: Maybe FillPattern
..}

-- | See @CT_PatternFill@, p. 4484
instance FromCursor FillPattern where
  fromCursor :: Cursor -> [FillPattern]
fromCursor Cursor
cur = do
    Maybe PatternType
_fillPatternType <- Name -> Cursor -> [Maybe PatternType]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"patternType" Cursor
cur
    Maybe Color
_fillPatternFgColor <- Name -> Cursor -> [Maybe Color]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"fgColor") Cursor
cur
    Maybe Color
_fillPatternBgColor <- Name -> Cursor -> [Maybe Color]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"bgColor") Cursor
cur
    FillPattern -> [FillPattern]
forall (m :: * -> *) a. Monad m => a -> m a
return FillPattern :: Maybe Color -> Maybe Color -> Maybe PatternType -> FillPattern
FillPattern{Maybe PatternType
Maybe Color
_fillPatternBgColor :: Maybe Color
_fillPatternFgColor :: Maybe Color
_fillPatternType :: Maybe PatternType
_fillPatternType :: Maybe PatternType
_fillPatternFgColor :: Maybe Color
_fillPatternBgColor :: Maybe Color
..}

instance FromAttrVal PatternType where
  fromAttrVal :: Reader PatternType
fromAttrVal FormatCode
"darkDown"        = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkDown
  fromAttrVal FormatCode
"darkGray"        = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkGray
  fromAttrVal FormatCode
"darkGrid"        = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkGrid
  fromAttrVal FormatCode
"darkHorizontal"  = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkHorizontal
  fromAttrVal FormatCode
"darkTrellis"     = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkTrellis
  fromAttrVal FormatCode
"darkUp"          = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkUp
  fromAttrVal FormatCode
"darkVertical"    = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeDarkVertical
  fromAttrVal FormatCode
"gray0625"        = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeGray0625
  fromAttrVal FormatCode
"gray125"         = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeGray125
  fromAttrVal FormatCode
"lightDown"       = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightDown
  fromAttrVal FormatCode
"lightGray"       = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightGray
  fromAttrVal FormatCode
"lightGrid"       = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightGrid
  fromAttrVal FormatCode
"lightHorizontal" = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightHorizontal
  fromAttrVal FormatCode
"lightTrellis"    = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightTrellis
  fromAttrVal FormatCode
"lightUp"         = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightUp
  fromAttrVal FormatCode
"lightVertical"   = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeLightVertical
  fromAttrVal FormatCode
"mediumGray"      = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeMediumGray
  fromAttrVal FormatCode
"none"            = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeNone
  fromAttrVal FormatCode
"solid"           = PatternType -> Either String (PatternType, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess PatternType
PatternTypeSolid
  fromAttrVal FormatCode
t                 = FormatCode -> Reader PatternType
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"PatternType" FormatCode
t

-- | See @CT_Border@, p. 4483
instance FromCursor Border where
  fromCursor :: Cursor -> [Border]
fromCursor Cursor
cur = do
    Maybe Bool
_borderDiagonalUp   <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"diagonalUp" Cursor
cur
    Maybe Bool
_borderDiagonalDown <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"diagonalDown" Cursor
cur
    Maybe Bool
_borderOutline      <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"outline" Cursor
cur
    Maybe BorderStyle
_borderStart      <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"start") Cursor
cur
    Maybe BorderStyle
_borderEnd        <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"end") Cursor
cur
    Maybe BorderStyle
_borderLeft       <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"left") Cursor
cur
    Maybe BorderStyle
_borderRight      <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"right") Cursor
cur
    Maybe BorderStyle
_borderTop        <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"top") Cursor
cur
    Maybe BorderStyle
_borderBottom     <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"bottom") Cursor
cur
    Maybe BorderStyle
_borderDiagonal   <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"diagonal") Cursor
cur
    Maybe BorderStyle
_borderVertical   <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"vertical") Cursor
cur
    Maybe BorderStyle
_borderHorizontal <- Name -> Cursor -> [Maybe BorderStyle]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"horizontal") Cursor
cur
    Border -> [Border]
forall (m :: * -> *) a. Monad m => a -> m a
return Border :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Maybe BorderStyle
-> Border
Border{Maybe Bool
Maybe BorderStyle
_borderHorizontal :: Maybe BorderStyle
_borderVertical :: Maybe BorderStyle
_borderDiagonal :: Maybe BorderStyle
_borderBottom :: Maybe BorderStyle
_borderTop :: Maybe BorderStyle
_borderRight :: Maybe BorderStyle
_borderLeft :: Maybe BorderStyle
_borderEnd :: Maybe BorderStyle
_borderStart :: Maybe BorderStyle
_borderOutline :: Maybe Bool
_borderDiagonalDown :: Maybe Bool
_borderDiagonalUp :: Maybe Bool
_borderVertical :: Maybe BorderStyle
_borderTop :: Maybe BorderStyle
_borderStart :: Maybe BorderStyle
_borderRight :: Maybe BorderStyle
_borderLeft :: Maybe BorderStyle
_borderHorizontal :: Maybe BorderStyle
_borderEnd :: Maybe BorderStyle
_borderDiagonal :: Maybe BorderStyle
_borderBottom :: Maybe BorderStyle
_borderOutline :: Maybe Bool
_borderDiagonalUp :: Maybe Bool
_borderDiagonalDown :: Maybe Bool
..}

instance FromCursor BorderStyle where
  fromCursor :: Cursor -> [BorderStyle]
fromCursor Cursor
cur = do
    Maybe LineStyle
_borderStyleLine  <- Name -> Cursor -> [Maybe LineStyle]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"style" Cursor
cur
    Maybe Color
_borderStyleColor <- Name -> Cursor -> [Maybe Color]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"color") Cursor
cur
    BorderStyle -> [BorderStyle]
forall (m :: * -> *) a. Monad m => a -> m a
return BorderStyle :: Maybe Color -> Maybe LineStyle -> BorderStyle
BorderStyle{Maybe LineStyle
Maybe Color
_borderStyleColor :: Maybe Color
_borderStyleLine :: Maybe LineStyle
_borderStyleLine :: Maybe LineStyle
_borderStyleColor :: Maybe Color
..}

instance FromAttrVal LineStyle where
  fromAttrVal :: Reader LineStyle
fromAttrVal FormatCode
"dashDot"          = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleDashDot
  fromAttrVal FormatCode
"dashDotDot"       = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleDashDotDot
  fromAttrVal FormatCode
"dashed"           = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleDashed
  fromAttrVal FormatCode
"dotted"           = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleDotted
  fromAttrVal FormatCode
"double"           = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleDouble
  fromAttrVal FormatCode
"hair"             = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleHair
  fromAttrVal FormatCode
"medium"           = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleMedium
  fromAttrVal FormatCode
"mediumDashDot"    = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleMediumDashDot
  fromAttrVal FormatCode
"mediumDashDotDot" = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleMediumDashDotDot
  fromAttrVal FormatCode
"mediumDashed"     = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleMediumDashed
  fromAttrVal FormatCode
"none"             = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleNone
  fromAttrVal FormatCode
"slantDashDot"     = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleSlantDashDot
  fromAttrVal FormatCode
"thick"            = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleThick
  fromAttrVal FormatCode
"thin"             = LineStyle -> Either String (LineStyle, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess LineStyle
LineStyleThin
  fromAttrVal FormatCode
t                  = FormatCode -> Reader LineStyle
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"LineStyle" FormatCode
t

-- | See @CT_Xf@, p. 4486
instance FromCursor CellXf where
  fromCursor :: Cursor -> [CellXf]
fromCursor Cursor
cur = do
    Maybe Alignment
_cellXfAlignment  <- Name -> Cursor -> [Maybe Alignment]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"alignment") Cursor
cur
    Maybe Protection
_cellXfProtection <- Name -> Cursor -> [Maybe Protection]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"protection") Cursor
cur
    Maybe Int
_cellXfNumFmtId          <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"numFmtId" Cursor
cur
    Maybe Int
_cellXfFontId            <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"fontId" Cursor
cur
    Maybe Int
_cellXfFillId            <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"fillId" Cursor
cur
    Maybe Int
_cellXfBorderId          <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"borderId" Cursor
cur
    Maybe Int
_cellXfId                <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"xfId" Cursor
cur
    Maybe Bool
_cellXfQuotePrefix       <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"quotePrefix" Cursor
cur
    Maybe Bool
_cellXfPivotButton       <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"pivotButton" Cursor
cur
    Maybe Bool
_cellXfApplyNumberFormat <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyNumberFormat" Cursor
cur
    Maybe Bool
_cellXfApplyFont         <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyFont" Cursor
cur
    Maybe Bool
_cellXfApplyFill         <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyFill" Cursor
cur
    Maybe Bool
_cellXfApplyBorder       <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyBorder" Cursor
cur
    Maybe Bool
_cellXfApplyAlignment    <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyAlignment" Cursor
cur
    Maybe Bool
_cellXfApplyProtection   <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"applyProtection" Cursor
cur
    CellXf -> [CellXf]
forall (m :: * -> *) a. Monad m => a -> m a
return 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{Maybe Bool
Maybe Int
Maybe Protection
Maybe Alignment
_cellXfApplyProtection :: Maybe Bool
_cellXfApplyAlignment :: Maybe Bool
_cellXfApplyBorder :: Maybe Bool
_cellXfApplyFill :: Maybe Bool
_cellXfApplyFont :: Maybe Bool
_cellXfApplyNumberFormat :: Maybe Bool
_cellXfPivotButton :: Maybe Bool
_cellXfQuotePrefix :: Maybe Bool
_cellXfId :: Maybe Int
_cellXfBorderId :: Maybe Int
_cellXfFillId :: Maybe Int
_cellXfFontId :: Maybe Int
_cellXfNumFmtId :: Maybe Int
_cellXfProtection :: Maybe Protection
_cellXfAlignment :: Maybe Alignment
_cellXfProtection :: Maybe Protection
_cellXfAlignment :: Maybe Alignment
_cellXfId :: Maybe Int
_cellXfQuotePrefix :: Maybe Bool
_cellXfPivotButton :: Maybe Bool
_cellXfNumFmtId :: Maybe Int
_cellXfFontId :: Maybe Int
_cellXfFillId :: Maybe Int
_cellXfBorderId :: Maybe Int
_cellXfApplyProtection :: Maybe Bool
_cellXfApplyNumberFormat :: Maybe Bool
_cellXfApplyFont :: Maybe Bool
_cellXfApplyFill :: Maybe Bool
_cellXfApplyBorder :: Maybe Bool
_cellXfApplyAlignment :: Maybe Bool
..}

-- | See @CT_Dxf@, p. 3937
instance FromCursor Dxf where
    fromCursor :: Cursor -> [Dxf]
fromCursor Cursor
cur = do
      Maybe Font
_dxfFont         <- Name -> Cursor -> [Maybe Font]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"font") Cursor
cur
      Maybe NumFmt
_dxfNumFmt       <- Name -> Cursor -> [Maybe NumFmt]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"numFmt") Cursor
cur
      Maybe Fill
_dxfFill         <- Name -> Cursor -> [Maybe Fill]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"fill") Cursor
cur
      Maybe Alignment
_dxfAlignment    <- Name -> Cursor -> [Maybe Alignment]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"alignment") Cursor
cur
      Maybe Border
_dxfBorder       <- Name -> Cursor -> [Maybe Border]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"border") Cursor
cur
      Maybe Protection
_dxfProtection   <- Name -> Cursor -> [Maybe Protection]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (FormatCode -> Name
n_ FormatCode
"protection") Cursor
cur
      Dxf -> [Dxf]
forall (m :: * -> *) a. Monad m => a -> m a
return Dxf :: Maybe Font
-> Maybe NumFmt
-> Maybe Fill
-> Maybe Alignment
-> Maybe Border
-> Maybe Protection
-> Dxf
Dxf{Maybe Protection
Maybe NumFmt
Maybe Font
Maybe Fill
Maybe Border
Maybe Alignment
_dxfProtection :: Maybe Protection
_dxfBorder :: Maybe Border
_dxfAlignment :: Maybe Alignment
_dxfFill :: Maybe Fill
_dxfNumFmt :: Maybe NumFmt
_dxfFont :: Maybe Font
_dxfProtection :: Maybe Protection
_dxfBorder :: Maybe Border
_dxfAlignment :: Maybe Alignment
_dxfFill :: Maybe Fill
_dxfNumFmt :: Maybe NumFmt
_dxfFont :: Maybe Font
..}

-- | See @CT_NumFmt@, p. 3936
instance FromCursor NumFmt where
  fromCursor :: Cursor -> [NumFmt]
fromCursor Cursor
cur = do
    FormatCode
_numFmtCode <- Name -> Cursor -> [FormatCode]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"formatCode" Cursor
cur
    Int
_numFmtId   <- Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"numFmtId" Cursor
cur
    NumFmt -> [NumFmt]
forall (m :: * -> *) a. Monad m => a -> m a
return NumFmt :: Int -> FormatCode -> NumFmt
NumFmt{Int
FormatCode
_numFmtId :: Int
_numFmtCode :: FormatCode
_numFmtCode :: FormatCode
_numFmtId :: Int
..}

-- | See @CT_CellAlignment@, p. 4482
instance FromCursor Alignment where
  fromCursor :: Cursor -> [Alignment]
fromCursor Cursor
cur = do
    Maybe CellHorizontalAlignment
_alignmentHorizontal      <- Name -> Cursor -> [Maybe CellHorizontalAlignment]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"horizontal" Cursor
cur
    Maybe CellVerticalAlignment
_alignmentVertical        <- Name -> Cursor -> [Maybe CellVerticalAlignment]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"vertical" Cursor
cur
    Maybe Int
_alignmentTextRotation    <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"textRotation" Cursor
cur
    Maybe Bool
_alignmentWrapText        <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"wrapText" Cursor
cur
    Maybe Int
_alignmentRelativeIndent  <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"relativeIndent" Cursor
cur
    Maybe Int
_alignmentIndent          <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"indent" Cursor
cur
    Maybe Bool
_alignmentJustifyLastLine <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"justifyLastLine" Cursor
cur
    Maybe Bool
_alignmentShrinkToFit     <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"shrinkToFit" Cursor
cur
    Maybe ReadingOrder
_alignmentReadingOrder    <- Name -> Cursor -> [Maybe ReadingOrder]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"readingOrder" Cursor
cur
    Alignment -> [Alignment]
forall (m :: * -> *) a. Monad m => a -> m a
return Alignment :: Maybe CellHorizontalAlignment
-> Maybe Int
-> Maybe Bool
-> Maybe ReadingOrder
-> Maybe Int
-> Maybe Bool
-> Maybe Int
-> Maybe CellVerticalAlignment
-> Maybe Bool
-> Alignment
Alignment{Maybe Bool
Maybe Int
Maybe ReadingOrder
Maybe CellVerticalAlignment
Maybe CellHorizontalAlignment
_alignmentReadingOrder :: Maybe ReadingOrder
_alignmentShrinkToFit :: Maybe Bool
_alignmentJustifyLastLine :: Maybe Bool
_alignmentIndent :: Maybe Int
_alignmentRelativeIndent :: Maybe Int
_alignmentWrapText :: Maybe Bool
_alignmentTextRotation :: Maybe Int
_alignmentVertical :: Maybe CellVerticalAlignment
_alignmentHorizontal :: Maybe CellHorizontalAlignment
_alignmentWrapText :: Maybe Bool
_alignmentVertical :: Maybe CellVerticalAlignment
_alignmentTextRotation :: Maybe Int
_alignmentShrinkToFit :: Maybe Bool
_alignmentRelativeIndent :: Maybe Int
_alignmentReadingOrder :: Maybe ReadingOrder
_alignmentJustifyLastLine :: Maybe Bool
_alignmentIndent :: Maybe Int
_alignmentHorizontal :: Maybe CellHorizontalAlignment
..}

instance FromAttrVal CellHorizontalAlignment where
  fromAttrVal :: Reader CellHorizontalAlignment
fromAttrVal FormatCode
"center"           = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentCenter
  fromAttrVal FormatCode
"centerContinuous" = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentCenterContinuous
  fromAttrVal FormatCode
"distributed"      = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentDistributed
  fromAttrVal FormatCode
"fill"             = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentFill
  fromAttrVal FormatCode
"general"          = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentGeneral
  fromAttrVal FormatCode
"justify"          = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentJustify
  fromAttrVal FormatCode
"left"             = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentLeft
  fromAttrVal FormatCode
"right"            = CellHorizontalAlignment
-> Either String (CellHorizontalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellHorizontalAlignment
CellHorizontalAlignmentRight
  fromAttrVal FormatCode
t                  = FormatCode -> Reader CellHorizontalAlignment
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"CellHorizontalAlignment" FormatCode
t

instance FromAttrVal CellVerticalAlignment where
  fromAttrVal :: Reader CellVerticalAlignment
fromAttrVal FormatCode
"bottom"      = CellVerticalAlignment
-> Either String (CellVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellVerticalAlignment
CellVerticalAlignmentBottom
  fromAttrVal FormatCode
"center"      = CellVerticalAlignment
-> Either String (CellVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellVerticalAlignment
CellVerticalAlignmentCenter
  fromAttrVal FormatCode
"distributed" = CellVerticalAlignment
-> Either String (CellVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellVerticalAlignment
CellVerticalAlignmentDistributed
  fromAttrVal FormatCode
"justify"     = CellVerticalAlignment
-> Either String (CellVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellVerticalAlignment
CellVerticalAlignmentJustify
  fromAttrVal FormatCode
"top"         = CellVerticalAlignment
-> Either String (CellVerticalAlignment, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess CellVerticalAlignment
CellVerticalAlignmentTop
  fromAttrVal FormatCode
t             = FormatCode -> Reader CellVerticalAlignment
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"CellVerticalAlignment" FormatCode
t

instance FromAttrVal ReadingOrder where
  fromAttrVal :: Reader ReadingOrder
fromAttrVal FormatCode
"0" = ReadingOrder -> Either String (ReadingOrder, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess ReadingOrder
ReadingOrderContextDependent
  fromAttrVal FormatCode
"1" = ReadingOrder -> Either String (ReadingOrder, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess ReadingOrder
ReadingOrderLeftToRight
  fromAttrVal FormatCode
"2" = ReadingOrder -> Either String (ReadingOrder, FormatCode)
forall a. a -> Either String (a, FormatCode)
readSuccess ReadingOrder
ReadingOrderRightToLeft
  fromAttrVal FormatCode
t   = FormatCode -> Reader ReadingOrder
forall a. FormatCode -> FormatCode -> Either String (a, FormatCode)
invalidText FormatCode
"ReadingOrder" FormatCode
t

-- | See @CT_CellProtection@, p. 4484
instance FromCursor Protection where
  fromCursor :: Cursor -> [Protection]
fromCursor Cursor
cur = do
    Maybe Bool
_protectionLocked <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"locked" Cursor
cur
    Maybe Bool
_protectionHidden <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"hidden" Cursor
cur
    Protection -> [Protection]
forall (m :: * -> *) a. Monad m => a -> m a
return Protection :: Maybe Bool -> Maybe Bool -> Protection
Protection{Maybe Bool
_protectionHidden :: Maybe Bool
_protectionLocked :: Maybe Bool
_protectionLocked :: Maybe Bool
_protectionHidden :: Maybe Bool
..}