Handle mixed case void tags (fixes snoyberg#167)

snoyberg · snoyberg · commit 7b4037369c11 · 2021-08-16T07:11:34.000+03:00
diff --git a/html-conduit/ChangeLog.md b/html-conduit/ChangeLog.md
@@ -1,5 +1,9 @@
 # ChangeLog for `html-conduit`
 
+## 1.3.2.2
+
+* Fix handling of mixed case void tags [#167](https://github.com/snoyberg/xml/issues/167)
+
 ## 1.3.2.1
 
 * Allow xml-conduit 1.9
diff --git a/html-conduit/html-conduit.cabal b/html-conduit/html-conduit.cabal
@@ -1,5 +1,5 @@
 Name:                html-conduit
-Version:             1.3.2.1
+Version:             1.3.2.2
 Synopsis:            Parse HTML documents using xml-conduit datatypes.
 Description:         This package uses tagstream-conduit for its parser. It automatically balances mismatched tags, so that there shouldn't be any parse failures. It does not handle a full HTML document rendering, such as adding missing html and head tags. Note that, since version 1.3.1, it uses an inlined copy of tagstream-conduit with entity decoding bugfixes applied.
 Homepage:            https://github.com/snoyberg/xml
diff --git a/html-conduit/src/Text/HTML/DOM.hs b/html-conduit/src/Text/HTML/DOM.hs
@@ -77,7 +77,10 @@ eventConduit' =
     toName l = XT.Name l Nothing Nothing
     closeStack = mapM_ (yield . XT.EventEndElement)
 
-    isVoid = flip Set.member $ Set.fromList
+    isVoid name = Set.member (T.toLower name) voidSet
+
+voidSet :: Set.Set T.Text
+voidSet = Set.fromList
         [ "area"
         , "base"
         , "br"
diff --git a/html-conduit/test/main.hs b/html-conduit/test/main.hs
@@ -97,6 +97,23 @@ main = hspec $ do
                         ]
                     ]
              in H.parseLBS html @?= doc
+        it "Mixed case br #167" $
+            let html = "<html><head><title>foo</title></head><body><bR><p>Hello World</p><BR>done</body></html>"
+                doc = X.Document (X.Prologue [] Nothing []) root []
+                root = X.Element "html" Map.empty
+                    [ X.NodeElement $ X.Element "head" Map.empty
+                        [ X.NodeElement $ X.Element "title" Map.empty
+                            [X.NodeContent "foo"]
+                        ]
+                    , X.NodeElement $ X.Element "body" Map.empty
+                        [ X.NodeElement $ X.Element "bR" Map.empty []
+                        , X.NodeElement $ X.Element "p" Map.empty
+                            [X.NodeContent "Hello World"]
+                        , X.NodeElement $ X.Element "BR" Map.empty []
+                        , X.NodeContent "done"
+                        ]
+                    ]
+             in H.parseLBS html @?= doc
 
     it "doesn't double unescape" $
         let html = "<p>Hello &amp;gt; World</p>"
diff --git a/stack.yaml b/stack.yaml
@@ -1,5 +1,5 @@
+resolver: lts-18.5
 packages:
 - xml-conduit/
 - xml-hamlet/
 - html-conduit/
-resolver: lts-17.4
