hexpat 0.6 → 0.7

raw patch · 7 files changed

+90/−40 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/XML/Expat/IO.hs +31/−15
• Text/XML/Expat/Namespaced.hs +1/−1
• Text/XML/Expat/Qualified.hs +1/−1
• Text/XML/Expat/Tree.hs +26/−20
• hexpat.cabal +1/−1
• test/benchmark.hs +1/−1
• test/tests.hs +29/−1

@@ -10,14 +10,14 @@ -- -- (2) Set up callbacks on the parser: 'setStartElementHandler', etc. ----- (3) Feed data into the parser: 'parse' or 'parseChunk'.+-- (3) Feed data into the parser: 'parse', 'parse'' or 'parseChunk'.  module Text.XML.Expat.IO (   -- ** Parser Setup   Parser, newParser,    -- ** Parsing-  parse, parseChunk, Encoding(..), XMLParseError(..),+  parse, parse', parseChunk, Encoding(..), XMLParseError(..),   getParseLocation,   XMLParseLocation(..), @@ -52,8 +52,8 @@ type ParserPtr = Ptr () data Parser = Parser     (ForeignPtr ())-    (IORef CStartElementHandler) -    (IORef CEndElementHandler) +    (IORef CStartElementHandler)+    (IORef CEndElementHandler)     (IORef CCharacterDataHandler)  instance Show Parser where@@ -76,7 +76,7 @@  parserCreate :: Maybe Encoding -> IO (ParserPtr) parserCreate a1 =-  withOptEncoding a1 $ \a1' -> +  withOptEncoding a1 $ \a1' ->   parserCreate'_ a1' >>= \res ->   let {res' = id res} in   return (res')@@ -103,10 +103,26 @@ unStatus 0 = False unStatus 1 = True --- |@parse data@ feeds /lazy/ bytestring data into a parser. It returns Nothing+-- |@parse data@ feeds /lazy/ ByteString data into a 'Parser'. It returns Nothing -- on success, or Just the parse error.-parse :: Parser -> BS.ByteString -> IO (Maybe XMLParseError)+parse :: Parser -> BSL.ByteString -> IO (Maybe XMLParseError) parse parser@(Parser _ _ _ _) bs = withHandlers parser $ do+    ok <- doParseChunks (BSL.toChunks bs)+    if ok+        then return Nothing+        else Just `fmap` getError parser+  where+    doParseChunks [] = doParseChunk parser BS.empty True+    doParseChunks (c:cs) = do+        ok <- doParseChunk parser c False+        if ok+            then doParseChunks cs+            else return False++-- |@parse data@ feeds /strict/ ByteString data into a 'Parser'. It returns Nothing+-- on success, or Just the parse error.+parse' :: Parser -> BS.ByteString -> IO (Maybe XMLParseError)+parse' parser@(Parser _ _ _ _) bs = withHandlers parser $ do     ok <- doParseChunk parser bs True     if ok         then return Nothing@@ -117,7 +133,7 @@ -- final parameter.   It returns Nothing on success, or Just the parse error. parseChunk :: Parser            -> BS.ByteString-           -> Bool+           -> Bool  -- ^ True if last chunk            -> IO (Maybe XMLParseError) parseChunk parser xml final = withHandlers parser $ unsafeParseChunk parser xml final @@ -181,9 +197,9 @@  doParseChunk :: Parser -> BS.ByteString -> Bool -> IO (Bool) doParseChunk a1 a2 a3 =-  withParser a1 $ \a1' -> -  withBStringLen a2 $ \(a2'1, a2'2) -> -  let {a3' = cFromBool a3} in +  withParser a1 $ \a1' ->+  withBStringLen a2 $ \(a2'1, a2'2) ->+  let {a3' = cFromBool a3} in   doParseChunk'_ a1' a2'1  a2'2 a3' >>= \res ->   let {res' = unStatus res} in   return (res')@@ -253,7 +269,7 @@ -- 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 +-- 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. @@ -283,7 +299,7 @@         cattrlist <- peekArray0 nullPtr cattrs         stillRunning <- handler cname (pairwise cattrlist)         unless stillRunning $-            withParser parser $ \p -> xmlStopParser p 0 +            withParser parser $ \p -> xmlStopParser p 0  -- |Attach a StartElementHandler to a Parser. setStartElementHandler :: Parser -> StartElementHandler -> IO ()@@ -303,7 +319,7 @@     h ptr cname = do         stillRunning <- handler cname         unless stillRunning $-            withParser parser $ \p -> xmlStopParser p 0 +            withParser parser $ \p -> xmlStopParser p 0  -- |Attach an EndElementHandler to a Parser. setEndElementHandler :: Parser -> EndElementHandler -> IO ()@@ -323,7 +339,7 @@     h ptr cdata len = do         stillRunning <- handler (cdata, fromIntegral len)         unless stillRunning $-            withParser parser $ \p -> xmlStopParser p 0 +            withParser parser $ \p -> xmlStopParser p 0  -- | Attach an CharacterDataHandler to a Parser. setCharacterDataHandler :: Parser -> CharacterDataHandler -> IO ()

@@ -41,7 +41,7 @@ -- | Type shortcut for a single node where namespaced names are used for tags type NNode text = Node (NName text) text --- | Type shortcut for attributes where namespaced names are used for tags+-- | Type shortcut for attributes with namespaced names type NAttributes text = Attributes (NName text) text  -- | Make a new NName from a prefix and localPart.

@@ -60,7 +60,7 @@ -- | Type shortcut for a single node where qualified names are used for tags type QNode text = Node (QName text) text --- | Type shortcut for attributes where qualified names are used for tags+-- | Type shortcut for attributes with qualified names type QAttributes text = Attributes (QName text) text  -- | Make a new QName from a prefix and localPart.

@@ -14,14 +14,14 @@ -- -- > -- | 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@@ -29,7 +29,7 @@ -- >         otherwise  -> do -- >             hPutStrLn stderr "Usage: helloworld <file.xml>" -- >             exitWith $ ExitFailure 1--- > +-- > -- > process :: String -> IO () -- > process filename = do -- >     inputText <- L.readFile filename@@ -54,7 +54,7 @@ -- > import Text.XML.Expat.Tree -- > import qualified Data.ByteString.Lazy as L -- > import Data.ByteString.Internal (c2w)--- > +-- > -- > -- This is the recommended way to handle errors in lazy parses -- > main = do -- >     let (tree, mError) = parseTree Nothing (L.pack $ map c2w $ "<top><banana></apple></top>")@@ -70,7 +70,7 @@ -- -- > ... -- > import Control.Exception.Extensible as E--- > +-- > -- > -- This is not the recommended way to handle errors. -- > main = do -- >     do@@ -183,7 +183,7 @@     gxFromCStringLen cstr = TE.decodeUtf8 <$> peekByteStringLen cstr     gxToByteString = TE.encodeUtf8 -peekByteStringLen :: CStringLen -> IO B.ByteString +peekByteStringLen :: CStringLen -> IO B.ByteString {-# INLINE peekByteStringLen #-} peekByteStringLen (cstr, len) =     I.create (fromIntegral len) $ \ptr ->@@ -218,7 +218,7 @@ -- text are the same string type. type UNode text = Node text text --- | Type shortcut for attributes with unqualified tag names where tag and+-- | Type shortcut for attributes with unqualified names where tag and -- text are the same string type. type UAttributes text = Attributes text text @@ -260,13 +260,13 @@         txt <- gxFromCStringLen cText         modifyIORef stack (text txt)         return True-    mError <- parse parser doc+    mError <- parse' parser doc     case mError of         Just error -> return $ Left error         Nothing -> do             [Element _ _ [root]] <- readIORef stack             return $ Right root-            +   start name attrs stack = Element name attrs [] : stack   text str (cur:rest) = modifyChildren (Text str:) cur : rest   end (cur:parent:rest) =@@ -279,7 +279,7 @@     CharacterData text |     FailDocument XMLParseError     deriving (Eq, Show)-    + instance (NFData tag, NFData text) => NFData (SAXEvent tag text) where     rnf (StartElement tag atts) = rnf (tag, atts)     rnf (EndElement tag) = rnf tag@@ -288,7 +288,7 @@  -- | Lazily parse XML to SAX events. In the event of an error, FailDocument is -- the last element of the output list.-parseSAX :: (GenericXMLString tag, GenericXMLString text) =>+parseSAX :: (Show tag, Show text, GenericXMLString tag, GenericXMLString text) =>             Maybe Encoding      -- ^ Optional encoding override          -> L.ByteString        -- ^ Input text (a lazy ByteString)          -> [SAXEvent tag text]@@ -312,14 +312,20 @@         modifyIORef queueRef (CharacterData txt:)         return True -    let runParser [] = return []-        runParser (c:cs) = unsafeInterleaveIO $ do-            mError <- parseChunk parser c (null cs)+    let runParser input = unsafeInterleaveIO $ do+            rem <- case input of+                (c:cs) -> do+                    mError <- parseChunk parser c False+                    case mError of+                        Just error -> return [FailDocument error]+                        Nothing -> runParser cs+                [] -> do+                    mError <- parseChunk parser B.empty True+                    case mError of+                        Just error -> return [FailDocument error]+                        Nothing -> return []             queue <- readIORef queueRef             writeIORef queueRef []-            rem <- case mError of-                Just error -> return [FailDocument error]-                Nothing -> runParser cs             return $ reverse queue ++ rem      runParser $ L.toChunks input@@ -331,7 +337,7 @@ instance Exception XMLParseException where  -- | Lazily parse XML to SAX events. In the event of an error, throw 'XMLParseException'.-parseSAXThrowing :: (GenericXMLString tag, GenericXMLString text) =>+parseSAXThrowing :: (Show tag, Show text, GenericXMLString tag, GenericXMLString text) =>                     Maybe Encoding      -- ^ Optional encoding override                  -> L.ByteString        -- ^ Input text (a lazy ByteString)                  -> [SAXEvent tag text]@@ -408,14 +414,14 @@ -- | Lazily parse XML to tree. Note that forcing the XMLParseError return value -- will force the entire parse.  Therefore, to ensure lazy operation, don't -- check the error status until you have processed the tree.-parseTree :: (GenericXMLString tag, GenericXMLString text) =>+parseTree :: (Show tag, Show text, GenericXMLString tag, GenericXMLString text) =>              Maybe Encoding      -- ^ Optional encoding override           -> L.ByteString        -- ^ Input text (a lazy ByteString)           -> (Node tag text, Maybe XMLParseError) parseTree mEnc bs = saxToTree $ parseSAX mEnc bs  -- | Lazily parse XML to tree. In the event of an error, throw 'XMLParseException'.-parseTreeThrowing :: (GenericXMLString tag, GenericXMLString text) =>+parseTreeThrowing :: (Show tag, Show text, GenericXMLString tag, GenericXMLString text) =>              Maybe Encoding      -- ^ Optional encoding override           -> L.ByteString        -- ^ Input text (a lazy ByteString)           -> Node tag text

@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: hexpat-Version: 0.6+Version: 0.7 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser

@@ -43,7 +43,7 @@ parseOnly :: B.ByteString -> String -> IO () parseOnly xml _ = do     parser <- newParser Nothing-    parse parser xml+    parse' parser xml     return ()  myParseTree enc xml = parseTree enc (L.fromChunks [xml])

@@ -1,12 +1,16 @@ import Text.XML.Expat.Tree+import Text.XML.Expat.IO import Text.XML.Expat.Format import Text.XML.Expat.Qualified import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Text as T+import CForeign import Data.ByteString.Internal (c2w, w2c) import Data.Char import Data.Maybe+import Data.IORef+import Control.Applicative import Control.Exception as E import Control.Monad import Control.Parallel.Strategies@@ -89,6 +93,29 @@     assertEqual "error1" (Left $ XMLParseError "not well-formed (invalid token)"         (XMLParseLocation 1 0 0 0)) eDoc +test_parse :: IO ()+test_parse = do+    ref <- newIORef []+    let lazy = L.fromChunks [+            toByteString "<open><tes",+            toByteString "t1>Hello</test",+            toByteString "1><hello></he",+            toByteString "llo></open>"]+    parser <- newParser Nothing+    setStartElementHandler parser $ \cname cattrs -> do+        name <- peekCString cname+        ref <- modifyIORef ref $ \l -> ("start "++name):l+        return True+    setEndElementHandler parser $ \cname -> do+        name <- peekCString cname+        ref <- modifyIORef ref $ \l -> ("end "++name):l+        return True+    parse parser lazy+    l <- reverse <$> readIORef ref+    assertEqual "parse"+        ["start open","start test1","end test1","start hello","end hello","end open"]+        l+ main = do     testXML <- readFile "test.xml"     -- Remove trailing newline@@ -122,6 +149,7 @@         TestCase $ test_error1,         TestCase $ test_error2,         TestCase $ test_error3,-        TestCase $ test_error4+        TestCase $ test_error4,+        TestCase $ test_parse       ]