generic-xml-0.1: Xml/HaXml.hs

{-# LANGUAGE TemplateHaskell, FlexibleInstances,
             OverlappingInstances, UndecidableInstances #-}

module Xml.HaXml where

import Data.List
import Xml.Base
import qualified Text.XML.HaXml.Types as H

isAttr :: Element -> Bool
isAttr (Attr {}) = True
isAttr _ = False

toHaXmls :: [Element] -> [H.Content]
toHaXmls = map toHaXml

toHaXml :: Element -> H.Content
toHaXml (Elem n es) = case partition isAttr es of
                      (as, xs) ->
                          H.CElem (H.Elem n (map toAttribute as) (toHaXmls xs))
toHaXml (CData x) = H.CString True x
-- We can't do better than wrap an attribute up in a fake element.
-- This shouldn't be happening in the real world anyway.
toHaXml a@(Attr {}) = toHaXml (Elem "JustAnAttr" [a])

toAttribute :: Element -> H.Attribute
toAttribute (Attr k v) = (k, H.AttValue [Left v])
toAttribute _ = error "toAttribute: Can't happen"

fromHaXmls :: [H.Content] -> [Element]
fromHaXmls = map fromHaXml

fromHaXml :: H.Content -> Element
fromHaXml (H.CElem (H.Elem n as xs))
    = Elem n (fromAttributes as ++ fromHaXmls xs)
fromHaXml (H.CString _ x) = CData x
fromHaXml _ = error "fromHaXml: Not implemented"

fromAttributes :: [H.Attribute] -> [Element]
fromAttributes = map fromAttribute

fromAttribute :: H.Attribute -> Element
fromAttribute (k, H.AttValue [Left v]) = Attr k v
fromAttribute _ = error "fromAttribute: Not implemented"