{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Codec.Xlsx.Types.Internal.FormulaData where

import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Cell
import Codec.Xlsx.Types.Common

data FormulaData = FormulaData
  { FormulaData -> CellFormula
frmdFormula :: CellFormula
  , FormulaData -> Maybe (SharedFormulaIndex, SharedFormulaOptions)
frmdShared :: Maybe (SharedFormulaIndex, SharedFormulaOptions)
  } deriving (forall x. FormulaData -> Rep FormulaData x)
-> (forall x. Rep FormulaData x -> FormulaData)
-> Generic FormulaData
forall x. Rep FormulaData x -> FormulaData
forall x. FormulaData -> Rep FormulaData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormulaData x -> FormulaData
$cfrom :: forall x. FormulaData -> Rep FormulaData x
Generic

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

instance FromXenoNode FormulaData where
  fromXenoNode :: Node -> Either Text FormulaData
fromXenoNode Node
n = do
    (Bool
bx, Bool
ca, Text
t, Maybe SharedFormulaIndex
mSi, Maybe CellRef
mRef) <-
      Node
-> AttrParser
     (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
-> Either
     Text (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
n (AttrParser
   (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
 -> Either
      Text (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser
     (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
-> Either
     Text (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
forall a b. (a -> b) -> a -> b
$
      (,,,,) (Bool
 -> Bool
 -> Text
 -> Maybe SharedFormulaIndex
 -> Maybe CellRef
 -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser Bool
-> AttrParser
     (Bool
      -> Text
      -> Maybe SharedFormulaIndex
      -> Maybe CellRef
      -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"bx" Bool
False
             AttrParser
  (Bool
   -> Text
   -> Maybe SharedFormulaIndex
   -> Maybe CellRef
   -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser Bool
-> AttrParser
     (Text
      -> Maybe SharedFormulaIndex
      -> Maybe CellRef
      -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"ca" Bool
False
             AttrParser
  (Text
   -> Maybe SharedFormulaIndex
   -> Maybe CellRef
   -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser Text
-> AttrParser
     (Maybe SharedFormulaIndex
      -> Maybe CellRef
      -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Text -> AttrParser Text
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"t" Text
defaultFormulaType
             AttrParser
  (Maybe SharedFormulaIndex
   -> Maybe CellRef
   -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser (Maybe SharedFormulaIndex)
-> AttrParser
     (Maybe CellRef
      -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser (Maybe SharedFormulaIndex)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"si"
             AttrParser
  (Maybe CellRef
   -> (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef))
-> AttrParser (Maybe CellRef)
-> AttrParser
     (Bool, Bool, Text, Maybe SharedFormulaIndex, Maybe CellRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser (Maybe CellRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"ref"
    (FormulaExpression
expr, 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
            Text
formula <- Node -> Either Text Text
contentX Node
n
            (FormulaExpression,
 Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Either
     Text
     (FormulaExpression,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall (m :: * -> *) a. Monad m => a -> m a
return (Formula -> FormulaExpression
NormalFormula (Formula -> FormulaExpression) -> Formula -> FormulaExpression
forall a b. (a -> b) -> a -> b
$ Text -> Formula
Formula Text
formula, Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall a. Maybe a
Nothing)
        Text
"shared" -> do
          SharedFormulaIndex
si <-
            Either Text SharedFormulaIndex
-> (SharedFormulaIndex -> Either Text SharedFormulaIndex)
-> Maybe SharedFormulaIndex
-> Either Text SharedFormulaIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (Text -> Either Text SharedFormulaIndex
forall a b. a -> Either a b
Left Text
"missing si attribute for shared formula")
              SharedFormulaIndex -> Either Text SharedFormulaIndex
forall (m :: * -> *) a. Monad m => a -> m a
return
              Maybe SharedFormulaIndex
mSi
          Formula
formula <- Text -> Formula
Formula (Text -> Formula) -> Either Text Text -> Either Text Formula
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> Either Text Text
contentX Node
n
          (FormulaExpression,
 Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Either
     Text
     (FormulaExpression,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( SharedFormulaIndex -> FormulaExpression
SharedFormula SharedFormulaIndex
si
            , Maybe CellRef
mRef Maybe CellRef
-> (CellRef -> Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CellRef
ref -> (SharedFormulaIndex, SharedFormulaOptions)
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (SharedFormulaIndex
si, (CellRef -> Formula -> SharedFormulaOptions
SharedFormulaOptions CellRef
ref Formula
formula)))
        Text
unexpected -> Text
-> Either
     Text
     (FormulaExpression,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall a b. a -> Either a b
Left (Text
 -> Either
      Text
      (FormulaExpression,
       Maybe (SharedFormulaIndex, SharedFormulaOptions)))
-> Text
-> Either
     Text
     (FormulaExpression,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected formula type" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
unexpected)
    let f :: CellFormula
f =
          CellFormula :: FormulaExpression -> Bool -> Bool -> CellFormula
CellFormula
          { _cellfAssignsToName :: Bool
_cellfAssignsToName = Bool
bx
          , _cellfCalculate :: Bool
_cellfCalculate = Bool
ca
          , _cellfExpression :: FormulaExpression
_cellfExpression = FormulaExpression
expr
          }
    FormulaData -> Either Text FormulaData
forall (m :: * -> *) a. Monad m => a -> m a
return (FormulaData -> Either Text FormulaData)
-> FormulaData -> Either Text FormulaData
forall a b. (a -> b) -> a -> b
$ CellFormula
-> Maybe (SharedFormulaIndex, SharedFormulaOptions) -> FormulaData
FormulaData CellFormula
f Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared