{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.StyleSheet (
StyleSheet(..)
, CellXf(..)
, minimalStyleSheet
, Alignment(..)
, Border(..)
, BorderStyle(..)
, Color(..)
, Dxf(..)
, Fill(..)
, FillPattern(..)
, Font(..)
, NumberFormat(..)
, NumFmt(..)
, ImpliedNumberFormat (..)
, FormatCode
, Protection(..)
, CellHorizontalAlignment(..)
, CellVerticalAlignment(..)
, FontFamily(..)
, FontScheme(..)
, FontUnderline(..)
, FontVerticalAlignment(..)
, LineStyle(..)
, PatternType(..)
, ReadingOrder(..)
, styleSheetBorders
, styleSheetFonts
, styleSheetFills
, styleSheetCellXfs
, styleSheetDxfs
, styleSheetNumFmts
, cellXfApplyAlignment
, cellXfApplyBorder
, cellXfApplyFill
, cellXfApplyFont
, cellXfApplyNumberFormat
, cellXfApplyProtection
, cellXfBorderId
, cellXfFillId
, cellXfFontId
, cellXfNumFmtId
, cellXfPivotButton
, cellXfQuotePrefix
, cellXfId
, cellXfAlignment
, cellXfProtection
, dxfAlignment
, dxfBorder
, dxfFill
, dxfFont
, dxfNumFmt
, dxfProtection
, alignmentHorizontal
, alignmentIndent
, alignmentJustifyLastLine
, alignmentReadingOrder
, alignmentRelativeIndent
, alignmentShrinkToFit
, alignmentTextRotation
, alignmentVertical
, alignmentWrapText
, borderDiagonalDown
, borderDiagonalUp
, borderOutline
, borderBottom
, borderDiagonal
, borderEnd
, borderHorizontal
, borderStart
, borderTop
, borderVertical
, borderLeft
, borderRight
, borderStyleColor
, borderStyleLine
, colorAutomatic
, colorARGB
, colorTheme
, colorTint
, fillPattern
, fillPatternBgColor
, fillPatternFgColor
, fillPatternType
, fontBold
, fontCharset
, fontColor
, fontCondense
, fontExtend
, fontFamily
, fontItalic
, fontName
, fontOutline
, fontScheme
, fontShadow
, fontStrikeThrough
, fontSize
, fontUnderline
, fontVertAlign
, protectionHidden
, protectionLocked
, fmtDecimals
, fmtDecimalsZeroes
, stdNumberFormatId
, idToStdNumberFormat
, firstUserNumFmtId
) where
import Control.Lens hiding (element, elements, (.=))
import Control.DeepSeq (NFData)
import Data.Default
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes)
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
data StyleSheet = StyleSheet
{ _styleSheetBorders :: [Border]
, _styleSheetCellXfs :: [CellXf]
, _styleSheetFills :: [Fill]
, _styleSheetFonts :: [Font]
, _styleSheetDxfs :: [Dxf]
, _styleSheetNumFmts :: Map Int FormatCode
} deriving (Eq, Ord, Show, Generic)
instance NFData StyleSheet
data CellXf = CellXf {
_cellXfApplyAlignment :: Maybe Bool
, _cellXfApplyBorder :: Maybe Bool
, _cellXfApplyFill :: Maybe Bool
, _cellXfApplyFont :: Maybe Bool
, _cellXfApplyNumberFormat :: Maybe Bool
, _cellXfApplyProtection :: Maybe Bool
, _cellXfBorderId :: Maybe Int
, _cellXfFillId :: Maybe Int
, _cellXfFontId :: Maybe Int
, _cellXfNumFmtId :: Maybe Int
, _cellXfPivotButton :: Maybe Bool
, _cellXfQuotePrefix :: Maybe Bool
, _cellXfId :: Maybe Int
, _cellXfAlignment :: Maybe Alignment
, _cellXfProtection :: Maybe Protection
}
deriving (Eq, Ord, Show, Generic)
instance NFData CellXf
data Alignment = Alignment {
_alignmentHorizontal :: Maybe CellHorizontalAlignment
, _alignmentIndent :: Maybe Int
, _alignmentJustifyLastLine :: Maybe Bool
, _alignmentReadingOrder :: Maybe ReadingOrder
, _alignmentRelativeIndent :: Maybe Int
, _alignmentShrinkToFit :: Maybe Bool
, _alignmentTextRotation :: Maybe Int
, _alignmentVertical :: Maybe CellVerticalAlignment
, _alignmentWrapText :: Maybe Bool
}
deriving (Eq, Ord, Show, Generic)
instance NFData Alignment
data Border = Border {
_borderDiagonalDown :: Maybe Bool
, _borderDiagonalUp :: Maybe Bool
, _borderOutline :: Maybe Bool
, _borderBottom :: Maybe BorderStyle
, _borderDiagonal :: Maybe BorderStyle
, _borderEnd :: Maybe BorderStyle
, _borderHorizontal :: Maybe BorderStyle
, _borderLeft :: Maybe BorderStyle
, _borderRight :: Maybe BorderStyle
, _borderStart :: Maybe BorderStyle
, _borderTop :: Maybe BorderStyle
, _borderVertical :: Maybe BorderStyle
}
deriving (Eq, Ord, Show, Generic)
instance NFData Border
data BorderStyle = BorderStyle {
_borderStyleColor :: Maybe Color
, _borderStyleLine :: Maybe LineStyle
}
deriving (Eq, Ord, Show, Generic)
instance NFData BorderStyle
data Color = Color {
_colorAutomatic :: Maybe Bool
, _colorARGB :: Maybe Text
, _colorTheme :: Maybe Int
, _colorTint :: Maybe Double
}
deriving (Eq, Ord, Show, Generic)
instance NFData Color
data Fill = Fill {
_fillPattern :: Maybe FillPattern
}
deriving (Eq, Ord, Show, Generic)
instance NFData Fill
data FillPattern = FillPattern {
_fillPatternBgColor :: Maybe Color
, _fillPatternFgColor :: Maybe Color
, _fillPatternType :: Maybe PatternType
}
deriving (Eq, Ord, Show, Generic)
instance NFData FillPattern
data Font = Font {
_fontBold :: Maybe Bool
, _fontCharset :: Maybe Int
, _fontColor :: Maybe Color
, _fontCondense :: Maybe Bool
, _fontExtend :: Maybe Bool
, _fontFamily :: Maybe FontFamily
, _fontItalic :: Maybe Bool
, _fontName :: Maybe Text
, _fontOutline :: Maybe Bool
, _fontScheme :: Maybe FontScheme
, _fontShadow :: Maybe Bool
, _fontStrikeThrough :: Maybe Bool
, _fontSize :: Maybe Double
, _fontUnderline :: Maybe FontUnderline
, _fontVertAlign :: Maybe FontVerticalAlignment
}
deriving (Eq, Ord, Show, Generic)
instance NFData Font
data Dxf = Dxf
{ _dxfFont :: Maybe Font
, _dxfNumFmt :: Maybe NumFmt
, _dxfFill :: Maybe Fill
, _dxfAlignment :: Maybe Alignment
, _dxfBorder :: Maybe Border
, _dxfProtection :: Maybe Protection
} deriving (Eq, Ord, Show, Generic)
instance NFData Dxf
type FormatCode = Text
data NumFmt = NumFmt
{ _numFmtId :: Int
, _numFmtCode :: FormatCode
} deriving (Eq, Ord, Show, Generic)
instance NFData NumFmt
mkNumFmtPair :: NumFmt -> (Int, FormatCode)
mkNumFmtPair NumFmt{..} = (_numFmtId, _numFmtCode)
data NumberFormat
= StdNumberFormat ImpliedNumberFormat
| UserNumberFormat FormatCode
deriving (Eq, Ord, Show, Generic)
instance NFData NumberFormat
fmtDecimals :: Int -> NumberFormat
fmtDecimals k = UserNumberFormat $ "0." <> T.replicate k "#"
fmtDecimalsZeroes :: Int -> NumberFormat
fmtDecimalsZeroes k = UserNumberFormat $ "0." <> T.replicate k "0"
data ImpliedNumberFormat =
NfGeneral
| NfZero
| Nf2Decimal
| NfMax3Decimal
| NfThousandSeparator2Decimal
| NfPercent
| NfPercent2Decimal
| NfExponent2Decimal
| NfSingleSpacedFraction
| NfDoubleSpacedFraction
| NfMmDdYy
| NfDMmmYy
| NfDMmm
| NfMmmYy
| NfHMm12Hr
| NfHMmSs12Hr
| NfHMm
| NfHMmSs
| NfMdyHMm
| NfThousandsNegativeParens
| NfThousandsNegativeRed
| NfThousands2DecimalNegativeParens
| NfThousands2DecimalNegativeRed
| NfMmSs
| NfOptHMmSs
| NfMmSs1Decimal
| NfExponent1Decimal
| NfTextPlaceHolder
| NfOtherImplied Int
deriving (Eq, Ord, Show, Generic)
instance NFData ImpliedNumberFormat
stdNumberFormatId :: ImpliedNumberFormat -> Int
stdNumberFormatId NfGeneral = 0
stdNumberFormatId NfZero = 1
stdNumberFormatId Nf2Decimal = 2
stdNumberFormatId NfMax3Decimal = 3
stdNumberFormatId NfThousandSeparator2Decimal = 4
stdNumberFormatId NfPercent = 9
stdNumberFormatId NfPercent2Decimal = 10
stdNumberFormatId NfExponent2Decimal = 11
stdNumberFormatId NfSingleSpacedFraction = 12
stdNumberFormatId NfDoubleSpacedFraction = 13
stdNumberFormatId NfMmDdYy = 14
stdNumberFormatId NfDMmmYy = 15
stdNumberFormatId NfDMmm = 16
stdNumberFormatId NfMmmYy = 17
stdNumberFormatId NfHMm12Hr = 18
stdNumberFormatId NfHMmSs12Hr = 19
stdNumberFormatId NfHMm = 20
stdNumberFormatId NfHMmSs = 21
stdNumberFormatId NfMdyHMm = 22
stdNumberFormatId NfThousandsNegativeParens = 37
stdNumberFormatId NfThousandsNegativeRed = 38
stdNumberFormatId NfThousands2DecimalNegativeParens = 39
stdNumberFormatId NfThousands2DecimalNegativeRed = 40
stdNumberFormatId NfMmSs = 45
stdNumberFormatId NfOptHMmSs = 46
stdNumberFormatId NfMmSs1Decimal = 47
stdNumberFormatId NfExponent1Decimal = 48
stdNumberFormatId NfTextPlaceHolder = 49
stdNumberFormatId (NfOtherImplied i) = i
idToStdNumberFormat :: Int -> Maybe ImpliedNumberFormat
idToStdNumberFormat 0 = Just NfGeneral
idToStdNumberFormat 1 = Just NfZero
idToStdNumberFormat 2 = Just Nf2Decimal
idToStdNumberFormat 3 = Just NfMax3Decimal
idToStdNumberFormat 4 = Just NfThousandSeparator2Decimal
idToStdNumberFormat 9 = Just NfPercent
idToStdNumberFormat 10 = Just NfPercent2Decimal
idToStdNumberFormat 11 = Just NfExponent2Decimal
idToStdNumberFormat 12 = Just NfSingleSpacedFraction
idToStdNumberFormat 13 = Just NfDoubleSpacedFraction
idToStdNumberFormat 14 = Just NfMmDdYy
idToStdNumberFormat 15 = Just NfDMmmYy
idToStdNumberFormat 16 = Just NfDMmm
idToStdNumberFormat 17 = Just NfMmmYy
idToStdNumberFormat 18 = Just NfHMm12Hr
idToStdNumberFormat 19 = Just NfHMmSs12Hr
idToStdNumberFormat 20 = Just NfHMm
idToStdNumberFormat 21 = Just NfHMmSs
idToStdNumberFormat 22 = Just NfMdyHMm
idToStdNumberFormat 37 = Just NfThousandsNegativeParens
idToStdNumberFormat 38 = Just NfThousandsNegativeRed
idToStdNumberFormat 39 = Just NfThousands2DecimalNegativeParens
idToStdNumberFormat 40 = Just NfThousands2DecimalNegativeRed
idToStdNumberFormat 45 = Just NfMmSs
idToStdNumberFormat 46 = Just NfOptHMmSs
idToStdNumberFormat 47 = Just NfMmSs1Decimal
idToStdNumberFormat 48 = Just NfExponent1Decimal
idToStdNumberFormat 49 = Just NfTextPlaceHolder
idToStdNumberFormat i = if i < firstUserNumFmtId then Just (NfOtherImplied i) else Nothing
firstUserNumFmtId :: Int
firstUserNumFmtId = 164
data Protection = Protection {
_protectionHidden :: Maybe Bool
, _protectionLocked :: Maybe Bool
}
deriving (Eq, Ord, Show, Generic)
instance NFData Protection
data CellHorizontalAlignment =
CellHorizontalAlignmentCenter
| CellHorizontalAlignmentCenterContinuous
| CellHorizontalAlignmentDistributed
| CellHorizontalAlignmentFill
| CellHorizontalAlignmentGeneral
| CellHorizontalAlignmentJustify
| CellHorizontalAlignmentLeft
| CellHorizontalAlignmentRight
deriving (Eq, Ord, Show, Generic)
instance NFData CellHorizontalAlignment
data CellVerticalAlignment =
CellVerticalAlignmentBottom
| CellVerticalAlignmentCenter
| CellVerticalAlignmentDistributed
| CellVerticalAlignmentJustify
| CellVerticalAlignmentTop
deriving (Eq, Ord, Show, Generic)
instance NFData CellVerticalAlignment
data FontFamily =
FontFamilyNotApplicable
| FontFamilyRoman
| FontFamilySwiss
| FontFamilyModern
| FontFamilyScript
| FontFamilyDecorative
deriving (Eq, Ord, Show, Generic)
instance NFData FontFamily
data FontScheme =
FontSchemeMajor
| FontSchemeMinor
| FontSchemeNone
deriving (Eq, Ord, Show, Generic)
instance NFData FontScheme
data FontUnderline =
FontUnderlineSingle
| FontUnderlineDouble
| FontUnderlineSingleAccounting
| FontUnderlineDoubleAccounting
| FontUnderlineNone
deriving (Eq, Ord, Show, Generic)
instance NFData FontUnderline
data FontVerticalAlignment =
FontVerticalAlignmentBaseline
| FontVerticalAlignmentSubscript
| FontVerticalAlignmentSuperscript
deriving (Eq, Ord, Show, Generic)
instance NFData FontVerticalAlignment
data LineStyle =
LineStyleDashDot
| LineStyleDashDotDot
| LineStyleDashed
| LineStyleDotted
| LineStyleDouble
| LineStyleHair
| LineStyleMedium
| LineStyleMediumDashDot
| LineStyleMediumDashDotDot
| LineStyleMediumDashed
| LineStyleNone
| LineStyleSlantDashDot
| LineStyleThick
| LineStyleThin
deriving (Eq, Ord, Show, Generic)
instance NFData LineStyle
data PatternType =
PatternTypeDarkDown
| PatternTypeDarkGray
| PatternTypeDarkGrid
| PatternTypeDarkHorizontal
| PatternTypeDarkTrellis
| PatternTypeDarkUp
| PatternTypeDarkVertical
| PatternTypeGray0625
| PatternTypeGray125
| PatternTypeLightDown
| PatternTypeLightGray
| PatternTypeLightGrid
| PatternTypeLightHorizontal
| PatternTypeLightTrellis
| PatternTypeLightUp
| PatternTypeLightVertical
| PatternTypeMediumGray
| PatternTypeNone
| PatternTypeSolid
deriving (Eq, Ord, Show, Generic)
instance NFData PatternType
data ReadingOrder =
ReadingOrderContextDependent
| ReadingOrderLeftToRight
| ReadingOrderRightToLeft
deriving (Eq, Ord, Show, Generic)
instance NFData ReadingOrder
makeLenses ''StyleSheet
makeLenses ''CellXf
makeLenses ''Dxf
makeLenses ''Alignment
makeLenses ''Border
makeLenses ''BorderStyle
makeLenses ''Color
makeLenses ''Fill
makeLenses ''FillPattern
makeLenses ''Font
makeLenses ''Protection
minimalStyleSheet :: StyleSheet
minimalStyleSheet = def
& styleSheetBorders .~ [defaultBorder]
& styleSheetFonts .~ [defaultFont]
& styleSheetFills .~ [fillNone, fillGray125]
& styleSheetCellXfs .~ [defaultCellXf]
where
defaultBorder :: Border
defaultBorder = def
& borderBottom .~ Just def
& borderTop .~ Just def
& borderLeft .~ Just def
& borderRight .~ Just def
defaultFont :: Font
defaultFont = def
& fontFamily .~ Just FontFamilySwiss
& fontSize .~ Just 11
fillNone, fillGray125 :: Fill
fillNone = def
& fillPattern .~ Just (def & fillPatternType .~ Just PatternTypeNone)
fillGray125 = def
& fillPattern .~ Just (def & fillPatternType .~ Just PatternTypeGray125)
defaultCellXf :: CellXf
defaultCellXf = def
& cellXfBorderId .~ Just 0
& cellXfFillId .~ Just 0
& cellXfFontId .~ Just 0
instance Default StyleSheet where
def = StyleSheet {
_styleSheetBorders = []
, _styleSheetFonts = []
, _styleSheetFills = []
, _styleSheetCellXfs = []
, _styleSheetDxfs = []
, _styleSheetNumFmts = M.empty
}
instance Default CellXf where
def = CellXf {
_cellXfApplyAlignment = Nothing
, _cellXfApplyBorder = Nothing
, _cellXfApplyFill = Nothing
, _cellXfApplyFont = Nothing
, _cellXfApplyNumberFormat = Nothing
, _cellXfApplyProtection = Nothing
, _cellXfBorderId = Nothing
, _cellXfFillId = Nothing
, _cellXfFontId = Nothing
, _cellXfNumFmtId = Nothing
, _cellXfPivotButton = Nothing
, _cellXfQuotePrefix = Nothing
, _cellXfId = Nothing
, _cellXfAlignment = Nothing
, _cellXfProtection = Nothing
}
instance Default Dxf where
def = Dxf
{ _dxfFont = Nothing
, _dxfNumFmt = Nothing
, _dxfFill = Nothing
, _dxfAlignment = Nothing
, _dxfBorder = Nothing
, _dxfProtection = Nothing
}
instance Default Alignment where
def = Alignment {
_alignmentHorizontal = Nothing
, _alignmentIndent = Nothing
, _alignmentJustifyLastLine = Nothing
, _alignmentReadingOrder = Nothing
, _alignmentRelativeIndent = Nothing
, _alignmentShrinkToFit = Nothing
, _alignmentTextRotation = Nothing
, _alignmentVertical = Nothing
, _alignmentWrapText = Nothing
}
instance Default Border where
def = Border {
_borderDiagonalDown = Nothing
, _borderDiagonalUp = Nothing
, _borderOutline = Nothing
, _borderBottom = Nothing
, _borderDiagonal = Nothing
, _borderEnd = Nothing
, _borderHorizontal = Nothing
, _borderStart = Nothing
, _borderTop = Nothing
, _borderVertical = Nothing
, _borderLeft = Nothing
, _borderRight = Nothing
}
instance Default BorderStyle where
def = BorderStyle {
_borderStyleColor = Nothing
, _borderStyleLine = Nothing
}
instance Default Color where
def = Color {
_colorAutomatic = Nothing
, _colorARGB = Nothing
, _colorTheme = Nothing
, _colorTint = Nothing
}
instance Default Fill where
def = Fill {
_fillPattern = Nothing
}
instance Default FillPattern where
def = FillPattern {
_fillPatternBgColor = Nothing
, _fillPatternFgColor = Nothing
, _fillPatternType = Nothing
}
instance Default Font where
def = Font {
_fontBold = Nothing
, _fontCharset = Nothing
, _fontColor = Nothing
, _fontCondense = Nothing
, _fontExtend = Nothing
, _fontFamily = Nothing
, _fontItalic = Nothing
, _fontName = Nothing
, _fontOutline = Nothing
, _fontScheme = Nothing
, _fontShadow = Nothing
, _fontStrikeThrough = Nothing
, _fontSize = Nothing
, _fontUnderline = Nothing
, _fontVertAlign = Nothing
}
instance Default Protection where
def = Protection {
_protectionHidden = Nothing
, _protectionLocked = Nothing
}
instance ToDocument StyleSheet where
toDocument = documentFromElement "Stylesheet generated by xlsx"
. toElement "styleSheet"
instance ToElement StyleSheet where
toElement nm StyleSheet{..} = elementListSimple nm elements
where
elements = [ countedElementList "numFmts" $ map (toElement "numFmt") numFmts
, countedElementList "fonts" $ map (toElement "font") _styleSheetFonts
, countedElementList "fills" $ map (toElement "fill") _styleSheetFills
, countedElementList "borders" $ map (toElement "border") _styleSheetBorders
, countedElementList "cellXfs" $ map (toElement "xf") _styleSheetCellXfs
, countedElementList "dxfs" $ map (toElement "dxf") _styleSheetDxfs
]
numFmts = map (uncurry NumFmt) $ M.toList _styleSheetNumFmts
instance ToElement CellXf where
toElement nm CellXf{..} = Element {
elementName = nm
, elementNodes = map NodeElement . catMaybes $ [
toElement "alignment" <$> _cellXfAlignment
, toElement "protection" <$> _cellXfProtection
]
, elementAttributes = M.fromList . catMaybes $ [
"numFmtId" .=? _cellXfNumFmtId
, "fontId" .=? _cellXfFontId
, "fillId" .=? _cellXfFillId
, "borderId" .=? _cellXfBorderId
, "xfId" .=? _cellXfId
, "quotePrefix" .=? _cellXfQuotePrefix
, "pivotButton" .=? _cellXfPivotButton
, "applyNumberFormat" .=? _cellXfApplyNumberFormat
, "applyFont" .=? _cellXfApplyFont
, "applyFill" .=? _cellXfApplyFill
, "applyBorder" .=? _cellXfApplyBorder
, "applyAlignment" .=? _cellXfApplyAlignment
, "applyProtection" .=? _cellXfApplyProtection
]
}
instance ToElement Dxf where
toElement nm Dxf{..} = Element
{ elementName = nm
, elementNodes = map NodeElement $
catMaybes [ toElement "font" <$> _dxfFont
, toElement "numFmt" <$> _dxfNumFmt
, toElement "fill" <$> _dxfFill
, toElement "alignment" <$> _dxfAlignment
, toElement "border" <$> _dxfBorder
, toElement "protection" <$> _dxfProtection
]
, elementAttributes = M.empty
}
instance ToElement Alignment where
toElement nm Alignment{..} = Element {
elementName = nm
, elementNodes = []
, elementAttributes = M.fromList . catMaybes $ [
"horizontal" .=? _alignmentHorizontal
, "vertical" .=? _alignmentVertical
, "textRotation" .=? _alignmentTextRotation
, "wrapText" .=? _alignmentWrapText
, "relativeIndent" .=? _alignmentRelativeIndent
, "indent" .=? _alignmentIndent
, "justifyLastLine" .=? _alignmentJustifyLastLine
, "shrinkToFit" .=? _alignmentShrinkToFit
, "readingOrder" .=? _alignmentReadingOrder
]
}
instance ToElement Border where
toElement nm Border{..} = Element {
elementName = nm
, elementAttributes = M.fromList . catMaybes $ [
"diagonalUp" .=? _borderDiagonalUp
, "diagonalDown" .=? _borderDiagonalDown
, "outline" .=? _borderOutline
]
, elementNodes = map NodeElement . catMaybes $ [
toElement "start" <$> _borderStart
, toElement "end" <$> _borderEnd
, toElement "left" <$> _borderLeft
, toElement "right" <$> _borderRight
, toElement "top" <$> _borderTop
, toElement "bottom" <$> _borderBottom
, toElement "diagonal" <$> _borderDiagonal
, toElement "vertical" <$> _borderVertical
, toElement "horizontal" <$> _borderHorizontal
]
}
instance ToElement BorderStyle where
toElement nm BorderStyle{..} = Element {
elementName = nm
, elementAttributes = M.fromList . catMaybes $ [
"style" .=? _borderStyleLine
]
, elementNodes = map NodeElement . catMaybes $ [
toElement "color" <$> _borderStyleColor
]
}
instance ToElement Color where
toElement nm Color{..} = Element {
elementName = nm
, elementNodes = []
, elementAttributes = M.fromList . catMaybes $ [
"auto" .=? _colorAutomatic
, "rgb" .=? _colorARGB
, "theme" .=? _colorTheme
, "tint" .=? _colorTint
]
}
instance ToElement Fill where
toElement nm Fill{..} = Element {
elementName = nm
, elementAttributes = M.empty
, elementNodes = map NodeElement . catMaybes $ [
toElement "patternFill" <$> _fillPattern
]
}
instance ToElement FillPattern where
toElement nm FillPattern{..} = Element {
elementName = nm
, elementAttributes = M.fromList . catMaybes $ [
"patternType" .=? _fillPatternType
]
, elementNodes = map NodeElement . catMaybes $ [
toElement "fgColor" <$> _fillPatternFgColor
, toElement "bgColor" <$> _fillPatternBgColor
]
}
instance ToElement Font where
toElement nm Font{..} = Element {
elementName = nm
, elementAttributes = M.empty
, elementNodes = map NodeElement . catMaybes $ [
elementValue "name" <$> _fontName
, elementValue "charset" <$> _fontCharset
, elementValue "family" <$> _fontFamily
, elementValue "b" <$> _fontBold
, elementValue "i" <$> _fontItalic
, elementValue "strike" <$> _fontStrikeThrough
, elementValue "outline" <$> _fontOutline
, elementValue "shadow" <$> _fontShadow
, elementValue "condense" <$> _fontCondense
, elementValue "extend" <$> _fontExtend
, toElement "color" <$> _fontColor
, elementValue "sz" <$> _fontSize
, elementValue "u" <$> _fontUnderline
, elementValue "vertAlign" <$> _fontVertAlign
, elementValue "scheme" <$> _fontScheme
]
}
instance ToElement NumFmt where
toElement nm (NumFmt {..}) =
leafElement nm
[ "numFmtId" .= toAttrVal _numFmtId
, "formatCode" .= toAttrVal _numFmtCode
]
instance ToElement Protection where
toElement nm Protection{..} = Element {
elementName = nm
, elementNodes = []
, elementAttributes = M.fromList . catMaybes $ [
"locked" .=? _protectionLocked
, "hidden" .=? _protectionHidden
]
}
instance ToAttrVal CellHorizontalAlignment where
toAttrVal CellHorizontalAlignmentCenter = "center"
toAttrVal CellHorizontalAlignmentCenterContinuous = "centerContinuous"
toAttrVal CellHorizontalAlignmentDistributed = "distributed"
toAttrVal CellHorizontalAlignmentFill = "fill"
toAttrVal CellHorizontalAlignmentGeneral = "general"
toAttrVal CellHorizontalAlignmentJustify = "justify"
toAttrVal CellHorizontalAlignmentLeft = "left"
toAttrVal CellHorizontalAlignmentRight = "right"
instance ToAttrVal CellVerticalAlignment where
toAttrVal CellVerticalAlignmentBottom = "bottom"
toAttrVal CellVerticalAlignmentCenter = "center"
toAttrVal CellVerticalAlignmentDistributed = "distributed"
toAttrVal CellVerticalAlignmentJustify = "justify"
toAttrVal CellVerticalAlignmentTop = "top"
instance ToAttrVal FontFamily where
toAttrVal FontFamilyNotApplicable = "0"
toAttrVal FontFamilyRoman = "1"
toAttrVal FontFamilySwiss = "2"
toAttrVal FontFamilyModern = "3"
toAttrVal FontFamilyScript = "4"
toAttrVal FontFamilyDecorative = "5"
instance ToAttrVal FontScheme where
toAttrVal FontSchemeMajor = "major"
toAttrVal FontSchemeMinor = "minor"
toAttrVal FontSchemeNone = "none"
instance ToAttrVal FontUnderline where
toAttrVal FontUnderlineSingle = "single"
toAttrVal FontUnderlineDouble = "double"
toAttrVal FontUnderlineSingleAccounting = "singleAccounting"
toAttrVal FontUnderlineDoubleAccounting = "doubleAccounting"
toAttrVal FontUnderlineNone = "none"
instance ToAttrVal FontVerticalAlignment where
toAttrVal FontVerticalAlignmentBaseline = "baseline"
toAttrVal FontVerticalAlignmentSubscript = "subscript"
toAttrVal FontVerticalAlignmentSuperscript = "superscript"
instance ToAttrVal LineStyle where
toAttrVal LineStyleDashDot = "dashDot"
toAttrVal LineStyleDashDotDot = "dashDotDot"
toAttrVal LineStyleDashed = "dashed"
toAttrVal LineStyleDotted = "dotted"
toAttrVal LineStyleDouble = "double"
toAttrVal LineStyleHair = "hair"
toAttrVal LineStyleMedium = "medium"
toAttrVal LineStyleMediumDashDot = "mediumDashDot"
toAttrVal LineStyleMediumDashDotDot = "mediumDashDotDot"
toAttrVal LineStyleMediumDashed = "mediumDashed"
toAttrVal LineStyleNone = "none"
toAttrVal LineStyleSlantDashDot = "slantDashDot"
toAttrVal LineStyleThick = "thick"
toAttrVal LineStyleThin = "thin"
instance ToAttrVal PatternType where
toAttrVal PatternTypeDarkDown = "darkDown"
toAttrVal PatternTypeDarkGray = "darkGray"
toAttrVal PatternTypeDarkGrid = "darkGrid"
toAttrVal PatternTypeDarkHorizontal = "darkHorizontal"
toAttrVal PatternTypeDarkTrellis = "darkTrellis"
toAttrVal PatternTypeDarkUp = "darkUp"
toAttrVal PatternTypeDarkVertical = "darkVertical"
toAttrVal PatternTypeGray0625 = "gray0625"
toAttrVal PatternTypeGray125 = "gray125"
toAttrVal PatternTypeLightDown = "lightDown"
toAttrVal PatternTypeLightGray = "lightGray"
toAttrVal PatternTypeLightGrid = "lightGrid"
toAttrVal PatternTypeLightHorizontal = "lightHorizontal"
toAttrVal PatternTypeLightTrellis = "lightTrellis"
toAttrVal PatternTypeLightUp = "lightUp"
toAttrVal PatternTypeLightVertical = "lightVertical"
toAttrVal PatternTypeMediumGray = "mediumGray"
toAttrVal PatternTypeNone = "none"
toAttrVal PatternTypeSolid = "solid"
instance ToAttrVal ReadingOrder where
toAttrVal ReadingOrderContextDependent = "0"
toAttrVal ReadingOrderLeftToRight = "1"
toAttrVal ReadingOrderRightToLeft = "2"
instance FromCursor StyleSheet where
fromCursor cur = do
let
_styleSheetFonts = cur $/ element (n_ "fonts") &/ element (n_ "font") >=> fromCursor
_styleSheetFills = cur $/ element (n_ "fills") &/ element (n_ "fill") >=> fromCursor
_styleSheetBorders = cur $/ element (n_ "borders") &/ element (n_ "border") >=> fromCursor
_styleSheetCellXfs = cur $/ element (n_ "cellXfs") &/ element (n_ "xf") >=> fromCursor
_styleSheetDxfs = cur $/ element (n_ "dxfs") &/ element (n_ "dxf") >=> fromCursor
_styleSheetNumFmts = M.fromList . map mkNumFmtPair $
cur $/ element (n_ "numFmts")&/ element (n_ "numFmt") >=> fromCursor
return StyleSheet{..}
instance FromCursor Font where
fromCursor cur = do
_fontName <- maybeElementValue (n_ "name") cur
_fontCharset <- maybeElementValue (n_ "charset") cur
_fontFamily <- maybeElementValue (n_ "family") cur
_fontBold <- maybeBoolElementValue (n_ "b") cur
_fontItalic <- maybeBoolElementValue (n_ "i") cur
_fontStrikeThrough<- maybeBoolElementValue (n_ "strike") cur
_fontOutline <- maybeBoolElementValue (n_ "outline") cur
_fontShadow <- maybeBoolElementValue (n_ "shadow") cur
_fontCondense <- maybeBoolElementValue (n_ "condense") cur
_fontExtend <- maybeBoolElementValue (n_ "extend") cur
_fontColor <- maybeFromElement (n_ "color") cur
_fontSize <- maybeElementValue (n_ "sz") cur
_fontUnderline <- maybeElementValueDef (n_ "u") FontUnderlineSingle cur
_fontVertAlign <- maybeElementValue (n_ "vertAlign") cur
_fontScheme <- maybeElementValue (n_ "scheme") cur
return Font{..}
instance FromAttrVal FontFamily where
fromAttrVal "0" = readSuccess FontFamilyNotApplicable
fromAttrVal "1" = readSuccess FontFamilyRoman
fromAttrVal "2" = readSuccess FontFamilySwiss
fromAttrVal "3" = readSuccess FontFamilyModern
fromAttrVal "4" = readSuccess FontFamilyScript
fromAttrVal "5" = readSuccess FontFamilyDecorative
fromAttrVal t = invalidText "FontFamily" t
instance FromAttrBs FontFamily where
fromAttrBs "0" = return FontFamilyNotApplicable
fromAttrBs "1" = return FontFamilyRoman
fromAttrBs "2" = return FontFamilySwiss
fromAttrBs "3" = return FontFamilyModern
fromAttrBs "4" = return FontFamilyScript
fromAttrBs "5" = return FontFamilyDecorative
fromAttrBs x = unexpectedAttrBs "FontFamily" x
instance FromCursor Color where
fromCursor cur = do
_colorAutomatic <- maybeAttribute "auto" cur
_colorARGB <- maybeAttribute "rgb" cur
_colorTheme <- maybeAttribute "theme" cur
_colorTint <- maybeAttribute "tint" cur
return Color{..}
instance FromXenoNode Color where
fromXenoNode root =
parseAttributes root $ do
_colorAutomatic <- maybeAttr "auto"
_colorARGB <- maybeAttr "rgb"
_colorTheme <- maybeAttr "theme"
_colorTint <- maybeAttr "tint"
return Color {..}
instance FromAttrVal FontUnderline where
fromAttrVal "single" = readSuccess FontUnderlineSingle
fromAttrVal "double" = readSuccess FontUnderlineDouble
fromAttrVal "singleAccounting" = readSuccess FontUnderlineSingleAccounting
fromAttrVal "doubleAccounting" = readSuccess FontUnderlineDoubleAccounting
fromAttrVal "none" = readSuccess FontUnderlineNone
fromAttrVal t = invalidText "FontUnderline" t
instance FromAttrBs FontUnderline where
fromAttrBs "single" = return FontUnderlineSingle
fromAttrBs "double" = return FontUnderlineDouble
fromAttrBs "singleAccounting" = return FontUnderlineSingleAccounting
fromAttrBs "doubleAccounting" = return FontUnderlineDoubleAccounting
fromAttrBs "none" = return FontUnderlineNone
fromAttrBs x = unexpectedAttrBs "FontUnderline" x
instance FromAttrVal FontVerticalAlignment where
fromAttrVal "baseline" = readSuccess FontVerticalAlignmentBaseline
fromAttrVal "subscript" = readSuccess FontVerticalAlignmentSubscript
fromAttrVal "superscript" = readSuccess FontVerticalAlignmentSuperscript
fromAttrVal t = invalidText "FontVerticalAlignment" t
instance FromAttrBs FontVerticalAlignment where
fromAttrBs "baseline" = return FontVerticalAlignmentBaseline
fromAttrBs "subscript" = return FontVerticalAlignmentSubscript
fromAttrBs "superscript" = return FontVerticalAlignmentSuperscript
fromAttrBs x = unexpectedAttrBs "FontVerticalAlignment" x
instance FromAttrVal FontScheme where
fromAttrVal "major" = readSuccess FontSchemeMajor
fromAttrVal "minor" = readSuccess FontSchemeMinor
fromAttrVal "none" = readSuccess FontSchemeNone
fromAttrVal t = invalidText "FontScheme" t
instance FromAttrBs FontScheme where
fromAttrBs "major" = return FontSchemeMajor
fromAttrBs "minor" = return FontSchemeMinor
fromAttrBs "none" = return FontSchemeNone
fromAttrBs x = unexpectedAttrBs "FontScheme" x
instance FromCursor Fill where
fromCursor cur = do
_fillPattern <- maybeFromElement (n_ "patternFill") cur
return Fill{..}
instance FromCursor FillPattern where
fromCursor cur = do
_fillPatternType <- maybeAttribute "patternType" cur
_fillPatternFgColor <- maybeFromElement (n_ "fgColor") cur
_fillPatternBgColor <- maybeFromElement (n_ "bgColor") cur
return FillPattern{..}
instance FromAttrVal PatternType where
fromAttrVal "darkDown" = readSuccess PatternTypeDarkDown
fromAttrVal "darkGray" = readSuccess PatternTypeDarkGray
fromAttrVal "darkGrid" = readSuccess PatternTypeDarkGrid
fromAttrVal "darkHorizontal" = readSuccess PatternTypeDarkHorizontal
fromAttrVal "darkTrellis" = readSuccess PatternTypeDarkTrellis
fromAttrVal "darkUp" = readSuccess PatternTypeDarkUp
fromAttrVal "darkVertical" = readSuccess PatternTypeDarkVertical
fromAttrVal "gray0625" = readSuccess PatternTypeGray0625
fromAttrVal "gray125" = readSuccess PatternTypeGray125
fromAttrVal "lightDown" = readSuccess PatternTypeLightDown
fromAttrVal "lightGray" = readSuccess PatternTypeLightGray
fromAttrVal "lightGrid" = readSuccess PatternTypeLightGrid
fromAttrVal "lightHorizontal" = readSuccess PatternTypeLightHorizontal
fromAttrVal "lightTrellis" = readSuccess PatternTypeLightTrellis
fromAttrVal "lightUp" = readSuccess PatternTypeLightUp
fromAttrVal "lightVertical" = readSuccess PatternTypeLightVertical
fromAttrVal "mediumGray" = readSuccess PatternTypeMediumGray
fromAttrVal "none" = readSuccess PatternTypeNone
fromAttrVal "solid" = readSuccess PatternTypeSolid
fromAttrVal t = invalidText "PatternType" t
instance FromCursor Border where
fromCursor cur = do
_borderDiagonalUp <- maybeAttribute "diagonalUp" cur
_borderDiagonalDown <- maybeAttribute "diagonalDown" cur
_borderOutline <- maybeAttribute "outline" cur
_borderStart <- maybeFromElement (n_ "start") cur
_borderEnd <- maybeFromElement (n_ "end") cur
_borderLeft <- maybeFromElement (n_ "left") cur
_borderRight <- maybeFromElement (n_ "right") cur
_borderTop <- maybeFromElement (n_ "top") cur
_borderBottom <- maybeFromElement (n_ "bottom") cur
_borderDiagonal <- maybeFromElement (n_ "diagonal") cur
_borderVertical <- maybeFromElement (n_ "vertical") cur
_borderHorizontal <- maybeFromElement (n_ "horizontal") cur
return Border{..}
instance FromCursor BorderStyle where
fromCursor cur = do
_borderStyleLine <- maybeAttribute "style" cur
_borderStyleColor <- maybeFromElement (n_ "color") cur
return BorderStyle{..}
instance FromAttrVal LineStyle where
fromAttrVal "dashDot" = readSuccess LineStyleDashDot
fromAttrVal "dashDotDot" = readSuccess LineStyleDashDotDot
fromAttrVal "dashed" = readSuccess LineStyleDashed
fromAttrVal "dotted" = readSuccess LineStyleDotted
fromAttrVal "double" = readSuccess LineStyleDouble
fromAttrVal "hair" = readSuccess LineStyleHair
fromAttrVal "medium" = readSuccess LineStyleMedium
fromAttrVal "mediumDashDot" = readSuccess LineStyleMediumDashDot
fromAttrVal "mediumDashDotDot" = readSuccess LineStyleMediumDashDotDot
fromAttrVal "mediumDashed" = readSuccess LineStyleMediumDashed
fromAttrVal "none" = readSuccess LineStyleNone
fromAttrVal "slantDashDot" = readSuccess LineStyleSlantDashDot
fromAttrVal "thick" = readSuccess LineStyleThick
fromAttrVal "thin" = readSuccess LineStyleThin
fromAttrVal t = invalidText "LineStyle" t
instance FromCursor CellXf where
fromCursor cur = do
_cellXfAlignment <- maybeFromElement (n_ "alignment") cur
_cellXfProtection <- maybeFromElement (n_ "protection") cur
_cellXfNumFmtId <- maybeAttribute "numFmtId" cur
_cellXfFontId <- maybeAttribute "fontId" cur
_cellXfFillId <- maybeAttribute "fillId" cur
_cellXfBorderId <- maybeAttribute "borderId" cur
_cellXfId <- maybeAttribute "xfId" cur
_cellXfQuotePrefix <- maybeAttribute "quotePrefix" cur
_cellXfPivotButton <- maybeAttribute "pivotButton" cur
_cellXfApplyNumberFormat <- maybeAttribute "applyNumberFormat" cur
_cellXfApplyFont <- maybeAttribute "applyFont" cur
_cellXfApplyFill <- maybeAttribute "applyFill" cur
_cellXfApplyBorder <- maybeAttribute "applyBorder" cur
_cellXfApplyAlignment <- maybeAttribute "applyAlignment" cur
_cellXfApplyProtection <- maybeAttribute "applyProtection" cur
return CellXf{..}
instance FromCursor Dxf where
fromCursor cur = do
_dxfFont <- maybeFromElement (n_ "font") cur
_dxfNumFmt <- maybeFromElement (n_ "numFmt") cur
_dxfFill <- maybeFromElement (n_ "fill") cur
_dxfAlignment <- maybeFromElement (n_ "alignment") cur
_dxfBorder <- maybeFromElement (n_ "border") cur
_dxfProtection <- maybeFromElement (n_ "protection") cur
return Dxf{..}
instance FromCursor NumFmt where
fromCursor cur = do
_numFmtCode <- fromAttribute "formatCode" cur
_numFmtId <- fromAttribute "numFmtId" cur
return NumFmt{..}
instance FromCursor Alignment where
fromCursor cur = do
_alignmentHorizontal <- maybeAttribute "horizontal" cur
_alignmentVertical <- maybeAttribute "vertical" cur
_alignmentTextRotation <- maybeAttribute "textRotation" cur
_alignmentWrapText <- maybeAttribute "wrapText" cur
_alignmentRelativeIndent <- maybeAttribute "relativeIndent" cur
_alignmentIndent <- maybeAttribute "indent" cur
_alignmentJustifyLastLine <- maybeAttribute "justifyLastLine" cur
_alignmentShrinkToFit <- maybeAttribute "shrinkToFit" cur
_alignmentReadingOrder <- maybeAttribute "readingOrder" cur
return Alignment{..}
instance FromAttrVal CellHorizontalAlignment where
fromAttrVal "center" = readSuccess CellHorizontalAlignmentCenter
fromAttrVal "centerContinuous" = readSuccess CellHorizontalAlignmentCenterContinuous
fromAttrVal "distributed" = readSuccess CellHorizontalAlignmentDistributed
fromAttrVal "fill" = readSuccess CellHorizontalAlignmentFill
fromAttrVal "general" = readSuccess CellHorizontalAlignmentGeneral
fromAttrVal "justify" = readSuccess CellHorizontalAlignmentJustify
fromAttrVal "left" = readSuccess CellHorizontalAlignmentLeft
fromAttrVal "right" = readSuccess CellHorizontalAlignmentRight
fromAttrVal t = invalidText "CellHorizontalAlignment" t
instance FromAttrVal CellVerticalAlignment where
fromAttrVal "bottom" = readSuccess CellVerticalAlignmentBottom
fromAttrVal "center" = readSuccess CellVerticalAlignmentCenter
fromAttrVal "distributed" = readSuccess CellVerticalAlignmentDistributed
fromAttrVal "justify" = readSuccess CellVerticalAlignmentJustify
fromAttrVal "top" = readSuccess CellVerticalAlignmentTop
fromAttrVal t = invalidText "CellVerticalAlignment" t
instance FromAttrVal ReadingOrder where
fromAttrVal "0" = readSuccess ReadingOrderContextDependent
fromAttrVal "1" = readSuccess ReadingOrderLeftToRight
fromAttrVal "2" = readSuccess ReadingOrderRightToLeft
fromAttrVal t = invalidText "ReadingOrder" t
instance FromCursor Protection where
fromCursor cur = do
_protectionLocked <- maybeAttribute "locked" cur
_protectionHidden <- maybeAttribute "hidden" cur
return Protection{..}