module Text.XML.Expat.IO (
Parser, newParser,
parse,
StartElementHandler, EndElementHandler, CharacterDataHandler,
setStartElementHandler, setEndElementHandler, setCharacterDataHandler
) where
import C2HS
type ParserPtr = Ptr ()
newtype Parser = Parser (ForeignPtr ())
withParser :: Parser -> (ParserPtr -> IO a) -> IO a
withParser (Parser fp) = withForeignPtr fp
withOptCString :: Maybe String -> (CString -> IO a) -> IO a
withOptCString Nothing f = f nullPtr
withOptCString (Just str) f = withCString str f
parserCreate :: Maybe String -> IO (ParserPtr)
parserCreate a1 =
withOptCString a1 $ \a1' ->
parserCreate'_ a1' >>= \res ->
let {res' = id res} in
return (res')
foreign import ccall "&XML_ParserFree" parserFree :: FunPtr (ParserPtr -> IO ())
newParser :: Maybe String -> IO Parser
newParser enc = do
ptr <- parserCreate enc
fptr <- newForeignPtr parserFree ptr
return $ Parser fptr
unStatus :: CInt -> Bool
unStatus 0 = False
unStatus 1 = True
parse :: Parser -> String -> Bool -> IO (Bool)
parse a1 a2 a3 =
withParser a1 $ \a1' ->
withCStringLenIntConv a2 $ \(a2'1, a2'2) ->
let {a3' = cFromBool a3} in
parse'_ a1' a2'1 a2'2 a3' >>= \res ->
let {res' = unStatus res} in
return (res')
type StartElementHandler = String -> [(String,String)] -> IO ()
type EndElementHandler = String -> IO ()
type CharacterDataHandler = String -> IO ()
type CStartElementHandler = Ptr () -> CString -> Ptr CString -> IO ()
foreign import ccall "wrapper"
mkCStartElementHandler :: CStartElementHandler
-> IO (FunPtr CStartElementHandler)
wrapStartElementHandler :: StartElementHandler
-> IO (FunPtr CStartElementHandler)
wrapStartElementHandler handler = mkCStartElementHandler h where
h ptr cname cattrs = do
name <- peekCString cname
cattrlist <- peekArray0 nullPtr cattrs
attrlist <- mapM peekCString cattrlist
handler name (pairwise attrlist)
setStartElementHandler :: Parser -> StartElementHandler -> IO ()
setStartElementHandler parser handler = do
withParser parser $ \p -> do
handler' <- wrapStartElementHandler handler
xMLSetStartElementHandler p handler'
type CEndElementHandler = Ptr () -> CString -> IO ()
foreign import ccall "wrapper"
mkCEndElementHandler :: CEndElementHandler
-> IO (FunPtr CEndElementHandler)
wrapEndElementHandler :: EndElementHandler
-> IO (FunPtr CEndElementHandler)
wrapEndElementHandler handler = mkCEndElementHandler h where
h ptr cname = do
name <- peekCString cname
handler name
setEndElementHandler :: Parser -> EndElementHandler -> IO ()
setEndElementHandler parser handler = do
withParser parser $ \p -> do
handler' <- wrapEndElementHandler handler
xMLSetEndElementHandler p handler'
type CCharacterDataHandler = Ptr () -> CString -> CInt -> IO ()
foreign import ccall "wrapper"
mkCCharacterDataHandler :: CCharacterDataHandler
-> IO (FunPtr CCharacterDataHandler)
wrapCharacterDataHandler :: CharacterDataHandler
-> IO (FunPtr CCharacterDataHandler)
wrapCharacterDataHandler handler = mkCCharacterDataHandler h where
h ptr cdata len = do
data_ <- peekCStringLen (cdata, fromIntegral len)
handler data_
setCharacterDataHandler :: Parser -> CharacterDataHandler -> IO ()
setCharacterDataHandler parser handler = do
withParser parser $ \p -> do
handler' <- wrapCharacterDataHandler handler
xMLSetCharacterDataHandler p handler'
pairwise (x1:x2:xs) = (x1,x2) : pairwise xs
pairwise [] = []
foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_ParserCreate"
parserCreate'_ :: ((Ptr CChar) -> (IO (Ptr ())))
foreign import ccall safe "Text/XML/Expat/IO.chs.h XML_Parse"
parse'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO CInt)))))
foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetStartElementHandler"
xMLSetStartElementHandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO ()))))) -> (IO ())))
foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetEndElementHandler"
xMLSetEndElementHandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (IO ())))) -> (IO ())))
foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetCharacterDataHandler"
xMLSetCharacterDataHandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO ()))))) -> (IO ())))