xlsx 0.1.0.3 → 0.1.0.4
raw patch · 4 files changed
+171/−51 lines, 4 filesdep +binary-searchdep +vectorPVP ok
version bump matches the API change (PVP)
Dependencies added: binary-search, vector
API changes (from Hackage documentation)
Files
- changelog +8/−0
- src/Codec/Xlsx/Writer.hs +88/−41
- src/Test.hs +70/−9
- xlsx.cabal +5/−1
changelog view
@@ -1,3 +1,11 @@+0.1.0.4+ * fixed generated xml so it gets read by MS Excel with no warnings (thanks Dmitriy Nikitinskiy <nick@linux-i294.site>)+ * improved shared strings collection by using Vector (thanks Dmitriy Nikitinskiy <nick@linux-i294.site>)+ * empty xml elements don't get emmitted anymore (thanks Philipp Hausmann <ph_git@314.ch>)+ * imporoved and cleaned up core.xml generation+0.1.0.3+ * added "str" cells content extraction as text+ * added a notice that formulas in <f> are not yet supported 0.1.0 * better tests and documentation * lenses for worksheets/cells
src/Codec/Xlsx/Writer.hs view
@@ -5,11 +5,10 @@ ) where import qualified Codec.Archive.Zip as Zip+import Control.Arrow (second) import Control.Lens hiding (transform)-import Control.Monad.Trans.State 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@@ -20,6 +19,10 @@ import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int import Data.Text.Lazy.Builder.RealFloat+import qualified Data.Set as S+import Data.Vector (Vector)+import qualified Data.Vector as V+import Numeric.Search.Range (searchFromTo) import System.Locale import System.Time import Text.XML@@ -39,13 +42,13 @@ [ 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+ "application/vnd.openxmlformats-officedocument.extended-properties+xml" $ appXml (xlsx ^. xlSheets) , 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+ "application/vnd.openxmlformats-officedocument.spreadsheetml.sharedStrings+xml" $ ssXml $ V.toList 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@@ -57,7 +60,11 @@ (n, cells, w) <- zip3 [1..] sheetCells sheets] sheets = xlsx ^. xlSheets . to M.elems sheetCount = length sheets- (sheetCells, shared) = runState (mapM collectSharedTransform sheets) []+ shared = V.fromList $ S.elems $ S.fromList $ concatMap (concatMap celltext . M.elems . _wsCells) sheets+ sheetCells = map (transformSheetData shared) sheets+ celltext (Cell{_cellValue=v}) = case v of+ Just(CellText a) -> [a]+ _ -> [] data FileData = FileData { fdName :: Text , fdContentType :: Text@@ -65,19 +72,45 @@ coreXml :: CalendarTime -> Text -> L.ByteString coreXml created creator =- renderLBS def $ Document (Prologue [] Nothing []) root []+ renderLBS def{rsNamespaces=nss} $ Document (Prologue [] Nothing []) root [] where+ nss = [ ("cp", "http://schemas.openxmlformats.org/package/2006/metadata/core-properties")+ , ("dc", "http://purl.org/dc/elements/1.1/")+ , ("dcterms", "http://purl.org/dc/terms/")+ , ("xsi","http://www.w3.org/2001/XMLSchema-instance")+ ]+ namespaced = nsName nss date = T.pack $ formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" created- 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")- (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"]]+ root = Element (namespaced "cp" "coreProperties") M.empty+ [ nEl (namespaced "dcterms" "created")+ (M.fromList [(namespaced "xsi" "type", "dcterms:W3CDTF")]) [NodeContent date]+ , nEl (namespaced "dc" "creator") M.empty [NodeContent creator]+ , nEl (namespaced "cp" "lastModifiedBy") M.empty [NodeContent creator]+ ] -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>"+appXml :: Map Text Worksheet -> L.ByteString+appXml s = renderLBS def $ Document (Prologue [] Nothing []) root []+ where+ nsAttrs = M.fromList [("xmlns:vt", "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")]+ root = Element (extPropNm "Properties") nsAttrs+ [ extPropEl "TotalTime" [NodeContent "0"]+ , extPropEl "HeadingPairs" [+ vTypeEl "vector" (M.fromList [("size", "2"), ("baseType", "variant")])+ [ vTypeEl0 "variant"+ [vTypeEl0 "lpstr" [NodeContent "Worksheets"]]+ , vTypeEl0 "variant"+ [vTypeEl0 "i4" [NodeContent $ txti $ M.size s]]+ ]+ ]+ , extPropEl "TitlesOfParts" [+ vTypeEl "vector" (M.fromList [("size", txti $ M.size s),("baseType","lpstr")]) $+ map (vTypeEl0 "lpstr" . return . NodeContent) $ M.keys s+ ]+ ]+ extPropNm n = nm "http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" n+ extPropEl n = nEl (extPropNm n) M.empty+ vTypeEl0 n = vTypeEl n M.empty+ vTypeEl = nEl . nm "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes" data XlsxCellData = XlsxSS Int | XlsxDouble Double@@ -100,39 +133,27 @@ value XlsxCell{xlsxCellValue=Just(XlsxBool False)} = "0" value _ = error "value undefined" -collectSharedTransform :: Worksheet -> State [Text] [(Int, [(Int, XlsxCell)])]-collectSharedTransform ws = transformed+transformSheetData :: Vector Text -> Worksheet -> [(Int, [(Int, XlsxCell)])]+transformSheetData shared ws = map transformRow $ toRows (ws ^. wsCells) where- 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 (c, XlsxCell s (Just $ XlsxSS i))- Nothing -> do- put $ shared ++ [t]- return (c, XlsxCell s (Just $ XlsxSS (length shared)))- Just(CellDouble dbl) ->- return (c, XlsxCell s (Just $ XlsxDouble dbl))- Just(CellBool b) ->- return (c, XlsxCell s (Just $ XlsxBool b))- Nothing ->- return (c, XlsxCell s Nothing)+ transformRow = second (map transformCell)+ transformCell (c, Cell{_cellValue=v, _cellStyle=s}) =+ (c, XlsxCell s (fmap transformValue v))+ transformValue (CellText t) =+ let Just i = searchFromTo (\p -> shared V.! p >= t) 0 (V.length shared - 1)+ in XlsxSS i+ transformValue (CellDouble dbl) = XlsxDouble dbl+ transformValue (CellBool b) = XlsxBool b sheetXml :: [ColumnsWidth] -> Map Int RowProperties -> [(Int, [(Int, XlsxCell)])] -> [Text]-> L.ByteString sheetXml cws rh rows merges = renderLBS def $ Document (Prologue [] Nothing []) root [] where cType = xlsxCellType root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $- 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]+ Element "worksheet" M.empty $ catMaybes+ [nonEmptyNmEl "cols" M.empty $ map cwEl cws,+ justNmEl "sheetData" M.empty $ map rowEl rows,+ nonEmptyNmEl "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"@@ -197,6 +218,21 @@ map (\fd -> nEl "Override" (M.fromList [("PartName", T.concat ["/", fdName fd]), ("ContentType", fdContentType fd)]) []) fds +-- | fully qualified XML name+qName :: Text -> Text -> Text -> Name+qName n ns p =+ Name+ { nameLocalName = n+ , nameNamespace = Just ns+ , namePrefix = Just p+ }++-- | fully qualified XML name from prefix to ns URL mapping+nsName :: [(Text, Text)] -> Text -> Text -> Name+nsName nss p n = qName n ns p+ where+ ns = fromJust $ lookup p nss+ nm :: Text -> Text -> Name nm ns n = Name { nameLocalName = n@@ -208,6 +244,17 @@ where addNS' (NodeElement e) = NodeElement $ addNS namespace e addNS' n = n++-- | Creates an element with the given name, attributes and children,+-- if there is at least one child. Otherwise returns `Nothing`.+nonEmptyNmEl :: Name -> Map Name Text -> [Node] -> Maybe Node+nonEmptyNmEl _ _ [] = Nothing+nonEmptyNmEl name attrs nodes = justNmEl name attrs nodes++-- | Creates an element with the given name, attributes and children.+-- Always returns a node/`Just`.+justNmEl :: Name -> Map Name Text -> [Node] -> Maybe Node+justNmEl name attrs nodes = Just $ nEl name attrs nodes nEl :: Name -> Map Name Text -> [Node] -> Node nEl name attrs nodes = NodeElement $ Element name attrs nodes
src/Test.hs view
@@ -6,7 +6,7 @@ import Control.Lens import qualified Data.ByteString.Lazy as L import qualified Data.Map as M-import Data.Text (Text)+import Data.Text (Text,pack) import System.Time @@ -21,7 +21,68 @@ 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>"+\<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" xmlns:mc=\"http://schemas.openxmlformats.org/markup-compatibility/2006\" xmlns:x14ac=\"http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac\" mc:Ignorable=\"x14ac\">\+\ <numFmts count=\"1\">\+\ <numFmt numFmtId=\"164\" formatCode=\"yyyy/mm/dd\"/>\+\ </numFmts>\+\ <fonts count=\"2\" x14ac:knownFonts=\"1\">\+\ <font>\+\ <sz val=\"11\"/>\+\ <color theme=\"1\"/>\+\ <name val=\"Calibri\"/>\+\ <family val=\"2\"/>\+\ <scheme val=\"minor\"/>\+\ </font>\+\ <font>\+\ <b/>\+\ <sz val=\"11\"/>\+\ <color theme=\"1\"/>\+\ <name val=\"Calibri\"/>\+\ <family val=\"2\"/>\+\ <scheme val=\"minor\"/>\+\ </font>\+\ </fonts>\+\ <fills count=\"2\">\+\ <fill>\+\ <patternFill patternType=\"none\"/>\+\ </fill>\+\ <fill>\+\ <patternFill patternType=\"gray125\"/>\+\ </fill>\+\ </fills>\+\ <borders count=\"1\">\+\ <border>\+\ <left/>\+\ <right/>\+\ <top/>\+\ <bottom/>\+\ <diagonal/>\+\ </border>\+\ </borders>\+\ <cellStyleXfs count=\"1\">\+\ <xf numFmtId=\"0\" fontId=\"0\" fillId=\"0\" borderId=\"0\"/>\+\ </cellStyleXfs>\+\ <cellXfs count=\"5\">\+\ <xf numFmtId=\"0\" fontId=\"0\" fillId=\"0\" borderId=\"0\" xfId=\"0\"/>\+\ <xf numFmtId=\"0\" fontId=\"1\" fillId=\"0\" borderId=\"0\" xfId=\"0\" applyFont=\"1\"/>\+\ <xf numFmtId=\"164\" fontId=\"1\" fillId=\"0\" borderId=\"0\" xfId=\"0\" applyNumberFormat=\"1\" applyFont=\"1\"/>\+\ <xf numFmtId=\"0\" fontId=\"0\" fillId=\"0\" borderId=\"0\" xfId=\"0\" applyFont=\"1\"/>\+\ <xf numFmtId=\"2\" fontId=\"0\" fillId=\"0\" borderId=\"0\" xfId=\"0\" applyNumberFormat=\"1\" applyFont=\"1\"/>\+\ </cellXfs>\+\ <cellStyles count=\"1\">\+\ <cellStyle name=\"Normal\" xfId=\"0\" builtinId=\"0\"/>\+\ </cellStyles>\+\ <dxfs count=\"0\"/>\+\ <tableStyles count=\"0\" defaultTableStyle=\"TableStyleMedium2\" defaultPivotStyle=\"PivotStyleLight16\"/>\+\ <extLst>\+\ <ext xmlns:x14=\"http://schemas.microsoft.com/office/spreadsheetml/2009/9/main\" uri=\"{EB79DEF2-80B8-43e5-95BD-54CBDDF9020C}\">\+\ <x14:slicerStyles defaultSlicerStyle=\"SlicerStyleLight1\"/>\+\ </ext>\+\ <ext xmlns:x15=\"http://schemas.microsoft.com/office/spreadsheetml/2010/11/main\" uri=\"{9260A510-F301-46a8-8635-F512D64BE5F5}\">\+\ <x15:timelineStyles defaultTimelineStyle=\"TimeSlicerStyleLight1\"/>\+\ </ext>\+\ </extLst>\+\</styleSheet>" main :: IO () main = do@@ -33,11 +94,11 @@ 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"]+ cells = M.fromList [((r, c), v) | r <- [1..10000], (c, v) <- zip [1..] (row r) ]+ row r = [ xText $ pack $ "column1-r" ++ show r+ , xText $ pack $ "column2-r" ++ show r+ , xEmpty+ , xText $ pack $ "column4-r" ++ show r+ , xDouble 42.12345+ , xText "False"] sheets = M.fromList [("List", Worksheet cols rowProps cells [])] -- wtf merges?
xlsx.cabal view
@@ -1,6 +1,6 @@ Name: xlsx -Version: 0.1.0.3+Version: 0.1.0.4 Synopsis: Simple and incomplete Excel file parser/writer Description:@@ -53,6 +53,8 @@ , old-time >= 1.1.0.1 , old-locale >= 1.0.0.5 , data-default == 0.5.*+ , vector >= 0.10+ , binary-search Default-Language: Haskell2010 @@ -78,6 +80,8 @@ , old-time , old-locale , data-default == 0.5.*+ , vector >= 0.10+ , binary-search Default-Language: Haskell2010 test-suite data-test