module Codec.Xlsx.Writer.Internal (
ToDocument(..)
, documentFromElement
, ToElement(..)
, elementList
, elementContent
, elementValue
, ToAttrVal(..)
, (.=)
, (.=?)
, addNS
, mainNamespace
) where
import Data.Text (Text)
import Data.String (fromString)
import Text.XML
import qualified Data.Map as Map
class ToDocument a where
toDocument :: a -> Document
documentFromElement :: Text -> Element -> Document
documentFromElement comment e = Document {
documentRoot = addNS mainNamespace e
, documentEpilogue = []
, documentPrologue = Prologue {
prologueBefore = [MiscComment comment]
, prologueDoctype = Nothing
, prologueAfter = []
}
}
class ToElement a where
toElement :: Name -> a -> Element
elementList :: Name -> [Element] -> Element
elementList nm as = Element {
elementName = nm
, elementNodes = map NodeElement as
, elementAttributes = Map.fromList [ "count" .= length as ]
}
elementContent :: Name -> Text -> Element
elementContent nm txt = Element {
elementName = nm
, elementAttributes = Map.fromList [ preserveSpace ]
, elementNodes = [NodeContent txt]
}
where
preserveSpace = (
Name { nameLocalName = "space"
, nameNamespace = Just "http://www.w3.org/XML/1998/namespace"
, namePrefix = Nothing
}
, "preserve"
)
class ToAttrVal a where
toAttrVal :: a -> Text
instance ToAttrVal Text where toAttrVal = id
instance ToAttrVal String where toAttrVal = fromString
instance ToAttrVal Int where toAttrVal = fromString . show
instance ToAttrVal Double where toAttrVal = fromString . show
instance ToAttrVal Bool where
toAttrVal True = "true"
toAttrVal False = "false"
elementValue :: ToAttrVal a => Name -> a -> Element
elementValue nm a = Element {
elementName = nm
, elementAttributes = Map.fromList [ "val" .= a ]
, elementNodes = []
}
(.=) :: ToAttrVal a => Name -> a -> (Name, Text)
nm .= a = (nm, toAttrVal a)
(.=?) :: ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
_ .=? Nothing = Nothing
nm .=? (Just a) = Just (nm .= a)
addNS :: Text -> Element -> Element
addNS ns Element{..} = Element{
elementName = goName elementName
, elementAttributes = elementAttributes
, elementNodes = map goNode elementNodes
}
where
goName :: Name -> Name
goName n@Name{..} =
case nameNamespace of
Just _ -> n
Nothing -> Name{
nameLocalName = nameLocalName
, nameNamespace = Just ns
, namePrefix = Nothing
}
goNode :: Node -> Node
goNode (NodeElement e) = NodeElement $ addNS ns e
goNode n = n
mainNamespace :: Text
mainNamespace = "http://schemas.openxmlformats.org/spreadsheetml/2006/main"