{-# 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)