src/Html.hs

   1 module Html (
   2   html_tests,
   3   replace_entities
   4   )
   5 where
   6
   7 import Test.Framework (Test, testGroup)
   8 import Test.Framework.Providers.HUnit (testCase)
   9 import Test.HUnit (Assertion, assertEqual)
  10 import Text.HTML.TagSoup.Entity (lookupEntity)
  11
  12 replace_entities :: String -> String
  13 replace_entities [] = []
  14 replace_entities ('&':xs) =
  15   let (b, a) = break (== ';') xs in
  16   case (lookupEntity b, a) of
  17     (Just s, ';':as) ->  s ++ replace_entities as
  18     _                -> '&' : replace_entities xs
  19 replace_entities (x:xs) = x : replace_entities xs
  20
  21
  22 html_tests :: Test
  23 html_tests =
  24   testGroup "HTML Tests" [ tc1 ]
  25   where
  26     tc1 = testCase
  27             "All entities are replaced correctly."
  28             test_replace_entities
  29
  30 test_replace_entities :: Assertion
  31 test_replace_entities =
  32   assertEqual description expected_text actual_text
  33   where
  34     description = "All entities are replaced correctly."
  35     actual_text =
  36       replace_entities $
  37         "&quot;The moon is gay&#8230;&hellip;&quot; " ++
  38         "said &lt;insert the current president of the " ++
  39         "United States of America&gt;. &ldquo;It&#8217;s " ++
  40         "OK&mdash;&ndash;he&#8217;s not a real doctor.&rdquo;"
  41     expected_text =
  42       "\"The moon is gay……\" said <insert " ++
  43       "the current president of the United States of America>. " ++
  44       "“It’s OK—–he’s not a real doctor.”"