Неэкранирование сущностей HTML (включая именованные)

Question

Этот вопрос похож на Удалить html-символьные объекты в строке вопрос, заданный ранее при переполнении стека. Однако принятый ответ не затрагивает проблему именованных сущностей HTML, например, ä для символа ä; Поэтому он не может скрыть весь HTML.

У меня есть наследствоHTML, который использует именованные сущности HTML для не-ASCII символов.То есть ö вместо ö, ä вместо ä и так далее. Полный список всех именованных сущностей HTML доступен в Википедии.

Я бы хотел быстро и эффективно вывести эти HTML-сущности в их символьные эквиваленты.

---

У меня есть код для этого в Python 3 с использованием регулярных выражений:

import re
import html.entities

s = re.sub(r'&(\w+?);', lambda m: chr(html.entities.name2codepoint[m.group(1)]), s)

Однако регулярные выражения не кажутся очень популярными, быстрыми или простыми в использовании на Haskell.

---

Text.HTML.TagSoup.Entity (tagsoup) имеет полезную таблицу и функции для отображения именованных объектов в кодовые точки tpo.Используя этот пакет и пакет regex-tdfa, я создал чрезвычайно медленный эквивалент в Haskell:

{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Lazy.Char8 as L
import Data.ByteString.Lazy.UTF8 as UTF8
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Regex.TDFA ((=~~))

unescapeEntites :: L.ByteString -> L.ByteString
unescapeEntites = regexReplaceBy "&#?[[:alnum:]]+;" $ lookupMatch
 where
  lookupMatch m =
    case lookupEntity (L.unpack . L.tail . L.init $ m) of
      Nothing -> m
      Just x -> UTF8.fromString [x]

-- regex replace taken from http://mutelight.org/articles/generating-a-permalink-slug-in-haskell
regexReplaceBy :: L.ByteString -> (L.ByteString -> L.ByteString) -> L.ByteString -> L.ByteString
regexReplaceBy regex f text = go text []
 where
  go str res =
    if L.null str
      then L.concat . reverse $ res
      else
        case (str =~~ regex) :: Maybe (L.ByteString, L.ByteString, L.ByteString) of
          Nothing -> L.concat . reverse $ (str : res)
          Just (bef, match , aft) -> go aft (f match : bef : res)

Функция unescapeEntities работает на несколько порядков медленнее, чем Pythonверсия выше.Код Python может преобразовать около 130 МБ за 7 секунд, в то время как моя версия на Haskell работает в течение нескольких минут.

Я ищу лучшее решение, прежде всего с точки зрения скорости.Но я также хотел бы избегать регулярных выражений, если это возможно (скорость и избегание регулярных выражений в Хаскеле, похоже, идут рука об руку).

Answer 1

Вот моя версия.Он использует String (вместо ByteString).

import Text.HTML.TagSoup.Entity (lookupEntity)

unescapeEntities :: String -> String
unescapeEntities [] = []
unescapeEntities ('&':xs) = 
  let (b, a) = break (== ';') xs in
  case (lookupEntity b, a) of
    (Just c, ';':as) ->  c  : unescapeEntities as    
    _                -> '&' : unescapeEntities xs
unescapeEntities (x:xs) = x : unescapeEntities xs

Я думаю, это быстрее, потому что он не использует дорогостоящие операции регулярного выражения.Я не проверял это.Вы можете адаптировать его для ByteString или Data.Text, если вам это нужно быстрее.

Answer 2

Вы можете установить пакет web-encodings, взять исходный код функции decodeHtml и добавить нужные вам символы (работает для меня). Это все, что вам нужно:

import Data.Maybe
import qualified Web.Encodings.StringLike as SL
import Web.Encodings.StringLike (StringLike)
import Data.Char (ord)

-- | Decode HTML-encoded content into plain content.
--
-- Note: this does not support all HTML entities available. It also swallows
-- all failures.
decodeHtml :: StringLike s => s -> s
decodeHtml s = case SL.uncons s of
    Nothing -> SL.empty
    Just ('&', xs) -> fromMaybe ('&' `SL.cons` decodeHtml xs) $ do
        (before, after) <- SL.breakCharMaybe ';' xs
        c <- case SL.unpack before of -- this are small enough that unpack is ok
            "lt" -> return '<'
            "gt" -> return '>'
            "amp" -> return '&'
            "quot" -> return '"'
            '#' : 'x' : hex -> readHexChar hex
            '#' : 'X' : hex -> readHexChar hex
            '#' : dec -> readDecChar dec
            _ -> Nothing -- just to shut up a warning
        return $ c `SL.cons` decodeHtml after
    Just (x, xs) -> x `SL.cons` decodeHtml xs

readHexChar :: String -> Maybe Char
readHexChar s = helper 0 s where
    helper i "" = return $ toEnum i
    helper i (c:cs) = do
        c' <- hexVal c
        helper (i * 16 + c') cs

hexVal :: Char -> Maybe Int
hexVal c
    | '0' <= c && c <= '9' = Just $ ord c - ord '0'
    | 'A' <= c && c <= 'F' = Just $ ord c - ord 'A' + 10
    | 'a' <= c && c <= 'f' = Just $ ord c - ord 'a' + 10
    | otherwise = Nothing

readDecChar :: String -> Maybe Char
readDecChar s = do
    case reads s of
        (i, _):_ -> Just $ toEnum (i :: Int)
        _ -> Nothing

Хотя я не тестировал производительность. Но это может быть хорошим примером, если вы можете сделать это и без регулярных выражений.