{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Common
  ( CellRef(..)
  , singleCellRef
  , fromSingleCellRef
  , fromSingleCellRefNoting
  , Range
  , mkRange
  , fromRange
  , SqRef(..)
  , XlsxText(..)
  , xlsxTextToCellValue
  , Formula(..)
  , CellValue(..)
  , ErrorType(..)
  , DateBase(..)
  , dateFromNumber
  , dateToNumber
  , int2col
  , col2int
  ) where

import GHC.Generics (Generic)

import Control.Arrow
import Control.DeepSeq (NFData)
import Control.Monad (forM, guard)
import qualified Data.ByteString as BS
import Data.Char
import Data.Ix (inRange)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Calendar (Day, addDays, diffDays, fromGregorian)
import Data.Time.Clock (UTCTime(UTCTime), picosecondsToDiffTime)
import Safe
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.RichText
import Codec.Xlsx.Writer.Internal

-- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\")
int2col :: Int -> Text
int2col :: Int -> Text
int2col = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
int2let ([Int] -> String) -> (Int -> [Int]) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
forall a. Integral a => a -> [a]
base26
    where
        int2let :: Int -> Char
int2let Int
0 = Char
'Z'
        int2let Int
x = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'A'
        base26 :: a -> [a]
base26  a
0 = []
        base26  a
i = let i' :: a
i' = (a
i a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
26)
                        i'' :: a
i'' = if a
i' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
26 else a
i'
                    in a -> [a] -> [a]
seq a
i' (a
i' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
base26 ((a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
i'') a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
26))

-- | reverse to 'int2col'
col2int :: Text -> Int
col2int :: Text -> Int
col2int = (Int -> Char -> Int) -> Int -> Text -> Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Int
i Char
c -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
let2int Char
c) Int
0
    where
        let2int :: Char -> Int
let2int Char
c = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A'

-- | Excel cell or cell range reference (e.g. @E3@)
-- See 18.18.62 @ST_Ref@ (p. 2482)
newtype CellRef = CellRef
  { CellRef -> Text
unCellRef :: Text
  } deriving (CellRef -> CellRef -> Bool
(CellRef -> CellRef -> Bool)
-> (CellRef -> CellRef -> Bool) -> Eq CellRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellRef -> CellRef -> Bool
$c/= :: CellRef -> CellRef -> Bool
== :: CellRef -> CellRef -> Bool
$c== :: CellRef -> CellRef -> Bool
Eq, Eq CellRef
Eq CellRef
-> (CellRef -> CellRef -> Ordering)
-> (CellRef -> CellRef -> Bool)
-> (CellRef -> CellRef -> Bool)
-> (CellRef -> CellRef -> Bool)
-> (CellRef -> CellRef -> Bool)
-> (CellRef -> CellRef -> CellRef)
-> (CellRef -> CellRef -> CellRef)
-> Ord CellRef
CellRef -> CellRef -> Bool
CellRef -> CellRef -> Ordering
CellRef -> CellRef -> CellRef
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 :: CellRef -> CellRef -> CellRef
$cmin :: CellRef -> CellRef -> CellRef
max :: CellRef -> CellRef -> CellRef
$cmax :: CellRef -> CellRef -> CellRef
>= :: CellRef -> CellRef -> Bool
$c>= :: CellRef -> CellRef -> Bool
> :: CellRef -> CellRef -> Bool
$c> :: CellRef -> CellRef -> Bool
<= :: CellRef -> CellRef -> Bool
$c<= :: CellRef -> CellRef -> Bool
< :: CellRef -> CellRef -> Bool
$c< :: CellRef -> CellRef -> Bool
compare :: CellRef -> CellRef -> Ordering
$ccompare :: CellRef -> CellRef -> Ordering
$cp1Ord :: Eq CellRef
Ord, Int -> CellRef -> String -> String
[CellRef] -> String -> String
CellRef -> String
(Int -> CellRef -> String -> String)
-> (CellRef -> String)
-> ([CellRef] -> String -> String)
-> Show CellRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CellRef] -> String -> String
$cshowList :: [CellRef] -> String -> String
show :: CellRef -> String
$cshow :: CellRef -> String
showsPrec :: Int -> CellRef -> String -> String
$cshowsPrec :: Int -> CellRef -> String -> String
Show, (forall x. CellRef -> Rep CellRef x)
-> (forall x. Rep CellRef x -> CellRef) -> Generic CellRef
forall x. Rep CellRef x -> CellRef
forall x. CellRef -> Rep CellRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellRef x -> CellRef
$cfrom :: forall x. CellRef -> Rep CellRef x
Generic)

instance NFData CellRef

-- | Render position in @(row, col)@ format to an Excel reference.
--
-- > mkCellRef (2, 4) == "D2"
singleCellRef :: (Int, Int) -> CellRef
singleCellRef :: (Int, Int) -> CellRef
singleCellRef = Text -> CellRef
CellRef (Text -> CellRef) -> ((Int, Int) -> Text) -> (Int, Int) -> CellRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Text
singleCellRefRaw

singleCellRefRaw :: (Int, Int) -> Text
singleCellRefRaw :: (Int, Int) -> Text
singleCellRefRaw (Int
row, Int
col) = [Text] -> Text
T.concat [Int -> Text
int2col Int
col, String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
row)]

-- | reverse to 'mkCellRef'
fromSingleCellRef :: CellRef -> Maybe (Int, Int)
fromSingleCellRef :: CellRef -> Maybe (Int, Int)
fromSingleCellRef = Text -> Maybe (Int, Int)
fromSingleCellRefRaw (Text -> Maybe (Int, Int))
-> (CellRef -> Text) -> CellRef -> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Text
unCellRef

fromSingleCellRefRaw :: Text -> Maybe (Int, Int)
fromSingleCellRefRaw :: Text -> Maybe (Int, Int)
fromSingleCellRefRaw Text
t = do
  let (Text
colT, Text
rowT) = (Char -> Bool) -> Text -> (Text, Text)
T.span ((Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'A', Char
'Z')) Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Text -> Bool
T.null Text
colT) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
rowT) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
rowT
  Int
row <- Text -> Maybe Int
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal Text
rowT
  (Int, Int) -> Maybe (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
row, Text -> Int
col2int Text
colT)

-- | reverse to 'mkCellRef' expecting valid reference and failig with
-- a standard error message like /"Bad cell reference 'XXX'"/
fromSingleCellRefNoting :: CellRef -> (Int, Int)
fromSingleCellRefNoting :: CellRef -> (Int, Int)
fromSingleCellRefNoting CellRef
ref = String -> Maybe (Int, Int) -> (Int, Int)
forall a. Partial => String -> Maybe a -> a
fromJustNote String
errMsg (Maybe (Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Int, Int)
fromSingleCellRefRaw Text
txt
  where
    txt :: Text
txt = CellRef -> Text
unCellRef CellRef
ref
    errMsg :: String
errMsg = String
"Bad cell reference '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Excel range (e.g. @D13:H14@), actually store as as 'CellRef' in
-- xlsx
type Range = CellRef

-- | Render range
--
-- > mkRange (2, 4) (6, 8) == "D2:H6"
mkRange :: (Int, Int) -> (Int, Int) -> Range
mkRange :: (Int, Int) -> (Int, Int) -> CellRef
mkRange (Int, Int)
fr (Int, Int)
to = Text -> CellRef
CellRef (Text -> CellRef) -> Text -> CellRef
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [(Int, Int) -> Text
singleCellRefRaw (Int, Int)
fr, String -> Text
T.pack String
":", (Int, Int) -> Text
singleCellRefRaw (Int, Int)
to]

-- | reverse to 'mkRange'
fromRange :: Range -> Maybe ((Int, Int), (Int, Int))
fromRange :: CellRef -> Maybe ((Int, Int), (Int, Int))
fromRange CellRef
r =
  case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (CellRef -> Text
unCellRef CellRef
r) of
    [Text
from, Text
to] -> (,) ((Int, Int) -> (Int, Int) -> ((Int, Int), (Int, Int)))
-> Maybe (Int, Int)
-> Maybe ((Int, Int) -> ((Int, Int), (Int, Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Int, Int)
fromSingleCellRefRaw Text
from Maybe ((Int, Int) -> ((Int, Int), (Int, Int)))
-> Maybe (Int, Int) -> Maybe ((Int, Int), (Int, Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe (Int, Int)
fromSingleCellRefRaw Text
to
    [Text]
_ -> Maybe ((Int, Int), (Int, Int))
forall a. Maybe a
Nothing

-- | A sequence of cell references
--
-- See 18.18.76 "ST_Sqref (Reference Sequence)" (p.2488)
newtype SqRef = SqRef [CellRef]
    deriving (SqRef -> SqRef -> Bool
(SqRef -> SqRef -> Bool) -> (SqRef -> SqRef -> Bool) -> Eq SqRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqRef -> SqRef -> Bool
$c/= :: SqRef -> SqRef -> Bool
== :: SqRef -> SqRef -> Bool
$c== :: SqRef -> SqRef -> Bool
Eq, Eq SqRef
Eq SqRef
-> (SqRef -> SqRef -> Ordering)
-> (SqRef -> SqRef -> Bool)
-> (SqRef -> SqRef -> Bool)
-> (SqRef -> SqRef -> Bool)
-> (SqRef -> SqRef -> Bool)
-> (SqRef -> SqRef -> SqRef)
-> (SqRef -> SqRef -> SqRef)
-> Ord SqRef
SqRef -> SqRef -> Bool
SqRef -> SqRef -> Ordering
SqRef -> SqRef -> SqRef
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 :: SqRef -> SqRef -> SqRef
$cmin :: SqRef -> SqRef -> SqRef
max :: SqRef -> SqRef -> SqRef
$cmax :: SqRef -> SqRef -> SqRef
>= :: SqRef -> SqRef -> Bool
$c>= :: SqRef -> SqRef -> Bool
> :: SqRef -> SqRef -> Bool
$c> :: SqRef -> SqRef -> Bool
<= :: SqRef -> SqRef -> Bool
$c<= :: SqRef -> SqRef -> Bool
< :: SqRef -> SqRef -> Bool
$c< :: SqRef -> SqRef -> Bool
compare :: SqRef -> SqRef -> Ordering
$ccompare :: SqRef -> SqRef -> Ordering
$cp1Ord :: Eq SqRef
Ord, Int -> SqRef -> String -> String
[SqRef] -> String -> String
SqRef -> String
(Int -> SqRef -> String -> String)
-> (SqRef -> String) -> ([SqRef] -> String -> String) -> Show SqRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SqRef] -> String -> String
$cshowList :: [SqRef] -> String -> String
show :: SqRef -> String
$cshow :: SqRef -> String
showsPrec :: Int -> SqRef -> String -> String
$cshowsPrec :: Int -> SqRef -> String -> String
Show, (forall x. SqRef -> Rep SqRef x)
-> (forall x. Rep SqRef x -> SqRef) -> Generic SqRef
forall x. Rep SqRef x -> SqRef
forall x. SqRef -> Rep SqRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SqRef x -> SqRef
$cfrom :: forall x. SqRef -> Rep SqRef x
Generic)

instance NFData SqRef

-- | Common type containing either simple string or rich formatted text.
-- Used in @si@, @comment@ and @is@ elements
--
-- E.g. @si@ spec says: "If the string is just a simple string with formatting applied
-- at the cell level, then the String Item (si) should contain a single text
-- element used to express the string. However, if the string in the cell is
-- more complex - i.e., has formatting applied at the character level - then the
-- string item shall consist of multiple rich text runs which collectively are
-- used to express the string.". So we have either a single "Text" field, or
-- else a list of "RichTextRun"s, each of which is some "Text" with layout
-- properties.
--
-- TODO: Currently we do not support @phoneticPr@ (Phonetic Properties, 18.4.3,
-- p. 1723) or @rPh@ (Phonetic Run, 18.4.6, p. 1725).
--
-- Section 18.4.8, "si (String Item)" (p. 1725)
--
-- See @CT_Rst@, p. 3903
data XlsxText = XlsxText Text
              | XlsxRichText [RichTextRun]
              deriving (XlsxText -> XlsxText -> Bool
(XlsxText -> XlsxText -> Bool)
-> (XlsxText -> XlsxText -> Bool) -> Eq XlsxText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XlsxText -> XlsxText -> Bool
$c/= :: XlsxText -> XlsxText -> Bool
== :: XlsxText -> XlsxText -> Bool
$c== :: XlsxText -> XlsxText -> Bool
Eq, Eq XlsxText
Eq XlsxText
-> (XlsxText -> XlsxText -> Ordering)
-> (XlsxText -> XlsxText -> Bool)
-> (XlsxText -> XlsxText -> Bool)
-> (XlsxText -> XlsxText -> Bool)
-> (XlsxText -> XlsxText -> Bool)
-> (XlsxText -> XlsxText -> XlsxText)
-> (XlsxText -> XlsxText -> XlsxText)
-> Ord XlsxText
XlsxText -> XlsxText -> Bool
XlsxText -> XlsxText -> Ordering
XlsxText -> XlsxText -> XlsxText
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 :: XlsxText -> XlsxText -> XlsxText
$cmin :: XlsxText -> XlsxText -> XlsxText
max :: XlsxText -> XlsxText -> XlsxText
$cmax :: XlsxText -> XlsxText -> XlsxText
>= :: XlsxText -> XlsxText -> Bool
$c>= :: XlsxText -> XlsxText -> Bool
> :: XlsxText -> XlsxText -> Bool
$c> :: XlsxText -> XlsxText -> Bool
<= :: XlsxText -> XlsxText -> Bool
$c<= :: XlsxText -> XlsxText -> Bool
< :: XlsxText -> XlsxText -> Bool
$c< :: XlsxText -> XlsxText -> Bool
compare :: XlsxText -> XlsxText -> Ordering
$ccompare :: XlsxText -> XlsxText -> Ordering
$cp1Ord :: Eq XlsxText
Ord, Int -> XlsxText -> String -> String
[XlsxText] -> String -> String
XlsxText -> String
(Int -> XlsxText -> String -> String)
-> (XlsxText -> String)
-> ([XlsxText] -> String -> String)
-> Show XlsxText
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [XlsxText] -> String -> String
$cshowList :: [XlsxText] -> String -> String
show :: XlsxText -> String
$cshow :: XlsxText -> String
showsPrec :: Int -> XlsxText -> String -> String
$cshowsPrec :: Int -> XlsxText -> String -> String
Show, (forall x. XlsxText -> Rep XlsxText x)
-> (forall x. Rep XlsxText x -> XlsxText) -> Generic XlsxText
forall x. Rep XlsxText x -> XlsxText
forall x. XlsxText -> Rep XlsxText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XlsxText x -> XlsxText
$cfrom :: forall x. XlsxText -> Rep XlsxText x
Generic)

instance NFData XlsxText

xlsxTextToCellValue :: XlsxText -> CellValue
xlsxTextToCellValue :: XlsxText -> CellValue
xlsxTextToCellValue (XlsxText Text
txt) = Text -> CellValue
CellText Text
txt
xlsxTextToCellValue (XlsxRichText [RichTextRun]
rich) = [RichTextRun] -> CellValue
CellRich [RichTextRun]
rich

-- | A formula
--
-- See 18.18.35 "ST_Formula (Formula)" (p. 2457)
newtype Formula = Formula {Formula -> Text
unFormula :: Text}
    deriving (Formula -> Formula -> Bool
(Formula -> Formula -> Bool)
-> (Formula -> Formula -> Bool) -> Eq Formula
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Formula -> Formula -> Bool
$c/= :: Formula -> Formula -> Bool
== :: Formula -> Formula -> Bool
$c== :: Formula -> Formula -> Bool
Eq, Eq Formula
Eq Formula
-> (Formula -> Formula -> Ordering)
-> (Formula -> Formula -> Bool)
-> (Formula -> Formula -> Bool)
-> (Formula -> Formula -> Bool)
-> (Formula -> Formula -> Bool)
-> (Formula -> Formula -> Formula)
-> (Formula -> Formula -> Formula)
-> Ord Formula
Formula -> Formula -> Bool
Formula -> Formula -> Ordering
Formula -> Formula -> Formula
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 :: Formula -> Formula -> Formula
$cmin :: Formula -> Formula -> Formula
max :: Formula -> Formula -> Formula
$cmax :: Formula -> Formula -> Formula
>= :: Formula -> Formula -> Bool
$c>= :: Formula -> Formula -> Bool
> :: Formula -> Formula -> Bool
$c> :: Formula -> Formula -> Bool
<= :: Formula -> Formula -> Bool
$c<= :: Formula -> Formula -> Bool
< :: Formula -> Formula -> Bool
$c< :: Formula -> Formula -> Bool
compare :: Formula -> Formula -> Ordering
$ccompare :: Formula -> Formula -> Ordering
$cp1Ord :: Eq Formula
Ord, Int -> Formula -> String -> String
[Formula] -> String -> String
Formula -> String
(Int -> Formula -> String -> String)
-> (Formula -> String)
-> ([Formula] -> String -> String)
-> Show Formula
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Formula] -> String -> String
$cshowList :: [Formula] -> String -> String
show :: Formula -> String
$cshow :: Formula -> String
showsPrec :: Int -> Formula -> String -> String
$cshowsPrec :: Int -> Formula -> String -> String
Show, (forall x. Formula -> Rep Formula x)
-> (forall x. Rep Formula x -> Formula) -> Generic Formula
forall x. Rep Formula x -> Formula
forall x. Formula -> Rep Formula x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Formula x -> Formula
$cfrom :: forall x. Formula -> Rep Formula x
Generic)

instance NFData Formula

-- | Cell values include text, numbers and booleans,
-- standard includes date format also but actually dates
-- are represented by numbers with a date format assigned
-- to a cell containing it
data CellValue
  = CellText Text
  | CellDouble Double
  | CellBool Bool
  | CellRich [RichTextRun]
  | CellError ErrorType
  deriving (CellValue -> CellValue -> Bool
(CellValue -> CellValue -> Bool)
-> (CellValue -> CellValue -> Bool) -> Eq CellValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellValue -> CellValue -> Bool
$c/= :: CellValue -> CellValue -> Bool
== :: CellValue -> CellValue -> Bool
$c== :: CellValue -> CellValue -> Bool
Eq, Eq CellValue
Eq CellValue
-> (CellValue -> CellValue -> Ordering)
-> (CellValue -> CellValue -> Bool)
-> (CellValue -> CellValue -> Bool)
-> (CellValue -> CellValue -> Bool)
-> (CellValue -> CellValue -> Bool)
-> (CellValue -> CellValue -> CellValue)
-> (CellValue -> CellValue -> CellValue)
-> Ord CellValue
CellValue -> CellValue -> Bool
CellValue -> CellValue -> Ordering
CellValue -> CellValue -> CellValue
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 :: CellValue -> CellValue -> CellValue
$cmin :: CellValue -> CellValue -> CellValue
max :: CellValue -> CellValue -> CellValue
$cmax :: CellValue -> CellValue -> CellValue
>= :: CellValue -> CellValue -> Bool
$c>= :: CellValue -> CellValue -> Bool
> :: CellValue -> CellValue -> Bool
$c> :: CellValue -> CellValue -> Bool
<= :: CellValue -> CellValue -> Bool
$c<= :: CellValue -> CellValue -> Bool
< :: CellValue -> CellValue -> Bool
$c< :: CellValue -> CellValue -> Bool
compare :: CellValue -> CellValue -> Ordering
$ccompare :: CellValue -> CellValue -> Ordering
$cp1Ord :: Eq CellValue
Ord, Int -> CellValue -> String -> String
[CellValue] -> String -> String
CellValue -> String
(Int -> CellValue -> String -> String)
-> (CellValue -> String)
-> ([CellValue] -> String -> String)
-> Show CellValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CellValue] -> String -> String
$cshowList :: [CellValue] -> String -> String
show :: CellValue -> String
$cshow :: CellValue -> String
showsPrec :: Int -> CellValue -> String -> String
$cshowsPrec :: Int -> CellValue -> String -> String
Show, (forall x. CellValue -> Rep CellValue x)
-> (forall x. Rep CellValue x -> CellValue) -> Generic CellValue
forall x. Rep CellValue x -> CellValue
forall x. CellValue -> Rep CellValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CellValue x -> CellValue
$cfrom :: forall x. CellValue -> Rep CellValue x
Generic)

instance NFData CellValue

-- | The evaluation of an expression can result in an error having one
-- of a number of error values.
--
-- See Annex L, L.2.16.8 "Error values" (p. 4764)
data ErrorType
  = ErrorDiv0
  -- ^ @#DIV/0!@ - Intended to indicate when any number, including
  -- zero, is divided by zero.
  | ErrorNA
  -- ^ @#N/A@ - Intended to indicate when a designated value is not
  -- available. For example, some functions, such as @SUMX2MY2@,
  -- perform a series of operations on corresponding elements in two
  -- arrays. If those arrays do not have the same number of elements,
  -- then for some elements in the longer array, there are no
  -- corresponding elements in the shorter one; that is, one or more
  -- values in the shorter array are not available. This error value
  -- can be produced by calling the function @NA@.
  | ErrorName
  -- ^ @#NAME?@ - Intended to indicate when what looks like a name is
  -- used, but no such name has been defined. For example, @XYZ/3@,
  -- where @XYZ@ is not a defined name. @Total is & A10@, where
  -- neither @Total@ nor @is@ is a defined name. Presumably, @"Total
  -- is " & A10@ was intended. @SUM(A1C10)@, where the range @A1:C10@
  -- was intended.
  | ErrorNull
  -- ^ @#NULL!@ - Intended to indicate when two areas are required to
  -- intersect, but do not. For example, In the case of @SUM(B1 C1)@,
  -- the space between @B1@ and @C1@ is treated as the binary
  -- intersection operator, when a comma was intended.
  | ErrorNum
  -- ^ @#NUM!@ - Intended to indicate when an argument to a function
  -- has a compatible type, but has a value that is outside the domain
  -- over which that function is defined. (This is known as a domain
  -- error.) For example, Certain calls to @ASIN@, @ATANH@, @FACT@,
  -- and @SQRT@ might result in domain errors. Intended to indicate
  -- that the result of a function cannot be represented in a value of
  -- the specified type, typically due to extreme magnitude. (This is
  -- known as a range error.) For example, @FACT(1000)@ might result
  -- in a range error.
  | ErrorRef
  -- ^ @#REF!@ - Intended to indicate when a cell reference is
  -- invalid. For example, If a formula contains a reference to a
  -- cell, and then the row or column containing that cell is deleted,
  -- a @#REF!@ error results. If a worksheet does not support 20,001
  -- columns, @OFFSET(A1,0,20000)@ results in a @#REF!@ error.
  | ErrorValue
  -- ^ @#VALUE!@ - Intended to indicate when an incompatible type
  -- argument is passed to a function, or an incompatible type operand
  -- is used with an operator. For example, In the case of a function
  -- argument, a number was expected, but text was provided. In the
  -- case of @1+"ABC"@, the binary addition operator is not defined for
  -- text.
  deriving (ErrorType -> ErrorType -> Bool
(ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool) -> Eq ErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c== :: ErrorType -> ErrorType -> Bool
Eq, Eq ErrorType
Eq ErrorType
-> (ErrorType -> ErrorType -> Ordering)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> Bool)
-> (ErrorType -> ErrorType -> ErrorType)
-> (ErrorType -> ErrorType -> ErrorType)
-> Ord ErrorType
ErrorType -> ErrorType -> Bool
ErrorType -> ErrorType -> Ordering
ErrorType -> ErrorType -> ErrorType
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 :: ErrorType -> ErrorType -> ErrorType
$cmin :: ErrorType -> ErrorType -> ErrorType
max :: ErrorType -> ErrorType -> ErrorType
$cmax :: ErrorType -> ErrorType -> ErrorType
>= :: ErrorType -> ErrorType -> Bool
$c>= :: ErrorType -> ErrorType -> Bool
> :: ErrorType -> ErrorType -> Bool
$c> :: ErrorType -> ErrorType -> Bool
<= :: ErrorType -> ErrorType -> Bool
$c<= :: ErrorType -> ErrorType -> Bool
< :: ErrorType -> ErrorType -> Bool
$c< :: ErrorType -> ErrorType -> Bool
compare :: ErrorType -> ErrorType -> Ordering
$ccompare :: ErrorType -> ErrorType -> Ordering
$cp1Ord :: Eq ErrorType
Ord, Int -> ErrorType -> String -> String
[ErrorType] -> String -> String
ErrorType -> String
(Int -> ErrorType -> String -> String)
-> (ErrorType -> String)
-> ([ErrorType] -> String -> String)
-> Show ErrorType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ErrorType] -> String -> String
$cshowList :: [ErrorType] -> String -> String
show :: ErrorType -> String
$cshow :: ErrorType -> String
showsPrec :: Int -> ErrorType -> String -> String
$cshowsPrec :: Int -> ErrorType -> String -> String
Show, (forall x. ErrorType -> Rep ErrorType x)
-> (forall x. Rep ErrorType x -> ErrorType) -> Generic ErrorType
forall x. Rep ErrorType x -> ErrorType
forall x. ErrorType -> Rep ErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorType x -> ErrorType
$cfrom :: forall x. ErrorType -> Rep ErrorType x
Generic)

instance NFData ErrorType

-- | Specifies date base used for conversion of serial values to and
-- from datetime values
--
-- See Annex L, L.2.16.9.1 "Date Conversion for Serial Values" (p. 4765)
data DateBase
  = DateBase1900
  -- ^ 1900 date base system, the lower limit is January 1, -9999
  -- 00:00:00, which has serial value -4346018. The upper-limit is
  -- December 31, 9999, 23:59:59, which has serial value
  -- 2,958,465.9999884. The base date for this date base system is
  -- December 30, 1899, which has a serial value of 0.
  | DateBase1904
  -- ^ 1904 backward compatibility date-base system, the lower limit
  -- is January 1, 1904, 00:00:00, which has serial value 0. The upper
  -- limit is December 31, 9999, 23:59:59, which has serial value
  -- 2,957,003.9999884. The base date for this date base system is
  -- January 1, 1904, which has a serial value of 0.
  deriving (DateBase -> DateBase -> Bool
(DateBase -> DateBase -> Bool)
-> (DateBase -> DateBase -> Bool) -> Eq DateBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateBase -> DateBase -> Bool
$c/= :: DateBase -> DateBase -> Bool
== :: DateBase -> DateBase -> Bool
$c== :: DateBase -> DateBase -> Bool
Eq, Int -> DateBase -> String -> String
[DateBase] -> String -> String
DateBase -> String
(Int -> DateBase -> String -> String)
-> (DateBase -> String)
-> ([DateBase] -> String -> String)
-> Show DateBase
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DateBase] -> String -> String
$cshowList :: [DateBase] -> String -> String
show :: DateBase -> String
$cshow :: DateBase -> String
showsPrec :: Int -> DateBase -> String -> String
$cshowsPrec :: Int -> DateBase -> String -> String
Show, (forall x. DateBase -> Rep DateBase x)
-> (forall x. Rep DateBase x -> DateBase) -> Generic DateBase
forall x. Rep DateBase x -> DateBase
forall x. DateBase -> Rep DateBase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateBase x -> DateBase
$cfrom :: forall x. DateBase -> Rep DateBase x
Generic)
instance NFData DateBase

baseDate :: DateBase -> Day
baseDate :: DateBase -> Day
baseDate DateBase
DateBase1900 = Integer -> Int -> Int -> Day
fromGregorian Integer
1899 Int
12 Int
30
baseDate DateBase
DateBase1904 = Integer -> Int -> Int -> Day
fromGregorian Integer
1904 Int
1 Int
1

-- | Convertts serial value into datetime according to the specified
-- date base
--
-- > show (dateFromNumber DateBase1900 42929.75) == "2017-07-13 18:00:00 UTC"
dateFromNumber :: RealFrac t => DateBase -> t -> UTCTime
dateFromNumber :: DateBase -> t -> UTCTime
dateFromNumber DateBase
b t
d = Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
diffTime
  where
    (Integer
numberOfDays, t
fractionOfOneDay) = t -> (Integer, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction t
d
    day :: Day
day = Integer -> Day -> Day
addDays Integer
numberOfDays (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ DateBase -> Day
baseDate DateBase
b
    diffTime :: DiffTime
diffTime = Integer -> DiffTime
picosecondsToDiffTime (t -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (t
fractionOfOneDay t -> t -> t
forall a. Num a => a -> a -> a
* t
24t -> t -> t
forall a. Num a => a -> a -> a
*t
60t -> t -> t
forall a. Num a => a -> a -> a
*t
60t -> t -> t
forall a. Num a => a -> a -> a
*t
1E12))

-- | Converts datetime into serial value
dateToNumber :: Fractional a => DateBase -> UTCTime -> a
dateToNumber :: DateBase -> UTCTime -> a
dateToNumber DateBase
b (UTCTime Day
day DiffTime
diffTime) = a
numberOfDays a -> a -> a
forall a. Num a => a -> a -> a
+ a
fractionOfOneDay
  where
    numberOfDays :: a
numberOfDays = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Day -> Integer
diffDays Day
day (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ DateBase -> Day
baseDate DateBase
b)
    fractionOfOneDay :: a
fractionOfOneDay = DiffTime -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
diffTime a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
24 a -> a -> a
forall a. Num a => a -> a -> a
* a
60 a -> a -> a
forall a. Num a => a -> a -> a
* a
60)

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

-- | See @CT_Rst@, p. 3903
instance FromCursor XlsxText where
  fromCursor :: Cursor -> [XlsxText]
fromCursor Cursor
cur = do
    let
      ts :: [Text]
ts = Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"t") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Text]
contentOrEmpty
      rs :: [RichTextRun]
rs = Cursor
cur Cursor -> (Cursor -> [RichTextRun]) -> [RichTextRun]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"r") Axis -> (Cursor -> [RichTextRun]) -> Cursor -> [RichTextRun]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [RichTextRun]
forall a. FromCursor a => Cursor -> [a]
fromCursor
    case ([Text]
ts,[RichTextRun]
rs) of
      ([Text
t], []) ->
        XlsxText -> [XlsxText]
forall (m :: * -> *) a. Monad m => a -> m a
return (XlsxText -> [XlsxText]) -> XlsxText -> [XlsxText]
forall a b. (a -> b) -> a -> b
$ Text -> XlsxText
XlsxText Text
t
      ([], RichTextRun
_:[RichTextRun]
_) ->
        XlsxText -> [XlsxText]
forall (m :: * -> *) a. Monad m => a -> m a
return (XlsxText -> [XlsxText]) -> XlsxText -> [XlsxText]
forall a b. (a -> b) -> a -> b
$ [RichTextRun] -> XlsxText
XlsxRichText [RichTextRun]
rs
      ([Text], [RichTextRun])
_ ->
        String -> [XlsxText]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid item"

instance FromXenoNode XlsxText where
  fromXenoNode :: Node -> Either Text XlsxText
fromXenoNode Node
root = do
    (Maybe Node
mCh, [RichTextRun]
rs) <-
      Node
-> ChildCollector (Maybe Node, [RichTextRun])
-> Either Text (Maybe Node, [RichTextRun])
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector (Maybe Node, [RichTextRun])
 -> Either Text (Maybe Node, [RichTextRun]))
-> ChildCollector (Maybe Node, [RichTextRun])
-> Either Text (Maybe Node, [RichTextRun])
forall a b. (a -> b) -> a -> b
$ (,) (Maybe Node -> [RichTextRun] -> (Maybe Node, [RichTextRun]))
-> ChildCollector (Maybe Node)
-> ChildCollector ([RichTextRun] -> (Maybe Node, [RichTextRun]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"t" ChildCollector ([RichTextRun] -> (Maybe Node, [RichTextRun]))
-> ChildCollector [RichTextRun]
-> ChildCollector (Maybe Node, [RichTextRun])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector [RichTextRun]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"r"
    Maybe Text
mT <- (Node -> Either Text Text)
-> Maybe Node -> Either Text (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> Either Text Text
contentX Maybe Node
mCh
    case Maybe Text
mT of
      Just Text
t -> XlsxText -> Either Text XlsxText
forall (m :: * -> *) a. Monad m => a -> m a
return (XlsxText -> Either Text XlsxText)
-> XlsxText -> Either Text XlsxText
forall a b. (a -> b) -> a -> b
$ Text -> XlsxText
XlsxText Text
t
      Maybe Text
Nothing ->
        case [RichTextRun]
rs of
          [] -> Text -> Either Text XlsxText
forall a b. a -> Either a b
Left (Text -> Either Text XlsxText) -> Text -> Either Text XlsxText
forall a b. (a -> b) -> a -> b
$ Text
"missing rich text subelements"
          [RichTextRun]
_ -> XlsxText -> Either Text XlsxText
forall (m :: * -> *) a. Monad m => a -> m a
return (XlsxText -> Either Text XlsxText)
-> XlsxText -> Either Text XlsxText
forall a b. (a -> b) -> a -> b
$ [RichTextRun] -> XlsxText
XlsxRichText [RichTextRun]
rs

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

instance FromAttrBs CellRef where
  -- we presume that cell references contain only latin letters,
  -- numbers and colon
  fromAttrBs :: ByteString -> Either Text CellRef
fromAttrBs = CellRef -> Either Text CellRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CellRef -> Either Text CellRef)
-> (ByteString -> CellRef) -> ByteString -> Either Text CellRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CellRef
CellRef (Text -> CellRef) -> (ByteString -> Text) -> ByteString -> CellRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1

instance FromAttrVal SqRef where
  fromAttrVal :: Reader SqRef
fromAttrVal Text
t = do
    [CellRef]
rs <- (Text -> Either String CellRef)
-> [Text] -> Either String [CellRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((CellRef, Text) -> CellRef)
-> Either String (CellRef, Text) -> Either String CellRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CellRef, Text) -> CellRef
forall a b. (a, b) -> a
fst (Either String (CellRef, Text) -> Either String CellRef)
-> Reader CellRef -> Text -> Either String CellRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader CellRef
forall a. FromAttrVal a => Reader a
fromAttrVal) ([Text] -> Either String [CellRef])
-> [Text] -> Either String [CellRef]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t
    SqRef -> Either String (SqRef, Text)
forall a. a -> Either String (a, Text)
readSuccess (SqRef -> Either String (SqRef, Text))
-> SqRef -> Either String (SqRef, Text)
forall a b. (a -> b) -> a -> b
$ [CellRef] -> SqRef
SqRef [CellRef]
rs

instance FromAttrBs SqRef where
  fromAttrBs :: ByteString -> Either Text SqRef
fromAttrBs ByteString
bs = do
    -- split on space
    [CellRef]
rs <- [ByteString]
-> (ByteString -> Either Text CellRef) -> Either Text [CellRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM  (Word8 -> ByteString -> [ByteString]
BS.split Word8
32 ByteString
bs) ByteString -> Either Text CellRef
forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs
    SqRef -> Either Text SqRef
forall (m :: * -> *) a. Monad m => a -> m a
return (SqRef -> Either Text SqRef) -> SqRef -> Either Text SqRef
forall a b. (a -> b) -> a -> b
$ [CellRef] -> SqRef
SqRef [CellRef]
rs

-- | See @ST_Formula@, p. 3873
instance FromCursor Formula where
    fromCursor :: Cursor -> [Formula]
fromCursor Cursor
cur = [Text -> Formula
Formula (Text -> Formula) -> ([Text] -> Text) -> [Text] -> Formula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Formula) -> [Text] -> Formula
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content]

instance FromXenoNode Formula where
  fromXenoNode :: Node -> Either Text Formula
fromXenoNode = (Text -> Formula) -> Either Text Text -> Either Text Formula
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Formula
Formula (Either Text Text -> Either Text Formula)
-> (Node -> Either Text Text) -> Node -> Either Text Formula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Either Text Text
contentX

instance FromAttrVal Formula where
  fromAttrVal :: Reader Formula
fromAttrVal Text
t = Formula -> Either String (Formula, Text)
forall a. a -> Either String (a, Text)
readSuccess (Formula -> Either String (Formula, Text))
-> Formula -> Either String (Formula, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Formula
Formula Text
t

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

instance FromAttrVal ErrorType where
  fromAttrVal :: Reader ErrorType
fromAttrVal Text
"#DIV/0!" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorDiv0
  fromAttrVal Text
"#N/A" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorNA
  fromAttrVal Text
"#NAME?" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorName
  fromAttrVal Text
"#NULL!" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorNull
  fromAttrVal Text
"#NUM!" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorNum
  fromAttrVal Text
"#REF!" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorRef
  fromAttrVal Text
"#VALUE!" = ErrorType -> Either String (ErrorType, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorType
ErrorValue
  fromAttrVal Text
t = Text -> Reader ErrorType
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"ErrorType" Text
t

instance FromAttrBs ErrorType where
  fromAttrBs :: ByteString -> Either Text ErrorType
fromAttrBs ByteString
"#DIV/0!" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorDiv0
  fromAttrBs ByteString
"#N/A" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNA
  fromAttrBs ByteString
"#NAME?" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorName
  fromAttrBs ByteString
"#NULL!" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNull
  fromAttrBs ByteString
"#NUM!" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNum
  fromAttrBs ByteString
"#REF!" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorRef
  fromAttrBs ByteString
"#VALUE!" = ErrorType -> Either Text ErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorValue
  fromAttrBs ByteString
x = Text -> ByteString -> Either Text ErrorType
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"ErrorType" ByteString
x

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

-- | See @CT_Rst@, p. 3903
instance ToElement XlsxText where
  toElement :: Name -> XlsxText -> Element
toElement Name
nm XlsxText
si = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall k a. Map k a
Map.empty
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node]) -> [Element] -> [Node]
forall a b. (a -> b) -> a -> b
$
        case XlsxText
si of
          XlsxText Text
text     -> [Name -> Text -> Element
elementContent Name
"t" Text
text]
          XlsxRichText [RichTextRun]
rich -> (RichTextRun -> Element) -> [RichTextRun] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> RichTextRun -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"r") [RichTextRun]
rich
    }

instance ToAttrVal CellRef where
  toAttrVal :: CellRef -> Text
toAttrVal = Text -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal (Text -> Text) -> (CellRef -> Text) -> CellRef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Text
unCellRef

-- See 18.18.76, "ST_Sqref (Reference Sequence)", p. 2488.
instance ToAttrVal SqRef where
  toAttrVal :: SqRef -> Text
toAttrVal (SqRef [CellRef]
refs) = Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (CellRef -> Text) -> [CellRef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map CellRef -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal [CellRef]
refs

-- | See @ST_Formula@, p. 3873
instance ToElement Formula where
    toElement :: Name -> Formula -> Element
toElement Name
nm (Formula Text
txt) = Name -> Text -> Element
elementContent Name
nm Text
txt

instance ToAttrVal ErrorType where
  toAttrVal :: ErrorType -> Text
toAttrVal ErrorType
ErrorDiv0 = Text
"#DIV/0!"
  toAttrVal ErrorType
ErrorNA = Text
"#N/A"
  toAttrVal ErrorType
ErrorName = Text
"#NAME?"
  toAttrVal ErrorType
ErrorNull = Text
"#NULL!"
  toAttrVal ErrorType
ErrorNum = Text
"#NUM!"
  toAttrVal ErrorType
ErrorRef = Text
"#REF!"
  toAttrVal ErrorType
ErrorValue = Text
"#VALUE!"