{-------------------------------------------------------------------------------------
-
- XML Trees (rose trees)
- Programmer: Leonidas Fegaras
- Email: fegaras@cse.uta.edu
- Web: http://lambda.uta.edu/
- Creation: 05/01/08, last update: 05/01/08
- 
- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.
- This material is provided as is, with absolutely no warranty expressed or implied.
- Any use is at your own risk. Permission is hereby granted to use or copy this program
- for any purpose, provided the above notices are retained on all copies.
-
--------------------------------------------------------------------------------------}


{-# OPTIONS_GHC -funbox-strict-fields #-}


module XTree where

import System.IO
import XMLParse(XMLEvent(..))
import HXML(AttList)


type Tag = String


-- A DOM-like tree to represent XML data
-- Int in XElem is the preorder numbering used for document order
data XTree =  XElem    !Tag !AttList !Int [XTree]
           |  XText    !String
           |  XInt     !Int
           |  XFloat   !Float
           |  XBool    !Bool
           |  XPI      Tag String	-- processing instruction
           |  XGERef   Tag		-- general entity reference
           |  XComment String		-- comment
           |  XError   String		-- error report
           deriving Eq

type XSeq = [XTree]


showAL :: AttList -> String
showAL = foldr(\(a,v) r -> " "++a++"=\""++v++"\""++r) []

showXT :: XTree -> Bool -> String
showXT e pad
    = case e of
        XElem tag al _ [] -> "<"++tag++(showAL al)++"/>"
        XElem tag al _ xs -> "<"++tag++(showAL al)++">"++(showXS xs)++"</"++tag++">"
        XText text -> text
        XInt n -> p++(show n)
        XFloat n -> p++(show n)
        XBool v -> p++(if v then "true" else "false")
        XComment s -> "<!--"++s++"-->"
        XPI n s -> "<?"++n++" "++s++">"
        XError s -> error s
        _ -> ""
      where p = if pad then " " else ""

showXS :: XSeq -> String
showXS [] = ""
showXS (x:xs) = (showXT x False) ++ (concatMap (\x -> showXT x True) xs)

instance Show XTree where
    show t = showXT t False


-- print an XSeq without waiting
putXSeq :: XSeq -> IO ()
putXSeq xs = hSetBuffering stdout NoBuffering >> putStrLn (showXS xs)


{--------------- Build the rose tree from the XML stream ----------------------------}


type Stream = [XMLEvent]


-- lazily materialize the SAX stream into a DOM tree
materialize :: Stream -> XTree
materialize stream = XElem "document" [] 1 [head (filter (\x -> case x of XElem _ _ _ _ -> True; _ -> False)
                                                         ((\(x,_,_)->x) (ml stream 2)))]
        where m ((TextEvent t):xs) i = (XText t,xs,i)
              m ((EmptyEvent n atts):xs) i = (XElem n atts i [],xs,i+1)
              m ((StartEvent n atts):xs) i = let (el,xs',i') = ml xs (i+1)
                                             in (XElem n atts i el,xs',i')
              m ((PIEvent n s):xs) i = (XPI n s,xs,i)
              m ((CommentEvent s):xs) i = (XComment s,xs,i)
              m ((GERefEvent n):xs) i = (XGERef n,xs,i)
              m ((ErrorEvent s):xs) i = (XError s,xs,i)
              m (_:xs) i = (XError "unrecognized XML event",xs,i)
              m [] i = (XError "unbalanced tags",[],i)
              ml [] i = ([],[],i)
              ml ((EndEvent n):xs) i = ([],xs,i)
              ml xs i = let (e,xs',i') = m xs i
                            (el,xs'',i'') = ml xs' i'
                        in (e:el,xs'',i'')