X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FHtml.hs;h=59876a5b5c0e9fd9f782442a7e5232dee4679ca6;hp=2a3b4838b9b22a363b2c80f43476832ee4f3c616;hb=0ed071e75268da9ba8273d5c13817fa1297c94e2;hpb=7bb00e04c15781d889f950d00babf3f183047bff diff --git a/src/Html.hs b/src/Html.hs index 2a3b483..59876a5 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -1,44 +1,39 @@ module Html ( html_tests, - replace_entities - ) + 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.”"