diff --git a/changelog b/changelog
new file mode 100644
--- /dev/null
+++ b/changelog
@@ -0,0 +1,7 @@
+0.1.0
+ * better tests and documentation
+ * lenses for worksheets/cells
+ * removed streaming support as it needs better API and improved implementaion
+ * removed CellLocalTime as ambiguous, added CellBool
+0.0.1
+ * initial release
diff --git a/src/Codec/Xlsx.hs b/src/Codec/Xlsx.hs
--- a/src/Codec/Xlsx.hs
+++ b/src/Codec/Xlsx.hs
@@ -1,118 +1,44 @@
-module Codec.Xlsx(
- Xlsx(..),
- WorksheetFile(..),
- Styles(..),
- ColumnsWidth(..),
- RowHeights,
- Worksheet(..),
- CellValue(..),
- Cell(..),
- CellData(..),
- int2col,
- col2int,
- foldRows,
- toList,
- fromList
- ) where
-
-import Control.Arrow
-import Data.Char
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.IntMap (IntMap)
-import Data.Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.LocalTime (LocalTime)
-import qualified Codec.Archive.Zip as Zip
-import qualified Data.ByteString.Lazy as L
-
-
-data Xlsx = Xlsx{ xlArchive :: Zip.Archive
- , xlSharedStrings :: IntMap Text
- , xlStyles :: Styles
- , xlWorksheetFiles :: [WorksheetFile]
- }
-
-data Styles = Styles L.ByteString
- deriving Show
-
-
-data WorksheetFile = WorksheetFile { wfName :: Text
- , wfPath :: FilePath
- }
- deriving Show
-
--- | Column range (from cwMin to cwMax) width
-data ColumnsWidth = ColumnsWidth { cwMin :: Int
- , cwMax :: Int
- , cwWidth :: Double
- }
- deriving Show
-
-type RowHeights = Map Int Double
-
-data Worksheet = Worksheet { wsName :: Text -- ^ worksheet name
- , wsMinX :: Int -- ^ minimum non-empty column number (1-based)
- , wsMaxX :: Int -- ^ maximum non-empty column number (1-based)
- , wsMinY :: Int -- ^ minimum non-empty row number (1-based)
- , wsMaxY :: Int -- ^ maximum non-empty row number (1-based)
- , wsColumns :: [ColumnsWidth] -- ^ column widths
- , wsRowHeights :: RowHeights -- ^ custom row height map
- , wsCells :: Map (Int,Int) CellData -- ^ data mapped by (column, row) pairs
- }
- deriving Show
-
-data CellValue = CellText Text | CellDouble Double | CellLocalTime LocalTime
- deriving Show
-
-
-data Cell = Cell { cellIx :: (Text, Int)
- , cellData :: CellData
- }
- deriving Show
-
-data CellData = CellData { cdStyle :: Maybe Int
- , cdValue :: Maybe CellValue
- }
- deriving Show
-
--- | convert column number (starting from 1) to its textual form (e.g. 3 -> "C")
-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))
-
--- | reverse to 'int2col'
-col2int :: Text -> Int
-col2int = T.foldl' (\i c -> i * 26 + let2int c) 0
- where
- let2int c = 1 + ord c - ord 'A'
-
--- | fold worksheet by row, then by column, so for region A1:B2 you'll get fold order like A1, A2, B1, B2
-foldRows :: (Int -> Int -> Maybe CellData -> a -> a) -> a -> Worksheet -> a
-foldRows f i Worksheet{wsMinX=minX, wsMaxX=maxX,
- wsMinY=minY, wsMaxY=maxY, wsCells=cells} = foldr foldRow i [minX..maxX]
- where
- foldRow x acc = foldr (\y -> f x y $ Map.lookup (x,y) cells) acc [minY..maxY]
-
-toList :: Worksheet -> [[Maybe CellData]]
-toList Worksheet{wsMinX=minX, wsMaxX=maxX,
- wsMinY=minY, wsMaxY=maxY, wsCells=cells} =
- [[Map.lookup (x,y) cells | x <- [minX..maxX]] | y <- [minY..maxY]]
+-- | This module provides solution for parsing and writing MIcrosoft
+-- Open Office XML Workbook format i.e. *.xlsx files
+--
+-- As a simple example you could read cell B3 from the 1st sheet of workbook \"report.xlsx\"
+-- using the following code:
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > module Read where
+-- > import Codec.Xlsx
+-- > import qualified Data.ByteString.Lazy as L
+-- > import Control.Lens
+-- >
+-- > main :: IO ()
+-- > main = do
+-- > bs <- L.readFile "report.xlsx"
+-- > let value = toXlsx bs ^? ixSheet "List1" .
+-- > ixCell (3,2) . cellValue . _Just
+-- > putStrLn $ "Cell B3 contains " ++ show value
+--
+-- And the following example mudule shows a way to construct and write xlsx file
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > module Write where
+-- > import Codec.Xlsx
+-- > import Control.Lens
+-- > import qualified Data.ByteString.Lazy as L
+-- > import System.Time
+-- >
+-- > main :: IO ()
+-- > main = do
+-- > ct <- getClockTime
+-- > let
+-- > sheet = def & cellValueAt (1,2) ?~ CellDouble 42.0
+-- > & cellValueAt (3,2) ?~ CellText "foo"
+-- > xlsx = def & atSheet "List1" ?~ sheet
+-- > L.writeFile "example.xlsx" $ fromXlsx ct xlsx
+module Codec.Xlsx
+ ( module X
+ ) where
-fromList :: Text -> [ColumnsWidth] -> RowHeights -> [[Maybe CellData]] -> Worksheet
-fromList sName cw rh d = Worksheet sName 1 maxX 1 maxY cw rh $ Map.fromList cellList
- where
- maxY = max (length d + 1) (maximum' $ Map.keys rh)
- maximum' l = if null l then minBound else maximum l
- maxX = maximum' $ map length d
- filterMap f p = map f . filter p
- cellList = filterMap (second fromJust) (isJust . snd)
- $ concatMap (\(y,ds) -> map (\(x,v) -> ((x,y),v)) (zip [1..] ds))
- $ zip [1..] d
+import Codec.Xlsx.Types as X
+import Codec.Xlsx.Parser as X
+import Codec.Xlsx.Writer as X
+import Codec.Xlsx.Lens as X
diff --git a/src/Codec/Xlsx/Lens.hs b/src/Codec/Xlsx/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Xlsx/Lens.hs
@@ -0,0 +1,47 @@
+module Codec.Xlsx.Lens
+ ( ixSheet
+ , atSheet
+ , ixCell
+ , atCell
+ , cellValueAt
+ ) where
+
+import Codec.Xlsx.Types
+import Control.Applicative
+import Control.Lens
+import Data.Text
+
+ixSheet :: Applicative f
+ => Text
+ -> (Worksheet -> f Worksheet)
+ -> Xlsx
+ -> f Xlsx
+ixSheet s = xlSheets . ix s
+
+atSheet :: Functor f
+ => Text
+ -> (Maybe Worksheet -> f (Maybe Worksheet))
+ -> Xlsx
+ -> f Xlsx
+atSheet s = xlSheets . at s
+
+ixCell :: Applicative f
+ => (Int, Int)
+ -> (Cell -> f Cell)
+ -> Worksheet
+ -> f Worksheet
+ixCell i = wsCells . ix i
+
+atCell :: Functor f
+ => (Int, Int)
+ -> (Maybe Cell -> f (Maybe Cell))
+ -> Worksheet
+ -> f Worksheet
+atCell i = wsCells . at i
+
+cellValueAt :: Functor f
+ => (Int, Int)
+ -> (Maybe CellValue -> f (Maybe CellValue))
+ -> Worksheet
+ -> f Worksheet
+cellValueAt i = atCell i . non def . cellValue
diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs
--- a/src/Codec/Xlsx/Parser.hs
+++ b/src/Codec/Xlsx/Parser.hs
@@ -1,64 +1,50 @@
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
-
-module Codec.Xlsx.Parser(
- xlsx,
- sheet,
- cellSource,
- sheetRowSource
- ) where
+-- | This module provides a function for reading .xlsx files
+module Codec.Xlsx.Parser
+ ( toXlsx
+ ) where
+import qualified Codec.Archive.Zip as Zip
import Control.Applicative
-import Control.Monad (join)
+import Control.Arrow ((&&&))
+import Control.Monad (liftM4)
import Control.Monad.IO.Class()
-import Data.Function (on)
-import qualified Data.IntMap as M
-import qualified Data.IntSet as S
+import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Lazy.Char8()
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IM
import Data.List
-import qualified Data.Map as Map
+import qualified Data.Map as M
import Data.Maybe
import Data.Ord
-import Prelude hiding (sequence)
-
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as T
-import qualified Data.ByteString.Lazy as L
-import Data.ByteString.Lazy.Char8()
-
-import qualified Codec.Archive.Zip as Zip
-import Data.Conduit
-import qualified Data.Conduit.List as CL
import Data.XML.Types
+import Prelude hiding (sequence)
import System.FilePath
import Text.XML as X
import Text.XML.Cursor
-import qualified Text.XML.Stream.Parse as Xml
-import Codec.Xlsx
-
-
-type MapRow = Map.Map Text Text
-
-
--- | Read archive and preload 'Xlsx' fields
-xlsx :: FilePath -> IO Xlsx
-xlsx fname = do
- ar <- Zip.toArchive <$> L.readFile fname
- ss <- getSharedStrings ar
- st <- getStyles ar
- ws <- getWorksheetFiles ar
- return $ Xlsx ar ss st ws
+import Codec.Xlsx.Types
--- | Get data from specified worksheet as conduit source.
-cellSource :: MonadThrow m => Xlsx -> Int -> [Text] -> Source m [Cell]
-cellSource x sheetN cols = getSheetCells x sheetN
- $= filterColumns (S.fromList $ map col2int cols)
- $= groupRows
- $= reverseRows
+-- | Reads `Xlsx' from raw data (lazy bytestring)
+toXlsx :: L.ByteString -> Xlsx
+toXlsx bs = Xlsx sheets styles
+ where
+ ar = Zip.toArchive bs
+ ss = getSharedStrings ar
+ styles = getStyles ar
+ wfs = getWorksheetFiles ar
+ sheets = M.fromList $ map (wfName &&& extractSheet ar ss) wfs
+data WorksheetFile = WorksheetFile { wfName :: Text
+ , wfPath :: FilePath
+ }
+ deriving Show
decimal :: Monad m => Text -> m Int
decimal t = case T.decimal t of
@@ -70,253 +56,130 @@
Right (r, _) -> return r
_ -> fail "invalid rational"
-
-sheet :: MonadThrow m => Xlsx -> Int -> m Worksheet
-sheet Xlsx{xlArchive=ar, xlSharedStrings=ss, xlWorksheetFiles=sheets} sheetN
- | sheetN < 0 || sheetN >= length sheets
- = fail "parseSheet: Invalid sheet number"
- | otherwise
- = collect parse
+extractSheet :: Zip.Archive
+ -> IM.IntMap Text
+ -> WorksheetFile
+ -> Worksheet
+extractSheet ar ss wf = Worksheet cws rowProps cells merges
where
- filename = wfPath $ sheets !! sheetN
- sName = wfName $ sheets !! sheetN
- file = fromJust $ Zip.fromEntry <$> Zip.findEntryByPath filename ar
- doc = case parseLBS def file of
- Left _ -> error "could not read file"
- Right d -> d
- tc :: Cursor
- tc = fromDocument doc
- parse = (tc $/ parseColumns, tc $/ parseRows)
- parseColumns :: Cursor -> [ColumnsWidth]
- parseColumns = element (n"cols") &/ element (n"col") >=> parseColumn
- parseColumn :: Cursor -> [ColumnsWidth]
- parseColumn c = do
- min <- c $| attribute "min" >=> decimal
- max <- c $| attribute "max" >=> decimal
- width <- c $| attribute "width" >=> rational
- return $ ColumnsWidth min max width
- parseRows :: Cursor -> [(Int, Maybe Double, [(Int, Int, CellData)])]
- parseRows = element (n"sheetData") &/ element (n"row") >=> parseRow
+ file = fromJust $ Zip.fromEntry <$> Zip.findEntryByPath (wfPath wf) ar
+ cur = case parseLBS def file of
+ Left _ -> error "could not read file"
+ Right d -> fromDocument d
+
+ cws = cur $/ element (n"cols") &/ element (n"col") >=>
+ liftM4 ColumnsWidth <$>
+ (attribute "min" >=> decimal) <*>
+ (attribute "max" >=> decimal) <*>
+ (attribute "width" >=> rational) <*>
+ (attribute "style" >=> decimal)
+
+ (rowProps, cells) = collect $ cur $/ element (n"sheetData") &/ element (n"row") >=> parseRow
parseRow c = do
r <- c $| attribute "r" >=> decimal
- let ht = if attribute "customHeight" c == ["true"]
+ let ht = if attribute "customHeight" c == ["true"]
then listToMaybe $ c $| attribute "ht" >=> rational
else Nothing
- return (r, ht, c $/ element (n"c") >=> parseCell)
- parseCell :: Cursor -> [(Int, Int, CellData)]
+ let s = if attribute "s" c /= []
+ then listToMaybe $ c $| attribute "s" >=> decimal
+ else Nothing
+ let rp = if isNothing s && isNothing ht
+ then Nothing
+ else Just (RowProps ht s)
+ return (r, rp, c $/ element (n"c") >=> parseCell)
+ parseCell :: Cursor -> [(Int, Int, Cell)]
parseCell cell = do
- (c, r) <- T.span (>'9') <$> (cell $| attribute "r")
- return (col2int c, int r, CellData s d)
- where
+ let
s = listToMaybe $ cell $| attribute "s" >=> decimal
t = fromMaybe "n" $ listToMaybe $ cell $| attribute "t"
- d = listToMaybe $ cell $/ element (n"v") &/ content >=> extractValue
- extractValue v = case t of
- "n" ->
- case T.rational v of
- Right (d, _) -> [CellDouble d]
- _ -> []
- "s" ->
- case T.decimal v of
- Right (d, _) -> maybeToList $ fmap CellText $ M.lookup d ss
- _ -> []
- _ -> []
- collect (cw, rd) = return $ Worksheet sName minX maxX minY maxY cw rowMap cellMap
- where
- (rowMap, (minX, maxX, minY, maxY, cellMap)) = foldr collectRow rInit rd
- rInit = (Map.empty, (maxBound, minBound, maxBound, minBound, Map.empty))
- collectRow (_, Nothing, cells) (rowMap, cellData) =
- (rowMap, foldr collectCell cellData cells)
- collectRow (n, Just h, cells) (rowMap, cellData) =
- (Map.insert n h rowMap, foldr collectCell cellData cells)
- collectCell (x, y, cd) (minX, maxX, minY, maxY, cellMap) =
- (min minX x, max maxX x, min minY y, max maxY y, Map.insert (x,y) cd cellMap)
-
-
--- | Get all rows from specified worksheet.
-sheetRowSource :: MonadThrow m => Xlsx -> Int -> Source m MapRow
-sheetRowSource x sheetN
- = getSheetCells x sheetN
- $= groupRows
- $= reverseRows
- $= mkMapRows
-
--- | Make 'Conduit' from 'mkMapRowsSink'.
-mkMapRows :: Monad m => Conduit [Cell] m MapRow
-mkMapRows = sequence mkMapRowsSink =$= CL.concatMap id
-
-
--- | Make 'MapRow' from list of 'Cell's.
-mkMapRowsSink :: Monad m => Sink [Cell] m [MapRow]
-mkMapRowsSink = do
- header <- fromMaybe [] <$> CL.head
- rows <- CL.consume
-
- return $ map (mkMapRow header) rows
- where
- mkMapRow header row = Map.fromList $ zipCells header row
-
- zipCells :: [Cell] -> [Cell] -> [(Text, Text)]
- zipCells [] _ = []
- zipCells header [] = map (\h -> (txt h, "")) header
- zipCells header@(h:hs) row@(r:rs) =
- case comparing (fst . cellIx) h r of
- LT -> (txt h , "" ) : zipCells hs row
- EQ -> (txt h , txt r) : zipCells hs rs
- GT -> ("" , txt r) : zipCells header rs
-
- txt = fromMaybe "" . cv
- cv Cell{cellData=CellData{cdValue=Just(CellText t)}} = Just t
- cv _ = Nothing
-
-reverseRows :: Monad m => Conduit [a] m [a]
-reverseRows = CL.map reverse
-groupRows = CL.groupBy ((==) `on` (snd.cellIx))
-filterColumns cs = CL.filter ((`S.member` cs) . col2int . fst . cellIx)
-
-
-getSheetCells
- :: MonadThrow m => Xlsx -> Int -> Source m Cell
-getSheetCells (Xlsx{xlArchive=ar, xlSharedStrings=ss, xlWorksheetFiles=sheets}) sheetN
- | sheetN < 0 || sheetN >= length sheets
- = error "parseSheet: Invalid sheet number"
- | otherwise
- = case xmlSource ar (wfPath $ sheets !! sheetN) of
- Nothing -> error "An impossible happened"
- Just xml -> xml $= mkXmlCond (getCell ss)
-
-
--- | Parse single cell from xml stream.
-getCell
- :: MonadThrow m => M.IntMap Text -> Sink Event m (Maybe Cell)
-getCell ss = Xml.tagName (n"c") cAttrs cParser
- where
- cAttrs = do
- cellIx <- Xml.requireAttr "r"
- style <- Xml.optionalAttr "s"
- typ <- Xml.optionalAttr "t"
- Xml.ignoreAttrs
- return (cellIx,style,typ)
-
- maybeCellDouble Nothing = Nothing
- maybeCellDouble (Just t) = either (const Nothing) (\(d,_) -> Just (CellDouble d)) $ T.rational t
-
- cParser (ix,style,typ) = do
- val <- case typ of
- Just "inlineStr" -> liftA (fmap CellText) (tagSeq ["is", "t"])
- Just "s" -> liftA (fmap CellText) (tagSeq ["v"] >>=
- return . join . fmap ((`M.lookup` ss).int))
- Just "n" -> liftA maybeCellDouble $ tagSeq ["v"]
- _ -> liftA maybeCellDouble $ tagSeq ["v"]
- return $ Cell (mkCellIx ix) $ CellData (int <$> style) val
+ d = listToMaybe $ cell $/ element (n"v") &/ content >=> extractCellValue ss t
+ (c, r) <- T.span (>'9') <$> (cell $| attribute "r")
+ return (int r, col2int c, Cell s d)
+ collect = foldr collectRow (M.empty, M.empty)
+ collectRow (_, Nothing, rowCells) (rowMap, cellMap) =
+ (rowMap, foldr collectCell cellMap rowCells)
+ collectRow (r, Just h, rowCells) (rowMap, cellMap) =
+ (M.insert r h rowMap, foldr collectCell cellMap rowCells)
+ collectCell (x, y, cd) = M.insert (x,y) cd
- mkCellIx ix = let (c,r) = T.span (>'9') ix
- in (c,int r)
+ merges = cur $/ parseMerges
+ parseMerges :: Cursor -> [Text]
+ parseMerges = element (n"mergeCells") &/ element (n"mergeCell") >=> parseMerge
+ parseMerge c = c $| attribute "ref"
+extractCellValue :: IntMap Text -> Text -> Text -> [CellValue]
+extractCellValue ss "s" v =
+ case T.decimal v of
+ Right (d, _) -> maybeToList $ fmap CellText $ IM.lookup d ss
+ _ -> []
+extractCellValue _ "n" v =
+ case T.rational v of
+ Right (d, _) -> [CellDouble d]
+ _ -> []
+extractCellValue _ "b" "1" = [CellBool True]
+extractCellValue _ "b" "0" = [CellBool False]
+extractCellValue _ _ _ = []
-- | Add sml namespace to name
+n :: Text -> Name
n x = Name
- {nameLocalName = x
- ,nameNamespace = Just "http://schemas.openxmlformats.org/spreadsheetml/2006/main"
- ,namePrefix = Nothing}
+ { nameLocalName = x
+ , nameNamespace = Just "http://schemas.openxmlformats.org/spreadsheetml/2006/main"
+ , namePrefix = Nothing
+ }
-- | Add office document relationship namespace to name
+odr :: Text -> Name
odr x = Name
- {nameLocalName = x
- ,nameNamespace = Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships"
- ,namePrefix = Nothing}
+ { nameLocalName = x
+ , nameNamespace = Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships"
+ , namePrefix = Nothing
+ }
-- | Add package relationship namespace to name
+pr :: Text -> Name
pr x = Name
- {nameLocalName = x
- ,nameNamespace = Just "http://schemas.openxmlformats.org/package/2006/relationships"
- ,namePrefix = Nothing}
-
-
--- | Get text from several nested tags
-tagSeq :: MonadThrow m => [Text] -> Sink Event m (Maybe Text)
-tagSeq (x:xs)
- = Xml.tagNoAttr (n x)
- $ foldr (\x -> Xml.force "" . Xml.tagNoAttr (n x)) Xml.content xs
-
-tagSeq _ = error "no tags in tag sequence"
-
-
--- | Get xml event stream from the specified file inside the zip archive.
-xmlSource
- :: MonadThrow m => Zip.Archive -> FilePath -> Maybe (Source m Event)
-xmlSource ar fname
- = Xml.parseLBS Xml.def
- . Zip.fromEntry
- <$> Zip.findEntryByPath fname ar
-
-
--- Get shared strings (if there are some) into IntMap.
-getSharedStrings
- :: (MonadThrow m, Functor m)
- => Zip.Archive -> m (M.IntMap Text)
-getSharedStrings x
- = case xmlSource x "xl/sharedStrings.xml" of
- Nothing -> return M.empty
- Just xml -> (M.fromAscList . zip [0..]) <$> getText xml
+ { nameLocalName = x
+ , nameNamespace = Just "http://schemas.openxmlformats.org/package/2006/relationships"
+ , namePrefix = Nothing
+ }
--- | Fetch all text from xml stream.
-getText xml = xml $= mkXmlCond Xml.contentMaybe $$ CL.consume
+-- | Get xml cursor from the specified file inside the zip archive.
+xmlCursor :: Zip.Archive -> FilePath -> Maybe Cursor
+xmlCursor ar fname = parse <$> Zip.findEntryByPath fname ar
+ where
+ parse entry = case parseLBS def (Zip.fromEntry entry) of
+ Left _ -> error "could not read file"
+ Right d -> fromDocument d
+-- | Get shared strings (if there are some) into IntMap.
+getSharedStrings :: Zip.Archive -> IM.IntMap Text
+getSharedStrings x = case xmlCursor x "xl/sharedStrings.xml" of
+ Nothing -> IM.empty
+ Just c -> IM.fromAscList $ zip [0..] (c $/ element (n"si") &/ element (n"t") &/ content)
-getStyles :: (MonadThrow m, Functor m) => Zip.Archive -> m Styles
+getStyles :: Zip.Archive -> Styles
getStyles ar = case Zip.fromEntry <$> Zip.findEntryByPath "xl/styles.xml" ar of
- Nothing -> return (Styles L.empty)
- Just xml -> return (Styles xml)
+ Nothing -> Styles L.empty
+ Just xml -> Styles xml
-getWorksheetFiles :: (MonadThrow m, Functor m) => Zip.Archive -> m [WorksheetFile]
-getWorksheetFiles ar = case xmlSource ar "xl/workbook.xml" of
+-- | getWorksheetFiles pulls the names of the sheets
+getWorksheetFiles :: Zip.Archive -> [WorksheetFile]
+getWorksheetFiles ar = case xmlCursor ar "xl/workbook.xml" of
Nothing ->
error "invalid workbook"
- Just xml -> do
- sheetData <- xml $= mkXmlCond getSheetData $$ CL.consume
- wbRels <- getWbRels ar
- return [WorksheetFile n ("xl" T.unpack (fromJust $ lookup rId wbRels)) | (n, rId) <- sheetData]
-
-getSheetData = Xml.tagName (n"sheet") attrs return
- where
- attrs = do
- name <- Xml.requireAttr "name"
- rId <- Xml.requireAttr (odr "id")
- Xml.ignoreAttrs
- return (name, rId)
-
-getWbRels :: (MonadThrow m, Functor m) => Zip.Archive -> m [(Text, Text)]
-getWbRels ar = case xmlSource ar "xl/_rels/workbook.xml.rels" of
- Nothing -> return []
- Just xml -> xml $$ parseWbRels
-
-parseWbRels = Xml.force "relationships required" $
- Xml.tagNoAttr (pr"Relationships") $
- Xml.many $ Xml.tagName (pr"Relationship") attr return
- where
- attr = do
- target <- Xml.requireAttr "Target"
- id <- Xml.requireAttr "Id"
- Xml.ignoreAttrs
- return (id, target)
-
----------------------------------------------------------------------
+ Just c ->
+ let
+ sheetData = c $/ element (n"sheets") &/ element (n"sheet") >=>
+ liftA2 (,) <$> attribute "name" <*> attribute (odr"id")
+ wbRels = getWbRels ar
+ in [WorksheetFile name ("xl" T.unpack (fromJust $ lookup rId wbRels)) | (name, rId) <- sheetData]
+getWbRels :: Zip.Archive -> [(Text, Text)]
+getWbRels ar = case xmlCursor ar "xl/_rels/workbook.xml.rels" of
+ Nothing -> []
+ Just c -> c $/ element (pr"Relationship") >=>
+ liftA2 (,) <$> attribute "Id" <*> attribute "Target"
int :: Text -> Int
int = either error fst . T.decimal
-
-
--- | Create conduit from xml sink
--- Resulting conduit filters nodes that `f` can consume and skips everything
--- else.
---
--- FIXME: Some benchmarking required: maybe it's not very efficient to `peek`i
--- each element twice. It's possible to swap call to `f` and `CL.peek`.
-mkXmlCond f = sequenceSink () $ const
- $ CL.peek >>= maybe -- try get current event form the stream
- (return Stop) -- stop if stream is empty
- (\_ -> f >>= maybe -- try consume current event
- (CL.drop 1 >> return (Emit () [])) -- skip it if can't process
- (return . Emit () . (:[]))) -- return result otherwise
diff --git a/src/Codec/Xlsx/Types.hs b/src/Codec/Xlsx/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Xlsx/Types.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Codec.Xlsx.Types
+ ( Xlsx(..), xlSheets, xlStyles
+ , def
+ , Styles(..)
+ , emptyStyles
+ , ColumnsWidth(..)
+ , Worksheet(..), wsColumns, wsRowPropertiesMap, wsCells, wsMerges
+ , CellMap
+ , CellValue(..)
+ , Cell(..), cellValue, cellStyle
+ , RowProperties (..)
+ , int2col
+ , col2int
+ , toRows
+ , fromRows
+ ) where
+
+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
+
+
+-- | Cell values include text, numbers and booleans,
+-- standard includes date format also but actually dates
+-- are represented by numbers with a date format assigned
+-- to a cell containing it
+data CellValue = CellText Text
+ | CellDouble Double
+ | CellBool Bool
+ deriving (Eq, Show)
+
+data Cell = Cell
+ { _cellStyle :: Maybe Int
+ , _cellValue :: Maybe CellValue
+ } deriving (Eq, Show)
+
+makeLenses ''Cell
+
+instance Default Cell where
+ def = Cell Nothing Nothing
+
+type CellMap = Map (Int, Int) Cell
+
+data RowProperties = RowProps { rowHeight :: Maybe Double, rowStyle::Maybe Int}
+ deriving (Read,Eq,Show,Ord)
+
+-- | Column range (from cwMin to cwMax) width
+data ColumnsWidth = ColumnsWidth
+ { cwMin :: Int
+ , cwMax :: Int
+ , cwWidth :: Double
+ , cwStyle :: Int
+ } deriving (Eq, Show)
+
+-- | Xlsx worksheet
+data Worksheet = Worksheet
+ { _wsColumns :: [ColumnsWidth] -- ^ column widths
+ , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map
+ , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs
+ , _wsMerges :: [Text]
+ } deriving (Eq, Show)
+
+makeLenses ''Worksheet
+
+instance Default Worksheet where
+ def = Worksheet [] M.empty M.empty []
+
+newtype Styles = Styles {unStyles :: L.ByteString}
+ deriving (Eq, Show)
+
+-- | Structured representation of Xlsx file (currently a subset of its contents)
+data Xlsx = Xlsx
+ { _xlSheets :: Map Text Worksheet
+ , _xlStyles :: Styles
+ } deriving (Eq, Show)
+
+makeLenses ''Xlsx
+
+instance Default Xlsx where
+ def = Xlsx M.empty emptyStyles
+
+emptyStyles :: Styles
+emptyStyles = Styles "\
+\"
+
+-- | convert column number (starting from 1) to its textual form (e.g. 3 -> "C")
+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))
+
+-- | reverse to 'int2col'
+col2int :: Text -> Int
+col2int = T.foldl' (\i c -> i * 26 + let2int c) 0
+ where
+ let2int c = 1 + ord c - ord 'A'
+
+-- | converts cells mapped by (row, column) into rows which contain
+-- row index and cells as pairs of column indices and cell values
+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"
+
+-- | reverse to 'toRows'
+fromRows :: [(Int, [(Int, Cell)])] -> CellMap
+fromRows rows = M.fromList $ concatMap mapRow rows
+ where
+ mapRow (r, cells) = map (\(c, v) -> ((r, c), v)) cells
diff --git a/src/Codec/Xlsx/Writer.hs b/src/Codec/Xlsx/Writer.hs
--- a/src/Codec/Xlsx/Writer.hs
+++ b/src/Codec/Xlsx/Writer.hs
@@ -1,188 +1,189 @@
{-# LANGUAGE OverloadedStrings #-}
-module Codec.Xlsx.Writer (
- writeXlsx,
- writeXlsxStyles
- ) where
+-- | This module provides a function for serializing structured `Xlsx` into lazy bytestring
+module Codec.Xlsx.Writer
+ ( fromXlsx
+ ) where
import qualified Codec.Archive.Zip as Zip
+import Control.Lens hiding (transform)
import Control.Monad.Trans.State
-import Data.ByteString.Lazy.Char8()
import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Lazy.Char8()
import Data.List
+import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
-import Data.Text (Text)
+import Data.Monoid ((<>))
+import Data.Text (Text, )
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.Int
import Data.Text.Lazy.Builder.RealFloat
-import Data.Time.Calendar
-import Data.Time.LocalTime
import System.Locale
import System.Time
import Text.XML
-import Codec.Xlsx
+import Codec.Xlsx.Types
--- | writes list of worksheets as xlsx file
-writeXlsx :: FilePath -> [Worksheet] -> IO ()
-writeXlsx p = writeXlsxStyles p emptyStylesXml
-
--- | writes list of worksheets and their styling as xlsx file
-writeXlsxStyles :: FilePath -> L.ByteString -> [Worksheet] -> IO ()
-writeXlsxStyles p s d = constructXlsx s d >>= L.writeFile p
-
-data FileData = FileData { fdName :: Text
- , fdContentType :: Text
- , fdContents :: L.ByteString}
-
-constructXlsx :: L.ByteString -> [Worksheet] -> IO L.ByteString
-constructXlsx s ws = do
- ct <- getClockTime
- let
+-- | Writes `Xlsx' to raw data (lazy bytestring)
+fromXlsx :: ClockTime -> Xlsx -> L.ByteString
+fromXlsx ct xlsx =
+ Zip.fromArchive $ foldr Zip.addEntryToArchive Zip.emptyArchive entries
+ where
TOD t _ = ct
- utct = toUTCTime ct
- (sheetCells, shared) = runState (mapM collectSharedTransform ws) []
- sheetNumber = length ws
- sheetFiles = [FileData (T.concat ["xl/worksheets/sheet", txti n, ".xml"]) "application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" $
- sheetXml (wsColumns w) (wsRowHeights w) cells | (n, cells, w) <- zip3 [1..] sheetCells ws]
- files = sheetFiles ++
- [ FileData "docProps/core.xml" "application/vnd.openxmlformats-package.core-properties+xml" $ coreXml utct "xlsxwriter"
- , FileData "docProps/app.xml" "application/vnd.openxmlformats-officedocument.extended-properties+xml" appXml
- , FileData "xl/workbook.xml" "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" $ bookXml ws
- , FileData "xl/styles.xml" "application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" s
- , FileData "xl/sharedStrings.xml" "application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" $ ssXml shared
- , FileData "xl/_rels/workbook.xml.rels" "application/vnd.openxmlformats-package.relationships+xml" $ bookRelXml sheetNumber
- , FileData "_rels/.rels" "application/vnd.openxmlformats-package.relationships+xml" rootRelXml ]
entries = Zip.toEntry "[Content_Types].xml" t (contentTypesXml files) :
map (\fd -> Zip.toEntry (T.unpack $ fdName fd) t (fdContents fd)) files
- ar = foldr Zip.addEntryToArchive Zip.emptyArchive entries
- return $ Zip.fromArchive ar
+ files = sheetFiles ++
+ [ FileData "docProps/core.xml"
+ "application/vnd.openxmlformats-package.core-properties+xml" $ coreXml (toUTCTime ct) "xlsxwriter"
+ , FileData "docProps/app.xml"
+ "application/vnd.openxmlformats-officedocument.extended-properties+xml" appXml
+ , FileData "xl/workbook.xml"
+ "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" $ bookXml (xlsx ^. xlSheets)
+ , FileData "xl/styles.xml"
+ "application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" $ unStyles (xlsx ^. xlStyles)
+ , FileData "xl/sharedStrings.xml"
+ "application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" $ ssXml shared
+ , FileData "xl/_rels/workbook.xml.rels"
+ "application/vnd.openxmlformats-package.relationships+xml" $ bookRelXml sheetCount
+ , FileData "_rels/.rels" "application/vnd.openxmlformats-package.relationships+xml" rootRelXml
+ ]
+ sheetFiles =
+ [ FileData ("xl/worksheets/sheet" <> txti n <> ".xml")
+ "application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" $
+ sheetXml (w ^. wsColumns) (w ^. wsRowPropertiesMap) cells (w ^. wsMerges) |
+ (n, cells, w) <- zip3 [1..] sheetCells sheets]
+ sheets = xlsx ^. xlSheets . to M.elems
+ sheetCount = length sheets
+ (sheetCells, shared) = runState (mapM collectSharedTransform sheets) []
+data FileData = FileData { fdName :: Text
+ , fdContentType :: Text
+ , fdContents :: L.ByteString}
coreXml :: CalendarTime -> Text -> L.ByteString
coreXml created creator =
renderLBS def $ Document (Prologue [] Nothing []) root []
where
date = T.pack $ formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" created
- nsAttrs = [("xmlns:dcterms", "http://purl.org/dc/terms/")]
+ nsAttrs = M.fromList [("xmlns:dcterms", "http://purl.org/dc/terms/")]
root = Element (nm "http://schemas.openxmlformats.org/package/2006/metadata/core-properties" "coreProperties") nsAttrs
[nEl (nm "http://purl.org/dc/terms/" "created")
- [(nm "http://www.w3.org/2001/XMLSchema-instance" "type", "dcterms:W3CDTF")] [NodeContent date],
- nEl (nm "http://purl.org/dc/elements/1.1/" "creator") [] [NodeContent creator],
- nEl (nm "http://schemas.openxmlformats.org/package/2006/metadata/core-properties" "version") [] [NodeContent "0"]]
+ (M.fromList [(nm "http://www.w3.org/2001/XMLSchema-instance" "type", "dcterms:W3CDTF")]) [NodeContent date],
+ nEl (nm "http://purl.org/dc/elements/1.1/" "creator") M.empty [NodeContent creator],
+ nEl (nm "http://schemas.openxmlformats.org/package/2006/metadata/core-properties" "version") M.empty [NodeContent "0"]]
appXml :: L.ByteString
appXml = "\
\0"
-data XlsxCellData = XlsxSS Int | XlsxDouble Double
-data XlsxCell = XlsxCell{ xlsxCellStyle :: Maybe Int
- , xlsxCellValue :: Maybe XlsxCellData
- }
+data XlsxCellData = XlsxSS Int
+ | XlsxDouble Double
+ | XlsxBool Bool
+ deriving (Show, Eq)
+data XlsxCell = XlsxCell
+ { xlsxCellStyle :: Maybe Int
+ , xlsxCellValue :: Maybe XlsxCellData
+ } deriving (Show, Eq)
xlsxCellType :: XlsxCell -> Text
xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxSS _)} = "s"
-xlsxCellType _ = "n" -- default type, TODO: fix cell output?
+xlsxCellType XlsxCell{xlsxCellValue=Just(XlsxBool _)} = "b"
+xlsxCellType _ = "n" -- default in SpreadsheetML schema, TODO: add other types
value :: XlsxCell -> Text
value XlsxCell{xlsxCellValue=Just(XlsxSS i)} = txti i
value XlsxCell{xlsxCellValue=Just(XlsxDouble d)} = txtd d
+value XlsxCell{xlsxCellValue=Just(XlsxBool True)} = "1"
+value XlsxCell{xlsxCellValue=Just(XlsxBool False)} = "0"
value _ = error "value undefined"
-
-collectSharedTransform :: Worksheet -> State [Text] [[XlsxCell]]
-collectSharedTransform d = transformed
+collectSharedTransform :: Worksheet -> State [Text] [(Int, [(Int, XlsxCell)])]
+collectSharedTransform ws = transformed
where
- transformed = mapM (mapM transform) $ toList d
- transform Nothing = return $ XlsxCell Nothing Nothing
- transform (Just CellData{cdValue=v, cdStyle=s}) =
+ transformed = mapM transformRow $ toRows (ws ^. wsCells)
+ transformRow (r, cells) = do
+ cells' <- mapM transform cells
+ return (r, cells')
+ transform (c, Cell{_cellValue=v, _cellStyle=s}) =
case v of
Just(CellText t) -> do
shared <- get
case t `elemIndex` shared of
Just i ->
- return $ XlsxCell s (Just $ XlsxSS i)
+ return (c, XlsxCell s (Just $ XlsxSS i))
Nothing -> do
put $ shared ++ [t]
- return $ XlsxCell s (Just $ XlsxSS (length shared))
+ return (c, XlsxCell s (Just $ XlsxSS (length shared)))
Just(CellDouble dbl) ->
- return $ XlsxCell s (Just $ XlsxDouble dbl)
- Just(CellLocalTime t) ->
- return $ XlsxCell s (Just $ XlsxDouble (xlsxDoubleTime t))
+ return (c, XlsxCell s (Just $ XlsxDouble dbl))
+ Just(CellBool b) ->
+ return (c, XlsxCell s (Just $ XlsxBool b))
Nothing ->
- return $ XlsxCell s Nothing
-
-xlsxDoubleTime :: LocalTime -> Double
-xlsxDoubleTime LocalTime{localDay=day,localTimeOfDay=time} =
- fromIntegral (diffDays day xlsxEpochStart) + timeFraction time
- where
- xlsxEpochStart = fromGregorian 1899 12 30
- timeFraction = fromRational . timeOfDayToDayFraction
+ return (c, XlsxCell s Nothing)
-sheetXml :: [ColumnsWidth] -> RowHeights -> [[XlsxCell]] -> L.ByteString
-sheetXml cws rh d = renderLBS def $ Document (Prologue [] Nothing []) root []
+sheetXml :: [ColumnsWidth] -> Map Int RowProperties -> [(Int, [(Int, XlsxCell)])] -> [Text]-> L.ByteString
+sheetXml cws rh rows merges = renderLBS def $ Document (Prologue [] Nothing []) root []
where
- rows = zip [1..] d
- numCols = zip [int2col n | n <- [1..]]
cType = xlsxCellType
root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $
- Element "worksheet" []
- [nEl "cols" [] $ map cwEl cws,
- nEl "sheetData" [] $ map rowEl rows]
- cwEl cw = NodeElement $! Element "col"
- [("min", txti $ cwMin cw), ("max", txti $ cwMax cw), ("width", txtd $ cwWidth cw)] []
+ Element "worksheet" M.empty
+ [nEl "cols" M.empty $ map cwEl cws,
+ nEl "sheetData" M.empty $ map rowEl rows,
+ nEl "mergeCells" M.empty $ map mergeE1 merges]
+ cwEl cw = NodeElement $! Element "col" (M.fromList
+ [("min", txti $ cwMin cw), ("max", txti $ cwMax cw), ("width", txtd $ cwWidth cw), ("style", txti $ cwStyle cw)]) []
rowEl (r, cells) = nEl "row"
- (ht ++ [("r", txti r), ("hidden", "false"), ("outlineLevel", "0"),
- ("collapsed", "false"), ("customFormat", "false"),
- ("customHeight", txtb hasHeight)])
- $ map (cellEl r) (numCols cells)
+ (M.fromList (ht ++ s ++ [("r", txti r) ,("hidden", "false"), ("outlineLevel", "0"),
+ ("collapsed", "false"), ("customFormat", "true"),
+ ("customHeight", txtb hasHeight)]))
+ $ map (cellEl r) cells
where
- (ht, hasHeight) = case M.lookup r rh of
- Just h -> ([("ht", txtd h)], True)
- Nothing -> ([], False)
- cellEl r (col, cell) =
- nEl "c" (cellAttrs r col cell) [nEl "v" [] [NodeContent $ value cell] | isJust $ xlsxCellValue cell]
+ (ht, hasHeight, s) = case M.lookup r rh of
+ Just (RowProps (Just h) (Just st)) -> ([("ht", txtd h)], True,[("s", txti st)])
+ Just (RowProps Nothing (Just st)) -> ([], True, [("s", txti st)])
+ Just (RowProps (Just h) Nothing ) -> ([("ht", txtd h)], True,[])
+ _ -> ([], False,[])
+ mergeE1 t = NodeElement $! Element "mergeCell" (M.fromList [("ref",t)]) []
+ cellEl r (icol, cell) =
+ nEl "c" (M.fromList (cellAttrs r (int2col icol) cell))
+ [nEl "v" M.empty [NodeContent $ value cell] | isJust $ xlsxCellValue cell]
cellAttrs r col cell = cellStyleAttr cell ++ [("r", T.concat [col, txti r]), ("t", cType cell)]
cellStyleAttr XlsxCell{xlsxCellStyle=Nothing} = []
cellStyleAttr XlsxCell{xlsxCellStyle=Just s} = [("s", txti s)]
-bookXml :: [Worksheet] -> L.ByteString
+bookXml :: Map Text Worksheet -> L.ByteString
bookXml wss = renderLBS def $ Document (Prologue [] Nothing []) root []
where
- numNames = [(txti i, wsName ws) | (i, ws) <- zip [1..] wss]
- root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "workbook" []
- [nEl "sheets" [] $
+ numNames = [(txti i, name) | (i, name) <- zip [1..] (M.keys wss)]
+ root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "workbook" M.empty
+ [nEl "sheets" M.empty $
map (\(n, name) -> nEl "sheet"
- [("name", name), ("sheetId", n), ("state", "visible"),
- (rId, T.concat ["rId", n])] []) numNames]
+ (M.fromList [("name", name), ("sheetId", n), ("state", "visible"),
+ (rId, T.concat ["rId", n])]) []) numNames]
rId = nm "http://schemas.openxmlformats.org/officeDocument/2006/relationships" "id"
-emptyStylesXml :: L.ByteString
-emptyStylesXml = "\
-\"
-
ssXml :: [Text] -> L.ByteString
ssXml ss =
renderLBS def $ Document (Prologue [] Nothing []) root []
where
- root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "sst" [] $
- map (\s -> nEl "si" [] [nEl "t" [] [NodeContent s]]) ss
+ root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $ Element "sst" M.empty $
+ map (\s -> nEl "si" M.empty [nEl "t" M.empty [NodeContent s]]) ss
bookRelXml :: Int -> L.ByteString
bookRelXml n = renderLBS def $ Document (Prologue [] Nothing []) root []
where
root = addNS "http://schemas.openxmlformats.org/package/2006/relationships" $
- Element "Relationships" [] $
+ Element "Relationships" M.empty $
map (\sn -> relEl sn (T.concat ["worksheets/sheet", txti sn, ".xml"]) "worksheet") [1..n]
++
[relEl (n + 1) "styles.xml" "styles", relEl (n + 2) "sharedStrings.xml" "sharedStrings"]
relEl i target typ =
nEl "Relationship"
- [("Id", T.concat ["rId", txti i]), ("Target", target),
- ("Type", T.concat ["http://schemas.openxmlformats.org/officeDocument/2006/relationships/", typ])] []
+ (M.fromList [("Id", T.concat ["rId", txti i]), ("Target", target),
+ ("Type", T.concat ["http://schemas.openxmlformats.org/officeDocument/2006/relationships/", typ])]) []
rootRelXml :: L.ByteString
rootRelXml = "\
@@ -192,9 +193,9 @@
contentTypesXml fds = renderLBS def $ Document (Prologue [] Nothing []) root []
where
root = addNS "http://schemas.openxmlformats.org/package/2006/content-types" $
- Element "Types" [] $
- map (\fd -> nEl "Override" [("PartName", T.concat ["/", fdName fd]),
- ("ContentType", fdContentType fd)] []) fds
+ Element "Types" M.empty $
+ map (\fd -> nEl "Override" (M.fromList [("PartName", T.concat ["/", fdName fd]),
+ ("ContentType", fdContentType fd)]) []) fds
nm :: Text -> Text -> Name
nm ns n = Name
@@ -208,7 +209,7 @@
addNS' (NodeElement e) = NodeElement $ addNS namespace e
addNS' n = n
-nEl :: Name -> [(Name, Text)] -> [Node] -> Node
+nEl :: Name -> Map Name Text -> [Node] -> Node
nEl name attrs nodes = NodeElement $ Element name attrs nodes
txti :: Int -> Text
diff --git a/src/Test.hs b/src/Test.hs
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,30 +1,43 @@
{-# LANGUAGE OverloadedStrings #-}
+
import Codec.Xlsx
-import Codec.Xlsx.Writer
+
+import Control.Applicative ((<$>))
+import Control.Lens
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
import Data.Text (Text)
-import Data.Time.Calendar
-import Data.Time.LocalTime
-
+import System.Time
-xText :: Text -> Maybe CellData
-xText t = Just CellData{cdValue=Just $ CellText t, cdStyle=Just 0}
+xEmpty :: Cell
+xEmpty = Cell{_cellValue=Nothing, _cellStyle=Just 0}
-xDate :: LocalTime -> Maybe CellData
-xDate d = Just CellData{cdValue=Just $ CellLocalTime d, cdStyle=Just 0}
+xText :: Text -> Cell
+xText t = Cell{_cellValue=Just $ CellText t, _cellStyle=Just 0}
-xDouble :: Double -> Maybe CellData
-xDouble d = Just CellData{cdValue=Just $ CellDouble d, cdStyle=Just 0}
+xDouble :: Double -> Cell
+xDouble d = Cell{_cellValue=Just $ CellDouble d, _cellStyle=Just 0}
-styles :: L.ByteString
-styles = "\
+styles :: Styles
+styles = Styles "\
\"
main :: IO ()
-main = writeXlsxStyles "test.xlsx" styles [fromList "List" cols rows sheet]
- where
- cols = [ColumnsWidth 1 10 15]
- rows = M.fromList [(1,50)]
- sheet = replicate 10000 [xText "column1", xText "column2", Nothing, xText "column4", xDate $! LocalTime (fromGregorian 2012 05 06) (TimeOfDay 7 30 50), xDouble 42.12345, xText "False"]
+main = do
+ ct <- getClockTime
+ L.writeFile "test.xlsx" $ fromXlsx ct $ Xlsx sheets styles
+ x <- toXlsx <$> L.readFile "test.xlsx"
+ putStrLn $ "And cell (3,2) value in list 'List' is " ++
+ show (x ^? xlSheets . ix "List" . wsCells . ix (3,2) . cellValue . _Just)
+ where
+ cols = [ColumnsWidth 1 10 15 1]
+ rowProps = M.fromList [(1, RowProps (Just 50) (Just 3))]
+ cells = M.fromList [((r, c), v) | (c, v) <- zip [1..] row, r <- [1..10000]]
+ row = [ xText "column1"
+ , xText "column2"
+ , xEmpty
+ , xText "column4"
+ , xDouble 42.12345
+ , xText "False"]
+ sheets = M.fromList [("List", Worksheet cols rowProps cells [])] -- wtf merges?
diff --git a/test/DataTest.hs b/test/DataTest.hs
--- a/test/DataTest.hs
+++ b/test/DataTest.hs
@@ -1,23 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
-import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Time.Calendar
+import Data.Time.LocalTime
+import System.Time
-import Test.QuickCheck
-import Test.HUnit
-import Control.Monad
+import Test.Tasty (defaultMain, testGroup)
+import Test.Tasty.SmallCheck (testProperty)
+import Test.Tasty.HUnit (testCase)
-import Codec.Xlsx
+import Test.HUnit ((@=?))
+import Test.SmallCheck.Series (Positive(..))
+import Codec.Xlsx
-main = defaultMain tests
-tests =
- [ testGroup "Behaves to spec"
- [ testProperty "col to name" prop_col2name
- ]
+main = defaultMain $
+ testGroup "Tests"
+ [ testProperty "col2int . int2col == id" $
+ \(Positive i) -> i == col2int (int2col i)
+ , testCase "write . read == id" $
+ testXlsx @=? toXlsx (fromXlsx testTime testXlsx)
+ , testCase "fromRows . toRows == id" $
+ testCellMap @=? fromRows (toRows testCellMap)
]
-prop_col2name (Positive i) = i == (col2Int $ int2col i)
- where types = (i::Int)
+testXlsx :: Xlsx
+testXlsx = Xlsx sheets emptyStyles
+ where
+ sheets = M.fromList [( "List1", sheet )]
+ sheet = Worksheet cols rowProps testCellMap []
+ rowProps = M.fromList [(1, RowProps (Just 50) (Just 3))]
+ cols = [ColumnsWidth 1 10 15 1]
+
+testCellMap :: CellMap
+testCellMap = M.fromList [ ((1, 2), cd1), ((1, 5), cd2)
+ , ((3, 1), cd3), ((3, 2), cd4), ((3, 7), cd5)
+ ]
+ where
+ cd v = Cell{_cellValue=Just v, _cellStyle=Nothing}
+ cd1 = cd (CellText "just a text")
+ cd2 = cd (CellDouble 42.4567)
+ cd3 = cd (CellText "another text")
+ cd4 = Cell{_cellValue=Nothing, _cellStyle=Nothing} -- shouldn't it be skipped?
+ cd5 = cd $(CellBool True)
+
+testTime :: ClockTime
+testTime = TOD 123 567
diff --git a/xlsx.cabal b/xlsx.cabal
--- a/xlsx.cabal
+++ b/xlsx.cabal
@@ -1,13 +1,20 @@
Name: xlsx
-Version: 0.0.1
+Version: 0.1.0
Synopsis: Simple and incomplete Excel file parser/writer
Description:
This library can help you to get some data read and written in Office
Open XML xlsx format. Small subset of xlsx format is supported.
- TODO: add link to ECMA standard.
+ .
+ For examples look into "Codec.Xlsx".
+ .
+ Format is covered by ECMA-376 standard:
+
+Extra-source-files:
+ changelog
+
Homepage: https://github.com/qrilka/xlsx
Bug-Reports: https://github.com/qrilka/xlsx/issues
License: MIT
@@ -18,61 +25,79 @@
Category: Codec
Build-type: Simple
-Cabal-version: >=1.8
+Cabal-version: >=1.10
Library
Hs-source-dirs: src
- Exposed-modules: Codec.Xlsx, Codec.Xlsx.Parser, Codec.Xlsx.Writer
+ Exposed-modules: Codec.Xlsx
+ , Codec.Xlsx.Parser
+ , Codec.Xlsx.Types
+ , Codec.Xlsx.Writer
+ , Codec.Xlsx.Lens
Build-depends: base == 4.*
- ,containers
- ,transformers
- ,bytestring
- ,text
- ,conduit == 0.4.*
- ,xml-types == 0.3.*
- ,xml-conduit == 0.7.*
- ,zip-archive == 0.1.*
- ,digest == 0.0.*
- ,zlib
- ,utf8-string
- ,time
- ,old-time
- ,old-locale
- ,filepath
+ , containers >= 0.5.0.0
+ , transformers >= 0.3.0.0
+ , bytestring >= 0.10.0.2
+ , text >= 0.11.3.1
+ , lens == 4.*
+ , conduit == 1.0.*
+ , xml-types == 0.3.*
+ , xml-conduit == 1.1.*
+ , zip-archive == 0.2.*
+ , digest == 0.0.*
+ , zlib == 0.5.4.*
+ , utf8-string >= 0.3.7
+ , time >= 1.4.0.1
+ , old-time >= 1.1.0.1
+ , old-locale >= 1.0.0.5
+ , filepath >= 1.3.0.1
+ , data-default == 0.5.*
+ Default-Language: Haskell2010
+
Executable test
Hs-source-dirs: src
- Other-modules: Codec.Xlsx, Codec.Xlsx.Parser, Codec.Xlsx.Writer
+ Other-modules: Codec.Xlsx
+ , Codec.Xlsx.Parser
+ , Codec.Xlsx.Writer
ghc-options: -Wall -threaded
main-is: Test.hs
-
+
Build-depends: base, containers, transformers, bytestring, text
- ,conduit == 0.4.*
- ,xml-types == 0.3.*
- ,xml-conduit == 0.7.*
- ,zip-archive == 0.1.*
- ,digest > 0.0.0.1
- ,zlib
- ,utf8-string
- ,time
- ,old-time
- ,old-locale
- ,filepath
-
+ , conduit == 1.0.*
+ , xml-types == 0.3.*
+ , xml-conduit == 1.1.*
+ , zip-archive == 0.2.*
+ , lens == 4.*
+ , digest > 0.0.0.1
+ , zlib
+ , utf8-string
+ , time
+ , old-time
+ , old-locale
+ , filepath
+ , data-default == 0.5.*
+ Default-Language: Haskell2010
+
test-suite data-test
type: exitcode-stdio-1.0
main-is: DataTest.hs
hs-source-dirs: test/
- Build-Depends: base, QuickCheck >= 2, HUnit,
+ Build-Depends: base,
+ containers,
+ time,
+ old-time,
xlsx,
- test-framework,
- test-framework-hunit,
- test-framework-quickcheck2
+ smallcheck,
+ HUnit,
+ tasty,
+ tasty-smallcheck,
+ tasty-hunit
+ Default-Language: Haskell2010
source-repository head
type: git
location: git://github.com/qrilka/xlsx.git
-