-- | A streaming XML parser, using a method known as SAX. SAX isn't really a
--   standard, but an implementation, so it's just an \"SAX-like\" parser.
--   This module allows you parse an XML document without having to evaluate
--   it as a whole. This is needed for protocols like jabber, which use xml
--   streams for communication.

module Text.XML.HaXml.SAX
	( SaxElement(..)
	, saxParse
	) where

import Text.XML.HaXml.Types
import Text.XML.HaXml.Parse
import Text.XML.HaXml.Lex
import Text.ParserCombinators.Poly.State

data SaxElement
	= SaxDocTypeDecl DocTypeDecl
		-- ^ A doctype declaration occured(\<!DOCTYPE\>)
	| SaxProcessingInstruction ProcessingInstruction
		-- ^ A processing instruction occured (\<??\>)
	| SaxComment String		-- ^ A comment occured (\<!-- --\>)
	| SaxElementOpen Name [Attribute] -- ^ An element was opened (\<\>)
	| SaxElementClose Name		-- ^ An element was closed (\<\/\>)
	| SaxElementTag Name [Attribute]
		-- ^ An element without content occured (\<\/\>)
	| SaxCharData CharData		-- ^ Some string data occured
	| SaxReference Reference	-- ^ A reference occured

-- | @saxParse file content@ takes a filename and the string content of that
--   file and generates a stream of @SaxElement@s. If an error occurs, the
--   parsing stops and a string is returned using the @Maybe@ type.
saxParse :: String -- ^ The filename
	 -> String -- ^ The content of the file
	 -> ([SaxElement],Maybe String)
		-- ^ A tuple of the parsed elements and @Nothing@, if no
		--   error occured, or @Just@ @String@ if an error occured.
saxParse file cntnt = parseStream sax emptySTs
                                    (xmlLex file cntnt)

parseStream :: Parser s t a -> s -> [t] -> ([a], Maybe String)
parseStream _ _ [] = ([],Nothing)
parseStream p state toks = case runParser p state toks of
	(Left err, _, _) -> ([],Just err)
	(Right res, nstate, rest) -> (res:moreres, err)
            where (moreres,err) = parseStream p nstate rest

sax :: XParser SaxElement
sax = oneOf [ saxelementopen
            , saxelementclose
            , saxprocessinginstruction
            , saxcomment
            , saxdoctypedecl
            , saxreference
            , saxchardata
            ]
	`adjustErr` (++("\nLooking for a SAX event:\n"
               ++"  elem-open, elem-close, PI, comment, DTD, ref, or chardata"))

saxelementopen :: XParser SaxElement
saxelementopen = do
	tok TokAnyOpen
	(ElemTag (N n) as) <- elemtag  -- no QN ever generated during parsing
	(( do tok TokEndClose
	      return (SaxElementTag n as)) `onFail`
	 ( do tok TokAnyClose
	      return (SaxElementOpen n as))
	 `onFail` fail "missing > or /> in element tag")

saxelementclose :: XParser SaxElement
saxelementclose = do
	tok TokEndOpen
	n <- name
	tok TokAnyClose
	return (SaxElementClose n)

saxcomment :: XParser SaxElement
saxcomment = comment >>= return . SaxComment

saxchardata :: XParser SaxElement
saxchardata =
  (cdsect >>= return . SaxCharData)
  `onFail`
  (chardata >>= return . SaxCharData)

saxreference :: XParser SaxElement
saxreference = reference >>= return . SaxReference

saxdoctypedecl :: XParser SaxElement
saxdoctypedecl = doctypedecl >>= return . SaxDocTypeDecl

saxprocessinginstruction :: XParser SaxElement
saxprocessinginstruction = fmap SaxProcessingInstruction processinginstruction