{-# 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
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
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. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

empty :: CustomProperties
empty :: CustomProperties
empty = Map Text Variant -> CustomProperties
CustomProperties 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
cprText
"property") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [(Text, Variant)]
parseCustomPropertyEntry
    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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
  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
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
custPropNs
  , namePrefix :: Maybe Text
namePrefix = 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"
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = forall k a. Map k a
M.empty
        , elementNodes :: [Node]
elementNodes      = forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => Name -> a -> Element
toElement Name
"property" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Text, Variant)) -> CustomProperty
CustomProperty)
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..] forall a b. (a -> b) -> a -> b
$ 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
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ Name
"name"  forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
key
                                         , Name
"fmtid" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
userDefinedFmtID
                                         , Name
"pid"   forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= forall a. Integral a => a -> Text
txti Int
i ]
        , elementNodes :: [Node]
elementNodes      = [ Element -> Node
NodeElement 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}"