X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FHtml.hs;h=59876a5b5c0e9fd9f782442a7e5232dee4679ca6;hp=2f9332522292d34bbed8f7d4abc8d8a890e09ea8;hb=e3864f89a0cae34d4d280efeb52ea5f761ddb44a;hpb=4cc476a2714260980899ca5358196bbf5226b3c2 diff --git a/src/Html.hs b/src/Html.hs index 2f93325..59876a5 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -1,41 +1,39 @@ -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_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 . " ++ "“It’s OK—–he’s not a real doctor.”"