diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,7 @@ +0.2.2.1 +----- +* fixed comments data type names and modules/imports + 0.2.2 ----- * added cell comments support diff --git a/src/Codec/Xlsx/Parser.hs b/src/Codec/Xlsx/Parser.hs --- a/src/Codec/Xlsx/Parser.hs +++ b/src/Codec/Xlsx/Parser.hs @@ -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 diff --git a/src/Codec/Xlsx/Parser/Internal.hs b/src/Codec/Xlsx/Parser/Internal.hs --- a/src/Codec/Xlsx/Parser/Internal.hs +++ b/src/Codec/Xlsx/Parser/Internal.hs @@ -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) diff --git a/src/Codec/Xlsx/Types.hs b/src/Codec/Xlsx/Types.hs --- a/src/Codec/Xlsx/Types.hs +++ b/src/Codec/Xlsx/Types.hs @@ -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 diff --git a/src/Codec/Xlsx/Types/Comment.hs b/src/Codec/Xlsx/Types/Comment.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Xlsx/Types/Comment.hs @@ -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) diff --git a/src/Codec/Xlsx/Types/Comments.hs b/src/Codec/Xlsx/Types/Comments.hs deleted file mode 100644 --- a/src/Codec/Xlsx/Types/Comments.hs +++ /dev/null @@ -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) diff --git a/src/Codec/Xlsx/Types/Internal/CommentTable.hs b/src/Codec/Xlsx/Types/Internal/CommentTable.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Xlsx/Types/Internal/CommentTable.hs @@ -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) diff --git a/src/Codec/Xlsx/Writer.hs b/src/Codec/Xlsx/Writer.hs --- a/src/Codec/Xlsx/Writer.hs +++ b/src/Codec/Xlsx/Writer.hs @@ -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 diff --git a/test/DataTest.hs b/test/DataTest.hs --- a/test/DataTest.hs +++ b/test/DataTest.hs @@ -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 " $ [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 diff --git a/xlsx.cabal b/xlsx.cabal --- a/xlsx.cabal +++ b/xlsx.cabal @@ -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