module Text.XML.Expat.Tree (
Text.XML.Expat.Tree.parse, Node(..),
EIO.Encoding(..)
) where
import qualified Text.XML.Expat.IO as EIO
import qualified Data.ByteString.Lazy as B
import Data.IORef
import System.IO.Unsafe (unsafePerformIO)
data Node = Element { eName :: String, eAttrs :: [(String,String)],
eChildren :: [Node] }
| Text String
deriving Show
modifyChildren :: ([Node] -> [Node]) -> Node -> Node
modifyChildren f node = node { eChildren = f (eChildren node) }
parse :: Maybe EIO.Encoding -> B.ByteString -> Maybe Node
parse enc doc = unsafePerformIO $ runParse where
runParse = do
parser <- EIO.newParser enc
stack <- newIORef [Element "" [] []]
EIO.setStartElementHandler parser (\n a -> modifyIORef stack (start n a))
EIO.setEndElementHandler parser (\n -> modifyIORef stack (end n))
EIO.setCharacterDataHandler parser (\s -> modifyIORef stack (text s))
ok <- EIO.parse parser doc
if ok
then do
[Element _ _ [root]] <- readIORef stack
return $ Just $ modifyChildren reverse root
else return Nothing
start name attrs stack = Element name attrs [] : stack
text str (cur:rest) = modifyChildren (Text str:) cur : rest
end name (cur:parent:rest) =
if eName cur /= name then error "name mismatch" else
let node = modifyChildren reverse cur in
modifyChildren (node:) parent : rest