libxml-sax 0.2 → 0.3

raw patch · 3 files changed

+167/−21 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Tests.hs +124/−0
• Text/XML/LibXML/SAX.chs +35/−18
• libxml-sax.cabal +8/−3

@@ -0,0 +1,124 @@+{- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>+   +   This program is free software: you can redistribute it and/or modify+   it under the terms of the GNU General Public License as published by+   the Free Software Foundation, either version 3 of the License, or+   any later version.+   +   This program is distributed in the hope that it will be useful,+   but WITHOUT ANY WARRANTY; without even the implied warranty of+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+   GNU General Public License for more details.+   +   You should have received a copy of the GNU General Public License+   along with this program.  If not, see <http://www.gnu.org/licenses/>.+-}++module Main () where++import Test.HUnit+import Text.XML.LibXML.SAX++allTests = "allTests" ~: TestList [beginTests, endTests, textTests, otherTests, incrementalTests]+beginTests = "beginTests" ~: TestList [testBegin, testBeginNS, testBeginPrefix]+endTests = "endTests" ~: TestList [testEnd, testEndNS, testEndPrefix]+textTests = "textTests" ~: TestList [testText, testPredefinedEntity, testNumericEntity]+otherTests = "otherTests" ~: TestList [testProcessingInstruction, testComment, testCDATA, testError]+incrementalTests = "incrementalTests" ~: TestList [incrBegin, incrEnd, incrText]++testBegin = TestCase $ do+	parser <- mkParser+	[event] <- parse parser "<test>" False+	BeginElement (QName "" "" "test") [] @=? event++testBeginNS = TestCase $ do+	parser <- mkParser+	[event] <- parse parser "<test xmlns='urn:test'>" False+	BeginElement (QName "urn:test" "" "test") [] @=? event++testBeginPrefix = TestCase $ do+	parser <- mkParser+	[event] <- parse parser "<t:test xmlns:t='urn:test'>" False+	BeginElement (QName "urn:test" "t" "test") [] @=? event++testEnd = TestCase $ do+	parser <- mkParser+	[_, event] <- parse parser "<test/>" True+	EndElement (QName "" "" "test") @=? event++testEndNS = TestCase $ do+	parser <- mkParser+	[_, event] <- parse parser "<test xmlns='urn:test'/>" True+	EndElement (QName "urn:test" "" "test") @=? event++testEndPrefix = TestCase $ do+	parser <- mkParser+	[_, event] <- parse parser "<t:test xmlns:t='urn:test'/>" True+	EndElement (QName "urn:test" "t" "test") @=? event++testText = TestCase $ do+	parser <- mkParser+	[_, event, _] <- parse parser "<test>text here</test>" True+	Characters "text here" @=? event++testPredefinedEntity = TestCase $ do+	parser <- mkParser+	events <- parse parser "<test>text &amp; here</test>" True+	let events' = init . tail $ events+	[Characters "text ", Characters "&", Characters " here"] @=? events'++testNumericEntity = TestCase $ do+	parser <- mkParser+	events <- parse parser "<test>text &#x003C; here</test>" True+	let events' = init . tail $ events+	[Characters "text ", Characters "<", Characters " here"] @=? events'++testProcessingInstruction = TestCase $ do+	parser <- mkParser+	events <- parse parser "<?instr version='1.0'?><test/>" True+	ProcessingInstruction "instr" "version='1.0'" @=? head events++testComment = TestCase $ do+	parser <- mkParser+	events <- parse parser "<!-- comment here --><test/>" True+	Comment " comment here " @=? head events++testCDATA = TestCase $ do+	parser <- mkParser+	events <- parse parser "<test><![CDATA[<test2/>]]></test>" True+	let events' = init . tail $ events+	[Characters "<test2/>"] @=? events'++testError = TestCase $ do+	parser <- mkParser+	events <- parse parser "</a>" True+	[ParseError "StartTag: invalid element name\n"] @=? events++incrBegin = TestCase $ do+	parser <- mkParser+	let parse' = parse parser+	+	[] <- parse' "<test" False+	[event] <- parse' ">" False+	BeginElement (QName "" "" "test") [] @=? event++incrEnd = TestCase $ do+	parser <- mkParser+	let parse' = parse parser+	+	[_] <- parse' "<test></test" False+	[event] <- parse' ">" True+	EndElement (QName "" "" "test") @=? event++incrText = TestCase $ do+	parser <- mkParser+	let parse' = parse parser+	+	[_] <- parse' "<test>text" False+	[] <- parse' " more text" False+	[event, _] <- parse' "</test>" True+	Characters "text more text" @=? event++main = do+	runTestTT allTests+

@@ -18,13 +18,13 @@  #include <libxml/parser.h> -module Text.XML.LibXML.SAX (-	 Parser-	,Event(..)-	,Attribute(..)-	,QName(..)-	,mkParser-	,parse+module Text.XML.LibXML.SAX+	( Parser+	, Event(..)+	, Attribute(..)+	, QName(..)+	, mkParser+	, parse 	) where  import Data.IORef (newIORef, readIORef, writeIORef, IORef)@@ -37,18 +37,26 @@ 	| EndElement QName 	| Characters String 	| Comment String-	| ProcessingInstruction String String -- Target, Data+	| ProcessingInstruction String String -- ^ Target, Data 	| ParseError String 	deriving (Show, Eq) -data Attribute = Attribute QName String+data Attribute = Attribute+	{ attributeName  :: QName+	, attributeValue :: String+	} 	deriving (Show, Eq) --- Namespace, prefix, local name-data QName = QName String String String+data QName = QName+	{ qnameNamespace :: String+	, qnamePrefix    :: String+	, qnameLocalName :: String+	} 	deriving (Show, Eq) -data Parser = Parser (ForeignPtr Context)+-- | An opaque reference to a libXML SAX parser.+-- +newtype Parser = Parser (ForeignPtr Context)  data Context = Context data SAXHandler = SAXHandler@@ -63,6 +71,8 @@ {#pointer *xmlSAXHandler as SAXHandlerPtr -> SAXHandler #} {#pointer *_xmlSAXHandler as SAXHandlerPtr nocode #} +-- | Construct a new, empty parser.+--  mkParser :: IO Parser mkParser = let n = nullPtr in do 	context <- {#call xmlCreatePushParserCtxt #} n n n 0 n@@ -72,6 +82,13 @@ foreign import ccall "libxml/parser.h &xmlFreeParserCtxt" 	xmlFreeParserCtxt :: FunPtr (Ptr Context -> IO ()) +-- | Feed some text into the parser. This may be performed multiple times+-- per 'Parser' value, in which case the internal parser state is retained+-- between computations.+-- +-- If the third parameter is 'True', the parser assumes that this is the+-- last input and checks that the document was closed correctly.+--  parse :: Parser -> String -> Bool -> IO [Event] parse (Parser fptr) s final = do 	withCStringLen s $ \(cs, cs_len) -> do@@ -83,7 +100,7 @@ 	rc <- {#call xmlParseChunk #} ctxt cs (fromIntegral cs_len) cFinal 	errors <- checkErrors rc ctxt 	events <- readIORef eventRef-	return $ events ++ errors+	return $ reverse events ++ errors 	 withHandlers :: Ptr Context -> (IORef [Event] -> IO a) -> IO a withHandlers ctxt block = do@@ -177,7 +194,7 @@ 	es <- readIORef eventref 	c_attrs <- splitCAttributes n_attrs (castPtr raw_attrs) 	attrs <- mapM convertCAttribute c_attrs-	writeIORef eventref (es ++ [BeginElement (QName ns pfx ln) attrs])+	writeIORef eventref ((BeginElement (QName ns pfx ln) attrs):es)  onEndElement :: IORef [Event] -> EndElementNsSAX2Func onEndElement eventref _ cln cpfx cns = do@@ -185,26 +202,26 @@ 	pfx <- peekNullable $ castPtr cpfx 	ln <- peekCString $ castPtr cln 	es <- readIORef eventref-	writeIORef eventref (es ++ [EndElement (QName ns pfx ln)])+	writeIORef eventref ((EndElement (QName ns pfx ln)):es)  onCharacters :: IORef [Event] -> CharactersSAXFunc onCharacters eventref _ ctext ctextlen = do 	text <- peekCStringLen (castPtr ctext, fromIntegral ctextlen) 	es <- readIORef eventref-	writeIORef eventref (es ++ [Characters text])+	writeIORef eventref ((Characters text):es)  onComment :: IORef [Event] -> CommentSAXFunc onComment eventRef _ ctext = do 	text <- peekCString (castPtr ctext) 	es <- readIORef eventRef-	writeIORef eventRef (es ++ [Comment text])+	writeIORef eventRef ((Comment text):es)  onProcessingInstruction :: IORef [Event] -> ProcessingInstructionSAXFunc onProcessingInstruction eventRef _ ctarget cdata = do 	target <- peekCString (castPtr ctarget) 	data' <- peekCString (castPtr cdata) 	es <- readIORef eventRef-	writeIORef eventRef (es ++ [ProcessingInstruction target data'])+	writeIORef eventRef ((ProcessingInstruction target data'):es)  foreign import ccall "wrapper" 	wrappedBegin :: StartElementNsSAX2Func -> IO (FunPtr StartElementNsSAX2Func)

@@ -1,15 +1,20 @@ Name: libxml-sax-Version: 0.2+Version: 0.3 Stability: Alpha Synopsis: Bindings for the libXML2 SAX interface Description: Incrementally convert text to lists of XML events-License: GPL+License: GPL-3 License-file: License.txt Author: John Millikin maintainer: jmillikin@gmail.com+copyright: Copyright (c) John Millikin 2009-2010,+                     (c) Dmitry Astapov 2010 Build-Type: Simple-Cabal-Version: >=1.2+Cabal-Version: >=1.4 Category: XML+homepage: http://ianen.org/haskell/bindings/libxml-sax/+tested-with: GHC==6.10.4+extra-source-files: Tests.hs  Library   Build-Depends: base >=3 && < 5