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

Tree @master (Download .tar.gz)

XMLTypes.hs @masterraw · history · blame

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