summaryrefslogtreecommitdiff
path: root/Utility/HtmlDetect.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/HtmlDetect.hs')
-rw-r--r--Utility/HtmlDetect.hs25
1 files changed, 18 insertions, 7 deletions
diff --git a/Utility/HtmlDetect.hs b/Utility/HtmlDetect.hs
index 57a56c95f..bf0839e9e 100644
--- a/Utility/HtmlDetect.hs
+++ b/Utility/HtmlDetect.hs
@@ -9,20 +9,20 @@ module Utility.HtmlDetect where
import Text.HTML.TagSoup
import Data.Char
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.Char8 as B8
--- | Detect if a string is a html document.
+-- | Detect if a String is a html document.
--
--- The document many not be valid, and will still be detected as html,
--- as long as it starts with a "<html>" or "<!DOCTYPE html>" tag.
+-- The document many not be valid, or may be truncated, and will
+-- still be detected as html, as long as it starts with a
+-- "<html>" or "<!DOCTYPE html>" tag.
--
-- Html fragments like "<p>this</p>" are not detected as being html,
-- although some browsers may chose to render them as html.
isHtml :: String -> Bool
-isHtml = evaluate . canonicalizeTags . parseTags . shorten
+isHtml = evaluate . canonicalizeTags . parseTags . take htmlPrefixLength
where
- -- We only care about the beginning of the file,
- -- so although tagsoup parses lazily anyway, truncate it.
- shorten = take 16384
evaluate (TagOpen "!DOCTYPE" ((t, _):_):_) = map toLower t == "html"
evaluate (TagOpen "html" _:_) = True
-- Allow some leading whitespace before the tag.
@@ -33,3 +33,14 @@ isHtml = evaluate . canonicalizeTags . parseTags . shorten
-- tag, but easy to allow for.
evaluate (TagComment _:rest) = evaluate rest
evaluate _ = False
+
+-- | Detect if a ByteString is a html document.
+isHtmlBs :: B.ByteString -> Bool
+-- The encoding of the ByteString is not known, but isHtml only
+-- looks for ascii strings.
+isHtmlBs = isHtml . B8.unpack
+
+-- | How much of the beginning of a html document is needed to detect it.
+-- (conservatively)
+htmlPrefixLength :: Int
+htmlPrefixLength = 8192