gdritter repos nml / master Data / NML / XMLLight.hs
master

Tree @master (Download .tar.gz)

XMLLight.hs @masterraw · history · blame

{-# 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