-- This module contains utilities f or building and pretty printing
-- an XML tree. Attributes are not used but can easily be added to
-- the data statement as follows: ATag ATag  and
-- type ATag = (AtTag, XMLTree)
-- type AtTag = (String,[(String, String)] whereby the
-- attributes are represented by two strings: name and value.
-- Change to previous version: a tag is always composed of a string
-- and a list of XMLTree's; the parent is no longer indicated.

module XML1 where
import "Utils"

-- an XML tree is empty, contains a single tag or a series of tags or
-- a content string
data XMLTree = Empty|
               Tag FTag|
               Content Content

-- declaration of equality.
instance Eq XMLTree where
   Empty == Empty = True
   Tag (s, t) == Tag (s1, t1) = (s == s1) && (t == t1)
   Content s == Content s1 = (s == s1) 
   t1 == t2  = False


-- the  string is the name of the tag (without attributes)
type STag = String  -- single tag (no attributes!!)
-- the tree are the children.
type FTag = (STag, [XMLTree]) -- full tag
type Content = String

-- add a tree to a tree; if the first tree is a tag a child is added;
-- it is not possible to add to a content
addTree :: XMLTree -> XMLTree -> XMLTree
addTree Empty Empty = Empty
addTree t Empty = t
addTree Empty t = t
addTree (Tag tag@(ftag, tree1)) t
                        = Tag (ftag, tree1 ++ [t])
addTree c _ = Empty  -- cannot add to content

-- add a tree list to a tree; 
-- it is not possible to add to a content
addTreeList :: XMLTree -> [XMLTree] -> XMLTree
addTreeList t [] = t
addTreeList Empty t = Empty
addTreeList (Tag tag@(ftag, tree1)) t
                        = Tag (ftag, tree1 ++ t)
addTreeList c _ = Empty  -- cannot add to content

-- add a child to a tag; if a list or content then return Empty
addChild :: XMLTree -> XMLTree -> XMLTree
addChild Empty t = t
addChild (Tag tag@(ftag, tree1)) t
                        = Tag (ftag, tree1 ++ [t])
addChild (Content s) t= Empty -- not permitted !!!
addChild t1 t2 = Empty

-- add content to the end of the tree
-- content may only be added after a tag
addContent :: XMLTree -> XMLTree -> XMLTree
addContent Empty c = Empty
addContent (Tag tag@(tag1, [])) (Content s)
                   = Tag (tag1, [Content s])
addContent (Tag tag@(tag1, t)) (Content s)
                   = Tag (tag1, t ++ [Content s])
addContent t c = Empty

-- get a child or the first child
getChild :: XMLTree -> XMLTree
getChild Empty = Empty
getChild (Tag ftag@(stag,  (x:xs))) = x  -- get first child
getChild t = Empty  -- everything else is certainly bad

-- gets the content of a tag
getContentFromTag :: XMLTree -> XMLTree
getContentFromTag  (Tag tag@(s, t)) = getContentFromList t
getContentFromTag t = Empty

-- gets the content of a tag (the string contained in the content)
getTagContent :: XMLTree -> String
getTagContent t = s
   where Content s = getContentFromTag t
getTagContent t = ""

-- gets the content from a List
getContentFromList [] = Empty
getContentFromList (Content c : ts) = Content c
getContentFromList (t:ts) = getContentFromList ts

-- replace a child tag
replaceChild :: XMLTree -> XMLTree -> String -> XMLTree
replaceChild (Tag tag@(s, t)) t1 s1
   = Tag (s, (replaceChildList t t1 s1))
replaceChild t t1 s = t

-- replace a tag in a list
replaceChildList :: [XMLTree] -> XMLTree -> String -> [XMLTree]
replaceChildList [] t s = []
replaceChildList (x:xs) t s
    | bv1 && s == s1 = t:xs
    | otherwise = replaceChildList xs t s
    where bv1 = testTag x
          Tag t1@(s1,_) =x

-- get the first child with a specific name
getChildByName :: XMLTree -> String -> XMLTree
getChildByName Empty s = Empty
getChildByName (Tag ftag@(stag, t)) s =
   getTagFromList t s
getChildByName t s = Empty

-- get a tag from a list
getTagFromList :: [XMLTree] -> String -> XMLTree
getTagFromList [] s = Empty
getTagFromList (x:xs)  s
    | bv1 && s == s1 = x
    | otherwise = getTagFromList xs s
    where bv1 = testTag x
          Tag t1@(s1,_) =x

-- get all tags with a given name
getChildrenByName :: XMLTree -> String -> [XMLTree]
getChildrenByName Empty s = []
getChildrenByName (Tag ftag@(stag, tree)) s
   = getTagsByNameFromList tree s
getChildrenByName t s = []

-- get all  tags with a given name from a list
getTagsByNameFromList :: [XMLTree] -> String -> [XMLTree]
getTagsByNameFromList [] s = []
getTagsByNameFromList (x:xs)  s
    | bv1 && s == s1 = x:getTagsByNameFromList xs s
    | otherwise = getTagsByNameFromList xs s
    where bv1 = testTag x
          Tag t1@(s1,_) =x


-- get all tags with a given name that directly descend from the given tag
getDirectChildrenByName :: XMLTree -> String -> [XMLTree]
getDirectChildrenByName (Tag ftag@(stag,  tree)) s =
   getDirectChildrenByNameFromList tree
   where getDirectChildrenByNameFromList :: [XMLTree] -> [XMLTree]
         getDirectChildrenByNameFromList [] = []
         getDirectChildrenByNameFromList ((Tag t@(s1, _)):ts) 
             | s1 == s = (Tag t):getDirectChildrenByNameFromList ts
             | otherwise = getDirectChildrenByNameFromList ts
         getDirectChildrenByNameFromList (t:ts) =
            getDirectChildrenByNameFromList ts
getDirectChildrenByName t s = []
   
-- get a list of all tags in a tree
getAllTags :: XMLTree -> [XMLTree]
getAllTags Empty = []
getAllTags (Tag ftag@(stag, tree)) = (Tag ftag):tree
getAllTags (Content c) = [(Content c)]

-- modify the name of a tag
modifyTagName :: XMLTree -> String -> XMLTree
modifyTagName (Tag (tag, tree)) newName
                     = Tag (newName, tree)
modifyTagName t newName = t   -- no tag; do nothing

-- get all children of a tag; if a tree return empty 
getChildren :: XMLTree -> [XMLTree]
getChildren Empty = []
getChildren (Tag ftag@(stag, tree)) = tree 
getChildren t = []

-- walk a tree. The first input is the tree to walk.
-- The second input is a function that takes as input an XML tree
-- and as output an XML Tree. This function is applied to every
-- Tag or Content of the input tree and must return resp. Tag and Content.
-- The output tree is the modified input tree.
walkATree :: XMLTree -> (XMLTree -> XMLTree) -> XMLTree
walkATree (Tag tag) f = (Tag (s, (walkAList t f)))
   where Tag (s, t) = f (Tag tag)
         walkAList [] f = []
         walkAList (x:xs) f = (f x):walkAList xs f
walkATree c f = f c  -- Content

-- select from a tree. The first input is the tree to select from.
-- The second input is a function that takes as input an XML tree
-- and as output an XML Tree. This function is applied to every
-- Tag or Content of the input tree and must return resp. Tag and Content.
-- The output tree is the concatenation of
-- the output from this function.
selectFromTree :: XMLTree -> (XMLTree -> [XMLTree]) -> [XMLTree]
selectFromTree Empty f = f Empty
selectFromTree (Tag tag@(s, t)) f  
   = (f (Tag tag)) ++ selectFromList t f
   where selectFromList [] f = []
         selectFromList (x:xs) f = (f x) ++ selectFromList xs f
selectFromTree c f = f c  -- content

-- eliminate all empty trees
eliminateEmpties :: [XMLTree] -> [XMLTree]
eliminateEmpties [] = []
eliminateEmpties (t:ts)
   | t == Empty = eliminateEmpties ts
   | otherwise = t:eliminateEmpties ts

-- show a list of trees in XML format
treeListToXML :: [XMLTree] -> String
treeListToXML [] = ""
treeListToXML (x:xs) = fileToXML x ++ "\n\n" ++ treeListToXML xs


-- show a tree in XML format including the xml tag
fileToXML :: XMLTree -> String
fileToXML t =  "<?xml version=\"1.0\"?>\n"  ++ toXML t ""

-- show a tree in xml format
toXML :: XMLTree -> String -> String
toXML Empty sep = ""
toXML (Content (s)) sep = sep ++ s ++ "\n"
toXML (Tag ftag) sep = toXMLTag ftag sep
toXML t sep = ""

-- show a tag in xml format
toXMLTag :: FTag -> String -> String
toXMLTag (s, tree) sep = sep ++ "<" ++ s ++ ">\n"
                    ++ (treeToXML tree (sep++ind))
                    ++ sep ++ "</" ++ s ++ ">\n"

-- show a tree with no header
treeToXML :: [XMLTree] -> String -> String
treeToXML [] sep = ""
treeToXML (x:xs) sep = toXML x sep ++ treeToXML xs sep


-- search if there is content that contains a certain string
searchContent :: [XMLTree] -> String -> Bool
searchContent [] s = False
searchContent (Content c@(s1):xs) s
   | containsString s s1 = True
   | otherwise = searchContent xs s
searchContent (x:xs) s = searchContent xs s

-- get content that contains a certain string
getContent :: [XMLTree] -> String -> XMLTree
getContent [] s = Empty
getContent (Content c@(s1):xs) s
   | containsString s s1 = Content c
   | otherwise = getContent xs s
getContent (x:xs) s = getContent xs s

-- test if a XMLTree is a Tag
testTag :: XMLTree -> Bool
testTag (Tag t) = True
testTag c = False

-- test if a XMLTree is Content
testContent :: XMLTree -> Bool
testContent (Content c) = True
testContent c = False


-- indent constant
ind = "  "

testWalkATree = putStr(fileToXML(walkATree tree4 f))
                where f (Tag (s, t)) = Tag ("Ha!", t)
                      f t = t

-- testdata

xml = Empty
tree11 = addChild xml (Tag("test",[]))
tree1 = (addChild (addChild xml (Tag("test", [])))
                            (Tag("test1",[])))
tree2 = (addChild tree1 (Tag("test2", [])))
showTree2 = putStr( fileToXML( tree2))
tree3 = (addChild tree2 (Tag("test",[])))
tree4 = (addTree (addChild (addChild xml (Tag("test",[])))
         (Tag("test1", []))) (Content ("Test content")))

test = putStr (fileToXML tree1)
test1 = putStr (fileToXML (getChild tree1)) 
test13 = putStr (fileToXML tree11)
test2 = putStr (treeListToXML (getChildren tree3))
test3 = putStr (fileToXML tree3)
test4 = putStr (fileToXML tree3)
test5 = putStr (fileToXML (getChild tree1))
test52 = putStr (fileToXML tree1)
test6 = putStr (treeListToXML (getChildrenByName tree3 "test"))
test7 = putStr (treeListToXML (getAllTags tree3))
test8 = putStr (fileToXML (addTree tree3 (Tag("add",[]))))
test9 = putStr (fileToXML (addTree tree3 (Tag("add",[]))))
test10 = putStr (fileToXML tree4)
test11 = putStr (fileToXML tree4) 
test16 = putStr (fileToXML(addTree tree11 (Tag ("ttt", []))))