packages feed

libxml-sax 0.5.1 → 0.6

raw patch · 2 files changed

+331/−195 lines, 2 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

- Text.XML.LibXML.SAX: ParserCallbacks :: (Name -> [Attribute] -> ST s ()) -> (Name -> ST s ()) -> (Text -> ST s ()) -> (Text -> ST s ()) -> (Instruction -> ST s ()) -> ParserCallbacks s
- Text.XML.LibXML.SAX: data ParserCallbacks s
- Text.XML.LibXML.SAX: newParser :: ParserCallbacks s -> (Text -> ST s ()) -> Maybe Text -> ST s (Parser s)
- Text.XML.LibXML.SAX: parse :: Parser s -> ByteString -> ST s ()
- Text.XML.LibXML.SAX: parsedProcessingInstruction :: ParserCallbacks s -> Instruction -> ST s ()
+ Text.XML.LibXML.SAX: clearCallback :: Parser m -> Callback m a -> m ()
+ Text.XML.LibXML.SAX: data Callback m a
+ Text.XML.LibXML.SAX: newParserIO :: (Text -> IO ()) -> Maybe Text -> IO (Parser IO)
+ Text.XML.LibXML.SAX: newParserST :: (Text -> ST s ()) -> Maybe Text -> ST s (Parser (ST s))
+ Text.XML.LibXML.SAX: parseBuffer :: Parser m -> (Ptr Word8, Integer) -> m ()
+ Text.XML.LibXML.SAX: parseBytes :: Parser m -> ByteString -> m ()
+ Text.XML.LibXML.SAX: parseLazyBytes :: Parser m -> ByteString -> m ()
+ Text.XML.LibXML.SAX: parseLazyText :: Parser m -> Text -> m ()
+ Text.XML.LibXML.SAX: parseText :: Parser m -> Text -> m ()
+ Text.XML.LibXML.SAX: parsedBeginDocument :: Callback m (m Bool)
+ Text.XML.LibXML.SAX: parsedCharactersBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)
+ Text.XML.LibXML.SAX: parsedCommentBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)
+ Text.XML.LibXML.SAX: parsedEndDocument :: Callback m (m Bool)
+ Text.XML.LibXML.SAX: parsedInstruction :: Callback m (Instruction -> m Bool)
+ Text.XML.LibXML.SAX: setCallback :: Parser m -> Callback m a -> a -> m ()
- Text.XML.LibXML.SAX: data Parser s
+ Text.XML.LibXML.SAX: data Parser m
- Text.XML.LibXML.SAX: parseComplete :: Parser s -> ST s ()
+ Text.XML.LibXML.SAX: parseComplete :: Parser m -> m ()
- Text.XML.LibXML.SAX: parsedBeginElement :: ParserCallbacks s -> Name -> [Attribute] -> ST s ()
+ Text.XML.LibXML.SAX: parsedBeginElement :: Callback m (Name -> [Attribute] -> m Bool)
- Text.XML.LibXML.SAX: parsedCharacters :: ParserCallbacks s -> Text -> ST s ()
+ Text.XML.LibXML.SAX: parsedCharacters :: Callback m (Text -> m Bool)
- Text.XML.LibXML.SAX: parsedComment :: ParserCallbacks s -> Text -> ST s ()
+ Text.XML.LibXML.SAX: parsedComment :: Callback m (Text -> m Bool)
- Text.XML.LibXML.SAX: parsedEndElement :: ParserCallbacks s -> Name -> ST s ()
+ Text.XML.LibXML.SAX: parsedEndElement :: Callback m (Name -> m Bool)

Files

Text/XML/LibXML/SAX.chs view
@@ -10,133 +10,178 @@ -- Bindings for the libXML2 SAX interface -- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface #-} -#include <libxml/parser.h>-#include <string.h>-+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RankNTypes #-} module Text.XML.LibXML.SAX-	( Parser-	, ParserCallbacks (..)-	, newParser-	, parse+	(+	-- * Parser+	  Parser+	, newParserIO+	, newParserST+	+	-- ** Callbacks+	, Callback+	, setCallback+	, clearCallback+	+	, parsedBeginDocument+	, parsedEndDocument+	, parsedBeginElement+	, parsedEndElement+	, parsedCharacters+	, parsedComment+	, parsedInstruction+	+	-- *** 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.STRef as ST import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B+import qualified Data.ByteString.Unsafe as BU import qualified Data.ByteString.Lazy as BL-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Encoding as TE+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 Foreign+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Foreign hiding (free) import Foreign.C import qualified Foreign.Concurrent as FC -data ParserCallbacks s = ParserCallbacks-	{ parsedBeginElement :: X.Name -> [X.Attribute] -> ST.ST s ()-	, parsedEndElement :: X.Name -> ST.ST s ()-	, parsedCharacters :: T.Text -> ST.ST s ()-	, parsedComment :: T.Text -> ST.ST s ()-	, parsedProcessingInstruction :: X.Instruction -> ST.ST s ()-	}+#include <libxml/parser.h>+#include <string.h> -{# pointer *xmlParserCtxt as Context newtype #}+{# pointer *xmlParserCtxt as ParserHandle newtype #} -data Parser s = Parser-	{ parserContext :: ForeignPtr Context-	, parserCallbackPtr :: ForeignPtr ()-	, parserOnError :: T.Text -> ST.ST s ()-	, parserErrorRef :: ST.STRef s (Maybe E.SomeException)+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 	} -newParser :: ParserCallbacks s-          -> (T.Text -> ST.ST s ()) -- ^ An error handler, called if parsing fails-          -> Maybe T.Text -- ^ An optional filename or URI-          -> ST.ST s (Parser s)-newParser callbacks onError filename = do-	ref <- ST.newSTRef Nothing-	ST.unsafeIOToST $ do-		cCallbacks <- mallocForeignPtrBytes {# sizeof xmlSAXHandler #}-		withForeignPtr cCallbacks $ \raw -> do-			{# call memset #} raw 0 {# sizeof xmlSAXHandler #}-			{#set xmlSAXHandler->initialized #} raw xmlSax2Magic-			-			wrappedBegin (onBeginElement ref (parsedBeginElement callbacks))-				>>= {#set xmlSAXHandler->startElementNs #} raw-			wrappedEnd (onEndElement ref (parsedEndElement callbacks))-				>>= {#set xmlSAXHandler->endElementNs #} raw-			wrappedText (onCharacters ref (parsedCharacters callbacks))-				>>= {#set xmlSAXHandler->characters #} raw-			wrappedComment (onComment ref (parsedComment callbacks))-				>>= {#set xmlSAXHandler->comment #} raw-			wrappedPI (onProcessingInstruction ref (parsedProcessingInstruction callbacks))-				>>= {#set xmlSAXHandler->processingInstruction #} raw-			-			FC.addForeignPtrFinalizer cCallbacks $ freeParserCallbacks raw-		-		ctxFP <- withForeignPtr cCallbacks $ \sax ->-			maybeWith withUTF8 filename $ \cFilename -> do-				Context ctx <- {#call xmlCreatePushParserCtxt #} sax nullPtr nullPtr 0 cFilename-				{#set xmlParserCtxt->replaceEntities #} ctx 1-				newForeignPtr xmlFreeParserCtxt ctx-		-		return $ Parser ctxFP cCallbacks onError ref+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+		{# 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 >>= freeHaskellFunPtr-	{# get xmlSAXHandler->endElementNs #} raw >>= freeHaskellFunPtr-	{# get xmlSAXHandler->characters #} raw >>= freeHaskellFunPtr-	{# get xmlSAXHandler->comment #} raw >>= freeHaskellFunPtr-	{# get xmlSAXHandler->processingInstruction #} raw >>= freeHaskellFunPtr+	{# 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"-	xmlFreeParserCtxt :: FunPtr (Ptr Context -> IO ())+	cParserFree :: FunPtr (Ptr ParserHandle -> IO ()) --- | Feed some text into the parser. This may be performed multiple times--- per 'Parser' value, in which case the internal parser state is retained--- between computations.--- -parse :: Parser s -> B.ByteString -> ST.ST s ()-parse p bytes = parse' p $ \h ->-	B.unsafeUseAsCStringLen bytes $ \(cs, csLen) -> do-	{# call xmlParseChunk #} h cs (fromIntegral csLen) 0+-- | A callback should return 'True' to continue parsing, or 'False'+-- to cancel.+--+data Callback m a = Callback (Parser m -> a -> IO ()) (Parser m -> IO ()) --- | Finish parsing any buffered data, and check that the document was--- closed correctly.--- -parseComplete :: Parser s -> ST.ST s ()-parseComplete p = parse' p $ \h ->-	{#call xmlParseChunk #} h nullPtr 0 1+setCallback :: Parser m -> Callback m a -> a -> m ()+setCallback p (Callback set _) io = parserFromIO p $ set p io -withParser :: Parser s -> (Context -> IO a) -> ST.ST s a-withParser p io = ST.unsafeIOToST $ withForeignPtr (parserContext p) $ io . Context+clearCallback :: Parser m -> Callback m a -> m ()+clearCallback p (Callback _ clear) = parserFromIO p $ clear p -parse' :: Parser s -> (Context -> IO CInt) -> ST.ST s ()-parse' p io = do-	let ref = parserErrorRef p-	ST.writeSTRef ref Nothing-	maybeErr <- withParser p $ \h -> do-		rc <- E.block $ io h-		touchForeignPtr $ parserCallbackPtr p-		maybeError <- ST.unsafeSTToIO $ ST.readSTRef ref-		case maybeError of-			Just err -> E.throwIO err-			Nothing -> return ()-		case rc of-			0 -> return Nothing-			_ -> do-				let Context h' = h-				errInfo <- {#call xmlCtxtGetLastError #} $ castPtr h'-				message <- peekUTF8 =<< {#get xmlError->message #} errInfo-				return $ Just message-	case maybeErr of-		Nothing -> return ()-		Just err -> parserOnError p err+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 ()++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)+ -- localname, prefix, namespace, value_begin, value_end data CAttribute = CAttribute CString CString CString CString CString @@ -160,100 +205,190 @@ 	val <- peekUTF8Len (c_vbegin, minusPtr c_vend c_vbegin) 	return (X.Attribute (X.Name ln ns pfx) [X.ContentText val]) -peekUTF8 :: CString -> IO T.Text-peekUTF8 cstr = do-	chunk <- B.packCString cstr-	return $ TE.decodeUtf8 $ BL.fromChunks [chunk]+-- Exposed callbacks -peekUTF8Len :: CStringLen -> IO T.Text-peekUTF8Len cstr = do-	chunk <- B.packCStringLen cstr-	return $ TE.decodeUtf8 $ BL.fromChunks [chunk]+wrapCallback0 :: Parser m -> m Bool -> IO (FunPtr Callback0)+wrapCallback0 p io = allocCallback0 $ \_ -> catchRef p io -withUTF8 :: T.Text -> (CString -> IO a) -> IO a-withUTF8 text io = B.useAsCString bytes io where-	bytes = B.concat (BL.toChunks (TE.encodeUtf8 text))+parsedBeginDocument :: Callback m (m Bool)+parsedBeginDocument = callback wrapCallback0+	{# get xmlSAXHandler->startDocument #}+	{# set xmlSAXHandler->startDocument #} --- Callback adapters-type CUString = Ptr CUChar+parsedEndDocument :: Callback m (m Bool)+parsedEndDocument = callback wrapCallback0+	{# get xmlSAXHandler->endDocument #}+	{# set xmlSAXHandler->endDocument #} -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 ())+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 -type CommentSAXFunc = Ptr () -> CUString -> IO ()+parsedBeginElement :: Callback m (X.Name -> [X.Attribute] -> m Bool)+parsedBeginElement = callback wrapBeginElement+	{# get xmlSAXHandler->startElementNs #}+	{# set xmlSAXHandler->startElementNs #} -type ProcessingInstructionSAXFunc = Ptr () -> CUString -> CUString -> IO ()+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 -catchRef :: ST.STRef s (Maybe E.SomeException) -> Ptr () -> IO (ST.ST s ()) -> IO ()-catchRef ref ctx getST = E.catch io onError where-	io = do-		st <- getST-		E.unblock $ ST.unsafeSTToIO st-	onError e = do-		ST.unsafeSTToIO $ ST.writeSTRef ref $ Just e-		{# call xmlStopParser #} (Context (castPtr ctx))-		return ()+parsedEndElement :: Callback m (X.Name -> m Bool)+parsedEndElement = callback wrapEndElement+	{# get xmlSAXHandler->endElementNs #}+	{# set xmlSAXHandler->endElementNs #} -onBeginElement :: ST.STRef s (Maybe E.SomeException)-               -> (X.Name -> [X.Attribute] -> ST.ST s ())-               -> StartElementNsSAX2Func-onBeginElement ref st ctx cln cpfx cns _ _ n_attrs _ raw_attrs = catchRef ref ctx $ 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-	return $ st (X.Name ln ns pfx) attrs+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 -onEndElement :: ST.STRef s (Maybe E.SomeException)-             -> (X.Name -> ST.ST s ())-             -> EndElementNsSAX2Func-onEndElement ref st ctx cln cpfx cns = catchRef ref ctx $ do-	ns <- maybePeek peekUTF8 $ castPtr cns-	pfx <- maybePeek peekUTF8 $ castPtr cpfx-	ln <- peekUTF8 $ castPtr cln-	return $ st (X.Name ln ns pfx)+parsedCharacters :: Callback m (T.Text -> m Bool)+parsedCharacters = callback wrapCharacters+	{# get xmlSAXHandler->characters #}+	{# set xmlSAXHandler->characters #} -onCharacters :: ST.STRef s (Maybe E.SomeException)-             -> (T.Text -> ST.ST s ())-             -> CharactersSAXFunc-onCharacters ref st ctx ctext ctextlen = catchRef ref ctx $ do-	text <- peekUTF8Len (castPtr ctext, fromIntegral ctextlen)-	return $ st text+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 -onComment :: ST.STRef s (Maybe E.SomeException)-          -> (T.Text -> ST.ST s ())-          -> CommentSAXFunc-onComment ref st ctx ctext = catchRef ref ctx $ do-	text <- peekUTF8 (castPtr ctext)-	return $ st text+parsedComment :: Callback m (T.Text -> m Bool)+parsedComment = callback wrapComment+	{# get xmlSAXHandler->comment #}+	{# set xmlSAXHandler->comment #} -onProcessingInstruction :: ST.STRef s (Maybe E.SomeException)-                        -> (X.Instruction -> ST.ST s ())-                        -> ProcessingInstructionSAXFunc-onProcessingInstruction ref st ctx ctarget cdata = catchRef ref ctx $ do-	target <- peekUTF8 (castPtr ctarget)-	value <- peekUTF8 (castPtr cdata)-	return $ st (X.Instruction target value)+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 -foreign import ccall "wrapper"-	wrappedBegin :: StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)+parsedInstruction :: Callback m (X.Instruction -> m Bool)+parsedInstruction = callback wrapInstruction+	{# get xmlSAXHandler->processingInstruction #}+	{# set xmlSAXHandler->processingInstruction #} -foreign import ccall "wrapper"-	wrappedEnd :: EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)+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) -foreign import ccall "wrapper"-	wrappedText :: CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc)+parsedCharactersBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)+parsedCharactersBuffer = callback wrapCharactersBuffer+	{# get xmlSAXHandler->characters #}+	{# set xmlSAXHandler->characters #} -foreign import ccall "wrapper"-	wrappedComment :: CommentSAXFunc -> IO (FunPtr CommentSAXFunc)+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) -foreign import ccall "wrapper"-	wrappedPI :: ProcessingInstructionSAXFunc -> IO (FunPtr ProcessingInstructionSAXFunc)+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
libxml-sax.cabal view
@@ -1,15 +1,16 @@-Name: libxml-sax-Version: 0.5.1-stability: experimental-Synopsis: Bindings for the libXML2 SAX interface-License: MIT-License-file: license.txt-Author: John Millikin+name: libxml-sax+version: 0.6+synopsis: Bindings for the libXML2 SAX interface+license: MIT+license-file: license.txt+author: John Millikin maintainer: jmillikin@gmail.com-copyright: John Millikin 2010-Build-Type: Simple-Cabal-Version: >=1.6-Category: Text, XML, Parsing+copyright: Copyright (c) John Millikin 2010+build-type: Simple+cabal-version: >=1.6+category: Foreign, Text, XML, Parsing+stability: experimental+homepage: http://ianen.org/haskell/bindings/libxml-sax/ tested-with: GHC==6.12.1  source-repository head@@ -18,17 +19,17 @@  library   ghc-options: -Wall -fno-warn-unused-do-bind--  build-tools: c2hs-   build-depends:-      base >=3 && < 5+      base >=4 && < 5     , bytestring >= 0.9 && < 0.10     , text >= 0.7 && < 0.8     , xml-types >= 0.1 && < 0.2 -  extra-libraries: xml2-  pkgconfig-depends: libxml-2.0+  build-tools:+    c2hs >= 0.15    exposed-modules:     Text.XML.LibXML.SAX++  extra-libraries: xml2+  pkgconfig-depends: libxml-2.0