packages feed

tagsoup 0.10.1 → 0.11

raw patch · 4 files changed

+125/−114 lines, 4 files

Files

TagSoup/Test.hs view
@@ -103,11 +103,12 @@ parseTests :: Test () parseTests = do     parseTags "<!DOCTYPE TEST>" === [TagOpen "!DOCTYPE" [("TEST","")]]-    parseTags "<test \"foo bar\">" === [TagOpen "test" [("","foo bar")]]-    parseTags "<test baz \"foo\">" === [TagOpen "test" [("baz",""),("","foo")]]-    parseTags "<test \'foo bar\'>" === [TagOpen "test" [("","foo bar")]]+    parseTags "<test \"foo bar\">" === [TagOpen "test" [("\"foo",""),("bar\"","")]]+    parseTags "<test baz \"foo\">" === [TagOpen "test" [("baz",""),("\"foo\"","")]]+    parseTags "<test 'foo bar'>" === [TagOpen "test" [("'foo",""),("bar'","")]]+    parseTags "<test bar=''' />" === [TagOpen "test" [("bar",""),("'","")], TagClose "test"]     parseTags "<test2 a b>" === [TagOpen "test2" [("a",""),("b","")]]-    parseTags "<test2 ''>" === [TagOpen "test2" [("","")]]+    parseTags "<test2 ''>" === [TagOpen "test2" [("''","")]]     parseTags "</test foo>" === [TagClose "test"]     parseTags "<test/>" === [TagOpen "test" [], TagClose "test"]     parseTags "<test1 a = b>" === [TagOpen "test1" [("a","b")]]@@ -137,6 +138,11 @@      parseTags "<test><![CDATA[Anything goes, <em>even hidden markup</em> &amp; entities]]> but this is outside</test>" ===         [TagOpen "test" [],TagText "Anything goes, <em>even hidden markup</em> &amp; entities but this is outside",TagClose "test"]++    parseTags "<a \r\n href=\"url\">" === [TagOpen "a" [("href","url")]]++    parseTags "<a href='random.php'><img src='strips/130307.jpg' alt='nukular bish'' title='' /></a>" === +        [TagOpen "a" [("href","random.php")],TagOpen "img" [("src","strips/130307.jpg"),("alt","nukular bish"),("'",""),("title","")],TagClose "img",TagClose "a"]   optionsTests :: Test ()
Text/HTML/TagSoup/Specification.hs view
@@ -5,27 +5,35 @@ import Text.HTML.TagSoup.Implementation import Data.Char --white x = x `elem` "\t\n\f "- -- We make some generalisations: -- <!name is a valid tag start closed by > -- <?name is a valid tag start closed by ?> -- </!name> is a valid closing tag -- </?name> is a valid closing tag--- <a "foo"> is a valid tag attibute, i.e missing an attribute name+-- <a "foo"> is a valid tag attibute in ! and ?, i.e missing an attribute name -- We also don't do lowercase conversion -- Entities are handled without a list of known entity names -- We don't have RCData, CData or Escape modes (only effects dat and tagOpen) --- 9.2.4 Tokenization +data TypeTag = TypeNormal -- <foo+             | TypeXml    -- <?foo+             | TypeDecl   -- <!foo+               deriving Eq+++-- 2.4.1 Common parser idioms+white x = x `elem` " \t\n\f\r"+++-- 8.2.4 Tokenization+ type Parser = S -> [Out]  parse :: String -> [Out] parse = dat . state  --- 9.2.4.1 Data state+-- 8.2.4.1 Data state dat :: Parser dat S{..} = pos $ case hd of     '&' -> charReference tl@@ -34,15 +42,15 @@     _ -> hd & dat tl  --- 9.2.4.2 Character reference data state+-- 8.2.4.2 Character reference data state charReference s = charRef dat False Nothing s  --- 9.2.4.3 Tag open state+-- 8.2.4.3 Tag open state tagOpen S{..} = case hd of     '!' -> markupDeclOpen tl     '/' -> closeTagOpen tl-    _ | isAlpha hd -> Tag & hd & tagName False tl+    _ | isAlpha hd -> Tag & hd & tagName TypeNormal tl     '>' -> errSeen "<>" & '<' & '>' & dat tl     '?' -> neilXmlTagOpen tl -- NEIL     _ -> errSeen  "<" & '<' & dat s@@ -50,147 +58,147 @@  -- seen "<?", emitted [] neilXmlTagOpen S{..} = pos $ case hd of-    _ | isAlpha hd -> Tag & '?' & hd & tagName True tl+    _ | isAlpha hd -> Tag & '?' & hd & tagName TypeXml tl     _ -> errSeen "<?" & '<' & '?' & dat s  -- seen "?", expecting ">" neilXmlTagClose S{..} = pos $ case hd of     '>' -> TagEnd & dat tl-    _ -> errSeen "?" & beforeAttName True s+    _ -> errSeen "?" & beforeAttName TypeXml s   -- just seen ">" at the end, am given tl-neilTagEnd xml S{..}-    | xml = pos $ errWant "?>" & TagEnd & dat s+neilTagEnd typ S{..}+    | typ == TypeXml = pos $ errWant "?>" & TagEnd & dat s     | otherwise = pos $ TagEnd & dat s  --- 9.2.4.4 Close tag open state+-- 8.2.4.4 Close tag open state -- Deviation: We ignore the if CDATA/RCDATA bits and tag matching -- Deviation: On </> we output </> to the text -- Deviation: </!name> is a closing tag, not a bogus comment closeTagOpen S{..} = case hd of-    _ | isAlpha hd || hd `elem` "?!" -> TagShut & hd & tagName False tl+    _ | isAlpha hd || hd `elem` "?!" -> TagShut & hd & tagName TypeNormal tl     '>' -> errSeen "</>" & '<' & '/' & '>' & dat tl     _ | eof -> '<' & '/' & dat s     _ -> errWant "tag name" & bogusComment s  --- 9.2.4.5 Tag name state-tagName xml S{..} = pos $ case hd of-    _ | white hd -> beforeAttName xml tl-    '/' -> selfClosingStartTag xml tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl-    _ | isAlpha hd -> hd & tagName xml tl-    _ | eof -> errWant (if xml then "?>" else ">") & dat s-    _ -> hd & tagName xml tl+-- 8.2.4.5 Tag name state+tagName typ S{..} = pos $ case hd of+    _ | white hd -> beforeAttName typ tl+    '/' -> selfClosingStartTag typ tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl+    _ | isAlpha hd -> hd & tagName typ tl+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s+    _ -> hd & tagName typ tl  --- 9.2.4.6 Before attribute name state-beforeAttName xml S{..} = pos $ case hd of-    _ | white hd -> beforeAttName xml tl-    '/' -> selfClosingStartTag xml tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl-    _ | hd `elem` "\'\"" -> beforeAttValue xml s -- NEIL-    _ | hd `elem` "\"'<=" -> errSeen [hd] & AttName & hd & attName xml tl-    _ | eof -> errWant (if xml then "?>" else ">") & dat s-    _ -> AttName & hd & attName xml tl+-- 8.2.4.6 Before attribute name state+beforeAttName typ S{..} = pos $ case hd of+    _ | white hd -> beforeAttName typ tl+    '/' -> selfClosingStartTag typ tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl+    _ | typ /= TypeNormal && hd `elem` "\'\"" -> beforeAttValue typ s -- NEIL+    _ | hd `elem` "\"'<=" -> errSeen [hd] & AttName & hd & attName typ tl+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s+    _ -> AttName & hd & attName typ tl  --- 9.2.4.7 Attribute name state-attName xml S{..} = pos $ case hd of-    _ | white hd -> afterAttName xml tl-    '/' -> selfClosingStartTag xml tl-    '=' -> beforeAttValue xml tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl+-- 8.2.4.7 Attribute name state+attName typ S{..} = pos $ case hd of+    _ | white hd -> afterAttName typ tl+    '/' -> selfClosingStartTag typ tl+    '=' -> beforeAttValue typ tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl     _ | hd `elem` "\"'<" -> errSeen [hd] & def-    _ | eof -> errWant (if xml then "?>" else ">") & dat s+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s     _ -> def-    where def = hd & attName xml tl+    where def = hd & attName typ tl  --- 9.2.4.8 After attribute name state-afterAttName xml S{..} = pos $ case hd of-    _ | white hd -> afterAttName xml tl-    '/' -> selfClosingStartTag xml tl-    '=' -> beforeAttValue xml tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl-    _ | hd `elem` "\"'" -> AttVal & beforeAttValue xml s -- NEIL+-- 8.2.4.8 After attribute name state+afterAttName typ S{..} = pos $ case hd of+    _ | white hd -> afterAttName typ tl+    '/' -> selfClosingStartTag typ tl+    '=' -> beforeAttValue typ tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl+    _ | typ /= TypeNormal && hd `elem` "\"'" -> AttVal & beforeAttValue typ s -- NEIL     _ | hd `elem` "\"'<" -> errSeen [hd] & def-    _ | eof -> errWant (if xml then "?>" else ">") & dat s+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s     _ -> def-    where def = AttName & hd & attName xml tl+    where def = AttName & hd & attName typ tl --- 9.2.4.9 Before attribute value state-beforeAttValue xml S{..} = pos $ case hd of-    _ | white hd -> beforeAttValue xml tl-    '\"' -> AttVal & attValueDQuoted xml tl-    '&' -> AttVal & attValueUnquoted xml s-    '\'' -> AttVal & attValueSQuoted xml tl-    '>' -> errSeen "=" & neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl+-- 8.2.4.9 Before attribute value state+beforeAttValue typ S{..} = pos $ case hd of+    _ | white hd -> beforeAttValue typ tl+    '\"' -> AttVal & attValueDQuoted typ tl+    '&' -> AttVal & attValueUnquoted typ s+    '\'' -> AttVal & attValueSQuoted typ tl+    '>' -> errSeen "=" & neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl     _ | hd `elem` "<=" -> errSeen [hd] & def-    _ | eof -> errWant (if xml then "?>" else ">") & dat s+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s     _ -> def-    where def = AttVal & hd & attValueUnquoted xml tl+    where def = AttVal & hd & attValueUnquoted typ tl  --- 9.2.4.10 Attribute value (double-quoted) state-attValueDQuoted xml S{..} = pos $ case hd of-    '\"' -> afterAttValueQuoted xml tl-    '&' -> charRefAttValue (attValueDQuoted xml) (Just '\"') tl+-- 8.2.4.10 Attribute value (double-quoted) state+attValueDQuoted typ S{..} = pos $ case hd of+    '\"' -> afterAttValueQuoted typ tl+    '&' -> charRefAttValue (attValueDQuoted typ) (Just '\"') tl     _ | eof -> errWant "\"" & dat s-    _ -> hd & attValueDQuoted xml tl+    _ -> hd & attValueDQuoted typ tl  --- 9.2.4.11 Attribute value (single-quoted) state-attValueSQuoted xml S{..} = pos $ case hd of-    '\'' -> afterAttValueQuoted xml tl-    '&' -> charRefAttValue (attValueSQuoted xml) (Just '\'') tl+-- 8.2.4.11 Attribute value (single-quoted) state+attValueSQuoted typ S{..} = pos $ case hd of+    '\'' -> afterAttValueQuoted typ tl+    '&' -> charRefAttValue (attValueSQuoted typ) (Just '\'') tl     _ | eof -> errWant "\'" & dat s-    _ -> hd & attValueSQuoted xml tl+    _ -> hd & attValueSQuoted typ tl  --- 9.2.4.12 Attribute value (unquoted) state-attValueUnquoted xml S{..} = pos $ case hd of-    _ | white hd -> beforeAttName xml tl-    '&' -> charRefAttValue (attValueUnquoted xml) Nothing tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl+-- 8.2.4.12 Attribute value (unquoted) state+attValueUnquoted typ S{..} = pos $ case hd of+    _ | white hd -> beforeAttName typ tl+    '&' -> charRefAttValue (attValueUnquoted typ) Nothing tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl     _ | hd `elem` "\"'<=" -> errSeen [hd] & def-    _ | eof -> errWant (if xml then "?>" else ">") & dat s+    _ | eof -> errWant (if typ == TypeXml then "?>" else ">") & dat s     _ -> def-    where def = hd & attValueUnquoted xml tl+    where def = hd & attValueUnquoted typ tl  --- 9.2.4.13 Character reference in attribute value state+-- 8.2.4.13 Character reference in attribute value state charRefAttValue :: Parser -> Maybe Char -> Parser charRefAttValue resume c s = charRef resume True c s  --- 9.2.4.14 After attribute value (quoted) state-afterAttValueQuoted xml S{..} = pos $ case hd of-    _ | white hd -> beforeAttName xml tl-    '/' -> selfClosingStartTag xml tl-    '>' -> neilTagEnd xml tl-    '?' | xml -> neilXmlTagClose tl+-- 8.2.4.14 After attribute value (quoted) state+afterAttValueQuoted typ S{..} = pos $ case hd of+    _ | white hd -> beforeAttName typ tl+    '/' -> selfClosingStartTag typ tl+    '>' -> neilTagEnd typ tl+    '?' | typ == TypeXml -> neilXmlTagClose tl     _ | eof -> dat s-    _ -> errSeen [hd] & beforeAttName xml s+    _ -> errSeen [hd] & beforeAttName typ s  --- 9.2.4.15 Self-closing start tag state-selfClosingStartTag xml S{..} = pos $ case hd of-    _ | xml -> errSeen "/" & beforeAttName xml s+-- 8.2.4.15 Self-closing start tag state+selfClosingStartTag typ S{..} = pos $ case hd of+    _ | typ == TypeXml -> errSeen "/" & beforeAttName typ s     '>' -> TagEndClose & dat tl     _ | eof -> errWant ">" & dat s-    _ -> errSeen "/" & beforeAttName xml s+    _ -> errSeen "/" & beforeAttName typ s  --- 9.2.4.16 Bogus comment state+-- 8.2.4.16 Bogus comment state bogusComment S{..} = Comment & bogusComment1 s bogusComment1 S{..} = pos $ case hd of     '>' -> CommentEnd & dat tl@@ -198,15 +206,15 @@     _ -> hd & bogusComment1 tl  --- 9.2.4.17 Markup declaration open state+-- 8.2.4.17 Markup declaration open state markupDeclOpen S{..} = pos $ case hd of     _ | Just s <- next "--" -> Comment & commentStart s-    _ | isAlpha hd -> Tag & '!' & hd & tagName False tl -- NEIL+    _ | isAlpha hd -> Tag & '!' & hd & tagName TypeDecl tl -- NEIL     _ | Just s <- next "[CDATA[" -> cdataSection s     _ -> errWant "tag name" & bogusComment s  --- 9.2.4.18 Comment start state+-- 8.2.4.18 Comment start state commentStart S{..} = pos $ case hd of     '-' -> commentStartDash tl     '>' -> errSeen "<!-->" & CommentEnd & dat tl@@ -214,7 +222,7 @@     _ -> hd & comment tl  --- 9.2.4.19 Comment start dash state+-- 8.2.4.19 Comment start dash state commentStartDash S{..} = pos $ case hd of     '-' -> commentEnd tl     '>' -> errSeen "<!--->" & CommentEnd & dat tl@@ -222,21 +230,21 @@     _ -> '-' & hd & comment tl  --- 9.2.4.20 Comment state+-- 8.2.4.20 Comment state comment S{..} = pos $ case hd of     '-' -> commentEndDash tl     _ | eof -> errWant "-->" & CommentEnd & dat s     _ -> hd & comment tl  --- 9.2.4.21 Comment end dash state+-- 8.2.4.21 Comment end dash state commentEndDash S{..} = pos $ case hd of     '-' -> commentEnd tl     _ | eof -> errWant "-->" & CommentEnd & dat s     _ -> '-' & hd & comment tl  --- 9.2.4.22 Comment end state+-- 8.2.4.22 Comment end state commentEnd S{..} = pos $ case hd of     '>' -> CommentEnd & dat tl     '-' -> errWant "-->" & '-' & commentEnd tl@@ -246,7 +254,7 @@     _ -> errSeen "--" & '-' & '-' & hd & comment tl  --- 9.2.4.23 Comment end bang state+-- 8.2.4.23 Comment end bang state commentEndBang S{..} = pos $ case hd of     '>' -> CommentEnd & dat tl     '-' -> '-' & '-' & '!' & commentEndDash tl@@ -254,7 +262,7 @@     _ -> '-' & '-' & '!' & hd & comment tl  --- 9.2.4.24 Comment end space state+-- 8.2.4.24 Comment end space state commentEndSpace S{..} = pos $ case hd of     '>' -> CommentEnd & dat tl     '-' -> commentEndDash tl@@ -263,14 +271,14 @@     _ -> hd & comment tl  --- 9.2.4.38 CDATA section state+-- 8.2.4.38 CDATA section state cdataSection S{..} = pos $ case hd of     _ | Just s <- next "]]>" -> dat s     _ | eof -> dat s     _ | otherwise -> hd & cdataSection tl  --- 9.2.4.39 Tokenizing character references+-- 8.2.4.39 Tokenizing character references -- Change from spec: this is reponsible for writing '&' if nothing is to be written charRef :: Parser -> Bool -> Maybe Char -> S -> [Out] charRef resume att end S{..} = pos $ case hd of
Text/HTML/TagSoup/Tree.hs view
@@ -1,14 +1,11 @@ {-|     /NOTE/: This module is preliminary and may change at a future date.-    If you wish to use its features, please email me and I will-    help evolve an API that suits you.      This module is intended to help converting a list of tags into a     tree of tags. -}  module Text.HTML.TagSoup.Tree-    {-# DEPRECATED "Not quite ready for use yet, email me if it looks useful to you" #-}     (     TagTree(..), tagTree,     flattenTree, transformTree, universeTree@@ -20,7 +17,7 @@  data TagTree str = TagBranch str [Attribute str] [TagTree str]                  | TagLeaf (Tag str)-                   deriving Show+                   deriving (Eq,Ord,Show)  instance Functor TagTree where     fmap f (TagBranch x y z) = TagBranch (f x) (map (f***f) y) (map (fmap f) z)
tagsoup.cabal view
@@ -1,6 +1,6 @@ cabal-version:  >= 1.6 name:           tagsoup-version:        0.10.1+version:        0.11 copyright:      Neil Mitchell 2006-2010 author:         Neil Mitchell <ndmitchell@gmail.com> maintainer:     Neil Mitchell <ndmitchell@gmail.com>