{-# 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 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
/= :: CommentTable -> CommentTable -> Bool
$c/= :: CommentTable -> CommentTable -> Bool
== :: CommentTable -> CommentTable -> Bool
$c== :: 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
showList :: [CommentTable] -> ShowS
$cshowList :: [CommentTable] -> ShowS
show :: CommentTable -> String
$cshow :: CommentTable -> String
showsPrec :: Int -> CommentTable -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep CommentTable x -> CommentTable
$cfrom :: forall x. CommentTable -> Rep CommentTable x
Generic)

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 :: Name -> Map Name Text -> [Node] -> Element
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
_commentVisible :: Comment -> Bool
_commentAuthor :: Comment -> Text
_commentText :: Comment -> XlsxText
_commentVisible :: Bool
_commentAuthor :: Text
_commentText :: XlsxText
..}) = Element :: Name -> Map Name Text -> [Node] -> Element
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)]
          , 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 (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
    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 (m :: * -> *) a. Monad m => a -> m a
return (CellRef
ref, XlsxText -> Text -> Bool -> Comment
Comment XlsxText
txt Text
author Bool
True)

-- | 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 -> (Int, Int)
fromRef = String -> Maybe (Int, Int) -> (Int, Int)
forall a. Partial => String -> Maybe a -> a
fromJustNote String
"Invalid comment ref" (Maybe (Int, Int) -> (Int, Int))
-> (CellRef -> Maybe (Int, Int)) -> CellRef -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Maybe (Int, Int)
fromSingleCellRef
    commentShapes :: [ByteString]
commentShapes = [ (Int, Int) -> Bool -> ByteString
forall a a.
(Show a, Show a, Num a, Num a) =>
(a, a) -> Bool -> ByteString
commentShape (CellRef -> (Int, Int)
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>"
        ]