packages feed

xlsx 0.2.1.2 → 0.2.2

raw patch · 20 files changed

+1047/−540 lines, 20 filesdep +base64-bytestringdep +extradep +filepathdep ~basedep ~bytestringdep ~containers

Dependencies added: base64-bytestring, extra, filepath, network-uri, raw-strings-qq, safe, unordered-containers

Dependency ranges changed: base, bytestring, containers, digest, old-locale, text, time, transformers, utf8-string, zlib

Files

CHANGELOG.markdown view
@@ -1,3 +1,8 @@+0.2.2+-----+* added cell comments support+* added custom file properties+ 0.2.1.2 ------- * loosened dependency on data-default package
src/Codec/Xlsx/Formatted.hs view
@@ -53,15 +53,15 @@  stateFromStyleSheet :: StyleSheet -> FormattingState stateFromStyleSheet StyleSheet{..} = FormattingState{-      _formattingBorders = fromList _styleSheetBorders-    , _formattingCellXfs = fromList _styleSheetCellXfs-    , _formattingFills   = fromList _styleSheetFills-    , _formattingFonts   = fromList _styleSheetFonts+      _formattingBorders = fromValueList _styleSheetBorders+    , _formattingCellXfs = fromValueList _styleSheetCellXfs+    , _formattingFills   = fromValueList _styleSheetFills+    , _formattingFonts   = fromValueList _styleSheetFonts     , _formattingMerges  = []     }   where-    fromList :: Ord a => [a] -> Map a Int-    fromList = Map.fromList . (`zip` [0..])+    fromValueList :: Ord a => [a] -> Map a Int+    fromValueList = Map.fromList . (`zip` [0..])  stateToStyleSheet :: FormattingState -> StyleSheet stateToStyleSheet FormattingState{..} = StyleSheet{@@ -191,7 +191,7 @@     go :: ((Int, Int), FormattedCell) -> State FormattingState ((Int, Int), Cell)     go (pos, c) = do       styleId <- cellStyleId c-      return (pos, Cell styleId (_formattedValue c))+      return (pos, Cell styleId (_formattedValue c) Nothing)  -- | Cell block corresponding to a single 'FormattedCell' --
src/Codec/Xlsx/Parser.hs view
@@ -1,43 +1,49 @@ {-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE TupleSections             #-} -- | This module provides a function for reading .xlsx files module Codec.Xlsx.Parser     ( toXlsx     ) where -import qualified Codec.Archive.Zip as Zip+import qualified Codec.Archive.Zip                           as Zip import           Control.Applicative-import           Control.Arrow ((&&&))-import           Control.Monad.IO.Class()-import qualified Data.ByteString.Lazy as L-import           Data.ByteString.Lazy.Char8()+import           Control.Arrow                               ((&&&))+import           Control.Monad.IO.Class                      ()+import qualified Data.ByteString.Lazy                        as L+import           Data.ByteString.Lazy.Char8                  () import           Data.List-import qualified Data.Map as M+import qualified Data.Map                                    as M import           Data.Maybe import           Data.Ord-import           Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Read as T-import           Data.XML.Types-import           Prelude hiding (sequence)-import           Text.XML as X+import           Data.Text                                   (Text)+import qualified Data.Text                                   as T+import qualified Data.Text.Read                              as T+import           Prelude                                     hiding (sequence)+import           Safe+import           System.FilePath.Posix+import           Text.XML                                    as X import           Text.XML.Cursor  import           Codec.Xlsx.Parser.Internal import           Codec.Xlsx.Types-import           Codec.Xlsx.Types.SharedStringTable+import           Codec.Xlsx.Types.Internal+import           Codec.Xlsx.Types.Internal.Relationships     as Relationships+import           Codec.Xlsx.Types.Internal.SharedStringTable+import           Codec.Xlsx.Types.Internal.CustomProperties+import           Codec.Xlsx.Types.Internal.CustomProperties  as CustomProperties   -- | Reads `Xlsx' from raw data (lazy bytestring) toXlsx :: L.ByteString -> Xlsx-toXlsx bs = Xlsx sheets styles names+toXlsx bs = Xlsx sheets styles names customPropMap   where     ar = Zip.toArchive bs     sst = getSharedStrings ar     styles = getStyles ar     (wfs, names) = readWorkbook ar     sheets = M.fromList $ map (wfName &&& extractSheet ar sst) wfs+    CustomProperties customPropMap = getCustomProperties ar  data WorksheetFile = WorksheetFile { wfName :: Text                                    , wfPath :: FilePath@@ -62,6 +68,11 @@       [] -> Nothing       views -> Just views +    commentsMap = getComments ar . relTarget =<< findRelByType commentsType sheetRels+    commentsType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"++    sheetRels = getRels ar (wfPath wf)+     -- Likewise, @pageSetup@ also occurs either 0 or 1 times     pageSetup = listToMaybe $ cur $/ element (n"pageSetup") >=> fromCursor @@ -82,12 +93,14 @@       return (r, rp, c $/ element (n"c") >=> parseCell)     parseCell :: Cursor -> [(Int, Int, Cell)]     parseCell cell = do+      ref <- cell $| attribute "r"       let         s = listToMaybe $ cell $| attribute "s" >=> decimal         t = fromMaybe "n" $ listToMaybe $ cell $| attribute "t"         d = listToMaybe $ cell $/ element (n"v") &/ content >=> extractCellValue sst t-      (c, r) <- T.span (>'9') <$> (cell $| attribute "r")-      return (int r, col2int c, Cell s d)+        (c, r) = T.span (>'9') ref+        comment = commentsMap >>= lookupComment ref+      return (int r, col2int c, Cell s d comment)     collect = foldr collectRow (M.empty, M.empty)     collectRow (_, Nothing, rowCells) (rowMap, cellMap) =       (rowMap, foldr collectCell cellMap rowCells)@@ -105,8 +118,8 @@     case T.decimal v of       Right (d, _) ->         case sstItem sst d of-          StringItemText txt  -> [CellText txt]-          StringItemRich rich -> [CellRich rich]+          XlsxText     txt  -> [CellText txt]+          XlsxRichText rich -> [CellRich rich]       _ ->         [] extractCellValue _ "str" str = [CellText str]@@ -118,22 +131,6 @@ extractCellValue _ "b" "0" = [CellBool False] extractCellValue _ _ _ = [] --- | 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-  }---- | 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 xml cursor from the specified file inside the zip archive. xmlCursor :: Zip.Archive -> FilePath -> Maybe Cursor xmlCursor ar fname = parse <$> Zip.findEntryByPath fname ar@@ -155,32 +152,49 @@   Nothing  -> Styles L.empty   Just xml -> Styles xml +getComments :: Zip.Archive -> FilePath -> Maybe CommentsTable+getComments ar fp = listToMaybe =<< fromCursor <$> xmlCursor ar fp++getCustomProperties :: Zip.Archive -> CustomProperties+getCustomProperties ar = case fromCursor <$> xmlCursor ar "docProps/custom.xml" of+    Just [cp] -> cp+    _   -> CustomProperties.empty+ -- | readWorkbook pulls the names of the sheets and the defined names readWorkbook :: Zip.Archive -> ([WorksheetFile], DefinedNames)-readWorkbook ar = case xmlCursor ar "xl/workbook.xml" of+readWorkbook ar = case xmlCursor ar wbPath of   Nothing ->     error "invalid workbook"   Just c ->     let-        sheetData = c $/ element (n"sheets") &/ element (n"sheet") >=>-                    liftA2 (,) <$> attribute "name" <*> attribute (odr"id")-        wbRels = getWbRels ar+        sheets = c $/ element (n"sheets") &/ element (n"sheet") >=>+                    liftA2 (worksheetFile wbRels) <$> attribute "name" <*> (attribute (odr"id") &| RefId)+        wbRels = getRels ar wbPath         names = c $/ element (n"definedNames") &/ element (n"definedName") >=> mkDefinedName-    in ([WorksheetFile name ("xl/" ++ T.unpack (fromJust $ lookup rId wbRels)) | (name, rId) <- sheetData]-       ,DefinedNames names)- where-  -- Specification says the 'name' is required.-  mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]-  mkDefinedName c = return ( head $ attribute "name" c-                           , listToMaybe $ attribute "localSheetId" c-                           , T.concat $ c $/ content-                           )+    in (sheets, DefinedNames names)+  where+    wbPath = "xl/workbook.xml"+    -- Specification says the 'name' is required.+    mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]+    mkDefinedName c = return ( head $ attribute "name" c+                             , listToMaybe $ attribute "localSheetId" c+                             , T.concat $ c $/ content+                             ) -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"+worksheetFile :: Relationships -> Text -> RefId -> WorksheetFile+worksheetFile wbRels name rId = WorksheetFile name path+  where+    path = relTarget . fromJustNote "sheet path" $ Relationships.lookup rId wbRels++getRels :: Zip.Archive -> FilePath -> Relationships+getRels ar fp =+    let (dir, file) = splitFileName fp+        relsPath = dir </> "_rels" </> file <.> "rels"+    in case xmlCursor ar relsPath of+        Nothing ->+            Relationships.empty+        Just c  ->+            let [rels] = fromCursor c in setTargetsFrom fp rels  int :: Text -> Int int = either error fst . T.decimal
src/Codec/Xlsx/Parser/Internal.hs view
@@ -14,6 +14,7 @@     , readFailure     , invalidText     , defaultReadFailure+    , boolean     , decimal     , rational     ) where@@ -107,9 +108,15 @@ decimal :: Monad m => Text -> m Int decimal t = case T.decimal t of   Right (d, _) -> return d-  _ -> fail "invalid decimal"+  _ -> fail $ "invalid decimal" ++ show t  rational :: Monad m => Text -> m Double rational t = case T.rational t of   Right (r, _) -> return r-  _ -> fail "invalid rational"+  _ -> fail $ "invalid rational: " ++ show t++boolean :: Monad m => Text -> m Bool+boolean t = case T.strip t of+    "true"  -> return True+    "false" -> return False+    _       -> fail $ "invalid boolean: " ++ show t
src/Codec/Xlsx/Types.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Xlsx.Types-    ( Xlsx(..), xlSheets, xlStyles, xlDefinedNames+    ( Xlsx(..), xlSheets, xlStyles, xlDefinedNames, xlCustomProperties     , def     , Styles(..)     , emptyStyles@@ -15,7 +15,7 @@     , Worksheet(..), wsColumns, wsRowPropertiesMap, wsCells, wsMerges, wsSheetViews, wsPageSetup     , CellMap     , CellValue(..)-    , Cell(..), cellValue, cellStyle+    , Cell(..), cellValue, cellStyle, cellComment     , RowProperties (..)     , Range     , int2col@@ -42,11 +42,13 @@ import           Text.XML.Cursor  import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.Comments as X import           Codec.Xlsx.Types.Common as X import           Codec.Xlsx.Types.PageSetup as X import           Codec.Xlsx.Types.RichText as X import           Codec.Xlsx.Types.SheetViews as X import           Codec.Xlsx.Types.StyleSheet as X+import           Codec.Xlsx.Types.Variant as X import           Codec.Xlsx.Writer.Internal  -- | Cell values include text, numbers and booleans,@@ -63,14 +65,15 @@ -- (e.g. formulas from @\<f\>@ and inline strings from @\<is\>@ -- subelements are ignored) data Cell = Cell-    { _cellStyle  :: Maybe Int-    , _cellValue  :: Maybe CellValue+    { _cellStyle   :: Maybe Int+    , _cellValue   :: Maybe CellValue+    , _cellComment :: Maybe  Comment     } deriving (Eq, Show)  makeLenses ''Cell  instance Default Cell where-    def = Cell Nothing Nothing+    def = Cell Nothing Nothing Nothing  -- | Map containing cell values which are indexed by row and column -- if you need to use more traditional (x,y) indexing please you could@@ -119,9 +122,10 @@  -- | Structured representation of Xlsx file (currently a subset of its contents) data Xlsx = Xlsx-    { _xlSheets       :: Map Text Worksheet-    , _xlStyles       :: Styles-    , _xlDefinedNames :: DefinedNames+    { _xlSheets           :: Map Text Worksheet+    , _xlStyles           :: Styles+    , _xlDefinedNames     :: DefinedNames+    , _xlCustomProperties :: Map Text Variant     } deriving (Eq, Show)  -- | Defined names@@ -151,7 +155,7 @@ makeLenses ''Xlsx  instance Default Xlsx where-    def = Xlsx M.empty emptyStyles def+    def = Xlsx M.empty emptyStyles def M.empty  instance Default DefinedNames where     def = DefinedNames []
+ src/Codec/Xlsx/Types/Comments.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module Codec.Xlsx.Types.Comments where++import Data.List.Extra (nubOrd)+import qualified Data.Map                   as Map+import qualified Data.HashMap.Strict        as HM+import           Data.Text                  (Text)+import           Data.Text.Lazy (toStrict)+import qualified Data.Text.Lazy.Builder  as B+import qualified Data.Text.Lazy.Builder.Int as B+import           Safe+import           Text.XML+import           Text.XML.Cursor++import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.Common+import           Codec.Xlsx.Writer.Internal+++-- | User comment for a cell+--+-- TODO: the following child elements:+-- * guid+-- * shapeId+-- * commentPr+--+-- Section 18.7.3 "comment (Comment)" (p. 1749)+data Comment = Comment {+    -- | cell comment text, maybe formatted+    -- Section 18.7.7 "text (Comment Text)" (p. 1754)+    _commentText   :: XlsxText+    -- | comment author+    , _commentAuthor :: Text }+    deriving (Show, Eq)++newtype CommentsTable = CommentsTable+    { _commentsTable :: HM.HashMap CellRef Comment }+    deriving (Show, Eq)++fromList :: [(CellRef, Comment)] -> CommentsTable+fromList = CommentsTable . HM.fromList++lookupComment :: CellRef -> CommentsTable -> Maybe Comment+lookupComment ref = HM.lookup ref . _commentsTable++instance ToDocument CommentsTable where+  toDocument = documentFromElement "Sheet comments generated by xlsx"+             . toElement "comments"++instance ToElement CommentsTable where+  toElement nm (CommentsTable m) = Element+      { elementName       = nm+      , elementAttributes = Map.empty+      , elementNodes      = [ NodeElement $ elementListSimple "authors" authorNodes+                            , NodeElement . elementListSimple "commentList" $ map commentToEl (HM.toList m) ]+      }+    where+      commentToEl (ref, Comment{..}) = Element+          { elementName = "comment"+          , elementAttributes = Map.fromList [ ("ref", ref)+                                             , ("authorId", lookupAuthor _commentAuthor)]+          , elementNodes      = [NodeElement $ toElement "text" _commentText]+          }+      lookupAuthor a = fromJustNote "author lookup" $ HM.lookup a authorIds+      authorNames = nubOrd . map _commentAuthor $ HM.elems m+      decimalToText :: Integer -> Text+      decimalToText = toStrict . B.toLazyText . B.decimal+      authorIds = HM.fromList $ zip authorNames (map decimalToText [0..])+      authorNodes = map (elementContent "author") authorNames++instance FromCursor CommentsTable where+  fromCursor cur = do+    let authorNames = cur $/ element (n"authors") &/ element (n"author") &/ content+        authors = HM.fromList $ zip [0..] authorNames+        items = cur $/ element (n"commentList") &/ element (n"comment") >=> parseComment authors+    return . CommentsTable $ HM.fromList items++parseComment :: HM.HashMap Int Text -> Cursor -> [(CellRef, Comment)]+parseComment authors cur = do+    ref <- cur $| attribute "ref"+    txt <- cur $/ element (n"text") >=> fromCursor+    authorId <- cur $| attribute "authorId" >=> decimal+    let author = fromJustNote "authorId" $ HM.lookup authorId authors+    return (ref, Comment txt author)
src/Codec/Xlsx/Types/Common.hs view
@@ -1,9 +1,78 @@+{-# LANGUAGE OverloadedStrings  #-} module Codec.Xlsx.Types.Common        ( CellRef+       , XlsxText (..)        ) where -import Data.Text (Text)+import qualified Data.Map                   as Map+import           Data.Text                  (Text)+import           Text.XML+import           Text.XML.Cursor +import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.RichText+import           Codec.Xlsx.Writer.Internal++ -- | Excel cell reference (e.g. @E3@) -- see 18.18.62 @ST_Ref@ (p. 2482) type CellRef = Text++-- | Common type containing either simple string or rich formatted text.+-- Used in @si@, @comment@ and @is@ elements+--+-- E.g. @si@ spec says: "If the string is just a simple string with formatting applied+-- at the cell level, then the String Item (si) should contain a single text+-- element used to express the string. However, if the string in the cell is+-- more complex - i.e., has formatting applied at the character level - then the+-- string item shall consist of multiple rich text runs which collectively are+-- used to express the string.". So we have either a single "Text" field, or+-- else a list of "RichTextRun"s, each of which is some "Text" with layout+-- properties.+--+-- TODO: Currently we do not support @phoneticPr@ (Phonetic Properties, 18.4.3,+-- p. 1723) or @rPh@ (Phonetic Run, 18.4.6, p. 1725).+--+-- Section 18.4.8, "si (String Item)" (p. 1725)+--+-- See @CT_Rst@, p. 3903+data XlsxText = XlsxText Text+              | XlsxRichText [RichTextRun]+              deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+  Rendering+-------------------------------------------------------------------------------}++-- | See @CT_Rst@, p. 3903+instance ToElement XlsxText where+  toElement nm si = Element {+      elementName       = nm+    , elementAttributes = Map.empty+    , elementNodes      = map NodeElement $+        case si of+          XlsxText text     -> [elementContent "t" text]+          XlsxRichText rich -> map (toElement "r") rich+    }++{-------------------------------------------------------------------------------+  Parsing+-------------------------------------------------------------------------------}++-- | See @CT_Rst@, p. 3903+instance FromCursor XlsxText where+  fromCursor cur = do+    let+      ts = cur $/ element (n"t") >=> contentOrEmpty+      contentOrEmpty c = case c $/ content of+        [t] -> [t]+        []  -> [""]+        _   -> error "invalid item: more than one text nodes under <t>!"+      rs = cur $/ element (n"r") >=> fromCursor+    case (ts,rs) of+      ([t], []) ->+        return $ XlsxText t+      ([], _:_) ->+        return $ XlsxRichText rs+      _ ->+        fail "invalid item"
+ src/Codec/Xlsx/Types/Internal.hs view
@@ -0,0 +1,10 @@+module Codec.Xlsx.Types.Internal where++import           Data.Text (Text)++import Codec.Xlsx.Writer.Internal++newtype RefId = RefId { unRefId :: Text } deriving (Show, Eq, Ord)++instance ToAttrVal RefId where+  toAttrVal = toAttrVal . unRefId
+ src/Codec/Xlsx/Types/Internal/CustomProperties.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}+module Codec.Xlsx.Types.Internal.CustomProperties where++import           Data.Map                   (Map)+import qualified Data.Map                   as M+import           Data.Text                  (Text)+import           Text.XML+import           Text.XML.Cursor++import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.Variant+import           Codec.Xlsx.Writer.Internal++newtype CustomProperties = CustomProperties (Map Text Variant)+    deriving (Show, Eq)++fromList :: [(Text, Variant)] -> CustomProperties+fromList = CustomProperties . M.fromList++empty :: CustomProperties+empty = CustomProperties M.empty++{-------------------------------------------------------------------------------+  Parsing+-------------------------------------------------------------------------------}++instance FromCursor CustomProperties where+  fromCursor cur = do+    let items = cur $/ element (cpr"property") >=> parseCustomPropertyEntry+    return (fromList items)++parseCustomPropertyEntry :: Cursor -> [(Text, Variant)]+parseCustomPropertyEntry cur = do+  name <- attribute "name" cur+  value <- cur $/ anyElement >=> fromCursor+  return (name, value)++-- | Add custom properties namespace to name+cpr :: Text -> Name+cpr x = Name+  { nameLocalName = x+  , nameNamespace = Just custPropNs+  , namePrefix = Nothing+  }++custPropNs :: Text+custPropNs = "http://schemas.openxmlformats.org/officeDocument/2006/custom-properties"++{-------------------------------------------------------------------------------+  Rendering+-------------------------------------------------------------------------------}++instance ToDocument CustomProperties where+    toDocument =+        documentFromNsElement "Custom properties generated by xlsx"+        "http://schemas.openxmlformats.org/officeDocument/2006/custom-properties"+        . toElement "Properties"++instance ToElement CustomProperties where+    toElement nm (CustomProperties m) = Element+        { elementName       = nm+        , elementAttributes = M.empty+        , elementNodes      = map (NodeElement . toElement "property" . CustomProperty)+                              . zip [2..] $ M.toList m+        }++newtype CustomProperty = CustomProperty (Int, (Text, Variant))++instance ToElement CustomProperty where+    toElement nm (CustomProperty (i, (key, val))) = Element+        { elementName       = nm+        , elementAttributes = M.fromList [ "name"  .= key+                                         , "fmtid" .= userDefinedFmtID+                                         , "pid"   .= txti i ]+        , elementNodes      = [ NodeElement $ variantToElement val ]+        }++-- | FMTID_UserDefinedProperties+userDefinedFmtID :: Text+userDefinedFmtID = "{D5CDD505-2E9C-101B-9397-08002B2CF9AE}"
+ src/Codec/Xlsx/Types/Internal/Relationships.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+module Codec.Xlsx.Types.Internal.Relationships where++import           Data.List                  (find)+import           Data.Map                   (Map)+import qualified Data.Map                   as Map+import           Data.Monoid                ((<>))+import           Data.Text                  (Text)+import qualified Data.Text                  as T+import           Network.URI                hiding (path)+import           Prelude                    hiding (abs, lookup)+import           Safe+import           Text.XML+import           Text.XML.Cursor++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative+#endif++import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.Internal+import           Codec.Xlsx.Writer.Internal++data Relationship = Relationship+    { relType   :: Text+    , relTarget :: FilePath+    } deriving (Show, Eq)++-- | Describes relationships according to Open Packaging Convention+--+-- See ECMA-376, 4th Edition Office Open XML File Formats — Open Packaging+-- Conventions+newtype Relationships = Relationships+    { relMap :: Map RefId Relationship+    } deriving (Show, Eq)++fromList :: [(RefId, Relationship)] -> Relationships+fromList = Relationships . Map.fromList++empty :: Relationships+empty = fromList []++relEntry :: Int -> Text -> FilePath -> (RefId, Relationship)+relEntry i typ trg = (RefId ("rId" <> txti i), Relationship (stdRelType typ) trg)++lookup :: RefId -> Relationships -> Maybe Relationship+lookup ref = Map.lookup ref . relMap++setTargetsFrom :: FilePath -> Relationships -> Relationships+setTargetsFrom fp (Relationships m) = Relationships (Map.map fixPath m)+    where+        fixPath rel = rel{ relTarget = fp `joinRel` relTarget rel}++-- | joins relative URI (actually a file path as an internal relation target)+joinRel :: FilePath -> FilePath -> FilePath+joinRel abs rel = uriToString id (relPath `nonStrictRelativeTo` base) ""+  where+    base = fromJustNote "joinRel base path" $ parseURIReference abs+    relPath = fromJustNote "joinRel relative path" $ parseURIReference rel+++findRelByType :: Text -> Relationships -> Maybe Relationship+findRelByType t (Relationships m) = find ((==t) . relType) (Map.elems m)++{-------------------------------------------------------------------------------+  Rendering+-------------------------------------------------------------------------------}++instance ToDocument Relationships where+  toDocument = documentFromNsElement "Relationships generated by xlsx" pkgRelNs+               . toElement "Relationships"++instance ToElement Relationships where+  toElement nm Relationships{..} = Element+      { elementName       = nm+      , elementAttributes = Map.empty+      , elementNodes      = map (NodeElement . relToEl "Relationship") $+                            Map.toList relMap+      }+    where+      relToEl nm' (relId, rel) = setAttr "Id" relId (toElement nm' rel)++instance ToElement Relationship where+  toElement nm Relationship{..} = Element+      { elementName       = nm+      , elementAttributes = Map.fromList [ "Target" .= relTarget+                                         , "Type"   .= relType ]+      , elementNodes      = []+      }++{-------------------------------------------------------------------------------+  Parsing+-------------------------------------------------------------------------------}+instance FromCursor Relationships where+  fromCursor cur = do+    let items = cur $/ element (pr"Relationship") >=> parseRelEntry+    return . Relationships $ Map.fromList items++parseRelEntry :: Cursor -> [(RefId, Relationship)]+parseRelEntry cur = do+  rel <- fromCursor cur+  rId <- attribute "Id" cur+  return (RefId rId, rel)++instance FromCursor Relationship where+  fromCursor cur =  do+    ty <- attribute "Type" cur+    trg <- T.unpack <$> attribute "Target" cur+    return $ Relationship ty trg++-- | Add package relationship namespace to name+pr :: Text -> Name+pr x = Name+  { nameLocalName = x+  , nameNamespace = Just pkgRelNs+  , namePrefix = Nothing+  }++-- | Add office document relationship namespace to name+odr :: Text -> Name+odr x = Name+  { nameLocalName = x+  , nameNamespace = Just odRelNs+  , namePrefix = Nothing+  }++odRelNs :: Text+odRelNs = "http://schemas.openxmlformats.org/officeDocument/2006/relationships"++pkgRelNs :: Text+pkgRelNs = "http://schemas.openxmlformats.org/package/2006/relationships"++stdRelType :: Text -> Text+stdRelType t = stdPart <> t+  where+    stdPart = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/"
+ src/Codec/Xlsx/Types/Internal/SharedStringTable.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# OPTIONS_GHC -Wall #-}+module Codec.Xlsx.Types.Internal.SharedStringTable (+    -- * Main types+    SharedStringTable(..)+  , sstConstruct+  , sstLookupText+  , sstLookupRich+  , sstItem+  ) where++import           Control.Monad++import           Data.Maybe (mapMaybe)+import           Data.Text (Text)+import           Data.Vector (Vector)+import           Numeric.Search.Range (searchFromTo)+import           Text.XML+import           Text.XML.Cursor+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Vector as V++import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types+import           Codec.Xlsx.Writer.Internal++-- | Shared string table+--+-- A workbook can contain thousands of cells containing string (non-numeric)+-- data. Furthermore this data is very likely to be repeated across many rows or+-- columns. The goal of implementing a single string table that is shared across+-- the workbook is to improve performance in opening and saving the file by only+-- reading and writing the repetitive information once.+--+-- Relevant parts of the EMCA standard (2nd edition, part 1,+-- <http://www.ecma-international.org/publications/standards/Ecma-376.htm>),+-- page numbers refer to the page in the PDF rather than the page number as+-- printed on the page):+--+-- * Section 18.4, "Shared String Table" (p. 1712)+--   in particular subsection 18.4.9, "sst (Shared String Table)" (p. 1726)+--+-- TODO: The @extLst@ child element is currently unsupported.+newtype SharedStringTable = SharedStringTable {+    sstTable :: Vector XlsxText+  }+  deriving (Show, Eq, Ord)++{-------------------------------------------------------------------------------+  Rendering+-------------------------------------------------------------------------------}++instance ToDocument SharedStringTable where+  toDocument = documentFromElement "Shared string table generated by xlsx"+             . toElement "sst"++-- | See @CT_Sst@, p. 3902.+--+-- TODO: The @count@ and @uniqCount@ attributes are currently unsupported.+instance ToElement SharedStringTable where+  toElement nm SharedStringTable{..} = Element {+      elementName       = nm+    , elementAttributes = Map.empty+    , elementNodes      = map (NodeElement . toElement "si")+                        $ V.toList sstTable+    }++{-------------------------------------------------------------------------------+  Parsing+-------------------------------------------------------------------------------}++-- | See @CT_Sst@, p. 3902+--+-- The optional attributes @count@ and @uniqCount@ are being ignored at least currently+instance FromCursor SharedStringTable where+  fromCursor cur = do+    let+      items = cur $/ element (n"si") >=> fromCursor+    return (SharedStringTable (V.fromList items))++{-------------------------------------------------------------------------------+  Extract shared strings+-------------------------------------------------------------------------------}++-- | Construct the 'SharedStringsTable' from an existing document+sstConstruct :: [Worksheet] -> SharedStringTable+sstConstruct =+    SharedStringTable . V.fromList . uniq . concatMap goSheet+  where+    goSheet :: Worksheet -> [XlsxText]+    goSheet = mapMaybe (_cellValue >=> sstEntry) . Map.elems . _wsCells++    sstEntry :: CellValue -> Maybe XlsxText+    sstEntry (CellText text) = Just $ XlsxText text+    sstEntry (CellRich rich) = Just $ XlsxRichText rich+    sstEntry _               = Nothing++    uniq :: Ord a => [a] -> [a]+    uniq = Set.elems . Set.fromList++sstLookupText :: SharedStringTable -> Text -> Int+sstLookupText sst = sstLookup sst . XlsxText++sstLookupRich :: SharedStringTable -> [RichTextRun] -> Int+sstLookupRich sst = sstLookup sst . XlsxRichText++-- | Internal generalization used by 'sstLookupText' and 'sstLookupRich'+sstLookup :: SharedStringTable -> XlsxText -> Int+sstLookup SharedStringTable{sstTable = shared} si =+    case searchFromTo (\p -> shared V.! p >= si) 0 (V.length shared - 1) of+      Just i  -> i+      Nothing -> error $ "SST entry for " ++ show si ++ " not found"++sstItem :: SharedStringTable -> Int -> XlsxText+sstItem (SharedStringTable shared) = (V.!) shared
src/Codec/Xlsx/Types/RichText.hs view
@@ -221,7 +221,7 @@     , elementAttributes = Map.empty     , elementNodes      = map NodeElement . catMaybes $ [           toElement "rPr" <$> _richTextRunProperties-        , Just $ elementContent "t" _richTextRunText+        , Just $ elementContentPreserved "t" _richTextRunText         ]     } 
− src/Codec/Xlsx/Types/SharedStringTable.hs
@@ -1,181 +0,0 @@-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}-{-# LANGUAGE TemplateHaskell    #-}-{-# OPTIONS_GHC -Wall #-}-module Codec.Xlsx.Types.SharedStringTable (-    -- * Main types-    SharedStringTable(..)-  , StringItem(..)-  , sstConstruct-  , sstLookupText-  , sstLookupRich-  , sstItem-    -- * Lenses-    -- ** SharedStringTable-  , sharedStringTable-  ) where--import           Control.Lens hiding (element)-import           Control.Monad--import           Data.Maybe (mapMaybe)-import           Data.Text (Text)-import           Data.Vector (Vector)-import           Numeric.Search.Range (searchFromTo)-import           Text.XML-import           Text.XML.Cursor-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified Data.Vector as V--import           Codec.Xlsx.Parser.Internal-import           Codec.Xlsx.Types-import           Codec.Xlsx.Writer.Internal---- | Shared string table------ A workbook can contain thousands of cells containing string (non-numeric)--- data. Furthermore this data is very likely to be repeated across many rows or--- columns. The goal of implementing a single string table that is shared across--- the workbook is to improve performance in opening and saving the file by only--- reading and writing the repetitive information once.------ Relevant parts of the EMCA standard (2nd edition, part 1,--- <http://www.ecma-international.org/publications/standards/Ecma-376.htm>),--- page numbers refer to the page in the PDF rather than the page number as--- printed on the page):------ * Section 18.4, "Shared String Table" (p. 1712)---   in particular subsection 18.4.9, "sst (Shared String Table)" (p. 1726)------ TODO: The @extLst@ child element is currently unsupported.-data SharedStringTable = SharedStringTable {-    _sharedStringTable :: Vector StringItem-  }-  deriving (Show, Eq, Ord)---- | String Item------ This element is the representation of an individual string in the Shared--- String table.------ The spec says: "If the string is just a simple string with formatting applied--- at the cell level, then the String Item (si) should contain a single text--- element used to express the string. However, if the string in the cell is--- more complex - i.e., has formatting applied at the character level - then the--- string item shall consist of multiple rich text runs which collectively are--- used to express the string.". So we have either a single "Text" field, or--- else a list of "RichTextRun"s, each of which is some "Text" with layout--- properties.------ TODO: Currently we do not support @phoneticPr@ (Phonetic Properties, 18.4.3,--- p. 1723) or @rPh@ (Phonetic Run, 18.4.6, p. 1725).------ Section 18.4.8, "si (String Item)" (p. 1725)-data StringItem =-    StringItemText Text-  | StringItemRich [RichTextRun]-  deriving (Show, Eq, Ord)--{--------------------------------------------------------------------------------  Lenses--------------------------------------------------------------------------------}--makeLenses ''SharedStringTable--{--------------------------------------------------------------------------------  Rendering--------------------------------------------------------------------------------}--instance ToDocument SharedStringTable where-  toDocument = documentFromElement "Shared string table generated by xlsx"-             . toElement "sst"---- | See @CT_Sst@, p. 3902.------ TODO: The @count@ and @uniqCount@ attributes are currently unsupported.-instance ToElement SharedStringTable where-  toElement nm SharedStringTable{..} = Element {-      elementName       = nm-    , elementAttributes = Map.empty-    , elementNodes      = map (NodeElement . toElement "si")-                        $ V.toList _sharedStringTable-    }---- | See @CT_Rst@, p. 3903-instance ToElement StringItem where-  toElement nm si = Element {-      elementName       = nm-    , elementAttributes = Map.empty-    , elementNodes      = map NodeElement $-        case si of-          StringItemText text -> [elementContent "t" text]-          StringItemRich rich -> map (toElement "r") rich-    }--{--------------------------------------------------------------------------------  Parsing--------------------------------------------------------------------------------}---- | See @CT_Sst@, p. 3902------ The optional attributes @count@ and @uniqCount@ are being ignored at least currently-instance FromCursor SharedStringTable where-  fromCursor cur = do-    let-      items = cur $/ element (n"si") >=> fromCursor-    return (SharedStringTable (V.fromList items))---- | See @CT_Rst@, p. 3903-instance FromCursor StringItem where-  fromCursor cur = do-    let-      ts = cur $/ element (n"t") >=> contentOrEmpty-      contentOrEmpty c = case c $/ content of-        [t] -> [t]-        []  -> [""]-        _   -> error "invalid item: more than one text nodes under <t>!"-      rs = cur $/ element (n"r") >=> fromCursor-    case (ts,rs) of-      ([t], []) ->-        return $ StringItemText t-      ([], _:_) ->-        return $ StringItemRich rs-      _ ->-        fail "invalid item"--{--------------------------------------------------------------------------------  Extract shared strings--------------------------------------------------------------------------------}---- | Construct the 'SharedStringsTable' from an existing document-sstConstruct :: [Worksheet] -> SharedStringTable-sstConstruct =-    SharedStringTable . V.fromList . uniq . concatMap goSheet-  where-    goSheet :: Worksheet -> [StringItem]-    goSheet = mapMaybe (_cellValue >=> sstEntry) . Map.elems . _wsCells--    sstEntry :: CellValue -> Maybe StringItem-    sstEntry (CellText text) = Just $ StringItemText text-    sstEntry (CellRich rich) = Just $ StringItemRich rich-    sstEntry _               = Nothing--    uniq :: Ord a => [a] -> [a]-    uniq = Set.elems . Set.fromList--sstLookupText :: SharedStringTable -> Text -> Int-sstLookupText sst = sstLookup sst . StringItemText--sstLookupRich :: SharedStringTable -> [RichTextRun] -> Int-sstLookupRich sst = sstLookup sst . StringItemRich---- | Internal generalization used by 'sstLookupText' and 'sstLookupRich'-sstLookup :: SharedStringTable -> StringItem -> Int-sstLookup SharedStringTable{_sharedStringTable = shared} si =-    case searchFromTo (\p -> shared V.! p >= si) 0 (V.length shared - 1) of-      Just i  -> i-      Nothing -> error $ "SST entry for " ++ show si ++ " not found"--sstItem :: SharedStringTable -> Int -> StringItem-sstItem SharedStringTable{_sharedStringTable = shared} = (V.!) shared
src/Codec/Xlsx/Types/StyleSheet.hs view
@@ -963,11 +963,11 @@     , elementAttributes = Map.empty     , elementNodes      = map NodeElement $ [          -- TODO: numFmts-         elementList "fonts"   $ map (toElement "font")   _styleSheetFonts-       , elementList "fills"   $ map (toElement "fill")   _styleSheetFills-       , elementList "borders" $ map (toElement "border") _styleSheetBorders+         countedElementList "fonts"   $ map (toElement "font")   _styleSheetFonts+       , countedElementList "fills"   $ map (toElement "fill")   _styleSheetFills+       , countedElementList "borders" $ map (toElement "border") _styleSheetBorders          -- TODO: cellStyleXfs-       , elementList "cellXfs" $ map (toElement "xf")     _styleSheetCellXfs+       , countedElementList "cellXfs" $ map (toElement "xf")     _styleSheetCellXfs          -- TODO: cellStyles          -- TODO: dxfs          -- TODO: tableStyles
+ src/Codec/Xlsx/Types/Variant.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+module Codec.Xlsx.Types.Variant where++import           Data.ByteString            (ByteString)+import           Data.ByteString.Base64     as B64+import           Data.Text                  (Text)+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as T+import           Text.XML+import           Text.XML.Cursor++import           Codec.Xlsx.Parser.Internal hiding (n)+import           Codec.Xlsx.Writer.Internal++data Variant+    = VtBlob ByteString+    | VtBool Bool+    | VtDecimal Double+    | VtLpwstr Text+    | VtInt Int+    -- TODO: vt_vector, vt_array, vt_oblob, vt_empty, vt_null, vt_i1, vt_i2,+    -- vt_i4, vt_i8, vt_ui1, vt_ui2, vt_ui4, vt_ui8, vt_uint, vt_r4, vt_r8,+    -- vt_lpstr, vt_bstr, vt_date, vt_filetime, vt_cy, vt_error, vt_stream,+    -- vt_ostream, vt_storage, vt_ostorage, vt_vstream, vt_clsid+    deriving (Eq, Show)++{-------------------------------------------------------------------------------+  Parsing+-------------------------------------------------------------------------------}++instance FromCursor Variant where+  fromCursor = variantFromNode . node++variantFromNode :: Node -> [Variant]+variantFromNode n@(NodeElement el) | elementName el == (vt"lpwstr") =+                                         fromNode n $/ content &| VtLpwstr+                                   | elementName el == (vt"bool") =+                                         fromNode n $/ content >=> fmap VtBool . boolean+                                   | elementName el == (vt"int") =+                                         fromNode n $/ content >=> fmap VtInt . decimal+                                   | elementName el == (vt"decimal") =+                                         fromNode n $/ content >=> fmap VtDecimal . rational+                                   | elementName el == (vt"blob") =+                                         fromNode n $/ content >=> fmap VtBlob . decodeBase64 . killWhitespace+variantFromNode  _ = fail "no matching nodes"++killWhitespace :: Text -> Text+killWhitespace = T.filter (/=' ')++decodeBase64 :: Monad m => Text -> m ByteString+decodeBase64 t = case B64.decode (T.encodeUtf8 t) of+  Right bs -> return bs+  Left err -> fail $ "invalid base64 value: " ++ err++-- | Add doc props variant types namespace to name+vt :: Text -> Name+vt x = Name+  { nameLocalName = x+  , nameNamespace = Just docPropsVtNs+  , namePrefix = Nothing+  }++docPropsVtNs :: Text+docPropsVtNs = "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes"++{-------------------------------------------------------------------------------+  Rendering+-------------------------------------------------------------------------------}++variantToElement :: Variant -> Element+variantToElement (VtLpwstr t)  = elementContent (vt"lpwstr")  t+variantToElement (VtBlob bs)   = elementContent (vt"blob")    (T.decodeLatin1 $ B64.encode bs)+variantToElement (VtBool b)    = elementContent (vt"bool")    (txtb b)+variantToElement (VtDecimal d) = elementContent (vt"decimal") (txtd d)+variantToElement (VtInt i)     = elementContent (vt"int")     (txti i)
src/Codec/Xlsx/Writer.hs view
@@ -1,33 +1,30 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} -- | 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.Arrow (second)-import           Control.Lens hiding (transform)-import qualified Data.ByteString.Lazy as L-import           Data.ByteString.Lazy.Char8 ()-import           Data.Map (Map)-import qualified Data.Map as M+import qualified Codec.Archive.Zip                           as Zip+import           Control.Arrow                               (second)+import           Control.Lens                                hiding (transform)+import qualified Data.ByteString.Lazy                        as L+import           Data.ByteString.Lazy.Char8                  ()+import           Data.Map                                    (Map)+import qualified Data.Map                                    as M import           Data.Maybe-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 (UTCTime)-import           Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)-import           Data.Time.Format (formatTime)+import           Data.Monoid                                 ((<>))+import           Data.Text                                   (Text)+import qualified Data.Text                                   as T+import           Data.Time                                   (UTCTime)+import           Data.Time.Clock.POSIX                       (POSIXTime, posixSecondsToUTCTime)+import           Data.Time.Format                            (formatTime) #if MIN_VERSION_time(1,5,0)-import           Data.Time.Format (defaultTimeLocale)+import           Data.Time.Format                            (defaultTimeLocale) #else-import           System.Locale (defaultTimeLocale)+import           System.Locale                               (defaultTimeLocale) #endif+import           Safe import           Text.XML  #if !MIN_VERSION_base(4,8,0)@@ -35,7 +32,11 @@ #endif  import           Codec.Xlsx.Types-import           Codec.Xlsx.Types.SharedStringTable+import qualified Codec.Xlsx.Types.Comments                   as Comments++import           Codec.Xlsx.Types.Internal.Relationships     as Relationships hiding (lookup)+import           Codec.Xlsx.Types.Internal.SharedStringTable+import           Codec.Xlsx.Types.Internal.CustomProperties import           Codec.Xlsx.Writer.Internal  -- | Writes `Xlsx' to raw data (lazy bytestring)@@ -47,7 +48,7 @@     utcTime = posixSecondsToUTCTime pt     entries = Zip.toEntry "[Content_Types].xml" t (contentTypesXml files) :               map (\fd -> Zip.toEntry (T.unpack $ fdName fd) t (fdContents fd)) files-    files = sheetFiles +++    files = sheetFiles ++ customPropFiles ++       [ FileData "docProps/core.xml"         "application/vnd.openxmlformats-package.core-properties+xml" $ coreXml utcTime "xlsxwriter"       , FileData "docProps/app.xml"@@ -59,23 +60,57 @@       , 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+        "application/vnd.openxmlformats-package.relationships+xml" bookRelsXml       , 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) (w ^. wsSheetViews) (w ^. wsPageSetup) |-        (n, cells, w) <- zip3 [1..] sheetCells sheets]+    rootRelXml = renderLBS def . toDocument $ Relationships.fromList rootRels+    rootFiles =  customPropFileRels +++        [ ("officeDocument", "xl/workbook.xml")+        , ("metadata/core-properties", "docProps/core.xml")+        , ("extended-properties", "docProps/app.xml") ]+    rootRels = [ relEntry i typ trg+               | (i, (typ, trg)) <- zip [1..] rootFiles ]+    customProps = xlsx ^. xlCustomProperties+    (customPropFiles, customPropFileRels) = case M.null customProps of+        True  -> ([], [])+        False -> ([ FileData "docProps/custom.xml"+                    "application/vnd.openxmlformats-officedocument.custom-properties+xml"+                    (customPropsXml (CustomProperties customProps)) ],+                  [ ("custom-properties", "docProps/custom.xml") ])+    bookRelsXml = renderLBS def . toDocument $ bookRels sheetCount+    sheetFiles = concat $ zipWith3 singleSheelFiles [1..] sheetCells sheets     sheets = xlsx ^. xlSheets . to M.elems     sheetCount = length sheets     shared = sstConstruct sheets     sheetCells = map (transformSheetData shared) sheets -data FileData = FileData { fdName :: Text+singleSheelFiles :: Int -> Cells -> Worksheet -> [FileData]+singleSheelFiles n cells ws = sheetFile:filesForComments+  where+    sheetFile = FileData ("xl/worksheets/sheet" <> txti n <> ".xml")+        "application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" $+        sheetXml ws cells+    filesForComments = if null comments then [] else [commentsFile, sheetRels]+    comments = concatMap (\(row, rowCells) -> mapMaybe (maybeCellComment row) rowCells) cells+    maybeCellComment row (col, cell) = do+        comment <- xlsxComment cell+        return (mkCellRef (row, col), comment)+    commentsFile = FileData commentsPath+        "application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml"+        commentsBS+    commentsPath = "xl/comments" <> txti n <> ".xml"+    commentsBS = renderLBS def . toDocument $ Comments.fromList comments+    sheetRels = FileData ("xl/worksheets/_rels/sheet" <> txti n <> ".xml.rels")+        "application/vnd.openxmlformats-package.relationships+xml" sheetRelsXml+    sheetRelsXml = renderLBS def . toDocument $ Relationships.fromList+        [relEntry 1 "comments" ("../comments" <> show n <> ".xml")]++data FileData = FileData { fdName        :: Text                          , fdContentType :: Text-                         , fdContents :: L.ByteString}+                         , fdContents    :: L.ByteString} +type Cells = [(Int, [(Int, XlsxCell)])]+ coreXml :: UTCTime -> Text -> L.ByteString coreXml created creator =   renderLBS def{rsNamespaces=nss} $ Document (Prologue [] Nothing []) root []@@ -123,8 +158,9 @@                   | XlsxBool Bool                     deriving (Show, Eq) data XlsxCell = XlsxCell-    { xlsxCellStyle  :: Maybe Int-    , xlsxCellValue  :: Maybe XlsxCellData+    { xlsxCellStyle :: Maybe Int+    , xlsxCellValue :: Maybe XlsxCellData+    , xlsxComment   :: Maybe Comment     } deriving (Show, Eq)  xlsxCellType :: XlsxCell -> Text@@ -139,20 +175,25 @@ value XlsxCell{xlsxCellValue=Just(XlsxBool False)} = "0" value _ = error "value undefined" -transformSheetData :: SharedStringTable -> Worksheet -> [(Int, [(Int, XlsxCell)])]+transformSheetData :: SharedStringTable -> Worksheet -> Cells transformSheetData shared ws = map transformRow $ toRows (ws ^. wsCells)   where     transformRow = second (map transformCell)-    transformCell (c, Cell{_cellValue=v, _cellStyle=s}) =-        (c, XlsxCell s (fmap transformValue v))+    transformCell (c, Cell{_cellValue=v, _cellStyle=s, _cellComment=comment}) =+        (c, XlsxCell s (fmap transformValue v) comment)     transformValue (CellText t) = XlsxSS (sstLookupText shared t)     transformValue (CellDouble dbl) =  XlsxDouble dbl     transformValue (CellBool b) = XlsxBool b     transformValue (CellRich r) = XlsxSS (sstLookupRich shared r) -sheetXml :: [ColumnsWidth] -> Map Int RowProperties -> [(Int, [(Int, XlsxCell)])] -> [Text]-> Maybe [SheetView] -> Maybe PageSetup -> L.ByteString-sheetXml cws rh rows merges sheetViews pageSetup = renderLBS def $ Document (Prologue [] Nothing []) root []+sheetXml :: Worksheet -> Cells -> L.ByteString+sheetXml ws rows = renderLBS def $ Document (Prologue [] Nothing []) root []   where+    cws = ws ^. wsColumns+    rh = ws ^. wsRowPropertiesMap+    merges = ws ^. wsMerges+    sheetViews = ws ^. wsSheetViews+    pageSetup = ws ^. wsPageSetup     cType = xlsxCellType     root = addNS "http://schemas.openxmlformats.org/spreadsheetml/2006/main" $            Element "worksheet" M.empty $ catMaybes@@ -211,21 +252,15 @@ ssXml :: SharedStringTable -> L.ByteString ssXml = renderLBS def . toDocument -bookRelXml :: Int -> L.ByteString-bookRelXml n = renderLBS def $ Document (Prologue [] Nothing []) root []-  where-    root = addNS "http://schemas.openxmlformats.org/package/2006/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"-      (M.fromList [("Id", T.concat ["rId", txti i]), ("Target", target),-       ("Type", T.concat ["http://schemas.openxmlformats.org/officeDocument/2006/relationships/", typ])]) []+customPropsXml :: CustomProperties -> L.ByteString+customPropsXml = renderLBS def . toDocument -rootRelXml :: L.ByteString-rootRelXml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\"><Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument\" Target=\"xl/workbook.xml\"/><Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties\" Target=\"docProps/core.xml\"/><Relationship Id=\"rId3\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties\" Target=\"docProps/app.xml\"/></Relationships>"+bookRels :: Int -> Relationships+bookRels n =  Relationships.fromList (sheetRels ++ [stylesRel, ssRel])+  where+    sheetRels = [relEntry i "worksheet" ("worksheets/sheet" <> show i <> ".xml") | i <- [1..n]]+    stylesRel = relEntry (n + 1) "styles" "styles.xml"+    ssRel = relEntry (n + 2) "sharedStrings" "sharedStrings.xml"  contentTypesXml :: [FileData] -> L.ByteString contentTypesXml fds = renderLBS def $ Document (Prologue [] Nothing []) root []@@ -248,7 +283,7 @@ nsName :: [(Text, Text)] -> Text -> Text -> Name nsName nss p n = qName n ns p     where-      ns = fromJust $ lookup p nss+      ns = fromJustNote "ns name lookup" $ lookup p nss  nm :: Text -> Text -> Name nm ns n = Name@@ -269,12 +304,3 @@  nEl :: Name -> Map Name Text -> [Node] -> Node nEl name attrs nodes = NodeElement $ Element name attrs nodes--txti :: Int -> Text-txti = toStrict . toLazyText . decimal--txtd :: Double -> Text-txtd = toStrict . toLazyText . realFloat--txtb :: Bool -> Text-txtb = T.toLower . T.pack . show
src/Codec/Xlsx/Writer/Internal.hs view
@@ -7,25 +7,39 @@     -- * Rendering documents     ToDocument(..)   , documentFromElement+  , documentFromNsElement     -- * Rendering elements   , ToElement(..)-  , elementList+  , countedElementList+  , elementListSimple   , elementContent+  , elementContentPreserved   , elementValue     -- * Rendering attributes   , ToAttrVal(..)   , (.=)   , (.=?)+  , setAttr     -- * Dealing with namespaces   , addNS   , mainNamespace+    -- * Misc+  , txti+  , txtb+  , txtd   ) where -import Data.Text (Text)-import Data.String (fromString)-import Text.XML-import qualified Data.Map as Map+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 qualified Data.Map                         as Map+import           Data.String                      (fromString)+import           Text.XML+ {-------------------------------------------------------------------------------   Rendering documents -------------------------------------------------------------------------------}@@ -34,8 +48,11 @@   toDocument :: a -> Document  documentFromElement :: Text -> Element -> Document-documentFromElement comment e = Document {-      documentRoot     = addNS mainNamespace e+documentFromElement comment e = documentFromNsElement comment mainNamespace e++documentFromNsElement :: Text -> Text -> Element -> Document+documentFromNsElement comment ns e = Document {+      documentRoot     = addNS ns e     , documentEpilogue = []     , documentPrologue = Prologue {           prologueBefore  = [MiscComment comment]@@ -51,19 +68,31 @@ class ToElement a where   toElement :: Name -> a -> Element -elementList :: Name -> [Element] -> Element-elementList nm as = Element {+countedElementList :: Name -> [Element] -> Element+countedElementList nm as = elementList0 nm as [ "count" .= length as ]++elementList0 :: Name -> [Element] -> [(Name, Text)] -> Element+elementList0 nm els attrs = Element {       elementName       = nm-    , elementNodes      = map NodeElement as-    , elementAttributes = Map.fromList [ "count" .= length as ]+    , elementNodes      = map NodeElement els+    , elementAttributes = Map.fromList attrs     } -elementContent :: Name -> Text -> Element-elementContent nm txt = Element {+elementListSimple :: Name -> [Element] -> Element+elementListSimple nm els = elementList0 nm els []++elementContent0 :: Name -> [(Name, Text)] -> Text -> Element+elementContent0 nm attrs txt = Element {       elementName       = nm-    , elementAttributes = Map.fromList [ preserveSpace ]+    , elementAttributes = Map.fromList attrs     , elementNodes      = [NodeContent txt]     }++elementContent :: Name -> Text -> Element+elementContent nm txt = elementContent0 nm [] txt++elementContentPreserved :: Name -> Text -> Element+elementContentPreserved nm txt = elementContent0 nm [ preserveSpace ] txt   where     preserveSpace = (         Name { nameLocalName = "space"@@ -103,6 +132,11 @@ _  .=? Nothing  = Nothing nm .=? (Just a) = Just (nm .= a) +setAttr :: ToAttrVal a => Name -> a -> Element -> Element+setAttr nm a el@Element{..} = el{ elementAttributes = attrs' }+  where+    attrs' = Map.insert nm (toAttrVal a) elementAttributes+ {-------------------------------------------------------------------------------   Dealing with namespaces -------------------------------------------------------------------------------}@@ -134,3 +168,13 @@ -- | The main namespace for Excel mainNamespace :: Text mainNamespace = "http://schemas.openxmlformats.org/spreadsheetml/2006/main"+++txtd :: Double -> Text+txtd = toStrict . toLazyText . realFloat++txtb :: Bool -> Text+txtb = T.toLower . T.pack . show++txti :: Int -> Text+txti = toStrict . toLazyText . decimal
− src/Test.hs
@@ -1,105 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import           Codec.Xlsx--import           Control.Applicative-import           Control.Lens-import qualified Data.ByteString.Lazy as L-import qualified Data.Map as M-import           Data.Text (Text,pack)-import           Data.Time.Clock.POSIX (getPOSIXTime)-import           Prelude---xEmpty :: Cell-xEmpty = Cell{_cellValue=Nothing, _cellStyle=Just 0}--xText :: Text -> Cell-xText t = Cell{_cellValue=Just $ CellText t, _cellStyle=Just 0}--xDouble :: Double -> Cell-xDouble d = Cell{_cellValue=Just $ CellDouble d, _cellStyle=Just 0}--styles :: Styles-styles = Styles "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\-\<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-    pt <- getPOSIXTime-    L.writeFile "test.xlsx" $ fromXlsx pt $ Xlsx sheets styles def-    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) | 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 [] Nothing Nothing)] -- wtf merges?
test/DataTest.hs view
@@ -1,48 +1,57 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-} module Main (main) where  import           Control.Lens-import           Data.ByteString.Lazy (ByteString)-import           Data.Map (Map)-import qualified Data.Map as M-import           Data.Time.Clock.POSIX (POSIXTime)-import qualified Data.Vector as V+import           Data.ByteString.Lazy               (ByteString)+import qualified Data.Map                           as M+import qualified Data.HashMap.Strict                as HM+import           Data.Time.Clock.POSIX              (POSIXTime)+import qualified Data.Vector                        as V+import           Text.RawString.QQ import           Text.XML import           Text.XML.Cursor -import           Test.Tasty (defaultMain, testGroup)-import           Test.Tasty.SmallCheck (testProperty)-import           Test.Tasty.HUnit (testCase)+import           Test.Tasty                         (defaultMain, testGroup)+import           Test.Tasty.HUnit                   (testCase)+import           Test.Tasty.SmallCheck              (testProperty) -import           Test.HUnit ((@=?))-import           Test.SmallCheck.Series (Positive(..))+import           Test.HUnit                         ((@=?))+import           Test.SmallCheck.Series             (Positive (..))  import           Codec.Xlsx-import           Codec.Xlsx.Types.SharedStringTable import           Codec.Xlsx.Parser.Internal+import           Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties+import           Codec.Xlsx.Types.Internal.SharedStringTable  +main :: IO () main = defaultMain $   testGroup "Tests"     [ testProperty "col2int . int2col == id" $         \(Positive i) -> i == col2int (int2col i)     , testCase "write . read == id" $-         testXlsx @=? toXlsx (fromXlsx testTime testXlsx)+        testXlsx @=? toXlsx (fromXlsx testTime testXlsx)     , testCase "fromRows . toRows == id" $-         testCellMap @=? fromRows (toRows testCellMap)+        testCellMap1 @=? fromRows (toRows testCellMap1)     , testCase "fromRight . parseStyleSheet . renderStyleSheet == id" $-         testStyleSheet @=? fromRight (parseStyleSheet (renderStyleSheet  testStyleSheet))+        testStyleSheet @=? fromRight (parseStyleSheet (renderStyleSheet  testStyleSheet))     , testCase "correct shared strings parsing" $-         [testSharedStringTable] @=? testParsedSharedStringTables+        [testSharedStringTable] @=? testParsedSharedStringTables     , testCase "correct shared strings parsing even when one of the shared strings entry is just <t/>" $-         [testSharedStringTableWithEmpty] @=? testParsedSharedStringTablesWithEmpty+        [testSharedStringTableWithEmpty] @=? testParsedSharedStringTablesWithEmpty+    , testCase "correct comments parsing" $+        [testCommentsTable] @=? testParsedComments+    , testCase "correct custom properties parsing" $+        [testCustomProperties] @=? testParsedCustomProperties     ]  testXlsx :: Xlsx-testXlsx = Xlsx sheets minimalStyles definedNames+testXlsx = Xlsx sheets minimalStyles definedNames customProperties   where-    sheets = M.fromList [( "List1", sheet )]-    sheet = Worksheet cols rowProps testCellMap ranges sheetViews pageSetup+    sheets = M.fromList [("List1", sheet1), ("Another sheet", sheet2)]+    sheet1 = Worksheet cols rowProps testCellMap1 ranges sheetViews pageSetup+    sheet2 = def & wsCells .~ testCellMap2     rowProps = M.fromList [(1, RowProps (Just 50) (Just 3))]     cols = [ColumnsWidth 1 10 15 1]     ranges = [mkRange (1,1) (1,2), mkRange (2,2) (10, 5)]@@ -62,19 +71,44 @@                            & pageSetupCopies .~ Just 2                            & pageSetupErrors .~ Just PrintErrorsDash                            & pageSetupPaperSize .~ Just PaperA4+    customProperties = M.fromList [("some_prop", VtInt 42)] -testCellMap :: CellMap-testCellMap = M.fromList [ ((1, 2), cd1), ((1, 5), cd2)+testCellMap1 :: CellMap+testCellMap1 = 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}+    cd v = def {_cellValue=Just v}     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)+    cd4 = def -- shouldn't it be skipped?+    cd5 = cd (CellBool True) +testCellMap2 :: CellMap+testCellMap2 = M.fromList [ ((1, 2), def & cellValue ?~ CellText "something here")+                          , ((3, 5), def & cellValue ?~ CellDouble 123.456)+                          , ((2, 4),+                             def & cellValue ?~ CellText "value"+                                 & cellComment ?~ comment1+                            )+                          , ((10, 7),+                             def & cellValue ?~ CellText "value"+                                 & cellComment ?~ comment2+                            )+                          ]+  where+    comment1 = Comment (XlsxText "simple comment") "bob"+    comment2 = Comment (XlsxRichText [rich1, rich2]) "alice"+    rich1 = def & richTextRunText.~ "Look ma!"+                & richTextRunProperties ?~ (+                   def & runPropertiesBold ?~ True+                       & runPropertiesFont ?~ "Tahoma")+    rich2 = def & richTextRunText .~ "It's blue!"+                & richTextRunProperties ?~ (+                   def & runPropertiesItalic ?~ True+                       & runPropertiesColor ?~ (def & colorARGB ?~ "FF000080"))+ testTime :: POSIXTime testTime = 123 @@ -88,10 +122,9 @@ testSharedStringTable = SharedStringTable $ V.fromList items   where     items = [text, rich]-    text = StringItemText "plain text"-    empty = StringItemText ""-    rich = StringItemRich [ RichTextRun Nothing "Just "-                          , RichTextRun (Just props) "example" ]+    text = XlsxText "plain text"+    rich = XlsxRichText [ RichTextRun Nothing "Just "+                        , RichTextRun (Just props) "example" ]     props = def & runPropertiesBold .~ Just True                 & runPropertiesUnderline .~ Just FontUnderlineSingle                 & runPropertiesSize .~ Just 10@@ -100,7 +133,7 @@  testSharedStringTableWithEmpty :: SharedStringTable testSharedStringTableWithEmpty =-  SharedStringTable $ V.fromList [StringItemText ""]+  SharedStringTable $ V.fromList [XlsxText ""]  testParsedSharedStringTables ::[SharedStringTable] testParsedSharedStringTables = fromCursor . fromDocument $ parseLBS_ def testStrings@@ -108,6 +141,30 @@ testParsedSharedStringTablesWithEmpty :: [SharedStringTable] testParsedSharedStringTablesWithEmpty = fromCursor . fromDocument $ parseLBS_ def testStringsWithEmpty +testCommentsTable = CommentsTable $ HM.fromList+    [ ("D4", Comment (XlsxRichText rich) "Bob")+    , ("A2", Comment (XlsxText "Some comment here") "CBR") ]+  where+    rich = [ RichTextRun+             { _richTextRunProperties =+               Just $ def & runPropertiesCharset ?~ 1+                          & runPropertiesColor ?~ def -- TODO: why not Nothing here?+                          & runPropertiesFont ?~ "Calibri"+                          & runPropertiesScheme ?~ FontSchemeMinor+                          & runPropertiesSize ?~ 8.0+             , _richTextRunText = "Bob:"}+           , RichTextRun+             { _richTextRunProperties =+               Just $ def & runPropertiesCharset ?~ 1+                          & runPropertiesColor ?~ def+                          & runPropertiesFont ?~ "Calibri"+                          & runPropertiesScheme ?~ FontSchemeMinor+                          & runPropertiesSize ?~ 8.0+             , _richTextRunText = "Why such high expense?"}]++testParsedComments ::[CommentsTable]+testParsedComments = fromCursor . fromDocument $ parseLBS_ def testComments+ testStrings :: ByteString testStrings = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\   \<sst xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" count=\"2\" uniqueCount=\"2\">\@@ -121,3 +178,78 @@   \<sst xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" count=\"2\" uniqueCount=\"2\">\   \<si><t/></si>\   \</sst>"++testComments :: ByteString+testComments = [r|+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>+<comments xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main">+  <authors>+    <author>Bob</author>+    <author>CBR</author>+  </authors>+  <commentList>+    <comment ref="D4" authorId="0">+      <text>+        <r>+          <rPr>+            <b/><sz val="8"/><color indexed="81"/><rFont val="Calibri"/>+            <charset val="1"/><scheme val="minor"/>+          </rPr>+          <t>Bob:</t>+        </r>+        <r>+          <rPr>+            <sz val="8"/><color indexed="81"/><rFont val="Calibri"/>+            <charset val="1"/> <scheme val="minor"/>+          </rPr>+          <t xml:space="preserve">Why such high expense?</t>+        </r>+      </text>+    </comment>+    <comment ref="A2" authorId="1">+      <text><t>Some comment here</t></text>+    </comment>+  </commentList>+</comments>+|]++testCustomProperties :: CustomProperties+testCustomProperties = CustomProperties.fromList+    [ ("testTextProp", VtLpwstr "test text property value")+    , ("prop2", VtLpwstr "222")+    , ("bool", VtBool False)+    , ("prop333", VtInt 1)+    , ("decimal", VtDecimal 1.234) ]++testParsedCustomProperties ::[CustomProperties]+testParsedCustomProperties = fromCursor . fromDocument $ parseLBS_ def testCustomPropertiesXml++testCustomPropertiesXml :: ByteString+testCustomPropertiesXml = [r|+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>+<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/custom-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="2" name="prop2">+    <vt:lpwstr>222</vt:lpwstr>+  </property>+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="3" name="prop333">+    <vt:int>1</vt:int>+  </property>+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="4" name="testTextProp">+    <vt:lpwstr>test text property value</vt:lpwstr>+  </property>+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="5" name="decimal">+    <vt:decimal>1.234</vt:decimal>+  </property>+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="6" name="bool">+    <vt:bool>false</vt:bool>+  </property>+  <property fmtid="{D5CDD505-2E9C-101B-9397-08002B2CF9AE}" pid="7" name="blob">+    <vt:blob>+    ZXhhbXBs+    ZSBibG9i+    IGNvbnRl+    bnRz+    </vt:blob>+  </property>+</Properties>+|]
xlsx.cabal view
@@ -1,6 +1,6 @@ Name:                xlsx -Version:             0.2.1.2+Version:             0.2.2  Synopsis:            Simple and incomplete Excel file parser/writer Description:@@ -33,39 +33,50 @@ Library   Hs-source-dirs:    src   Exposed-modules:   Codec.Xlsx-                     , Codec.Xlsx.Types-                     , Codec.Xlsx.Types.Common-                     , Codec.Xlsx.Types.SharedStringTable-                     , Codec.Xlsx.Types.RichText-                     , Codec.Xlsx.Types.SheetViews-                     , Codec.Xlsx.Types.PageSetup-                     , Codec.Xlsx.Types.StyleSheet-                     , Codec.Xlsx.Lens-                     , Codec.Xlsx.Parser-                     , Codec.Xlsx.Parser.Internal-                     , Codec.Xlsx.Formatted-                     , Codec.Xlsx.Writer-                     , Codec.Xlsx.Writer.Internal+                   , Codec.Xlsx.Types+                   , Codec.Xlsx.Types.Comments+                   , Codec.Xlsx.Types.Common+                   , Codec.Xlsx.Types.Internal+                   , Codec.Xlsx.Types.Internal.CustomProperties+                   , Codec.Xlsx.Types.Internal.Relationships+                   , Codec.Xlsx.Types.Internal.SharedStringTable+                   , Codec.Xlsx.Types.RichText+                   , Codec.Xlsx.Types.SheetViews+                   , Codec.Xlsx.Types.PageSetup+                   , Codec.Xlsx.Types.StyleSheet+                   , Codec.Xlsx.Types.Variant+                   , Codec.Xlsx.Lens+                   , Codec.Xlsx.Parser+                   , Codec.Xlsx.Parser.Internal+                   , Codec.Xlsx.Formatted+                   , Codec.Xlsx.Writer+                   , Codec.Xlsx.Writer.Internal    Build-depends:     base         == 4.*-                     , containers   >= 0.5.0.0-                     , transformers >= 0.3.0.0-                     , bytestring   >= 0.10.0.2-                     , text         >= 0.11.3.1-                     , lens         >= 3.8 && < 5-                     , conduit      >= 1.0.0-                     , xml-types    == 0.3.*-                     , xml-conduit  >= 1.1.0-                     , zip-archive  >= 0.2-                     , digest       == 0.0.*-                     , zlib         >= 0.5.4.0-                     , utf8-string  >= 0.3.7-                     , time         >= 1.4.0.1-                     , old-locale   >= 1.0.0.5-                     , data-default-                     , vector       >= 0.10-                     , mtl          >= 2.1-                     , binary-search+                   , binary-search+                   , bytestring   >= 0.10.0.2+                   , conduit      >= 1.0.0+                   , containers   >= 0.5.0.0+                   , data-default+                   , digest       == 0.0.*+                   , extra+                   , filepath+                   , lens         >= 3.8 && < 5+                   , mtl          >= 2.1+                   , network-uri+                   , old-locale   >= 1.0.0.5+                   , safe         >= 0.3+                   , text         >= 0.11.3.1+                   , time         >= 1.4.0.1+                   , transformers >= 0.3.0.0+                   , unordered-containers+                   , utf8-string  >= 0.3.7+                   , vector       >= 0.10+                   , xml-conduit  >= 1.1.0+                   , xml-types    == 0.3.*+                   , zip-archive  >= 0.2+                   , zlib         >= 0.5.4.0+                   , base64-bytestring   Default-Language:     Haskell2010   Other-Extensions:  CPP                      DeriveDataTypeable@@ -77,50 +88,25 @@                      TemplateHaskell                      TupleSections ---Executable           test-  Hs-source-dirs:    src-  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     >= 1.0.0-                     , xml-types   == 0.3.*-                     , xml-conduit >= 1.1.0-                     , zip-archive >= 0.2-                     , lens        >= 3.8 && < 5-                     , digest      >  0.0.0.1-                     , zlib-                     , utf8-string-                     , time-                     , old-locale-                     , data-default-                     , vector       >= 0.10-                     , binary-search-  Default-Language:     Haskell2010- test-suite data-test   type: exitcode-stdio-1.0   main-is:  DataTest.hs   hs-source-dirs: test/-  Build-Depends: base,-                 containers,-                 time,-                 xlsx,-                 xml-conduit >= 1.1.0,-                 smallcheck,-                 HUnit,-                 tasty,-                 tasty-smallcheck,-                 tasty-hunit,-                 lens,-                 bytestring,-                 vector+  Build-Depends: base+               , containers+               , time+               , xlsx+               , xml-conduit >= 1.1.0+               , smallcheck+               , HUnit+               , tasty+               , tasty-smallcheck+               , tasty-hunit+               , lens+               , bytestring+               , vector+               , raw-strings-qq+               , unordered-containers   Default-Language:     Haskell2010  source-repository head