X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FHtml.hs;h=3abd82b037879becf76d8f22bab2c45de50ddd3f;hp=f1671a8e57f0fb0401ec7cea8ec5d765a42a6ba3;hb=1b72ed45ef890ed1329a32457b4d7f3a7fb37788;hpb=d7c6b5499c0969b6e488d9fc583f93bbb4e3d4c7 diff --git a/src/Html.hs b/src/Html.hs index f1671a8..3abd82b 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -3,11 +3,38 @@ module Html ( replace_entities ) where -import Test.Framework ( Test, testGroup ) -import Test.Framework.Providers.HUnit ( testCase ) -import Test.HUnit ( Assertion, assertEqual ) +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) = @@ -18,26 +45,23 @@ 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.”"