libxml-sax 0.6.1.1 → 0.7

raw patch · 5 files changed

+1368/−424 lines, 5 filesdep ~basedep ~xml-typesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, xml-types

API changes (from Hackage documentation)

Files

• Text/XML/LibXML/SAX.chs +0/−419
• Text/XML/LibXML/SAX.hs +724/−0
• hslibxml-shim.c +464/−0
• hslibxml-shim.h +174/−0
• libxml-sax.cabal +6/−5

@@ -1,419 +0,0 @@--------------------------------------------------------------------------------- |--- Module: Text.XML.LibXML.SAX--- Copyright: 2010 John Millikin--- License: MIT------ Maintainer: jmillikin@gmail.com--- Portability: portable------ Bindings for the libXML2 SAX interface-----------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE RankNTypes #-}-module Text.XML.LibXML.SAX-	(-	-- * Parser-	  Parser-	, newParserIO-	, newParserST-	-	-- ** Callbacks-	, Callback-	, setCallback-	, clearCallback-	-	, parsedBeginDocument-	, parsedEndDocument-	, parsedBeginElement-	, parsedEndElement-	, parsedCharacters-	, parsedComment-	, parsedInstruction-	, parsedDoctype-	-	-- *** Buffer-based callbacks-	, parsedCharactersBuffer-	, parsedCommentBuffer-	-	-- ** Parser input-	, parseText-	, parseLazyText-	, parseBytes-	, parseLazyBytes-	, parseBuffer-	, parseComplete-	) where-import qualified Control.Exception as E-import Control.Monad (when, unless)-import qualified Control.Monad.ST as ST-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as BU-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.XML.Types as X-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Foreign hiding (free)-import Foreign.C-import qualified Foreign.Concurrent as FC--#include <libxml/parser.h>-#include <string.h>--{# pointer *xmlParserCtxt as ParserHandle newtype #}--data Parser m = Parser-	{ parserHandle :: ForeignPtr ParserHandle-	, parserCallbacks :: ForeignPtr ()-	, parserErrorRef :: IORef (Maybe E.SomeException)-	, parserOnError :: T.Text -> m ()-	, parserToIO :: forall a. m a -> IO a-	, parserFromIO :: forall a. IO a -> m a-	}--newParserIO :: (T.Text -> IO ()) -- ^ An error handler, called if parsing fails-            -> Maybe T.Text -- ^ An optional filename or URI-            -> IO (Parser IO)-newParserIO onError filename = E.block $ do-	ref <- newIORef Nothing-	-	ParserHandle handlePtr <--		maybeWith withUTF8 filename $ \cFilename ->-		allocaBytes {# sizeof xmlSAXHandler #} $ \sax -> do-		void $ {# call memset #} sax 0 {# sizeof xmlSAXHandler #}-		{#set xmlSAXHandler->initialized #} sax xmlSax2Magic-		{#call xmlCreatePushParserCtxt #} sax nullPtr nullPtr 0 cFilename-	-	sax <- {#get xmlParserCtxt->sax #} handlePtr-	cCallbacks <- FC.newForeignPtr sax $ freeParserCallbacks sax-	-	{#set xmlParserCtxt->replaceEntities #} handlePtr 1-	-	parserFP <- newForeignPtr cParserFree handlePtr-	return $ Parser parserFP cCallbacks ref onError id id--newParserST :: (T.Text -> ST.ST s ()) -- ^ An error handler, called if parsing fails-            -> Maybe T.Text -- ^ An optional filename or URI-            -> ST.ST s (Parser (ST.ST s))-newParserST onError filename = ST.unsafeIOToST $ do-	p <- newParserIO (\_ -> return ()) filename-	return $ p-		{ parserToIO = ST.unsafeSTToIO-		, parserFromIO = ST.unsafeIOToST-		, parserOnError = onError-		}--freeParserCallbacks :: Ptr () -> IO ()-freeParserCallbacks raw = do-	{# get xmlSAXHandler->startElementNs #} raw >>= freeFunPtr-	{# get xmlSAXHandler->endElementNs #} raw >>= freeFunPtr-	{# get xmlSAXHandler->characters #} raw >>= freeFunPtr-	{# get xmlSAXHandler->comment #} raw >>= freeFunPtr-	{# get xmlSAXHandler->processingInstruction #} raw >>= freeFunPtr--foreign import ccall "libxml/parser.h &xmlFreeParserCtxt"-	cParserFree :: FunPtr (Ptr ParserHandle -> IO ())---- | A callback should return 'True' to continue parsing, or 'False'--- to cancel.----data Callback m a = Callback (Parser m -> a -> IO ()) (Parser m -> IO ())--setCallback :: Parser m -> Callback m a -> a -> m ()-setCallback p (Callback set _) io = parserFromIO p $ set p io--clearCallback :: Parser m -> Callback m a -> m ()-clearCallback p (Callback _ clear) = parserFromIO p $ clear p--catchRef :: Parser m -> m Bool -> IO ()-catchRef p io = do-	continue <- E.catch (E.unblock (parserToIO p io)) $ \e -> do-		writeIORef (parserErrorRef p) $ Just e-		return False-	unless continue $ withParserIO p $ {# call xmlStopParser #}--callback :: (Parser m -> a -> IO (FunPtr b))-         -> (Ptr () -> IO (FunPtr b))-         -> (Ptr () -> FunPtr b -> IO ())-         -> Callback m a-callback wrap getPtr setPtr = Callback set clear where-	set parser io = withForeignPtr (parserCallbacks parser) $ \p -> do-		free p-		wrap parser io >>= setPtr p-	clear parser = withForeignPtr (parserCallbacks parser) $ \p -> do-		free p-		setPtr p nullFunPtr-	free p = getPtr p >>= freeFunPtr---- Callback wrappers-type CUString = Ptr CUChar--type Callback0 = Ptr () -> IO ()--type StartElementNsSAX2Func = (Ptr () -> CUString -> CUString-                               -> CUString -> CInt -> Ptr CUString -> CInt-                               -> CInt -> Ptr CUString -> IO ())-type EndElementNsSAX2Func = (Ptr () -> CUString -> CUString -> CUString-                             -> IO ())-type CharactersSAXFunc = (Ptr () -> CUString -> CInt -> IO ())--type CommentSAXFunc = Ptr () -> CUString -> IO ()--type ProcessingInstructionSAXFunc = Ptr () -> CUString -> CUString -> IO ()--type ExternalSubsetSAXFunc = Ptr () -> CUString -> CUString -> CUString -> IO ()--foreign import ccall "wrapper"-	allocCallback0 :: Callback0 -> IO (FunPtr Callback0)--foreign import ccall "wrapper"-	allocCallbackBeginElement :: StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)--foreign import ccall "wrapper"-	allocCallbackEndElement :: EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)--foreign import ccall "wrapper"-	allocCallbackCharacters :: CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc)--foreign import ccall "wrapper"-	allocCallbackComment :: CommentSAXFunc -> IO (FunPtr CommentSAXFunc)--foreign import ccall "wrapper"-	allocCallbackInstruction :: ProcessingInstructionSAXFunc -> IO (FunPtr ProcessingInstructionSAXFunc)--foreign import ccall "wrapper"-	allocCallbackExternalSubset :: ExternalSubsetSAXFunc -> IO (FunPtr ExternalSubsetSAXFunc)---- localname, prefix, namespace, value_begin, value_end-data CAttribute = CAttribute CString CString CString CString CString--splitCAttributes :: CInt -> Ptr CString -> IO [CAttribute]-splitCAttributes = loop 0 where-	loop _      0 _     = return []-	loop offset n attrs = do-		c_ln <- peekElemOff attrs (offset + 0)-		c_prefix <- peekElemOff attrs (offset + 1)-		c_ns <- peekElemOff attrs (offset + 2)-		c_vbegin <- peekElemOff attrs (offset + 3)-		c_vend <- peekElemOff attrs (offset + 4)-		as <- loop (offset + 5) (n - 1) attrs-		return (CAttribute c_ln c_prefix c_ns c_vbegin c_vend : as)--convertCAttribute :: CAttribute -> IO X.Attribute-convertCAttribute (CAttribute c_ln c_pfx c_ns c_vbegin c_vend) = do-	ln <- peekUTF8 c_ln-	pfx <- maybePeek peekUTF8 c_pfx-	ns <- maybePeek peekUTF8 c_ns-	val <- peekUTF8Len (c_vbegin, minusPtr c_vend c_vbegin)-	return (X.Attribute (X.Name ln ns pfx) [X.ContentText val])---- Exposed callbacks--wrapCallback0 :: Parser m -> m Bool -> IO (FunPtr Callback0)-wrapCallback0 p io = allocCallback0 $ \_ -> catchRef p io--parsedBeginDocument :: Callback m (m Bool)-parsedBeginDocument = callback wrapCallback0-	{# get xmlSAXHandler->startDocument #}-	{# set xmlSAXHandler->startDocument #}--parsedEndDocument :: Callback m (m Bool)-parsedEndDocument = callback wrapCallback0-	{# get xmlSAXHandler->endDocument #}-	{# set xmlSAXHandler->endDocument #}--wrapBeginElement :: Parser m -> (X.Name -> [X.Attribute] -> m Bool)-                 -> IO (FunPtr StartElementNsSAX2Func)-wrapBeginElement p io =-	allocCallbackBeginElement $ \_ cln cpfx cns _ _ n_attrs _ raw_attrs ->-	catchRef p $ parserFromIO p $ do-		ns <- maybePeek peekUTF8 $ castPtr cns-		pfx <- maybePeek peekUTF8 $ castPtr cpfx-		ln <- peekUTF8 $ castPtr cln-		c_attrs <- splitCAttributes n_attrs (castPtr raw_attrs)-		attrs <- mapM convertCAttribute c_attrs-		parserToIO p $ io (X.Name ln ns pfx) attrs--parsedBeginElement :: Callback m (X.Name -> [X.Attribute] -> m Bool)-parsedBeginElement = callback wrapBeginElement-	{# get xmlSAXHandler->startElementNs #}-	{# set xmlSAXHandler->startElementNs #}--wrapEndElement :: Parser m -> (X.Name -> m Bool)-               -> IO (FunPtr EndElementNsSAX2Func)-wrapEndElement p io =-	allocCallbackEndElement $ \_ cln cpfx cns ->-	catchRef p $ parserFromIO p $ do-		ns <- maybePeek peekUTF8 $ castPtr cns-		pfx <- maybePeek peekUTF8 $ castPtr cpfx-		ln <- peekUTF8 $ castPtr cln-		parserToIO p $ io $ X.Name ln ns pfx--parsedEndElement :: Callback m (X.Name -> m Bool)-parsedEndElement = callback wrapEndElement-	{# get xmlSAXHandler->endElementNs #}-	{# set xmlSAXHandler->endElementNs #}--wrapCharacters :: Parser m -> (T.Text -> m Bool)-               -> IO (FunPtr CharactersSAXFunc)-wrapCharacters p io =-	allocCallbackCharacters $ \_ cstr clen ->-	catchRef p $ parserFromIO p $ do-		text <- peekStrictUTF8Len (castPtr cstr, fromIntegral clen)-		parserToIO p $ io text--parsedCharacters :: Callback m (T.Text -> m Bool)-parsedCharacters = callback wrapCharacters-	{# get xmlSAXHandler->characters #}-	{# set xmlSAXHandler->characters #}--wrapComment :: Parser m -> (T.Text -> m Bool)-            -> IO (FunPtr CommentSAXFunc)-wrapComment p io =-	allocCallbackComment $ \_ cstr ->-	catchRef p $ parserFromIO p $ do-		text <- peekStrictUTF8 (castPtr cstr)-		parserToIO p $ io text--parsedComment :: Callback m (T.Text -> m Bool)-parsedComment = callback wrapComment-	{# get xmlSAXHandler->comment #}-	{# set xmlSAXHandler->comment #}--wrapInstruction :: Parser m -> (X.Instruction -> m Bool)-                -> IO (FunPtr ProcessingInstructionSAXFunc)-wrapInstruction p io =-	allocCallbackInstruction $ \_ ctarget cdata ->-	catchRef p $ parserFromIO p $ do-		target <- peekUTF8 (castPtr ctarget)-		value <- peekUTF8 (castPtr cdata)-		parserToIO p $ io $ X.Instruction target value--parsedInstruction :: Callback m (X.Instruction -> m Bool)-parsedInstruction = callback wrapInstruction-	{# get xmlSAXHandler->processingInstruction #}-	{# set xmlSAXHandler->processingInstruction #}--wrapExternalSubset :: Parser m -> (X.Doctype -> m Bool) -> IO (FunPtr ExternalSubsetSAXFunc)-wrapExternalSubset p io =-	allocCallbackExternalSubset $ \_ cname cpublic csystem ->-	catchRef p $ parserFromIO p $ do-		name <- peekUTF8 (castPtr cname)-		public <- maybePeek peekUTF8 (castPtr cpublic)-		system <- maybePeek peekUTF8 (castPtr csystem)-		let external = case (public, system) of-			(Nothing, Just s) -> Just $ X.SystemID s-			(Just p', Just s) -> Just $ X.PublicID p' s-			_ -> Nothing-		parserToIO p $ io $ X.Doctype name external []--parsedDoctype :: Callback m (X.Doctype -> m Bool)-parsedDoctype = callback wrapExternalSubset-	{# get xmlSAXHandler->externalSubset #}-	{# set xmlSAXHandler->externalSubset #}--wrapCharactersBuffer :: Parser m -> ((Ptr Word8, Integer) -> m Bool)-                     -> IO (FunPtr CharactersSAXFunc)-wrapCharactersBuffer p io =-	allocCallbackCharacters $ \_ cstr clen ->-	catchRef p $ do-		io (castPtr cstr, fromIntegral clen)--parsedCharactersBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)-parsedCharactersBuffer = callback wrapCharactersBuffer-	{# get xmlSAXHandler->characters #}-	{# set xmlSAXHandler->characters #}--wrapCommentBuffer :: Parser m -> ((Ptr Word8, Integer) -> m Bool)-            -> IO (FunPtr CommentSAXFunc)-wrapCommentBuffer p io =-	allocCallbackComment $ \_ cstr ->-	catchRef p $ parserFromIO p $ do-		clen <- {# call xmlStrlen #} cstr-		parserToIO p $ io (castPtr cstr, fromIntegral clen)--parsedCommentBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)-parsedCommentBuffer = callback wrapCommentBuffer-	{# get xmlSAXHandler->comment #}-	{# set xmlSAXHandler->comment #}--withParserIO :: Parser m -> (ParserHandle -> IO a) -> IO a-withParserIO p io = withForeignPtr (parserHandle p) $ io . ParserHandle--parseImpl :: Parser m -> (ParserHandle -> IO CInt) -> m ()-parseImpl p io = parserFromIO p $ do-	writeIORef (parserErrorRef p) Nothing-	rc <- E.block $ withParserIO p io-	touchForeignPtr $ parserCallbacks p-	-	threw <- readIORef $ parserErrorRef p-	case threw of-		Nothing -> return ()-		Just exc -> E.throwIO exc-	-	when (rc /= 0) $ do-		err <- getParseError p-		parserToIO p $ parserOnError p $ err--parseText :: Parser m -> T.Text -> m ()-parseText p = parseBytes p . TE.encodeUtf8--parseLazyText :: Parser m -> TL.Text -> m ()-parseLazyText p = parseText p . T.concat . TL.toChunks--parseBytes :: Parser m -> B.ByteString -> m ()-parseBytes p bytes = parseImpl p $ \h ->-	BU.unsafeUseAsCStringLen bytes $ \(cstr, len) ->-	{# call xmlParseChunk #} h cstr (fromIntegral len) 0--parseLazyBytes :: Parser m -> BL.ByteString -> m ()-parseLazyBytes p = parseBytes p . B.concat . BL.toChunks--parseBuffer :: Parser m -> (Ptr Word8, Integer) -> m ()-parseBuffer p (ptr, len) = parseImpl p $ \h ->-	{# call xmlParseChunk #} h (castPtr ptr) (fromIntegral len) 0---- | Finish parsing any buffered data, and check that the document was--- closed correctly.--- -parseComplete :: Parser m -> m ()-parseComplete p = parseImpl p $ \h ->-	{#call xmlParseChunk #} h nullPtr 0 1--getParseError :: Parser m -> IO T.Text-getParseError p = withParserIO p $ \h -> do-	let ParserHandle h' = h-	errInfo <- {#call xmlCtxtGetLastError #} $ castPtr h'-	peekStrictUTF8 =<< {#get xmlError->message #} errInfo-	--peekStrictUTF8 :: CString -> IO T.Text-peekStrictUTF8 = fmap (TE.decodeUtf8) . B.packCString--peekStrictUTF8Len :: CStringLen -> IO T.Text-peekStrictUTF8Len = fmap (TE.decodeUtf8) . B.packCStringLen--peekUTF8 :: CString -> IO TL.Text-peekUTF8 = fmap (fromStrict . TE.decodeUtf8) . B.packCString--peekUTF8Len :: CStringLen -> IO TL.Text-peekUTF8Len = fmap (fromStrict . TE.decodeUtf8) . B.packCStringLen--withUTF8 :: T.Text -> (CString -> IO a) -> IO a-withUTF8 = B.useAsCString . TE.encodeUtf8--fromStrict :: T.Text -> TL.Text-fromStrict t = TL.fromChunks [t]--freeFunPtr :: FunPtr a -> IO ()-freeFunPtr ptr = if ptr == nullFunPtr-	then return ()-	else freeHaskellFunPtr ptr---- XML_SAX2_MAGIC-xmlSax2Magic :: CUInt-xmlSax2Magic = 0xDEEDBEAF

@@ -0,0 +1,724 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RankNTypes #-}++-----------------------------------------------------------------------------+-- |+-- Module: Text.XML.LibXML.SAX+-- Copyright: 2010 John Millikin+-- License: MIT+--+-- Maintainer: jmillikin@gmail.com+-- Portability: portable+--+-- Bindings for the libXML2 SAX interface+--+-----------------------------------------------------------------------------++module Text.XML.LibXML.SAX+	(+	-- * Parser+	  Parser+	, newParserIO+	, newParserST+	+	-- ** Parser input+	, parseBytes+	, parseComplete+	+	-- * Callbacks+	, Callback+	, setCallback+	, clearCallback+	+	-- ** Parse events+	, parsedBeginDocument+	, parsedEndDocument+	, parsedBeginElement+	, parsedEndElement+	, parsedCharacters+	, parsedReference+	, parsedComment+	, parsedInstruction+	, parsedCDATA+	, parsedWhitespace+	, parsedInternalSubset+	, parsedExternalSubset+	+	-- ** Warning and error reporting+	, reportWarning+	, reportError+	+	) where++import qualified Control.Exception as E+import           Control.Monad (when, unless)+import qualified Control.Monad.ST as ST+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as BU+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.XML.Types as X+import           Data.IORef (IORef, newIORef, readIORef, writeIORef)+import           Foreign hiding (free, void)+import           Foreign.C+import qualified Foreign.Concurrent as FC+import           Text.ParserCombinators.ReadP ((+++))+import qualified Text.ParserCombinators.ReadP as ReadP++data Context = Context++-- | A 'Parser' tracks the internal state of a LibXML parser context.+--+-- As LibXML is a very stateful library, parsers must operate within either+-- the 'IO' or 'ST.ST' monad. Use 'newParserIO' or 'newParserST' to create+-- parsers in the appropriate monad.+--+-- In general, clients should prefer 'newParserST', because ST values can be+-- safely computed with no side effects.+data Parser m = Parser+	{ parserHandle :: ForeignPtr Context+	, parserErrorRef :: IORef (Maybe E.SomeException)+	, parserToIO :: forall a. m a -> IO a+	, parserFromIO :: forall a. IO a -> m a+	}++newParserIO :: Maybe T.Text -- ^ An optional filename or URI+            -> IO (Parser IO)+newParserIO filename = E.block $ do+	ref <- newIORef Nothing+	+	raw <- maybeWith withUTF8 filename cAllocParser+	managed <- newForeignPtr_ raw+	+	FC.addForeignPtrFinalizer managed (cFreeParser raw)+	FC.addForeignPtrFinalizer managed (freeCallbacks raw)+	+	return (Parser managed ref id id)++newParserST :: Maybe T.Text -- ^ An optional filename or URI+            -> ST.ST s (Parser (ST.ST s))+newParserST filename = ST.unsafeIOToST $ do+	p <- newParserIO filename+	return $ p+		{ parserToIO = ST.unsafeSTToIO+		, parserFromIO = ST.unsafeIOToST+		}++parseImpl :: Parser m -> (Ptr Context -> IO a) -> m ()+parseImpl p io = parserFromIO p $ do+	writeIORef (parserErrorRef p) Nothing+	E.block (void (withParserIO p io))+	+	threw <- readIORef (parserErrorRef p)+	case threw of+		Nothing -> return ()+		Just exc -> E.throwIO exc++parseBytes :: Parser m -> B.ByteString -> m ()+parseBytes p bytes = parseImpl p $ \h ->+	BU.unsafeUseAsCStringLen bytes $ \(cstr, len) ->+	cParseChunk h cstr (fromIntegral len) 0++-- | Finish parsing any buffered data, and check that the document was+-- closed correctly.+-- +parseComplete :: Parser m -> m ()+parseComplete p = parseImpl p (\h -> cParseChunk h nullPtr 0 1)++-- Callbacks {{{++freeCallbacks :: Ptr Context -> IO ()+freeCallbacks ctx = do+	getcb_startDocument ctx >>= freeFunPtr+	getcb_endDocument ctx >>= freeFunPtr+	getcb_startElementNs ctx >>= freeFunPtr+	getcb_endElementNs ctx >>= freeFunPtr+	getcb_characters ctx >>= freeFunPtr+	getcb_reference ctx >>= freeFunPtr+	getcb_comment ctx >>= freeFunPtr+	getcb_processingInstruction ctx >>= freeFunPtr+	getcb_cdataBlock ctx >>= freeFunPtr+	getcb_ignorableWhitespace ctx >>= freeFunPtr+	getcb_internalSubset ctx >>= freeFunPtr+	getcb_externalSubset ctx >>= freeFunPtr+	getcb_warning ctx >>= freeFunPtr+	getcb_error ctx >>= freeFunPtr++data Callback m a = Callback (Parser m -> a -> IO ()) (Parser m -> IO ())++-- | Set a callback computation to run when a particular parse event occurs.+-- The callback should return 'True' to continue parsing, or 'False'+-- to abort.+--+-- Alternatively, callbacks may throw an 'E.Exception' to abort parsing. The+-- exception will be propagated through to the caller of 'parseBytes' or+-- 'parseComplete'.+setCallback :: Parser m -> Callback m a -> a -> m ()+setCallback p (Callback set _) io = parserFromIO p (set p io)++-- | Remove a callback from the parser. This might also change the parser's+-- behavior, such as automatically expanding entity references when no+-- 'parsedReference' callback is set.+clearCallback :: Parser m -> Callback m a -> m ()+clearCallback p (Callback _ clear) = parserFromIO p (clear p)++catchRef :: Parser m -> Ptr Context -> m Bool -> IO ()+catchRef p cb_ctx io = withParserIO p $ \ctx ->+	(cWantCallback ctx cb_ctx >>=) $ \want ->+	when (want == 1) $ do+		continue <- E.catch (E.unblock (parserToIO p io)) $ \e -> do+			writeIORef (parserErrorRef p) (Just e)+			return False+		unless continue (cStopParser ctx)++catchRefIO :: Parser m -> Ptr Context -> IO Bool -> IO ()+catchRefIO p cb_ctx io = catchRef p cb_ctx (parserFromIO p io)++callback :: (Parser m -> a -> IO (FunPtr b))+         -> (Ptr Context -> IO (FunPtr b))+         -> (Ptr Context -> FunPtr b -> IO ())+         -> Callback m a+callback wrap getPtr setPtr = Callback set clear where+	set p io = withForeignPtr (parserHandle p) $ \ctx -> do+		free ctx+		wrap p io >>= setPtr ctx+	clear p = withForeignPtr (parserHandle p) $ \ctx -> do+		free ctx+		setPtr ctx nullFunPtr+	free ctx = getPtr ctx >>= freeFunPtr++-- begin document {{{++parsedBeginDocument :: Callback m (m Bool)+parsedBeginDocument = callback wrap_startDocument+	getcb_startDocument+	setcb_startDocument++type StartDocumentSAXFunc = Ptr Context -> IO ()++wrap_startDocument :: Parser m -> m Bool -> IO (FunPtr StartDocumentSAXFunc)+wrap_startDocument p io = newcb_startDocument (\ctx -> catchRef p ctx io)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_startDocument"+	getcb_startDocument :: Ptr Context -> IO (FunPtr StartDocumentSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_startDocument"+	setcb_startDocument :: Ptr Context -> FunPtr StartDocumentSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_startDocument  :: StartDocumentSAXFunc -> IO (FunPtr StartDocumentSAXFunc)++-- }}}++-- end document {{{++parsedEndDocument :: Callback m (m Bool)+parsedEndDocument = callback wrap_endDocument+	getcb_endDocument+	setcb_endDocument++type EndDocumentSAXFunc = Ptr Context -> IO ()++wrap_endDocument :: Parser m -> m Bool -> IO (FunPtr EndDocumentSAXFunc)+wrap_endDocument p io = newcb_endDocument (\ctx -> catchRef p ctx io)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_endDocument"+	getcb_endDocument :: Ptr Context -> IO (FunPtr EndDocumentSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_endDocument"+	setcb_endDocument :: Ptr Context -> FunPtr EndDocumentSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_endDocument  :: EndDocumentSAXFunc -> IO (FunPtr EndDocumentSAXFunc)++-- }}}++-- begin element {{{++parsedBeginElement :: Callback m (X.Name -> [(X.Name, [X.Content])] -> m Bool)+parsedBeginElement = callback wrap_beginElement+	getcb_startElementNs+	setcb_startElementNs++type StartElementNsSAX2Func = (Ptr Context -> CString -> CString -> CString -> CInt -> Ptr CString -> CInt -> CInt -> Ptr CString -> IO ())++wrap_beginElement :: Parser m -> (X.Name -> [(X.Name, [X.Content])] -> m Bool) -> IO (FunPtr StartElementNsSAX2Func)+wrap_beginElement p io =+	newcb_startElementNs $ \ctx cln cpfx cns _ _ n_attrs _ raw_attrs ->+	catchRefIO p ctx $ do+		ns <- maybePeek peekUTF8 (castPtr cns)+		pfx <- maybePeek peekUTF8 (castPtr cpfx)+		ln <- peekUTF8 (castPtr cln)+		attrs <- peekAttributes (castPtr raw_attrs) n_attrs+		parserToIO p (io (X.Name ln ns pfx) attrs)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_startElementNs"+	getcb_startElementNs :: Ptr Context -> IO (FunPtr StartElementNsSAX2Func)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_startElementNs"+	setcb_startElementNs :: Ptr Context -> FunPtr StartElementNsSAX2Func -> IO ()++foreign import ccall "wrapper"+	newcb_startElementNs :: StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)++peekAttributes :: Ptr CString -> CInt -> IO [(X.Name, [X.Content])]+peekAttributes ptr = loop 0 where+	loop _      0 = return []+	loop offset n = do+		local <- peekUTF8 =<< peekElemOff ptr (offset + 0)+		prefix <- maybePeek peekUTF8 =<< peekElemOff ptr (offset + 1)+		ns <- maybePeek peekUTF8 =<< peekElemOff ptr (offset + 2)+		+		val_begin <- peekElemOff ptr (offset + 3)+		val_end <- peekElemOff ptr (offset + 4)+		val <- peekUTF8Len (val_begin, minusPtr val_end val_begin)+		+		let content = parseAttributeContent val+		let attr = (X.Name local ns prefix, content)+		attrs <- loop (offset + 5) (n - 1)+		+		return (attr:attrs)++parseAttributeContent :: T.Text -> [X.Content]+parseAttributeContent = parse . T.unpack where+	parse chars = case ReadP.readP_to_S parser chars of+		(cs,_):_ -> cs+		_ -> error "parseAttributeContent: no parse"+	parser = ReadP.manyTill content ReadP.eof+	content = reference +++ text+	reference = do+		void (ReadP.char '&')+		name <- ReadP.munch1 (/= ';')+		void (ReadP.char ';')+		return (X.ContentEntity (T.pack name))+	text = do+		chars <- ReadP.munch1 (/= '&')+		return (X.ContentText (T.pack chars))++-- }}}++-- end element {{{++parsedEndElement :: Callback m (X.Name -> m Bool)+parsedEndElement = callback wrap_endElementNs+	getcb_endElementNs+	setcb_endElementNs++type EndElementNsSAX2Func = (Ptr Context -> CString -> CString -> CString -> IO ())++wrap_endElementNs :: Parser m -> (X.Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func)+wrap_endElementNs p io =+	newcb_endElementNs $ \ctx cln cpfx cns ->+	catchRefIO p ctx $ do+		ns <- maybePeek peekUTF8 (castPtr cns)+		prefix <- maybePeek peekUTF8 (castPtr cpfx)+		local <- peekUTF8 (castPtr cln)+		parserToIO p (io (X.Name local ns prefix))++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_endElementNs"+	getcb_endElementNs :: Ptr Context -> IO (FunPtr EndElementNsSAX2Func)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_endElementNs"+	setcb_endElementNs :: Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ()++foreign import ccall "wrapper"+	newcb_endElementNs :: EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)++-- }}}++-- characters, cdata, and whitespace {{{++parsedCharacters :: Callback m (T.Text -> m Bool)+parsedCharacters = callback wrap_characters+	getcb_characters+	setcb_characters++-- | If 'parsedCDATA' is set, it receives any text contained in CDATA+-- blocks. By default, all text is received by 'parsedCharacters'.+parsedCDATA :: Callback m (T.Text -> m Bool)+parsedCDATA = callback wrap_characters+	getcb_cdataBlock+	setcb_cdataBlock++-- | If 'parsedWhitespace' is set, it receives any whitespace marked as+-- ignorable by the document's DTD. By default, all text is received by+-- 'parsedCharacters'.+parsedWhitespace :: Callback m (T.Text -> m Bool)+parsedWhitespace = callback wrap_characters+	getcb_ignorableWhitespace+	setcb_ignorableWhitespace++type CharactersSAXFunc = (Ptr Context -> CString -> CInt -> IO ())++wrap_characters :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)+wrap_characters p io =+	newcb_characters $ \ctx cstr clen ->+	catchRefIO p ctx $ do+		text <- peekUTF8Len (castPtr cstr, fromIntegral clen)+		parserToIO p (io text)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_characters"+	getcb_characters :: Ptr Context -> IO (FunPtr CharactersSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_cdataBlock"+	getcb_cdataBlock :: Ptr Context -> IO (FunPtr CharactersSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_ignorableWhitespace"+	getcb_ignorableWhitespace :: Ptr Context -> IO (FunPtr CharactersSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_characters"+	setcb_characters :: Ptr Context -> FunPtr CharactersSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_cdataBlock"+	setcb_cdataBlock :: Ptr Context -> FunPtr CharactersSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_ignorableWhitespace"+	setcb_ignorableWhitespace :: Ptr Context -> FunPtr CharactersSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_characters :: CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc)++-- }}}++-- entity reference {{{++-- | If 'parsedReference' is set, entity references in element and attribute+-- content will reported separately from text, and will not be automatically+-- expanded.+--+-- Use this when processing documents in passthrough mode, to preserve+-- existing entity references.+parsedReference :: Callback m (T.Text -> m Bool)+parsedReference = callback wrap_reference+	getcb_reference+	setcb_reference++type ReferenceSAXFunc = Ptr Context -> CString -> IO ()++wrap_reference :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)+wrap_reference p io =+	newcb_reference $ \ctx cstr ->+	catchRefIO p ctx $ do+		text <- peekUTF8 (castPtr cstr)+		parserToIO p (io text)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_reference"+	getcb_reference :: Ptr Context -> IO (FunPtr ReferenceSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_reference"+	setcb_reference :: Ptr Context -> FunPtr ReferenceSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_reference :: ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)++-- }}}++-- comment {{{++parsedComment :: Callback m (T.Text -> m Bool)+parsedComment = callback wrap_comment+	getcb_comment+	setcb_comment++type CommentSAXFunc = Ptr Context -> CString -> IO ()++wrap_comment :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr CommentSAXFunc)+wrap_comment p io =+	newcb_comment $ \ctx cstr ->+	catchRefIO p ctx $ do+		text <- peekUTF8 (castPtr cstr)+		parserToIO p (io text)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_comment"+	getcb_comment :: Ptr Context -> IO (FunPtr CommentSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_comment"+	setcb_comment :: Ptr Context -> FunPtr CommentSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_comment :: CommentSAXFunc -> IO (FunPtr CommentSAXFunc)++-- }}}++-- processing instruction {{{++parsedInstruction :: Callback m (X.Instruction -> m Bool)+parsedInstruction = callback wrap_processingInstruction+	getcb_processingInstruction+	setcb_processingInstruction++type ProcessingInstructionSAXFunc = Ptr Context -> CString -> CString -> IO ()++wrap_processingInstruction :: Parser m -> (X.Instruction -> m Bool) -> IO (FunPtr ProcessingInstructionSAXFunc)+wrap_processingInstruction p io =+	newcb_processingInstruction $ \ctx ctarget cdata ->+	catchRefIO p ctx $ do+		target <- peekUTF8 (castPtr ctarget)+		value <- peekUTF8 (castPtr cdata)+		parserToIO p (io (X.Instruction target value))++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_processingInstruction"+	getcb_processingInstruction :: Ptr Context -> IO (FunPtr ProcessingInstructionSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_processingInstruction"+	setcb_processingInstruction :: Ptr Context -> FunPtr ProcessingInstructionSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_processingInstruction :: ProcessingInstructionSAXFunc -> IO (FunPtr ProcessingInstructionSAXFunc)++-- }}}++-- external subset {{{++parsedExternalSubset :: Callback m (T.Text -> Maybe X.ExternalID -> m Bool)+parsedExternalSubset = callback wrap_externalSubset+	getcb_externalSubset+	setcb_externalSubset++type ExternalSubsetSAXFunc = Ptr Context -> CString -> CString -> CString -> IO ()++wrap_externalSubset :: Parser m -> (T.Text -> Maybe X.ExternalID -> m Bool) -> IO (FunPtr ExternalSubsetSAXFunc)+wrap_externalSubset p io =+	newcb_externalSubset $ \ctx cname cpublic csystem ->+	catchRefIO p ctx $ do+		name <- peekUTF8 (castPtr cname)+		public <- maybePeek peekUTF8 (castPtr cpublic)+		system <- maybePeek peekUTF8 (castPtr csystem)+		let external = case (public, system) of+			(Nothing, Just s) -> Just (X.SystemID s)+			(Just p', Just s) -> Just (X.PublicID p' s)+			_ -> Nothing+		parserToIO p (io name external)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_externalSubset"+	getcb_externalSubset :: Ptr Context -> IO (FunPtr ExternalSubsetSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_externalSubset"+	setcb_externalSubset :: Ptr Context -> FunPtr ExternalSubsetSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_externalSubset :: ExternalSubsetSAXFunc -> IO (FunPtr ExternalSubsetSAXFunc)++-- }}}++-- internal subset {{{++parsedInternalSubset :: Callback m (T.Text -> Maybe X.ExternalID -> m Bool)+parsedInternalSubset = callback wrap_internalSubset+	getcb_internalSubset+	setcb_internalSubset++type InternalSubsetSAXFunc = Ptr Context -> CString -> CString -> CString -> IO ()++wrap_internalSubset :: Parser m -> (T.Text -> Maybe X.ExternalID -> m Bool) -> IO (FunPtr InternalSubsetSAXFunc)+wrap_internalSubset p io =+	newcb_internalSubset $ \ctx cname cpublic csystem ->+	catchRefIO p ctx $ do+		name <- peekUTF8 (castPtr cname)+		public <- maybePeek peekUTF8 (castPtr cpublic)+		system <- maybePeek peekUTF8 (castPtr csystem)+		let external = case (public, system) of+			(Nothing, Just s) -> Just (X.SystemID s)+			(Just p', Just s) -> Just (X.PublicID p' s)+			_ -> Nothing+		parserToIO p (io name external)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_internalSubset"+	getcb_internalSubset :: Ptr Context -> IO (FunPtr InternalSubsetSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_internalSubset"+	setcb_internalSubset :: Ptr Context -> FunPtr InternalSubsetSAXFunc -> IO ()++foreign import ccall "wrapper"+	newcb_internalSubset :: InternalSubsetSAXFunc -> IO (FunPtr InternalSubsetSAXFunc)++-- }}}++-- warning and error {{{++reportWarning :: Callback m (T.Text -> m Bool)+reportWarning = callback wrap_FixedError+	getcb_warning+	setcb_warning++reportError :: Callback m (T.Text -> m Bool)+reportError = callback wrap_FixedError+	getcb_error+	setcb_error++type FixedErrorFunc = Ptr Context -> CString -> IO ()++wrap_FixedError :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr FixedErrorFunc)+wrap_FixedError p io =+	newcb_FixedError $ \ctx cmsg ->+	catchRefIO p ctx $ do+		msg <- peekUTF8 cmsg+		parserToIO p (io msg)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_warning"+	getcb_warning :: Ptr Context -> IO (FunPtr FixedErrorFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_error"+	getcb_error :: Ptr Context -> IO (FunPtr FixedErrorFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_warning"+	setcb_warning :: Ptr Context -> FunPtr FixedErrorFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_error"+	setcb_error :: Ptr Context -> FunPtr FixedErrorFunc -> IO ()++foreign import ccall "wrapper"+	newcb_FixedError :: FixedErrorFunc -> IO (FunPtr FixedErrorFunc)++-- }}}++-- }}}++withParserIO :: Parser m -> (Ptr Context -> IO a) -> IO a+withParserIO p io = withForeignPtr (parserHandle p) io++peekUTF8 :: CString -> IO T.Text+peekUTF8 = fmap (TE.decodeUtf8) . B.packCString++peekUTF8Len :: CStringLen -> IO T.Text+peekUTF8Len = fmap (TE.decodeUtf8) . B.packCStringLen++withUTF8 :: T.Text -> (CString -> IO a) -> IO a+withUTF8 = BU.unsafeUseAsCString . TE.encodeUtf8++freeFunPtr :: FunPtr a -> IO ()+freeFunPtr ptr = if ptr == nullFunPtr+	then return ()+	else freeHaskellFunPtr ptr++void :: Functor f => f a -> f ()+void = fmap (const ())++foreign import ccall unsafe "hslibxml-shim.h hslibxml_alloc_parser"+	cAllocParser :: CString -> IO (Ptr Context)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_free_parser"+	cFreeParser :: Ptr Context -> IO ()++foreign import ccall safe "libxml/parser.h xmlParseChunk"+	cParseChunk :: Ptr Context -> CString -> CInt -> CInt -> IO CInt++foreign import ccall safe "libxml/parser.h xmlStopParser"+	cStopParser :: Ptr Context -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_want_callback"+	cWantCallback :: Ptr Context -> Ptr a -> IO CInt++-- Unbound callback FFI definitions {{{++{-++data Entity = Entity++data ParserInput = ParserInput++data Enumeration = Enumeration++data ElementContent = ElementContent++data XmlError = XmlError++type IsStandaloneSAXFunc = Ptr Context -> IO CInt++type HasInternalSubsetSAXFunc = Ptr Context -> IO CInt++type HasExternalSubsetSAXFunc = Ptr Context -> IO CInt++type ExternalEntityLoader = CString -> CString -> Ptr Context -> IO (Ptr ParserInput)++type GetEntitySAXFunc = Ptr Context -> CString -> IO (Ptr Entity)++type EntityDeclSAXFunc = Ptr Context -> CString -> CInt -> CString -> CString -> CString -> IO ()++type NotationDeclSAXFunc = Ptr Context -> CString -> CString -> CString -> IO ()++type AttributeDeclSAXFunc = Ptr Context -> CString -> CString -> CInt -> CInt -> CString -> Ptr Enumeration -> IO ()++type ElementDeclSAXFunc = Ptr Context -> CString -> CInt -> Ptr ElementContent -> IO ()++type UnparsedEntityDeclSAXFunc = Ptr Context -> CString -> CString -> CString -> CString -> IO ()++type GetParameterEntitySAXFunc = Ptr Context -> CString -> IO (Ptr Entity)++type XmlStructuredErrorFunc = Ptr Context -> Ptr XmlError -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_isStandalone"+	getcb_isStandalone :: Ptr Context -> IO (FunPtr IsStandaloneSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_hasInternalSubset"+	getcb_hasInternalSubset :: Ptr Context -> IO (FunPtr HasInternalSubsetSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_hasExternalSubset"+	getcb_hasExternalSubset :: Ptr Context -> IO (FunPtr HasExternalSubsetSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_resolveEntity"+	getcb_resolveEntity :: Ptr Context -> IO (FunPtr ResolveEntitySAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_getEntity"+	getcb_getEntity :: Ptr Context -> IO (FunPtr GetEntitySAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_entityDecl"+	getcb_entityDecl :: Ptr Context -> IO (FunPtr EntityDeclSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_notationDecl"+	getcb_notationDecl :: Ptr Context -> IO (FunPtr NotationDeclSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_attributeDecl"+	getcb_attributeDecl :: Ptr Context -> IO (FunPtr AttributeDeclSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_elementDecl"+	getcb_elementDecl :: Ptr Context -> IO (FunPtr ElementDeclSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_unparsedEntityDecl"+	getcb_unparsedEntityDecl :: Ptr Context -> IO (FunPtr UnparsedEntityDeclSAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_getParameterEntity"+	getcb_getParameterEntity :: Ptr Context -> IO (FunPtr GetParameterEntitySAXFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_getcb_serror"+	getcb_serror :: Ptr Context -> IO (FunPtr XmlStructuredErrorFunc)++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_isStandalone"+	setcb_isStandalone :: Ptr Context -> FunPtr IsStandaloneSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_hasInternalSubset"+	setcb_hasInternalSubset :: Ptr Context -> FunPtr HasInternalSubsetSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_hasExternalSubset"+	setcb_hasExternalSubset :: Ptr Context -> FunPtr HasExternalSubsetSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_resolveEntity"+	setcb_resolveEntity :: Ptr Context -> FunPtr ResolveEntitySAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_getEntity"+	setcb_getEntity :: Ptr Context -> FunPtr GetEntitySAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_entityDecl"+	setcb_entityDecl :: Ptr Context -> FunPtr EntityDeclSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_notationDecl"+	setcb_notationDecl :: Ptr Context -> FunPtr NotationDeclSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_attributeDecl"+	setcb_attributeDecl :: Ptr Context -> FunPtr AttributeDeclSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_elementDecl"+	setcb_elementDecl :: Ptr Context -> FunPtr ElementDeclSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_unparsedEntityDecl"+	setcb_unparsedEntityDecl :: Ptr Context -> FunPtr UnparsedEntityDeclSAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_getParameterEntity"+	setcb_getParameterEntity :: Ptr Context -> FunPtr GetParameterEntitySAXFunc -> IO ()++foreign import ccall unsafe "hslibxml-shim.h hslibxml_setcb_serror"+	setcb_serror :: Ptr Context -> FunPtr XmlStructuredErrorFunc -> IO ()++-}++-- }}}

@@ -0,0 +1,464 @@+#define _GNU_SOURCE++#include "hslibxml-shim.h"+#include <string.h>+#include <stdio.h>++typedef struct UserData UserData;+struct UserData+{+	FixedErrorFunc warning;+	FixedErrorFunc error;+	xmlExternalEntityLoader resolveEntity;+};++static xmlParserInput *+hslibxml_entity_loader(const char *publicId, const char *systemId, xmlParserCtxt *ctx)+{+	UserData *user_data = (UserData *)ctx->_private;+	if (user_data && user_data->resolveEntity)+	{+		return user_data->resolveEntity(publicId, systemId, ctx);+	}+	return NULL;+}++xmlParserCtxt *+hslibxml_alloc_parser(const char *filename)+{+	xmlSAXHandler sax;+	xmlParserCtxt *ctx;+	UserData *user_data;+	+	static int entity_resolver_set = 0;+	if (entity_resolver_set == 0)+	{+		entity_resolver_set = 1;+		xmlSetExternalEntityLoader(hslibxml_entity_loader);+	}+	+	user_data = calloc(1, sizeof(UserData));+	+	memset(&sax, 0, sizeof(xmlSAXHandler));+	sax.initialized = XML_SAX2_MAGIC;+	+	ctx = xmlCreatePushParserCtxt(&sax, NULL, NULL, 0, filename);+	ctx->replaceEntities = 1;+	ctx->_private = user_data;+	return ctx;+}++void+hslibxml_free_parser(xmlParserCtxt *ctx)+{+	xmlFreeParserCtxt(ctx);+}++int+hslibxml_want_callback(xmlParserCtxt *ctx, void *cb_ctx)+{+	if (ctx->replaceEntities)+	{+		return 1;+	}+	+	return (ctx == cb_ctx);+}++internalSubsetSAXFunc+hslibxml_getcb_internalSubset(xmlParserCtxt *ctx)+{+	return ctx->sax->internalSubset;+}++isStandaloneSAXFunc+hslibxml_getcb_isStandalone(xmlParserCtxt *ctx)+{+	return ctx->sax->isStandalone;+}++hasInternalSubsetSAXFunc+hslibxml_getcb_hasInternalSubset(xmlParserCtxt *ctx)+{+	return ctx->sax->hasInternalSubset;+}++hasExternalSubsetSAXFunc+hslibxml_getcb_hasExternalSubset(xmlParserCtxt *ctx)+{+	return ctx->sax->hasExternalSubset;+}++xmlExternalEntityLoader+hslibxml_getcb_resolveEntity(xmlParserCtxt *ctx)+{+	UserData *user_data = (UserData *)ctx->_private;+	return user_data->resolveEntity;+}++getEntitySAXFunc+hslibxml_getcb_getEntity(xmlParserCtxt *ctx)+{+	return ctx->sax->getEntity;+}++entityDeclSAXFunc+hslibxml_getcb_entityDecl(xmlParserCtxt *ctx)+{+	return ctx->sax->entityDecl;+}++notationDeclSAXFunc+hslibxml_getcb_notationDecl(xmlParserCtxt *ctx)+{+	return ctx->sax->notationDecl;+}++attributeDeclSAXFunc+hslibxml_getcb_attributeDecl(xmlParserCtxt *ctx)+{+	return ctx->sax->attributeDecl;+}++elementDeclSAXFunc+hslibxml_getcb_elementDecl(xmlParserCtxt *ctx)+{+	return ctx->sax->elementDecl;+}++unparsedEntityDeclSAXFunc+hslibxml_getcb_unparsedEntityDecl(xmlParserCtxt *ctx)+{+	return ctx->sax->unparsedEntityDecl;+}++startDocumentSAXFunc+hslibxml_getcb_startDocument(xmlParserCtxt *ctx)+{+	return ctx->sax->startDocument;+}++endDocumentSAXFunc+hslibxml_getcb_endDocument(xmlParserCtxt *ctx)+{+	return ctx->sax->endDocument;+}++referenceSAXFunc+hslibxml_getcb_reference(xmlParserCtxt *ctx)+{+	return ctx->sax->reference;+}++charactersSAXFunc+hslibxml_getcb_characters(xmlParserCtxt *ctx)+{+	return ctx->sax->characters;+}++ignorableWhitespaceSAXFunc+hslibxml_getcb_ignorableWhitespace(xmlParserCtxt *ctx)+{+	return ctx->sax->ignorableWhitespace;+}++processingInstructionSAXFunc+hslibxml_getcb_processingInstruction(xmlParserCtxt *ctx)+{+	return ctx->sax->processingInstruction;+}++commentSAXFunc+hslibxml_getcb_comment(xmlParserCtxt *ctx)+{+	return ctx->sax->comment;+}++FixedErrorFunc+hslibxml_getcb_warning(xmlParserCtxt *ctx)+{+	UserData *user_data = (UserData *)ctx->_private;+	return user_data->warning;+}++FixedErrorFunc+hslibxml_getcb_error(xmlParserCtxt *ctx)+{+	UserData *user_data = (UserData *)ctx->_private;+	return user_data->error;+}++fatalErrorSAXFunc+hslibxml_getcb_fatalError(xmlParserCtxt *ctx)+{+	return ctx->sax->fatalError;+}++getParameterEntitySAXFunc+hslibxml_getcb_getParameterEntity(xmlParserCtxt *ctx)+{+	return ctx->sax->getParameterEntity;+}++cdataBlockSAXFunc+hslibxml_getcb_cdataBlock(xmlParserCtxt *ctx)+{+	return ctx->sax->cdataBlock;+}++externalSubsetSAXFunc+hslibxml_getcb_externalSubset(xmlParserCtxt *ctx)+{+	return ctx->sax->externalSubset;+}++startElementNsSAX2Func+hslibxml_getcb_startElementNs(xmlParserCtxt *ctx)+{+	return ctx->sax->startElementNs;+}++endElementNsSAX2Func+hslibxml_getcb_endElementNs(xmlParserCtxt *ctx)+{+	return ctx->sax->endElementNs;+}++xmlStructuredErrorFunc+hslibxml_getcb_serror(xmlParserCtxt *ctx)+{+	return ctx->sax->serror;+}++void+hslibxml_setcb_internalSubset(xmlParserCtxt *ctx, internalSubsetSAXFunc cb)+{+	ctx->sax->internalSubset = cb;+}++void+hslibxml_setcb_isStandalone(xmlParserCtxt *ctx, isStandaloneSAXFunc cb)+{+	ctx->sax->isStandalone = cb;+}++void+hslibxml_setcb_hasInternalSubset(xmlParserCtxt *ctx, hasInternalSubsetSAXFunc cb)+{+	ctx->sax->hasInternalSubset = cb;+}++void+hslibxml_setcb_hasExternalSubset(xmlParserCtxt *ctx, hasExternalSubsetSAXFunc cb)+{+	ctx->sax->hasExternalSubset = cb;+}++void+hslibxml_setcb_resolveEntity(xmlParserCtxt *ctx, xmlExternalEntityLoader cb)+{+	UserData *user_data = (UserData *)ctx->_private;+	user_data->resolveEntity = cb;+}++void+hslibxml_setcb_getEntity(xmlParserCtxt *ctx, getEntitySAXFunc cb)+{+	ctx->sax->getEntity = cb;+}++void+hslibxml_setcb_entityDecl(xmlParserCtxt *ctx, entityDeclSAXFunc cb)+{+	ctx->sax->entityDecl = cb;+}++void+hslibxml_setcb_notationDecl(xmlParserCtxt *ctx, notationDeclSAXFunc cb)+{+	ctx->sax->notationDecl = cb;+}++void+hslibxml_setcb_attributeDecl(xmlParserCtxt *ctx, attributeDeclSAXFunc cb)+{+	ctx->sax->attributeDecl = cb;+}++void+hslibxml_setcb_elementDecl(xmlParserCtxt *ctx, elementDeclSAXFunc cb)+{+	ctx->sax->elementDecl = cb;+}++void+hslibxml_setcb_unparsedEntityDecl(xmlParserCtxt *ctx, unparsedEntityDeclSAXFunc cb)+{+	ctx->sax->unparsedEntityDecl = cb;+}++void+hslibxml_setcb_startDocument(xmlParserCtxt *ctx, startDocumentSAXFunc cb)+{+	ctx->sax->startDocument = cb;+}++void+hslibxml_setcb_endDocument(xmlParserCtxt *ctx, endDocumentSAXFunc cb)+{+	ctx->sax->endDocument = cb;+}++void+hslibxml_setcb_reference(xmlParserCtxt *ctx, referenceSAXFunc cb)+{+	ctx->sax->reference = cb;+	+	if (cb == NULL)+	{ ctx->replaceEntities = 1; }+	+	else+	{ ctx->replaceEntities = 0; }+}++void+hslibxml_setcb_characters(xmlParserCtxt *ctx, charactersSAXFunc cb)+{+	ctx->sax->characters = cb;+}++void+hslibxml_setcb_ignorableWhitespace(xmlParserCtxt *ctx, ignorableWhitespaceSAXFunc cb)+{+	ctx->sax->ignorableWhitespace = cb;+}++void+hslibxml_setcb_processingInstruction(xmlParserCtxt *ctx, processingInstructionSAXFunc cb)+{+	ctx->sax->processingInstruction = cb;+}++void+hslibxml_setcb_comment(xmlParserCtxt *ctx, commentSAXFunc cb)+{+	ctx->sax->comment = cb;+}++static void+hslibxml_on_warning(void *data, const char *format, ...)+{+	xmlParserCtxt *ctx;+	UserData *user_data;+	char *msg;+	va_list params;+	int rc;+	+	ctx = (xmlParserCtxt *)data;+	user_data = (UserData *)ctx->_private;+	+	va_start(params, format);+	rc = vasprintf(&msg, format, params);+	if (rc == -1)+	{+		/* try to get something to the user */+		user_data->warning(ctx, format);+		return;+	}+	+	user_data->warning(ctx, msg);+	free(msg);+}++static void+hslibxml_on_error(void *data, const char *format, ...)+{+	xmlParserCtxt *ctx;+	UserData *user_data;+	char *msg;+	va_list params;+	int rc;+	+	ctx = (xmlParserCtxt *)data;+	user_data = (UserData *)ctx->_private;+	+	va_start(params, format);+	rc = vasprintf(&msg, format, params);+	if (rc == -1)+	{+		/* try to get something to the user */+		user_data->error(ctx, format);+		return;+	}+	+	user_data->error(ctx, msg);+	free(msg);+}++void+hslibxml_setcb_warning(xmlParserCtxt *ctx, FixedErrorFunc cb)+{+	UserData *user_data = (UserData *)ctx->_private;+	if (cb == NULL)+	{ ctx->sax->warning = NULL; }+	+	else+	{ ctx->sax->warning = hslibxml_on_warning; }+	+	user_data->warning = cb;+}++void+hslibxml_setcb_error(xmlParserCtxt *ctx, FixedErrorFunc cb)+{+	UserData *user_data = (UserData *)ctx->_private;+	if (cb == NULL)+	{ ctx->sax->error = NULL; }+	+	else+	{ ctx->sax->error = hslibxml_on_error; }+	+	user_data->error = cb;+}++void+hslibxml_setcb_fatalError(xmlParserCtxt *ctx, fatalErrorSAXFunc cb)+{+	ctx->sax->fatalError = cb;+}++void+hslibxml_setcb_getParameterEntity(xmlParserCtxt *ctx, getParameterEntitySAXFunc cb)+{+	ctx->sax->getParameterEntity = cb;+}++void+hslibxml_setcb_cdataBlock(xmlParserCtxt *ctx, cdataBlockSAXFunc cb)+{+	ctx->sax->cdataBlock = cb;+}++void+hslibxml_setcb_externalSubset(xmlParserCtxt *ctx, externalSubsetSAXFunc cb)+{+	ctx->sax->externalSubset = cb;+}++void+hslibxml_setcb_startElementNs(xmlParserCtxt *ctx, startElementNsSAX2Func cb)+{+	ctx->sax->startElementNs = cb;+}++void+hslibxml_setcb_endElementNs(xmlParserCtxt *ctx, endElementNsSAX2Func cb)+{+	ctx->sax->endElementNs = cb;+}++void+hslibxml_setcb_serror(xmlParserCtxt *ctx, xmlStructuredErrorFunc cb)+{+	ctx->sax->serror = cb;+}

@@ -0,0 +1,174 @@+#ifndef HSLIBXML_SHIM_H+#define HSLIBXML_SHIM_H++#include <libxml/parser.h>++/* Versions of the error handling callbacks with fixed arity */+typedef void(*FixedErrorFunc)(void *ctx, const char *msg);++xmlParserCtxt *+hslibxml_alloc_parser(const char *filename);++void+hslibxml_free_parser(xmlParserCtxt *ctx);++int+hslibxml_want_callback(xmlParserCtxt *ctx, void *cb_ctx);++internalSubsetSAXFunc+hslibxml_getcb_internalSubset(xmlParserCtxt *ctx);++isStandaloneSAXFunc+hslibxml_getcb_isStandalone(xmlParserCtxt *ctx);++hasInternalSubsetSAXFunc+hslibxml_getcb_hasInternalSubset(xmlParserCtxt *ctx);++hasExternalSubsetSAXFunc+hslibxml_getcb_hasExternalSubset(xmlParserCtxt *ctx);++xmlExternalEntityLoader+hslibxml_getcb_resolveEntity(xmlParserCtxt *ctx);++getEntitySAXFunc+hslibxml_getcb_getEntity(xmlParserCtxt *ctx);++entityDeclSAXFunc+hslibxml_getcb_entityDecl(xmlParserCtxt *ctx);++notationDeclSAXFunc+hslibxml_getcb_notationDecl(xmlParserCtxt *ctx);++attributeDeclSAXFunc+hslibxml_getcb_attributeDecl(xmlParserCtxt *ctx);++elementDeclSAXFunc+hslibxml_getcb_elementDecl(xmlParserCtxt *ctx);++unparsedEntityDeclSAXFunc+hslibxml_getcb_unparsedEntityDecl(xmlParserCtxt *ctx);++startDocumentSAXFunc+hslibxml_getcb_startDocument(xmlParserCtxt *ctx);++endDocumentSAXFunc+hslibxml_getcb_endDocument(xmlParserCtxt *ctx);++referenceSAXFunc+hslibxml_getcb_reference(xmlParserCtxt *ctx);++charactersSAXFunc+hslibxml_getcb_characters(xmlParserCtxt *ctx);++ignorableWhitespaceSAXFunc+hslibxml_getcb_ignorableWhitespace(xmlParserCtxt *ctx);++processingInstructionSAXFunc+hslibxml_getcb_processingInstruction(xmlParserCtxt *ctx);++commentSAXFunc+hslibxml_getcb_comment(xmlParserCtxt *ctx);++FixedErrorFunc+hslibxml_getcb_warning(xmlParserCtxt *ctx);++FixedErrorFunc+hslibxml_getcb_error(xmlParserCtxt *ctx);++getParameterEntitySAXFunc+hslibxml_getcb_getParameterEntity(xmlParserCtxt *ctx);++cdataBlockSAXFunc+hslibxml_getcb_cdataBlock(xmlParserCtxt *ctx);++externalSubsetSAXFunc+hslibxml_getcb_externalSubset(xmlParserCtxt *ctx);++startElementNsSAX2Func+hslibxml_getcb_startElementNs(xmlParserCtxt *ctx);++endElementNsSAX2Func+hslibxml_getcb_endElementNs(xmlParserCtxt *ctx);++xmlStructuredErrorFunc+hslibxml_getcb_serror(xmlParserCtxt *ctx);++void+hslibxml_setcb_internalSubset(xmlParserCtxt *ctx, internalSubsetSAXFunc cb);++void+hslibxml_setcb_isStandalone(xmlParserCtxt *ctx, isStandaloneSAXFunc cb);++void+hslibxml_setcb_hasInternalSubset(xmlParserCtxt *ctx, hasInternalSubsetSAXFunc cb);++void+hslibxml_setcb_hasExternalSubset(xmlParserCtxt *ctx, hasExternalSubsetSAXFunc cb);++void+hslibxml_setcb_resolveEntity(xmlParserCtxt *ctx, xmlExternalEntityLoader cb);++void+hslibxml_setcb_getEntity(xmlParserCtxt *ctx, getEntitySAXFunc cb);++void+hslibxml_setcb_entityDecl(xmlParserCtxt *ctx, entityDeclSAXFunc cb);++void+hslibxml_setcb_notationDecl(xmlParserCtxt *ctx, notationDeclSAXFunc cb);++void+hslibxml_setcb_attributeDecl(xmlParserCtxt *ctx, attributeDeclSAXFunc cb);++void+hslibxml_setcb_elementDecl(xmlParserCtxt *ctx, elementDeclSAXFunc cb);++void+hslibxml_setcb_unparsedEntityDecl(xmlParserCtxt *ctx, unparsedEntityDeclSAXFunc cb);++void+hslibxml_setcb_startDocument(xmlParserCtxt *ctx, startDocumentSAXFunc cb);++void+hslibxml_setcb_endDocument(xmlParserCtxt *ctx, endDocumentSAXFunc cb);++void+hslibxml_setcb_reference(xmlParserCtxt *ctx, referenceSAXFunc cb);++void+hslibxml_setcb_characters(xmlParserCtxt *ctx, charactersSAXFunc cb);++void+hslibxml_setcb_ignorableWhitespace(xmlParserCtxt *ctx, ignorableWhitespaceSAXFunc cb);++void+hslibxml_setcb_processingInstruction(xmlParserCtxt *ctx, processingInstructionSAXFunc cb);++void+hslibxml_setcb_comment(xmlParserCtxt *ctx, commentSAXFunc cb);++void+hslibxml_setcb_warning(xmlParserCtxt *ctx, FixedErrorFunc cb);++void+hslibxml_setcb_error(xmlParserCtxt *ctx, FixedErrorFunc cb);++void+hslibxml_setcb_getParameterEntity(xmlParserCtxt *ctx, getParameterEntitySAXFunc cb);++void+hslibxml_setcb_cdataBlock(xmlParserCtxt *ctx, cdataBlockSAXFunc cb);++void+hslibxml_setcb_externalSubset(xmlParserCtxt *ctx, externalSubsetSAXFunc cb);++void+hslibxml_setcb_startElementNs(xmlParserCtxt *ctx, startElementNsSAX2Func cb);++void+hslibxml_setcb_endElementNs(xmlParserCtxt *ctx, endElementNsSAX2Func cb);++void+hslibxml_setcb_serror(xmlParserCtxt *ctx, xmlStructuredErrorFunc cb);++#endif

@@ -1,5 +1,5 @@ name: libxml-sax-version: 0.6.1.1+version: 0.7 synopsis: Bindings for the libXML2 SAX interface license: MIT license-file: license.txt@@ -12,6 +12,7 @@ stability: experimental homepage: http://john-millikin.com/software/bindings/libxml-sax/ tested-with: GHC==6.12.1+extra-source-files: hslibxml-shim.h  source-repository head   type: bazaar@@ -19,18 +20,18 @@  library   ghc-options: -Wall+  cc-options: -Wall    build-depends:       base >= 4 && < 5     , bytestring >= 0.9 && < 0.10     , text >= 0.7 && < 0.12-    , xml-types >= 0.1 && < 0.2--  build-tools:-    c2hs >= 0.15+    , xml-types >= 0.3 && < 0.4    exposed-modules:     Text.XML.LibXML.SAX++  c-sources: hslibxml-shim.c    extra-libraries: xml2   pkgconfig-depends: libxml-2.0