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