-- | 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 :: String -> String -> ([SaxElement], Maybe String)
saxParse String
file String
cntnt = forall s t a. Parser s t a -> s -> [t] -> ([a], Maybe String)
parseStream XParser SaxElement
sax SymTabs
emptySTs
                                    (String -> String -> [(Posn, TokenT)]
xmlLex String
file String
cntnt)

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

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

saxelementopen :: XParser SaxElement
saxelementopen :: XParser SaxElement
saxelementopen = do
        TokenT -> XParser TokenT
tok TokenT
TokAnyOpen
        (ElemTag (N String
n) [Attribute]
as) <- XParser ElemTag
elemtag  -- no QN ever generated during parsing
        ( do TokenT -> XParser TokenT
tok TokenT
TokEndClose
             forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Attribute] -> SaxElement
SaxElementTag String
n [Attribute]
as)) forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
          ( do TokenT -> XParser TokenT
tok TokenT
TokAnyClose
               forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Attribute] -> SaxElement
SaxElementOpen String
n [Attribute]
as))
          forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing > or /> in element tag"

saxelementclose :: XParser SaxElement
saxelementclose :: XParser SaxElement
saxelementclose = do
        TokenT -> XParser TokenT
tok TokenT
TokEndOpen
        String
n <- XParser String
name
        TokenT -> XParser TokenT
tok TokenT
TokAnyClose
        forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SaxElement
SaxElementClose String
n)

saxcomment :: XParser SaxElement
saxcomment :: XParser SaxElement
saxcomment = String -> SaxElement
SaxComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
comment

saxchardata :: XParser SaxElement
saxchardata :: XParser SaxElement
saxchardata =
  (String -> SaxElement
SaxCharData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>XParser String
cdsect)
  forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail`
  (String -> SaxElement
SaxCharData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>XParser String
chardata)

saxreference :: XParser SaxElement
saxreference :: XParser SaxElement
saxreference = Reference -> SaxElement
SaxReference forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser Reference
reference

saxdoctypedecl :: XParser SaxElement
saxdoctypedecl :: XParser SaxElement
saxdoctypedecl = DocTypeDecl -> SaxElement
SaxDocTypeDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser DocTypeDecl
doctypedecl

saxprocessinginstruction :: XParser SaxElement
saxprocessinginstruction :: XParser SaxElement
saxprocessinginstruction = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProcessingInstruction -> SaxElement
SaxProcessingInstruction XParser ProcessingInstruction
processinginstruction