{-# LANGUAGE RecordWildCards #-}
-- | Module for converting an internal NML datum to the
-- @Text.XML.Light@ module provided by the package @xml@.
module Data.NML.XMLLight
( decode
, encode
, module Text.XML.Light.Types
) where
import Control.Monad ((>=>))
import Data.Text (Text, unpack, pack)
import Text.XML.Light.Output (showContent)
import Text.XML.Light.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 Content
decode = toMaybe . (parseNML >=> toPair)
-- | Convert Content to NML
encode :: Content -> Text
encode = pack . showContent
-- | Take an NML @<x|y>@ pair to an XML node datum
toPair :: NMLPair -> Either String Content
toPair NMLPair { .. } = do
elName <- toName pName
elAttribs <- mapM toAttr pAttrs
elContent <- mapM toElement pElems
let elLine = Nothing
return (Elem (Element { .. }))
-- | Take an NML name to an XML name datum
toName :: Text -> Either String QName
toName n = return $ QName
{ qName = unpack n
, qURI = Nothing
, qPrefix = 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 Attr
toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [ EText t ] }) = do
attrKey <- toName nm
let attrVal = unpack t
return Attr { .. }
toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [] }) = do
attrKey <- toName nm
let attrVal = ""
return Attr { .. }
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 Content
toElement (EEntity t) =
return $ Text (CData { cdVerbatim = CDataRaw
, cdData = "&" ++ unpack t ++ ";"
, cdLine = Nothing
})
toElement (EText t) =
return $ Text (CData { cdVerbatim = CDataText
, cdData = unpack t
, cdLine = Nothing
})
toElement (EPair p) = toPair p