diff --git a/Text/XML/Expat/IO.chs b/Text/XML/Expat/IO.chs --- a/Text/XML/Expat/IO.chs +++ b/Text/XML/Expat/IO.chs @@ -1,21 +1,33 @@ -- hexpat, a Haskell wrapper for expat -- Copyright (C) 2008 Evan Martin --- |This module wraps the Expat API directly, with IO. +-- |This module wraps the Expat API directly with IO operations +-- everywhere. Basic usage is: +-- +-- (1) Make a new parser: 'newParser'. +-- +-- (2) Set up callbacks on the parser: 'setStartElementHandler', etc. +-- +-- (3) Feed data into the parser: 'parse' or 'parseChunk'. module Text.XML.Expat.IO ( -- ** Parser Setup Parser, newParser, -- ** Parsing - parse, + parse, Encoding(..), -- ** Parser Callbacks StartElementHandler, EndElementHandler, CharacterDataHandler, - setStartElementHandler, setEndElementHandler, setCharacterDataHandler + setStartElementHandler, setEndElementHandler, setCharacterDataHandler, + + -- ** Lower-level Parsing Interface + parseChunk ) where import C2HS +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL #include @@ -31,38 +43,55 @@ 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 +-- |Encoding types available for the document encoding. +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 + {#fun unsafe XML_ParserCreate as parserCreate - {withOptCString* `Maybe String'} -> `ParserPtr' id#} + {withOptEncoding* `Maybe Encoding'} -> `ParserPtr' id#} foreign import ccall "&XML_ParserFree" parserFree :: FunPtr (ParserPtr -> IO ()) --- |Create a 'Parser'. The optional parameter is the default character --- encoding, and can be one of --- --- - \"US-ASCII\" --- --- - \"UTF-8\" --- --- - \"UTF-16\" --- --- - \"ISO-8859-1\" -newParser :: Maybe String -> IO Parser +-- |Create a 'Parser'. The encoding parameter, if provided, overrides the +-- document's encoding declaration. +newParser :: Maybe Encoding -> IO Parser newParser enc = do ptr <- parserCreate enc fptr <- newForeignPtr parserFree ptr return $ Parser fptr +-- ByteString.useAsCStringLen is almost what we need, but C2HS wants a CInt +-- instead of an Int. +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 --- |@parse data False@ feeds mode data into a 'Parser'. The end of the data --- is indicated by passing True for the final parameter. @parse@ returns --- False on a parse error. -{#fun XML_Parse as parse - {withParser* `Parser', `String' &, `Bool'} -> `Bool' unStatus#} +-- |@parseChunk data False@ feeds /strict/ ByteString data into a +-- 'Parser'. The end of the data is indicated by passing @True@ for the +-- final parameter. @parse@ returns @False@ on a parse error. +{#fun XML_Parse as parseChunk + {withParser* `Parser', withBStringLen* `BS.ByteString' &, `Bool'} + -> `Bool' unStatus#} + +-- |@parse data@ feeds /lazy/ bytestring data into a parser and returns +-- @True@ if there was no parse error. +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 -- |The type of the \"element started\" callback. The first parameter is -- the element name; the second are the (attribute, value) pairs. diff --git a/Text/XML/Expat/IO.hs b/Text/XML/Expat/IO.hs deleted file mode 100644 --- a/Text/XML/Expat/IO.hs +++ /dev/null @@ -1,164 +0,0 @@ --- GENERATED by C->Haskell Compiler, version 0.15.1 Rainy Days, 31 Aug 2007 (Haskell) --- Edit the ORIGNAL .chs file instead! - - -{-# LINE 1 "IO.chs" #-}-- hexpat, a Haskell wrapper for expat --- Copyright (C) 2008 Evan Martin - --- |This module wraps the Expat API directly, with IO. - -module Text.XML.Expat.IO ( - -- ** Parser Setup - Parser, newParser, - - -- ** Parsing - parse, - - -- ** Parser Callbacks - StartElementHandler, EndElementHandler, CharacterDataHandler, - setStartElementHandler, setEndElementHandler, setCharacterDataHandler -) where - -import C2HS - - --- Expat functions start with "XML", but C2HS appears to ignore our "as" --- definitions if they only differ from the symbol in case. So we write out --- XML_* in most cases anyway... :( - -{-# LINE 25 "IO.chs" #-} - --- |Opaque parser type. -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') -{-# LINE 39 "IO.chs" #-} -foreign import ccall "&XML_ParserFree" parserFree :: FunPtr (ParserPtr -> IO ()) - --- |Create a 'Parser'. The optional parameter is the default character --- encoding, and can be one of --- --- - \"US-ASCII\" --- --- - \"UTF-8\" --- --- - \"UTF-16\" --- --- - \"ISO-8859-1\" -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 data False@ feeds mode data into a 'Parser'. The end of the data --- is indicated by passing True for the final parameter. @parse@ returns --- False on a parse error. -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') -{-# LINE 65 "IO.chs" #-} - --- |The type of the \"element started\" callback. The first parameter is --- the element name; the second are the (attribute, value) pairs. -type StartElementHandler = String -> [(String,String)] -> IO () --- |The type of the \"element ended\" callback. The parameter is --- the element name. -type EndElementHandler = String -> IO () --- |The type of the \"character data\" callback. The parameter is --- the character data processed. This callback may be called more than once --- while processing a single conceptual block of text. -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) --- |Attach a StartElementHandler to a Parser. -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 --- |Attach an EndElementHandler to a Parser. -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_ --- |Attach an CharacterDataHandler to a Parser. -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 "IO.chs.h XML_ParserCreate" - parserCreate'_ :: ((Ptr CChar) -> (IO (Ptr ()))) - -foreign import ccall safe "IO.chs.h XML_Parse" - parse'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO CInt))))) - -foreign import ccall unsafe "IO.chs.h XML_SetStartElementHandler" - xmlSetstartelementhandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO ()))))) -> (IO ()))) - -foreign import ccall unsafe "IO.chs.h XML_SetEndElementHandler" - xmlSetendelementhandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (IO ())))) -> (IO ()))) - -foreign import ccall unsafe "IO.chs.h XML_SetCharacterDataHandler" - xmlSetcharacterdatahandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO ()))))) -> (IO ()))) diff --git a/Text/XML/Expat/Tree.hs b/Text/XML/Expat/Tree.hs --- a/Text/XML/Expat/Tree.hs +++ b/Text/XML/Expat/Tree.hs @@ -2,15 +2,18 @@ -- Copyright (C) 2008 Evan Martin -- |The Expat.Tree module provides a simplified interface to parsing, that --- returns a tree of the XML structure. (Note that this is not a lazy parse --- of the document: as soon as the root node is accessed, the entire document --- is parsed.) +-- returns a tree of the XML structure. It is written using the lower-level +-- bindings in the "Text.XML.Expat.IO" module. (Note that this is not a lazy +-- parse of the document: as soon as the root node is accessed, the entire +-- document is parsed.) module Text.XML.Expat.Tree ( - Text.XML.Expat.Tree.parse, Node(..) + Text.XML.Expat.Tree.parse, Node(..), + EIO.Encoding(..) ) where -import Text.XML.Expat.IO as EIO +import qualified Text.XML.Expat.IO as EIO +import qualified Data.ByteString.Lazy as B import Data.IORef import System.IO.Unsafe (unsafePerformIO) @@ -23,9 +26,10 @@ modifyChildren :: ([Node] -> [Node]) -> Node -> Node modifyChildren f node = node { eChildren = f (eChildren node) } --- |@parse enc doc@ parses XML content @doc@ with optional encoding @enc@, --- and returns the root 'Node' of the document if there were no parsing errors. -parse :: Maybe String -> String -> Maybe Node +-- |@parse enc doc@ parses /lazy/ bytestring XML content @doc@ with optional +-- encoding override @enc@ and returns the root 'Node' of the document if there +-- were no parsing errors. +parse :: Maybe EIO.Encoding -> B.ByteString -> Maybe Node parse enc doc = unsafePerformIO $ runParse where runParse = do parser <- EIO.newParser enc @@ -35,7 +39,7 @@ EIO.setStartElementHandler parser (\n a -> modifyIORef stack (start n a)) EIO.setEndElementHandler parser (\n -> modifyIORef stack (end n)) EIO.setCharacterDataHandler parser (\s -> modifyIORef stack (text s)) - ok <- EIO.parse parser doc True + ok <- EIO.parse parser doc if ok then do [Element _ _ [root]] <- readIORef stack diff --git a/hexpat.cabal b/hexpat.cabal --- a/hexpat.cabal +++ b/hexpat.cabal @@ -1,7 +1,18 @@ Cabal-Version: >= 1.2 Name: hexpat -Version: 0.1 +Version: 0.2 Synopsis: wrapper for expat, the fast XML parser +Description: + Expat () is a stream-oriented XML parser + written in C. It is known for being simple and fast. + . + There are already nice XML libraries in the Text.XML hierarchy. The + reason to use Expat is when speed is of concern. From a benchmark + that compares getting the length of the root node of a HaXml tree + (presumably forcing parsing the entire file) against running an Expat + parser with a registered start node handler, Expat is about 12 times + faster. This is not a fair benchmark; HaXml does a lot more than this + Expat library. But if Expat suffices, it is good for what it does. Category: XML License: BSD3 License-File: LICENSE @@ -9,12 +20,13 @@ Maintainer: martine@danga.com Copyright: (c) 2008 Evan Martin Homepage: http://neugierig.org/software/darcs/browse/?r=hexpat;a=summary -Extra-Source-Files: C2HS.hs test.hs +Extra-Source-Files: test.hs, perf.hs Build-Type: Simple Library - Build-Depends: base, haskell98 + Build-Depends: base, haskell98, bytestring Exposed-Modules: Text.XML.Expat.IO, Text.XML.Expat.Tree + Other-Modules: C2HS Extensions: ForeignFunctionInterface Extra-Libraries: expat diff --git a/perf.hs b/perf.hs new file mode 100644 --- /dev/null +++ b/perf.hs @@ -0,0 +1,42 @@ +-- hexpat, a Haskell wrapper for expat +-- Copyright (C) 2008 Evan Martin + +-- This program microbenchmarks HaXml versus Expat parsing. +-- The comparision is pretty unfair; HaXml does a whole lot more. +-- However, if you just want to read all the XML tags in a file, +-- this program demonstrates why Expat may be preferable. + +import Control.Exception +import qualified Data.ByteString.Lazy as BS +import Data.Char (ord) +import Data.IORef +import Microbench +import Text.XML.Expat.IO as Expat +import Text.XML.HaXml as HaXml + +parse_haxml :: String -> IO () +parse_haxml input = do + let Document _ _ root _ = HaXml.xmlParse "input" input + let Elem _ _ content = root + evaluate $ length content + return () + +parse_expat :: BS.ByteString -> IO () +parse_expat input = do + parser <- Expat.newParser Nothing + counter <- newIORef 0 + Expat.setStartElementHandler parser (elementHandler counter) + Expat.parse parser input + readIORef counter + return () + where + elementHandler counter tag attrs = modifyIORef counter (+1) + +main = do + xml <- readFile "test.xml" + let xmlbs = BS.pack (map (fromIntegral.ord) xml) + -- Force reading the entire file first. + putStrLn $ "input is " ++ show (BS.length xmlbs) ++ " bytes." + -- Start the races. + microbench "HaXml" (parse_haxml xml) + microbench "hexpat" (parse_expat xmlbs)