xml-conduit-parse 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+20/−9 lines, 3 files
Files
- Data/Conduit/Parser/XML.hs +18/−7
- test/Main.hs +1/−1
- xml-conduit-parse.cabal +1/−1
Data/Conduit/Parser/XML.hs view
@@ -11,9 +11,11 @@ , AttributeMap , AttrParser() , attr+ , textAttr , ignoreAttrs -- ** Content , content+ , textContent -- * Re-exports -- ** Event producers , Reexport.parseBytes@@ -94,13 +96,16 @@ tagNoAttr :: MonadCatch m => Name -> ConduitParser Event m a -> ConduitParser Event m a tagNoAttr name f = tagName name (return ()) $ const f --- | Parse a tag content.-content :: MonadCatch m => ConduitParser Event m Text-content = do+-- | Parse a tag content as 'Text'.+textContent :: MonadCatch m => ConduitParser Event m Text+textContent = do skipMany ignored mconcat <$> sepEndBy text ignored where ignored = beginDocument <|> endDocument <|> void beginDoctype <|> endDoctype <|> void instruction <|> void comment +-- | Parse a tag content using a custom parsing function.+content :: MonadCatch m => (Text -> Maybe a) -> ConduitParser Event m a+content parse = maybe (unexpected "Invalid content.") return . parse =<< textContent newtype AttrParser a = AttrParser { runAttrParser :: AttributeMap -> Either SomeException (AttributeMap, a) } @@ -115,7 +120,7 @@ pure = return (<*>) = ap --- | Attribute parsers can be combined with @(\<|\>)@, 'some', 'many', 'optional', 'choice', etc.+-- | Attribute parsers can be combined with ('<|>'), 'some', 'many', 'optional', 'choice', etc. instance Alternative AttrParser where empty = AttrParser $ const $ Left $ toException $ Reexport.XmlException "AttrParser.empty" Nothing AttrParser f <|> AttrParser g = AttrParser $ \x -> either (const $ g x) Right (f x)@@ -123,11 +128,17 @@ instance MonadThrow AttrParser where throwM = AttrParser . const . throwM --- | Single attribute parser.-attr :: Name -> AttrParser Text-attr name = AttrParser $ \attrs -> maybe raiseError (returnValue attrs) (Map.lookup name attrs)+-- | Parse a single textual attribute.+textAttr :: Name -> AttrParser Text+textAttr name = AttrParser $ \attrs -> maybe raiseError (returnValue attrs) (Map.lookup name attrs) where raiseError = Left . toException $ Reexport.XmlException ("Missing attribute: " ++ show name) Nothing returnValue attrs contents = Right (Map.delete name attrs, contentsToText contents)++-- | Parse a single attribute using a custom parsing function.+attr :: Name -> (Text -> Maybe a) -> AttrParser a+attr name p = do+ x <- textAttr name+ maybe (throwM $ Reexport.XmlException ("Invalid attribute: " ++ show name) Nothing) return (p x) -- | Consume all remaining unparsed attributes. ignoreAttrs :: AttrParser ()
test/Main.hs view
@@ -47,7 +47,7 @@ , "<child3>combine <all> <![CDATA[&content]]></child3>\n" , "</hello>" ]- parser = tagName "hello" (attr "world") $ \world -> do+ parser = tagName "hello" (textAttr "world") $ \world -> do tagNoAttr "{mynamespace}child1" $ return () tagNoAttr "child2" $ return () x <- tagNoAttr "child3" content
xml-conduit-parse.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-parse-version: 0.1.0.0+version: 0.2.0.0 synopsis: Streaming XML parser based on conduits. description: This library provides an alternative, hopefully higher-level implementation for the parsing part of @xml-conduit@.