module Codec.Xlsx.Types (
Xlsx(..)
, Styles(..)
, DefinedNames(..)
, ColumnsWidth(..)
, PageSetup(..)
, Worksheet(..)
, CellMap
, CellValue(..)
, Cell(..)
, RowProperties (..)
, Range
, xlSheets
, xlStyles
, xlDefinedNames
, xlCustomProperties
, wsColumns
, wsRowPropertiesMap
, wsCells
, wsMerges
, wsSheetViews
, wsPageSetup
, wsConditionalFormattings
, cellValue
, cellStyle
, cellComment
, emptyStyles
, renderStyleSheet
, parseStyleSheet
, def
, int2col
, col2int
, mkCellRef
, mkRange
, toRows
, fromRows
, module X
) where
import Control.Exception (SomeException, toException)
import Control.Lens.TH
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.Default
import Data.Function (on)
import Data.List (groupBy)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.XML (renderLBS, parseLBS)
import Text.XML.Cursor
import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Comment as X
import Codec.Xlsx.Types.Common as X
import Codec.Xlsx.Types.ConditionalFormatting as X
import Codec.Xlsx.Types.PageSetup as X
import Codec.Xlsx.Types.RichText as X
import Codec.Xlsx.Types.SheetViews as X
import Codec.Xlsx.Types.StyleSheet as X
import Codec.Xlsx.Types.Variant as X
import Codec.Xlsx.Writer.Internal
data CellValue = CellText Text
| CellDouble Double
| CellBool Bool
| CellRich [RichTextRun]
deriving (Eq, Show)
data Cell = Cell
{ _cellStyle :: Maybe Int
, _cellValue :: Maybe CellValue
, _cellComment :: Maybe Comment
} deriving (Eq, Show)
makeLenses ''Cell
instance Default Cell where
def = Cell Nothing Nothing Nothing
type CellMap = Map (Int, Int) Cell
data RowProperties = RowProps { rowHeight :: Maybe Double, rowStyle::Maybe Int}
deriving (Read,Eq,Show,Ord)
data ColumnsWidth = ColumnsWidth
{ cwMin :: Int
, cwMax :: Int
, cwWidth :: Double
, cwStyle :: Int
} deriving (Eq, Show)
instance FromCursor ColumnsWidth where
fromCursor c = do
cwMin <- decimal =<< attribute "min" c
cwMax <- decimal =<< attribute "max" c
cwWidth <- rational =<< attribute "width" c
cwStyle <- decimal =<< attribute "style" c
return ColumnsWidth{..}
type Range = Text
data Worksheet = Worksheet
{ _wsColumns :: [ColumnsWidth]
, _wsRowPropertiesMap :: Map Int RowProperties
, _wsCells :: CellMap
, _wsMerges :: [Range]
, _wsSheetViews :: Maybe [SheetView]
, _wsPageSetup :: Maybe PageSetup
, _wsConditionalFormattings :: Map SqRef ConditionalFormatting
} deriving (Eq, Show)
makeLenses ''Worksheet
instance Default Worksheet where
def = Worksheet [] M.empty M.empty [] Nothing Nothing M.empty
newtype Styles = Styles {unStyles :: L.ByteString}
deriving (Eq, Show)
data Xlsx = Xlsx
{ _xlSheets :: Map Text Worksheet
, _xlStyles :: Styles
, _xlDefinedNames :: DefinedNames
, _xlCustomProperties :: Map Text Variant
} deriving (Eq, Show)
newtype DefinedNames = DefinedNames [(Text, Maybe Text, Text)]
deriving (Eq, Show)
makeLenses ''Xlsx
instance Default Xlsx where
def = Xlsx M.empty emptyStyles def M.empty
instance Default DefinedNames where
def = DefinedNames []
emptyStyles :: Styles
emptyStyles = Styles "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\
\<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"></styleSheet>"
renderStyleSheet :: StyleSheet -> Styles
renderStyleSheet = Styles . renderLBS def . toDocument
parseStyleSheet :: Styles -> Either SomeException StyleSheet
parseStyleSheet (Styles bs) = parseLBS def bs >>= parseDoc
where
parseDoc doc = case fromCursor (fromDocument doc) of
[stylesheet] -> Right stylesheet
_ -> Left . toException $ ParseException "Could not parse style sheets"
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'
toRows :: CellMap -> [(Int, [(Int, Cell)])]
toRows cells =
map extractRow $ groupBy ((==) `on` (fst . fst)) $ M.toList cells
where
extractRow row@(((x,_),_):_) =
(x, map (\((_,y),v) -> (y,v)) row)
extractRow _ = error "invalid CellMap row"
fromRows :: [(Int, [(Int, Cell)])] -> CellMap
fromRows rows = M.fromList $ concatMap mapRow rows
where
mapRow (r, cells) = map (\(c, v) -> ((r, c), v)) cells
mkCellRef :: (Int, Int) -> CellRef
mkCellRef (row, col) = T.concat [int2col col, T.pack (show row)]
mkRange :: (Int, Int) -> (Int, Int) -> Range
mkRange fr to = T.concat [mkCellRef fr, T.pack ":", mkCellRef to]