{-# 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

-- | Formula for the cell.
--
-- TODO: array, dataTable formula types support
--
-- See 18.3.1.40 "f (Formula)" (p. 1636)
data CellFormula = CellFormula
  { CellFormula -> FormulaExpression
_cellfExpression :: FormulaExpression
  , CellFormula -> Bool
_cellfAssignsToName :: Bool
      -- ^ Specifies that this formula assigns a value to a name.
  , CellFormula -> Bool
_cellfCalculate :: Bool
      -- ^ Indicates that this formula needs to be recalculated
      -- the next time calculation is performed.
      -- [/Example/: This is always set on volatile functions,
      -- like =RAND(), and circular references. /end example/]
  } deriving (CellFormula -> CellFormula -> Bool
(CellFormula -> CellFormula -> Bool)
-> (CellFormula -> CellFormula -> Bool) -> Eq CellFormula
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellFormula -> CellFormula -> Bool
$c/= :: CellFormula -> CellFormula -> Bool
== :: CellFormula -> CellFormula -> Bool
$c== :: CellFormula -> CellFormula -> Bool
Eq, Int -> CellFormula -> ShowS
[CellFormula] -> ShowS
CellFormula -> String
(Int -> CellFormula -> ShowS)
-> (CellFormula -> String)
-> ([CellFormula] -> ShowS)
-> Show CellFormula
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellFormula] -> ShowS
$cshowList :: [CellFormula] -> ShowS
show :: CellFormula -> String
$cshow :: CellFormula -> String
showsPrec :: Int -> CellFormula -> ShowS
$cshowsPrec :: Int -> CellFormula -> ShowS
Show, (forall x. CellFormula -> Rep CellFormula x)
-> (forall x. Rep CellFormula x -> CellFormula)
-> Generic CellFormula
forall x. Rep CellFormula x -> CellFormula
forall x. CellFormula -> Rep CellFormula x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellFormula x -> CellFormula
$cfrom :: forall x. CellFormula -> Rep CellFormula x
Generic)
instance NFData CellFormula

-- | formula type with type-specific options
data FormulaExpression
  = NormalFormula Formula
  | SharedFormula SharedFormulaIndex
  deriving (FormulaExpression -> FormulaExpression -> Bool
(FormulaExpression -> FormulaExpression -> Bool)
-> (FormulaExpression -> FormulaExpression -> Bool)
-> Eq FormulaExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormulaExpression -> FormulaExpression -> Bool
$c/= :: FormulaExpression -> FormulaExpression -> Bool
== :: FormulaExpression -> FormulaExpression -> Bool
$c== :: FormulaExpression -> FormulaExpression -> Bool
Eq, Int -> FormulaExpression -> ShowS
[FormulaExpression] -> ShowS
FormulaExpression -> String
(Int -> FormulaExpression -> ShowS)
-> (FormulaExpression -> String)
-> ([FormulaExpression] -> ShowS)
-> Show FormulaExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormulaExpression] -> ShowS
$cshowList :: [FormulaExpression] -> ShowS
show :: FormulaExpression -> String
$cshow :: FormulaExpression -> String
showsPrec :: Int -> FormulaExpression -> ShowS
$cshowsPrec :: Int -> FormulaExpression -> ShowS
Show, (forall x. FormulaExpression -> Rep FormulaExpression x)
-> (forall x. Rep FormulaExpression x -> FormulaExpression)
-> Generic FormulaExpression
forall x. Rep FormulaExpression x -> FormulaExpression
forall x. FormulaExpression -> Rep FormulaExpression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormulaExpression x -> FormulaExpression
$cfrom :: forall x. FormulaExpression -> Rep FormulaExpression x
Generic)
instance NFData FormulaExpression

defaultFormulaType :: Text
defaultFormulaType :: Text
defaultFormulaType = Text
"normal"

-- | index of shared formula in worksheet's 'wsSharedFormulas'
-- property
newtype SharedFormulaIndex = SharedFormulaIndex Int
  deriving (SharedFormulaIndex -> SharedFormulaIndex -> Bool
(SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> (SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> Eq SharedFormulaIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c/= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
== :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c== :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
Eq, Eq SharedFormulaIndex
Eq SharedFormulaIndex
-> (SharedFormulaIndex -> SharedFormulaIndex -> Ordering)
-> (SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> (SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> (SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> (SharedFormulaIndex -> SharedFormulaIndex -> Bool)
-> (SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex)
-> (SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex)
-> Ord SharedFormulaIndex
SharedFormulaIndex -> SharedFormulaIndex -> Bool
SharedFormulaIndex -> SharedFormulaIndex -> Ordering
SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex
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 :: SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex
$cmin :: SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex
max :: SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex
$cmax :: SharedFormulaIndex -> SharedFormulaIndex -> SharedFormulaIndex
>= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c>= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
> :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c> :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
<= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c<= :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
< :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
$c< :: SharedFormulaIndex -> SharedFormulaIndex -> Bool
compare :: SharedFormulaIndex -> SharedFormulaIndex -> Ordering
$ccompare :: SharedFormulaIndex -> SharedFormulaIndex -> Ordering
$cp1Ord :: Eq SharedFormulaIndex
Ord, Int -> SharedFormulaIndex -> ShowS
[SharedFormulaIndex] -> ShowS
SharedFormulaIndex -> String
(Int -> SharedFormulaIndex -> ShowS)
-> (SharedFormulaIndex -> String)
-> ([SharedFormulaIndex] -> ShowS)
-> Show SharedFormulaIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedFormulaIndex] -> ShowS
$cshowList :: [SharedFormulaIndex] -> ShowS
show :: SharedFormulaIndex -> String
$cshow :: SharedFormulaIndex -> String
showsPrec :: Int -> SharedFormulaIndex -> ShowS
$cshowsPrec :: Int -> SharedFormulaIndex -> ShowS
Show, (forall x. SharedFormulaIndex -> Rep SharedFormulaIndex x)
-> (forall x. Rep SharedFormulaIndex x -> SharedFormulaIndex)
-> Generic SharedFormulaIndex
forall x. Rep SharedFormulaIndex x -> SharedFormulaIndex
forall x. SharedFormulaIndex -> Rep SharedFormulaIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SharedFormulaIndex x -> SharedFormulaIndex
$cfrom :: forall x. SharedFormulaIndex -> Rep SharedFormulaIndex x
Generic)
instance NFData SharedFormulaIndex

data SharedFormulaOptions = SharedFormulaOptions
  { SharedFormulaOptions -> CellRef
_sfoRef :: CellRef
  , SharedFormulaOptions -> Formula
_sfoExpression :: Formula
  }
  deriving (SharedFormulaOptions -> SharedFormulaOptions -> Bool
(SharedFormulaOptions -> SharedFormulaOptions -> Bool)
-> (SharedFormulaOptions -> SharedFormulaOptions -> Bool)
-> Eq SharedFormulaOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SharedFormulaOptions -> SharedFormulaOptions -> Bool
$c/= :: SharedFormulaOptions -> SharedFormulaOptions -> Bool
== :: SharedFormulaOptions -> SharedFormulaOptions -> Bool
$c== :: SharedFormulaOptions -> SharedFormulaOptions -> Bool
Eq, Int -> SharedFormulaOptions -> ShowS
[SharedFormulaOptions] -> ShowS
SharedFormulaOptions -> String
(Int -> SharedFormulaOptions -> ShowS)
-> (SharedFormulaOptions -> String)
-> ([SharedFormulaOptions] -> ShowS)
-> Show SharedFormulaOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SharedFormulaOptions] -> ShowS
$cshowList :: [SharedFormulaOptions] -> ShowS
show :: SharedFormulaOptions -> String
$cshow :: SharedFormulaOptions -> String
showsPrec :: Int -> SharedFormulaOptions -> ShowS
$cshowsPrec :: Int -> SharedFormulaOptions -> ShowS
Show, (forall x. SharedFormulaOptions -> Rep SharedFormulaOptions x)
-> (forall x. Rep SharedFormulaOptions x -> SharedFormulaOptions)
-> Generic SharedFormulaOptions
forall x. Rep SharedFormulaOptions x -> SharedFormulaOptions
forall x. SharedFormulaOptions -> Rep SharedFormulaOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SharedFormulaOptions x -> SharedFormulaOptions
$cfrom :: forall x. SharedFormulaOptions -> Rep SharedFormulaOptions x
Generic)
instance NFData SharedFormulaOptions

simpleCellFormula :: Text -> CellFormula
simpleCellFormula :: Text -> CellFormula
simpleCellFormula Text
expr = CellFormula :: FormulaExpression -> Bool -> Bool -> CellFormula
CellFormula
    { _cellfExpression :: FormulaExpression
_cellfExpression    = Formula -> FormulaExpression
NormalFormula (Formula -> FormulaExpression) -> Formula -> FormulaExpression
forall a b. (a -> b) -> a -> b
$ Text -> Formula
Formula Text
expr
    , _cellfAssignsToName :: Bool
_cellfAssignsToName = Bool
False
    , _cellfCalculate :: Bool
_cellfCalculate     = Bool
False
    }

sharedFormulaByIndex :: SharedFormulaIndex -> CellFormula
sharedFormulaByIndex :: SharedFormulaIndex -> CellFormula
sharedFormulaByIndex SharedFormulaIndex
si =
  CellFormula :: FormulaExpression -> Bool -> Bool -> CellFormula
CellFormula
  { _cellfExpression :: FormulaExpression
_cellfExpression = SharedFormulaIndex -> FormulaExpression
SharedFormula SharedFormulaIndex
si
  , _cellfAssignsToName :: Bool
_cellfAssignsToName = Bool
False
  , _cellfCalculate :: Bool
_cellfCalculate = Bool
False
  }

-- | Currently cell details include cell values, style ids and cell
-- formulas (inline strings from @\<is\>@ subelements are ignored)
data Cell = Cell
    { Cell -> Maybe Int
_cellStyle   :: Maybe Int
    , Cell -> Maybe CellValue
_cellValue   :: Maybe CellValue
    , Cell -> Maybe Comment
_cellComment :: Maybe Comment
    , Cell -> Maybe CellFormula
_cellFormula :: Maybe CellFormula
    } deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show, (forall x. Cell -> Rep Cell x)
-> (forall x. Rep Cell x -> Cell) -> Generic Cell
forall x. Rep Cell x -> Cell
forall x. Cell -> Rep Cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cell x -> Cell
$cfrom :: forall x. Cell -> Rep Cell x
Generic)
instance NFData Cell

instance Default Cell where
    def :: Cell
def = Maybe Int
-> Maybe CellValue -> Maybe Comment -> Maybe CellFormula -> Cell
Cell Maybe Int
forall a. Maybe a
Nothing Maybe CellValue
forall a. Maybe a
Nothing Maybe Comment
forall a. Maybe a
Nothing Maybe CellFormula
forall a. Maybe a
Nothing

makeLenses ''Cell

-- | Map containing cell values which are indexed by row and column
-- if you need to use more traditional (x,y) indexing please you could
-- use corresponding accessors from ''Codec.Xlsx.Lens''
type CellMap = Map (Int, Int) Cell

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

formulaDataFromCursor ::
     Cursor -> [(CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
formulaDataFromCursor :: Cursor
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
formulaDataFromCursor Cursor
cur = do
  Bool
_cellfAssignsToName <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"bx" Bool
False Cursor
cur
  Bool
_cellfCalculate <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"ca" Bool
False Cursor
cur
  Text
t <- Name -> Text -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"t" Text
defaultFormulaType Cursor
cur
  (FormulaExpression
_cellfExpression, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) <-
    case Text
t of
      Text
d| Text
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
defaultFormulaType -> do
        Formula
formula <- Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
        (FormulaExpression,
 Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> [(FormulaExpression,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Formula -> FormulaExpression
NormalFormula Formula
formula, Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall a. Maybe a
Nothing)
      Text
"shared" -> do
        let expr :: Maybe Formula
expr = [Formula] -> Maybe Formula
forall a. [a] -> Maybe a
listToMaybe ([Formula] -> Maybe Formula) -> [Formula] -> Maybe Formula
forall a b. (a -> b) -> a -> b
$ Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
        Maybe CellRef
ref <- Name -> Cursor -> [Maybe CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"ref" Cursor
cur
        SharedFormulaIndex
si <- Name -> Cursor -> [SharedFormulaIndex]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"si" Cursor
cur
        (FormulaExpression,
 Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> [(FormulaExpression,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a. Monad m => a -> m a
return (SharedFormulaIndex -> FormulaExpression
SharedFormula SharedFormulaIndex
si, (,) (SharedFormulaIndex
 -> SharedFormulaOptions
 -> (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe SharedFormulaIndex
-> Maybe
     (SharedFormulaOptions
      -> (SharedFormulaIndex, SharedFormulaOptions))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SharedFormulaIndex -> Maybe SharedFormulaIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure SharedFormulaIndex
si Maybe
  (SharedFormulaOptions
   -> (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe SharedFormulaOptions
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                 (CellRef -> Formula -> SharedFormulaOptions
SharedFormulaOptions (CellRef -> Formula -> SharedFormulaOptions)
-> Maybe CellRef -> Maybe (Formula -> SharedFormulaOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CellRef
ref Maybe (Formula -> SharedFormulaOptions)
-> Maybe Formula -> Maybe SharedFormulaOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Formula
expr))
      Text
_ ->
        String
-> [(FormulaExpression,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> [(FormulaExpression,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> String
-> [(FormulaExpression,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall a b. (a -> b) -> a -> b
$ String
"Unexpected formula type" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a. Monad m => a -> m a
return (CellFormula :: FormulaExpression -> Bool -> Bool -> CellFormula
CellFormula {Bool
FormulaExpression
_cellfExpression :: FormulaExpression
_cellfCalculate :: Bool
_cellfAssignsToName :: Bool
_cellfCalculate :: Bool
_cellfAssignsToName :: Bool
_cellfExpression :: FormulaExpression
..}, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared)

instance FromAttrVal SharedFormulaIndex where
  fromAttrVal :: Reader SharedFormulaIndex
fromAttrVal = ((Int, Text) -> (SharedFormulaIndex, Text))
-> Either String (Int, Text)
-> Either String (SharedFormulaIndex, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> SharedFormulaIndex)
-> (Int, Text) -> (SharedFormulaIndex, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> SharedFormulaIndex
SharedFormulaIndex) (Either String (Int, Text)
 -> Either String (SharedFormulaIndex, Text))
-> (Text -> Either String (Int, Text)) -> Reader SharedFormulaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Int, Text)
forall a. FromAttrVal a => Reader a
fromAttrVal

instance FromAttrBs SharedFormulaIndex where
  fromAttrBs :: ByteString -> Either Text SharedFormulaIndex
fromAttrBs = (Int -> SharedFormulaIndex)
-> Either Text Int -> Either Text SharedFormulaIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SharedFormulaIndex
SharedFormulaIndex (Either Text Int -> Either Text SharedFormulaIndex)
-> (ByteString -> Either Text Int)
-> ByteString
-> Either Text SharedFormulaIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text Int
forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToElement CellFormula where
  toElement :: Name -> CellFormula -> Element
toElement Name
nm CellFormula {Bool
FormulaExpression
_cellfCalculate :: Bool
_cellfAssignsToName :: Bool
_cellfExpression :: FormulaExpression
_cellfCalculate :: CellFormula -> Bool
_cellfAssignsToName :: CellFormula -> Bool
_cellfExpression :: CellFormula -> FormulaExpression
..} =
    Element
formulaEl {elementAttributes :: Map Name Text
elementAttributes = Element -> Map Name Text
elementAttributes Element
formulaEl Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> Map Name Text
commonAttrs}
    where
      commonAttrs :: Map Name Text
commonAttrs =
        [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Text)] -> Map Name Text)
-> [(Name, Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$
        [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes
          [ Name
"bx" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_cellfAssignsToName
          , Name
"ca" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_cellfCalculate
          , Name
"t" Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Text -> Text -> Maybe Text
forall a. Eq a => a -> a -> Maybe a
justNonDef Text
defaultFormulaType Text
fType
          ]
      (Element
formulaEl, Text
fType) =
        case FormulaExpression
_cellfExpression of
          NormalFormula Formula
f -> (Name -> Formula -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
nm Formula
f, Text
defaultFormulaType)
          SharedFormula SharedFormulaIndex
si -> (Name -> [(Name, Text)] -> Element
leafElement Name
nm [Name
"si" Name -> SharedFormulaIndex -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= SharedFormulaIndex
si], Text
"shared")

instance ToAttrVal SharedFormulaIndex where
  toAttrVal :: SharedFormulaIndex -> Text
toAttrVal (SharedFormulaIndex Int
si) = Int -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Int
si

applySharedFormulaOpts :: SharedFormulaOptions -> Element -> Element
applySharedFormulaOpts :: SharedFormulaOptions -> Element -> Element
applySharedFormulaOpts SharedFormulaOptions {Formula
CellRef
_sfoExpression :: Formula
_sfoRef :: CellRef
_sfoExpression :: SharedFormulaOptions -> Formula
_sfoRef :: SharedFormulaOptions -> CellRef
..} Element
el =
  Element
el
  { elementAttributes :: Map Name Text
elementAttributes = Element -> Map Name Text
elementAttributes Element
el Map Name Text -> Map Name Text -> Map Name Text
forall a. Semigroup a => a -> a -> a
<> [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [Name
"ref" Name -> CellRef -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= CellRef
_sfoRef]
  , elementNodes :: [Node]
elementNodes = Text -> Node
NodeContent (Formula -> Text
unFormula Formula
_sfoExpression) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Element -> [Node]
elementNodes Element
el
  }