@@ -1,6 +1,5 @@
11{-# LANGUAGE LambdaCase #-}
22{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ViewPatterns #-}
43{- |
54 Module : Text.Pandoc.XML
65 Copyright : Copyright (C) 2006-2021 John MacFarlane
@@ -123,23 +122,20 @@ html5EntityMap = foldr go mempty htmlEntities
123122
124123-- Unescapes XML entities
125124fromEntities :: Text -> Text
126−fromEntities = T.pack . fromEntities'
125+fromEntities t
126+ = let (x, y) = T.break (== '&') t
127+ in if T.null y
128+ then t
129+ else x <>
130+ let (ent, rest) = T.break (\c -> isSpace c || c == ';') y
131+ rest' = case T.uncons rest of
132+ Just (';',ys) -> ys
133+ _ -> rest
134+ ent' = T.drop 1 ent <> ";"
135+ in case T.pack <$> lookupEntity (T.unpack ent') of
136+ Just c -> c <> fromEntities rest'
137+ Nothing -> ent <> fromEntities rest
127138
128−fromEntities' :: Text -> String
129−fromEntities' (T.uncons -> Just ('&', xs)) =
130− case lookupEntity $ T.unpack ent' of
131− Just c -> c <> fromEntities' rest
132− Nothing -> "&" <> fromEntities' xs
133− where (ent, rest) = case T.break (\c -> isSpace c || c == ';') xs of
134− (zs,T.uncons -> Just (';',ys)) -> (zs,ys)
135− (zs, ys) -> (zs,ys)
136− ent'
137− | Just ys <- T.stripPrefix "#X" ent = "#x" <> ys -- workaround tagsoup bug
138− | Just ('#', _) <- T.uncons ent = ent
139− | otherwise = ent <> ";"
140−fromEntities' t = case T.uncons t of
141− Just (x, xs) -> x : fromEntities' xs
142− Nothing -> ""
143139
144140html5Attributes :: Set.Set Text
145141html5Attributes = Set.fromList