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 -- FIXME: parser for attr value
    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