module TPDB.Data.Xml where
import TPDB.Data
import TPDB.Xml
import Text.XML.HaXml.Types (QName (..) )
import Text.XML.HaXml.XmlContent.Haskell hiding ( element, many )
import Data.Typeable
instance XmlContent Identifier where
parseContents = do
CString _ s _ <- next
return $ mknullary s
toContents i =
[ CString False ( escape $ show i ) () ]
instance ( Typeable ( Term v c ) , XmlContent v, XmlContent c )
=> XmlContent ( Term v c ) where
toContents ( Var v ) = rmkel "var" $ toContents v
toContents ( Node f args ) = rmkel "funapp"
$ sharp_name_HACK ( toContents f )
++ map ( \ arg -> mkel "arg" $ toContents arg ) args
sharp_name_HACK e = case e of
[ CElem ( Elem (N "sharp") [] cs ) () ] ->
rmkel "sharp" $ rmkel "name" cs
_ -> rmkel "name" e
instance HTypeable ( Rule ( Term v c )) where
toHType _ = Prim "Rule" "Rule"
instance ( HTypeable ( Rule ( Term v c) )
, XmlContent ( Term v c ) )
=> XmlContent ( Rule ( Term v c ) ) where
toContents u =
return $ mkel "rule"
[ mkel "lhs" $ toContents $ lhs u
, mkel "rhs" $ toContents $ rhs u
]