{-# 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
int2col :: Int -> Text
int2col = T.pack . reverse . map int2let . base26
where
int2let 0 = 'Z'
int2let x = chr $ (x - 1) + ord 'A'
base26 0 = []
base26 i = let i' = (i `mod` 26)
i'' = if i' == 0 then 26 else i'
in seq i' (i' : base26 ((i - i'') `div` 26))
col2int :: Text -> Int
col2int = T.foldl' (\i c -> i * 26 + let2int c) 0
where
let2int c = 1 + ord c - ord 'A'
newtype CellRef = CellRef
{ unCellRef :: Text
} deriving (Eq, Ord, Show, Generic)
instance NFData CellRef
singleCellRef :: (Int, Int) -> CellRef
singleCellRef = CellRef . singleCellRefRaw
singleCellRefRaw :: (Int, Int) -> Text
singleCellRefRaw (row, col) = T.concat [int2col col, T.pack (show row)]
fromSingleCellRef :: CellRef -> Maybe (Int, Int)
fromSingleCellRef = fromSingleCellRefRaw . unCellRef
fromSingleCellRefRaw :: Text -> Maybe (Int, Int)
fromSingleCellRefRaw t = do
let (colT, rowT) = T.span (inRange ('A', 'Z')) t
guard $ not (T.null colT) && not (T.null rowT) && T.all isDigit rowT
row <- decimal rowT
return (row, col2int colT)
fromSingleCellRefNoting :: CellRef -> (Int, Int)
fromSingleCellRefNoting ref = fromJustNote errMsg $ fromSingleCellRefRaw txt
where
txt = unCellRef ref
errMsg = "Bad cell reference '" ++ T.unpack txt ++ "'"
type Range = CellRef
mkRange :: (Int, Int) -> (Int, Int) -> Range
mkRange fr to = CellRef $ T.concat [singleCellRefRaw fr, T.pack ":", singleCellRefRaw to]
fromRange :: Range -> Maybe ((Int, Int), (Int, Int))
fromRange r =
case T.split (== ':') (unCellRef r) of
[from, to] -> (,) <$> fromSingleCellRefRaw from <*> fromSingleCellRefRaw to
_ -> Nothing
newtype SqRef = SqRef [CellRef]
deriving (Eq, Ord, Show, Generic)
instance NFData SqRef
data XlsxText = XlsxText Text
| XlsxRichText [RichTextRun]
deriving (Eq, Ord, Show, Generic)
instance NFData XlsxText
xlsxTextToCellValue :: XlsxText -> CellValue
xlsxTextToCellValue (XlsxText txt) = CellText txt
xlsxTextToCellValue (XlsxRichText rich) = CellRich rich
newtype Formula = Formula {unFormula :: Text}
deriving (Eq, Ord, Show, Generic)
instance NFData Formula
data CellValue
= CellText Text
| CellDouble Double
| CellBool Bool
| CellRich [RichTextRun]
| CellError ErrorType
deriving (Eq, Ord, Show, Generic)
instance NFData CellValue
data ErrorType
= ErrorDiv0
| ErrorNA
| ErrorName
| ErrorNull
| ErrorNum
| ErrorRef
| ErrorValue
deriving (Eq, Ord, Show, Generic)
instance NFData ErrorType
data DateBase
= DateBase1900
| DateBase1904
deriving (Eq, Show, Generic)
instance NFData DateBase
baseDate :: DateBase -> Day
baseDate DateBase1900 = fromGregorian 1899 12 30
baseDate DateBase1904 = fromGregorian 1904 1 1
dateFromNumber :: RealFrac t => DateBase -> t -> UTCTime
dateFromNumber b d = UTCTime day diffTime
where
(numberOfDays, fractionOfOneDay) = properFraction d
day = addDays numberOfDays $ baseDate b
diffTime = picosecondsToDiffTime (round (fractionOfOneDay * 24*60*60*1E12))
dateToNumber :: Fractional a => DateBase -> UTCTime -> a
dateToNumber b (UTCTime day diffTime) = numberOfDays + fractionOfOneDay
where
numberOfDays = fromIntegral (diffDays day $ baseDate b)
fractionOfOneDay = realToFrac diffTime / (24 * 60 * 60)
instance FromCursor XlsxText where
fromCursor cur = do
let
ts = cur $/ element (n_ "t") >=> contentOrEmpty
rs = cur $/ element (n_ "r") >=> fromCursor
case (ts,rs) of
([t], []) ->
return $ XlsxText t
([], _:_) ->
return $ XlsxRichText rs
_ ->
fail "invalid item"
instance FromXenoNode XlsxText where
fromXenoNode root = do
(mCh, rs) <-
collectChildren root $ (,) <$> maybeChild "t" <*> fromChildList "r"
mT <- mapM contentX mCh
case mT of
Just t -> return $ XlsxText t
Nothing ->
case rs of
[] -> Left $ "missing rich text subelements"
_ -> return $ XlsxRichText rs
instance FromAttrVal CellRef where
fromAttrVal = fmap (first CellRef) . fromAttrVal
instance FromAttrBs CellRef where
fromAttrBs = pure . CellRef . T.decodeLatin1
instance FromAttrVal SqRef where
fromAttrVal t = do
rs <- mapM (fmap fst . fromAttrVal) $ T.split (== ' ') t
readSuccess $ SqRef rs
instance FromAttrBs SqRef where
fromAttrBs bs = do
rs <- forM (BS.split 32 bs) fromAttrBs
return $ SqRef rs
instance FromCursor Formula where
fromCursor cur = [Formula . T.concat $ cur $/ content]
instance FromXenoNode Formula where
fromXenoNode = fmap Formula . contentX
instance FromAttrVal Formula where
fromAttrVal t = readSuccess $ Formula t
instance FromAttrBs Formula where
fromAttrBs = fmap Formula . fromAttrBs
instance FromAttrVal ErrorType where
fromAttrVal "#DIV/0!" = readSuccess ErrorDiv0
fromAttrVal "#N/A" = readSuccess ErrorNA
fromAttrVal "#NAME?" = readSuccess ErrorName
fromAttrVal "#NULL!" = readSuccess ErrorNull
fromAttrVal "#NUM!" = readSuccess ErrorNum
fromAttrVal "#REF!" = readSuccess ErrorRef
fromAttrVal "#VALUE!" = readSuccess ErrorValue
fromAttrVal t = invalidText "ErrorType" t
instance FromAttrBs ErrorType where
fromAttrBs "#DIV/0!" = return ErrorDiv0
fromAttrBs "#N/A" = return ErrorNA
fromAttrBs "#NAME?" = return ErrorName
fromAttrBs "#NULL!" = return ErrorNull
fromAttrBs "#NUM!" = return ErrorNum
fromAttrBs "#REF!" = return ErrorRef
fromAttrBs "#VALUE!" = return ErrorValue
fromAttrBs x = unexpectedAttrBs "ErrorType" x
instance ToElement XlsxText where
toElement nm si = Element {
elementName = nm
, elementAttributes = Map.empty
, elementNodes = map NodeElement $
case si of
XlsxText text -> [elementContent "t" text]
XlsxRichText rich -> map (toElement "r") rich
}
instance ToAttrVal CellRef where
toAttrVal = toAttrVal . unCellRef
instance ToAttrVal SqRef where
toAttrVal (SqRef refs) = T.intercalate " " $ map toAttrVal refs
instance ToElement Formula where
toElement nm (Formula txt) = elementContent nm txt
instance ToAttrVal ErrorType where
toAttrVal ErrorDiv0 = "#DIV/0!"
toAttrVal ErrorNA = "#N/A"
toAttrVal ErrorName = "#NAME?"
toAttrVal ErrorNull = "#NULL!"
toAttrVal ErrorNum = "#NUM!"
toAttrVal ErrorRef = "#REF!"
toAttrVal ErrorValue = "#VALUE!"