libxml-enumerator 0.4.0.4 → 0.5
raw patch · 2 files changed
+63/−68 lines, 2 filesdep ~libxml-saxdep ~xml-types
Dependency ranges changed: libxml-sax, xml-types
Files
- Text/XML/LibXML/Enumerator.hs +59/−60
- libxml-enumerator.cabal +4/−8
Text/XML/LibXML/Enumerator.hs view
@@ -10,104 +10,100 @@ ----------------------------------------------------------------------------- module Text.XML.LibXML.Enumerator ( parseBytesIO- , parseTextIO , parseBytesST- , parseTextST ) where++import Control.Monad (unless) import qualified Data.ByteString as B import qualified Data.Enumerator as E-import Data.Enumerator ((>>==))+import Data.Enumerator ((>>==)) import qualified Data.Text as T-import qualified Data.Text.Lazy as TL import qualified Data.XML.Types as X import qualified Text.XML.LibXML.SAX as SAX -import Control.Exception (ErrorCall(..))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class (lift)-import Control.Monad.ST (ST)+import Control.Exception (ErrorCall(..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.ST (ST) import qualified Data.STRef as ST import qualified Data.IORef as IO -newParserIO :: Maybe T.Text -> IO (SAX.Parser IO, IO.IORef [X.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 [X.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- setCallbacks p addEvent- return (p, eventRef, errRef)--setCallbacks :: Monad m => SAX.Parser m -> (X.Event -> m Bool) -> m ()-setCallbacks p addEvent = do+setCallbacks :: Monad m => Bool -> SAX.Parser m -> (X.Event -> m Bool) -> m ()+setCallbacks expandRefs p addEvent = do let set cb st = SAX.setCallback p cb st - let fromStrict txt = TL.fromChunks [txt]- set SAX.parsedBeginDocument (addEvent X.EventBeginDocument) set SAX.parsedEndDocument (addEvent X.EventEndDocument) set SAX.parsedBeginElement ((addEvent .) . X.EventBeginElement) set SAX.parsedEndElement (addEvent . X.EventEndElement)- set SAX.parsedCharacters (addEvent . X.EventContent . X.ContentText . fromStrict)- set SAX.parsedComment (addEvent . X.EventComment . fromStrict)+ set SAX.parsedCharacters (addEvent . X.EventContent . X.ContentText)+ set SAX.parsedCDATA (addEvent . X.EventCDATA)+ set SAX.parsedComment (addEvent . X.EventComment) set SAX.parsedInstruction (addEvent . X.EventInstruction)- set SAX.parsedDoctype (addEvent . X.EventDoctype)--parseBytesIO :: MonadIO m => Maybe T.Text -> E.Enumeratee B.ByteString X.Event m b-parseBytesIO = parseIO SAX.parseBytes--parseTextIO :: MonadIO m => Maybe T.Text -> E.Enumeratee T.Text X.Event m b-parseTextIO = parseIO SAX.parseText+ set SAX.parsedExternalSubset ((addEvent .) . X.EventBeginDoctype)+ + unless expandRefs (set SAX.parsedReference (addEvent . X.EventContent . X.ContentEntity)) -parseIO :: MonadIO m- => (SAX.Parser IO -> a -> IO ())- -> Maybe T.Text- -> E.Enumeratee a X.Event m b-parseIO parseFn name s = E.Iteratee $ do- (p, eventRef, errRef) <- liftIO $ newParserIO name+parseBytesIO :: MonadIO m+ => Bool -- ^ Whether to expand entity references+ -> Maybe T.Text -- ^ An optional filename or URI+ -> E.Enumeratee B.ByteString X.Event m b+parseBytesIO expandRefs name s = E.Iteratee $ do+ p <- liftIO (SAX.newParserIO name) + -- error handling+ errRef <- liftIO (IO.newIORef Nothing)+ liftIO (SAX.setCallback p SAX.reportError $ \msg -> do+ IO.writeIORef errRef (Just msg)+ return False)+ + -- event storage+ eventRef <- liftIO (IO.newIORef [])+ let addEvent e = do+ IO.modifyIORef eventRef (e:)+ return True+ liftIO (setCallbacks expandRefs p addEvent)+ let withEvents io = liftIO $ do IO.writeIORef eventRef [] IO.writeIORef errRef Nothing- io+ void io events <- IO.readIORef eventRef err <- IO.readIORef errRef return (reverse events, err) - let parseChunk bytes = withEvents (parseFn p bytes)+ let parseChunk bytes = withEvents (SAX.parseBytes p bytes) let complete = withEvents (SAX.parseComplete p) E.runIteratee $ eneeParser parseChunk complete s -parseBytesST :: Maybe T.Text -> E.Enumeratee B.ByteString X.Event (ST s) b-parseBytesST = parseST SAX.parseBytes--parseTextST :: Maybe T.Text -> E.Enumeratee T.Text X.Event (ST s) b-parseTextST = parseST SAX.parseText--parseST :: (SAX.Parser (ST s) -> a -> ST s ())- -> Maybe T.Text- -> E.Enumeratee a X.Event (ST s) b-parseST parseFn name s = E.Iteratee $ do- (p, eventRef, errRef) <- newParserST name+parseBytesST :: Bool -- ^ Whether to expand entity references+ -> Maybe T.Text -- ^ An optional filename or URI+ -> E.Enumeratee B.ByteString X.Event (ST s) b+parseBytesST expandRefs name s = E.Iteratee $do+ p <- SAX.newParserST name + -- error handling+ errRef <- ST.newSTRef Nothing+ SAX.setCallback p SAX.reportError $ \msg -> do+ ST.writeSTRef errRef (Just msg)+ return False+ + -- event storage+ eventRef <- ST.newSTRef []+ let addEvent e = do+ ST.modifySTRef eventRef (e:)+ return True+ setCallbacks expandRefs p addEvent+ let withEvents st = do ST.writeSTRef eventRef [] ST.writeSTRef errRef Nothing- st+ void st events <- ST.readSTRef eventRef err <- ST.readSTRef errRef return (reverse events, err) - let parseChunk bytes = withEvents (parseFn p bytes)+ let parseChunk bytes = withEvents (SAX.parseBytes p bytes) let complete = withEvents (SAX.parseComplete p) E.runIteratee $ eneeParser parseChunk complete s @@ -130,3 +126,6 @@ if null events then checkError k else k (E.Chunks events) >>== E.checkDoneEx extra checkError++void :: Functor m => m a -> m ()+void = fmap (return ())
libxml-enumerator.cabal view
@@ -1,5 +1,5 @@ name: libxml-enumerator-version: 0.4.0.4+version: 0.5 synopsis: Enumerator-based API for libXML's SAX interface license: MIT license-file: license.txt@@ -19,11 +19,7 @@ location: http://john-millikin.com/software/libxml-enumerator/ library- if true- ghc-options: -Wall-- if impl(ghc >= 6.11)- ghc-options: -fno-warn-unused-do-bind+ ghc-options: -Wall build-depends: base >= 4 && < 5@@ -31,8 +27,8 @@ , text >= 0.7 && < 0.12 , enumerator >= 0.4.3 && < 0.5 , transformers >= 0.2 && < 0.3- , libxml-sax >= 0.6.1 && < 0.7- , xml-types >= 0.1.1 && < 0.2+ , libxml-sax >= 0.7 && < 0.8+ , xml-types >= 0.3 && < 0.4 exposed-modules: Text.XML.LibXML.Enumerator