{-# LANGUAGE RecordWildCards #-}
-- | Module for converting an internal NML datum to the
-- @Data.XML.Types@ module provided by the package @xml-types@.
module Data.NML.XMLTypes
( decode
, module Data.XML.Types
) where
import Control.Monad ((>=>))
import Data.Text (Text)
import Data.XML.Types
import Data.NML.Parse
toMaybe :: Either a b -> Maybe b
toMaybe (Right x) = Just x
toMaybe _ = Nothing
-- | Parse raw text to Content
decode :: Text -> Maybe Node
decode = toMaybe . (parseNML >=> toPair)
-- | Take an NML @<x|y>@ pair to an XML node datum
toPair :: NMLPair -> Either String Node
toPair NMLPair { .. } = do
elementName <- toName pName
elementAttributes <- mapM toAttr pAttrs
elementNodes <- mapM toElement pElems
return (NodeElement (Element { .. }))
-- | Take an NML name to an XML name datum
toName :: Text -> Either String Name
toName n = return $ Name
{ nameLocalName = n
, nameNamespace = Nothing
, namePrefix = Nothing
}
-- | Take an NML @<x|y>@ pair to an XML attribute. Note that
-- it is not valid for nested pairs to be attributes.
toAttr :: NMLPair -> Either String (Name, [Content])
toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [ EText t ] }) = do
nm' <- toName nm
return (nm', [ContentText t])
toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [] }) = do
nm' <- toName nm
return (nm', [])
toAttr p@(NMLPair { pAttrs = (_:_)}) =
fail ("Attributes can't have their own attributes: " ++ show p)
toAttr p =
fail ("Attribute values must be raw text: " ++ show p)
-- | Take an NML element to an XML content node
toElement :: NMLElem -> Either String Node
toElement (EEntity t) = return $ NodeContent (ContentEntity t)
toElement (EText t) = return $ NodeContent (ContentText t)
toElement (EPair p) = toPair p