module Text.Roundtrip.Xml.Classes (
XmlSyntax(..), Attribute
) where
import Data.Text as T
import Data.XML.Types (Name(..), Content)
import qualified Text.PrettyPrint.HughesPJ as P
import Text.Roundtrip.Classes
import Text.Roundtrip.SpecPrinter
type Attribute = (Name, [Content])
class Syntax delta => XmlSyntax delta where
xmlBeginDoc :: delta ()
xmlEndDoc :: delta ()
xmlBeginElem :: Name -> delta ()
xmlEndElem :: Name -> delta ()
xmlAttrValue :: Name -> delta T.Text
xmlTextNotEmpty :: delta T.Text
instance XmlSyntax SpecPrinter where
xmlBeginDoc = specPrinter $ P.text "begin-doc"
xmlEndDoc = specPrinter $ P.text "end-doc"
xmlBeginElem name = specPrinter $ P.text "<" P.<> P.text (format name) P.<+> P.text "...>"
xmlEndElem name = specPrinter $ P.text "</" P.<> P.text (format name) P.<> P.text ">"
xmlAttrValue name = specPrinter $ P.text "attr" P.<+> P.text (format name)
xmlTextNotEmpty = specPrinter $ P.text "text-node"
format :: Name -> String
format n =
case n of
Name localName _ (Just prefix) -> T.unpack prefix ++ ':' : T.unpack localName
Name localName (Just ns) Nothing -> '{' : (T.unpack ns ++ '}' : T.unpack localName)
Name localName Nothing Nothing -> T.unpack localName