module Codec.Xlsx.Types.ConditionalFormatting
( ConditionalFormatting
, CfRule(..)
, Condition(..)
, OperatorExpression (..)
, TimePeriod (..)
, cfrCondition
, cfrDxfId
, cfrPriority
, cfrStopIfTrue
, topCfPriority
) where
import Control.Lens (makeLenses)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Text (Text)
import Text.XML
import Text.XML.Cursor
import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Writer.Internal
data OperatorExpression
= OpBeginsWith Formula
| OpBetween Formula Formula
| OpContainsText Formula
| OpEndsWith Formula
| OpEqual Formula
| OpGreaterThan Formula
| OpGreaterThanOrEqual Formula
| OpLessThan Formula
| OpLessThanOrEqual Formula
| OpNotBetween Formula Formula
| OpNotContains Formula
| OpNotEqual Formula
deriving (Eq, Ord, Show)
data TimePeriod
= PerLast7Days
| PerLastMonth
| PerLastWeek
| PerNextMonth
| PerNextWeek
| PerThisMonth
| PerThisWeek
| PerToday
| PerTomorrow
| PerYesterday
deriving (Eq, Ord, Show)
data Condition
= BeginsWith Text
| CellIs OperatorExpression
| ContainsBlanks
| ContainsErrors
| ContainsText Text
| DoesNotContainErrors
| DoesNotContainBlanks
| DoesNotContainText Text
| EndsWith Text
| Expression Formula
| InTimePeriod TimePeriod
deriving (Eq, Ord, Show)
data CfRule = CfRule
{ _cfrCondition :: Condition
, _cfrDxfId :: Maybe Int
, _cfrPriority :: Int
, _cfrStopIfTrue :: Maybe Bool
} deriving (Eq, Ord, Show)
makeLenses ''CfRule
type ConditionalFormatting = [CfRule]
topCfPriority :: Int
topCfPriority = 1
instance FromCursor CfRule where
fromCursor cur = do
_cfrDxfId <- maybeAttribute "dxfId" cur
_cfrPriority <- fromAttribute "priority" cur
_cfrStopIfTrue <- maybeAttribute "stopIfTrue" cur
cfType <- fromAttribute "type" cur
_cfrCondition <- readCondition cfType cur
return CfRule{..}
readCondition :: Text -> Cursor -> [Condition]
readCondition "beginsWith" cur = do
txt <- fromAttribute "text" cur
return $ BeginsWith txt
readCondition "cellIs" cur = do
operator <- fromAttribute "operator" cur
let formulas = cur $/ element (n"formula") >=> fromCursor
expr <- readOpExpression operator formulas
return $ CellIs expr
readCondition "containsBlanks" _ = return ContainsBlanks
readCondition "containsErrors" _ = return ContainsErrors
readCondition "containsText" cur = do
txt <- fromAttribute "text" cur
return $ ContainsText txt
readCondition "notContainsBlanks" _ = return DoesNotContainBlanks
readCondition "notContainsErrors" _ = return DoesNotContainErrors
readCondition "notContainsText" cur = do
txt <- fromAttribute "text" cur
return $ DoesNotContainText txt
readCondition "endsWith" cur = do
txt <- fromAttribute "text" cur
return $ EndsWith txt
readCondition "expression" cur = do
formula <- cur $/ element "formula" >=> fromCursor
return $ Expression formula
readCondition "timePeriod" cur = do
period <- fromAttribute "timePeriod" cur
return $ InTimePeriod period
readCondition _ _ = error "Unexpected conditional formatting type"
readOpExpression :: Text -> [Formula] -> [OperatorExpression]
readOpExpression "beginsWith" [f ] = [OpBeginsWith f ]
readOpExpression "between" [f1, f2] = [OpBetween f1 f2]
readOpExpression "containsText" [f] = [OpContainsText f]
readOpExpression "endsWith" [f] = [OpEndsWith f]
readOpExpression "equal" [f] = [OpEqual f]
readOpExpression "greaterThan" [f] = [OpGreaterThan f]
readOpExpression "greaterThanOrEqual" [f] = [OpGreaterThanOrEqual f]
readOpExpression "lessThan" [f] = [OpLessThan f]
readOpExpression "lessThanOrEqual" [f] = [OpLessThanOrEqual f]
readOpExpression "notBetween" [f1, f2] = [OpNotBetween f1 f2]
readOpExpression "notContains" [f] = [OpNotContains f]
readOpExpression "notEqual" [f] = [OpNotEqual f]
readOpExpression _ _ = []
instance FromAttrVal TimePeriod where
fromAttrVal "last7Days" = readSuccess PerLast7Days
fromAttrVal "lastMonth" = readSuccess PerLastMonth
fromAttrVal "lastWeek" = readSuccess PerLastWeek
fromAttrVal "nextMonth" = readSuccess PerNextMonth
fromAttrVal "nextWeek" = readSuccess PerNextWeek
fromAttrVal "thisMonth" = readSuccess PerThisMonth
fromAttrVal "thisWeek" = readSuccess PerThisWeek
fromAttrVal "today" = readSuccess PerToday
fromAttrVal "tomorrow" = readSuccess PerTomorrow
fromAttrVal "yesterday" = readSuccess PerYesterday
fromAttrVal t = invalidText "TimePeriod" t
instance ToElement CfRule where
toElement nm CfRule{..} =
let (condType, condAttrs, condNodes) = conditionData _cfrCondition
baseAttrs = M.fromList . catMaybes $
[ Just $ "type" .= condType
, "dxfId" .=? _cfrDxfId
, Just $ "priority" .= _cfrPriority
, "stopIfTrue" .=? _cfrStopIfTrue
]
in Element
{ elementName = nm
, elementAttributes = M.union baseAttrs condAttrs
, elementNodes = condNodes
}
conditionData :: Condition -> (Text, Map Name Text, [Node])
conditionData (BeginsWith t) = ("beginsWith", M.fromList [ "text" .= t], [])
conditionData (CellIs opExpr) = ("cellIs", M.fromList [ "operator" .= op], formulas)
where (op, formulas) = operatorExpressionData opExpr
conditionData ContainsBlanks = ("containsBlanks", M.empty, [])
conditionData ContainsErrors = ("containsErrors", M.empty, [])
conditionData (ContainsText t) = ("containsText", M.fromList [ "text" .= t], [])
conditionData DoesNotContainBlanks = ("notContainsBlanks", M.empty, [])
conditionData DoesNotContainErrors = ("notContainsErrors", M.empty, [])
conditionData (DoesNotContainText t) = ("notContainsText", M.fromList [ "text" .= t], [])
conditionData (EndsWith t) = ("endsWith", M.fromList [ "text" .= t], [])
conditionData (Expression formula) = ("expression", M.empty, [formulaNode formula])
conditionData (InTimePeriod period) = ("timePeriod", M.fromList [ "timePeriod" .= period ], [])
operatorExpressionData :: OperatorExpression -> (Text, [Node])
operatorExpressionData (OpBeginsWith f) = ("beginsWith", [formulaNode f])
operatorExpressionData (OpBetween f1 f2) = ("between", [formulaNode f1, formulaNode f2])
operatorExpressionData (OpContainsText f) = ("containsText", [formulaNode f])
operatorExpressionData (OpEndsWith f) = ("endsWith", [formulaNode f])
operatorExpressionData (OpEqual f) = ("equal", [formulaNode f])
operatorExpressionData (OpGreaterThan f) = ("greaterThan", [formulaNode f])
operatorExpressionData (OpGreaterThanOrEqual f) = ("greaterThanOrEqual", [formulaNode f])
operatorExpressionData (OpLessThan f) = ("lessThan", [formulaNode f])
operatorExpressionData (OpLessThanOrEqual f) = ("lessThanOrEqual", [formulaNode f])
operatorExpressionData (OpNotBetween f1 f2) = ("notBetween", [formulaNode f1, formulaNode f2])
operatorExpressionData (OpNotContains f) = ("notContains", [formulaNode f])
operatorExpressionData (OpNotEqual f) = ("notEqual", [formulaNode f])
formulaNode :: Formula -> Node
formulaNode = NodeElement . toElement "formula"
instance ToAttrVal TimePeriod where
toAttrVal PerLast7Days = "last7Days"
toAttrVal PerLastMonth = "lastMonth"
toAttrVal PerLastWeek = "lastWeek"
toAttrVal PerNextMonth = "nextMonth"
toAttrVal PerNextWeek = "nextWeek"
toAttrVal PerThisMonth = "thisMonth"
toAttrVal PerThisWeek = "thisWeek"
toAttrVal PerToday = "today"
toAttrVal PerTomorrow = "tomorrow"
toAttrVal PerYesterday = "yesterday"