libxml-sax 0.7.2 → 0.7.3
raw patch · 7 files changed
+1415/−1393 lines, 7 filesdep ~basedep ~bytestring
Dependency ranges changed: base, bytestring
Files
- Text/XML/LibXML/SAX.hs +0/−744
- cbits/hslibxml-shim.c +464/−0
- cbits/hslibxml-shim.h +174/−0
- hslibxml-shim.c +0/−464
- hslibxml-shim.h +0/−174
- lib/Text/XML/LibXML/SAX.hs +756/−0
- libxml-sax.cabal +21/−11
− Text/XML/LibXML/SAX.hs
@@ -1,744 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}---------------------------------------------------------------------------------- |--- 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 Data.Char (chr, isDigit)-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- refCB <- getcb_reference ctx- let hasRefCB = refCB /= nullFunPtr- - ns <- maybePeek peekUTF8 (castPtr cns)- pfx <- maybePeek peekUTF8 (castPtr cpfx)- ln <- peekUTF8 (castPtr cln)- attrs <- peekAttributes hasRefCB (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 :: Bool -> Ptr CString -> CInt -> IO [(X.Name, [X.Content])]-peekAttributes hasRefCB 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 = if hasRefCB- then parseAttributeContent val- else [X.ContentText 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 eof- content = charRef +++ reference +++ text- charRef = do- void (ReadP.string "&#")- val <- ReadP.munch1 (isDigit)- void (ReadP.char ';')- return (X.ContentText (T.singleton (chr (read val))))- 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))--#if MIN_VERSION_base(4,2,0)- eof = ReadP.eof-#else- eof = do- s <- ReadP.look- unless (null s) ReadP.pfail-#endif---- }}}---- 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 ()---}---- }}}
+ cbits/hslibxml-shim.c view
@@ -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;+}
+ cbits/hslibxml-shim.h view
@@ -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
− hslibxml-shim.c
@@ -1,464 +0,0 @@-#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;-}
− hslibxml-shim.h
@@ -1,174 +0,0 @@-#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
+ lib/Text/XML/LibXML/SAX.hs view
@@ -0,0 +1,756 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- 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++#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)+#else+import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)+#endif++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as BU+import Data.Char (chr, isDigit)+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)+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 = mask $ \_ -> 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 = unsafeIOToST $ do+ p <- newParserIO filename+ return $ p+ { parserToIO = unsafeSTToIO+ , parserFromIO = unsafeIOToST+ }++parseImpl :: Parser m -> (Ptr Context -> IO CInt) -> m ()+parseImpl p io = parserFromIO p $ do+ writeIORef (parserErrorRef p) Nothing+ _ <- mask (\_ -> 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 (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+ refCB <- getcb_reference ctx+ let hasRefCB = refCB /= nullFunPtr+ + ns <- maybePeek peekUTF8 (castPtr cns)+ pfx <- maybePeek peekUTF8 (castPtr cpfx)+ ln <- peekUTF8 (castPtr cln)+ attrs <- peekAttributes hasRefCB (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 :: Bool -> Ptr CString -> CInt -> IO [(X.Name, [X.Content])]+peekAttributes hasRefCB 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 = if hasRefCB+ then parseAttributeContent val+ else [X.ContentText 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 eof+ content = charRef +++ reference +++ text+ charRef = do+ _ <- ReadP.string "&#"+ val <- ReadP.munch1 (isDigit)+ _ <- ReadP.char ';'+ return (X.ContentText (T.singleton (chr (read val))))+ reference = do+ _ <- ReadP.char '&'+ name <- ReadP.munch1 (/= ';')+ _ <- ReadP.char ';'+ return (X.ContentEntity (T.pack name))+ text = do+ chars <- ReadP.munch1 (/= '&')+ return (X.ContentText (T.pack chars))++#if MIN_VERSION_base(4,2,0)+ eof = ReadP.eof+#else+ eof = do+ s <- ReadP.look+ unless (null s) ReadP.pfail+#endif++-- }}}++-- 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++-- mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b+mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b+#if MIN_VERSION_base(4,3,0)+mask = E.mask+#else+mask io = E.block (io E.unblock)+#endif++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 ()++-}++-- }}}
libxml-sax.cabal view
@@ -1,37 +1,47 @@ name: libxml-sax-version: 0.7.2-synopsis: Bindings for the libXML2 SAX interface+version: 0.7.3 license: MIT license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com-copyright: Copyright (c) John Millikin 2010 build-type: Simple-cabal-version: >=1.6+cabal-version: >= 1.6 category: Foreign, Text, XML, Parsing stability: experimental-homepage: http://john-millikin.com/software/bindings/libxml-sax/-tested-with: GHC==6.12.1-extra-source-files: hslibxml-shim.h+homepage: https://john-millikin.com/software/haskell-libxml/+bug-reports: mailto:jmillikin@gmail.com +synopsis: Bindings for the libXML2 SAX interface+description:++extra-source-files:+ cbits/hslibxml-shim.c+ cbits/hslibxml-shim.h+ source-repository head type: bazaar- location: http://john-millikin.com/software/bindings/libxml-sax/+ location: https://john-millikin.com/branches/haskell-libxml-sax/0.7/ +source-repository this+ type: bazaar+ location: https://john-millikin.com/branches/haskell-libxml-sax/0.7/+ tag: haskell-libxml-sax_0.7.3+ library+ hs-source-dirs: lib ghc-options: -Wall -O2 cc-options: -Wall build-depends:- base >= 4 && < 5- , bytestring >= 0.9 && < 0.10+ base >= 4.1 && < 5.0+ , bytestring >= 0.9 , text >= 0.7 && < 0.12 , xml-types >= 0.3 && < 0.4 exposed-modules: Text.XML.LibXML.SAX - c-sources: hslibxml-shim.c+ c-sources: cbits/hslibxml-shim.c extra-libraries: xml2 pkgconfig-depends: libxml-2.0