X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FHtml.hs;h=59876a5b5c0e9fd9f782442a7e5232dee4679ca6;hp=1c9a4285541c720c2c413166f606cb15d5abdc46;hb=0ed071e75268da9ba8273d5c13817fa1297c94e2;hpb=e565ae841fa735a1361712eac06cc7ae9be098dc diff --git a/src/Html.hs b/src/Html.hs index 1c9a428..59876a5 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -1,34 +1,39 @@ -module Html +module Html ( + html_tests, + replace_entities ) where -import Test.HUnit -import Text.HTML.TagSoup.Entity (lookupEntity) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +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 + (Just s, ';':as) -> s ++ replace_entities as _ -> '&' : replace_entities xs replace_entities (x:xs) = x : replace_entities xs -html_tests :: [Test] -html_tests = [ test_replace_entities ] +html_tests :: TestTree +html_tests = + testGroup "HTML Tests" [ test_replace_entities ] -test_replace_entities :: Test + +test_replace_entities :: TestTree test_replace_entities = - TestCase $ assertEqual description expected_text actual_text - where - description = "All entities are replaced correctly." - actual_text = - 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 = - "\"The moon is gay……\" said . " ++ - "“It’s OK—–he’s not a real doctor.”" + testCase description $ actual @?= expected + where + 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 = + "\"The moon is gay……\" said . " ++ + "“It’s OK—–he’s not a real doctor.”"