-- UUAGC 0.9.7 (src/Text/Xml/Xml.ag) module Text.Xml.Xml where import Misc.Commons (ss) type Namespace = String type Comment = String type Text = String type NodePair = (Node, Node) type NodeMap = [NodePair] doc = Node_Doc text = Node_Text comment = Node_Comment nodeset = Node_NodeSet snippet = Node_Snippet empty = Node_Empty elementNS ns e = Node_Element ns e [] element = elementNS "" attributeNS ns k v (Node_Element n' e a s) = Node_Element n' e ((Attribute_Attribute ns k v):a) s attribute = attributeNS "" -- Determine whether an XML node has significant data. significant (Node_NodeSet []) = False significant (Node_Text "") = False significant (Node_Comment "") = False significant (Node_Empty ) = False significant _ = True -- todo: use utils. ppNodeset [] _ = id ppNodeset [n] mixed = n ppNodeset ns mixed = c . foldl1 (\a -> ((a.c).)) ns . c where c = if mixed then id else ss "\n" ppNs "" = ss "" ppNs ns = ss (ns ++ ":") -- Escape special characters in text that will end up in an XML document. escape :: String -> String escape [] = [] escape ('<':xs) = "<" ++ escape xs escape ('>':xs) = ">" ++ escape xs escape ('&':xs) = "&" ++ escape xs escape ('"':xs) = """ ++ escape xs escape (x:xs) = x : escape xs wrappedSemNode = flip (wrap_Node . sem_Node) Inh_Node instance Show Node where show = xmlToString xmlToString :: Node -> String xmlToString = ($"") . pp_Syn_Node . wrappedSemNode -- Attribute --------------------------------------------------- {- visit 0: synthesized attribute: pp : ShowS alternatives: alternative Attribute: child namespace : {Namespace} child key : {String} child value : {String} -} data Attribute = Attribute_Attribute (Namespace) (String) (String) deriving ( Eq) -- cata sem_Attribute :: Attribute -> T_Attribute sem_Attribute (Attribute_Attribute _namespace _key _value ) = (sem_Attribute_Attribute _namespace _key _value ) -- semantic domain type T_Attribute = ( ShowS) data Inh_Attribute = Inh_Attribute {} data Syn_Attribute = Syn_Attribute {pp_Syn_Attribute :: ShowS} wrap_Attribute :: T_Attribute -> Inh_Attribute -> Syn_Attribute wrap_Attribute sem (Inh_Attribute ) = (let ( _lhsOpp) = (sem ) in (Syn_Attribute _lhsOpp )) sem_Attribute_Attribute :: Namespace -> String -> String -> T_Attribute sem_Attribute_Attribute namespace_ key_ value_ = (let _lhsOpp :: ShowS -- "src/Text/Xml/Xml.ag"(line 105, column 15) _lhsOpp = ppNs namespace_ . ss key_ . ss "=\"" . ss (escape value_) . ss "\"" in ( _lhsOpp)) -- Attributes -------------------------------------------------- {- visit 0: synthesized attribute: pp : ShowS alternatives: alternative Cons: child hd : Attribute child tl : Attributes alternative Nil: -} type Attributes = [(Attribute)] -- cata sem_Attributes :: Attributes -> T_Attributes sem_Attributes list = (Prelude.foldr sem_Attributes_Cons sem_Attributes_Nil (Prelude.map sem_Attribute list) ) -- semantic domain type T_Attributes = ( ShowS) data Inh_Attributes = Inh_Attributes {} data Syn_Attributes = Syn_Attributes {pp_Syn_Attributes :: ShowS} wrap_Attributes :: T_Attributes -> Inh_Attributes -> Syn_Attributes wrap_Attributes sem (Inh_Attributes ) = (let ( _lhsOpp) = (sem ) in (Syn_Attributes _lhsOpp )) sem_Attributes_Cons :: T_Attribute -> T_Attributes -> T_Attributes sem_Attributes_Cons hd_ tl_ = (let _lhsOpp :: ShowS _hdIpp :: ShowS _tlIpp :: ShowS -- "src/Text/Xml/Xml.ag"(line 108, column 15) _lhsOpp = ss " " . _hdIpp . _tlIpp ( _hdIpp) = (hd_ ) ( _tlIpp) = (tl_ ) in ( _lhsOpp)) sem_Attributes_Nil :: T_Attributes sem_Attributes_Nil = (let _lhsOpp :: ShowS -- use rule "src/Text/Xml/Xml.ag"(line 93, column 41) _lhsOpp = id in ( _lhsOpp)) -- Node -------------------------------------------------------- {- visit 0: synthesized attributes: mixed : Bool pp : ShowS alternatives: alternative Comment: child comment : {Comment} alternative Doc: child root : Node alternative Element: child namespace : {Namespace} child name : {String} child attributes : Attributes child childNodes : Node alternative Empty: alternative NodeSet: child nodes : NodeSet alternative Snippet: child snippet : {String} alternative Text: child text : {Text} -} data Node = Node_Comment (Comment) | Node_Doc (Node) | Node_Element (Namespace) (String) (Attributes) (Node) | Node_Empty | Node_NodeSet (NodeSet) | Node_Snippet (String) | Node_Text (Text) deriving ( Eq) -- cata sem_Node :: Node -> T_Node sem_Node (Node_Comment _comment ) = (sem_Node_Comment _comment ) sem_Node (Node_Doc _root ) = (sem_Node_Doc (sem_Node _root ) ) sem_Node (Node_Element _namespace _name _attributes _childNodes ) = (sem_Node_Element _namespace _name (sem_Attributes _attributes ) (sem_Node _childNodes ) ) sem_Node (Node_Empty ) = (sem_Node_Empty ) sem_Node (Node_NodeSet _nodes ) = (sem_Node_NodeSet (sem_NodeSet _nodes ) ) sem_Node (Node_Snippet _snippet ) = (sem_Node_Snippet _snippet ) sem_Node (Node_Text _text ) = (sem_Node_Text _text ) -- semantic domain type T_Node = ( Bool,ShowS) data Inh_Node = Inh_Node {} data Syn_Node = Syn_Node {mixed_Syn_Node :: Bool,pp_Syn_Node :: ShowS} wrap_Node :: T_Node -> Inh_Node -> Syn_Node wrap_Node sem (Inh_Node ) = (let ( _lhsOmixed,_lhsOpp) = (sem ) in (Syn_Node _lhsOmixed _lhsOpp )) sem_Node_Comment :: Comment -> T_Node sem_Node_Comment comment_ = (let _lhsOpp :: ShowS _lhsOmixed :: Bool -- "src/Text/Xml/Xml.ag"(line 102, column 15) _lhsOpp = ss "" -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = False in ( _lhsOmixed,_lhsOpp)) sem_Node_Doc :: T_Node -> T_Node sem_Node_Doc root_ = (let _lhsOmixed :: Bool _lhsOpp :: ShowS _rootImixed :: Bool _rootIpp :: ShowS -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = _rootImixed -- use rule "src/Text/Xml/Xml.ag"(line 93, column 41) _lhsOpp = _rootIpp ( _rootImixed,_rootIpp) = (root_ ) in ( _lhsOmixed,_lhsOpp)) sem_Node_Element :: Namespace -> String -> T_Attributes -> T_Node -> T_Node sem_Node_Element namespace_ name_ attributes_ childNodes_ = (let _lhsOmixed :: Bool _lhsOpp :: ShowS _attributesIpp :: ShowS _childNodesImixed :: Bool _childNodesIpp :: ShowS -- "src/Text/Xml/Xml.ag"(line 68, column 13) _lhsOmixed = False -- "src/Text/Xml/Xml.ag"(line 98, column 15) _lhsOpp = ss "<" . ppNs namespace_ . ss name_ . _attributesIpp . ss ">" . _childNodesIpp . ss "" ( _attributesIpp) = (attributes_ ) ( _childNodesImixed,_childNodesIpp) = (childNodes_ ) in ( _lhsOmixed,_lhsOpp)) sem_Node_Empty :: T_Node sem_Node_Empty = (let _lhsOmixed :: Bool _lhsOpp :: ShowS -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = False -- use rule "src/Text/Xml/Xml.ag"(line 93, column 41) _lhsOpp = id in ( _lhsOmixed,_lhsOpp)) sem_Node_NodeSet :: T_NodeSet -> T_Node sem_Node_NodeSet nodes_ = (let _lhsOpp :: ShowS _lhsOmixed :: Bool _nodesImixed :: Bool _nodesIpp :: ([ShowS]) -- "src/Text/Xml/Xml.ag"(line 97, column 15) _lhsOpp = ppNodeset _nodesIpp _nodesImixed -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = _nodesImixed ( _nodesImixed,_nodesIpp) = (nodes_ ) in ( _lhsOmixed,_lhsOpp)) sem_Node_Snippet :: String -> T_Node sem_Node_Snippet snippet_ = (let _lhsOpp :: ShowS _lhsOmixed :: Bool -- "src/Text/Xml/Xml.ag"(line 101, column 15) _lhsOpp = ss snippet_ -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = False in ( _lhsOmixed,_lhsOpp)) sem_Node_Text :: Text -> T_Node sem_Node_Text text_ = (let _lhsOmixed :: Bool _lhsOpp :: ShowS -- "src/Text/Xml/Xml.ag"(line 67, column 13) _lhsOmixed = True -- "src/Text/Xml/Xml.ag"(line 100, column 15) _lhsOpp = ss (escape text_) in ( _lhsOmixed,_lhsOpp)) -- NodeSet ----------------------------------------------------- {- visit 0: synthesized attributes: mixed : Bool pp : [ShowS] alternatives: alternative Cons: child hd : Node child tl : NodeSet alternative Nil: -} type NodeSet = [(Node)] -- cata sem_NodeSet :: NodeSet -> T_NodeSet sem_NodeSet list = (Prelude.foldr sem_NodeSet_Cons sem_NodeSet_Nil (Prelude.map sem_Node list) ) -- semantic domain type T_NodeSet = ( Bool,([ShowS])) data Inh_NodeSet = Inh_NodeSet {} data Syn_NodeSet = Syn_NodeSet {mixed_Syn_NodeSet :: Bool,pp_Syn_NodeSet :: [ShowS]} wrap_NodeSet :: T_NodeSet -> Inh_NodeSet -> Syn_NodeSet wrap_NodeSet sem (Inh_NodeSet ) = (let ( _lhsOmixed,_lhsOpp) = (sem ) in (Syn_NodeSet _lhsOmixed _lhsOpp )) sem_NodeSet_Cons :: T_Node -> T_NodeSet -> T_NodeSet sem_NodeSet_Cons hd_ tl_ = (let _lhsOmixed :: Bool _lhsOpp :: ([ShowS]) _hdImixed :: Bool _hdIpp :: ShowS _tlImixed :: Bool _tlIpp :: ([ShowS]) -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = _hdImixed || _tlImixed -- use rule "src/Text/Xml/Xml.ag"(line 94, column 41) _lhsOpp = _hdIpp : _tlIpp ( _hdImixed,_hdIpp) = (hd_ ) ( _tlImixed,_tlIpp) = (tl_ ) in ( _lhsOmixed,_lhsOpp)) sem_NodeSet_Nil :: T_NodeSet sem_NodeSet_Nil = (let _lhsOmixed :: Bool _lhsOpp :: ([ShowS]) -- use rule "src/Text/Xml/Xml.ag"(line 64, column 31) _lhsOmixed = False -- use rule "src/Text/Xml/Xml.ag"(line 94, column 41) _lhsOpp = [] in ( _lhsOmixed,_lhsOpp))