unescapeHtml :: String -> String
unescapeHtml = loop
  where
    loop []       = []
    loop ('&':cs) = unescape cs
    loop (c:cs)   = c : loop cs

    entities = H.fromList [("lt", '<'), ("gt", '>'), ("amp", '&'), ("quot", '"')]

    unescape cs = case break (== ';') cs of
        (_, [])      -> []
        ('#':x:hex, _:cs') | x `elem` ['x', 'X'] -> case readHex hex of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        ('#':dec, _:cs') -> case reads dec of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        (ent, _:cs') -> case H.lookup ent entities of
            Just c  -> c : loop cs'
            Nothing -> loop cs'
unescapeHtml :: String -> String
unescapeHtml = loop
  where
    loop []       = []
    loop ('&':cs) = unescape cs
    loop (c:cs)   = c : loop cs

    entities = H.fromList [("lt", '<'), ("gt", '>'), ("amp", '&'), ("quot", '"')]

    unescape cs = case break (== ';') cs of
        (_, [])      -> []
        ('#':x:hex, _:cs') | x `elem` ['x', 'X'] -> case readHex hex of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        ('#':dec, _:cs') -> case reads dec of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        (ent, _:cs') -> case H.lookup ent entities of
            Just c  -> c : loop cs'
            Nothing -> loop cs'
unescapeHtml = loop
  where
    loop []       = []
    loop ('&':cs) = unescape cs
    loop (c:cs)   = c : loop cs

    entities = H.fromList [("lt", '<'), ("gt", '>'), ("amp", '&'), ("quot", '"')]

    unescape cs = case break (== ';') cs of
        (_, [])      -> []
        ('#':x:hex, _:cs') | x `elem` ['x', 'X'] -> case readHex hex of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        ('#':dec, _:cs') -> case reads dec of
            [(n, [])] -> toEnum n : loop cs'
            _         -> loop cs'
        (ent, _:cs') -> case H.lookup ent entities of
            Just c  -> c : loop cs'
            Nothing -> loop cs'