data XMLTree = Empty|
               Tag FTag|
               Tree [FTag]|
               Content String

-- the  string is the name of the tag (without attributes)
type STag = String  -- single tag (no attributes!!)
type FTag = (STag, XMLTree) -- full tag

-- add a child to a tag; if a list then at at the end
addChild :: XMLTree -> (STag, XMLTree) -> XMLTree
addChild Empty (tag, tree1) = Tag (tag, tree1)
addChild (Tag tag@(ftag, tree)) ftag1 = Tag (ftag, addChild tree ftag1)
addChild (Tree xs) (tag, tree1) =
               Tree (xs ++ [(tag, tree1)])
-- addChild (Content s) (tag, tree1) Not permitted !!!

-- add a tag to the end of the tree
addSerial :: XMLTree -> (STag, XMLTree) -> XMLTree
addSerial Empty (tag, tree1) = Tag (tag, tree1)
addSerial (Tag tag) ftag = Tree [tag, ftag]
addSerial (Tree xs) ftag = Tree (xs ++ [ftag])

getChild :: XMLTree -> XMLTree
getChild Empty = Empty
getChild (Tree []) = Empty
getChild (Tree (x:xs)) = Tag x
getChild (Tag ftag@(stag, Empty)) = Empty
getChild (Tag ftag@(stag, Tag t)) = Tag t
getChild (Tag ftag@(stag, Tree (x:xs))) = Tag x 

getChildrenByName :: XMLTree -> String -> [XMLTree]
getChildrenByName Empty s = [Empty]
getChildrenByName (Tree []) s = [Empty]
getChildrenByName (Tree (x:xs)) s
   | stag == s = (Tag ftag):getChildrenByName (Tree xs) s
   where (ftag@(stag, tree)) = x
getChildrenByName (Tag ftag@(stag, tree)) s
   | stag == s = (Tag ftag):getChildrenByName tree s
   | otherwise = getChildrenByName tree s
   
   
getAllTags :: XMLTree -> [XMLTree]
getAllTags Empty = []
getAllTags (Tree []) = []
getAllTags (Tree (x:xs)) = (Tag x):getAllTags (Tree xs)
getAllTags (Tag ftag@(stag, Empty)) = [(Tag ftag)]
getAllTags (Tag ftag@(stag, tree)) = (Tag ftag):getAllTags tree

getChildren :: XMLTree -> XMLTree
getChildren Empty = Empty
getChildren (Tree []) = Empty
getChildren (Tree t) = Tree t
getChildren (Tag ftag@(stag, tree)) = tree 

showXML :: XMLTree -> String -> String
showXML Empty sep = ""
showXML (Tree []) sep = ""
showXML (Tree (x:xs)) sep =
   (showTag x sep) ++
   "\n" ++ sep ++ (showXML (Tree xs) (sep ++ " "))
showXML (Tag ftag) sep = (showTag ftag sep) 
showXML (Content s) sep = sep ++ s

showXMLlist :: [XMLTree] -> String
showXMLlist [] = ""
showXMLlist (x:xs) = showXML x "" ++ showXMLlist xs

showTag :: FTag -> String -> String
showTag (s, tree) sep = sep ++ "<" ++ s ++ ">" ++ "\n" ++
                 (showXML tree (sep ++ " "))

fileToXML :: XMLTree -> String
fileToXML t =  "<?xml version=\"1.0\"?>\n"  ++ toXML t ""

toXML :: XMLTree -> String -> String
toXML Empty sep = ""
toXML (Tree []) sep = ""
toXML (Tree (x:xs)) sep =
   (toXMLTag x sep) ++ toXML (Tree xs) sep 
toXML (Content s) sep = sep ++ s
toXML (Tag ftag) sep = toXMLTag ftag sep

toXMLTag :: (STag, XMLTree) -> String -> String
toXMLTag (s, tree) sep = sep ++ "<" ++ s ++ ">\n" ++ (toXML tree (sep ++ " "))
                    ++ sep ++ "</" ++ s ++ ">\n"

xml = Empty
tree11 = addChild xml ("test", Empty)
tree1 = (addChild (addChild xml ("test", Empty))  ("test1", Empty))
tree2 = (addChild tree1 ("test2", Empty))
tree3 = (addChild tree2 ("test", Empty))

test = putStr (showXML tree1 "")
test1 = putStr (showXML (getChild tree1) "")
test2 = putStr (showXML (getChildren tree3) "")
test3 = putStr (fileToXML tree3)
test4 = putStr (showXML tree3 "")
test5 = putStr (fileToXML (getChild tree1))
test6 = putStr (showXMLlist (getChildrenByName tree3 "test"))
test7 = putStr (showXMLlist (getAllTags tree3))
test8 = putStr (fileToXML (addSerial tree3 ("add",Empty)))