xlsx 0.0.1 → 0.1.0
raw patch · 9 files changed
+589/−552 lines, 9 filesdep +data-defaultdep +lensdep +smallcheckdep −QuickCheckdep −test-frameworkdep −test-framework-hunitdep ~bytestringdep ~conduitdep ~containers
Dependencies added: data-default, lens, smallcheck, tasty, tasty-hunit, tasty-smallcheck
Dependencies removed: QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: bytestring, conduit, containers, filepath, old-locale, old-time, text, time, transformers, utf8-string, xml-conduit, zip-archive, zlib
Files
- changelog +7/−0
- src/Codec/Xlsx.hs +43/−117
- src/Codec/Xlsx/Lens.hs +47/−0
- src/Codec/Xlsx/Parser.hs +124/−261
- src/Codec/Xlsx/Types.hs +127/−0
- src/Codec/Xlsx/Writer.hs +106/−105
- src/Test.hs +30/−17
- test/DataTest.hs +42/−14
- xlsx.cabal +63/−38
+ changelog view
@@ -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
src/Codec/Xlsx.hs view
@@ -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
+ src/Codec/Xlsx/Lens.hs view
@@ -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
src/Codec/Xlsx/Parser.hs view
@@ -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
+ src/Codec/Xlsx/Types.hs view
@@ -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 "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\+\<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"></styleSheet>"++-- | 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
src/Codec/Xlsx/Writer.hs view
@@ -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 = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\ \<Properties xmlns=\"http://schemas.openxmlformats.org/officeDocument/2006/extended-properties\" xmlns:vt=\"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes\"><TotalTime>0</TotalTime></Properties>" -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 = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\-\<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"></styleSheet>"- 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 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\@@ -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
src/Test.hs view
@@ -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 = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\+styles :: Styles+styles = Styles "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\ \<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"><numFmts count=\"1\"><numFmt formatCode=\"GENERAL\" numFmtId=\"164\"/></numFmts><fonts count=\"4\"><font><name val=\"Courier New\"/><charset val=\"1\"/><family val=\"2\"/><sz val=\"10\"/></font><font><name val=\"Arial\"/><family val=\"0\"/><sz val=\"10\"/></font><font><name val=\"Arial\"/><family val=\"0\"/><sz val=\"10\"/></font><font><name val=\"Arial\"/><family val=\"0\"/><sz val=\"10\"/></font></fonts><fills count=\"2\"><fill><patternFill patternType=\"none\"/></fill><fill><patternFill patternType=\"gray125\"/></fill></fills><borders count=\"1\"><border diagonalDown=\"false\" diagonalUp=\"false\"><left/><right/><top/><bottom/><diagonal/></border></borders><cellStyleXfs count=\"20\"><xf applyAlignment=\"true\" applyBorder=\"true\" applyFont=\"true\" applyProtection=\"true\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"164\"><alignment horizontal=\"general\" indent=\"0\" shrinkToFit=\"false\" textRotation=\"0\" vertical=\"bottom\" wrapText=\"false\"/><protection hidden=\"false\" locked=\"true\"/></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"2\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"2\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"0\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"43\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"41\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"44\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"42\"></xf><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"true\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"1\" numFmtId=\"9\"></xf></cellStyleXfs><cellXfs count=\"1\"><xf applyAlignment=\"false\" applyBorder=\"false\" applyFont=\"false\" applyProtection=\"false\" borderId=\"0\" fillId=\"0\" fontId=\"0\" numFmtId=\"164\" xfId=\"0\"></xf></cellXfs><cellStyles count=\"6\"><cellStyle builtinId=\"0\" customBuiltin=\"false\" name=\"Normal\" xfId=\"0\"/><cellStyle builtinId=\"3\" customBuiltin=\"false\" name=\"Comma\" xfId=\"15\"/><cellStyle builtinId=\"6\" customBuiltin=\"false\" name=\"Comma [0]\" xfId=\"16\"/><cellStyle builtinId=\"4\" customBuiltin=\"false\" name=\"Currency\" xfId=\"17\"/><cellStyle builtinId=\"7\" customBuiltin=\"false\" name=\"Currency [0]\" xfId=\"18\"/><cellStyle builtinId=\"5\" customBuiltin=\"false\" name=\"Percent\" xfId=\"19\"/></cellStyles></styleSheet>" 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?
test/DataTest.hs view
@@ -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
xlsx.cabal view
@@ -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:+ <http://www.ecma-international.org/publications/standards/Ecma-376.htm>+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-