{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Codec.Xlsx.Types.Common
  ( CellRef(..)
  , RowCoord(..)
  , ColumnCoord(..)
  , CellCoord
  , RangeCoord
  , mapBoth
  , col2coord
  , coord2col
  , row2coord
  , coord2row
  , singleCellRef
  , singleCellRef'
  , fromSingleCellRef
  , fromSingleCellRef'
  , fromSingleCellRefNoting
  , escapeRefSheetName
  , unEscapeRefSheetName
  , mkForeignSingleCellRef
  , fromForeignSingleCellRef
  , Range
  , mkRange
  , mkRange'
  , mkForeignRange
  , fromRange
  , fromRange'
  , fromForeignRange
  , SqRef(..)
  , XlsxText(..)
  , xlsxTextToCellValue
  , Formula(..)
  , CellValue(..)
  , ErrorType(..)
  , DateBase(..)
  , dateFromNumber
  , dateToNumber
  , int2col
  , col2int
  , columnIndexToText
  , textToColumnIndex
  -- ** prisms
  , _XlsxText
  , _XlsxRichText
  , _CellText
  , _CellDouble
  , _CellBool
  , _CellRich
  , _CellError
  , RowIndex(..)
  , ColumnIndex(..)
  ) where

import GHC.Generics (Generic)

import Control.Applicative (liftA2)
import Control.Arrow
import Control.DeepSeq (NFData)
import Control.Monad (forM, guard)
import Data.Bifunctor (bimap)
import qualified Data.ByteString as BS
import Data.Char
import Data.Maybe (isJust, fromMaybe)
import Data.Function ((&))
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
#ifdef USE_MICROLENS
import Lens.Micro
import Lens.Micro.Internal
import Lens.Micro.GHC ()
import Data.Profunctor.Choice
import Data.Profunctor(dimap)
#else
import Control.Lens(makePrisms)
#endif

newtype RowIndex = RowIndex {RowIndex -> Int
unRowIndex :: Int}
  deriving (RowIndex -> RowIndex -> Bool
(RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool) -> Eq RowIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowIndex -> RowIndex -> Bool
== :: RowIndex -> RowIndex -> Bool
$c/= :: RowIndex -> RowIndex -> Bool
/= :: RowIndex -> RowIndex -> Bool
Eq, Eq RowIndex
Eq RowIndex =>
(RowIndex -> RowIndex -> Ordering)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> Bool)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> Ord RowIndex
RowIndex -> RowIndex -> Bool
RowIndex -> RowIndex -> Ordering
RowIndex -> RowIndex -> RowIndex
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
$ccompare :: RowIndex -> RowIndex -> Ordering
compare :: RowIndex -> RowIndex -> Ordering
$c< :: RowIndex -> RowIndex -> Bool
< :: RowIndex -> RowIndex -> Bool
$c<= :: RowIndex -> RowIndex -> Bool
<= :: RowIndex -> RowIndex -> Bool
$c> :: RowIndex -> RowIndex -> Bool
> :: RowIndex -> RowIndex -> Bool
$c>= :: RowIndex -> RowIndex -> Bool
>= :: RowIndex -> RowIndex -> Bool
$cmax :: RowIndex -> RowIndex -> RowIndex
max :: RowIndex -> RowIndex -> RowIndex
$cmin :: RowIndex -> RowIndex -> RowIndex
min :: RowIndex -> RowIndex -> RowIndex
Ord, Int -> RowIndex -> ShowS
[RowIndex] -> ShowS
RowIndex -> String
(Int -> RowIndex -> ShowS)
-> (RowIndex -> String) -> ([RowIndex] -> ShowS) -> Show RowIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowIndex -> ShowS
showsPrec :: Int -> RowIndex -> ShowS
$cshow :: RowIndex -> String
show :: RowIndex -> String
$cshowList :: [RowIndex] -> ShowS
showList :: [RowIndex] -> ShowS
Show, ReadPrec [RowIndex]
ReadPrec RowIndex
Int -> ReadS RowIndex
ReadS [RowIndex]
(Int -> ReadS RowIndex)
-> ReadS [RowIndex]
-> ReadPrec RowIndex
-> ReadPrec [RowIndex]
-> Read RowIndex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RowIndex
readsPrec :: Int -> ReadS RowIndex
$creadList :: ReadS [RowIndex]
readList :: ReadS [RowIndex]
$creadPrec :: ReadPrec RowIndex
readPrec :: ReadPrec RowIndex
$creadListPrec :: ReadPrec [RowIndex]
readListPrec :: ReadPrec [RowIndex]
Read, (forall x. RowIndex -> Rep RowIndex x)
-> (forall x. Rep RowIndex x -> RowIndex) -> Generic RowIndex
forall x. Rep RowIndex x -> RowIndex
forall x. RowIndex -> Rep RowIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RowIndex -> Rep RowIndex x
from :: forall x. RowIndex -> Rep RowIndex x
$cto :: forall x. Rep RowIndex x -> RowIndex
to :: forall x. Rep RowIndex x -> RowIndex
Generic, Integer -> RowIndex
RowIndex -> RowIndex
RowIndex -> RowIndex -> RowIndex
(RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex)
-> (RowIndex -> RowIndex)
-> (RowIndex -> RowIndex)
-> (Integer -> RowIndex)
-> Num RowIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RowIndex -> RowIndex -> RowIndex
+ :: RowIndex -> RowIndex -> RowIndex
$c- :: RowIndex -> RowIndex -> RowIndex
- :: RowIndex -> RowIndex -> RowIndex
$c* :: RowIndex -> RowIndex -> RowIndex
* :: RowIndex -> RowIndex -> RowIndex
$cnegate :: RowIndex -> RowIndex
negate :: RowIndex -> RowIndex
$cabs :: RowIndex -> RowIndex
abs :: RowIndex -> RowIndex
$csignum :: RowIndex -> RowIndex
signum :: RowIndex -> RowIndex
$cfromInteger :: Integer -> RowIndex
fromInteger :: Integer -> RowIndex
Num, Num RowIndex
Ord RowIndex
(Num RowIndex, Ord RowIndex) =>
(RowIndex -> Rational) -> Real RowIndex
RowIndex -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: RowIndex -> Rational
toRational :: RowIndex -> Rational
Real, Int -> RowIndex
RowIndex -> Int
RowIndex -> [RowIndex]
RowIndex -> RowIndex
RowIndex -> RowIndex -> [RowIndex]
RowIndex -> RowIndex -> RowIndex -> [RowIndex]
(RowIndex -> RowIndex)
-> (RowIndex -> RowIndex)
-> (Int -> RowIndex)
-> (RowIndex -> Int)
-> (RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> [RowIndex])
-> (RowIndex -> RowIndex -> RowIndex -> [RowIndex])
-> Enum RowIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RowIndex -> RowIndex
succ :: RowIndex -> RowIndex
$cpred :: RowIndex -> RowIndex
pred :: RowIndex -> RowIndex
$ctoEnum :: Int -> RowIndex
toEnum :: Int -> RowIndex
$cfromEnum :: RowIndex -> Int
fromEnum :: RowIndex -> Int
$cenumFrom :: RowIndex -> [RowIndex]
enumFrom :: RowIndex -> [RowIndex]
$cenumFromThen :: RowIndex -> RowIndex -> [RowIndex]
enumFromThen :: RowIndex -> RowIndex -> [RowIndex]
$cenumFromTo :: RowIndex -> RowIndex -> [RowIndex]
enumFromTo :: RowIndex -> RowIndex -> [RowIndex]
$cenumFromThenTo :: RowIndex -> RowIndex -> RowIndex -> [RowIndex]
enumFromThenTo :: RowIndex -> RowIndex -> RowIndex -> [RowIndex]
Enum, Enum RowIndex
Real RowIndex
(Real RowIndex, Enum RowIndex) =>
(RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> RowIndex)
-> (RowIndex -> RowIndex -> (RowIndex, RowIndex))
-> (RowIndex -> RowIndex -> (RowIndex, RowIndex))
-> (RowIndex -> Integer)
-> Integral RowIndex
RowIndex -> Integer
RowIndex -> RowIndex -> (RowIndex, RowIndex)
RowIndex -> RowIndex -> RowIndex
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: RowIndex -> RowIndex -> RowIndex
quot :: RowIndex -> RowIndex -> RowIndex
$crem :: RowIndex -> RowIndex -> RowIndex
rem :: RowIndex -> RowIndex -> RowIndex
$cdiv :: RowIndex -> RowIndex -> RowIndex
div :: RowIndex -> RowIndex -> RowIndex
$cmod :: RowIndex -> RowIndex -> RowIndex
mod :: RowIndex -> RowIndex -> RowIndex
$cquotRem :: RowIndex -> RowIndex -> (RowIndex, RowIndex)
quotRem :: RowIndex -> RowIndex -> (RowIndex, RowIndex)
$cdivMod :: RowIndex -> RowIndex -> (RowIndex, RowIndex)
divMod :: RowIndex -> RowIndex -> (RowIndex, RowIndex)
$ctoInteger :: RowIndex -> Integer
toInteger :: RowIndex -> Integer
Integral)
newtype ColumnIndex = ColumnIndex {ColumnIndex -> Int
unColumnIndex :: Int}
  deriving (ColumnIndex -> ColumnIndex -> Bool
(ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool) -> Eq ColumnIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnIndex -> ColumnIndex -> Bool
== :: ColumnIndex -> ColumnIndex -> Bool
$c/= :: ColumnIndex -> ColumnIndex -> Bool
/= :: ColumnIndex -> ColumnIndex -> Bool
Eq, Eq ColumnIndex
Eq ColumnIndex =>
(ColumnIndex -> ColumnIndex -> Ordering)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> Ord ColumnIndex
ColumnIndex -> ColumnIndex -> Bool
ColumnIndex -> ColumnIndex -> Ordering
ColumnIndex -> ColumnIndex -> ColumnIndex
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
$ccompare :: ColumnIndex -> ColumnIndex -> Ordering
compare :: ColumnIndex -> ColumnIndex -> Ordering
$c< :: ColumnIndex -> ColumnIndex -> Bool
< :: ColumnIndex -> ColumnIndex -> Bool
$c<= :: ColumnIndex -> ColumnIndex -> Bool
<= :: ColumnIndex -> ColumnIndex -> Bool
$c> :: ColumnIndex -> ColumnIndex -> Bool
> :: ColumnIndex -> ColumnIndex -> Bool
$c>= :: ColumnIndex -> ColumnIndex -> Bool
>= :: ColumnIndex -> ColumnIndex -> Bool
$cmax :: ColumnIndex -> ColumnIndex -> ColumnIndex
max :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmin :: ColumnIndex -> ColumnIndex -> ColumnIndex
min :: ColumnIndex -> ColumnIndex -> ColumnIndex
Ord, Int -> ColumnIndex -> ShowS
[ColumnIndex] -> ShowS
ColumnIndex -> String
(Int -> ColumnIndex -> ShowS)
-> (ColumnIndex -> String)
-> ([ColumnIndex] -> ShowS)
-> Show ColumnIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnIndex -> ShowS
showsPrec :: Int -> ColumnIndex -> ShowS
$cshow :: ColumnIndex -> String
show :: ColumnIndex -> String
$cshowList :: [ColumnIndex] -> ShowS
showList :: [ColumnIndex] -> ShowS
Show, ReadPrec [ColumnIndex]
ReadPrec ColumnIndex
Int -> ReadS ColumnIndex
ReadS [ColumnIndex]
(Int -> ReadS ColumnIndex)
-> ReadS [ColumnIndex]
-> ReadPrec ColumnIndex
-> ReadPrec [ColumnIndex]
-> Read ColumnIndex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ColumnIndex
readsPrec :: Int -> ReadS ColumnIndex
$creadList :: ReadS [ColumnIndex]
readList :: ReadS [ColumnIndex]
$creadPrec :: ReadPrec ColumnIndex
readPrec :: ReadPrec ColumnIndex
$creadListPrec :: ReadPrec [ColumnIndex]
readListPrec :: ReadPrec [ColumnIndex]
Read, (forall x. ColumnIndex -> Rep ColumnIndex x)
-> (forall x. Rep ColumnIndex x -> ColumnIndex)
-> Generic ColumnIndex
forall x. Rep ColumnIndex x -> ColumnIndex
forall x. ColumnIndex -> Rep ColumnIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnIndex -> Rep ColumnIndex x
from :: forall x. ColumnIndex -> Rep ColumnIndex x
$cto :: forall x. Rep ColumnIndex x -> ColumnIndex
to :: forall x. Rep ColumnIndex x -> ColumnIndex
Generic, Integer -> ColumnIndex
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> ColumnIndex
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Integer -> ColumnIndex)
-> Num ColumnIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c- :: ColumnIndex -> ColumnIndex -> ColumnIndex
- :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c* :: ColumnIndex -> ColumnIndex -> ColumnIndex
* :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cnegate :: ColumnIndex -> ColumnIndex
negate :: ColumnIndex -> ColumnIndex
$cabs :: ColumnIndex -> ColumnIndex
abs :: ColumnIndex -> ColumnIndex
$csignum :: ColumnIndex -> ColumnIndex
signum :: ColumnIndex -> ColumnIndex
$cfromInteger :: Integer -> ColumnIndex
fromInteger :: Integer -> ColumnIndex
Num, Num ColumnIndex
Ord ColumnIndex
(Num ColumnIndex, Ord ColumnIndex) =>
(ColumnIndex -> Rational) -> Real ColumnIndex
ColumnIndex -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ColumnIndex -> Rational
toRational :: ColumnIndex -> Rational
Real, Int -> ColumnIndex
ColumnIndex -> Int
ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
(ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Int -> ColumnIndex)
-> (ColumnIndex -> Int)
-> (ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> Enum ColumnIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColumnIndex -> ColumnIndex
succ :: ColumnIndex -> ColumnIndex
$cpred :: ColumnIndex -> ColumnIndex
pred :: ColumnIndex -> ColumnIndex
$ctoEnum :: Int -> ColumnIndex
toEnum :: Int -> ColumnIndex
$cfromEnum :: ColumnIndex -> Int
fromEnum :: ColumnIndex -> Int
$cenumFrom :: ColumnIndex -> [ColumnIndex]
enumFrom :: ColumnIndex -> [ColumnIndex]
$cenumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
Enum, Enum ColumnIndex
Real ColumnIndex
(Real ColumnIndex, Enum ColumnIndex) =>
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> Integer)
-> Integral ColumnIndex
ColumnIndex -> Integer
ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
ColumnIndex -> ColumnIndex -> ColumnIndex
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ColumnIndex -> ColumnIndex -> ColumnIndex
quot :: ColumnIndex -> ColumnIndex -> ColumnIndex
$crem :: ColumnIndex -> ColumnIndex -> ColumnIndex
rem :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cdiv :: ColumnIndex -> ColumnIndex -> ColumnIndex
div :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmod :: ColumnIndex -> ColumnIndex -> ColumnIndex
mod :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cquotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
quotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$cdivMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
divMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$ctoInteger :: ColumnIndex -> Integer
toInteger :: ColumnIndex -> Integer
Integral)
instance NFData RowIndex
instance NFData ColumnIndex

instance ToAttrVal RowIndex where
  toAttrVal :: RowIndex -> Text
toAttrVal = Int -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal (Int -> Text) -> (RowIndex -> Int) -> RowIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex -> Int
unRowIndex

{-# DEPRECATED int2col
    "this function will be removed in an upcoming release, use columnIndexToText instead." #-}
int2col :: ColumnIndex -> Text
int2col :: ColumnIndex -> Text
int2col = ColumnIndex -> Text
columnIndexToText

{-# DEPRECATED col2int
    "this function will be removed in an upcoming release, use textToColumnIndex instead." #-}
col2int :: Text -> ColumnIndex
col2int :: Text -> ColumnIndex
col2int = Text -> ColumnIndex
textToColumnIndex

-- | convert column number (starting from 1) to its textual form (e.g. 3 -> \"C\")
columnIndexToText :: ColumnIndex -> Text
columnIndexToText :: ColumnIndex -> Text
columnIndexToText = String -> Text
T.pack (String -> Text) -> (ColumnIndex -> String) -> ColumnIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> (ColumnIndex -> String) -> ColumnIndex -> 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)
-> (ColumnIndex -> [Int]) -> ColumnIndex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
forall {t}. Integral t => t -> [t]
base26 (Int -> [Int]) -> (ColumnIndex -> Int) -> ColumnIndex -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnIndex -> Int
unColumnIndex
    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 :: t -> [t]
base26  t
0 = []
        base26  t
i = let i' :: t
i' = (t
i t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
26)
                        i'' :: t
i'' = if t
i' t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then t
26 else t
i'
                    in t -> [t] -> [t]
forall a b. a -> b -> b
seq t
i' (t
i' t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
base26 ((t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
i'') t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
26))

rowIndexToText :: RowIndex -> Text
rowIndexToText :: RowIndex -> Text
rowIndexToText = String -> Text
T.pack (String -> Text) -> (RowIndex -> String) -> RowIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (RowIndex -> Int) -> RowIndex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex -> Int
unRowIndex

-- | reverse of 'columnIndexToText'
textToColumnIndex :: Text -> ColumnIndex
textToColumnIndex :: Text -> ColumnIndex
textToColumnIndex = Int -> ColumnIndex
ColumnIndex (Int -> ColumnIndex) -> (Text -> Int) -> Text -> ColumnIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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'

textToRowIndex :: Text -> RowIndex
textToRowIndex :: Text -> RowIndex
textToRowIndex = Int -> RowIndex
RowIndex (Int -> RowIndex) -> (Text -> Int) -> Text -> RowIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Excel cell or cell range reference (e.g. @E3@), possibly absolute.
-- See 18.18.62 @ST_Ref@ (p. 2482)
--
-- Note: The @ST_Ref@ type can point to another sheet (supported)
-- or a sheet in another workbook (separate .xlsx file, not implemented).
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
$c== :: CellRef -> CellRef -> Bool
== :: CellRef -> CellRef -> Bool
$c/= :: CellRef -> CellRef -> Bool
/= :: 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
$ccompare :: CellRef -> CellRef -> Ordering
compare :: CellRef -> CellRef -> Ordering
$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
>= :: CellRef -> CellRef -> Bool
$cmax :: CellRef -> CellRef -> CellRef
max :: CellRef -> CellRef -> CellRef
$cmin :: CellRef -> CellRef -> CellRef
min :: CellRef -> CellRef -> CellRef
Ord, Int -> CellRef -> ShowS
[CellRef] -> ShowS
CellRef -> String
(Int -> CellRef -> ShowS)
-> (CellRef -> String) -> ([CellRef] -> ShowS) -> Show CellRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellRef -> ShowS
showsPrec :: Int -> CellRef -> ShowS
$cshow :: CellRef -> String
show :: CellRef -> String
$cshowList :: [CellRef] -> ShowS
showList :: [CellRef] -> ShowS
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
$cfrom :: forall x. CellRef -> Rep CellRef x
from :: forall x. CellRef -> Rep CellRef x
$cto :: forall x. Rep CellRef x -> CellRef
to :: forall x. Rep CellRef x -> CellRef
Generic)
instance NFData CellRef

-- | A helper type for coordinates to carry the intent of them being relative or absolute (preceded by '$'):
--
-- > singleCellRefRaw' (RowRel 5, ColumnAbs 1) == "$A5"
data RowCoord
  = RowAbs !RowIndex
  | RowRel !RowIndex
  deriving (RowCoord -> RowCoord -> Bool
(RowCoord -> RowCoord -> Bool)
-> (RowCoord -> RowCoord -> Bool) -> Eq RowCoord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowCoord -> RowCoord -> Bool
== :: RowCoord -> RowCoord -> Bool
$c/= :: RowCoord -> RowCoord -> Bool
/= :: RowCoord -> RowCoord -> Bool
Eq, Eq RowCoord
Eq RowCoord =>
(RowCoord -> RowCoord -> Ordering)
-> (RowCoord -> RowCoord -> Bool)
-> (RowCoord -> RowCoord -> Bool)
-> (RowCoord -> RowCoord -> Bool)
-> (RowCoord -> RowCoord -> Bool)
-> (RowCoord -> RowCoord -> RowCoord)
-> (RowCoord -> RowCoord -> RowCoord)
-> Ord RowCoord
RowCoord -> RowCoord -> Bool
RowCoord -> RowCoord -> Ordering
RowCoord -> RowCoord -> RowCoord
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
$ccompare :: RowCoord -> RowCoord -> Ordering
compare :: RowCoord -> RowCoord -> Ordering
$c< :: RowCoord -> RowCoord -> Bool
< :: RowCoord -> RowCoord -> Bool
$c<= :: RowCoord -> RowCoord -> Bool
<= :: RowCoord -> RowCoord -> Bool
$c> :: RowCoord -> RowCoord -> Bool
> :: RowCoord -> RowCoord -> Bool
$c>= :: RowCoord -> RowCoord -> Bool
>= :: RowCoord -> RowCoord -> Bool
$cmax :: RowCoord -> RowCoord -> RowCoord
max :: RowCoord -> RowCoord -> RowCoord
$cmin :: RowCoord -> RowCoord -> RowCoord
min :: RowCoord -> RowCoord -> RowCoord
Ord, Int -> RowCoord -> ShowS
[RowCoord] -> ShowS
RowCoord -> String
(Int -> RowCoord -> ShowS)
-> (RowCoord -> String) -> ([RowCoord] -> ShowS) -> Show RowCoord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowCoord -> ShowS
showsPrec :: Int -> RowCoord -> ShowS
$cshow :: RowCoord -> String
show :: RowCoord -> String
$cshowList :: [RowCoord] -> ShowS
showList :: [RowCoord] -> ShowS
Show, ReadPrec [RowCoord]
ReadPrec RowCoord
Int -> ReadS RowCoord
ReadS [RowCoord]
(Int -> ReadS RowCoord)
-> ReadS [RowCoord]
-> ReadPrec RowCoord
-> ReadPrec [RowCoord]
-> Read RowCoord
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RowCoord
readsPrec :: Int -> ReadS RowCoord
$creadList :: ReadS [RowCoord]
readList :: ReadS [RowCoord]
$creadPrec :: ReadPrec RowCoord
readPrec :: ReadPrec RowCoord
$creadListPrec :: ReadPrec [RowCoord]
readListPrec :: ReadPrec [RowCoord]
Read, (forall x. RowCoord -> Rep RowCoord x)
-> (forall x. Rep RowCoord x -> RowCoord) -> Generic RowCoord
forall x. Rep RowCoord x -> RowCoord
forall x. RowCoord -> Rep RowCoord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RowCoord -> Rep RowCoord x
from :: forall x. RowCoord -> Rep RowCoord x
$cto :: forall x. Rep RowCoord x -> RowCoord
to :: forall x. Rep RowCoord x -> RowCoord
Generic)
instance NFData RowCoord

data ColumnCoord
  = ColumnAbs !ColumnIndex
  | ColumnRel !ColumnIndex
  deriving (ColumnCoord -> ColumnCoord -> Bool
(ColumnCoord -> ColumnCoord -> Bool)
-> (ColumnCoord -> ColumnCoord -> Bool) -> Eq ColumnCoord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnCoord -> ColumnCoord -> Bool
== :: ColumnCoord -> ColumnCoord -> Bool
$c/= :: ColumnCoord -> ColumnCoord -> Bool
/= :: ColumnCoord -> ColumnCoord -> Bool
Eq, Eq ColumnCoord
Eq ColumnCoord =>
(ColumnCoord -> ColumnCoord -> Ordering)
-> (ColumnCoord -> ColumnCoord -> Bool)
-> (ColumnCoord -> ColumnCoord -> Bool)
-> (ColumnCoord -> ColumnCoord -> Bool)
-> (ColumnCoord -> ColumnCoord -> Bool)
-> (ColumnCoord -> ColumnCoord -> ColumnCoord)
-> (ColumnCoord -> ColumnCoord -> ColumnCoord)
-> Ord ColumnCoord
ColumnCoord -> ColumnCoord -> Bool
ColumnCoord -> ColumnCoord -> Ordering
ColumnCoord -> ColumnCoord -> ColumnCoord
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
$ccompare :: ColumnCoord -> ColumnCoord -> Ordering
compare :: ColumnCoord -> ColumnCoord -> Ordering
$c< :: ColumnCoord -> ColumnCoord -> Bool
< :: ColumnCoord -> ColumnCoord -> Bool
$c<= :: ColumnCoord -> ColumnCoord -> Bool
<= :: ColumnCoord -> ColumnCoord -> Bool
$c> :: ColumnCoord -> ColumnCoord -> Bool
> :: ColumnCoord -> ColumnCoord -> Bool
$c>= :: ColumnCoord -> ColumnCoord -> Bool
>= :: ColumnCoord -> ColumnCoord -> Bool
$cmax :: ColumnCoord -> ColumnCoord -> ColumnCoord
max :: ColumnCoord -> ColumnCoord -> ColumnCoord
$cmin :: ColumnCoord -> ColumnCoord -> ColumnCoord
min :: ColumnCoord -> ColumnCoord -> ColumnCoord
Ord, Int -> ColumnCoord -> ShowS
[ColumnCoord] -> ShowS
ColumnCoord -> String
(Int -> ColumnCoord -> ShowS)
-> (ColumnCoord -> String)
-> ([ColumnCoord] -> ShowS)
-> Show ColumnCoord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnCoord -> ShowS
showsPrec :: Int -> ColumnCoord -> ShowS
$cshow :: ColumnCoord -> String
show :: ColumnCoord -> String
$cshowList :: [ColumnCoord] -> ShowS
showList :: [ColumnCoord] -> ShowS
Show, ReadPrec [ColumnCoord]
ReadPrec ColumnCoord
Int -> ReadS ColumnCoord
ReadS [ColumnCoord]
(Int -> ReadS ColumnCoord)
-> ReadS [ColumnCoord]
-> ReadPrec ColumnCoord
-> ReadPrec [ColumnCoord]
-> Read ColumnCoord
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ColumnCoord
readsPrec :: Int -> ReadS ColumnCoord
$creadList :: ReadS [ColumnCoord]
readList :: ReadS [ColumnCoord]
$creadPrec :: ReadPrec ColumnCoord
readPrec :: ReadPrec ColumnCoord
$creadListPrec :: ReadPrec [ColumnCoord]
readListPrec :: ReadPrec [ColumnCoord]
Read, (forall x. ColumnCoord -> Rep ColumnCoord x)
-> (forall x. Rep ColumnCoord x -> ColumnCoord)
-> Generic ColumnCoord
forall x. Rep ColumnCoord x -> ColumnCoord
forall x. ColumnCoord -> Rep ColumnCoord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnCoord -> Rep ColumnCoord x
from :: forall x. ColumnCoord -> Rep ColumnCoord x
$cto :: forall x. Rep ColumnCoord x -> ColumnCoord
to :: forall x. Rep ColumnCoord x -> ColumnCoord
Generic)
instance NFData ColumnCoord

type CellCoord = (RowCoord, ColumnCoord)

type RangeCoord = (CellCoord, CellCoord)

mkColumnCoord :: Bool -> ColumnIndex -> ColumnCoord
mkColumnCoord :: Bool -> ColumnIndex -> ColumnCoord
mkColumnCoord Bool
isAbs = if Bool
isAbs then ColumnIndex -> ColumnCoord
ColumnAbs else ColumnIndex -> ColumnCoord
ColumnRel

mkRowCoord :: Bool -> RowIndex -> RowCoord
mkRowCoord :: Bool -> RowIndex -> RowCoord
mkRowCoord Bool
isAbs = if Bool
isAbs then RowIndex -> RowCoord
RowAbs else RowIndex -> RowCoord
RowRel

coord2col :: ColumnCoord -> Text
coord2col :: ColumnCoord -> Text
coord2col (ColumnAbs ColumnIndex
c) = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnCoord -> Text
coord2col (ColumnIndex -> ColumnCoord
ColumnRel ColumnIndex
c)
coord2col (ColumnRel ColumnIndex
c) = ColumnIndex -> Text
columnIndexToText ColumnIndex
c

col2coord :: Text -> ColumnCoord
col2coord :: Text -> ColumnCoord
col2coord Text
t =
  let t' :: Maybe Text
t' = Text -> Text -> Maybe Text
T.stripPrefix Text
"$" Text
t
    in Bool -> ColumnIndex -> ColumnCoord
mkColumnCoord (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
t') (Text -> ColumnIndex
textToColumnIndex (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t Maybe Text
t'))

coord2row :: RowCoord -> Text
coord2row :: RowCoord -> Text
coord2row (RowAbs RowIndex
c) = Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RowCoord -> Text
coord2row (RowIndex -> RowCoord
RowRel RowIndex
c)
coord2row (RowRel RowIndex
c) = RowIndex -> Text
rowIndexToText RowIndex
c

row2coord :: Text -> RowCoord
row2coord :: Text -> RowCoord
row2coord Text
t =
  let t' :: Maybe Text
t' = Text -> Text -> Maybe Text
T.stripPrefix Text
"$" Text
t
    in Bool -> RowIndex -> RowCoord
mkRowCoord (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
t') (Text -> RowIndex
textToRowIndex (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t Maybe Text
t'))

-- | Unwrap a Coord into an abstract Int coordinate
unRowCoord :: RowCoord -> RowIndex
unRowCoord :: RowCoord -> RowIndex
unRowCoord (RowAbs RowIndex
i) = RowIndex
i
unRowCoord (RowRel RowIndex
i) = RowIndex
i

-- | Unwrap a Coord into an abstract Int coordinate
unColumnCoord :: ColumnCoord -> ColumnIndex
unColumnCoord :: ColumnCoord -> ColumnIndex
unColumnCoord (ColumnAbs ColumnIndex
i) = ColumnIndex
i
unColumnCoord (ColumnRel ColumnIndex
i) = ColumnIndex
i

-- | Helper function to apply the same transformation to both members of a tuple
--
-- > mapBoth Abs (1, 2) == (Abs 1, Abs 2s)
mapBoth :: (a -> b) -> (a, a) -> (b, b)
mapBoth :: forall a b. (a -> b) -> (a, a) -> (b, b)
mapBoth a -> b
f = (a -> b) -> (a -> b) -> (a, a) -> (b, b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f a -> b
f

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

-- | Allow specifying whether a coordinate parameter is relative or absolute.
--
-- > singleCellRef' (Rel 5, Abs 1) == CellRef "$A5"
singleCellRef' :: CellCoord -> CellRef
singleCellRef' :: CellCoord -> CellRef
singleCellRef' = Text -> CellRef
CellRef (Text -> CellRef) -> (CellCoord -> Text) -> CellCoord -> CellRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellCoord -> Text
singleCellRefRaw'

singleCellRefRaw :: (RowIndex, ColumnIndex) -> Text
singleCellRefRaw :: (RowIndex, ColumnIndex) -> Text
singleCellRefRaw (RowIndex
row, ColumnIndex
col) = [Text] -> Text
T.concat [ColumnIndex -> Text
columnIndexToText ColumnIndex
col, RowIndex -> Text
rowIndexToText RowIndex
row]

singleCellRefRaw' :: CellCoord -> Text
singleCellRefRaw' :: CellCoord -> Text
singleCellRefRaw' (RowCoord
row, ColumnCoord
col) =
    ColumnCoord -> Text
coord2col ColumnCoord
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RowCoord -> Text
coord2row RowCoord
row

-- | Converse function to 'singleCellRef'
-- Ignores a potential foreign sheet prefix.
fromSingleCellRef :: CellRef -> Maybe (RowIndex, ColumnIndex)
fromSingleCellRef :: CellRef -> Maybe (RowIndex, ColumnIndex)
fromSingleCellRef = Text -> Maybe (RowIndex, ColumnIndex)
fromSingleCellRefRaw (Text -> Maybe (RowIndex, ColumnIndex))
-> (CellRef -> Text) -> CellRef -> Maybe (RowIndex, ColumnIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Text
unCellRef

-- | Converse function to 'singleCellRef\''
-- Ignores a potential foreign sheet prefix.
fromSingleCellRef' :: CellRef -> Maybe CellCoord
fromSingleCellRef' :: CellRef -> Maybe CellCoord
fromSingleCellRef' = Text -> Maybe CellCoord
fromSingleCellRefRaw' (Text -> Maybe CellCoord)
-> (CellRef -> Text) -> CellRef -> Maybe CellCoord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Text
unCellRef

fromSingleCellRefRaw :: Text -> Maybe (RowIndex, ColumnIndex)
fromSingleCellRefRaw :: Text -> Maybe (RowIndex, ColumnIndex)
fromSingleCellRefRaw =
  (CellCoord -> (RowIndex, ColumnIndex))
-> Maybe CellCoord -> Maybe (RowIndex, ColumnIndex)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RowCoord -> RowIndex)
-> (RowCoord, ColumnIndex) -> (RowIndex, ColumnIndex)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first RowCoord -> RowIndex
unRowCoord ((RowCoord, ColumnIndex) -> (RowIndex, ColumnIndex))
-> (CellCoord -> (RowCoord, ColumnIndex))
-> CellCoord
-> (RowIndex, ColumnIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnCoord -> ColumnIndex)
-> CellCoord -> (RowCoord, ColumnIndex)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ColumnCoord -> ColumnIndex
unColumnCoord) (Maybe CellCoord -> Maybe (RowIndex, ColumnIndex))
-> (Text -> Maybe CellCoord)
-> Text
-> Maybe (RowIndex, ColumnIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe CellCoord
fromSingleCellRefRaw'

fromSingleCellRefRaw' :: Text -> Maybe CellCoord
fromSingleCellRefRaw' :: Text -> Maybe CellCoord
fromSingleCellRefRaw' Text
t' = Text -> Maybe Text
ignoreRefSheetName Text
t' Maybe Text -> (Text -> Maybe CellCoord) -> Maybe CellCoord
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t -> do
    let (Bool
isColAbsolute, Text
remT) =
          Text -> Text -> Maybe Text
T.stripPrefix Text
"$" Text
t
          Maybe Text -> (Maybe Text -> (Bool, Text)) -> (Bool, Text)
forall a b. a -> (a -> b) -> b
& \Maybe Text
remT' -> (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
remT', Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t Maybe Text
remT')
    let (Text
colT, Text
rowExpr) = (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
remT
    let (Bool
isRowAbsolute, Text
rowT) =
          Text -> Text -> Maybe Text
T.stripPrefix Text
"$" Text
rowExpr
          Maybe Text -> (Maybe Text -> (Bool, Text)) -> (Bool, Text)
forall a b. a -> (a -> b) -> b
& \Maybe Text
rowT' -> (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
rowT', Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
rowExpr Maybe Text
rowT')
    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
    RowIndex
row <- Text -> Maybe RowIndex
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal Text
rowT
    CellCoord -> Maybe CellCoord
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CellCoord -> Maybe CellCoord) -> CellCoord -> Maybe CellCoord
forall a b. (a -> b) -> a -> b
$
      (RowIndex -> RowCoord)
-> (ColumnIndex -> ColumnCoord)
-> (RowIndex, ColumnIndex)
-> CellCoord
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (Bool -> RowIndex -> RowCoord
mkRowCoord Bool
isRowAbsolute)
      (Bool -> ColumnIndex -> ColumnCoord
mkColumnCoord Bool
isColAbsolute)
      (RowIndex
row, Text -> ColumnIndex
textToColumnIndex Text
colT)

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

-- | Frame and escape the referenced sheet name in single quotes (apostrophe).
--
-- Sheet name in ST_Ref can be single-quoted when it contains non-alphanum class, non-ASCII range characters.
-- Intermediate squote characters are escaped in a doubled fashion:
-- "My ' Sheet" -> 'My '' Sheet'
escapeRefSheetName :: Text -> Text
escapeRefSheetName :: Text -> Text
escapeRefSheetName Text
sheetName =
   [Text] -> Text
T.concat [Text
"'", Text -> Text
escape Text
sheetName, Text
"'"]
  where
    escape :: Text -> Text
escape Text
sn = Partial => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"'" Text
sn [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"''"

-- | Unframe and unescape the referenced sheet name.
unEscapeRefSheetName :: Text -> Text
unEscapeRefSheetName :: Text -> Text
unEscapeRefSheetName = Text -> Text
unescape (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unFrame
      where
        unescape :: Text -> Text
unescape  = Text -> [Text] -> Text
T.intercalate Text
"'" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partial => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"''"
        unFrame :: Text -> Text
unFrame Text
sn = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
sn (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"'" Text
sn Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripSuffix Text
"'"

ignoreRefSheetName :: Text -> Maybe Text
ignoreRefSheetName :: Text -> Maybe Text
ignoreRefSheetName Text
t =
  case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') Text
t of
    [Text
_, Text
r] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
r
    [Text
r] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
r
    [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | Render a single cell existing in another worksheet.
-- This function always renders the sheet name single-quoted regardless the presence of spaces.
-- A sheet name shouldn't contain @"[]*:?/\"@ chars and apostrophe @"'"@ should not happen at extremities.
--
-- > mkForeignRange "MyOtherSheet" (Rel 2, Rel 4) (Abs 6, Abs 8) == "'MyOtherSheet'!D2:$H$6"
mkForeignSingleCellRef :: Text -> CellCoord -> CellRef
mkForeignSingleCellRef :: Text -> CellCoord -> CellRef
mkForeignSingleCellRef Text
sheetName CellCoord
coord =
    let cr :: Text
cr = CellCoord -> Text
singleCellRefRaw' CellCoord
coord
      in Text -> CellRef
CellRef (Text -> CellRef) -> Text -> CellRef
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text -> Text
escapeRefSheetName Text
sheetName, Text
"!", Text
cr]

-- | Converse function to 'mkForeignSingleCellRef'.
-- The provided CellRef must be a foreign range.
fromForeignSingleCellRef :: CellRef -> Maybe (Text, CellCoord)
fromForeignSingleCellRef :: CellRef -> Maybe (Text, CellCoord)
fromForeignSingleCellRef 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
sheetName, Text
ref] -> (Text -> Text
unEscapeRefSheetName Text
sheetName,) (CellCoord -> (Text, CellCoord))
-> Maybe CellCoord -> Maybe (Text, CellCoord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe CellCoord
fromSingleCellRefRaw' Text
ref
      [Text]
_ -> Maybe (Text, CellCoord)
forall a. Maybe a
Nothing

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

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

-- | Render range with possibly absolute coordinates
--
-- > mkRange' (Abs 2, Abs 4) (6, 8) == CellRef "$D$2:H6"
mkRange' :: (RowCoord,ColumnCoord) -> (RowCoord,ColumnCoord) -> Range
mkRange' :: CellCoord -> CellCoord -> CellRef
mkRange' CellCoord
fr CellCoord
to =
  Text -> CellRef
CellRef (Text -> CellRef) -> Text -> CellRef
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [CellCoord -> Text
singleCellRefRaw' CellCoord
fr, Text
":", CellCoord -> Text
singleCellRefRaw' CellCoord
to]

-- | Render a cell range existing in another worksheet.
-- This function always renders the sheet name single-quoted regardless the presence of spaces.
-- A sheet name shouldn't contain @"[]*:?/\"@ chars and apostrophe @"'"@ should not happen at extremities.
--
-- > mkForeignRange "MyOtherSheet" (Rel 2, Rel 4) (Abs 6, Abs 8) == "'MyOtherSheet'!D2:$H$6"
mkForeignRange :: Text -> CellCoord -> CellCoord -> Range
mkForeignRange :: Text -> CellCoord -> CellCoord -> CellRef
mkForeignRange Text
sheetName CellCoord
fr CellCoord
to =
    case CellCoord -> CellCoord -> CellRef
mkRange' CellCoord
fr CellCoord
to of
      CellRef Text
cr -> Text -> CellRef
CellRef (Text -> CellRef) -> Text -> CellRef
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text -> Text
escapeRefSheetName Text
sheetName, Text
"!", Text
cr]

-- | Converse function to 'mkRange' ignoring absolute coordinates.
-- Ignores a potential foreign sheet prefix.
fromRange :: Range -> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex))
fromRange :: CellRef -> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex))
fromRange CellRef
r =
  (CellCoord -> (RowIndex, ColumnIndex))
-> (CellCoord, CellCoord)
-> ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex))
forall a b. (a -> b) -> (a, a) -> (b, b)
mapBoth ((RowCoord -> RowIndex)
-> (RowCoord, ColumnIndex) -> (RowIndex, ColumnIndex)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first RowCoord -> RowIndex
unRowCoord ((RowCoord, ColumnIndex) -> (RowIndex, ColumnIndex))
-> (CellCoord -> (RowCoord, ColumnIndex))
-> CellCoord
-> (RowIndex, ColumnIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnCoord -> ColumnIndex)
-> CellCoord -> (RowCoord, ColumnIndex)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ColumnCoord -> ColumnIndex
unColumnCoord) ((CellCoord, CellCoord)
 -> ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex)))
-> Maybe (CellCoord, CellCoord)
-> Maybe ((RowIndex, ColumnIndex), (RowIndex, ColumnIndex))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellRef -> Maybe (CellCoord, CellCoord)
fromRange' CellRef
r

-- | Converse function to 'mkRange\'' to handle possibly absolute coordinates.
-- Ignores a potential foreign sheet prefix.
fromRange' :: Range -> Maybe RangeCoord
fromRange' :: CellRef -> Maybe (CellCoord, CellCoord)
fromRange' CellRef
t' = Text -> Maybe (CellCoord, CellCoord)
parseRange (Text -> Maybe (CellCoord, CellCoord))
-> Maybe Text -> Maybe (CellCoord, CellCoord)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Text
ignoreRefSheetName (CellRef -> Text
unCellRef CellRef
t')
  where
    parseRange :: Text -> Maybe (CellCoord, CellCoord)
parseRange Text
t =
      case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t of
        [Text
from, Text
to] -> (CellCoord -> CellCoord -> (CellCoord, CellCoord))
-> Maybe CellCoord
-> Maybe CellCoord
-> Maybe (CellCoord, CellCoord)
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Text -> Maybe CellCoord
fromSingleCellRefRaw' Text
from) (Text -> Maybe CellCoord
fromSingleCellRefRaw' Text
to)
        [Text]
_ -> Maybe (CellCoord, CellCoord)
forall a. Maybe a
Nothing

-- | Converse function to 'mkForeignRange'.
-- The provided Range must be a foreign range.
fromForeignRange :: Range -> Maybe (Text, RangeCoord)
fromForeignRange :: CellRef -> Maybe (Text, (CellCoord, CellCoord))
fromForeignRange 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
sheetName, Text
ref] -> (Text -> Text
unEscapeRefSheetName Text
sheetName,) ((CellCoord, CellCoord) -> (Text, (CellCoord, CellCoord)))
-> Maybe (CellCoord, CellCoord)
-> Maybe (Text, (CellCoord, CellCoord))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellRef -> Maybe (CellCoord, CellCoord)
fromRange' (Text -> CellRef
CellRef Text
ref)
      [Text]
_ -> Maybe (Text, (CellCoord, CellCoord))
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
$c== :: SqRef -> SqRef -> Bool
== :: SqRef -> SqRef -> Bool
$c/= :: SqRef -> SqRef -> Bool
/= :: 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
$ccompare :: SqRef -> SqRef -> Ordering
compare :: SqRef -> SqRef -> Ordering
$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
>= :: SqRef -> SqRef -> Bool
$cmax :: SqRef -> SqRef -> SqRef
max :: SqRef -> SqRef -> SqRef
$cmin :: SqRef -> SqRef -> SqRef
min :: SqRef -> SqRef -> SqRef
Ord, Int -> SqRef -> ShowS
[SqRef] -> ShowS
SqRef -> String
(Int -> SqRef -> ShowS)
-> (SqRef -> String) -> ([SqRef] -> ShowS) -> Show SqRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqRef -> ShowS
showsPrec :: Int -> SqRef -> ShowS
$cshow :: SqRef -> String
show :: SqRef -> String
$cshowList :: [SqRef] -> ShowS
showList :: [SqRef] -> ShowS
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
$cfrom :: forall x. SqRef -> Rep SqRef x
from :: forall x. SqRef -> Rep SqRef x
$cto :: forall x. Rep SqRef x -> SqRef
to :: forall x. Rep SqRef x -> SqRef
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
$c== :: XlsxText -> XlsxText -> Bool
== :: XlsxText -> XlsxText -> Bool
$c/= :: XlsxText -> XlsxText -> Bool
/= :: 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
$ccompare :: XlsxText -> XlsxText -> Ordering
compare :: XlsxText -> XlsxText -> Ordering
$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
>= :: XlsxText -> XlsxText -> Bool
$cmax :: XlsxText -> XlsxText -> XlsxText
max :: XlsxText -> XlsxText -> XlsxText
$cmin :: XlsxText -> XlsxText -> XlsxText
min :: XlsxText -> XlsxText -> XlsxText
Ord, Int -> XlsxText -> ShowS
[XlsxText] -> ShowS
XlsxText -> String
(Int -> XlsxText -> ShowS)
-> (XlsxText -> String) -> ([XlsxText] -> ShowS) -> Show XlsxText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XlsxText -> ShowS
showsPrec :: Int -> XlsxText -> ShowS
$cshow :: XlsxText -> String
show :: XlsxText -> String
$cshowList :: [XlsxText] -> ShowS
showList :: [XlsxText] -> ShowS
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
$cfrom :: forall x. XlsxText -> Rep XlsxText x
from :: forall x. XlsxText -> Rep XlsxText x
$cto :: forall x. Rep XlsxText x -> XlsxText
to :: forall x. Rep XlsxText x -> XlsxText
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
$c== :: Formula -> Formula -> Bool
== :: Formula -> Formula -> Bool
$c/= :: Formula -> Formula -> Bool
/= :: 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
$ccompare :: Formula -> Formula -> Ordering
compare :: Formula -> Formula -> Ordering
$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
>= :: Formula -> Formula -> Bool
$cmax :: Formula -> Formula -> Formula
max :: Formula -> Formula -> Formula
$cmin :: Formula -> Formula -> Formula
min :: Formula -> Formula -> Formula
Ord, Int -> Formula -> ShowS
[Formula] -> ShowS
Formula -> String
(Int -> Formula -> ShowS)
-> (Formula -> String) -> ([Formula] -> ShowS) -> Show Formula
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Formula -> ShowS
showsPrec :: Int -> Formula -> ShowS
$cshow :: Formula -> String
show :: Formula -> String
$cshowList :: [Formula] -> ShowS
showList :: [Formula] -> ShowS
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
$cfrom :: forall x. Formula -> Rep Formula x
from :: forall x. Formula -> Rep Formula x
$cto :: forall x. Rep Formula x -> Formula
to :: forall x. Rep Formula x -> Formula
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
-- Specification (ECMA-376):
-- - 18.3.1.4 c (Cell)
-- - 18.18.11 ST_CellType (Cell Type)
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
$c== :: CellValue -> CellValue -> Bool
== :: CellValue -> CellValue -> Bool
$c/= :: CellValue -> CellValue -> Bool
/= :: 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
$ccompare :: CellValue -> CellValue -> Ordering
compare :: CellValue -> CellValue -> Ordering
$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
>= :: CellValue -> CellValue -> Bool
$cmax :: CellValue -> CellValue -> CellValue
max :: CellValue -> CellValue -> CellValue
$cmin :: CellValue -> CellValue -> CellValue
min :: CellValue -> CellValue -> CellValue
Ord, Int -> CellValue -> ShowS
[CellValue] -> ShowS
CellValue -> String
(Int -> CellValue -> ShowS)
-> (CellValue -> String)
-> ([CellValue] -> ShowS)
-> Show CellValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellValue -> ShowS
showsPrec :: Int -> CellValue -> ShowS
$cshow :: CellValue -> String
show :: CellValue -> String
$cshowList :: [CellValue] -> ShowS
showList :: [CellValue] -> ShowS
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
$cfrom :: forall x. CellValue -> Rep CellValue x
from :: forall x. CellValue -> Rep CellValue x
$cto :: forall x. Rep CellValue x -> CellValue
to :: forall x. Rep CellValue x -> CellValue
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
$c== :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
/= :: 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
$ccompare :: ErrorType -> ErrorType -> Ordering
compare :: ErrorType -> ErrorType -> Ordering
$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
>= :: ErrorType -> ErrorType -> Bool
$cmax :: ErrorType -> ErrorType -> ErrorType
max :: ErrorType -> ErrorType -> ErrorType
$cmin :: ErrorType -> ErrorType -> ErrorType
min :: ErrorType -> ErrorType -> ErrorType
Ord, Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
(Int -> ErrorType -> ShowS)
-> (ErrorType -> String)
-> ([ErrorType] -> ShowS)
-> Show ErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorType -> ShowS
showsPrec :: Int -> ErrorType -> ShowS
$cshow :: ErrorType -> String
show :: ErrorType -> String
$cshowList :: [ErrorType] -> ShowS
showList :: [ErrorType] -> ShowS
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
$cfrom :: forall x. ErrorType -> Rep ErrorType x
from :: forall x. ErrorType -> Rep ErrorType x
$cto :: forall x. Rep ErrorType x -> ErrorType
to :: forall x. Rep ErrorType x -> ErrorType
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
$c== :: DateBase -> DateBase -> Bool
== :: DateBase -> DateBase -> Bool
$c/= :: DateBase -> DateBase -> Bool
/= :: DateBase -> DateBase -> Bool
Eq, Int -> DateBase -> ShowS
[DateBase] -> ShowS
DateBase -> String
(Int -> DateBase -> ShowS)
-> (DateBase -> String) -> ([DateBase] -> ShowS) -> Show DateBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateBase -> ShowS
showsPrec :: Int -> DateBase -> ShowS
$cshow :: DateBase -> String
show :: DateBase -> String
$cshowList :: [DateBase] -> ShowS
showList :: [DateBase] -> ShowS
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
$cfrom :: forall x. DateBase -> Rep DateBase x
from :: forall x. DateBase -> Rep DateBase x
$cto :: forall x. Rep DateBase x -> DateBase
to :: forall x. Rep DateBase x -> DateBase
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

-- | Converts serial value into datetime according to the specified
-- date base. Because Excel treats 1900 as a leap year even though it isn't,
-- this function converts any numbers that represent some time in /1900-02-29/
-- in Excel to `UTCTime` /1900-03-01 00:00/.
-- See https://docs.microsoft.com/en-gb/office/troubleshoot/excel/wrongly-assumes-1900-is-leap-year for details.
--
-- > show (dateFromNumber DateBase1900 42929.75) == "2017-07-13 18:00:00 UTC"
-- > show (dateFromNumber DateBase1900 60) == "1900-03-01 00:00:00 UTC"
-- > show (dateFromNumber DateBase1900 61) == "1900-03-01 00:00:00 UTC"
dateFromNumber :: forall t. RealFrac t => DateBase -> t -> UTCTime
dateFromNumber :: forall t. RealFrac t => DateBase -> t -> UTCTime
dateFromNumber DateBase
b t
d
  -- 60 is Excel's 2020-02-29 00:00 and 61 is Excel's 2020-03-01
  | DateBase
b DateBase -> DateBase -> Bool
forall a. Eq a => a -> a -> Bool
== DateBase
DateBase1900 Bool -> Bool -> Bool
&& t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
60            = t -> UTCTime
forall {p}. RealFrac p => p -> UTCTime
getUTCTime (t
d t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
  | DateBase
b DateBase -> DateBase -> Bool
forall a. Eq a => a -> a -> Bool
== DateBase
DateBase1900 Bool -> Bool -> Bool
&& t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
60 Bool -> Bool -> Bool
&& t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
61 = t -> UTCTime
forall {p}. RealFrac p => p -> UTCTime
getUTCTime (t
61 :: t)
  | Bool
otherwise                              = t -> UTCTime
forall {p}. RealFrac p => p -> UTCTime
getUTCTime t
d
  where
    getUTCTime :: p -> UTCTime
getUTCTime p
n =
      let
        (Integer
numberOfDays, p
fractionOfOneDay) = p -> (Integer, p)
forall b. Integral b => p -> (b, p)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction p
n
        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 (p -> Integer
forall b. Integral b => p -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (p
fractionOfOneDay p -> p -> p
forall a. Num a => a -> a -> a
* p
24p -> p -> p
forall a. Num a => a -> a -> a
*p
60p -> p -> p
forall a. Num a => a -> a -> a
*p
60p -> p -> p
forall a. Num a => a -> a -> a
*p
1E12))
      in
        Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
diffTime

-- | Converts datetime into serial value.
-- Because Excel treats 1900 as a leap year even though it isn't,
-- the numbers that represent times in /1900-02-29/ in Excel, in the range /[60, 61[/,
-- are never generated by this function for `DateBase1900`. This means that
-- under those conditions this is not an inverse of `dateFromNumber`.
-- See https://docs.microsoft.com/en-gb/office/troubleshoot/excel/wrongly-assumes-1900-is-leap-year for details.
dateToNumber :: Fractional a => DateBase -> UTCTime -> a
dateToNumber :: forall a. Fractional a => 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
excel1900CorrectedDay (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)
    marchFirst1900 :: Day
marchFirst1900              = Integer -> Int -> Int -> Day
fromGregorian Integer
1900 Int
3 Int
1
    excel1900CorrectedDay :: Day
excel1900CorrectedDay = if Day
day Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
marchFirst1900
      then Integer -> Day -> Day
addDays (-Integer
1) Day
day
      else Day
day

{-------------------------------------------------------------------------------
  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 a. a -> [a]
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 a. a -> [a]
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 a. String -> [a]
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 a b.
ChildCollector (a -> b) -> ChildCollector a -> ChildCollector b
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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Node -> Either Text Text
contentX Maybe Node
mCh
    case Maybe Text
mT of
      Just Text
t -> XlsxText -> Either Text XlsxText
forall a. a -> Either Text a
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 a. a -> Either Text a
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 a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> CellRef) -> (Text, Text) -> (CellRef, Text)
forall b c d. (b -> c) -> (b, d) -> (c, d)
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 a. a -> Either Text a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((CellRef, Text) -> CellRef)
-> Either String (CellRef, Text) -> Either String CellRef
forall a b. (a -> b) -> Either String a -> Either String b
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 a. a -> Either Text a
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 a b. (a -> b) -> Either Text a -> Either Text b
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 a b. (a -> b) -> Either Text a -> Either Text b
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 a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorDiv0
  fromAttrBs ByteString
"#N/A" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNA
  fromAttrBs ByteString
"#NAME?" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorName
  fromAttrBs ByteString
"#NULL!" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNull
  fromAttrBs ByteString
"#NUM!" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorNum
  fromAttrBs ByteString
"#REF!" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
ErrorRef
  fromAttrBs ByteString
"#VALUE!" = ErrorType -> Either Text ErrorType
forall a. a -> Either Text a
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 {
      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!"

#ifdef USE_MICROLENS
-- Since micro-lens denies the existence of prisms,
-- I pasted the splice that's generated from makePrisms,
-- then I copied over the definitions from Control.Lens for the prism
-- function as well.
-- Essentially this is doing the template haskell by hand.
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type Prism' s a = Prism s s a a

prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism bt seta = dimap seta (either pure (fmap bt)) . right'

_CellText :: Prism' CellValue Text
_CellText
  = (prism (\ x1_a1ZQv -> CellText x1_a1ZQv))
      (\ x_a1ZQw
         -> case x_a1ZQw of
              CellText y1_a1ZQx -> Right y1_a1ZQx
              _ -> Left x_a1ZQw)
{-# INLINE _CellText #-}
_CellDouble :: Prism' CellValue Double
_CellDouble
  = (prism (\ x1_a1ZQy -> CellDouble x1_a1ZQy))
      (\ x_a1ZQz
         -> case x_a1ZQz of
              CellDouble y1_a1ZQA -> Right y1_a1ZQA
              _ -> Left x_a1ZQz)
{-# INLINE _CellDouble #-}
_CellBool :: Prism' CellValue Bool
_CellBool
  = (prism (\ x1_a1ZQB -> CellBool x1_a1ZQB))
      (\ x_a1ZQC
         -> case x_a1ZQC of
              CellBool y1_a1ZQD -> Right y1_a1ZQD
              _ -> Left x_a1ZQC)
{-# INLINE _CellBool #-}
_CellRich :: Prism' CellValue [RichTextRun]
_CellRich
  = (prism (\ x1_a1ZQE -> CellRich x1_a1ZQE))
      (\ x_a1ZQF
         -> case x_a1ZQF of
              CellRich y1_a1ZQG -> Right y1_a1ZQG
              _ -> Left x_a1ZQF)
{-# INLINE _CellRich #-}
_CellError :: Prism' CellValue ErrorType
_CellError
  = (prism (\ x1_a1ZQH -> CellError x1_a1ZQH))
      (\ x_a1ZQI
         -> case x_a1ZQI of
              CellError y1_a1ZQJ -> Right y1_a1ZQJ
              _ -> Left x_a1ZQI)
{-# INLINE _CellError #-}

_XlsxText :: Prism' XlsxText Text
_XlsxText
  = (prism (\ x1_a1ZzU -> XlsxText x1_a1ZzU))
      (\ x_a1ZzV
         -> case x_a1ZzV of
              XlsxText y1_a1ZzW -> Right y1_a1ZzW
              _ -> Left x_a1ZzV)
{-# INLINE _XlsxText #-}
_XlsxRichText :: Prism' XlsxText [RichTextRun]
_XlsxRichText
  = (prism (\ x1_a1ZzX -> XlsxRichText x1_a1ZzX))
      (\ x_a1ZzY
         -> case x_a1ZzY of
              XlsxRichText y1_a1ZzZ -> Right y1_a1ZzZ
              _ -> Left x_a1ZzY)
{-# INLINE _XlsxRichText #-}

#else
makePrisms ''XlsxText
makePrisms ''CellValue
#endif