xmlhtml 0.1.2 → 0.1.3
raw patch · 6 files changed
+112/−113 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- src/Text/XmlHtml/HTML/Meta.hs +0/−3
- src/Text/XmlHtml/HTML/Parse.hs +33/−48
- src/Text/XmlHtml/HTML/Render.hs +10/−20
- test/suite/Text/XmlHtml/Tests.hs +65/−38
- test/xmlhtml-testsuite.cabal +3/−3
- xmlhtml.cabal +1/−1
src/Text/XmlHtml/HTML/Meta.hs view
@@ -23,9 +23,6 @@ rawTextTags :: Set Text rawTextTags = S.fromAscList [ "script", "style" ] -rcdataTags :: Set Text-rcdataTags = S.fromAscList [ "textarea", "title" ]- ------------------------------------------------------------------------------ -- | Tags which can be implicitly ended in case they are the last element in -- their parent. This list actually includes all of the elements that have
src/Text/XmlHtml/HTML/Parse.hs view
@@ -47,37 +47,33 @@ with neither markup nor references, except that they end at the first syntactically valid matching end tag. - 3. HTML RCDATA tags (textarea and title) are parsed as text and references- but no other markup, except that they end at the first syntactically- valid matching end tag.-- 4. End tags need only match their corresponding start tags in a case+ 3. End tags need only match their corresponding start tags in a case insensitive comparison. In case they are different, the start tag is used for the element tag name. - 5. Hexadecimal char references may use &#X...; (capital X) -- DONE+ 4. Hexadecimal char references may use &#X...; (capital X) -- DONE - 6. Attribute names are allowed to consist of any text except for control+ 5. Attribute names are allowed to consist of any text except for control characters, space, '\"', '\'', '>', '/', or '='. - 7. Empty attribute syntax is allowed (an attribute not followed by an eq).+ 6. Empty attribute syntax is allowed (an attribute not followed by an eq). In this case, the attribute value is considered to be the empty string. - 8. Quoted attribute syntax is relaxed to allow any character except for+ 7. Quoted attribute syntax is relaxed to allow any character except for the matching quote. References are allowed. - 9. Attribute values may be unquoted. In this case, the attribute value+ 8. Attribute values may be unquoted. In this case, the attribute value may not contain space, single or double quotes, '=', '<', '>', or '`', and may not be the empty string. It can still contain references. - 10. There are many more character references available.+ 9. There are many more character references available. - 11. Only "ambiguous" ampersands are prohibited in character data. This+ 10. Only "ambiguous" ampersands are prohibited in character data. This means ampersands that parse like character or entity references. - 12. Omittable end tags are inserted automatically.+ 11. Omittable end tags are inserted automatically. - 13. DOCTYPE tags matched with case insensitive keywords.+ 12. DOCTYPE tags matched with case insensitive keywords. -} @@ -136,17 +132,6 @@ --------------------------------------------------------------------------------- | Reads text and references, up until the passed-in parser succeeds.--- (Generally, the passed in parser should be an end tag parser for the--- RCDATA element.)-rcdata :: [Char] -> Parser a -> Parser Node-rcdata cs end = TextNode <$> T.concat <$> P.manyTill part end- where part = takeWhile1 (not . (`elem` cs))- <|> reference- <|> T.singleton <$> P.anyChar--------------------------------------------------------------------------------- -- | When parsing an element, three things can happen (besides failure): -- -- (1) The end tag matches the start tag. This is a Matched.@@ -162,51 +147,50 @@ -- element being parsed. data ElemResult = Matched | ImplicitLast Text- | ImplicitNext Text [(Text, Text)] Bool+ | ImplicitNext Text Text [(Text, Text)] Bool -------------------------------------------------------------------------------finishElement :: Text -> [(Text, Text)] -> Bool -> Parser (Node, ElemResult)-finishElement t a b = do+finishElement :: Text -> Text -> [(Text, Text)] -> Bool+ -> Parser (Node, ElemResult)+finishElement t tbase a b = do if b then return (Element t a [], Matched) else nonEmptyElem where nonEmptyElem- | T.map toLower t `S.member` rawTextTags = do+ | tbase `S.member` rawTextTags = do c <- XML.cdata "<" $ P.try (endTag t) return (Element t a [c], Matched)- | T.map toLower t `S.member` rcdataTags = do- c <- rcdata "&<" $ P.try (endTag t)- return (Element t a [c], Matched)- | T.map toLower t `S.member` endOmittableLast = tagContents optional+ | tbase `S.member` endOmittableLast = tagContents optional | otherwise = tagContents (fmap Just) tagContents modifier = do- (c,r1) <- content (Just t)+ (c,r1) <- content (Just tbase) case r1 of Matched -> do r2 <- modifier (endTag t) case r2 of Nothing -> return (Element t a c, Matched) Just rr -> return (Element t a c, rr)- ImplicitLast tag | T.map toLower tag == T.map toLower t -> do+ ImplicitLast tag | T.toCaseFold tag == T.toCaseFold t -> do return (Element t a c, Matched) end -> do return (Element t a c, end) -------------------------------------------------------------------------------emptyOrStartTag :: Parser (Text, [(Text, Text)], Bool)+emptyOrStartTag :: Parser (Text, Text, [(Text, Text)], Bool) emptyOrStartTag = do t <- P.try $ P.char '<' *> XML.name+ let tbase = T.toLower $ snd $ T.breakOnEnd ":" t a <- many $ P.try $ do XML.whiteSpace attribute when (hasDups a) $ fail "Duplicate attribute names in element" _ <- optional XML.whiteSpace e <- fmap isJust $ optional (P.char '/')- let e' = e || (T.map toLower t `S.member` voidTags)+ let e' = e || (tbase `S.member` voidTags) _ <- P.char '>'- return (t, a, e')+ return (t, tbase, a, e') where hasDups a = length (nub (map fst a)) < length a @@ -268,9 +252,10 @@ endTag s = do _ <- text "</" t <- XML.name- r <- if (T.map toLower s == T.map toLower t)+ let tbase = T.toLower $ snd $ T.breakOnEnd ":" t+ r <- if (T.toCaseFold s == T.toCaseFold t) then return Matched- else if T.map toLower s `S.member` endOmittableLast+ else if tbase `S.member` endOmittableLast then return (ImplicitLast t) else fail $ "mismatched tags: </" ++ T.unpack t ++ "> found inside <" ++ T.unpack s ++ "> tag"@@ -306,17 +291,17 @@ return (n, end) doElement = do- (t,a,b) <- emptyOrStartTag- handle t a b+ (t,tb, a,b) <- emptyOrStartTag+ handle t tb a b - handle t a b = do- if breaksTag t parent- then return ([Nothing], ImplicitNext t a b)+ handle t tb a b = do+ if breaksTag tb parent+ then return ([Nothing], ImplicitNext t tb a b) else do- (n,end) <- finishElement t a b+ (n,end) <- finishElement t tb a b case end of- ImplicitNext t' a' b' -> do- (ns,end') <- handle t' a' b'+ ImplicitNext t' tb' a' b' -> do+ (ns,end') <- handle t' tb' a' b' return (Just n : ns, end') _ -> return ([Just n], end)
src/Text/XmlHtml/HTML/Render.hs view
@@ -60,7 +60,9 @@ | otherwise = fromText e "<!--" `mappend` fromText e t `mappend` fromText e "-->"-node e (Element t a c) = element e t a c+node e (Element t a c) =+ let tbase = T.toLower $ snd $ T.breakOnEnd ":" t+ in element e t tbase a c ------------------------------------------------------------------------------@@ -78,16 +80,16 @@ ------------------------------------------------------------------------------ -- XXX: Should do something to avoid concatting large CDATA sections before -- writing them to the output.-element :: Encoding -> Text -> [(Text, Text)] -> [Node] -> Builder-element e t a c- | t `S.member` voidTags && null c =+element :: Encoding -> Text -> Text -> [(Text, Text)] -> [Node] -> Builder+element e t tb a c+ | tb `S.member` voidTags && null c = fromText e "<" `mappend` fromText e t `mappend` (mconcat $ map (attribute e) a) `mappend` fromText e " />"- | t `S.member` voidTags =+ | tb `S.member` voidTags = error $ T.unpack t ++ " must be empty"- | t `S.member` rawTextTags,+ | tb `S.member` rawTextTags, all isTextNode c, let s = T.concat (map nodeText c), not ("</" `T.append` t `T.isInfixOf` s) =@@ -99,22 +101,10 @@ `mappend` fromText e "</" `mappend` fromText e t `mappend` fromText e ">"- | t `S.member` rawTextTags,+ | tb `S.member` rawTextTags, [ TextNode _ ] <- c = error $ T.unpack t ++ " cannot contain text looking like its end tag"- | t `S.member` rawTextTags =- error $ T.unpack t ++ " cannot contain child elements or comments"- | t `S.member` rcdataTags,- all isTextNode c =- fromText e "<"- `mappend` fromText e t- `mappend` (mconcat $ map (attribute e) a)- `mappend` fromText e ">"- `mappend` mconcat (map (escaped "<&" e . nodeText) c)- `mappend` fromText e "</"- `mappend` fromText e t- `mappend` fromText e ">"- | t `S.member` rcdataTags =+ | tb `S.member` rawTextTags = error $ T.unpack t ++ " cannot contain child elements or comments" | otherwise = fromText e "<"
test/suite/Text/XmlHtml/Tests.hs view
@@ -358,7 +358,6 @@ testIt "caseInsDoctype2 " caseInsDoctype2, testIt "voidEmptyElem " voidEmptyElem, testIt "rawTextElem " rawTextElem,- testIt "rcdataElem " rcdataElem, testIt "endTagCase " endTagCase, testIt "hexEntityCap " hexEntityCap, testIt "laxAttrName " laxAttrName,@@ -409,12 +408,6 @@ TextNode "This<is'\"a]]>test&"] ]) -rcdataElem :: Bool-rcdataElem = parseHTML "" "<textarea>This<is>'\"a]]>test&</textarea>"- == Right (HtmlDocument UTF8 Nothing [Element "textarea" [] [- TextNode "This<is>'\"a]]>test&"]- ])- endTagCase :: Bool endTagCase = parseHTML "" "<testing></TeStInG>" == Right (HtmlDocument UTF8 Nothing [Element "testing" [] []])@@ -735,12 +728,16 @@ testIt "renderHTMLRaw2 " renderHTMLRaw2, testIt "renderHTMLRaw3 " renderHTMLRaw3, testIt "renderHTMLRaw4 " renderHTMLRaw4,- testIt "renderHTMLRcdata " renderHTMLRcdata,- testIt "renderHTMLRcdataMult " renderHTMLRcdataMult,- testIt "renderHTMLRcdata2 " renderHTMLRcdata2, testIt "renderHTMLAmpAttr1 " renderHTMLAmpAttr1, testIt "renderHTMLAmpAttr2 " renderHTMLAmpAttr2,- testIt "renderHTMLAmpAttr3 " renderHTMLAmpAttr3+ testIt "renderHTMLAmpAttr3 " renderHTMLAmpAttr3,+ testIt "renderHTMLQVoid " renderHTMLQVoid,+ testIt "renderHTMLQVoid2 " renderHTMLQVoid2,+ testIt "renderHTMLQRaw " renderHTMLQRaw,+ testIt "renderHTMLQRawMult " renderHTMLQRawMult,+ testIt "renderHTMLQRaw2 " renderHTMLQRaw2,+ testIt "renderHTMLQRaw3 " renderHTMLQRaw3,+ testIt "renderHTMLQRaw4 " renderHTMLQRaw4 ] renderHTMLVoid :: Bool@@ -800,33 +797,6 @@ ] ])) -renderHTMLRcdata :: Bool-renderHTMLRcdata =- toByteString (render (HtmlDocument UTF8 Nothing [- Element "title" [("foo", "bar")] [- TextNode "<testing>/&+</">"- ]- ]))- == "<title foo=\'bar\'><testing>/&+</&quot;></title>"--renderHTMLRcdataMult :: Bool-renderHTMLRcdataMult =- toByteString (render (HtmlDocument UTF8 Nothing [- Element "title" [] [- TextNode "foo",- TextNode "bar"- ]- ]))- == "<title>foobar</title>"--renderHTMLRcdata2 :: Bool-renderHTMLRcdata2 = isBottom $- toByteString (render (HtmlDocument UTF8 Nothing [- Element "title" [] [- Comment "foo"- ]- ]))- renderHTMLAmpAttr1 :: Bool renderHTMLAmpAttr1 = toByteString (render (HtmlDocument UTF8 Nothing [@@ -844,6 +814,63 @@ toByteString (render (HtmlDocument UTF8 Nothing [ Element "body" [("foo", "a e b")] [] ])) == "<body foo=\'a &#x65; b\'></body>"++renderHTMLQVoid :: Bool+renderHTMLQVoid =+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:img" [("src", "foo")] []+ ]))+ == "<foo:img src=\'foo\' />"++renderHTMLQVoid2 :: Bool+renderHTMLQVoid2 = isBottom $+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:img" [] [TextNode "foo"]+ ]))++renderHTMLQRaw :: Bool+renderHTMLQRaw =+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:script" [("type", "text/javascript")] [+ TextNode "<testing>/&+</foo>"+ ]+ ]))+ == "<foo:script type=\'text/javascript\'><testing>/&+</foo></foo:script>"++renderHTMLQRawMult :: Bool+renderHTMLQRawMult =+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:script" [("type", "text/javascript")] [+ TextNode "foo",+ TextNode "bar"+ ]+ ]))+ == "<foo:script type=\'text/javascript\'>foobar</foo:script>"++renderHTMLQRaw2 :: Bool+renderHTMLQRaw2 = isBottom $+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:script" [("type", "text/javascript")] [+ TextNode "</foo:script>"+ ]+ ]))++renderHTMLQRaw3 :: Bool+renderHTMLQRaw3 = isBottom $+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:script" [("type", "text/javascript")] [+ Comment "foo"+ ]+ ]))++renderHTMLQRaw4 :: Bool+renderHTMLQRaw4 = isBottom $+ toByteString (render (HtmlDocument UTF8 Nothing [+ Element "foo:script" [("type", "text/javascript")] [+ TextNode "</foo:scri",+ TextNode "pt>"+ ]+ ])) ------------------------------------------------------------------------------
test/xmlhtml-testsuite.cabal view
@@ -1,5 +1,5 @@ name: xmlhtml-testsuite-version: 0.1.1+version: 0.1.3 build-type: Simple cabal-version: >= 1.6 @@ -13,14 +13,14 @@ QuickCheck >= 2.3.0.2, base == 4.*, blaze-builder == 0.2.*,- blaze-html == 0.3.*,+ blaze-html >= 0.3.2 && < 0.5, bytestring == 0.9.*, containers >= 0.3 && <0.5, parsec >= 3.0 && < 3.2, test-framework >= 0.3.1 && <0.4, test-framework-hunit >= 0.2.5 && <0.3, test-framework-quickcheck2 >= 0.2.6 && < 0.3,- text >= 0.10 && < 0.12+ text >= 0.11 && < 0.12 ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind
xmlhtml.cabal view
@@ -1,5 +1,5 @@ Name: xmlhtml-Version: 0.1.2+Version: 0.1.3 Synopsis: XML parser and renderer with HTML 5 quirks mode Description: Contains renderers and parsers for both XML and HTML 5 document fragments, which share data structures wo that