polysoup 0.5.2 → 0.6

raw patch · 4 files changed

+42/−16 lines, 4 filesdep +deepseq

Dependencies added: deepseq

Files

• polysoup.cabal +3/−2
• src/Text/XML/PolySoup/Parser.hs +14/−4
• src/Text/XML/PolySoup/Tag.hs +1/−1
• src/Text/XML/PolySoup/XmlTree.hs +24/−9

@@ -1,5 +1,5 @@ name:               polysoup-version:            0.5.2+version:            0.6 synopsis:           Online XML parsing with polyparse and tagsoup description:     The library provides combinators for lazy, incremental XML parsing.@@ -29,7 +29,8 @@         base            >= 4        && < 5       , containers      >= 0.4      && < 0.6       , tagsoup         >= 0.12     && < 0.14-      , polyparse       >= 1.9      && < 1.10+      , polyparse       >= 1.9      && < 1.12+      , deepseq         >= 1.3      && < 1.4      exposed-modules:         Text.XML.PolySoup

@@ -15,9 +15,10 @@  -- * Parsing -- ** Selective-, find+-- , find , first , every+, every' -- ** Sequential , pop -- ** Peek@@ -30,6 +31,7 @@  import           Control.Applicative import qualified Control.Arrow as Arr+import           Data.Maybe (catMaybes)  import           Text.XML.PolySoup.Predicate @@ -68,9 +70,9 @@ ---------------------------------------------------------------------  --- | A synonym to `first`.-find :: Q a b -> P a b-find = first+-- -- | A synonym to `first`.+-- find :: Q a b -> P a b+-- find = first   -- | Find the first tree satisfying the given predicate.@@ -91,6 +93,14 @@     upd (vs, acc) t = case p t of         Just v  -> (v:vs, acc)         Nothing -> (vs, t:acc)+++-- | A lazy version of `every` which "forgets" non-matching subtrees+-- along the way.+every' :: Q a b -> P a [b]+every' (Q p) =+    let prep xs = Just (xs, [])+    in  P $ prep . catMaybes . map p   ---------------------------------------------------------------------

@@ -58,7 +58,7 @@ getText = maybeTagText  --- | Get name of the tag.+-- | Get the list of the attributes. getAtts :: Tag s -> Maybe [(s, s)] getAtts (TagOpen _ x)   = Just x getAtts _               = Nothing

@@ -23,7 +23,9 @@ ) where  +import           Control.DeepSeq (NFData, deepseq) import           Data.Tree+import           Text.StringLike import qualified Text.HTML.TagSoup as S import           Text.ParserCombinators.Poly.Lazy @@ -56,39 +58,52 @@   -- | Parse XML tree from a list of tags.-parseTree :: Eq s => [S.Tag s] -> XmlTree s+parseTree :: (NFData s, StringLike s) => [S.Tag s] -> XmlTree s parseTree = fst . runParser xmlTreeP   -- | Parse XML forest from a list of tags.  Note, that if the XML file -- has additional headers, the `parseForest` function has to be used to -- parse it correctly.-parseForest :: Eq s => [S.Tag s] -> XmlForest s+parseForest :: (NFData s, StringLike s) => [S.Tag s] -> XmlForest s parseForest = fst . runParser (many xmlTreeP)   -- | A parser from tags to an XML tree.-xmlTreeP :: Eq s => XmlParser s (XmlTree s)-xmlTreeP = nodeP <|> leafP+xmlTreeP :: (NFData s, StringLike s) => XmlParser s (XmlTree s)+xmlTreeP = leafP <|> nodeP+-- xmlTreeP = nodeP <|> leafP   -- | Internal node parser.-nodeP :: Eq s => XmlParser s (XmlTree s)+nodeP :: (NFData s, StringLike s) => XmlParser s (XmlTree s) nodeP = do     x <- satisfy S.isTagOpen-    x `seq` Node x <$> many xmlTreeP+    x `tagOpenSeq` Node x <$> many xmlTreeP         <* satisfy (S.isTagCloseName $ tagName x)   where     tagName (S.TagOpen x _) = x     tagName _ = error "tagName: not an open tag"+    -- Without `deepseq` even the simple `renderForest . parseForest` leads+    -- to a memory leak.  Tested multiple times w.r.t. tagsoup-0.13.1.+    tagOpenSeq (S.TagOpen x xs) = deepseq (x, xs)+    tagOpenSeq _ = id   -- | Leaf node parser.-leafP :: XmlParser s (XmlTree s)+leafP :: (NFData s, StringLike s) => XmlParser s (XmlTree s) leafP = fmap     (flip Node [])-    (satisfy $ \x ->-        not (S.isTagOpen x || S.isTagClose x))+--     (satisfy $ \x -> not (S.isTagOpen x || S.isTagClose x))+    (satisfy $ \x -> not (isTagOpen x || S.isTagClose x))+  where+    isTagOpen (S.TagOpen xs _) = case uncons xs of+        -- Headers (e.g. <?xml ...> and <!CDATA ...>) do not have+        -- corresponding closing tags, therefore have to be treated+        -- as leaves.+        Just (x, _) -> x /= '!' && x /= '?'+        Nothing     -> True+    isTagOpen _ = False       ---------------------------------------------------------------------