hexpat 0.5 → 0.6

raw patch · 9 files changed

+318/−34 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/XML/Expat/IO.hs +63/−12
• Text/XML/Expat/Namespaced.hs +8/−3
• Text/XML/Expat/Tree.hs +84/−3
• hexpat.cabal +9/−12
• test/Makefile +28/−0
• test/helloworld.hs +33/−0
• test/leak.hs +63/−0
• test/locations.hs +25/−0
• test/tests.hs +5/−4

@@ -18,6 +18,8 @@    -- ** Parsing   parse, parseChunk, Encoding(..), XMLParseError(..),+  getParseLocation,+  XMLParseLocation(..),    -- ** Parser Callbacks   StartElementHandler, EndElementHandler, CharacterDataHandler,@@ -41,6 +43,7 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Internal as BSI import Data.IORef+import Data.Int import Foreign import CForeign @@ -132,13 +135,11 @@         else Just `fmap` getError parser  getError parser = withParser parser $ \p -> do-                code <- xmlGetErrorCode p-                cerr <- xmlErrorString code-                err <- peekCString cerr-                line <- xmlGetCurrentLineNumber p-                col <- xmlGetCurrentColumnNumber p-                return $ XMLParseError err-                    (fromIntegral line) (fromIntegral col)+    code <- xmlGetErrorCode p+    cerr <- xmlErrorString code+    err <- peekCString cerr+    loc <- getParseLocation parser+    return $ XMLParseError err loc  data ExpatHandlers = ExpatHandlers     (FunPtr CStartElementHandler)@@ -187,12 +188,36 @@   let {res' = unStatus res} in   return (res') --- | Parse error, consisting of message text, line number, and column number-data XMLParseError = XMLParseError String Integer Integer deriving (Eq, Show)+-- | Parse error, consisting of message text and error location+data XMLParseError = XMLParseError String XMLParseLocation deriving (Eq, Show)  instance NFData XMLParseError where-    rnf (XMLParseError msg lin col) = rnf (msg, lin, col)+    rnf (XMLParseError msg loc) = rnf (msg, loc) +-- | Specifies a location of an event within the input text+data XMLParseLocation = XMLParseLocation {+        xmlLineNumber   :: Int64,  -- ^ Line number of the event+        xmlColumnNumber :: Int64,  -- ^ Column number of the event+        xmlByteIndex    :: Int64,  -- ^ Byte index of event from start of document+        xmlByteCount    :: Int64   -- ^ The number of bytes in the event+    }+    deriving (Eq, Show)++instance NFData XMLParseLocation where+    rnf (XMLParseLocation lin col ind cou) = rnf (lin, col, ind, cou)++getParseLocation parser = withParser parser $ \p -> do+    line <- xmlGetCurrentLineNumber p+    col <- xmlGetCurrentColumnNumber p+    index <- xmlGetCurrentByteIndex p+    count <- xmlGetCurrentByteCount p+    return $ XMLParseLocation {+            xmlLineNumber = fromIntegral line,+            xmlColumnNumber = fromIntegral col,+            xmlByteIndex = fromIntegral index,+            xmlByteCount = fromIntegral count+        }+ -- |The type of the \"element started\" callback.  The first parameter is -- the element name; the second are the (attribute, value) pairs. Return True -- to continue parsing as normal, or False to terminate the parse.@@ -210,12 +235,38 @@ type CStartElementHandler = Ptr () -> CString -> Ptr CString -> IO () nullCStartElementHandler _ _ _ = return () +-- Note on word sizes:+--+-- on expat 2.0:+-- XML_GetCurrentLineNumber returns XML_Size+-- XML_GetCurrentColumnNumber returns XML_Size+-- XML_GetCurrentByteIndex returns XML_Index+-- These are defined in expat_external.h+--+-- debian-i386 says XML_Size and XML_Index are 4 bytes.+-- ubuntu-amd64 says XML_Size and XML_Index are 8 bytes.+-- These two systems do NOT define XML_LARGE_SIZE, which would force these types+-- to be 64-bit.+--+-- If we guess the word size too small, it shouldn't matter: We will just discard+-- the most significant part.  If we get the word size too large, we will get+-- garbage (very bad).+--+-- So - what I will do is use CLong and CULong, which correspond to what expat+-- is using when XML_LARGE_SIZE is disabled, and give the correct sizes on the +-- two machines mentioned above.  At the absolute worst the word size will be too+-- short.+ foreign import ccall unsafe "expat.h XML_GetErrorCode" xmlGetErrorCode     :: ParserPtr -> IO CInt foreign import ccall unsafe "expat.h XML_GetCurrentLineNumber" xmlGetCurrentLineNumber-    :: ParserPtr -> IO CUInt  -- to do: Get 64-bit value if supported (how?)+    :: ParserPtr -> IO CULong foreign import ccall unsafe "expat.h XML_GetCurrentColumnNumber" xmlGetCurrentColumnNumber-    :: ParserPtr -> IO CUInt  -- to do: Get 64-bit value if supported (how?)+    :: ParserPtr -> IO CULong+foreign import ccall unsafe "expat.h XML_GetCurrentByteIndex" xmlGetCurrentByteIndex+    :: ParserPtr -> IO CLong+foreign import ccall unsafe "expat.h XML_GetCurrentByteCount" xmlGetCurrentByteCount+    :: ParserPtr -> IO CInt foreign import ccall unsafe "expat.h XML_ErrorString" xmlErrorString     :: CInt -> IO CString foreign import ccall unsafe "expat.h XML_StopParser" xmlStopParser

@@ -94,17 +94,22 @@     (nsAtts, otherAtts) = L.partition ((== Just xmlns) . qnPrefix . fst) qattrs     (dfAtt, normalAtts) = L.partition ((== QName Nothing xmlns) . fst) otherAtts     nsMap  = M.fromList $ for nsAtts $ \((QName _ lp), uri) -> (Just lp, Just uri)+    -- fixme: when snd q is null, use Nothing     dfMap  = M.fromList $ for dfAtt $ \q -> (Nothing, Just $ snd q)     chldBs = M.unions [dfMap, nsMap, bindings]-    trans (QName pref qual) = case pref `M.lookup` chldBs of++    trans bs (QName pref qual) = case pref `M.lookup` bs of       Nothing -> error                $  "Namespace prefix referenced but never bound: '"               ++ (show . DM.fromJust) pref               ++ "'"       Just mUri -> NName mUri qual-    transAt (qn, v) = (trans qn, v) +    nname       = trans chldBs qname -    nname       = trans qname+    -- attributes with no prefix are in the same namespace as the element+    attBs = M.insert Nothing (nnNamespace nname) chldBs++    transAt (qn, v) = (trans attBs qn, v)      nNsAtts     = map transAt nsAtts     nDfAtt      = map transAt dfAtt

@@ -10,16 +10,50 @@ -- The GenericXMLString type class allows you to use any string type. Three -- string types are provided for here: @String@, @ByteString@ and @Text@. --+-- Here is a complete example to get you started:+--+-- > -- | A "hello world" example of hexpat that lazily parses a document, printing+-- > -- it to standard out.+-- > +-- > import Text.XML.Expat.Tree+-- > import Text.XML.Expat.Format+-- > import System.Environment+-- > import System.Exit+-- > import System.IO+-- > import qualified Data.ByteString.Lazy as L+-- > +-- > main = do+-- >     args <- getArgs+-- >     case args of+-- >         [filename] -> process filename+-- >         otherwise  -> do+-- >             hPutStrLn stderr "Usage: helloworld <file.xml>"+-- >             exitWith $ ExitFailure 1+-- > +-- > process :: String -> IO ()+-- > process filename = do+-- >     inputText <- L.readFile filename+-- >     -- Note: Because we're not using the tree, Haskell can't infer the type of+-- >     -- strings we're using so we need to tell it explicitly with a type signature.+-- >     let (xml, mErr) = parseTree Nothing inputText :: (UNode String, Maybe XMLParseError)+-- >     -- Process document before handling error, so we get lazy processing.+-- >     L.hPutStr stdout $ formatTree xml+-- >     putStrLn ""+-- >     case mErr of+-- >         Nothing -> return ()+-- >         Just err -> do+-- >             hPutStrLn stderr $ "XML parse failed: "++show err+-- >             exitWith $ ExitFailure 2+-- -- Error handling in strict parses is very straight forward - just check the -- 'Either' return value.  Lazy parses are not so simple.  Here are two working -- examples that illustrate the ways to handle errors.  Here they are: ----- Way no. 1+-- Way no. 1 - Using a Maybe value -- -- > import Text.XML.Expat.Tree -- > import qualified Data.ByteString.Lazy as L -- > import Data.ByteString.Internal (c2w)--- > import Control.Exception.Extensible as E -- >  -- > -- This is the recommended way to handle errors in lazy parses -- > main = do@@ -30,8 +64,10 @@ -- >         Just err -> putStrLn $ "It failed : "++show err -- >         Nothing -> putStrLn "Success!" ----- Way no. 2+-- Way no. 2 - Using exceptions --+-- Unless exceptions fit in with the design of your program, this way is less preferred.+-- -- > ... -- > import Control.Exception.Extensible as E -- > @@ -60,10 +96,12 @@   parseTree',   Encoding(..),   XMLParseError(..),+  XMLParseLocation(..),   -- * SAX-style parse   parseSAX,   SAXEvent(..),   saxToTree,+  parseSAXLocations,   -- * Variants that throw exceptions   XMLParseException(..),   parseSAXThrowing,@@ -301,6 +339,49 @@   where     freakOut (FailDocument err) = Exc.throw $ XMLParseException err     freakOut other = other++-- | A variant of parseSAX that gives a document location with each SAX event.+parseSAXLocations :: (GenericXMLString tag, GenericXMLString text) =>+            Maybe Encoding      -- ^ Optional encoding override+         -> L.ByteString        -- ^ Input text (a lazy ByteString)+         -> [(SAXEvent tag text, XMLParseLocation)]+parseSAXLocations enc input = unsafePerformIO $ do+    -- Done with cut & paste coding for maximum speed.+    parser <- newParser enc+    queueRef <- newIORef []+    setStartElementHandler parser $ \cName cAttrs -> do+        name <- mkText cName+        attrs <- forM cAttrs $ \(cAttrName,cAttrValue) -> do+            attrName <- mkText cAttrName+            attrValue <- mkText cAttrValue+            return (attrName, attrValue)+        loc <- getParseLocation parser+        modifyIORef queueRef ((StartElement name attrs,loc):)+        return True+    setEndElementHandler parser $ \cName -> do+        name <- mkText cName+        loc <- getParseLocation parser+        modifyIORef queueRef ((EndElement name, loc):)+        return True+    setCharacterDataHandler parser $ \cText -> do+        txt <- gxFromCStringLen cText+        loc <- getParseLocation parser+        modifyIORef queueRef ((CharacterData txt, loc):)+        return True++    let runParser [] = return []+        runParser (c:cs) = unsafeInterleaveIO $ do+            mError <- parseChunk parser c (null cs)+            queue <- readIORef queueRef+            writeIORef queueRef []+            rem <- case mError of+                Just error -> do+                    loc <- getParseLocation parser+                    return [(FailDocument error, loc)]+                Nothing -> runParser cs+            return $ reverse queue ++ rem++    runParser $ L.toChunks input  -- | A lower level function that lazily converts a SAX stream into a tree structure. saxToTree :: GenericXMLString tag =>

@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: hexpat-Version: 0.5+Version: 0.6 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser@@ -13,16 +13,9 @@   The emphasis is on speed and simplicity. If you want more complete and powerful   XML libraries, consider using /HaXml/ or /HXT/ instead.   .-  Note that /hexpat/ has undergone a major API change since 0.3.x.-  .-  Benchmark results on ghc 6.10.1 against HaXml for parsing a 4K xml file with non-threading runtime:-  HAXML: 2631 us, HEXPAT: low-level parse-no tree: 243 us, lazy-String: 1240 us,-  lazy-Text: 782 us, strict-String: 1125 us, strict-Text: 770 us+  Examples and benchmarks: <http://haskell.org/haskellwiki/Hexpat/>   .-  With -threaded:-  HAXML: 2667 us, HEXPAT: low-level parse-no tree: 472 us,-  lazy-String: 1453 us, lazy-Text: 1057 us, strict-String: 1342 us,-  strict-Text: 943 us+  DARCS repository: <http://code.haskell.org/hexpat/> Category: XML License: BSD3 License-File: LICENSE@@ -32,7 +25,7 @@   (c) 2009 Stephen Blackheath <http://blacksapphire.com/antispam/>,   (c) 2008 Evan Martin <martine@danga.com>,   (c) 2009 Matthew Pocock <matthew.pocock@ncl.ac.uk>-Homepage: http://code.haskell.org/hexpat/+Homepage: http://haskell.org/haskellwiki/Hexpat/ Extra-Source-Files:   test/tests.hs,   test/test.xml,@@ -40,8 +33,12 @@   test/lazySAX.hs,   test/lazyTree.hs,   test/lazyTreeThrow.hs,+  test/leak.hs,   test/errorHandlingWay1.hs,-  test/errorHandlingWay2.hs+  test/errorHandlingWay2.hs,+  test/helloworld.hs,+  test/locations.hs,+  test/Makefile Build-Type: Simple Stability: beta 

@@ -0,0 +1,28 @@+all: tests lazySAX lazyTree lazyTreeThrow benchmark leak helloworld locations++tests: tests.hs+	ghc -O2 --make -o tests tests.hs++lazySAX: lazySAX.hs+	ghc -O2 --make -o lazySAX lazySAX.hs++lazyTree: lazyTree.hs+	ghc -O2 --make -o lazyTree lazyTree.hs++lazyTreeThrow: lazyTreeThrow.hs+	ghc -O2 --make -o lazyTreeThrow lazyTreeThrow.hs++benchmark: benchmark.hs+	ghc -O2 --make -o benchmark benchmark.hs #-threaded++leak: leak.hs+	ghc -O2 --make -o leak leak.hs -threaded++helloworld: helloworld.hs+	ghc -O2 --make -o helloworld helloworld.hs++locations: locations.hs+	ghc -O2 --make -o locations locations.hs++clean:+	rm -f tests perf lazySAX lazyTree benchmark leak helloworld locations *.hi *.o

@@ -0,0 +1,33 @@+-- | A "hello world" example of hexpat that lazily parses a document, printing+-- it to standard out.++import Text.XML.Expat.Tree+import Text.XML.Expat.Format+import System.Environment+import System.Exit+import System.IO+import qualified Data.ByteString.Lazy as L++main = do+    args <- getArgs+    case args of+        [filename] -> process filename+        otherwise  -> do+            hPutStrLn stderr "Usage: helloworld <file.xml>"+            exitWith $ ExitFailure 1++process :: String -> IO ()+process filename = do+    inputText <- L.readFile filename+    -- Note: Because we're not using the tree, Haskell can't infer the type of+    -- strings we're using so we need to tell it explicitly with a type signature.+    let (xml, mErr) = parseTree Nothing inputText :: (UNode String, Maybe XMLParseError)+    -- Process document before handling error, so we get lazy processing.+    L.hPutStr stdout $ formatTree xml+    putStrLn ""+    case mErr of+        Nothing -> return ()+        Just err -> do+            hPutStrLn stderr $ "XML parse failed: "++show err+            exitWith $ ExitFailure 2+

@@ -0,0 +1,63 @@+-- Memory leak test+--+-- This test passes if you can leave it running for several minutes, and it+-- does not leak memory or exhibit any other undesirable behaviour.++module Main where++import Text.XML.Expat.Tree+import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Internal as I+import Control.Concurrent+import Control.Monad+import Control.Parallel.Strategies+import Foreign.ForeignPtr+import Foreign.Ptr++longDoc = "<?xml version=\"1.0\"?><long>"++body 1+    where+        body 10000 = "</long>"+        body i = "\n  <item idx=\"" ++ show i ++ "\"/>"++body (i+1)++toBL :: String -> L.ByteString+toBL = L.fromChunks . chunkify+  where+    chunkify [] = []+    chunkify str =+        let (start, rem) = splitAt 1024 str+        in  (B.pack $ map c2w start):chunkify rem++longBL = toBL longDoc++instance NFData B.ByteString where+    rnf bs = ()++myCopy :: B.ByteString -> IO B.ByteString+myCopy (I.PS x s l) = I.create l $ \p -> withForeignPtr x $ \f ->+    I.memcpy p (f `plusPtr` s) (fromIntegral l)++myLCopy :: L.ByteString -> IO L.ByteString+myLCopy bs = do+    let cs = L.toChunks bs+    cs' <- mapM myCopy cs+    return $ L.fromChunks cs'++{-+allocateStuff :: IO ()+allocateStuff = do+    x <- forM [1..1000] $ \idx -> return  $ show idx+    rnf x `seq` return ()+    -}++gocrazy descr = forever $ do+    putStrLn descr+    c <- myLCopy longBL+    let sax = parseSAX Nothing c :: [SAXEvent B.ByteString B.ByteString]+    rnf (take 20 sax) `seq` return ()++main = do+    forkIO $ gocrazy "one"+    gocrazy "two"+

@@ -0,0 +1,25 @@+-- | Parse to sax events with locations++import Text.XML.Expat.Tree+import Text.XML.Expat.Format+import System.Environment+import System.Exit+import System.IO+import qualified Data.ByteString.Lazy as L++main = do+    args <- getArgs+    case args of+        [filename] -> process filename+        otherwise  -> do+            hPutStrLn stderr "Usage: locations <file.xml>"+            exitWith $ ExitFailure 1++process :: String -> IO ()+process filename = do+    inputText <- L.readFile filename+    -- Note: Because we're not using the tree, Haskell can't infer the type of+    -- strings we're using so we need to tell it explicitly with a type signature.+    let events = parseSAXLocations Nothing inputText :: [(SAXEvent String String, XMLParseLocation)]+    mapM_ print events+

@@ -62,13 +62,13 @@ test_error1 :: IO () test_error1 = do     let eDoc = parseTree' Nothing (toByteString "<hello></goodbye>") :: Either XMLParseError (UNode String)-    assertEqual "error1" (Left $ XMLParseError "mismatched tag" 1 9) eDoc+    assertEqual "error1" (Left $ XMLParseError "mismatched tag" (XMLParseLocation 1 9 9 0)) eDoc  test_error2 :: IO () test_error2 = do     assertEqual "error2" (             Element {eName = "hello", eAttrs = [], eChildren = []},-            Just (XMLParseError "mismatched tag" 1 9)+            Just (XMLParseError "mismatched tag" (XMLParseLocation 1 9 9 0))         ) (parseTree Nothing               (toByteStringL "<hello></goodbye>") :: (UNode String, Maybe XMLParseError)) @@ -79,14 +79,15 @@                 Element {eName = "test1", eAttrs = [], eChildren = [Text "Hello"]},                 Element {eName = "hello", eAttrs = [], eChildren = []}             ]},-            Just (XMLParseError "mismatched tag" 1 35)+            Just (XMLParseError "mismatched tag" (XMLParseLocation 1 35 35 0))         ) $ parseTree Nothing               (toByteStringL "<open><test1>Hello</test1><hello></goodbye>")  test_error4 :: IO () test_error4 = do     let eDoc = parseTree' Nothing (toByteString "!") :: Either XMLParseError (UNode String)-    assertEqual "error1" (Left $ XMLParseError "not well-formed (invalid token)" 1 0) eDoc+    assertEqual "error1" (Left $ XMLParseError "not well-formed (invalid token)"+        (XMLParseLocation 1 0 0 0)) eDoc  main = do     testXML <- readFile "test.xml"