packages feed

zenacy-html 2.0.7 → 2.1.0

raw patch · 7 files changed

+201/−15 lines, 7 files

Files

CHANGES.md view
@@ -1,5 +1,10 @@ # Change Log +## 2.1.0++* Fix removal of earliest active format element+* Fix DOM node attribute matching+ ## 2.0.7  * Update benchmarks for ST MonadFail removal
src/Zenacy/HTML/Internal/DOM.hs view
@@ -45,7 +45,9 @@   , domElementHasAttr   , domElementFindAttr   , domElementAttrValue+  , domAttrEq   , domAttrMerge+  , domAttrSet   , domMatch   , domLastChild   , domMapID@@ -111,6 +113,13 @@   , insert   , keys   )+import Data.Set+  ( Set+  )+import qualified Data.Set as Set+  ( empty+  , insert+  ) import Data.Sequence   ( Seq(..)   , ViewL(..)@@ -492,11 +501,20 @@ domMatch d i j =   case (domGetNode d i, domGetNode d j) of     (Just (DOMElement _ _ n1 s1 a1 _), Just (DOMElement _ _ n2 s2 a2 _)) ->-      n1 == n2 && s1 == s2 && a1 == a1+      n1 == n2 && s1 == s2 && domAttrEq a1 a2     (Just (DOMTemplate _ _ s1 a1 _ ), Just (DOMTemplate _ _ s2 a2 _)) ->-      s1 == s2 && a1 == a1+      s1 == s2 && domAttrEq a1 a2     _otherwise ->       False++-- | Determine if two sequences of attributes are equivalent.+domAttrEq :: Seq DOMAttr -> Seq DOMAttr -> Bool+domAttrEq a b = domAttrSet a == domAttrSet b++-- | Converta an attribute sequence to an attribute set in order+-- to be insensitive to order.+domAttrSet :: Seq DOMAttr -> Set DOMAttr+domAttrSet = foldr Set.insert Set.empty  -- | Returns the last child of a node if it exists. domLastChild :: DOM -> DOMID -> Maybe DOMID
src/Zenacy/HTML/Internal/Parser.hs view
@@ -883,17 +883,26 @@ activeFormatAddMarker Parser {..} =   uref parserActiveFormatList (ParserFormatMarker:) +-- | Limits matching active format elements up to the first+-- marker to two so that a third can be added (Noah's Ark clause).+activeFormatLimit :: (DOMID -> Bool) -> [ParserFormatItem] -> [ParserFormatItem]+activeFormatLimit match xs =+  f 0 xs+  where+    f :: Int -> [ParserFormatItem] -> [ParserFormatItem]+    f n [] = []+    f n (e@(ParserFormatMarker):es) = e : es+    f n (e@(ParserFormatElement domId _):es)+      | match domId = if n < 2 then e : f (n + 1) es else f n es+      | otherwise = e : f n es+ -- | Adds an element to the list of active format elements. activeFormatAddElement :: Parser s -> Token -> DOMID -> ST s () activeFormatAddElement p@Parser {..} t x = do   d <- getDOM p   a <- activeFormatList p-  let match (ParserFormatElement y _) = domMatch d x y-      b = takeWhile (not . formatItemIsMarker) a-      n = (foldr (\i z -> z + if match i then 1 else 0) 0 b) :: Int-      a' = if n < 3 then a else removeFirst match a-      e' = ParserFormatElement x t : a'-  wref parserActiveFormatList e'+  wref parserActiveFormatList $+    ParserFormatElement x t : activeFormatLimit (domMatch d x) a  -- | Adds the current node to the list of active format elements. activeFormatAddCurrentNode :: Parser s -> Token -> ST s ()@@ -952,15 +961,15 @@   case a of     [] -> pure ()     (x:xs)-      | isOpen e x -> pure ()+      | openOrMarker e x -> pure ()       | otherwise -> do-          let b = reverse . takeWhile (not . isOpen e) $ a+          let b = reverse . takeWhile (not . openOrMarker e) $ a               a' = drop (length b) a           reopen p b a'  -- | Determines is a format item is open.-isOpen :: [DOMID] -> ParserFormatItem -> Bool-isOpen x = \case+openOrMarker :: [DOMID] -> ParserFormatItem -> Bool+openOrMarker x = \case    ParserFormatMarker -> True    ParserFormatElement i _ -> i `elem` x
+ test/Examples.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Examples+  ( testExamples+  ) where++import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertEqual+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( pack+  )+import Zenacy.HTML++testExamples :: Test+testExamples = testGroup "Examples"+  [ testMisnested+  , testUnexpected+  , testUnclosed+  ]++testMisnested :: Test+testMisnested = testCase "Misnested tags" $ do+  flip (assertEqual "13.2.10.1 Misnested tags")+    (htmlRender $ htmlParseEasy+    "<html><head></head><body><p>1<b>2<i>3</b>4</i>5</p></body></html>")+    "<html><head></head><body><p>1<b>2<i>3</i></b><i>4</i>5</p></body></html>"+  flip (assertEqual "13.2.10.2 Misnested tags")+    (htmlRender $ htmlParseEasy+    "<html><head></head><body><b>1<p>2</b>3</p></body></html>")+    "<html><head></head><body><b>1</b><p><b>2</b>3</p></body></html>"++testUnexpected :: Test+testUnexpected = testCase "Unexpected markup in tables" $ do+  flip (assertEqual "13.2.10.3 Unexpected markup in tables")+    (htmlRender $ htmlParseEasy+    "<html><head></head><body><table><b><tr><td>aaa</td></tr>bbb</table>ccc</body></html>")+    "<html><head></head><body>\+    \<b></b><b>bbb</b><table><tbody><tr><td>aaa</td></tr></tbody></table><b>ccc</b>\+    \</body></html>"++testUnclosed :: Test+testUnclosed = testCase "Unclosed formatting elements" $ do+  flip (assertEqual "13.2.10.6 Unclosed formatting elements")+    (htmlRender $ htmlParseEasy+    "<!DOCTYPE html>\+    \<p><b class=x><b class=x><b><b class=x><b class=x><b>X\+    \<p>X\+    \<p><b><b class=x><b>X\+    \<p></b></b></b></b></b></b>X")++    "<!DOCTYPE html><html><head></head><body>\+    \<p>\+      \<b class=\"x\">\+        \<b class=\"x\">\+          \<b>\+            \<b class=\"x\">\+              \<b class=\"x\">\+                \<b>X</b>\+              \</b>\+            \</b>\+          \</b>\+        \</b>\+      \</b>\+    \</p>\+    \<p>\+      \<b class=\"x\">\+        \<b>\+          \<b class=\"x\">\+            \<b class=\"x\">\+              \<b>X</b>\+            \</b>\+          \</b>\+        \</b>\+      \</b>\+    \</p>\+    \<p>\+      \<b class=\"x\">\+        \<b>\+          \<b class=\"x\">\+            \<b class=\"x\">\+              \<b>\+                \<b>\+                  \<b class=\"x\">\+                    \<b>X</b>\+                  \</b>\+                \</b>\+              \</b>\+            \</b>\+          \</b>\+        \</b>\+      \</b>\+    \</p>\+    \<p>X</p>\+    \</body></html>"
+ test/Issues.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Issues+  ( testIssues+  ) where++import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertEqual+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( pack+  )+import Zenacy.HTML++testIssues :: Test+testIssues = testGroup "Issues"+  [ testIssue01+  ]++testIssue01 :: Test+testIssue01 = testCase "issue 01" $ do+  flip (assertEqual "Issue 1 case 1")+    (htmlRender $ htmlParseEasy+    "<html><body> <p><i><i>a<i>b<i></i></i></i></i></p> </body></html>")+    "<html><head></head><body> <p><i><i>a<i>b<i></i></i></i></i></p> </body></html>"+  flip (assertEqual "Issue 1 case 2")+    (htmlRender $ htmlParseEasy+    "<html><body>x<p><i><i>a<i>b<i></i></i></i></i></p>y</body></html>")+    "<html><head></head><body>x<p><i><i>a<i>b<i></i></i></i></i></p>y</body></html>"
test/TestSuite.hs view
@@ -1,5 +1,7 @@ module Main where +import Examples+import Issues import Samples import Zenacy.HTML.Internal.Buffer.Tests import Zenacy.HTML.Internal.Entity.Tests@@ -29,5 +31,7 @@   , testTrie   , testZip   , testQuery+  , testExamples   , testSamples+  , testIssues   ]
zenacy-html.cabal view
@@ -1,5 +1,5 @@ cabal-version: >= 1.10-version: 2.0.7+version: 2.1.0 name:   zenacy-html synopsis:@@ -149,7 +149,10 @@   default-language:     Haskell2010   other-modules:-    Zenacy.HTML.Internal.Buffer.Tests+    Examples+    , Issues+    , Samples+    , Zenacy.HTML.Internal.Buffer.Tests     , Zenacy.HTML.Internal.Entity.Tests     , Zenacy.HTML.Internal.HTML.Tests     , Zenacy.HTML.Internal.Image.Tests@@ -160,7 +163,6 @@     , Zenacy.HTML.Internal.Token.Tests     , Zenacy.HTML.Internal.Trie.Tests     , Zenacy.HTML.Internal.Zip.Tests-    , Samples  benchmark zenacy-html-bench   type: