{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Comment where

import Control.DeepSeq (NFData)
import Data.Text (Text)
import GHC.Generics (Generic)

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
    { Comment -> XlsxText
_commentText    :: XlsxText
    -- ^ cell comment text, maybe formatted
    -- Section 18.7.7 "text (Comment Text)" (p. 1754)
    , Comment -> Text
_commentAuthor  :: Text
    -- ^ comment author
    , Comment -> Bool
_commentVisible :: Bool
    } deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comment] -> ShowS
$cshowList :: [Comment] -> ShowS
show :: Comment -> String
$cshow :: Comment -> String
showsPrec :: Int -> Comment -> ShowS
$cshowsPrec :: Int -> Comment -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Comment x -> Comment
$cfrom :: forall x. Comment -> Rep Comment x
Generic)
instance NFData Comment