libxml-enumerator 0.1 → 0.2

raw patch · 2 files changed

+67/−32 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/XML/LibXML/Enumerator.hs +66/−31
• libxml-enumerator.cabal +1/−1

@@ -10,8 +10,10 @@ ----------------------------------------------------------------------------- module Text.XML.LibXML.Enumerator 	( Event (..)-	, parseBytes-	, parseText+	, parseBytesIO+	, parseTextIO+	, parseBytesST+	, parseTextST 	) where import qualified Data.ByteString as B import qualified Data.Enumerator as E@@ -20,10 +22,11 @@ import qualified Data.XML.Types as X import qualified Text.XML.LibXML.SAX as SAX +import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift)-import Control.Monad.ST (ST, unsafeSTToIO)+import Control.Monad.ST (ST) import qualified Data.STRef as ST-import System.IO.Unsafe (unsafePerformIO)+import qualified Data.IORef as IO  data Event 	= EventBeginDocument@@ -35,42 +38,74 @@ 	| EventInstruction X.Instruction 	deriving (Show, Eq) -newParser :: Maybe T.Text -> ST s (SAX.Parser (ST s), ST.STRef s [Event], ST.STRef s (Maybe T.Text))-newParser name = do+newParserIO :: Maybe T.Text -> IO (SAX.Parser IO, IO.IORef [Event], IO.IORef (Maybe T.Text))+newParserIO name = do+	errRef <- IO.newIORef Nothing+	p <- SAX.newParserIO (\msg -> IO.writeIORef errRef (Just msg)) name+	eventRef <- IO.newIORef []+	let addEvent e = IO.modifyIORef eventRef (e:) >> return True+	setCallbacks p addEvent+	return (p, eventRef, errRef)++newParserST :: Maybe T.Text -> ST s (SAX.Parser (ST s), ST.STRef s [Event], ST.STRef s (Maybe T.Text))+newParserST name = do 	errRef <- ST.newSTRef Nothing 	p <- SAX.newParserST (\msg -> ST.writeSTRef errRef (Just msg)) name 	eventRef <- ST.newSTRef []-	 	let addEvent e = ST.modifySTRef eventRef (e:) >> return True-	let setCallback cb st = SAX.setCallback p cb st-	-	setCallback SAX.parsedBeginDocument (addEvent EventBeginDocument)-	setCallback SAX.parsedEndDocument (addEvent EventEndDocument)-	setCallback SAX.parsedBeginElement ((addEvent .) . EventBeginElement)-	setCallback SAX.parsedEndElement (addEvent . EventEndElement)-	setCallback SAX.parsedCharacters (addEvent . EventCharacters)-	setCallback SAX.parsedComment (addEvent . EventComment)-	setCallback SAX.parsedInstruction (addEvent . EventInstruction)-	+	setCallbacks p addEvent 	return (p, eventRef, errRef) -unsafePerformST_M :: Monad m => ST s a -> m a-unsafePerformST_M st = unsafePerformIO (unsafeSTToIO (fmap return st))+setCallbacks :: Monad m => SAX.Parser m -> (Event -> m Bool) -> m ()+setCallbacks p addEvent = do+	let set cb st = SAX.setCallback p cb st+	+	set SAX.parsedBeginDocument (addEvent EventBeginDocument)+	set SAX.parsedEndDocument (addEvent EventEndDocument)+	set SAX.parsedBeginElement ((addEvent .) . EventBeginElement)+	set SAX.parsedEndElement (addEvent . EventEndElement)+	set SAX.parsedCharacters (addEvent . EventCharacters)+	set SAX.parsedComment (addEvent . EventComment)+	set SAX.parsedInstruction (addEvent . EventInstruction) -parseBytes :: Monad m => Maybe T.Text -> E.Enumeratee T.Text B.ByteString Event m b-parseBytes = parseSomething SAX.parseBytes+parseBytesIO :: MonadIO m => Maybe T.Text -> E.Enumeratee T.Text B.ByteString Event m b+parseBytesIO = parseIO SAX.parseBytes -parseText :: Monad m => Maybe T.Text -> E.Enumeratee T.Text T.Text Event m b-parseText = parseSomething SAX.parseText+parseTextIO :: MonadIO m => Maybe T.Text -> E.Enumeratee T.Text T.Text Event m b+parseTextIO = parseIO SAX.parseText -parseSomething :: Monad m-               => (SAX.Parser (ST s) -> a -> ST s ())-               -> Maybe T.Text-               -> E.Enumeratee T.Text a Event m b-parseSomething something name s = E.Iteratee $ do-	(p, eventRef, errRef) <- unsafePerformST_M $ newParser name+parseIO :: MonadIO m+        => (SAX.Parser IO -> a -> IO ())+        -> Maybe T.Text+        -> E.Enumeratee T.Text a Event m b+parseIO parseFn name s = E.Iteratee $ do+	(p, eventRef, errRef) <- liftIO $ newParserIO name 	-	let withEvents st = unsafePerformST_M $ do+	let withEvents io = liftIO $ do+		IO.writeIORef eventRef []+		IO.writeIORef errRef Nothing+		io+		events <- IO.readIORef eventRef+		err <- IO.readIORef errRef+		return (reverse events, err)+	+	let parseChunk bytes = withEvents (parseFn p bytes)+	let complete = withEvents (SAX.parseComplete p)+	E.runIteratee $ eneeParser parseChunk complete s++parseBytesST :: Maybe T.Text -> E.Enumeratee T.Text B.ByteString Event (ST s) b+parseBytesST = parseST SAX.parseBytes++parseTextST :: Maybe T.Text -> E.Enumeratee T.Text T.Text Event (ST s) b+parseTextST = parseST SAX.parseText++parseST :: (SAX.Parser (ST s) -> a -> ST s ())+        -> Maybe T.Text+        -> E.Enumeratee T.Text a Event (ST s) b+parseST parseFn name s = E.Iteratee $ do+	(p, eventRef, errRef) <- newParserST name+	+	let withEvents st = do 		ST.writeSTRef eventRef [] 		ST.writeSTRef errRef Nothing 		st@@ -78,7 +113,7 @@ 		err <- ST.readSTRef errRef 		return (reverse events, err) 	-	let parseChunk bytes = withEvents (something p bytes)+	let parseChunk bytes = withEvents (parseFn p bytes) 	let complete = withEvents (SAX.parseComplete p) 	E.runIteratee $ eneeParser parseChunk complete s 

@@ -1,5 +1,5 @@ name: libxml-enumerator-version: 0.1+version: 0.2 synopsis: Enumerator-based API for libXML's SAX interface license: MIT license-file: license.txt