    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards   #-}
    {-# LANGUAGE DeriveGeneric #-}
    module Codec.Xlsx.Types.Internal.CommentTable where

    import Data.ByteString.Lazy (ByteString)
    import qualified Data.ByteString.Lazy as LB
    import qualified Data.ByteString.Lazy.Char8 as LBC8
    import Data.List.Extra (nubOrd)
    import Data.Map (Map)
    import qualified Data.Map as M
    import Data.Text (Text)
    import qualified Data.Text as Text
    import Data.Text.Lazy (toStrict)
    import qualified Data.Text.Lazy.Builder as B
    import qualified Data.Text.Lazy.Builder.Int as B
    import GHC.Generics (Generic)
    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
        { CommentTable -> Map CellRef Comment
    _commentsTable :: Map CellRef Comment }
        deriving (CommentTable -> CommentTable -> Bool
    (CommentTable -> CommentTable -> Bool)
    -> (CommentTable -> CommentTable -> Bool) -> Eq CommentTable
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CommentTable -> CommentTable -> Bool
    == :: CommentTable -> CommentTable -> Bool
    $c/= :: CommentTable -> CommentTable -> Bool
    /= :: CommentTable -> CommentTable -> Bool
    Eq, Int -> CommentTable -> ShowS
    [CommentTable] -> ShowS
    CommentTable -> String
    (Int -> CommentTable -> ShowS)
    -> (CommentTable -> String)
    -> ([CommentTable] -> ShowS)
    -> Show CommentTable
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CommentTable -> ShowS
    showsPrec :: Int -> CommentTable -> ShowS
    $cshow :: CommentTable -> String
    show :: CommentTable -> String
    $cshowList :: [CommentTable] -> ShowS
    showList :: [CommentTable] -> ShowS
    Show, (forall x. CommentTable -> Rep CommentTable x)
    -> (forall x. Rep CommentTable x -> CommentTable)
    -> Generic CommentTable
    forall x. Rep CommentTable x -> CommentTable
    forall x. CommentTable -> Rep CommentTable x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. CommentTable -> Rep CommentTable x
    from :: forall x. CommentTable -> Rep CommentTable x
    $cto :: forall x. Rep CommentTable x -> CommentTable
    to :: forall x. Rep CommentTable x -> CommentTable
    Generic)

    tshow :: Show a => a -> Text
    tshow :: forall a. Show a => a -> Text
    tshow = String -> Text
    Text.pack (String -> Text) -> (a -> String) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    fromList :: [(CellRef, Comment)] -> CommentTable
    fromList :: [(CellRef, Comment)] -> CommentTable
    fromList = Map CellRef Comment -> CommentTable
    CommentTable (Map CellRef Comment -> CommentTable)
    -> ([(CellRef, Comment)] -> Map CellRef Comment)
    -> [(CellRef, Comment)]
    -> CommentTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(CellRef, Comment)] -> Map CellRef Comment
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList

    toList :: CommentTable -> [(CellRef, Comment)]
    toList :: CommentTable -> [(CellRef, Comment)]
    toList = Map CellRef Comment -> [(CellRef, Comment)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map CellRef Comment -> [(CellRef, Comment)])
    -> (CommentTable -> Map CellRef Comment)
    -> CommentTable
    -> [(CellRef, Comment)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommentTable -> Map CellRef Comment
    _commentsTable

    lookupComment :: CellRef -> CommentTable -> Maybe Comment
    lookupComment :: CellRef -> CommentTable -> Maybe Comment
    lookupComment CellRef
    ref = CellRef -> Map CellRef Comment -> Maybe Comment
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup CellRef
    ref (Map CellRef Comment -> Maybe Comment)
    -> (CommentTable -> Map CellRef Comment)
    -> CommentTable
    -> Maybe Comment
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommentTable -> Map CellRef Comment
    _commentsTable

    instance ToDocument CommentTable where
      toDocument :: CommentTable -> Document
    toDocument = Text -> Element -> Document
    documentFromElement Text
    "Sheet comments generated by xlsx"
                 (Element -> Document)
    -> (CommentTable -> Element) -> CommentTable -> Document
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> CommentTable -> Element
    forall a. ToElement a => Name -> a -> Element
    toElement Name
    "comments"

    instance ToElement CommentTable where
      toElement :: Name -> CommentTable -> Element
    toElement Name
    nm (CommentTable Map CellRef Comment
    m) = Element
          { elementName :: Name
    elementName       = Name
    nm
          , elementAttributes :: Map Name Text
    elementAttributes = Map Name Text
    forall k a. Map k a
    M.empty
          , elementNodes :: [Node]
    elementNodes      = [ Element -> Node
    NodeElement (Element -> Node) -> Element -> Node
    forall a b. (a -> b) -> a -> b
    $ Name -> [Element] -> Element
    elementListSimple Name
    "authors" [Element]
    authorNodes
                                , Element -> Node
    NodeElement (Element -> Node) -> ([Element] -> Element) -> [Element] -> Node
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [Element] -> Element
    elementListSimple Name
    "commentList" ([Element] -> Node) -> [Element] -> Node
    forall a b. (a -> b) -> a -> b
    $ ((CellRef, Comment) -> Element)
    -> [(CellRef, Comment)] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (CellRef, Comment) -> Element
    forall {a}. ToAttrVal a => (a, Comment) -> Element
    commentToEl (Map CellRef Comment -> [(CellRef, Comment)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map CellRef Comment
    m) ]
          }
        where
          commentToEl :: (a, Comment) -> Element
    commentToEl (a
    ref, Comment{Bool
    Text
    XlsxText
    _commentText :: XlsxText
    _commentAuthor :: Text
    _commentVisible :: Bool
    _commentText :: Comment -> XlsxText
    _commentAuthor :: Comment -> Text
    _commentVisible :: Comment -> Bool
    ..}) = Element
              { elementName :: Name
    elementName = Name
    "comment"
              , elementAttributes :: Map Name Text
    elementAttributes = [(Name, Text)] -> Map Name Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [ (Name
    "ref" Name -> a -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= a
    ref)
                                               , (Name
    "authorId" Name -> Text -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= Text -> Text
    lookupAuthor Text
    _commentAuthor)
                                               , (Name
    "visible" Name -> Text -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= Bool -> Text
    forall a. Show a => a -> Text
    tshow Bool
    _commentVisible)]
              , elementNodes :: [Node]
    elementNodes      = [Element -> Node
    NodeElement (Element -> Node) -> Element -> Node
    forall a b. (a -> b) -> a -> b
    $ Name -> XlsxText -> Element
    forall a. ToElement a => Name -> a -> Element
    toElement Name
    "text" XlsxText
    _commentText]
              }
          lookupAuthor :: Text -> Text
    lookupAuthor Text
    a = String -> Maybe Text -> Text
    forall a. Partial => String -> Maybe a -> a
    fromJustNote String
    "author lookup" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    a Map Text Text
    authorIds
          authorNames :: [Text]
    authorNames = [Text] -> [Text]
    forall a. Ord a => [a] -> [a]
    nubOrd ([Text] -> [Text]) -> ([Comment] -> [Text]) -> [Comment] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Comment -> Text) -> [Comment] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Comment -> Text
    _commentAuthor ([Comment] -> [Text]) -> [Comment] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Map CellRef Comment -> [Comment]
    forall k a. Map k a -> [a]
    M.elems Map CellRef Comment
    m
          decimalToText :: Integer -> Text
          decimalToText :: Integer -> Text
    decimalToText = Text -> Text
    toStrict (Text -> Text) -> (Integer -> Text) -> Integer -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Text
    B.toLazyText (Builder -> Text) -> (Integer -> Builder) -> Integer -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Builder
    forall a. Integral a => a -> Builder
    B.decimal
          authorIds :: Map Text Text
    authorIds = [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, Text)] -> Map Text Text)
    -> [(Text, Text)] -> Map Text Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text] -> [(Text, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    authorNames ((Integer -> Text) -> [Integer] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Text
    decimalToText [Integer
    0..])
          authorNodes :: [Element]
    authorNodes = (Text -> Element) -> [Text] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Text -> Element
    elementContent Name
    "author") [Text]
    authorNames

    instance FromCursor CommentTable where
      fromCursor :: Cursor -> [CommentTable]
    fromCursor Cursor
    cur = do
        let authorNames :: [Text]
    authorNames = Cursor
    cur Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "authors") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "author") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [Text]
    contentOrEmpty
            authors :: Map Int Text
    authors = [(Int, Text)] -> Map Int Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Int, Text)] -> Map Int Text) -> [(Int, Text)] -> Map Int Text
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Text] -> [(Int, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [Text]
    authorNames
            items :: [(CellRef, Comment)]
    items = Cursor
    cur Cursor -> (Cursor -> [(CellRef, Comment)]) -> [(CellRef, Comment)]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "commentList") Axis
    -> (Cursor -> [(CellRef, Comment)])
    -> Cursor
    -> [(CellRef, Comment)]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Name -> Axis
    element (Text -> Name
    n_ Text
    "comment") Axis
    -> (Cursor -> [(CellRef, Comment)])
    -> Cursor
    -> [(CellRef, Comment)]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Map Int Text -> Cursor -> [(CellRef, Comment)]
    parseComment Map Int Text
    authors
        CommentTable -> [CommentTable]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CommentTable -> [CommentTable])
    -> (Map CellRef Comment -> CommentTable)
    -> Map CellRef Comment
    -> [CommentTable]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map CellRef Comment -> CommentTable
    CommentTable (Map CellRef Comment -> [CommentTable])
    -> Map CellRef Comment -> [CommentTable]
    forall a b. (a -> b) -> a -> b
    $ [(CellRef, Comment)] -> Map CellRef Comment
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(CellRef, Comment)]
    items

    parseComment :: Map Int Text -> Cursor -> [(CellRef, Comment)]
    parseComment :: Map Int Text -> Cursor -> [(CellRef, Comment)]
    parseComment Map Int Text
    authors Cursor
    cur = do
        CellRef
    ref <- Name -> Cursor -> [CellRef]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "ref" Cursor
    cur
        XlsxText
    txt <- Cursor
    cur Cursor -> (Cursor -> [XlsxText]) -> [XlsxText]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "text") Axis -> (Cursor -> [XlsxText]) -> Cursor -> [XlsxText]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [XlsxText]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor
        Int
    authorId <- Cursor
    cur Cursor -> (Cursor -> [Int]) -> [Int]
    forall node a. Cursor node -> (Cursor node -> a) -> a
    $| Name -> Cursor -> [Text]
    attribute Name
    "authorId" (Cursor -> [Text]) -> (Text -> [Int]) -> Cursor -> [Int]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Text -> [Int]
    forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
    decimal
        Bool
    visible <- (String -> Bool
    forall a. Read a => String -> a
    read (String -> Bool) -> (Text -> String) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    Text.unpack :: Text -> Bool)
          (Text -> Bool) -> [Text] -> [Bool]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> Cursor -> [Text]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "visible" Cursor
    cur :: [Text])
        let author :: Text
    author = String -> Maybe Text -> Text
    forall a. Partial => String -> Maybe a -> a
    fromJustNote String
    "authorId" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Map Int Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    authorId Map Int Text
    authors
        (CellRef, Comment) -> [(CellRef, Comment)]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CellRef
    ref, XlsxText -> Text -> Bool -> Comment
    Comment XlsxText
    txt Text
    author Bool
    visible)

    -- | helper to render comment baloons vml file,
    -- currently uses fixed shape
    renderShapes :: CommentTable -> ByteString
    renderShapes :: CommentTable -> ByteString
    renderShapes (CommentTable Map CellRef Comment
    m) = [ByteString] -> ByteString
    LB.concat
        [ ByteString
    "<xml xmlns:v=\"urn:schemas-microsoft-com:vml\" "
        , ByteString
    "xmlns:o=\"urn:schemas-microsoft-com:office:office\" "
        , ByteString
    "xmlns:x=\"urn:schemas-microsoft-com:office:excel\">"
        , ByteString
    commentShapeType
        , [ByteString] -> ByteString
    LB.concat [ByteString]
    commentShapes
        , ByteString
    "</xml>"
        ]
      where
        commentShapeType :: ByteString
    commentShapeType = [ByteString] -> ByteString
    LB.concat
            [ ByteString
    "<v:shapetype id=\"baloon\" coordsize=\"21600,21600\" o:spt=\"202\" "
            , ByteString
    "path=\"m,l,21600r21600,l21600,xe\">"
            , ByteString
    "<v:stroke joinstyle=\"miter\"></v:stroke>"
            , ByteString
    "<v:path gradientshapeok=\"t\" o:connecttype=\"rect\"></v:path>"
            , ByteString
    "</v:shapetype>"
            ]
        fromRef :: CellRef -> (RowIndex, ColumnIndex)
    fromRef CellRef
    cr =
          String -> Maybe (RowIndex, ColumnIndex) -> (RowIndex, ColumnIndex)
    forall a. Partial => String -> Maybe a -> a
    fromJustNote (String
    "Invalid comment ref: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> CellRef -> String
    forall a. Show a => a -> String
    show CellRef
    cr) (Maybe (RowIndex, ColumnIndex) -> (RowIndex, ColumnIndex))
    -> Maybe (RowIndex, ColumnIndex) -> (RowIndex, ColumnIndex)
    forall a b. (a -> b) -> a -> b
    $ CellRef -> Maybe (RowIndex, ColumnIndex)
    fromSingleCellRef CellRef
    cr
        commentShapes :: [ByteString]
    commentShapes = [ (RowIndex, ColumnIndex) -> Bool -> ByteString
    forall {a} {a}.
    (Show a, Show a, Num a, Num a) =>
    (a, a) -> Bool -> ByteString
    commentShape (CellRef -> (RowIndex, ColumnIndex)
    fromRef CellRef
    ref) (Comment -> Bool
    _commentVisible Comment
    cmnt)
                        | (CellRef
    ref, Comment
    cmnt) <- Map CellRef Comment -> [(CellRef, Comment)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map CellRef Comment
    m ]
        commentShape :: (a, a) -> Bool -> ByteString
    commentShape (a
    r, a
    c) Bool
    v = [ByteString] -> ByteString
    LB.concat
            [ ByteString
    "<v:shape type=\"#baloon\" "
            , ByteString
    "style=\"position:absolute;width:auto" -- ;width:108pt;height:59.25pt"
            , if Bool
    v then ByteString
    "" else ByteString
    ";visibility:hidden"
            , ByteString
    "\" fillcolor=\"#ffffe1\" o:insetmode=\"auto\">"
            , ByteString
    "<v:fill color2=\"#ffffe1\"></v:fill><v:shadow color=\"black\" obscured=\"t\"></v:shadow>"
            , ByteString
    "<v:path o:connecttype=\"none\"></v:path><v:textbox style=\"mso-direction-alt:auto\">"
            , ByteString
    "<div style=\"text-align:left\"></div></v:textbox>"
            , ByteString
    "<x:ClientData ObjectType=\"Note\">"
            , ByteString
    "<x:MoveWithCells></x:MoveWithCells><x:SizeWithCells></x:SizeWithCells>"
            , ByteString
    "<x:Anchor>4, 15, 0, 7, 6, 31, 5, 1</x:Anchor><x:AutoFill>False</x:AutoFill>"
            , ByteString
    "<x:Row>"
            , String -> ByteString
    LBC8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show (a
    r a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)
            , ByteString
    "</x:Row>"
            , ByteString
    "<x:Column>"
            , String -> ByteString
    LBC8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show (a
    c a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)
            , ByteString
    "</x:Column>"
            , ByteString
    "</x:ClientData>"
            , ByteString
    "</v:shape>"
            ]