xlsx 0.2.2 → 0.2.2.1

raw patch · 10 files changed

+108/−100 lines, 10 filesdep −digestdep −utf8-stringdep −xml-types

Dependencies removed: digest, utf8-string, xml-types

Files

• CHANGELOG.markdown +4/−0
• src/Codec/Xlsx/Parser.hs +2/−1
• src/Codec/Xlsx/Parser/Internal.hs +1/−1
• src/Codec/Xlsx/Types.hs +1/−1
• src/Codec/Xlsx/Types/Comment.hs +21/−0
• src/Codec/Xlsx/Types/Comments.hs +0/−85
• src/Codec/Xlsx/Types/Internal/CommentTable.hs +69/−0
• src/Codec/Xlsx/Writer.hs +3/−4
• test/DataTest.hs +4/−3
• xlsx.cabal +3/−5

@@ -1,3 +1,7 @@+0.2.2.1+-----+* fixed comments data type names and modules/imports+ 0.2.2 ----- * added cell comments support

@@ -31,6 +31,7 @@ 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.CommentTable import           Codec.Xlsx.Types.Internal.CustomProperties  as CustomProperties  @@ -152,7 +153,7 @@   Nothing  -> Styles L.empty   Just xml -> Styles xml -getComments :: Zip.Archive -> FilePath -> Maybe CommentsTable+getComments :: Zip.Archive -> FilePath -> Maybe CommentTable getComments ar fp = listToMaybe =<< fromCursor <$> xmlCursor ar fp  getCustomProperties :: Zip.Archive -> CustomProperties

@@ -24,7 +24,7 @@ import qualified Data.Text as T import qualified Data.Text.Read as T import           Data.Typeable (Typeable)-import           Data.XML.Types+import           Text.XML import           Text.XML.Cursor  #if !MIN_VERSION_base(4,8,0)

@@ -42,7 +42,7 @@ import           Text.XML.Cursor  import           Codec.Xlsx.Parser.Internal-import           Codec.Xlsx.Types.Comments as X+import           Codec.Xlsx.Types.Comment as X import           Codec.Xlsx.Types.Common as X import           Codec.Xlsx.Types.PageSetup as X import           Codec.Xlsx.Types.RichText as X

@@ -0,0 +1,21 @@+module Codec.Xlsx.Types.Comment where++import           Data.Text               (Text)++import           Codec.Xlsx.Types.Common++-- | 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)

@@ -1,85 +0,0 @@-{-# 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)

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+module Codec.Xlsx.Types.Internal.CommentTable where++import qualified Data.HashMap.Strict        as HM+import           Data.List.Extra            (nubOrd)+import qualified Data.Map                   as Map+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.Comment+import           Codec.Xlsx.Types.Common+import           Codec.Xlsx.Writer.Internal++newtype CommentTable = CommentTable+    { _commentsTable :: HM.HashMap CellRef Comment }+    deriving (Show, Eq)++fromList :: [(CellRef, Comment)] -> CommentTable+fromList = CommentTable . HM.fromList++lookupComment :: CellRef -> CommentTable -> Maybe Comment+lookupComment ref = HM.lookup ref . _commentsTable++instance ToDocument CommentTable where+  toDocument = documentFromElement "Sheet comments generated by xlsx"+             . toElement "comments"++instance ToElement CommentTable where+  toElement nm (CommentTable 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 CommentTable 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 . CommentTable $ 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)

@@ -32,11 +32,10 @@ #endif  import           Codec.Xlsx.Types-import qualified Codec.Xlsx.Types.Comments                   as Comments-+import qualified Codec.Xlsx.Types.Internal.CommentTable      as CommentTable+import           Codec.Xlsx.Types.Internal.CustomProperties 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)@@ -99,7 +98,7 @@         "application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml"         commentsBS     commentsPath = "xl/comments" <> txti n <> ".xml"-    commentsBS = renderLBS def . toDocument $ Comments.fromList comments+    commentsBS = renderLBS def . toDocument $ CommentTable.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

@@ -22,6 +22,7 @@ import           Codec.Xlsx import           Codec.Xlsx.Parser.Internal import           Codec.Xlsx.Types.Internal.CustomProperties as CustomProperties+import           Codec.Xlsx.Types.Internal.CommentTable import           Codec.Xlsx.Types.Internal.SharedStringTable  @@ -41,7 +42,7 @@     , testCase "correct shared strings parsing even when one of the shared strings entry is just <t/>" $         [testSharedStringTableWithEmpty] @=? testParsedSharedStringTablesWithEmpty     , testCase "correct comments parsing" $-        [testCommentsTable] @=? testParsedComments+        [testCommentTable] @=? testParsedComments     , testCase "correct custom properties parsing" $         [testCustomProperties] @=? testParsedCustomProperties     ]@@ -141,7 +142,7 @@ testParsedSharedStringTablesWithEmpty :: [SharedStringTable] testParsedSharedStringTablesWithEmpty = fromCursor . fromDocument $ parseLBS_ def testStringsWithEmpty -testCommentsTable = CommentsTable $ HM.fromList+testCommentTable = CommentTable $ HM.fromList     [ ("D4", Comment (XlsxRichText rich) "Bob")     , ("A2", Comment (XlsxText "Some comment here") "CBR") ]   where@@ -162,7 +163,7 @@                           & runPropertiesSize ?~ 8.0              , _richTextRunText = "Why such high expense?"}] -testParsedComments ::[CommentsTable]+testParsedComments ::[CommentTable] testParsedComments = fromCursor . fromDocument $ parseLBS_ def testComments  testStrings :: ByteString

@@ -1,6 +1,6 @@ Name:                xlsx -Version:             0.2.2+Version:             0.2.2.1  Synopsis:            Simple and incomplete Excel file parser/writer Description:@@ -34,9 +34,10 @@   Hs-source-dirs:    src   Exposed-modules:   Codec.Xlsx                    , Codec.Xlsx.Types-                   , Codec.Xlsx.Types.Comments+                   , Codec.Xlsx.Types.Comment                    , Codec.Xlsx.Types.Common                    , Codec.Xlsx.Types.Internal+                   , Codec.Xlsx.Types.Internal.CommentTable                    , Codec.Xlsx.Types.Internal.CustomProperties                    , Codec.Xlsx.Types.Internal.Relationships                    , Codec.Xlsx.Types.Internal.SharedStringTable@@ -58,7 +59,6 @@                    , conduit      >= 1.0.0                    , containers   >= 0.5.0.0                    , data-default-                   , digest       == 0.0.*                    , extra                    , filepath                    , lens         >= 3.8 && < 5@@ -70,10 +70,8 @@                    , 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