From: Michael Orlitzky <michael@orlitzky.com>
Date: Wed, 10 Jul 2013 18:01:19 +0000 (-0400)
Subject: Add missing Html.hs from previous commit.
X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=commitdiff_plain;h=e565ae841fa735a1361712eac06cc7ae9be098dc;hp=bbd3f429da0e9e5906f6aecb85f1c00683500428

Add missing Html.hs from previous commit.
---

diff --git a/src/Html.hs b/src/Html.hs
new file mode 100644
index 0000000..1c9a428
--- /dev/null
+++ b/src/Html.hs
@@ -0,0 +1,34 @@
+module Html
+where
+
+import Test.HUnit
+import Text.HTML.TagSoup.Entity (lookupEntity)
+
+replace_entities :: String -> String
+replace_entities [] = []
+replace_entities ('&':xs) =
+  let (b, a) = break (== ';') xs in
+  case (lookupEntity b, a) of
+    (Just c, ';':as) ->  c  : replace_entities as
+    _                -> '&' : replace_entities xs
+replace_entities (x:xs) = x : replace_entities xs
+
+
+html_tests :: [Test]
+html_tests = [ test_replace_entities ]
+
+test_replace_entities :: Test
+test_replace_entities =
+    TestCase $ assertEqual description expected_text actual_text
+    where
+      description = "All entities are replaced correctly."
+      actual_text =
+        replace_entities $
+          "&quot;The moon is gay&#8230;&hellip;&quot; " ++
+          "said &lt;insert the current president of the " ++
+          "United States of America&gt;. &ldquo;It&#8217;s " ++
+          "OK&mdash;&ndash;he&#8217;s not a real doctor.&rdquo;"
+      expected_text =
+        "\"The moon is gay……\" said <insert " ++
+        "the current president of the United States of America>. " ++
+        "“It’s OK—–he’s not a real doctor.”"