-- XML processing
import Control.SetFunctions
import XML

{-
-- Data type for simple XML documents
data XmlExp = XText String
            | XElem String [(String,String)] [XmlExp]

xtxt :: String -> XmlExp
xtxt s = XText s

xml :: String -> [XmlExp] -> XmlExp
xml t xs = XElem t [] xs
-}

entry1 :: XmlExp
entry1 = xml "entry"
             [xml "name"  [xtxt "Hanus"],
              xml "first" [xtxt "Michael"],
              --xml "phone" [xtxt "+49-431-8807271"],
              XElem "phone" [("place","office")] [xtxt "+49-431-8807271"],
              xml "email" [xtxt "mh@informatik.uni-kiel.de"],
              xml "email" [xtxt "hanus@email.uni-kiel.de"]]

entry2 :: XmlExp
entry2 = xml "entry"
             [xml "nickname" [xtxt "Bill"],
              xml "name"  [xtxt "Smith"],
              xml "phone" [xtxt "+1-987-742-9388"],
              xml "first" [xtxt "William"]]

-- Representation of the contacts data:
contacts :: XmlExp
contacts = xml "contacts" [entry1,entry2]

-- Get name/phone of an entry:
getNamePhone0 :: XmlExp -> String
getNamePhone0
  (xml "entry"
       [xml "name"  [xtxt name],
        _, _,
        xml "phone" [xtxt phone]]) = name ++ ": " ++ phone

getNamePhone1 :: XmlExp -> String
getNamePhone1
  (xml "entry"
       (with [xml "name"  [xtxt name],
              xml "phone" [xtxt phone]])) = name ++ ": " ++ phone

with :: [a] -> [a]
with []     = _
with (x:xs) = _ ++ [x] ++ with xs

xml' :: String -> [XmlExp] -> XmlExp
xml' t xs = XElem t _ xs

getNamePhone :: XmlExp -> String
getNamePhone
  (xml' "entry"
        (with [xml' "name"  [xtxt name],
               xml' "phone" [xtxt phone]])) = name ++ ": " ++ phone

------------------------------------------------------------------------------
-- Support for unordered patterns:

getAnyNamePhone :: XmlExp -> String
getAnyNamePhone
  (xml' "entry"
        (with (anyOrder [xml' "name"  [xtxt name],
                         xml' "phone" [xtxt phone]]))) = name ++ ": " ++ phone

anyOrder :: [a] -> [a]
anyOrder []     = []
anyOrder (x:xs) = insert x (anyOrder xs)
 where insert z ys     = z : ys
       insert z (y:ys) = y : insert z ys

------------------------------------------------------------------------------
-- Support for deep pattern matching

getDeepNamePhone :: XmlExp -> String
getDeepNamePhone
  (deepXml "entry"
      (with (anyOrder [xml' "name"  [xtxt name],
                       xml' "phone" [xtxt phone]]))) = name ++ ": " ++ phone

deepXml :: String -> [XmlExp] -> XmlExp
deepXml tag elems = xml' tag elems
deepXml tag elems = xml' _ (_ ++ [deepXml tag elems] ++ _)

-- get all email addresses in a document:
getEmail :: XmlExp -> String
getEmail (deepXml "email" [xtxt email]) = email

allEmails :: XmlExp -> [String]
allEmails xe = sortValues ((set1 getEmail) xe)

------------------------------------------------------------------------------
-- Support for negated patterns

getNamePhoneWithoutEmail :: XmlExp -> String
getNamePhoneWithoutEmail
  (deepXml "entry"
      (withOthers [xml' "name"  [xtxt name],
                   xml' "phone" [xtxt phone]] others))
  | "email" `noTagOf` others = name ++ ": " ++ phone

noTagOf :: String -> [XmlExp] -> Bool
noTagOf tag = all ((/= tag) . tagOf)

withOthers :: Eq a => [a] -> [a] -> [a]
withOthers ys zs = withAcc [] ys zs
 where -- accumulate all remaining elements in last arguments
  withAcc prevs []     others | others == prevs ++ suffix
                              = suffix  where suffix free
  withAcc prevs (x:xs) others =
    prefix ++ [x] ++ withAcc (prevs ++ prefix) xs others where prefix free

------------------------------------------------------------------------------
-- Transformation of XML documents:
-- Create new XML document containing phone number + full name
transPhone :: XmlExp -> XmlExp
transPhone
  (deepXml "entry"
     (with (anyOrder [xml' "name"  [xtxt name],
                      xml' "first" [xtxt first],
                      xml' "phone" phone]))) =
 xml "phonename" [xml "phone" phone,
                  xml "fullname" [xtxt (first ++ " " ++ name)]]

phoneTable :: XmlExp
phoneTable = xml "table" (sortValues ((set1 transPhone) contacts))

-- Get a name with number of their email addresses
getEmails :: XmlExp -> (String,Int)
getEmails (deepXml "entry" (withOthers [xml "name" [xtxt name]] os)) =
  (name, length (sortValues ((set1 emailOf) os)))
 where
  emailOf (with [xml "email" email]) = email

getAllEmailNumbers = sortValues ((set1 getEmails) contacts)

------------------------------------------------------------------------------