packages feed

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 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 &lt;all&gt; <![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@.