{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Cell
( CellFormula(..)
, FormulaExpression(..)
, simpleCellFormula
, sharedFormulaByIndex
, SharedFormulaIndex(..)
, SharedFormulaOptions(..)
, formulaDataFromCursor
, applySharedFormulaOpts
, Cell(..)
, cellStyle
, cellValue
, cellComment
, cellFormula
, CellMap
) where
import Control.Arrow (first)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH (makeLenses)
#endif
import Control.DeepSeq (NFData)
import Data.Default
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (catMaybes, listToMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor
import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Comment
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Writer.Internal
data CellFormula = CellFormula
{ _cellfExpression :: FormulaExpression
, _cellfAssignsToName :: Bool
, _cellfCalculate :: Bool
} deriving (Eq, Show, Generic)
instance NFData CellFormula
data FormulaExpression
= NormalFormula Formula
| SharedFormula SharedFormulaIndex
deriving (Eq, Show, Generic)
instance NFData FormulaExpression
defaultFormulaType :: Text
defaultFormulaType = "normal"
newtype SharedFormulaIndex = SharedFormulaIndex Int
deriving (Eq, Ord, Show, Generic)
instance NFData SharedFormulaIndex
data SharedFormulaOptions = SharedFormulaOptions
{ _sfoRef :: CellRef
, _sfoExpression :: Formula
}
deriving (Eq, Show, Generic)
instance NFData SharedFormulaOptions
simpleCellFormula :: Text -> CellFormula
simpleCellFormula expr = CellFormula
{ _cellfExpression = NormalFormula $ Formula expr
, _cellfAssignsToName = False
, _cellfCalculate = False
}
sharedFormulaByIndex :: SharedFormulaIndex -> CellFormula
sharedFormulaByIndex si =
CellFormula
{ _cellfExpression = SharedFormula si
, _cellfAssignsToName = False
, _cellfCalculate = False
}
data Cell = Cell
{ _cellStyle :: Maybe Int
, _cellValue :: Maybe CellValue
, _cellComment :: Maybe Comment
, _cellFormula :: Maybe CellFormula
} deriving (Eq, Show, Generic)
instance NFData Cell
instance Default Cell where
def = Cell Nothing Nothing Nothing Nothing
makeLenses ''Cell
type CellMap = Map (Int, Int) Cell
formulaDataFromCursor ::
Cursor -> [(CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
formulaDataFromCursor cur = do
_cellfAssignsToName <- fromAttributeDef "bx" False cur
_cellfCalculate <- fromAttributeDef "ca" False cur
t <- fromAttributeDef "t" defaultFormulaType cur
(_cellfExpression, shared) <-
case t of
d| d == defaultFormulaType -> do
formula <- fromCursor cur
return (NormalFormula formula, Nothing)
"shared" -> do
let expr = listToMaybe $ fromCursor cur
ref <- maybeAttribute "ref" cur
si <- fromAttribute "si" cur
return (SharedFormula si, (,) <$> pure si <*>
(SharedFormulaOptions <$> ref <*> expr))
_ ->
fail $ "Unexpected formula type" ++ show t
return (CellFormula {..}, shared)
instance FromAttrVal SharedFormulaIndex where
fromAttrVal = fmap (first SharedFormulaIndex) . fromAttrVal
instance FromAttrBs SharedFormulaIndex where
fromAttrBs = fmap SharedFormulaIndex . fromAttrBs
instance ToElement CellFormula where
toElement nm CellFormula {..} =
formulaEl {elementAttributes = elementAttributes formulaEl <> commonAttrs}
where
commonAttrs =
M.fromList $
catMaybes
[ "bx" .=? justTrue _cellfAssignsToName
, "ca" .=? justTrue _cellfCalculate
, "t" .=? justNonDef defaultFormulaType fType
]
(formulaEl, fType) =
case _cellfExpression of
NormalFormula f -> (toElement nm f, defaultFormulaType)
SharedFormula si -> (leafElement nm ["si" .= si], "shared")
instance ToAttrVal SharedFormulaIndex where
toAttrVal (SharedFormulaIndex si) = toAttrVal si
applySharedFormulaOpts :: SharedFormulaOptions -> Element -> Element
applySharedFormulaOpts SharedFormulaOptions {..} el =
el
{ elementAttributes = elementAttributes el <> M.fromList ["ref" .= _sfoRef]
, elementNodes = NodeContent (unFormula _sfoExpression) : elementNodes el
}