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

import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Variant
import Codec.Xlsx.Writer.Internal

newtype CustomProperties = CustomProperties (Map Text Variant)
    deriving (CustomProperties -> CustomProperties -> Bool
(CustomProperties -> CustomProperties -> Bool)
-> (CustomProperties -> CustomProperties -> Bool)
-> Eq CustomProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomProperties -> CustomProperties -> Bool
$c/= :: CustomProperties -> CustomProperties -> Bool
== :: CustomProperties -> CustomProperties -> Bool
$c== :: CustomProperties -> CustomProperties -> Bool
Eq, Int -> CustomProperties -> ShowS
[CustomProperties] -> ShowS
CustomProperties -> String
(Int -> CustomProperties -> ShowS)
-> (CustomProperties -> String)
-> ([CustomProperties] -> ShowS)
-> Show CustomProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomProperties] -> ShowS
$cshowList :: [CustomProperties] -> ShowS
show :: CustomProperties -> String
$cshow :: CustomProperties -> String
showsPrec :: Int -> CustomProperties -> ShowS
$cshowsPrec :: Int -> CustomProperties -> ShowS
Show, (forall x. CustomProperties -> Rep CustomProperties x)
-> (forall x. Rep CustomProperties x -> CustomProperties)
-> Generic CustomProperties
forall x. Rep CustomProperties x -> CustomProperties
forall x. CustomProperties -> Rep CustomProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomProperties x -> CustomProperties
$cfrom :: forall x. CustomProperties -> Rep CustomProperties x
Generic)

fromList :: [(Text, Variant)] -> CustomProperties
fromList :: [(Text, Variant)] -> CustomProperties
fromList = Map Text Variant -> CustomProperties
CustomProperties (Map Text Variant -> CustomProperties)
-> ([(Text, Variant)] -> Map Text Variant)
-> [(Text, Variant)]
-> CustomProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

empty :: CustomProperties
empty :: CustomProperties
empty = Map Text Variant -> CustomProperties
CustomProperties Map Text Variant
forall k a. Map k a
M.empty

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

instance FromCursor CustomProperties where
  fromCursor :: Cursor -> [CustomProperties]
fromCursor Cursor
cur = do
    let items :: [(Text, Variant)]
items = Cursor
cur Cursor -> (Cursor -> [(Text, Variant)]) -> [(Text, Variant)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
cprText
"property") Axis
-> (Cursor -> [(Text, Variant)]) -> Cursor -> [(Text, Variant)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [(Text, Variant)]
parseCustomPropertyEntry
    CustomProperties -> [CustomProperties]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Variant)] -> CustomProperties
fromList [(Text, Variant)]
items)

parseCustomPropertyEntry :: Cursor -> [(Text, Variant)]
parseCustomPropertyEntry :: Cursor -> [(Text, Variant)]
parseCustomPropertyEntry Cursor
cur = do
  Text
name <- Name -> Cursor -> [Text]
attribute Name
"name" Cursor
cur
  Variant
value <- Cursor
cur Cursor -> (Cursor -> [Variant]) -> [Variant]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement Axis -> (Cursor -> [Variant]) -> Cursor -> [Variant]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Variant]
forall a. FromCursor a => Cursor -> [a]
fromCursor
  (Text, Variant) -> [(Text, Variant)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Variant
value)

-- | Add custom properties namespace to name
cpr :: Text -> Name
cpr :: Text -> Name
cpr Text
x = Name :: Text -> Maybe Text -> Maybe Text -> Name
Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
custPropNs
  , namePrefix :: Maybe Text
namePrefix = Maybe Text
forall a. Maybe a
Nothing
  }

custPropNs :: Text
custPropNs :: Text
custPropNs = Text
"http://schemas.openxmlformats.org/officeDocument/2006/custom-properties"

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToDocument CustomProperties where
    toDocument :: CustomProperties -> Document
toDocument =
        Text -> Text -> Element -> Document
documentFromNsElement Text
"Custom properties generated by xlsx"
        Text
"http://schemas.openxmlformats.org/officeDocument/2006/custom-properties"
        (Element -> Document)
-> (CustomProperties -> Element) -> CustomProperties -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CustomProperties -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"Properties"

instance ToElement CustomProperties where
    toElement :: Name -> CustomProperties -> Element
toElement Name
nm (CustomProperties Map Text Variant
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      = ((Int, (Text, Variant)) -> Node)
-> [(Int, (Text, Variant))] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node)
-> ((Int, (Text, Variant)) -> Element)
-> (Int, (Text, Variant))
-> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CustomProperty -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"property" (CustomProperty -> Element)
-> ((Int, (Text, Variant)) -> CustomProperty)
-> (Int, (Text, Variant))
-> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Text, Variant)) -> CustomProperty
CustomProperty)
                              ([(Int, (Text, Variant))] -> [Node])
-> ([(Text, Variant)] -> [(Int, (Text, Variant))])
-> [(Text, Variant)]
-> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Text, Variant)] -> [(Int, (Text, Variant))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..] ([(Text, Variant)] -> [Node]) -> [(Text, Variant)] -> [Node]
forall a b. (a -> b) -> a -> b
$ Map Text Variant -> [(Text, Variant)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Variant
m
        }

newtype CustomProperty = CustomProperty (Int, (Text, Variant))

instance ToElement CustomProperty where
    toElement :: Name -> CustomProperty -> Element
toElement Name
nm (CustomProperty (Int
i, (Text
key, Variant
val))) = Element :: Name -> Map Name Text -> [Node] -> Element
Element
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ Name
"name"  Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
key
                                         , Name
"fmtid" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
userDefinedFmtID
                                         , Name
"pid"   Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int -> Text
forall a. Integral a => a -> Text
txti Int
i ]
        , elementNodes :: [Node]
elementNodes      = [ Element -> Node
NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Variant -> Element
variantToElement Variant
val ]
        }

-- | FMTID_UserDefinedProperties
userDefinedFmtID :: Text
userDefinedFmtID :: Text
userDefinedFmtID = Text
"{D5CDD505-2E9C-101B-9397-08002B2CF9AE}"