{-# 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
	{ forall (m :: * -> *). Parser m -> ForeignPtr Context
parserHandle :: ForeignPtr Context
	, forall (m :: * -> *). Parser m -> IORef (Maybe SomeException)
parserErrorRef :: IORef (Maybe E.SomeException)
	, forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO :: forall a. m a -> IO a
	, forall (m :: * -> *). Parser m -> forall a. IO a -> m a
parserFromIO :: forall a. IO a -> m a
	}

newParserIO :: Maybe T.Text -- ^ An optional filename or URI
            -> IO (Parser IO)
newParserIO :: Maybe Text -> IO (Parser IO)
newParserIO Maybe Text
filename = ((forall a. IO a -> IO a) -> IO (Parser IO)) -> IO (Parser IO)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Parser IO)) -> IO (Parser IO))
-> ((forall a. IO a -> IO a) -> IO (Parser IO)) -> IO (Parser IO)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_ -> do
	IORef (Maybe SomeException)
ref <- Maybe SomeException -> IO (IORef (Maybe SomeException))
forall a. a -> IO (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing
	
	Ptr Context
raw <- (Text -> (Ptr CChar -> IO (Ptr Context)) -> IO (Ptr Context))
-> Maybe Text
-> (Ptr CChar -> IO (Ptr Context))
-> IO (Ptr Context)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith Text -> (Ptr CChar -> IO (Ptr Context)) -> IO (Ptr Context)
forall a. Text -> (Ptr CChar -> IO a) -> IO a
withUTF8 Maybe Text
filename Ptr CChar -> IO (Ptr Context)
cAllocParser
	ForeignPtr Context
managed <- Ptr Context -> IO (ForeignPtr Context)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Context
raw
	
	ForeignPtr Context -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
FC.addForeignPtrFinalizer ForeignPtr Context
managed (Ptr Context -> IO ()
cFreeParser Ptr Context
raw)
	ForeignPtr Context -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
FC.addForeignPtrFinalizer ForeignPtr Context
managed (Ptr Context -> IO ()
freeCallbacks Ptr Context
raw)
	
	Parser IO -> IO (Parser IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Context
-> IORef (Maybe SomeException)
-> (forall a. IO a -> IO a)
-> (forall a. IO a -> IO a)
-> Parser IO
forall (m :: * -> *).
ForeignPtr Context
-> IORef (Maybe SomeException)
-> (forall a. m a -> IO a)
-> (forall a. IO a -> m a)
-> Parser m
Parser ForeignPtr Context
managed IORef (Maybe SomeException)
ref IO a -> IO a
forall a. a -> a
forall a. IO a -> IO a
id IO a -> IO a
forall a. a -> a
forall a. IO a -> IO a
id)

newParserST :: Maybe T.Text -- ^ An optional filename or URI
            -> ST.ST s (Parser (ST.ST s))
newParserST :: forall s. Maybe Text -> ST s (Parser (ST s))
newParserST Maybe Text
filename = IO (Parser (ST s)) -> ST s (Parser (ST s))
forall a s. IO a -> ST s a
unsafeIOToST (IO (Parser (ST s)) -> ST s (Parser (ST s)))
-> IO (Parser (ST s)) -> ST s (Parser (ST s))
forall a b. (a -> b) -> a -> b
$ do
	Parser IO
p <- Maybe Text -> IO (Parser IO)
newParserIO Maybe Text
filename
	Parser (ST s) -> IO (Parser (ST s))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser (ST s) -> IO (Parser (ST s)))
-> Parser (ST s) -> IO (Parser (ST s))
forall a b. (a -> b) -> a -> b
$ Parser IO
p
		{ parserToIO = unsafeSTToIO
		, parserFromIO = unsafeIOToST
		}

parseImpl :: Parser m -> (Ptr Context -> IO CInt) -> m ()
parseImpl :: forall (m :: * -> *). Parser m -> (Ptr Context -> IO CInt) -> m ()
parseImpl Parser m
p Ptr Context -> IO CInt
io = Parser m -> forall a. IO a -> m a
forall (m :: * -> *). Parser m -> forall a. IO a -> m a
parserFromIO Parser m
p (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
	IORef (Maybe SomeException) -> Maybe SomeException -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Parser m -> IORef (Maybe SomeException)
forall (m :: * -> *). Parser m -> IORef (Maybe SomeException)
parserErrorRef Parser m
p) Maybe SomeException
forall a. Maybe a
Nothing
	CInt
_ <- ((forall a. IO a -> IO a) -> IO CInt) -> IO CInt
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
_ -> Parser m -> (Ptr Context -> IO CInt) -> IO CInt
forall (m :: * -> *) a. Parser m -> (Ptr Context -> IO a) -> IO a
withParserIO Parser m
p Ptr Context -> IO CInt
io)
	
	Maybe SomeException
threw <- IORef (Maybe SomeException) -> IO (Maybe SomeException)
forall a. IORef a -> IO a
readIORef (Parser m -> IORef (Maybe SomeException)
forall (m :: * -> *). Parser m -> IORef (Maybe SomeException)
parserErrorRef Parser m
p)
	case Maybe SomeException
threw of
		Maybe SomeException
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
		Just SomeException
exc -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO SomeException
exc

parseBytes :: Parser m -> B.ByteString -> m ()
parseBytes :: forall (m :: * -> *). Parser m -> ByteString -> m ()
parseBytes Parser m
p ByteString
bytes = Parser m -> (Ptr Context -> IO CInt) -> m ()
forall (m :: * -> *). Parser m -> (Ptr Context -> IO CInt) -> m ()
parseImpl Parser m
p ((Ptr Context -> IO CInt) -> m ())
-> (Ptr Context -> IO CInt) -> m ()
forall a b. (a -> b) -> a -> b
$ \Ptr Context
h ->
	ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) ->
	Ptr Context -> Ptr CChar -> CInt -> CInt -> IO CInt
cParseChunk Ptr Context
h Ptr CChar
cstr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) CInt
0

-- | Finish parsing any buffered data, and check that the document was
-- closed correctly.
-- 
parseComplete :: Parser m -> m ()
parseComplete :: forall (m :: * -> *). Parser m -> m ()
parseComplete Parser m
p = Parser m -> (Ptr Context -> IO CInt) -> m ()
forall (m :: * -> *). Parser m -> (Ptr Context -> IO CInt) -> m ()
parseImpl Parser m
p (\Ptr Context
h -> Ptr Context -> IO CInt
cParseComplete Ptr Context
h)

-- Callbacks {{{

freeCallbacks :: Ptr Context -> IO ()
freeCallbacks :: Ptr Context -> IO ()
freeCallbacks Ptr Context
ctx = do
	Ptr Context -> IO (FunPtr (Ptr Context -> IO ()))
getcb_startDocument Ptr Context
ctx IO (FunPtr (Ptr Context -> IO ()))
-> (FunPtr (Ptr Context -> IO ()) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr (Ptr Context -> IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr (Ptr Context -> IO ()))
getcb_endDocument Ptr Context
ctx IO (FunPtr (Ptr Context -> IO ()))
-> (FunPtr (Ptr Context -> IO ()) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr (Ptr Context -> IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr StartElementNsSAX2Func)
getcb_startElementNs Ptr Context
ctx IO (FunPtr StartElementNsSAX2Func)
-> (FunPtr StartElementNsSAX2Func -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr StartElementNsSAX2Func -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_endElementNs Ptr Context
ctx IO (FunPtr EndElementNsSAX2Func)
-> (FunPtr EndElementNsSAX2Func -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr EndElementNsSAX2Func -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_characters Ptr Context
ctx IO (FunPtr CharactersSAXFunc)
-> (FunPtr CharactersSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr CharactersSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_reference Ptr Context
ctx IO (FunPtr ReferenceSAXFunc)
-> (FunPtr ReferenceSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr ReferenceSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_comment Ptr Context
ctx IO (FunPtr ReferenceSAXFunc)
-> (FunPtr ReferenceSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr ReferenceSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr ProcessingInstructionSAXFunc)
getcb_processingInstruction Ptr Context
ctx IO (FunPtr ProcessingInstructionSAXFunc)
-> (FunPtr ProcessingInstructionSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr ProcessingInstructionSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_cdataBlock Ptr Context
ctx IO (FunPtr CharactersSAXFunc)
-> (FunPtr CharactersSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr CharactersSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_ignorableWhitespace Ptr Context
ctx IO (FunPtr CharactersSAXFunc)
-> (FunPtr CharactersSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr CharactersSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_internalSubset Ptr Context
ctx IO (FunPtr EndElementNsSAX2Func)
-> (FunPtr EndElementNsSAX2Func -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr EndElementNsSAX2Func -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_externalSubset Ptr Context
ctx IO (FunPtr EndElementNsSAX2Func)
-> (FunPtr EndElementNsSAX2Func -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr EndElementNsSAX2Func -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_warning Ptr Context
ctx IO (FunPtr ReferenceSAXFunc)
-> (FunPtr ReferenceSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr ReferenceSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_error Ptr Context
ctx IO (FunPtr ReferenceSAXFunc)
-> (FunPtr ReferenceSAXFunc -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr ReferenceSAXFunc -> IO ()
forall a. FunPtr a -> IO ()
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 :: forall (m :: * -> *) a. Parser m -> Callback m a -> a -> m ()
setCallback Parser m
p (Callback Parser m -> a -> IO ()
set Parser m -> IO ()
_) a
io = Parser m -> forall a. IO a -> m a
forall (m :: * -> *). Parser m -> forall a. IO a -> m a
parserFromIO Parser m
p (Parser m -> a -> IO ()
set Parser m
p a
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 :: forall (m :: * -> *) a. Parser m -> Callback m a -> m ()
clearCallback Parser m
p (Callback Parser m -> a -> IO ()
_ Parser m -> IO ()
clear) = Parser m -> forall a. IO a -> m a
forall (m :: * -> *). Parser m -> forall a. IO a -> m a
parserFromIO Parser m
p (Parser m -> IO ()
clear Parser m
p)

catchRef :: Parser m -> Ptr Context -> m Bool -> IO ()
catchRef :: forall (m :: * -> *). Parser m -> Ptr Context -> m Bool -> IO ()
catchRef Parser m
p Ptr Context
cb_ctx m Bool
io = Parser m -> (Ptr Context -> IO ()) -> IO ()
forall (m :: * -> *) a. Parser m -> (Ptr Context -> IO a) -> IO a
withParserIO Parser m
p ((Ptr Context -> IO ()) -> IO ())
-> (Ptr Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx ->
	(Ptr Context -> Ptr Context -> IO CInt
forall a. Ptr Context -> Ptr a -> IO CInt
cWantCallback Ptr Context
ctx Ptr Context
cb_ctx IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((CInt -> IO ()) -> IO ()) -> (CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CInt
want ->
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
want CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Bool
continue <- IO Bool -> (SomeException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p m Bool
io) ((SomeException -> IO Bool) -> IO Bool)
-> (SomeException -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
			IORef (Maybe SomeException) -> Maybe SomeException -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Parser m -> IORef (Maybe SomeException)
forall (m :: * -> *). Parser m -> IORef (Maybe SomeException)
parserErrorRef Parser m
p) (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e)
			Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
		Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
continue (Ptr Context -> IO ()
cStopParser Ptr Context
ctx)

catchRefIO :: Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO :: forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
cb_ctx IO Bool
io = Parser m -> Ptr Context -> m Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> m Bool -> IO ()
catchRef Parser m
p Ptr Context
cb_ctx (Parser m -> forall a. IO a -> m a
forall (m :: * -> *). Parser m -> forall a. IO a -> m a
parserFromIO Parser m
p IO Bool
io)

callback :: (Parser m -> a -> IO (FunPtr b))
         -> (Ptr Context -> IO (FunPtr b))
         -> (Ptr Context -> FunPtr b -> IO ())
         -> Callback m a
callback :: forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> a -> IO (FunPtr b)
wrap Ptr Context -> IO (FunPtr b)
getPtr Ptr Context -> FunPtr b -> IO ()
setPtr = (Parser m -> a -> IO ()) -> (Parser m -> IO ()) -> Callback m a
forall (m :: * -> *) a.
(Parser m -> a -> IO ()) -> (Parser m -> IO ()) -> Callback m a
Callback Parser m -> a -> IO ()
set Parser m -> IO ()
forall {m :: * -> *}. Parser m -> IO ()
clear where
	set :: Parser m -> a -> IO ()
set Parser m
p a
io = ForeignPtr Context -> (Ptr Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Parser m -> ForeignPtr Context
forall (m :: * -> *). Parser m -> ForeignPtr Context
parserHandle Parser m
p) ((Ptr Context -> IO ()) -> IO ())
-> (Ptr Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx -> do
		Ptr Context -> IO ()
free Ptr Context
ctx
		Parser m -> a -> IO (FunPtr b)
wrap Parser m
p a
io IO (FunPtr b) -> (FunPtr b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Context -> FunPtr b -> IO ()
setPtr Ptr Context
ctx
	clear :: Parser m -> IO ()
clear Parser m
p = ForeignPtr Context -> (Ptr Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Parser m -> ForeignPtr Context
forall (m :: * -> *). Parser m -> ForeignPtr Context
parserHandle Parser m
p) ((Ptr Context -> IO ()) -> IO ())
-> (Ptr Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx -> do
		Ptr Context -> IO ()
free Ptr Context
ctx
		Ptr Context -> FunPtr b -> IO ()
setPtr Ptr Context
ctx FunPtr b
forall a. FunPtr a
nullFunPtr
	free :: Ptr Context -> IO ()
free Ptr Context
ctx = Ptr Context -> IO (FunPtr b)
getPtr Ptr Context
ctx IO (FunPtr b) -> (FunPtr b -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr b -> IO ()
forall a. FunPtr a -> IO ()
freeFunPtr

-- begin document {{{

parsedBeginDocument :: Callback m (m Bool)
parsedBeginDocument :: forall (m :: * -> *). Callback m (m Bool)
parsedBeginDocument = (Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ())))
-> (Ptr Context -> IO (FunPtr (Ptr Context -> IO ())))
-> (Ptr Context -> FunPtr (Ptr Context -> IO ()) -> IO ())
-> Callback m (m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
forall (m :: * -> *).
Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
wrap_startDocument
	Ptr Context -> IO (FunPtr (Ptr Context -> IO ()))
getcb_startDocument
	Ptr Context -> FunPtr (Ptr Context -> IO ()) -> IO ()
setcb_startDocument

type StartDocumentSAXFunc = Ptr Context -> IO ()

wrap_startDocument :: Parser m -> m Bool -> IO (FunPtr StartDocumentSAXFunc)
wrap_startDocument :: forall (m :: * -> *).
Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
wrap_startDocument Parser m
p m Bool
io = (Ptr Context -> IO ()) -> IO (FunPtr (Ptr Context -> IO ()))
newcb_startDocument (\Ptr Context
ctx -> Parser m -> Ptr Context -> m Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> m Bool -> IO ()
catchRef Parser m
p Ptr Context
ctx m Bool
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 :: forall (m :: * -> *). Callback m (m Bool)
parsedEndDocument = (Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ())))
-> (Ptr Context -> IO (FunPtr (Ptr Context -> IO ())))
-> (Ptr Context -> FunPtr (Ptr Context -> IO ()) -> IO ())
-> Callback m (m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
forall (m :: * -> *).
Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
wrap_endDocument
	Ptr Context -> IO (FunPtr (Ptr Context -> IO ()))
getcb_endDocument
	Ptr Context -> FunPtr (Ptr Context -> IO ()) -> IO ()
setcb_endDocument

type EndDocumentSAXFunc = Ptr Context -> IO ()

wrap_endDocument :: Parser m -> m Bool -> IO (FunPtr EndDocumentSAXFunc)
wrap_endDocument :: forall (m :: * -> *).
Parser m -> m Bool -> IO (FunPtr (Ptr Context -> IO ()))
wrap_endDocument Parser m
p m Bool
io = (Ptr Context -> IO ()) -> IO (FunPtr (Ptr Context -> IO ()))
newcb_endDocument (\Ptr Context
ctx -> Parser m -> Ptr Context -> m Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> m Bool -> IO ()
catchRef Parser m
p Ptr Context
ctx m Bool
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 :: forall (m :: * -> *).
Callback m (Name -> [(Name, [Content])] -> m Bool)
parsedBeginElement = (Parser m
 -> (Name -> [(Name, [Content])] -> m Bool)
 -> IO (FunPtr StartElementNsSAX2Func))
-> (Ptr Context -> IO (FunPtr StartElementNsSAX2Func))
-> (Ptr Context -> FunPtr StartElementNsSAX2Func -> IO ())
-> Callback m (Name -> [(Name, [Content])] -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m
-> (Name -> [(Name, [Content])] -> m Bool)
-> IO (FunPtr StartElementNsSAX2Func)
forall (m :: * -> *).
Parser m
-> (Name -> [(Name, [Content])] -> m Bool)
-> IO (FunPtr StartElementNsSAX2Func)
wrap_beginElement
	Ptr Context -> IO (FunPtr StartElementNsSAX2Func)
getcb_startElementNs
	Ptr Context -> FunPtr StartElementNsSAX2Func -> IO ()
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 :: forall (m :: * -> *).
Parser m
-> (Name -> [(Name, [Content])] -> m Bool)
-> IO (FunPtr StartElementNsSAX2Func)
wrap_beginElement Parser m
p Name -> [(Name, [Content])] -> m Bool
io =
	StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)
newcb_startElementNs (StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func))
-> StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cln Ptr CChar
cpfx Ptr CChar
cns CInt
_ Ptr (Ptr CChar)
_ CInt
n_attrs CInt
_ Ptr (Ptr CChar)
raw_attrs ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		FunPtr ReferenceSAXFunc
refCB <- Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_reference Ptr Context
ctx
		let hasRefCB :: Bool
hasRefCB = FunPtr ReferenceSAXFunc
refCB FunPtr ReferenceSAXFunc -> FunPtr ReferenceSAXFunc -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr ReferenceSAXFunc
forall a. FunPtr a
nullFunPtr
		
		Maybe Text
ns <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cns)
		Maybe Text
pfx <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cpfx)
		Text
ln <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cln)
		[(Name, [Content])]
attrs <- Bool -> Ptr (Ptr CChar) -> CInt -> IO [(Name, [Content])]
peekAttributes Bool
hasRefCB (Ptr (Ptr CChar) -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr CChar)
raw_attrs) CInt
n_attrs
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Name -> [(Name, [Content])] -> m Bool
io (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
ln Maybe Text
ns Maybe Text
pfx) [(Name, [Content])]
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 :: Bool -> Ptr (Ptr CChar) -> CInt -> IO [(Name, [Content])]
peekAttributes Bool
hasRefCB Ptr (Ptr CChar)
ptr = Int -> CInt -> IO [(Name, [Content])]
forall {t}. (Eq t, Num t) => Int -> t -> IO [(Name, [Content])]
loop Int
0 where
	loop :: Int -> t -> IO [(Name, [Content])]
loop Int
_      t
0 = [(Name, [Content])] -> IO [(Name, [Content])]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
	loop Int
offset t
n = do
		Text
local <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> IO Text) -> IO (Ptr CChar) -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CChar)
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0)
		Maybe Text
prefix <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> IO (Maybe Text)) -> IO (Ptr CChar) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CChar)
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
		Maybe Text
ns <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> IO (Maybe Text)) -> IO (Ptr CChar) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CChar)
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
		
		Ptr CChar
val_begin <- Ptr (Ptr CChar) -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CChar)
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
		Ptr CChar
val_end <- Ptr (Ptr CChar) -> Int -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CChar)
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
		Text
val <- CStringLen -> IO Text
peekUTF8Len (Ptr CChar
val_begin, Ptr CChar -> Ptr CChar -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr CChar
val_end Ptr CChar
val_begin)
		
		let content :: [Content]
content = if Bool
hasRefCB
			then Text -> [Content]
parseAttributeContent Text
val
			else [Text -> Content
X.ContentText Text
val]
		let attr :: (Name, [Content])
attr = (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
local Maybe Text
ns Maybe Text
prefix, [Content]
content)
		[(Name, [Content])]
attrs <- Int -> t -> IO [(Name, [Content])]
loop (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
		
		[(Name, [Content])] -> IO [(Name, [Content])]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name, [Content])
attr(Name, [Content]) -> [(Name, [Content])] -> [(Name, [Content])]
forall a. a -> [a] -> [a]
:[(Name, [Content])]
attrs)

parseAttributeContent :: T.Text -> [X.Content]
parseAttributeContent :: Text -> [Content]
parseAttributeContent = String -> [Content]
parse (String -> [Content]) -> (Text -> String) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack where
	parse :: String -> [Content]
parse String
chars = case ReadP [Content] -> ReadS [Content]
forall a. ReadP a -> ReadS a
ReadP.readP_to_S ReadP [Content]
parser String
chars of
		([Content]
cs,String
_):[([Content], String)]
_ -> [Content]
cs
		[([Content], String)]
_ -> String -> [Content]
forall a. HasCallStack => String -> a
error String
"parseAttributeContent: no parse"
	parser :: ReadP [Content]
parser = ReadP Content -> ReadP () -> ReadP [Content]
forall a end. ReadP a -> ReadP end -> ReadP [a]
ReadP.manyTill ReadP Content
content ReadP ()
eof
	content :: ReadP Content
content = ReadP Content
charRef ReadP Content -> ReadP Content -> ReadP Content
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Content
reference ReadP Content -> ReadP Content -> ReadP Content
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Content
text
	charRef :: ReadP Content
charRef = do
		String
_ <- String -> ReadP String
ReadP.string String
"&#"
		String
val <- (Char -> Bool) -> ReadP String
ReadP.munch1 (Char -> Bool
isDigit)
		Char
_ <- Char -> ReadP Char
ReadP.char Char
';'
		Content -> ReadP Content
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Content
X.ContentText (Char -> Text
T.singleton (Int -> Char
chr (String -> Int
forall a. Read a => String -> a
read String
val))))
	reference :: ReadP Content
reference = do
		Char
_ <- Char -> ReadP Char
ReadP.char Char
'&'
		String
name <- (Char -> Bool) -> ReadP String
ReadP.munch1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')
		Char
_ <- Char -> ReadP Char
ReadP.char Char
';'
		Content -> ReadP Content
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Content
X.ContentEntity (String -> Text
T.pack String
name))
	text :: ReadP Content
text = do
		String
chars <- (Char -> Bool) -> ReadP String
ReadP.munch1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'&')
		Content -> ReadP Content
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Content
X.ContentText (String -> Text
T.pack String
chars))

#if MIN_VERSION_base(4,2,0)
	eof :: ReadP ()
eof = ReadP ()
ReadP.eof
#else
	eof = do
		s <- ReadP.look
		unless (null s) ReadP.pfail
#endif

-- }}}

-- end element {{{

parsedEndElement :: Callback m (X.Name -> m Bool)
parsedEndElement :: forall (m :: * -> *). Callback m (Name -> m Bool)
parsedEndElement = (Parser m -> (Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ())
-> Callback m (Name -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func)
forall (m :: * -> *).
Parser m -> (Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func)
wrap_endElementNs
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_endElementNs
	Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ()
setcb_endElementNs

type EndElementNsSAX2Func = (Ptr Context -> CString -> CString -> CString -> IO ())

wrap_endElementNs :: Parser m -> (X.Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func)
wrap_endElementNs :: forall (m :: * -> *).
Parser m -> (Name -> m Bool) -> IO (FunPtr EndElementNsSAX2Func)
wrap_endElementNs Parser m
p Name -> m Bool
io =
	EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
newcb_endElementNs (EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func))
-> EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cln Ptr CChar
cpfx Ptr CChar
cns ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Maybe Text
ns <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cns)
		Maybe Text
prefix <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cpfx)
		Text
local <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cln)
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Name -> m Bool
io (Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
local Maybe Text
ns Maybe Text
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
parsedCharacters = (Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> FunPtr CharactersSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
wrap_characters
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_characters
	Ptr Context -> FunPtr CharactersSAXFunc -> IO ()
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
parsedCDATA = (Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> FunPtr CharactersSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
wrap_characters
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_cdataBlock
	Ptr Context -> FunPtr CharactersSAXFunc -> IO ()
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
parsedWhitespace = (Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> IO (FunPtr CharactersSAXFunc))
-> (Ptr Context -> FunPtr CharactersSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
wrap_characters
	Ptr Context -> IO (FunPtr CharactersSAXFunc)
getcb_ignorableWhitespace
	Ptr Context -> FunPtr CharactersSAXFunc -> IO ()
setcb_ignorableWhitespace

type CharactersSAXFunc = (Ptr Context -> CString -> CInt -> IO ())

wrap_characters :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
wrap_characters :: forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr CharactersSAXFunc)
wrap_characters Parser m
p Text -> m Bool
io =
	CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc)
newcb_characters (CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc))
-> CharactersSAXFunc -> IO (FunPtr CharactersSAXFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cstr CInt
clen ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
text <- CStringLen -> IO Text
peekUTF8Len (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
clen)
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> m Bool
io Text
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
parsedReference = (Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> FunPtr ReferenceSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_reference
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_reference
	Ptr Context -> FunPtr ReferenceSAXFunc -> IO ()
setcb_reference

type ReferenceSAXFunc = Ptr Context -> CString -> IO ()

wrap_reference :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_reference :: forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_reference Parser m
p Text -> m Bool
io =
	ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
newcb_reference (ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc))
-> ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cstr ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
text <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr)
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> m Bool
io Text
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
parsedComment = (Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> FunPtr ReferenceSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_comment
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_comment
	Ptr Context -> FunPtr ReferenceSAXFunc -> IO ()
setcb_comment

type CommentSAXFunc = Ptr Context -> CString -> IO ()

wrap_comment :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr CommentSAXFunc)
wrap_comment :: forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_comment Parser m
p Text -> m Bool
io =
	ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
newcb_comment (ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc))
-> ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cstr ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
text <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr)
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> m Bool
io Text
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 :: forall (m :: * -> *). Callback m (Instruction -> m Bool)
parsedInstruction = (Parser m
 -> (Instruction -> m Bool)
 -> IO (FunPtr ProcessingInstructionSAXFunc))
-> (Ptr Context -> IO (FunPtr ProcessingInstructionSAXFunc))
-> (Ptr Context -> FunPtr ProcessingInstructionSAXFunc -> IO ())
-> Callback m (Instruction -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m
-> (Instruction -> m Bool)
-> IO (FunPtr ProcessingInstructionSAXFunc)
forall (m :: * -> *).
Parser m
-> (Instruction -> m Bool)
-> IO (FunPtr ProcessingInstructionSAXFunc)
wrap_processingInstruction
	Ptr Context -> IO (FunPtr ProcessingInstructionSAXFunc)
getcb_processingInstruction
	Ptr Context -> FunPtr ProcessingInstructionSAXFunc -> IO ()
setcb_processingInstruction

type ProcessingInstructionSAXFunc = Ptr Context -> CString -> CString -> IO ()

wrap_processingInstruction :: Parser m -> (X.Instruction -> m Bool) -> IO (FunPtr ProcessingInstructionSAXFunc)
wrap_processingInstruction :: forall (m :: * -> *).
Parser m
-> (Instruction -> m Bool)
-> IO (FunPtr ProcessingInstructionSAXFunc)
wrap_processingInstruction Parser m
p Instruction -> m Bool
io =
	ProcessingInstructionSAXFunc
-> IO (FunPtr ProcessingInstructionSAXFunc)
newcb_processingInstruction (ProcessingInstructionSAXFunc
 -> IO (FunPtr ProcessingInstructionSAXFunc))
-> ProcessingInstructionSAXFunc
-> IO (FunPtr ProcessingInstructionSAXFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
ctarget Ptr CChar
cdata ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
target <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ctarget)
		Text
value <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cdata)
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Instruction -> m Bool
io (Text -> Text -> Instruction
X.Instruction Text
target Text
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 :: forall (m :: * -> *).
Callback m (Text -> Maybe ExternalID -> m Bool)
parsedExternalSubset = (Parser m
 -> (Text -> Maybe ExternalID -> m Bool)
 -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ())
-> Callback m (Text -> Maybe ExternalID -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
forall (m :: * -> *).
Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
wrap_externalSubset
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_externalSubset
	Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ()
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 :: forall (m :: * -> *).
Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
wrap_externalSubset Parser m
p Text -> Maybe ExternalID -> m Bool
io =
	EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
newcb_externalSubset (EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func))
-> EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cname Ptr CChar
cpublic Ptr CChar
csystem ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
name <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cname)
		Maybe Text
public <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cpublic)
		Maybe Text
system <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
csystem)
		let external :: Maybe ExternalID
external = case (Maybe Text
public, Maybe Text
system) of
			(Maybe Text
Nothing, Just Text
s) -> ExternalID -> Maybe ExternalID
forall a. a -> Maybe a
Just (Text -> ExternalID
X.SystemID Text
s)
			(Just Text
p', Just Text
s) -> ExternalID -> Maybe ExternalID
forall a. a -> Maybe a
Just (Text -> Text -> ExternalID
X.PublicID Text
p' Text
s)
			(Maybe Text, Maybe Text)
_ -> Maybe ExternalID
forall a. Maybe a
Nothing
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> Maybe ExternalID -> m Bool
io Text
name Maybe ExternalID
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 :: forall (m :: * -> *).
Callback m (Text -> Maybe ExternalID -> m Bool)
parsedInternalSubset = (Parser m
 -> (Text -> Maybe ExternalID -> m Bool)
 -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> IO (FunPtr EndElementNsSAX2Func))
-> (Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ())
-> Callback m (Text -> Maybe ExternalID -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
forall (m :: * -> *).
Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
wrap_internalSubset
	Ptr Context -> IO (FunPtr EndElementNsSAX2Func)
getcb_internalSubset
	Ptr Context -> FunPtr EndElementNsSAX2Func -> IO ()
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 :: forall (m :: * -> *).
Parser m
-> (Text -> Maybe ExternalID -> m Bool)
-> IO (FunPtr EndElementNsSAX2Func)
wrap_internalSubset Parser m
p Text -> Maybe ExternalID -> m Bool
io =
	EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
newcb_internalSubset (EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func))
-> EndElementNsSAX2Func -> IO (FunPtr EndElementNsSAX2Func)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cname Ptr CChar
cpublic Ptr CChar
csystem ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
name <- Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cname)
		Maybe Text
public <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cpublic)
		Maybe Text
system <- (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
peekUTF8 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
csystem)
		let external :: Maybe ExternalID
external = case (Maybe Text
public, Maybe Text
system) of
			(Maybe Text
Nothing, Just Text
s) -> ExternalID -> Maybe ExternalID
forall a. a -> Maybe a
Just (Text -> ExternalID
X.SystemID Text
s)
			(Just Text
p', Just Text
s) -> ExternalID -> Maybe ExternalID
forall a. a -> Maybe a
Just (Text -> Text -> ExternalID
X.PublicID Text
p' Text
s)
			(Maybe Text, Maybe Text)
_ -> Maybe ExternalID
forall a. Maybe a
Nothing
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> Maybe ExternalID -> m Bool
io Text
name Maybe ExternalID
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 :: forall (m :: * -> *). Callback m (Text -> m Bool)
reportWarning = (Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> FunPtr ReferenceSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_FixedError
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_warning
	Ptr Context -> FunPtr ReferenceSAXFunc -> IO ()
setcb_warning

reportError :: Callback m (T.Text -> m Bool)
reportError :: forall (m :: * -> *). Callback m (Text -> m Bool)
reportError = (Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> IO (FunPtr ReferenceSAXFunc))
-> (Ptr Context -> FunPtr ReferenceSAXFunc -> IO ())
-> Callback m (Text -> m Bool)
forall (m :: * -> *) a b.
(Parser m -> a -> IO (FunPtr b))
-> (Ptr Context -> IO (FunPtr b))
-> (Ptr Context -> FunPtr b -> IO ())
-> Callback m a
callback Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_FixedError
	Ptr Context -> IO (FunPtr ReferenceSAXFunc)
getcb_error
	Ptr Context -> FunPtr ReferenceSAXFunc -> IO ()
setcb_error

type FixedErrorFunc = Ptr Context -> CString -> IO ()

wrap_FixedError :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr FixedErrorFunc)
wrap_FixedError :: forall (m :: * -> *).
Parser m -> (Text -> m Bool) -> IO (FunPtr ReferenceSAXFunc)
wrap_FixedError Parser m
p Text -> m Bool
io =
	ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
newcb_FixedError (ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc))
-> ReferenceSAXFunc -> IO (FunPtr ReferenceSAXFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Context
ctx Ptr CChar
cmsg ->
	Parser m -> Ptr Context -> IO Bool -> IO ()
forall (m :: * -> *). Parser m -> Ptr Context -> IO Bool -> IO ()
catchRefIO Parser m
p Ptr Context
ctx (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Text
msg <- Ptr CChar -> IO Text
peekUTF8 Ptr CChar
cmsg
		Parser m -> forall a. m a -> IO a
forall (m :: * -> *). Parser m -> forall a. m a -> IO a
parserToIO Parser m
p (Text -> m Bool
io Text
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 :: forall (m :: * -> *) a. Parser m -> (Ptr Context -> IO a) -> IO a
withParserIO Parser m
p Ptr Context -> IO a
io = ForeignPtr Context -> (Ptr Context -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Parser m -> ForeignPtr Context
forall (m :: * -> *). Parser m -> ForeignPtr Context
parserHandle Parser m
p) Ptr Context -> IO a
io

peekUTF8 :: CString -> IO T.Text
peekUTF8 :: Ptr CChar -> IO Text
peekUTF8 = (ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
TE.decodeUtf8) (IO ByteString -> IO Text)
-> (Ptr CChar -> IO ByteString) -> Ptr CChar -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> IO ByteString
B.packCString

peekUTF8Len :: CStringLen -> IO T.Text
peekUTF8Len :: CStringLen -> IO Text
peekUTF8Len = (ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
TE.decodeUtf8) (IO ByteString -> IO Text)
-> (CStringLen -> IO ByteString) -> CStringLen -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> IO ByteString
B.packCStringLen

withUTF8 :: T.Text -> (CString -> IO a) -> IO a
withUTF8 :: forall a. Text -> (Ptr CChar -> IO a) -> IO a
withUTF8 = ByteString -> (Ptr CChar -> IO a) -> IO a
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BU.unsafeUseAsCString (ByteString -> (Ptr CChar -> IO a) -> IO a)
-> (Text -> ByteString) -> Text -> (Ptr CChar -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

freeFunPtr :: FunPtr a -> IO ()
freeFunPtr :: forall a. FunPtr a -> IO ()
freeFunPtr FunPtr a
ptr = if FunPtr a
ptr FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr
	then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	else FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
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 :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
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 "hslibxml-shim.h hslibxml_parse_complete"
	cParseComplete :: Ptr Context -> 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 ()

-}

-- }}}