hexpat 0.2 → 0.3

raw patch · 6 files changed

+156/−33 lines, 6 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/XML/Expat/Format.hs +54/−0
• Text/XML/Expat/IO.chs +57/−23
• Text/XML/Expat/Tree.hs +1/−1
• hexpat.cabal +8/−7
• test.hs +7/−2
• test2.hs +29/−0

@@ -0,0 +1,54 @@+module Text.XML.Expat.Format (+        formatDoc,+        formatDocS,+        formatNode,+        formatNodeS+    ) where++import Text.XML.Expat.IO+import Text.XML.Expat.Tree++enc :: String -> String+enc = id++-- | Format document with <?xml.. header.+formatDoc :: Maybe Encoding -> Node -> String+formatDoc mEnc node = formatDocS mEnc node ""++-- | Format document with <?xml.. header returning as a ShowS.+formatDocS :: Maybe Encoding -> Node -> ShowS+formatDocS mEnc node = ("<?xml version=\"1.0\""++) . putEnc mEnc . ("?>\n"++) . formatNodeS node+    where+        putEnc (Just enc) = (" encoding=\""++) . (encodingToString enc++) . ("\""++)+        putEnc Nothing = id++-- | Format XML node with no XML header.+formatNode :: Node -> String+formatNode node = formatNodeS node ""++-- | Format XML node with no XML header returning as a ShowS.+formatNodeS :: Node -> ShowS+formatNodeS (Element name attrs children) =+    ("<"++) . (enc name++) .+    foldr (.) id (flip map attrs (\(name, value) ->+            (" "++) . (enc name++) . ("=\""++) .+                     (enc (escapeXML value)++) . ("\""++) +        )) .+    (if null children+            then+                ("/>"++)+            else+                (">"++) .+                foldr (.) id (map formatNodeS children) .+                ("</"++) . (enc name++) . (">"++)+        )+formatNodeS (Text txt) = (enc (escapeXML txt)++)++escapeXML :: String -> String+escapeXML = concatMap e+    where+        e '&' = "&amp;"+        e '<' = "&lt;"+        e '"' = "&quot;"+        e '\'' = "&apos;"+        e ch = [ch]

@@ -22,12 +22,17 @@   setStartElementHandler, setEndElementHandler, setCharacterDataHandler,    -- ** Lower-level Parsing Interface-  parseChunk+  parseChunk,++  -- ** Helpers+  encodingToString ) where +import Control.Exception (bracket) import C2HS import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import Data.IORef  #include <expat.h> @@ -38,10 +43,14 @@  -- |Opaque parser type. type ParserPtr = Ptr ()-newtype Parser = Parser (ForeignPtr ())+data Parser = Parser+    (ForeignPtr ())+    (IORef CStartElementHandler) +    (IORef CEndElementHandler) +    (IORef CCharacterDataHandler)   withParser :: Parser -> (ParserPtr -> IO a) -> IO a-withParser (Parser fp) = withForeignPtr fp+withParser (Parser fp _ _ _) = withForeignPtr fp  -- |Encoding types available for the document encoding. data Encoding = ASCII | UTF8 | UTF16 | ISO88591@@ -65,7 +74,10 @@ newParser enc = do   ptr <- parserCreate enc   fptr <- newForeignPtr parserFree ptr-  return $ Parser fptr+  nullStartH <- newIORef nullCStartElementHandler+  nullEndH <- newIORef nullCEndElementHandler+  nullCharH <- newIORef nullCCharacterDataHandler+  return $ Parser fptr nullStartH nullEndH nullCharH  -- ByteString.useAsCStringLen is almost what we need, but C2HS wants a CInt -- instead of an Int.@@ -79,7 +91,28 @@ -- |@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+parseChunk :: Parser+              -> BS.ByteString+              -> Bool+              -> IO Bool+parseChunk parser@(Parser fp startRef endRef charRef) xml final = do+    bracket+        (do+            cStartH <- mkCStartElementHandler =<< readIORef startRef+            cEndH   <- mkCEndElementHandler =<< readIORef endRef+            cCharH  <- mkCCharacterDataHandler =<< readIORef charRef+            withParser parser $ \p -> do+                {#call unsafe XML_SetStartElementHandler as ^#}  p cStartH+                {#call unsafe XML_SetEndElementHandler as ^#}    p cEndH+                {#call unsafe XML_SetCharacterDataHandler as ^#} p cCharH+            return (cStartH, cEndH, cCharH))+        (\(cStartH, cEndH, cCharH) -> do+            freeHaskellFunPtr cStartH+            freeHaskellFunPtr cEndH+            freeHaskellFunPtr cCharH)+        (\_ -> doParseChunk parser xml final)++{#fun XML_Parse as doParseChunk     {withParser* `Parser', withBStringLen* `BS.ByteString' &, `Bool'}     -> `Bool' unStatus#} @@ -105,12 +138,13 @@ type CharacterDataHandler = String -> IO ()  type CStartElementHandler = Ptr () -> CString -> Ptr CString -> IO ()+nullCStartElementHandler _ _ _ = return ()+ foreign import ccall "wrapper"   mkCStartElementHandler :: CStartElementHandler                          -> IO (FunPtr CStartElementHandler)-wrapStartElementHandler :: StartElementHandler-                        -> IO (FunPtr CStartElementHandler)-wrapStartElementHandler handler = mkCStartElementHandler h where+wrapStartElementHandler :: StartElementHandler -> CStartElementHandler+wrapStartElementHandler handler = h where   h ptr cname cattrs = do     name <- peekCString cname     cattrlist <- peekArray0 nullPtr cattrs@@ -118,45 +152,45 @@     handler name (pairwise attrlist) -- |Attach a StartElementHandler to a Parser. setStartElementHandler :: Parser -> StartElementHandler -> IO ()-setStartElementHandler parser handler = do+setStartElementHandler parser@(Parser _ startRef _ _) handler = do   withParser parser $ \p -> do-  handler' <- wrapStartElementHandler handler-  {#call unsafe XML_SetStartElementHandler as ^#} p handler'+  writeIORef startRef $ wrapStartElementHandler handler   type CEndElementHandler = Ptr () -> CString -> IO ()+nullCEndElementHandler _ _ = return ()+ foreign import ccall "wrapper"   mkCEndElementHandler :: CEndElementHandler                        -> IO (FunPtr CEndElementHandler)-wrapEndElementHandler :: EndElementHandler-                      -> IO (FunPtr CEndElementHandler)-wrapEndElementHandler handler = mkCEndElementHandler h where+wrapEndElementHandler :: EndElementHandler -> CEndElementHandler+wrapEndElementHandler handler = 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+setEndElementHandler parser@(Parser _ _ endRef _) handler = do   withParser parser $ \p -> do-  handler' <- wrapEndElementHandler handler-  {#call unsafe XML_SetEndElementHandler as ^#} p handler'+  writeIORef endRef $ wrapEndElementHandler handler  type CCharacterDataHandler = Ptr () -> CString -> CInt -> IO ()+nullCCharacterDataHandler _ _ _ = return ()+ foreign import ccall "wrapper"   mkCCharacterDataHandler :: CCharacterDataHandler                           -> IO (FunPtr CCharacterDataHandler)-wrapCharacterDataHandler :: CharacterDataHandler-                      -> IO (FunPtr CCharacterDataHandler)-wrapCharacterDataHandler handler = mkCCharacterDataHandler h where+wrapCharacterDataHandler :: CharacterDataHandler -> CCharacterDataHandler+wrapCharacterDataHandler handler = 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+setCharacterDataHandler parser@(Parser _ _ _ charRef) handler = do   withParser parser $ \p -> do-  handler' <- wrapCharacterDataHandler handler-  {#call unsafe XML_SetCharacterDataHandler as ^#} p handler'+  writeIORef charRef $ wrapCharacterDataHandler handler  pairwise (x1:x2:xs) = (x1,x2) : pairwise xs pairwise []         = []

@@ -43,7 +43,7 @@     if ok       then do         [Element _ _ [root]] <- readIORef stack-        return $ Just $ modifyChildren reverse root+        return $ Just root       else return Nothing   start name attrs stack = Element name attrs [] : stack   text str (cur:rest) = modifyChildren (Text str:) cur : rest

@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: hexpat-Version: 0.2+Version: 0.3 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser@@ -16,16 +16,17 @@ Category: XML License: BSD3 License-File: LICENSE-Author: Evan Martin-Maintainer: martine@danga.com-Copyright: (c) 2008 Evan Martin <martine@danga.com>-Homepage: http://neugierig.org/software/darcs/browse/?r=hexpat;a=summary-Extra-Source-Files: test.hs, perf.hs+Author: Evan Martin, Stephen Blackheath+Maintainer: http://blacksapphire.com/antispam/+Copyright: (c) 2008 Evan Martin <martine@danga.com>, (c) 2008 Stephen Blackheath+Homepage: http://code.haskell.org/hexpat/+Extra-Source-Files: test.hs, perf.hs, test2.hs Build-Type: Simple+Stability: beta  Library   Build-Depends: base, haskell98, bytestring-  Exposed-Modules: Text.XML.Expat.IO, Text.XML.Expat.Tree+  Exposed-Modules: Text.XML.Expat.IO, Text.XML.Expat.Tree, Text.XML.Expat.Format   Other-Modules: C2HS   Extensions: ForeignFunctionInterface   Extra-Libraries: expat

@@ -1,11 +1,16 @@ import qualified Text.XML.Expat.IO as EIO import qualified Text.XML.Expat.Tree as ETree+import qualified Data.ByteString.Lazy as B import Data.Tree+import Data.Char +toByteString :: String -> B.ByteString+toByteString = B.pack . map (fromIntegral . ord)+ main_eio doc = do   parser <- EIO.newParser Nothing   EIO.setStartElementHandler parser startElement-  EIO.parse parser doc True+  EIO.parse parser doc   putStrLn "ok"   where   startElement name attrs = putStrLn $ show name ++ " " ++ show attrs@@ -23,4 +28,4 @@ main = do   let doc = "<foo baz='bah'><bar/><text>some &amp; text</text></foo>"   xml <- readFile "test.xml"-  main_eio xml+  main_eio (toByteString xml)

@@ -0,0 +1,29 @@+import Text.XML.Expat.IO+import Text.XML.Expat.Tree as T+import Text.XML.Expat.Format+import qualified Data.ByteString.Lazy as B+import Data.Char+import Data.Maybe++toByteString :: String -> B.ByteString+toByteString = B.pack . map (fromIntegral . ord)++test :: String -> IO ()+test xml = do+  let mTree = T.parse (Just UTF8) (toByteString xml)+  --putStrLn $ show mTree+  case mTree of+      Just tree -> do+          let out = formatDoc (Just UTF8) tree+          if out == xml+              then putStrLn "passed"+              else do+                  putStrLn $ "FAILED: mismatch"+                  putStrLn $ "input="++xml+                  putStrLn $ "output="++out+      Nothing ->+          putStrLn "FAILED: parse failed"++main = do+  test "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<test><test1 type=\"expression\">Cat &amp; mouse</test1><test2 type=\"communication\">Dog &amp; bone</test2></test>"+  test "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<test>Cat &amp; mouse</test>"