module Text.XML.Expat.IO (
Parser, newParser,
parse, Encoding(..),
StartElementHandler, EndElementHandler, CharacterDataHandler,
setStartElementHandler, setEndElementHandler, setCharacterDataHandler,
parseChunk
) where
import C2HS
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
type ParserPtr = Ptr ()
newtype Parser = Parser (ForeignPtr ())
withParser :: Parser -> (ParserPtr -> IO a) -> IO a
withParser (Parser fp) = withForeignPtr fp
data Encoding = ASCII | UTF8 | UTF16 | ISO88591
encodingToString :: Encoding -> String
encodingToString ASCII = "US-ASCII"
encodingToString UTF8 = "UTF-8"
encodingToString UTF16 = "UTF-16"
encodingToString ISO88591 = "ISO-8859-1"
withOptEncoding :: Maybe Encoding -> (CString -> IO a) -> IO a
withOptEncoding Nothing f = f nullPtr
withOptEncoding (Just enc) f = withCString (encodingToString enc) f
parserCreate :: Maybe Encoding -> IO (ParserPtr)
parserCreate a1 =
withOptEncoding a1 $ \a1' ->
parserCreate'_ a1' >>= \res ->
let {res' = id res} in
return (res')
foreign import ccall "&XML_ParserFree" parserFree :: FunPtr (ParserPtr -> IO ())
newParser :: Maybe Encoding -> IO Parser
newParser enc = do
ptr <- parserCreate enc
fptr <- newForeignPtr parserFree ptr
return $ Parser fptr
withBStringLen :: BS.ByteString -> ((CString, CInt) -> IO a) -> IO a
withBStringLen bs f = do
BS.useAsCStringLen bs $ \(str, len) -> f (str, fromIntegral len)
unStatus :: CInt -> Bool
unStatus 0 = False
unStatus 1 = True
parseChunk :: Parser -> BS.ByteString -> Bool -> IO (Bool)
parseChunk a1 a2 a3 =
withParser a1 $ \a1' ->
withBStringLen a2 $ \(a2'1, a2'2) ->
let {a3' = cFromBool a3} in
parseChunk'_ a1' a2'1 a2'2 a3' >>= \res ->
let {res' = unStatus res} in
return (res')
parse :: Parser -> BSL.ByteString -> IO Bool
parse parser bs = feedChunk (BSL.toChunks bs) where
feedChunk [] = return True
feedChunk [chunk] = parseChunk parser chunk True
feedChunk (c:cs) = do ok <- parseChunk parser c False
if ok then feedChunk cs
else return False
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"
parseChunk'_ :: ((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 ())))