X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FHtml.hs;h=3abd82b037879becf76d8f22bab2c45de50ddd3f;hb=dad4547feb83fcc2035df684936cedba6272a86f;hp=2f9332522292d34bbed8f7d4abc8d8a890e09ea8;hpb=4cc476a2714260980899ca5358196bbf5226b3c2;p=dead%2Fhalcyon.git

diff --git a/src/Html.hs b/src/Html.hs
index 2f93325..3abd82b 100644
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -1,41 +1,67 @@
-module Html
+module Html (
+  html_tests,
+  replace_entities )
 where
 
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, assertEqual)
-import Text.HTML.TagSoup.Entity (lookupEntity)
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.HTML.TagSoup.Entity ( lookupEntity )
 
+
+-- | Replace (x)html entities in a 'String'. To do this, we search
+--   through the string looking for ampersands which may indicate the
+--   beginning of an entity.
+--
+--   If we find one and there's a semicolon after it, we attempt to
+--   look up the identifier that we found between the ampersand and
+--   the semicolon. If an entity is found, we replace the ampersand,
+--   semicolon, and everything in between with the entity. However if
+--   no corresponding entity is found, we leave everything alone.
+--
+--   Examples:
+--
+--   >>> replace_entities "Hello, world!"
+--   "Hello, world!"
+--
+--   >>> replace_entities "Hello; world!"
+--   "Hello; world!"
+--
+--   >>> replace_entities "Hello, world & other worlds!"
+--   "Hello, world & other worlds!"
+--
+--   >>> replace_entities "Hello, world & other worlds; hello indeed!"
+--   "Hello, world & other worlds; hello indeed!"
+--
+--   >>> putStrLn $ replace_entities "Hello world—I guess"
+--   Hello world—I guess
+--
 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
+    (Just s, ';':as) ->  s ++ replace_entities as
     _                -> '&' : replace_entities xs
 replace_entities (x:xs) = x : replace_entities xs
 
 
-html_tests :: Test
+html_tests :: TestTree
 html_tests =
-  testGroup "HTML Tests" [ tc1 ]
-  where
-    tc1 = testCase
-            "All entities are replaced correctly."
-            test_replace_entities
+  testGroup "HTML Tests" [ test_replace_entities ]
+
 
-test_replace_entities :: Assertion
+test_replace_entities :: TestTree
 test_replace_entities =
-  assertEqual description expected_text actual_text
+  testCase description $ actual @?= expected
   where
-    description = "All entities are replaced correctly."
-    actual_text =
+    description = "all entities are replaced correctly."
+    actual =
       replace_entities $
         ""The moon is gay……" " ++
         "said <insert the current president of the " ++
         "United States of America>. “It’s " ++
         "OK—–he’s not a real doctor.”"
-    expected_text =
+    expected =
       "\"The moon is gay……\" said <insert " ++
       "the current president of the United States of America>. " ++
       "“It’s OK—–he’s not a real doctor.”"