xmlhtml 0.2.3.4 → 0.2.3.5

raw patch · 22 files changed

+2099/−2133 lines, 22 filesdep +HUnitdep +QuickCheckdep +directorydep ~basedep ~blaze-builderdep ~blaze-htmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HUnit, QuickCheck, directory, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: base, blaze-builder, blaze-html, blaze-markup, bytestring, containers, parsec, text, unordered-containers

API changes (from Hackage documentation)

Files

• README +0/−54
• README.md +57/−0
• src/Text/Blaze/Renderer/XmlHtml.hs +10/−4
• src/Text/XmlHtml/HTML/Meta.hs +3/−0
• src/Text/XmlHtml/HTML/Render.hs +6/−2
• src/Text/XmlHtml/TextParser.hs +3/−0
• src/Text/XmlHtml/XML/Render.hs +7/−2
• test/runTestsAndCoverage.sh +0/−54
• test/src/TestSuite.hs +9/−0
• test/src/Text/XmlHtml/CursorTests.hs +505/−0
• test/src/Text/XmlHtml/DocumentTests.hs +274/−0
• test/src/Text/XmlHtml/OASISTest.hs +183/−0
• test/src/Text/XmlHtml/TestCommon.hs +38/−0
• test/src/Text/XmlHtml/Tests.hs +963/−0
• test/suite/TestSuite.hs +0/−9
• test/suite/Text/XmlHtml/CursorTests.hs +0/−505
• test/suite/Text/XmlHtml/DocumentTests.hs +0/−274
• test/suite/Text/XmlHtml/OASISTest.hs +0/−183
• test/suite/Text/XmlHtml/TestCommon.hs +0/−38
• test/suite/Text/XmlHtml/Tests.hs +0/−963
• test/xmlhtml-testsuite.cabal +0/−28
• xmlhtml.cabal +41/−17

@@ -1,54 +0,0 @@-xmlhtml - XML and HTML 5 parsing and rendering--This library implements both parsers and renderers for XML and HTML 5 document-fragments.  The two share data structures to represent the document tree, so-that you can write code to easily work with either XML or HTML 5.  Convenience-functions are also available to work with the internal data structure in-several natural ways.--Caveats:--- Both parsers are written to parse document fragments, not complete-  documents.  This means that they do not enforce rules about overall-  document structure.  There does not need to be only a single root node,-  and the HTML 5 implementation never inserts any missing start tags.--- The XML parser is incapable of handling processing instructions, or defined-  entities.  If will silently drop processing instructions, and will fail if-  encounters an entity reference for anything by the predefined entities-  (apos, quot, amp, lt, and gt).--- The HTML parser is really an XML parser with HTML 5 quirks mode.  It should-  be just fine for parsing documents that conform to the HTML 5 specification.-  However, it is *not* a compliant HTML 5 parser, as compliant parsers are-  required to be compatible with non-compliant documents in many ways that we-  aren't interested in.  So this is a great basis for a template system, for-  example, but a very poor basis for a web browser or web spider.--To get started, just use the parseHTML or parseXML functions from Text.XmlHtml-to parse a ByteString into a document tree.  On the other side, use render to-write the document tree back to a ByteString.--Working with document trees is easily done in two ways.--1. Text.XmlHtml exports the document tree types (notably, Document and Node)-   and functions like getAttribute, setAttribute, tagName, childNodes, etc. for-   working with them.--2. Text.XmlHtml.Cursor exports a zipper for node forests, which you can use to-   navigate and modify the document tree positionally.--That's it, basically.  This is hopefully a pretty simple package to use.--TO DO Items:--1. Do something better with character encodings.  For now, they are basically-   ignored, and we just use the byte order mark to distinguish between the-   three required encodings.  We should implement the encoding sniffing rules-   for both XML (the <?xml ... ?> declaration) and HTML 5.--2. Benchmark and improve performance of the parsers and renderers.--3. Ensure that rendering always gives an error rather than writing an invalid-   document. (Is this a good idea?  It does limit rendering speed.)-

@@ -0,0 +1,57 @@+xmlhtml - XML and HTML 5 parsing and rendering+----------------------------------------------++[![Build Status](https://travis-ci.org/snapframework/xmlhtml.svg?branch=master)](https://travis-ci.org/snapframework/xmlhtml)++This library implements both parsers and renderers for XML and HTML 5 document+fragments.  The two share data structures to represent the document tree, so+that you can write code to easily work with either XML or HTML 5.  Convenience+functions are also available to work with the internal data structure in+several natural ways.++Caveats:++- Both parsers are written to parse document fragments, not complete+  documents.  This means that they do not enforce rules about overall+  document structure.  There does not need to be only a single root node,+  and the HTML 5 implementation never inserts any missing start tags.++- The XML parser is incapable of handling processing instructions, or defined+  entities.  If will silently drop processing instructions, and will fail if+  encounters an entity reference for anything by the predefined entities+  (apos, quot, amp, lt, and gt).++- The HTML parser is really an XML parser with HTML 5 quirks mode.  It should+  be just fine for parsing documents that conform to the HTML 5 specification.+  However, it is *not* a compliant HTML 5 parser, as compliant parsers are+  required to be compatible with non-compliant documents in many ways that we+  aren't interested in.  So this is a great basis for a template system, for+  example, but a very poor basis for a web browser or web spider.++To get started, just use the parseHTML or parseXML functions from Text.XmlHtml+to parse a ByteString into a document tree.  On the other side, use render to+write the document tree back to a ByteString.++Working with document trees is easily done in two ways.++1. Text.XmlHtml exports the document tree types (notably, Document and Node)+   and functions like getAttribute, setAttribute, tagName, childNodes, etc. for+   working with them.++2. Text.XmlHtml.Cursor exports a zipper for node forests, which you can use to+   navigate and modify the document tree positionally.++That's it, basically.  This is hopefully a pretty simple package to use.++TO DO Items:++1. Do something better with character encodings.  For now, they are basically+   ignored, and we just use the byte order mark to distinguish between the+   three required encodings.  We should implement the encoding sniffing rules+   for both XML (the <?xml ... ?> declaration) and HTML 5.++2. Benchmark and improve performance of the parsers and renderers.++3. Ensure that rendering always gives an error rather than writing an invalid+   document. (Is this a good idea?  It does limit rendering speed.)+

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP               #-}+ -- | Renderer that supports rendering to xmlhtml forests.  This is a port of -- the Hexpat renderer. --@@ -8,11 +10,11 @@ module Text.Blaze.Renderer.XmlHtml (renderHtml, renderHtmlNodes) where  import           Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import qualified Data.Text           as T+import qualified Data.Text.Encoding  as T import           Text.Blaze.Html-import           Text.Blaze.Internal-import           Text.XmlHtml+import           Text.Blaze.Internal as TBI+import           Text.XmlHtml        as X   -- | Render a 'ChoiceString' to Text. This is only meant to be used for@@ -66,6 +68,10 @@         go ((fromChoiceStringText key, fromChoiceStringText value) : attrs)            content     go _ (Content content) = fromChoiceString content+#if MIN_VERSION_blaze_markup(0,6,3)+    go _ (TBI.Comment comment) =+        (X.Comment (fromChoiceStringText comment) :)+#endif     go attrs (Append h1 h2) = go attrs h1 . go attrs h2     go _ Empty = id     {-# NOINLINE go #-}

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -O0 -fno-case-merge -fno-strictness -fno-cse #-}+{-# LANGUAGE CPP                         #-} {-# LANGUAGE OverloadedStrings           #-}  module Text.XmlHtml.HTML.Meta@@ -10,7 +11,9 @@   , predefinedRefs   ) where +#if !MIN_VERSION_base(4,8,0) import           Data.Monoid+#endif import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import           Data.HashSet (HashSet)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards     #-} @@ -6,7 +7,6 @@ import           Blaze.ByteString.Builder import           Control.Applicative import           Data.Maybe-import           Data.Monoid import qualified Text.Parsec as P import           Text.XmlHtml.Common import           Text.XmlHtml.TextParser@@ -19,6 +19,10 @@  import qualified Data.HashSet as S +#if !MIN_VERSION_base(4,8,0)+import           Data.Monoid+#endif+ ------------------------------------------------------------------------------ -- | And, the rendering code. render :: Encoding -> Maybe DocType -> [Node] -> Builder@@ -82,7 +86,7 @@ firstNode e (Element t a c) = node e (Element t a c) firstNode _ (TextNode "")   = mempty firstNode e (TextNode t)    = let (c,t') = fromJust $ T.uncons t-                              in escaped "<>& \t\r\n" e (T.singleton c)+                              in escaped "<>& \t\r" e (T.singleton c)                                  `mappend` node e (TextNode t')  

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -16,7 +17,9 @@ , module Text.Parsec.Text ) where +#if !MIN_VERSION_base(4,8,0) import           Control.Applicative+#endif import           Data.Char import           Data.Maybe import           Text.XmlHtml.Common

@@ -1,3 +1,5 @@++{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}  module Text.XmlHtml.XML.Render where@@ -5,13 +7,16 @@ import           Blaze.ByteString.Builder import           Data.Char import           Data.Maybe-import           Data.Monoid import           Text.XmlHtml.Common  import           Data.Text (Text) import qualified Data.Text as T +#if !MIN_VERSION_base(4,8,0)+import           Data.Monoid+#endif + ------------------------------------------------------------------------------ render :: Encoding -> Maybe DocType -> [Node] -> Builder render e dt ns = byteOrder@@ -106,7 +111,7 @@ firstNode e (Element t a c) = node e (Element t a c) firstNode _ (TextNode "")   = mempty firstNode e (TextNode t)    = let (c,t') = fromJust $ T.uncons t-                              in escaped "<>& \t\r\n" e (T.singleton c)+                              in escaped "<>& \t\r" e (T.singleton c)                                  `mappend` node e (TextNode t')  

@@ -1,54 +0,0 @@-#!/bin/sh--set -e--if [ -z "$DEBUG" ]; then-    export DEBUG="testsuite"-fi--SUITE=./dist/build/testsuite/testsuite--export LC_ALL=C-export LANG=C--rm -f testsuite.tix--if [ ! -f $SUITE ]; then-    cat <<EOF-Testsuite executable not found, please run:-    cabal configure -ftest-then-    cabal build-EOF-    exit;-fi--./dist/build/testsuite/testsuite -j4 -a1000 $*--DIR=dist/hpc--rm -Rf $DIR-mkdir -p $DIR--EXCLUDES='Main-Text.XmlHtml.HTML.Meta-Text.XmlHtml.DocumentTests-Text.XmlHtml.CursorTests-Text.XmlHtml.OASISTest-Text.XmlHtml.TestCommon-Text.XmlHtml.Tests'--EXCL=""--for m in $EXCLUDES; do-    EXCL="$EXCL --exclude=$m"-done--hpc markup $EXCL --destdir=$DIR testsuite >/dev/null 2>&1--rm -f testsuite.tix--cat <<EOF--Test coverage report written to $DIR.-EOF

@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Test.Framework (defaultMain)+import           Text.XmlHtml.Tests (tests)++main :: IO ()+main = defaultMain tests

@@ -0,0 +1,505 @@+{-# LANGUAGE OverloadedStrings         #-}++module Text.XmlHtml.CursorTests (cursorTests) where++import           Data.Maybe+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit hiding (Test, Node)+import           Text.XmlHtml+import           Text.XmlHtml.Cursor+import           Text.XmlHtml.TestCommon++------------------------------------------------------------------------------+-- Tests of navigating with the Cursor type ----------------------------------+------------------------------------------------------------------------------++cursorTests :: [Test]+cursorTests = [+    testIt   "fromNodeAndCurrent     " $ fromNodeAndCurrent,+    testIt   "fromNodesAndSiblings   " $ fromNodesAndSiblings,+    testIt   "leftSiblings           " $ leftSiblings,+    testIt   "emptyFromNodes         " $ emptyFromNodes,+    testIt   "cursorNEQ              " $ cursorNEQ,+    testCase "cursorNavigation       " $ cursorNavigation,+    testCase "cursorSearch           " $ cursorSearch,+    testCase "cursorMutation         " $ cursorMutation,+    testCase "cursorInsertion        " $ cursorInsertion,+    testCase "cursorDeletion         " $ cursorDeletion+    ]++fromNodeAndCurrent :: Bool+fromNodeAndCurrent = all (\n -> n == current (fromNode n)) ns+    where ns = [+            TextNode "foo",+            Comment "bar",+            Element "foo" [] [],+            Element "root" [] [+                TextNode "foo",+                Comment "bar",+                Element "foo" [] []+                ]+            ]++fromNodesAndSiblings :: Bool+fromNodesAndSiblings = n == siblings (fromJust $ fromNodes n)+    where n = [+            TextNode "foo",+            Comment "bar",+            Element "foo" [] [],+            Element "root" [] [+                TextNode "foo",+                Comment "bar",+                Element "foo" [] []+                ]+            ]++leftSiblings :: Bool+leftSiblings = fromJust $ do+        r <- do+            c1 <- fromNodes n+            c2 <- right c1+            c3 <- right c2+            return c3+        return (n == siblings r)+    where n = [+            TextNode "foo",+            Comment "bar",+            Element "foo" [] [],+            Element "root" [] [+                TextNode "foo",+                Comment "bar",+                Element "foo" [] []+                ]+            ]++emptyFromNodes :: Bool+emptyFromNodes = isNothing (fromNodes [])++cursorNEQ :: Bool+cursorNEQ = let a = fromNode (Element "a" [] [])+                b = fromNode (Element "b" [] [])+            in  a /= b++-- Sample node structure for running cursor tests.+cursorTestTree :: Node+cursorTestTree = Element "department" [("code", "A17")] [+    Element "employee" [("name", "alice")] [+        Element "address" [] [+            TextNode "124 My Road"+            ],+        Element "phone" [] [+            TextNode "555-1234"+            ]+        ],+    Element "employee" [("name", "bob")] [+        Comment "My best friend",+        Element "address" [] [+            TextNode "123 My Road"+            ],+        Element "temp" [] []+        ],+    Element "employee" [("name", "camille")] [+        Element "phone" [] [+            TextNode "800-888-8888"+            ]+        ]+    ]++cursorNavigation :: Assertion+cursorNavigation = do+    let r = fromNode cursorTestTree++    let Just e1 = firstChild r+    let Just e2 = getChild 1 r+    let Just e3 = lastChild r++    assertBool "rootElem" $ isElement (current r)+    assertBool "parent of root" $ isNothing (parent r)++    assertBool "getChild bounds" $ isNothing (getChild 3 r)+    assertBool "getChild negative bounds" $ isNothing (getChild (-1) r)+    assertBool "firstChild"      $+        getAttribute "name" (current e1) == Just "alice"+    assertBool "childAt 1 "      $+        getAttribute "name" (current e2) == Just "bob"+    assertBool "lastChild "      $+        getAttribute "name" (current e3) == Just "camille"++    do let Just a = lastChild e2+       assertBool "firstChild on empty element" $ isNothing (firstChild a)+       assertBool "getChild on empty element"   $ isNothing (getChild 0 a)+       assertBool "lastChild on empty element"  $ isNothing (lastChild a)++    do let Just a = right e1+       let Just b = right a+       assertBool "two paths #1" $ a == e2+       assertBool "two paths #2" $ b == e3+       assertBool "right off end" $ isNothing (right b)++       let Just c = left e3+       let Just d = left e2+       assertBool "two paths #3" $ c == e2+       assertBool "two paths #4" $ d == e1+       assertBool  "left off end" $ isNothing (left d)++    do let Just r1 = parent e2+       assertEqual "child -> parent" (current r) (current r1)++    do let Just cmt = firstChild e2+       assertBool  "topNode"  $ tagName (topNode cmt) == Just "department"+       assertBool  "topNodes" $ map tagName (topNodes cmt) == [ Just "department" ]++       assertBool "first child of comment" $ isNothing (firstChild cmt)+       assertBool "last  child of comment" $ isNothing (lastChild cmt)++    do assertBool "nextDF down" $ nextDF r == Just e1++       let Just cmt = firstChild e2+       assertBool "nextDF right" $ nextDF cmt == right cmt++       let Just em = lastChild e2+       assertBool "nextDF up-right" $ nextDF em == Just e3+       +       let Just pelem = lastChild e3+       let Just ptext = lastChild pelem+       assertBool "nextDF end" $ isNothing (nextDF ptext)+++cursorSearch :: Assertion+cursorSearch = do+    let r = fromNode cursorTestTree++    let Just e1 = findChild isFirst r+    let Just e2 = findChild ((==(Just "bob")) . getAttribute "name" .  current) r+    let Just e3 = findChild isLast r++    assertBool "findChild isFirst" $+        getAttribute "name" (current e1) == Just "alice"+    assertBool "findChild" $+        getAttribute "name" (current e2) == Just "bob"+    assertBool "findChild isLast" $+        getAttribute "name" (current e3) == Just "camille"++    assertBool "findLeft Just" $ findLeft (const True) e2 == Just e1+    assertBool "findLeft Nothing" $ findLeft (const False) e2 == Nothing+    assertBool "findRight Just" $ findRight (const True) e2 == Just e3+    assertBool "findRight Nothing" $ findRight (const False) e2 == Nothing+    assertBool "findRec" $ findRec (not . hasChildren) r == (firstChild =<< firstChild e1)++    assertBool "isChild true" $ isChild e1+    assertBool "isChild false" $ not $ isChild r+    assertBool "getNodeIndex" $ getNodeIndex e2 == 1+++cursorMutation :: Assertion+cursorMutation = do+    let r = fromNode cursorTestTree++    let Just e1 = firstChild r+    let Just e2 = right e1+    let Just e3 = lastChild r++    do let Just cmt = firstChild e2+       let cmt'     = setNode (Comment "Not my friend any more") cmt+       let Just e2' = parent cmt'+       assertBool "setNode" $ current e2' ==+            Element "employee" [("name", "bob")] [+                Comment "Not my friend any more",+                Element "address" [] [+                    TextNode "123 My Road"+                    ],+                Element "temp" [] []+                ]++    do let e1' = modifyNode (setAttribute "name" "bryan") e1+       let n   = current e1'+       assertBool "modifyNode" $ getAttribute "name" n == Just "bryan"++    do let myModifyM = return . setAttribute "name" "chelsea"+       e3' <- modifyNodeM myModifyM e3+       let n   = current e3'+       assertBool "modifyNode" $ getAttribute "name" n == Just "chelsea"+++cursorInsertion :: Assertion+cursorInsertion = do+    let r            = fromNode cursorTestTree+    let Just alice   = firstChild r+    let Just bob     = getChild 1 r+    let Just camille = lastChild r++    let fred = Element "employee" [("name", "fred")] []++    -- Stock insertLeft+    do let ins    = insertLeft fred bob+       assertBool "insertLeft leaves cursor" $+            getAttribute "name" (current ins) == Just "bob"++       let Just a = findLeft isFirst ins+       assertBool "insertLeft 1" $+            getAttribute "name" (current a) == Just "alice"++       let Just b = right a+       assertBool "insertLeft 2" $+            getAttribute "name" (current b) == Just "fred"++       let Just c = right b+       assertBool "insertLeft 3" $+            getAttribute "name" (current c) == Just "bob"++       let Just d = right c+       assertBool "insertLeft 4" $+            getAttribute "name" (current d) == Just "camille"++    -- insertLeft on first child+    do let ins    = insertLeft fred alice+       assertBool "insertLeft firstChild" $+            getAttribute "name" (current ins) == Just "alice"++       let Just a = findLeft isFirst ins+       assertBool "insertLeft firstChild 1" $+            getAttribute "name" (current a) == Just "fred"++    -- Stock insertRight+    do let ins    = insertRight fred alice+       assertBool "insertRight leaves cursor" $+            getAttribute "name" (current ins) == Just "alice"++       let Just a = findRight isLast ins+       assertBool "insertRight 1" $+            getAttribute "name" (current a) == Just "camille"++       let Just b = left a+       assertBool "insertRight 2" $+            getAttribute "name" (current b) == Just "bob"++       let Just c = left b+       assertBool "insertRight 3" $+            getAttribute "name" (current c) == Just "fred"++       let Just d = left c+       assertBool "insertRight 4" $+            getAttribute "name" (current d) == Just "alice"++    -- insertRight on last child+    do let ins    = insertRight fred camille+       assertBool "insertRight lastChild" $+            getAttribute "name" (current ins) == Just "camille"++       let Just a = findRight isLast ins+       assertBool "insertRight lastChild 1" $+            getAttribute "name" (current a) == Just "fred"++    let mary = Element "employee" [("name", "mary")] []+    let new  = [fred, mary]++    -- insertManyLeft+    do let ins = insertManyLeft new camille+       assertBool "insertManyLeft leaves cursor" $+            getAttribute "name" (current ins) == Just "camille"++       let Just a = left ins+       assertBool "insertManyLeft 1" $+            getAttribute "name" (current a) == Just "mary"++       let Just b = left a+       assertBool "insertManyLeft 2" $+            getAttribute "name" (current b) == Just "fred"++       let Just c = left b+       assertBool "insertManyLeft 3" $+            getAttribute "name" (current c) == Just "bob"++    -- insertManyRight+    do let ins = insertManyRight new alice+       assertBool "insertManyRight leaves cursor" $+            getAttribute "name" (current ins) == Just "alice"++       let Just a = right ins+       assertBool "insertManyRight 1" $+            getAttribute "name" (current a) == Just "fred"++       let Just b = right a+       assertBool "insertManyRight 2" $+            getAttribute "name" (current b) == Just "mary"++       let Just c = right b+       assertBool "insertManyRight 3" $+            getAttribute "name" (current c) == Just "bob"++    -- insertFirstChild and insertLastChild+    do let Just ins1 = insertFirstChild fred r+       let Just ins2 = insertLastChild mary ins1++       let Just a = firstChild ins2+       assertBool "insert children 1" $+            getAttribute "name" (current a) == Just "fred"++       let Just b = right a+       assertBool "insert children 2" $+            getAttribute "name" (current b) == Just "alice"++       let Just c = right b+       assertBool "insert children 3" $+            getAttribute "name" (current c) == Just "bob"++       let Just d = right c+       assertBool "insert children 4" $+            getAttribute "name" (current d) == Just "camille"++       let Just e = right d+       assertBool "insert children 5" $+            getAttribute "name" (current e) == Just "mary"+       assertBool "insert children 6" $ isLast e++    -- non-element insertFirstChild and insertLastChild+    do let Just cmt = firstChild bob+       assertBool "non-elem insertFirstChild" $+            insertFirstChild fred cmt == Nothing+       assertBool "non-elem insertLastChild" $+            insertLastChild fred cmt == Nothing+       assertBool "non-elem insertManyFirstChild" $+            insertManyFirstChild new cmt == Nothing+       assertBool "non-elem insertManyLastChild" $+            insertManyLastChild new cmt == Nothing++    -- insertManyFirstChild+    do let Just ins = insertManyFirstChild new r++       let Just a = firstChild ins+       assertBool "insertManyFirstChild 1" $+            getAttribute "name" (current a) == Just "fred"++       let Just b = right a+       assertBool "insertManyFirstChild 2" $+            getAttribute "name" (current b) == Just "mary"++       let Just c = right b+       assertBool "insertManyFirstChild 3" $+            getAttribute "name" (current c) == Just "alice"++       let Just d = right c+       assertBool "insertManyFirstChild 4" $+            getAttribute "name" (current d) == Just "bob"++       let Just e = right d+       assertBool "insertManyFirstChild 5" $+            getAttribute "name" (current e) == Just "camille"+       assertBool "insertManyFirstChild 6" $ isLast e+++    -- insertManyLastChild+    do let Just ins = insertManyLastChild new r++       let Just a = firstChild ins+       assertBool "insertManyFirstChild 1" $+            getAttribute "name" (current a) == Just "alice"++       let Just b = right a+       assertBool "insertManyFirstChild 2" $+            getAttribute "name" (current b) == Just "bob"++       let Just c = right b+       assertBool "insertManyFirstChild 3" $+            getAttribute "name" (current c) == Just "camille"++       let Just d = right c+       assertBool "insertManyFirstChild 4" $+            getAttribute "name" (current d) == Just "fred"++       let Just e = right d+       assertBool "insertManyFirstChild 5" $+            getAttribute "name" (current e) == Just "mary"+       assertBool "insertManyFirstChild 6" $ isLast e++    -- insertGoLeft from middle+    do let ins    = insertGoLeft fred bob+       let Just a = right ins+       assertBool "insertGoLeft 1" $+            getAttribute "name" (current ins) == Just "fred"+       assertBool "insertGoLeft 2" $+            getAttribute "name" (current a)   == Just "bob"++    -- insertGoLeft from end+    do let ins    = insertGoLeft fred alice+       let Just a = right ins+       assertBool "insertGoLeft 3" $+            getAttribute "name" (current ins) == Just "fred"+       assertBool "insertGoLeft 4" $+            getAttribute "name" (current a)   == Just "alice"++    -- insertGoRight from middle+    do let ins    = insertGoRight fred bob+       let Just a = left ins+       assertBool "insertGoRight 1" $+            getAttribute "name" (current ins) == Just "fred"+       assertBool "insertGoRight 2" $+            getAttribute "name" (current a)   == Just "bob"++    -- insertGoRight from end+    do let ins    = insertGoRight fred camille+       let Just a = left ins+       assertBool "insertGoRight 3" $+            getAttribute "name" (current ins) == Just "fred"+       assertBool "insertGoRight 4" $+            getAttribute "name" (current a)   == Just "camille"+++cursorDeletion :: Assertion+cursorDeletion = do+    let r = fromNode cursorTestTree+    let Just alice   = firstChild r+    let Just bob     = getChild 1 r+    let Just camille = lastChild r++    -- removeLeft success+    do let Just (n,del) = removeLeft bob+       let [b,c] = siblings del+       assertBool "removeLeft node1" $ getAttribute "name" n == Just "alice"+       assertBool "removeLeft node2" $ getAttribute "name" b == Just "bob"+       assertBool "removeLeft node3" $ getAttribute "name" c == Just "camille"++    -- removeLeft failure+    do assertBool "removeLeft failure" $ isNothing (removeLeft alice)++    -- removeRight success+    do let Just (n,del) = removeRight bob+       let [a,b] = siblings del+       assertBool "removeLeft node1" $ getAttribute "name" a == Just "alice"+       assertBool "removeLeft node2" $ getAttribute "name" b == Just "bob"+       assertBool "removeLeft node3" $ getAttribute "name" n == Just "camille"++    -- removeRight failure+    do assertBool "removeLeft failure" $ isNothing (removeRight camille)++    -- removeGoLeft success+    do let Just del = removeGoLeft bob+       let Just c   = right del+       assertBool "removeGoLeft 1" $+            getAttribute "name" (current del) == Just "alice"+       assertBool "removeGoLeft 2" $+            getAttribute "name" (current c) == Just "camille"++    -- removeGoLeft failure+    do assertBool "removeGoLeft failure" $ isNothing (removeGoLeft alice)++    -- removeGoRight success+    do let Just del = removeGoRight bob+       let Just a   = left del+       assertBool "removeGoRight 1" $+            getAttribute "name" (current del) == Just "camille"+       assertBool "removeGoRight 2" $+            getAttribute "name" (current a) == Just "alice"++    -- removeGoLeft failure+    do assertBool "removeGoRight failure" $ isNothing (removeGoRight camille)++    -- removeGoUp success+    do let Just del = removeGoUp bob+       let [a,c]    = childNodes (current del)+       assertBool "removeGoUp 1" $ getAttribute "name" a == Just "alice"+       assertBool "removeGoUp 2" $ getAttribute "name" c == Just "camille"++    -- removeGoUp failure+    do assertBool "removeGoUp failure" $ isNothing (removeGoUp r)

@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings         #-}++module Text.XmlHtml.DocumentTests (documentTests) where++import           Data.Text ()                  -- for string instance+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit hiding (Node, Test)+import           Text.XmlHtml+import           Text.XmlHtml.TestCommon+++------------------------------------------------------------------------------+-- Tests of manipulating the Node tree and Document --------------------------+------------------------------------------------------------------------------++documentTests :: [Test]+documentTests = [+    -- Exercise the (/=) operators; (==) is done plenty of places.+    testIt   "compareExternalIDs     " $ compareExternalIDs,+    testIt   "compareInternalSubs    " $ compareInternalSubs,+    testIt   "compareDoctypes        " $ compareDoctypes,+    testIt   "compareNodes           " $ compareNodes,+    testIt   "compareDocuments       " $ compareDocuments,+    testIt   "compareEncodings       " $ compareEncodings,++    -- Silly tests just to exercise the Show instances on types.+    testCase "exerciseShows          " $ exerciseShows,++    -- Exercise the accessors for Document and Node+    testCase "docNodeAccessors       " $ docNodeAccessors,++    testIt   "isTextNodeYes          " $ isTextNode someTextNode,+    testIt   "isTextNodeNo           " $ not $ isTextNode someComment,+    testIt   "isTextNodeNo2          " $ not $ isTextNode someElement,+    testIt   "isCommentYes           " $ isComment someComment,+    testIt   "isCommentNo            " $ not $ isComment someTextNode,+    testIt   "isCommentNo2           " $ not $ isComment someElement,+    testIt   "isElementYes           " $ isElement someElement,+    testIt   "isElementNo            " $ not $ isElement someTextNode,+    testIt   "isElementNo2           " $ not $ isElement someComment,+    testIt   "tagNameElement         " $ tagName someElement == Just "baz",+    testIt   "tagNameText            " $ tagName someTextNode == Nothing,+    testIt   "tagNameComment         " $ tagName someComment == Nothing,+    testIt   "getAttributePresent    " $ getAttribute "fiz" someElement+                                            == Just "buzz",+    testIt   "getAttributeMissing    " $ getAttribute "baz" someElement+                                            == Nothing,+    testIt   "getAttributeWrongType  " $ getAttribute "fix" someTextNode+                                            == Nothing,+    testIt   "hasAttributePresent    " $ hasAttribute "fiz" someElement,+    testIt   "hasAttributeMissing    " $ not $ hasAttribute "baz" someElement,+    testIt   "hasAttributeWrongType  " $ not $ hasAttribute "fix" someTextNode,+    testIt   "setAttributeNew        " $ setAttributeNew,+    testIt   "setAttributeReplace    " $ setAttributeReplace,+    testIt   "setAttributeWrongType  " $ setAttributeWrongType,+    testIt   "nestedNodeText         " $ nestedNodeText,+    testIt   "childNodesElem         " $ childNodesElem,+    testIt   "childNodesOther        " $ childNodesOther,+    testIt   "childElemsTest         " $ childElemsTest,+    testIt   "childElemsTagTest      " $ childElemsTagTest,+    testIt   "childElemTagExists     " $ childElemTagExists,+    testIt   "childElemTagNotExists  " $ childElemTagNotExists,+    testIt   "childElemTagOther      " $ childElemTagOther,+    testIt   "descNodesElem          " $ descNodesElem,+    testIt   "descNodesOther         " $ descNodesOther,+    testIt   "descElemsTest          " $ descElemsTest,+    testIt   "descElemsTagTest       " $ descElemsTagTest,+    testIt   "descElemTagExists      " $ descElemTagExists,+    testIt   "descElemTagDFS         " $ descElemTagDFS,+    testIt   "descElemTagNotExists   " $ descElemTagNotExists,+    testIt   "descElemTagOther       " $ descElemTagOther+    ]+++compareExternalIDs :: Bool+compareExternalIDs = Public "foo" "bar" /= System "bar"++compareInternalSubs :: Bool+compareInternalSubs = InternalText "" /= NoInternalSubset++compareDoctypes :: Bool+compareDoctypes = DocType "html" NoExternalID NoInternalSubset+               /= DocType "foo"  NoExternalID NoInternalSubset++compareNodes :: Bool+compareNodes = TextNode "" /= Comment ""++compareDocuments :: Bool+compareDocuments = XmlDocument UTF8 Nothing [] /= HtmlDocument UTF8 Nothing []++compareEncodings :: Bool+compareEncodings = UTF8 /= UTF16BE++exerciseShows :: Assertion+exerciseShows = do+    assertBool "1" $ length (showList [NoExternalID] "") > 0+    assertBool "2" $ length (showList [NoInternalSubset] "") > 0+    assertBool "3" $ length (showList [DocType "foo" NoExternalID NoInternalSubset] "") > 0+    assertBool "4" $ length (showList [TextNode ""] "") > 0+    assertBool "5" $ length (showList [XmlDocument UTF8 Nothing []] "") > 0+    assertBool "6" $ length (showList [UTF8] "") > 0++docNodeAccessors :: Assertion+docNodeAccessors = do+    let hdoc = HtmlDocument UTF8 Nothing []+    assertEqual "html enc"  (docEncoding hdoc) UTF8+    assertEqual "html type" (docType hdoc) Nothing+    assertEqual "html nodes" (docContent hdoc) []++    let xdoc = XmlDocument UTF8 Nothing []+    assertEqual "xml enc"  (docEncoding xdoc) UTF8+    assertEqual "xml type" (docType xdoc) Nothing+    assertEqual "xml nodes" (docContent xdoc) []++    let elm = Element  "foo" [] []+    let txt = TextNode ""+    let cmt = Comment  ""+    assertEqual "elm tag"   (elementTag      elm) "foo"+    assertEqual "elm attr"  (elementAttrs    elm) []+    assertEqual "elm child" (elementChildren elm) []+    assertBool  "txt tag"   $ isBottom (elementTag      txt)+    assertBool  "txt attr"  $ isBottom (elementAttrs    txt)+    assertBool  "txt child" $ isBottom (elementChildren txt)+    assertBool  "cmt tag"   $ isBottom (elementTag      cmt)+    assertBool  "cmt attr"  $ isBottom (elementAttrs    cmt)+    assertBool  "cmt child" $ isBottom (elementChildren cmt)+++someTextNode :: Node+someTextNode = TextNode "foo"++someComment :: Node+someComment = Comment "bar"++someElement :: Node+someElement = Element "baz" [("fiz","buzz")] [TextNode "content"]++someTree :: Node+someTree = Element "department" [("code", "A17")] [+    Element "employee" [("name", "bob")] [+        Comment "My best friend",+        Element "address" [] [+            TextNode "123 My Road"+            ]+        ],+    Element "employee" [("name", "alice")] [+        Element "address" [] [+            TextNode "124 My Road"+            ],+        Element "phone" [] [+            TextNode "555-1234"+            ]+        ]+    ]++setAttributeNew :: Bool+setAttributeNew =+    let e = setAttribute "flo" "friz" someElement+    in  length (elementAttrs e) == 2+        && getAttribute "fiz" e == Just "buzz"+        && getAttribute "flo" e == Just "friz"++setAttributeReplace :: Bool+setAttributeReplace =+    let e = setAttribute "fiz" "bat" someElement+    in  length (elementAttrs e) == 1+        && getAttribute "fiz" e == Just "bat"++setAttributeWrongType :: Bool+setAttributeWrongType =+    setAttribute "fuss" "plus" someTextNode == someTextNode+    && setAttribute "fuss" "plus" someComment == someComment++nestedNodeText :: Bool+nestedNodeText = nodeText someTree == "123 My Road124 My Road555-1234"++childNodesElem :: Bool+childNodesElem = length (childNodes n) == 3+    where n = Element "foo" [] [ TextNode "bar",+                                 Comment  "baz",+                                 Element  "bat" [] [] ]++childNodesOther :: Bool+childNodesOther = childNodes (TextNode "foo") == []+               && childNodes (Comment "bar")  == []++childElemsTest :: Bool+childElemsTest = length (childElements n) == 1+    where n = Element "foo" [] [ TextNode "bar",+                                 Comment  "baz",+                                 Element  "bat" [] [] ]++childElemsTagTest :: Bool+childElemsTagTest = length (childElementsTag "good" n) == 2+    where n = Element "parent" [] [+                Element "good" [] [],+                TextNode "foo",+                Comment "bar",+                Element "bad" [] [],+                Element "good" [] [],+                Element "bad" [] []+              ]++childElemTagExists :: Bool+childElemTagExists = childElementTag "b" n == Just (Element "b" [] [])+    where n = Element "parent" [] [+                Element "a" [] [],+                Element "b" [] [],+                Element "c" [] []+              ]++childElemTagNotExists :: Bool+childElemTagNotExists = childElementTag "b" n == Nothing+    where n = Element "parent" [] [+                Element "a" [] [],+                Element "c" [] []+              ]++childElemTagOther :: Bool+childElemTagOther = childElementTag "b" n == Nothing+    where n = TextNode ""+++descNodesElem :: Bool+descNodesElem = length (descendantNodes n) == 3+    where n = Element "foo" [] [ TextNode "bar",+                                 Element  "bat" [] [ Comment  "baz" ] ]++descNodesOther :: Bool+descNodesOther = descendantNodes (TextNode "foo") == []+              && descendantNodes (Comment "bar")  == []++descElemsTest :: Bool+descElemsTest = length (descendantElements n) == 1+    where n = Element "foo" [] [ TextNode "bar",+                                 Element  "bat" [] [ Comment  "baz" ] ]++descElemsTagTest :: Bool+descElemsTagTest = length (descendantElementsTag "good" n) == 2+    where n = Element "parent" [] [+                TextNode "foo",+                Element "good" [] [],+                Comment "bar",+                Element "parent" [] [ Element "good" [] [] ],+                Element "bad" [] []+              ]++descElemTagExists :: Bool+descElemTagExists = descendantElementTag "b" n == Just (Element "b" [] [])+    where n = Element "parent" [] [+                Element "a" [] [ Element "b" [] [] ],+                Element "c" [] []+              ]++descElemTagDFS :: Bool+descElemTagDFS = descendantElementTag "b" n == Just (Element "b" [] [])+    where n = Element "parent" [] [+                Element "a" [] [ Element "b" [] [] ],+                Element "b" [("wrong", "")] [],+                Element "c" [] []+              ]++descElemTagNotExists :: Bool+descElemTagNotExists = descendantElementTag "b" n == Nothing+    where n = Element "parent" [] [+                Element "a" [] [],+                Element "c" [] [ Element "d" [] [] ]+              ]++descElemTagOther :: Bool+descElemTagOther = descendantElementTag "b" n == Nothing+    where n = TextNode ""+

@@ -0,0 +1,183 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.XmlHtml.OASISTest (testsOASIS) where++import           Blaze.ByteString.Builder+import           Control.Applicative+import           Control.Monad+import qualified Data.ByteString as B+import           Data.Maybe+import qualified Data.Text as T+import           System.Directory+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit hiding (Test, Node)+import           Text.XmlHtml++------------------------------------------------------------------------------+-- | Runs the OASIS XML conformance test suite.  The test cases sit in+-- directories inside of @test/resources@.  This test reads them, parses them,+-- and ensures that they behave as expected:+--+-- * If there is a file in the same directory named /filename/@.correct@+--   or /filename/@.incorrect@, the parsing is expected to either succeed+--   or fail, as indicated.  Otherwise, the remaining cases apply.+--+-- * For those tests marked @not-wf@, the test expects an error message.+--+-- * For tests marked @valid@ or @invalid@ (there is no distinction since+--   @xmlhtml@ is not a validating parser), the test expects a successful+--   parse, but does not verify the parse result.+--+-- For tests that should succeed as XML but not HTML, or vice versa, files+-- can be named /filename/@.xml.correct@, and so on (all 4 combinations).++testsOASIS :: [Test]+testsOASIS = [+    testCase "xmlhtml/ibm-not-wf     " $ oasisP  "ibm/ibm_oasis_not-wf.xml",+    testCase "xmlhtml/ibm-invalid    " $ oasisP  "ibm/ibm_oasis_invalid.xml",+    testCase "xmlhtml/ibm-valid      " $ oasisP  "ibm/ibm_oasis_valid.xml",+    testCase "xmlhtml/oasis          " $ oasisP  "oasis/oasis.xml",+    testCase "xmlhtml/r-ibm-not-wf   " $ oasisR  "ibm/ibm_oasis_not-wf.xml",+    testCase "xmlhtml/r-ibm-invalid  " $ oasisR  "ibm/ibm_oasis_invalid.xml",+    testCase "xmlhtml/r-ibm-valid    " $ oasisR  "ibm/ibm_oasis_valid.xml",+    testCase "xmlhtml/r-oasis        " $ oasisR  "oasis/oasis.xml",+    testCase "xmlhtml/h-ibm-not-wf   " $ oasisHP "ibm/ibm_oasis_not-wf.xml",+    testCase "xmlhtml/h-ibm-invalid  " $ oasisHP "ibm/ibm_oasis_invalid.xml",+    testCase "xmlhtml/h-ibm-valid    " $ oasisHP "ibm/ibm_oasis_valid.xml",+    testCase "xmlhtml/h-oasis        " $ oasisHP "oasis/oasis.xml",+    testCase "xmlhtml/hr-ibm-not-wf  " $ oasisHR "ibm/ibm_oasis_not-wf.xml",+    testCase "xmlhtml/hr-ibm-invalid " $ oasisHR "ibm/ibm_oasis_invalid.xml",+    testCase "xmlhtml/hr-ibm-valid   " $ oasisHR "ibm/ibm_oasis_valid.xml",+    testCase "xmlhtml/hr-oasis       " $ oasisHR "oasis/oasis.xml"+    ]+++oasisP :: String -> Assertion+oasisP name = do+    tests <- getOASIS ".xml" name+    forM_ tests $ \(fn, ty) -> case ty of+        True  -> oasisWF fn+        False -> oasisNotWF fn+++oasisR :: String -> Assertion+oasisR name = do+    tests <- getOASIS ".xml" name+    forM_ tests $ \(fn, ty) -> case ty of+        True  -> oasisRerender fn+        False -> return ()+++oasisHP :: String -> Assertion+oasisHP name = do+    tests <- getOASIS ".html" name+    forM_ tests $ \(fn, ty) -> case ty of+        True  -> hOasisWF fn+        False -> hOasisNotWF fn+++oasisHR :: String -> Assertion+oasisHR name = do+    tests <- getOASIS ".html" name+    forM_ tests $ \(fn, ty) -> case ty of+        True  -> hOasisRerender fn+        False -> return ()+++getOASIS :: String -> String -> IO [(String, Bool)]+getOASIS sub name = do+    testListSrc <- B.readFile ("test/resources/" ++ name)+    let Right (XmlDocument _ _ ns) = parseXML name testListSrc+    let Just c = listToMaybe (filter isElement ns)+    oasisTestCases sub name c+++oasisTestCases :: String -> String -> Node -> IO [(String, Bool)]+oasisTestCases sub name n = do+    fmap concat $ forM (childElements n) $ \t -> case tagName t of+        Just "TESTCASES" -> oasisTestCases sub name t+        Just "TEST"      -> oasisTest sub name t+        _                -> error (show t)+++oasisTest :: String -> String -> Node -> IO [(String, Bool)]+oasisTest sub name t = do+    let fn = file $ fromJust $ getAttribute "URI" t+    fe <- doesFileExist fn+    ce <- (||) <$> doesFileExist (fn ++ ".correct")+               <*> doesFileExist (fn ++ sub ++ ".correct")+    ie <- (||) <$> doesFileExist (fn ++ ".incorrect")+               <*> doesFileExist (fn ++ sub ++ ".incorrect")+    let ty = getAttribute "TYPE" t+    if fe then case () of+        () | ce                   -> return [(fn, True)]+           | ie                   -> return [(fn, False)]+           | ty == Just "not-wf"  -> return [(fn, False)]+           | ty == Just "invalid" -> return [(fn, True)]+           | ty == Just "valid"   -> return [(fn, True)]+           | otherwise            -> return [(fn, True)]+      else return []+  where+    file f        = "test/resources/" ++ toLastSlash name ++ T.unpack f+    toLastSlash s = snd (go s)+        where go []     = (False, [])+              go (c:cs) = let (found, ccs) = go cs+                          in  if found then (True, c:ccs)+                              else if c == '/' then (True, "/")+                              else (False, c:cs)+++oasisNotWF :: String -> Assertion+oasisNotWF name = do+    src <- B.readFile name+    assertBool ("not-wf parse " ++ name) $ isLeft (parseXML name src)+  where+    isLeft (Left _) = True+    isLeft _        = False+++oasisWF :: String -> Assertion+oasisWF name = do+    src <- B.readFile name+    assertBool ("wf parse " ++ name) $ isRight (parseXML name src)+  where+    isRight (Right _) = True+    isRight _         = False+++oasisRerender :: String -> Assertion+oasisRerender name = do+    src         <- B.readFile name+    let Right d  = parseXML "" src+    let src2     = toByteString (render d)+    let Right d2 = parseXML "" src2+    assertEqual ("rerender " ++ name) d d2+++hOasisNotWF :: String -> Assertion+hOasisNotWF name = do+    src <- B.readFile name+    assertBool ("not-wf parse " ++ name) $ isLeft (parseHTML name src)+  where+    isLeft (Left _) = True+    isLeft _        = False+++hOasisWF :: String -> Assertion+hOasisWF name = do+    src <- B.readFile name+    assertBool ("wf parse " ++ name) $ isRight (parseHTML name src)+  where+    isRight (Right _) = True+    isRight _         = False+++hOasisRerender :: String -> Assertion+hOasisRerender name = do+    src         <- B.readFile name+    let Right d  = parseHTML "" src+    let src2     = toByteString (render d)+    let Right d2 = parseHTML "" src2+    assertEqual ("rerender " ++ name) d d2+

@@ -0,0 +1,38 @@+{-# LANGUAGE ScopedTypeVariables       #-}++module Text.XmlHtml.TestCommon where++import           Control.Exception as E+import           System.IO.Unsafe+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit hiding (Test, Node)++------------------------------------------------------------------------------+-- | Tests a simple Bool property.+testIt :: TestName -> Bool -> Test+testIt name b = testCase name $ assertBool name b++------------------------------------------------------------------------------+-- Code adapted from ChasingBottoms.+--+-- Adding an actual dependency isn't possible because Cabal refuses to build+-- the package due to version conflicts.+--+-- isBottom is impossible to write, but very useful!  So we defy the+-- impossible, and write it anyway.+isBottom :: a -> Bool+isBottom a = unsafePerformIO $+    (E.evaluate a >> return False) `E.catches` [+        E.Handler $ \ (_ :: PatternMatchFail) -> return True,+        E.Handler $ \ (_ :: ErrorCall)        -> return True,+        E.Handler $ \ (_ :: NoMethodError)    -> return True,+        E.Handler $ \ (_ :: RecConError)      -> return True,+        E.Handler $ \ (_ :: RecUpdError)      -> return True,+        E.Handler $ \ (_ :: RecSelError)      -> return True+        ]++------------------------------------------------------------------------------+isLeft :: Either a b -> Bool+isLeft = either (const True) (const False)+

@@ -0,0 +1,963 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings         #-}++module Text.XmlHtml.Tests (tests) where++import           Blaze.ByteString.Builder+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import           Data.Monoid+import           Data.String+import           Data.Text ()                  -- for string instance+import qualified Data.Text.Encoding as T+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.HUnit hiding (Test, Node)+import           Text.Blaze+import           Text.Blaze.Html+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import qualified Text.Blaze.Internal as H+import           Text.Blaze.Renderer.XmlHtml+import           Text.XmlHtml+import           Text.XmlHtml.CursorTests+import           Text.XmlHtml.DocumentTests+import           Text.XmlHtml.TestCommon+import           Text.XmlHtml.OASISTest+++------------------------------------------------------------------------------+-- The master list of tests to run. ------------------------------------------+------------------------------------------------------------------------------++tests :: [Test]+tests = xmlParsingTests+     ++ htmlXMLParsingTests+     ++ htmlParsingQuirkTests+     ++ xmlRenderingTests+     ++ htmlXMLRenderingTests+     ++ htmlRenderingQuirkTests+     ++ documentTests+     ++ cursorTests+     ++ blazeRenderTests+     ++ testsOASIS+++------------------------------------------------------------------------------+-- XML Parsing Tests ---------------------------------------------------------+------------------------------------------------------------------------------++xmlParsingTests :: [Test]+xmlParsingTests = [+    testCase "byteOrderMark          " byteOrderMark,+    testIt   "emptyDocument          " emptyDocument,+    testIt   "publicDocType          " publicDocType,+    testIt   "systemDocType          " systemDocType,+    testIt   "emptyDocType           " emptyDocType,+    testCase "dtdInternalScan        " dtdInternalScan,+    testIt   "textOnly               " textOnly,+    testIt   "textWithRefs           " textWithRefs,+    testIt   "untermRef              " untermRef,+    testIt   "textWithCDATA          " textWithCDATA,+    testIt   "cdataOnly              " cdataOnly,+    testIt   "commentOnly            " commentOnly,+    testIt   "emptyElement           " emptyElement,+    testIt   "emptyElement2          " emptyElement2,+    testIt   "elemWithText           " elemWithText,+    testIt   "xmlDeclXML             " xmlDeclXML,+    testIt   "procInst               " procInst,+    testIt   "badDoctype1            " badDoctype1,+    testIt   "badDoctype2            " badDoctype2,+    testIt   "badDoctype3            " badDoctype3,+    testIt   "badDoctype4            " badDoctype4,+    testIt   "badDoctype5            " badDoctype5,+    testCase "tagNames               " tagNames+    ]++byteOrderMark :: Assertion+byteOrderMark = do+    assertEqual "BOM UTF16BE" (Right $ XmlDocument UTF16BE Nothing [])+        (parseXML "" $ T.encodeUtf16BE "\xFEFF")+    assertEqual "BOM UTF16LE" (Right $ XmlDocument UTF16LE Nothing [])+        (parseXML "" $ T.encodeUtf16LE "\xFEFF")+    assertEqual "BOM UTF8" (Right $ XmlDocument UTF8 Nothing [])+        (parseXML "" $ T.encodeUtf8 "\xFEFF")+    assertEqual "BOM None" (Right $ XmlDocument UTF8 Nothing [])+        (parseXML "" $ T.encodeUtf8 "")++emptyDocument :: Bool+emptyDocument = parseXML "" ""+    == Right (XmlDocument UTF8 Nothing [])++publicDocType :: Bool+publicDocType = parseXML "" "<!DOCTYPE tag PUBLIC \"foo\" \"bar\">"+    == Right (XmlDocument UTF8 (Just (DocType "tag" (Public "foo" "bar") NoInternalSubset)) [])++systemDocType :: Bool+systemDocType = parseXML "" "<!DOCTYPE tag SYSTEM \"foo\">"+    == Right (XmlDocument UTF8 (Just (DocType "tag" (System "foo") NoInternalSubset)) [])++emptyDocType :: Bool+emptyDocType  = parseXML "" "<!DOCTYPE tag >"+    == Right (XmlDocument UTF8 (Just (DocType "tag" NoExternalID NoInternalSubset)) [])++dtdInternalScan :: Assertion+dtdInternalScan = do+    assertEqual "empty" (parseXML "" "<!DOCTYPE a []>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[]" ))) []))+    assertBool "bad brackets" (isLeft $ parseXML "" "<!DOCTYPE a ()>")+    assertEqual "quoted" (parseXML "" "<!DOCTYPE a [\"]\"]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[\"]\"]" ))) []))+    assertBool "bad quote" (isLeft $ parseXML "" "<!DOCTYPE a [\"]>")+    assertEqual "nested brackets" (parseXML "" "<!DOCTYPE a [[[]]]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[[[]]]" ))) []))+    assertEqual "part comment 1" (parseXML "" "<!DOCTYPE a [<]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<]" ))) []))+    assertEqual "part comment 2" (parseXML "" "<!DOCTYPE a [[<]]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[[<]]" ))) []))+    assertEqual "part comment 3" (parseXML "" "<!DOCTYPE a [<[]]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<[]]" ))) []))+    assertEqual "part comment 4" (parseXML "" "<!DOCTYPE a [<!]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<!]" ))) []))+    assertEqual "part comment 5" (parseXML "" "<!DOCTYPE a [[<!]]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[[<!]]" ))) []))+    assertEqual "part comment 6" (parseXML "" "<!DOCTYPE a [<!-]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<!-]" ))) []))+    assertEqual "comment" (parseXML "" "<!DOCTYPE a [<!--foo-->]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<!--foo-->]" ))) []))+    assertEqual "docint 1" (parseXML "" "<!DOCTYPE a [<''<\"\"<!''<!\"\">]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<''<\"\"<!''<!\"\">]" ))) []))+    assertEqual "docint2" (parseXML "" "<!DOCTYPE a [<![<!-[<!-]<!-''<!-\"\"]]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<![<!-[<!-]<!-''<!-\"\"]]" ))) []))+    assertEqual "docint3" (parseXML "" "<!DOCTYPE a [<!- ]>")+        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText+            "[<!- ]" ))) []))+    assertBool "bad comment" (isLeft $ parseXML "" "<!DOCTYPE a [<!-- -- -->]>")++textOnly :: Bool+textOnly      = parseXML "" "sldhfsklj''a's s"+    == Right (XmlDocument UTF8 Nothing [TextNode "sldhfsklj''a's s"])++textWithRefs :: Bool+textWithRefs  = parseXML "" "This is Bob&apos;s sled"+    == Right (XmlDocument UTF8 Nothing [TextNode "This is Bob's sled"])++untermRef :: Bool+untermRef     = isLeft (parseXML "" "&#X6a")++textWithCDATA :: Bool+textWithCDATA = parseXML "" "Testing <![CDATA[with <some> c]data]]>"+    == Right (XmlDocument UTF8 Nothing [TextNode "Testing with <some> c]data"])++cdataOnly :: Bool+cdataOnly     = parseXML "" "<![CDATA[ Testing <![CDATA[ test ]]>"+    == Right (XmlDocument UTF8 Nothing [TextNode " Testing <![CDATA[ test "])++commentOnly :: Bool+commentOnly   = parseXML "" "<!-- this <is> a \"comment -->"+    == Right (XmlDocument UTF8 Nothing [Comment " this <is> a \"comment "])++emptyElement :: Bool+emptyElement  = parseXML "" "<myElement/>"+    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] []])++emptyElement2 :: Bool+emptyElement2  = parseXML "" "<myElement />"+    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] []])++elemWithText :: Bool+elemWithText  = parseXML "" "<myElement>text</myElement>"+    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] [TextNode "text"]])++xmlDeclXML :: Bool+xmlDeclXML    = parseXML "" "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"+    == Right (XmlDocument UTF8 Nothing [])++procInst :: Bool+procInst      = parseXML "" "<?myPI This''is <not> parsed!?>"+    == Right (XmlDocument UTF8 Nothing [])++badDoctype1 :: Bool+badDoctype1    = isLeft $ parseXML "" "<!DOCTYPE>"++badDoctype2 :: Bool+badDoctype2    = isLeft $ parseXML "" "<!DOCTYPE html BAD>"++badDoctype3 :: Bool+badDoctype3    = isLeft $ parseXML "" "<!DOCTYPE html SYSTEM>"++badDoctype4 :: Bool+badDoctype4    = isLeft $ parseXML "" "<!DOCTYPE html PUBLIC \"foo\">"++badDoctype5 :: Bool+badDoctype5    = isLeft $ parseXML "" ("<!DOCTYPE html SYSTEM \"foo\" "+                                       `B.append` "PUBLIC \"bar\" \"baz\">")++tagNames :: Assertion+tagNames = do+    assertBool "tag name 0"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<foo />")+    assertBool "tag name 1"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xc0\&foo />")+    assertBool "tag name 2"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xd8\&foo />")+    assertBool "tag name 3"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xf8\&foo />")+    assertBool "tag name 4"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x370\&foo />")+    assertBool "tag name 5"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x37f\&foo />")+    assertBool "tag name 6"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x200c\&foo />")+    assertBool "tag name 7"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x2070\&foo />")+    assertBool "tag name 8"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x2c00\&foo />")+    assertBool "tag name 9"  $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x3001\&foo />")+    assertBool "tag name 10" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xf900\&foo />")+    assertBool "tag name 11" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xfdf0\&foo />")+    assertBool "tag name 12" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<\x10000\&foo />")+    assertBool "tag name 13" $ id  $+        isLeft $ parseXML "" (T.encodeUtf8 "<\xd7\&foo />")+    assertBool "tag name 14" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<f-oo />")+    assertBool "tag name 15" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<f.oo />")+    assertBool "tag name 16" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<f\xb7\&oo />")+    assertBool "tag name 17" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<f3oo />")+    assertBool "tag name 18" $ not $+        isLeft $ parseXML "" (T.encodeUtf8 "<f\x203f\&oo />")+    assertBool "tag name 19" $ id  $+        isLeft $ parseXML "" (T.encodeUtf8 "<f\x2041\&oo />")+++------------------------------------------------------------------------------+-- HTML Repetitions of XML Parsing Tests -------------------------------------+------------------------------------------------------------------------------++htmlXMLParsingTests :: [Test]+htmlXMLParsingTests = [+    testIt "emptyDocumentHTML      " emptyDocumentHTML,+    testIt "publicDocTypeHTML      " publicDocTypeHTML,+    testIt "systemDocTypeHTML      " systemDocTypeHTML,+    testIt "emptyDocTypeHTML       " emptyDocTypeHTML,+    testIt "textOnlyHTML           " textOnlyHTML,+    testIt "textWithRefsHTML       " textWithRefsHTML,+    testIt "textWithCDataHTML      " textWithCDataHTML,+    testIt "cdataOnlyHTML          " cdataOnlyHTML,+    testIt "commentOnlyHTML        " commentOnlyHTML,+    testIt "emptyElementHTML       " emptyElementHTML,+    testIt "emptyElement2HTML      " emptyElement2HTML,+    testIt "elemWithTextHTML       " elemWithTextHTML,+    testIt "xmlDeclHTML            " xmlDeclHTML,+    testIt "procInstHTML           " procInstHTML,+    testIt "badDoctype1HTML        " badDoctype1HTML,+    testIt "badDoctype2HTML        " badDoctype2HTML,+    testIt "badDoctype3HTML        " badDoctype3HTML,+    testIt "badDoctype4HTML        " badDoctype4HTML,+    testIt "badDoctype5HTML        " badDoctype5HTML+    ]++emptyDocumentHTML :: Bool+emptyDocumentHTML = parseHTML "" ""+    == Right (HtmlDocument UTF8 Nothing [])++publicDocTypeHTML :: Bool+publicDocTypeHTML = parseHTML "" "<!DOCTYPE tag PUBLIC \"foo\" \"bar\">"+    == Right (HtmlDocument UTF8 (Just (DocType "tag" (Public "foo" "bar") NoInternalSubset)) [])++systemDocTypeHTML :: Bool+systemDocTypeHTML = parseHTML "" "<!DOCTYPE tag SYSTEM \"foo\">"+    == Right (HtmlDocument UTF8 (Just (DocType "tag" (System "foo") NoInternalSubset)) [])++emptyDocTypeHTML :: Bool+emptyDocTypeHTML  = parseHTML "" "<!DOCTYPE tag >"+    == Right (HtmlDocument UTF8 (Just (DocType "tag" NoExternalID NoInternalSubset)) [])++textOnlyHTML :: Bool+textOnlyHTML      = parseHTML "" "sldhfsklj''a's s"+    == Right (HtmlDocument UTF8 Nothing [TextNode "sldhfsklj''a's s"])++textWithRefsHTML :: Bool+textWithRefsHTML  = parseHTML "" "This is Bob&apos;s sled"+    == Right (HtmlDocument UTF8 Nothing [TextNode "This is Bob's sled"])++textWithCDataHTML :: Bool+textWithCDataHTML = parseHTML "" "Testing <![CDATA[with <some> c]data]]>"+    == Right (HtmlDocument UTF8 Nothing [TextNode "Testing with <some> c]data"])++cdataOnlyHTML :: Bool+cdataOnlyHTML     = parseHTML "" "<![CDATA[ Testing <![CDATA[ test ]]>"+    == Right (HtmlDocument UTF8 Nothing [TextNode " Testing <![CDATA[ test "])++commentOnlyHTML :: Bool+commentOnlyHTML   = parseHTML "" "<!-- this <is> a \"comment -->"+    == Right (HtmlDocument UTF8 Nothing [Comment " this <is> a \"comment "])++emptyElementHTML :: Bool+emptyElementHTML  = parseHTML "" "<myElement/>"+    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] []])++emptyElement2HTML :: Bool+emptyElement2HTML = parseHTML "" "<myElement />"+    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] []])++elemWithTextHTML :: Bool+elemWithTextHTML  = parseHTML "" "<myElement>text</myElement>"+    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] [TextNode "text"]])++xmlDeclHTML :: Bool+xmlDeclHTML       = parseHTML "" "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"+    == Right (HtmlDocument UTF8 Nothing [])++procInstHTML :: Bool+procInstHTML      = parseHTML "" "<?myPI This''is <not> parsed!?>"+    == Right (HtmlDocument UTF8 Nothing [])++badDoctype1HTML :: Bool+badDoctype1HTML    = isLeft $ parseHTML "" "<!DOCTYPE>"++badDoctype2HTML :: Bool+badDoctype2HTML    = isLeft $ parseHTML "" "<!DOCTYPE html BAD>"++badDoctype3HTML :: Bool+badDoctype3HTML    = isLeft $ parseHTML "" "<!DOCTYPE html SYSTEM>"++badDoctype4HTML :: Bool+badDoctype4HTML    = isLeft $ parseHTML "" "<!DOCTYPE html PUBLIC \"foo\">"++badDoctype5HTML :: Bool+badDoctype5HTML    = isLeft $ parseHTML "" ("<!DOCTYPE html SYSTEM \"foo\" "+                                       `B.append` "PUBLIC \"bar\" \"baz\">")+++------------------------------------------------------------------------------+-- HTML Quirks Parsing Tests -------------------------------------------------+------------------------------------------------------------------------------++htmlParsingQuirkTests :: [Test]+htmlParsingQuirkTests = [+    testIt   "voidElem               " voidElem,+    testIt   "caseInsDoctype1        " caseInsDoctype1,+    testIt   "caseInsDoctype2        " caseInsDoctype2,+    testIt   "voidEmptyElem          " voidEmptyElem,+    testIt   "rawTextElem            " rawTextElem,+    testIt   "endTagCase             " endTagCase,+    testIt   "hexEntityCap           " hexEntityCap,+    testIt   "laxAttrName            " laxAttrName,+    testCase "badAttrName            " badAttrName,+    testIt   "emptyAttr              " emptyAttr,+    testIt   "emptyAttr2             " emptyAttr2,+    testIt   "unquotedAttr           " unquotedAttr,+    testIt   "laxAttrVal             " laxAttrVal,+    testIt   "ampersandInText        " ampersandInText,+    testIt   "omitOptionalEnds       " omitOptionalEnds,+    testIt   "omitEndHEAD            " omitEndHEAD,+    testIt   "omitEndLI              " omitEndLI,+    testIt   "omitEndDT              " omitEndDT,+    testIt   "omitEndDD              " omitEndDD,+    testIt   "omitEndP               " omitEndP,+    testIt   "omitEndRT              " omitEndRT,+    testIt   "omitEndRP              " omitEndRP,+    testIt   "omitEndOPTGRP          " omitEndOPTGRP,+    testIt   "omitEndOPTION          " omitEndOPTION,+    testIt   "omitEndCOLGRP          " omitEndCOLGRP,+    testIt   "omitEndTHEAD           " omitEndTHEAD,+    testIt   "omitEndTBODY           " omitEndTBODY,+    testIt   "omitEndTFOOT           " omitEndTFOOT,+    testIt   "omitEndTR              " omitEndTR,+    testIt   "omitEndTD              " omitEndTD,+    testIt   "omitEndTH              " omitEndTH,+    testIt   "testNewRefs            " testNewRefs,+    testIt   "errorImplicitClose     " errorImplicitClose,+    testIt   "weirdScriptThing       " weirdScriptThing+    ]++caseInsDoctype1 :: Bool+caseInsDoctype1 = parseHTML "" "<!dOcTyPe html SyStEm 'foo'>"+    == Right (HtmlDocument UTF8 (Just (DocType "html" (System "foo") NoInternalSubset)) [])++caseInsDoctype2 :: Bool+caseInsDoctype2 = parseHTML "" "<!dOcTyPe html PuBlIc 'foo' 'bar'>"+    == Right (HtmlDocument UTF8 (Just (DocType "html" (Public "foo" "bar") NoInternalSubset)) [])++voidElem :: Bool+voidElem      = parseHTML "" "<img>"+    == Right (HtmlDocument UTF8 Nothing [Element "img" [] []])++voidEmptyElem :: Bool+voidEmptyElem = parseHTML "" "<img/>"+    == Right (HtmlDocument UTF8 Nothing [Element "img" [] []])++rawTextElem :: Bool+rawTextElem   = parseHTML "" "<script type=\"text/javascript\">This<is'\"a]]>test&amp;</script>"+    == Right (HtmlDocument UTF8 Nothing [Element "script" [("type", "text/javascript")] [+                    TextNode "This<is'\"a]]>test&amp;"]+                    ])++endTagCase :: Bool+endTagCase    = parseHTML "" "<testing></TeStInG>"+    == Right (HtmlDocument UTF8 Nothing [Element "testing" [] []])++hexEntityCap :: Bool+hexEntityCap  = parseHTML "" "&#X6a;"+    == Right (HtmlDocument UTF8 Nothing [TextNode "\x6a"])++laxAttrName :: Bool+laxAttrName   = parseHTML "" "<test val<fun=\"test\"></test>"+    == Right (HtmlDocument UTF8 Nothing [Element "test" [("val<fun", "test")] []])++badAttrName :: Assertion+badAttrName = do+    assertBool "attr name 0"  $ not $+        isLeft $ parseHTML "" (T.encodeUtf8 "<foo attr/>")+    assertBool "attr name 1"  $+        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x0002\&ttr/>")+    assertBool "attr name 2"  $+        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x000F\&ttr/>")+    assertBool "attr name 3"  $+        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x007F\&ttr/>")+    assertBool "attr name 4"  $+        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \xFDD0\&ttr/>")++emptyAttr :: Bool+emptyAttr     = parseHTML "" "<test attr></test>"+    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "")] []])++emptyAttr2 :: Bool+emptyAttr2     = parseHTML "" "<div itemscope itemtype=\"type\"></div>"+    == Right (HtmlDocument UTF8 Nothing [Element "div" [("itemscope", ""), ("itemtype", "type")] []])++unquotedAttr :: Bool+unquotedAttr  = parseHTML "" "<test attr=you&amp;me></test>"+    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "you&me")] []])++laxAttrVal :: Bool+laxAttrVal    = parseHTML "" "<test attr=\"a &amp; d < b & c\"/>"+    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "a & d < b & c")] []])++ampersandInText :: Bool+ampersandInText   = parseHTML "" "&#X6a"+    == Right (HtmlDocument UTF8 Nothing [TextNode "&#X6a"])++omitOptionalEnds :: Bool+omitOptionalEnds   = parseHTML "" "<html><body><p></html>"+    == Right (HtmlDocument UTF8 Nothing [Element "html" [] [+                Element "body" [] [ Element "p" [] []]]])++omitEndHEAD :: Bool+omitEndHEAD   = parseHTML "" "<head><body>"+    == Right (HtmlDocument UTF8 Nothing [Element "head" [] [], Element "body" [] []])++omitEndLI :: Bool+omitEndLI     = parseHTML "" "<li><li>"+    == Right (HtmlDocument UTF8 Nothing [Element "li" [] [], Element "li" [] []])++omitEndDT :: Bool+omitEndDT     = parseHTML "" "<dt><dd>"+    == Right (HtmlDocument UTF8 Nothing [Element "dt" [] [], Element "dd" [] []])++omitEndDD :: Bool+omitEndDD     = parseHTML "" "<dd><dt>"+    == Right (HtmlDocument UTF8 Nothing [Element "dd" [] [], Element "dt" [] []])++omitEndP :: Bool+omitEndP      = parseHTML "" "<p><h1></h1>"+    == Right (HtmlDocument UTF8 Nothing [Element "p" [] [], Element "h1" [] []])++omitEndRT :: Bool+omitEndRT     = parseHTML "" "<rt><rp>"+    == Right (HtmlDocument UTF8 Nothing [Element "rt" [] [], Element "rp" [] []])++omitEndRP :: Bool+omitEndRP     = parseHTML "" "<rp><rt>"+    == Right (HtmlDocument UTF8 Nothing [Element "rp" [] [], Element "rt" [] []])++omitEndOPTGRP :: Bool+omitEndOPTGRP = parseHTML "" "<optgroup><optgroup>"+    == Right (HtmlDocument UTF8 Nothing [Element "optgroup" [] [], Element "optgroup" [] []])++omitEndOPTION :: Bool+omitEndOPTION = parseHTML "" "<option><option>"+    == Right (HtmlDocument UTF8 Nothing [Element "option" [] [], Element "option" [] []])++omitEndCOLGRP :: Bool+omitEndCOLGRP = parseHTML "" "<colgroup><tbody>"+    == Right (HtmlDocument UTF8 Nothing [Element "colgroup" [] [], Element "tbody" [] []])++omitEndTHEAD :: Bool+omitEndTHEAD  = parseHTML "" "<thead><tbody>"+    == Right (HtmlDocument UTF8 Nothing [Element "thead" [] [], Element "tbody" [] []])++omitEndTBODY :: Bool+omitEndTBODY  = parseHTML "" "<tbody><thead>"+    == Right (HtmlDocument UTF8 Nothing [Element "tbody" [] [], Element "thead" [] []])++omitEndTFOOT :: Bool+omitEndTFOOT  = parseHTML "" "<tfoot><tbody>"+    == Right (HtmlDocument UTF8 Nothing [Element "tfoot" [] [], Element "tbody" [] []])++omitEndTR :: Bool+omitEndTR     = parseHTML "" "<tr><tr>"+    == Right (HtmlDocument UTF8 Nothing [Element "tr" [] [], Element "tr" [] []])++omitEndTD :: Bool+omitEndTD     = parseHTML "" "<td><td>"+    == Right (HtmlDocument UTF8 Nothing [Element "td" [] [], Element "td" [] []])++omitEndTH :: Bool+omitEndTH     = parseHTML "" "<th><td>"+    == Right (HtmlDocument UTF8 Nothing [Element "th" [] [], Element "td" [] []])++testNewRefs :: Bool+testNewRefs   = parseHTML "" "&CenterDot;&doublebarwedge;&fjlig;"+    == Right (HtmlDocument UTF8 Nothing [TextNode "\x000B7\x02306\&fj"])++errorImplicitClose :: Bool+errorImplicitClose = isLeft $ parseHTML "" "<p><pre>foo</pre></p>"++weirdScriptThing :: Bool+weirdScriptThing = parseHTML "" "<div><script type=\"text/javascript\">selector.append('<option>'+name+'</option>');</script></div>"+    == Right (HtmlDocument UTF8 Nothing [+        Element "div" [] [+            Element "script" [("type", "text/javascript")] [+                TextNode "selector.append('<option>'+name+'</option>');"+                ]+            ]+        ])++------------------------------------------------------------------------------+-- XML Rendering Tests -------------------------------------------------------+------------------------------------------------------------------------------++xmlRenderingTests :: [Test]+xmlRenderingTests = [+    testIt "renderByteOrderMark    " renderByteOrderMark,+    testIt "renderByteOrderMarkLE  " renderByteOrderMarkLE,+    testIt "singleQuoteInSysID     " singleQuoteInSysID,+    testIt "doubleQuoteInSysID     " doubleQuoteInSysID,+    testIt "bothQuotesInSysID      " bothQuotesInSysID,+    testIt "doubleQuoteInPubID     " doubleQuoteInPubID,+    testIt "doubleDashInComment    " doubleDashInComment,+    testIt "trailingDashInComment  " trailingDashInComment,+    testIt "renderEmptyText        " renderEmptyText,+    testIt "singleQuoteInAttr      " singleQuoteInAttr,+    testIt "doubleQuoteInAttr      " doubleQuoteInAttr,+    testIt "bothQuotesInAttr       " bothQuotesInAttr+    ]++renderByteOrderMark :: Bool+renderByteOrderMark =+    toByteString (render (XmlDocument UTF16BE Nothing []))+    == T.encodeUtf16BE "\xFEFF<?xml version=\"1.0\" encoding=\"UTF-16\"?>\n"++renderByteOrderMarkLE :: Bool+renderByteOrderMarkLE =+    toByteString (render (XmlDocument UTF16LE Nothing []))+    == T.encodeUtf16LE "\xFEFF<?xml version=\"1.0\" encoding=\"UTF-16\"?>\n"++-- (Appears at the beginning of all XML output)+utf8Decl :: ByteString+utf8Decl = T.encodeUtf8 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"++singleQuoteInSysID :: Bool+singleQuoteInSysID =+    toByteString (render (XmlDocument UTF8+        (Just (DocType "html" (System "test\'ing") NoInternalSubset))+        []))+    == utf8Decl `B.append` "<!DOCTYPE html SYSTEM \"test\'ing\">\n"++doubleQuoteInSysID :: Bool+doubleQuoteInSysID =+    toByteString (render (XmlDocument UTF8+        (Just (DocType "html" (System "test\"ing") NoInternalSubset))+        []))+    == utf8Decl `B.append` "<!DOCTYPE html SYSTEM \'test\"ing\'>\n"++bothQuotesInSysID :: Bool+bothQuotesInSysID = isBottom $+    toByteString (render (XmlDocument UTF8+        (Just (DocType "html" (System "test\"\'ing") NoInternalSubset))+        []))++doubleQuoteInPubID :: Bool+doubleQuoteInPubID = isBottom $+    toByteString (render (XmlDocument UTF8+        (Just (DocType "html" (Public "test\"ing" "foo") NoInternalSubset))+        []))++doubleDashInComment :: Bool+doubleDashInComment = isBottom $+    toByteString (render (XmlDocument UTF8 Nothing [+        Comment "test--ing"+        ]))++trailingDashInComment :: Bool+trailingDashInComment = isBottom $+    toByteString (render (XmlDocument UTF8 Nothing [+        Comment "testing-"+        ]))++renderEmptyText :: Bool+renderEmptyText =+    toByteString (render (XmlDocument UTF8 Nothing [+        TextNode ""+        ]))+    == utf8Decl++singleQuoteInAttr :: Bool+singleQuoteInAttr =+    toByteString (render (XmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\'ing")] []+        ]))+    == utf8Decl `B.append` "<foo bar=\"test\'ing\"/>"++doubleQuoteInAttr :: Bool+doubleQuoteInAttr =+    toByteString (render (XmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\"ing")] []+        ]))+    == utf8Decl `B.append` "<foo bar=\'test\"ing\'/>"++bothQuotesInAttr :: Bool+bothQuotesInAttr =+    toByteString (render (XmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\'\"ing")] []+        ]))+    == utf8Decl `B.append` "<foo bar=\"test\'&quot;ing\"/>"+++------------------------------------------------------------------------------+-- HTML Repeats of XML Rendering Tests ---------------------------------------+------------------------------------------------------------------------------++htmlXMLRenderingTests :: [Test]+htmlXMLRenderingTests = [+    testIt "hRenderByteOrderMark   " hRenderByteOrderMark,+    testIt "hSingleQuoteInSysID    " hSingleQuoteInSysID,+    testIt "hDoubleQuoteInSysID    " hDoubleQuoteInSysID,+    testIt "hBothQuotesInSysID     " hBothQuotesInSysID,+    testIt "hDoubleQuoteInPubID    " hDoubleQuoteInPubID,+    testIt "hDoubleDashInComment   " hDoubleDashInComment,+    testIt "hTrailingDashInComment " hTrailingDashInComment,+    testIt "hRenderEmptyText       " hRenderEmptyText,+    testIt "hSingleQuoteInAttr     " hSingleQuoteInAttr,+    testIt "hDoubleQuoteInAttr     " hDoubleQuoteInAttr,+    testIt "hBothQuotesInAttr      " hBothQuotesInAttr+    ]++hRenderByteOrderMark :: Bool+hRenderByteOrderMark =+    toByteString (render (HtmlDocument UTF16BE Nothing []))+    == "\xFE\xFF"++hSingleQuoteInSysID :: Bool+hSingleQuoteInSysID =+    toByteString (render (HtmlDocument UTF8+        (Just (DocType "html" (System "test\'ing") NoInternalSubset))+        []))+    == "<!DOCTYPE html SYSTEM \"test\'ing\">\n"++hDoubleQuoteInSysID :: Bool+hDoubleQuoteInSysID =+    toByteString (render (HtmlDocument UTF8+        (Just (DocType "html" (System "test\"ing") NoInternalSubset))+        []))+    == "<!DOCTYPE html SYSTEM \'test\"ing\'>\n"++hBothQuotesInSysID :: Bool+hBothQuotesInSysID = isBottom $+    toByteString (render (HtmlDocument UTF8+        (Just (DocType "html" (System "test\"\'ing") NoInternalSubset))+        []))++hDoubleQuoteInPubID :: Bool+hDoubleQuoteInPubID = isBottom $+    toByteString (render (HtmlDocument UTF8+        (Just (DocType "html" (Public "test\"ing" "foo") NoInternalSubset))+        []))++hDoubleDashInComment :: Bool+hDoubleDashInComment = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Comment "test--ing"+        ]))++hTrailingDashInComment :: Bool+hTrailingDashInComment = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Comment "testing-"+        ]))++hRenderEmptyText :: Bool+hRenderEmptyText =+    toByteString (render (HtmlDocument UTF8 Nothing [+        TextNode ""+        ]))+    == ""++hSingleQuoteInAttr :: Bool+hSingleQuoteInAttr =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\'ing")] []+        ]))+    == "<foo bar=\"test\'ing\"></foo>"++hDoubleQuoteInAttr :: Bool+hDoubleQuoteInAttr =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\"ing")] []+        ]))+    == "<foo bar=\'test\"ing\'></foo>"++hBothQuotesInAttr :: Bool+hBothQuotesInAttr =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "foo" [("bar", "test\'\"ing")] []+        ]))+    == "<foo bar=\"test\'&quot;ing\"></foo>"+++------------------------------------------------------------------------------+-- HTML Quirks Rendering Tests -----------------------------------------------+------------------------------------------------------------------------------++htmlRenderingQuirkTests :: [Test]+htmlRenderingQuirkTests = [+    testIt "renderHTMLVoid         " renderHTMLVoid,+    testIt "renderHTMLVoid2        " renderHTMLVoid2,+    testIt "renderHTMLRaw          " renderHTMLRaw,+    testIt "renderHTMLRawMult      " renderHTMLRawMult,+    testIt "renderHTMLRaw2         " renderHTMLRaw2,+    testIt "renderHTMLRaw3         " renderHTMLRaw3,+    testIt "renderHTMLRaw4         " renderHTMLRaw4,+    testIt "renderHTMLAmpAttr1     " renderHTMLAmpAttr1,+    testIt "renderHTMLAmpAttr2     " renderHTMLAmpAttr2,+    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+renderHTMLVoid =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "img" [("src", "foo")] []+        ]))+    == "<img src=\'foo\' />"++renderHTMLVoid2 :: Bool+renderHTMLVoid2 = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "img" [] [TextNode "foo"]+        ]))++renderHTMLRaw :: Bool+renderHTMLRaw =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "script" [("type", "text/javascript")] [+            TextNode "<testing>/&+</foo>"+            ]+        ]))+    == "<script type=\'text/javascript\'><testing>/&+</foo></script>"++renderHTMLRawMult :: Bool+renderHTMLRawMult =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "script" [("type", "text/javascript")] [+            TextNode "foo",+            TextNode "bar"+            ]+        ]))+    == "<script type=\'text/javascript\'>foobar</script>"++renderHTMLRaw2 :: Bool+renderHTMLRaw2 = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "script" [("type", "text/javascript")] [+            TextNode "</script>"+            ]+        ]))++renderHTMLRaw3 :: Bool+renderHTMLRaw3 = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "script" [("type", "text/javascript")] [+            Comment "foo"+            ]+        ]))++renderHTMLRaw4 :: Bool+renderHTMLRaw4 = isBottom $+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "script" [("type", "text/javascript")] [+            TextNode "</scri",+            TextNode "pt>"+            ]+        ]))++renderHTMLAmpAttr1 :: Bool+renderHTMLAmpAttr1 =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "body" [("foo", "a & b")] [] ]))+    == "<body foo=\'a & b\'></body>"++renderHTMLAmpAttr2 :: Bool+renderHTMLAmpAttr2 =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "body" [("foo", "a &amp; b")] [] ]))+    == "<body foo=\'a &amp;amp; b\'></body>"++renderHTMLAmpAttr3 :: Bool+renderHTMLAmpAttr3 =+    toByteString (render (HtmlDocument UTF8 Nothing [+        Element "body" [("foo", "a &#x65; b")] [] ]))+    == "<body foo=\'a &amp;#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>"+            ]+        ]))+++------------------------------------------------------------------------------+-- Tests of rendering from the blaze-html package ----------------------------+------------------------------------------------------------------------------++blazeRenderTests :: [Test]+blazeRenderTests = [+    testIt   "blazeTestString        " blazeTestString,+    testIt   "blazeTestText          " blazeTestText,+    testIt   "blazeTestBS            " blazeTestBS,+    testIt   "blazeTestPre           " blazeTestPre,+    testIt   "blazeTestExternal      " blazeTestExternal,+    testIt   "blazeTestCustom        " blazeTestCustom,+    testIt   "blazeTestMulti         " blazeTestMulti,+    testIt   "blazeTestEmpty         " blazeTestEmpty+    ]++blazeTestIsString :: (IsString t1, IsString t) =>+     (t -> AttributeValue) -> (t1 -> Html) -> Bool+blazeTestIsString valFunc tagFunc = renderHtml html == result+  where+    html = H.div ! A.class_ (valFunc "foo") $ tagFunc "hello world"+    result = HtmlDocument UTF8 Nothing [Element "div" [("class", "foo")] [TextNode "hello world"]]++blazeTestString :: Bool+blazeTestString = blazeTestIsString H.stringValue H.string++blazeTestText :: Bool+blazeTestText = blazeTestIsString H.textValue H.text++blazeTestBS :: Bool+blazeTestBS = blazeTestIsString H.unsafeByteStringValue H.unsafeByteString++blazeTestPre :: Bool+blazeTestPre = blazeTestIsString H.preEscapedStringValue H.preEscapedString++blazeTestExternal :: Bool+blazeTestExternal = renderHtml html == result+  where+    html = do+        H.script $ H.string "alert('hello world');"+    result = HtmlDocument UTF8 Nothing [Element "script" [] [TextNode "alert('hello world');"]]++blazeTestCustom :: Bool+blazeTestCustom = renderHtml html == result+  where+    html = do+        H.select ! H.customAttribute "dojoType" (mappend "select " "this") $ "foo"+    result = HtmlDocument UTF8 Nothing [Element "select" [("dojoType", "select this")] [TextNode "foo"]]++blazeTestMulti :: Bool+blazeTestMulti = renderHtml (selectCustom `mappend` html) == result+  where+    html = do+        H.link ! A.rel "stylesheet"+    result = HtmlDocument UTF8 Nothing+        [ Element "select" [("dojoType", "select")] [TextNode "foo ", TextNode "bar"]+        , Element "link" [("rel", "stylesheet")] []+        ]++blazeTestEmpty :: Bool+blazeTestEmpty = renderHtmlNodes mempty == []++selectCustom :: Html+selectCustom = H.select ! H.customAttribute "dojoType" "select" $ (mappend "foo " "bar")+++

@@ -1,9 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import           Test.Framework (defaultMain)-import           Text.XmlHtml.Tests (tests)--main :: IO ()-main = defaultMain tests

@@ -1,505 +0,0 @@-{-# LANGUAGE OverloadedStrings         #-}--module Text.XmlHtml.CursorTests (cursorTests) where--import           Data.Maybe-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.HUnit hiding (Test, Node)-import           Text.XmlHtml-import           Text.XmlHtml.Cursor-import           Text.XmlHtml.TestCommon----------------------------------------------------------------------------------- Tests of navigating with the Cursor type -------------------------------------------------------------------------------------------------------------------cursorTests :: [Test]-cursorTests = [-    testIt   "fromNodeAndCurrent     " $ fromNodeAndCurrent,-    testIt   "fromNodesAndSiblings   " $ fromNodesAndSiblings,-    testIt   "leftSiblings           " $ leftSiblings,-    testIt   "emptyFromNodes         " $ emptyFromNodes,-    testIt   "cursorNEQ              " $ cursorNEQ,-    testCase "cursorNavigation       " $ cursorNavigation,-    testCase "cursorSearch           " $ cursorSearch,-    testCase "cursorMutation         " $ cursorMutation,-    testCase "cursorInsertion        " $ cursorInsertion,-    testCase "cursorDeletion         " $ cursorDeletion-    ]--fromNodeAndCurrent :: Bool-fromNodeAndCurrent = all (\n -> n == current (fromNode n)) ns-    where ns = [-            TextNode "foo",-            Comment "bar",-            Element "foo" [] [],-            Element "root" [] [-                TextNode "foo",-                Comment "bar",-                Element "foo" [] []-                ]-            ]--fromNodesAndSiblings :: Bool-fromNodesAndSiblings = n == siblings (fromJust $ fromNodes n)-    where n = [-            TextNode "foo",-            Comment "bar",-            Element "foo" [] [],-            Element "root" [] [-                TextNode "foo",-                Comment "bar",-                Element "foo" [] []-                ]-            ]--leftSiblings :: Bool-leftSiblings = fromJust $ do-        r <- do-            c1 <- fromNodes n-            c2 <- right c1-            c3 <- right c2-            return c3-        return (n == siblings r)-    where n = [-            TextNode "foo",-            Comment "bar",-            Element "foo" [] [],-            Element "root" [] [-                TextNode "foo",-                Comment "bar",-                Element "foo" [] []-                ]-            ]--emptyFromNodes :: Bool-emptyFromNodes = isNothing (fromNodes [])--cursorNEQ :: Bool-cursorNEQ = let a = fromNode (Element "a" [] [])-                b = fromNode (Element "b" [] [])-            in  a /= b---- Sample node structure for running cursor tests.-cursorTestTree :: Node-cursorTestTree = Element "department" [("code", "A17")] [-    Element "employee" [("name", "alice")] [-        Element "address" [] [-            TextNode "124 My Road"-            ],-        Element "phone" [] [-            TextNode "555-1234"-            ]-        ],-    Element "employee" [("name", "bob")] [-        Comment "My best friend",-        Element "address" [] [-            TextNode "123 My Road"-            ],-        Element "temp" [] []-        ],-    Element "employee" [("name", "camille")] [-        Element "phone" [] [-            TextNode "800-888-8888"-            ]-        ]-    ]--cursorNavigation :: Assertion-cursorNavigation = do-    let r = fromNode cursorTestTree--    let Just e1 = firstChild r-    let Just e2 = getChild 1 r-    let Just e3 = lastChild r--    assertBool "rootElem" $ isElement (current r)-    assertBool "parent of root" $ isNothing (parent r)--    assertBool "getChild bounds" $ isNothing (getChild 3 r)-    assertBool "getChild negative bounds" $ isNothing (getChild (-1) r)-    assertBool "firstChild"      $-        getAttribute "name" (current e1) == Just "alice"-    assertBool "childAt 1 "      $-        getAttribute "name" (current e2) == Just "bob"-    assertBool "lastChild "      $-        getAttribute "name" (current e3) == Just "camille"--    do let Just a = lastChild e2-       assertBool "firstChild on empty element" $ isNothing (firstChild a)-       assertBool "getChild on empty element"   $ isNothing (getChild 0 a)-       assertBool "lastChild on empty element"  $ isNothing (lastChild a)--    do let Just a = right e1-       let Just b = right a-       assertBool "two paths #1" $ a == e2-       assertBool "two paths #2" $ b == e3-       assertBool "right off end" $ isNothing (right b)--       let Just c = left e3-       let Just d = left e2-       assertBool "two paths #3" $ c == e2-       assertBool "two paths #4" $ d == e1-       assertBool  "left off end" $ isNothing (left d)--    do let Just r1 = parent e2-       assertEqual "child -> parent" (current r) (current r1)--    do let Just cmt = firstChild e2-       assertBool  "topNode"  $ tagName (topNode cmt) == Just "department"-       assertBool  "topNodes" $ map tagName (topNodes cmt) == [ Just "department" ]--       assertBool "first child of comment" $ isNothing (firstChild cmt)-       assertBool "last  child of comment" $ isNothing (lastChild cmt)--    do assertBool "nextDF down" $ nextDF r == Just e1--       let Just cmt = firstChild e2-       assertBool "nextDF right" $ nextDF cmt == right cmt--       let Just em = lastChild e2-       assertBool "nextDF up-right" $ nextDF em == Just e3-       -       let Just pelem = lastChild e3-       let Just ptext = lastChild pelem-       assertBool "nextDF end" $ isNothing (nextDF ptext)---cursorSearch :: Assertion-cursorSearch = do-    let r = fromNode cursorTestTree--    let Just e1 = findChild isFirst r-    let Just e2 = findChild ((==(Just "bob")) . getAttribute "name" .  current) r-    let Just e3 = findChild isLast r--    assertBool "findChild isFirst" $-        getAttribute "name" (current e1) == Just "alice"-    assertBool "findChild" $-        getAttribute "name" (current e2) == Just "bob"-    assertBool "findChild isLast" $-        getAttribute "name" (current e3) == Just "camille"--    assertBool "findLeft Just" $ findLeft (const True) e2 == Just e1-    assertBool "findLeft Nothing" $ findLeft (const False) e2 == Nothing-    assertBool "findRight Just" $ findRight (const True) e2 == Just e3-    assertBool "findRight Nothing" $ findRight (const False) e2 == Nothing-    assertBool "findRec" $ findRec (not . hasChildren) r == (firstChild =<< firstChild e1)--    assertBool "isChild true" $ isChild e1-    assertBool "isChild false" $ not $ isChild r-    assertBool "getNodeIndex" $ getNodeIndex e2 == 1---cursorMutation :: Assertion-cursorMutation = do-    let r = fromNode cursorTestTree--    let Just e1 = firstChild r-    let Just e2 = right e1-    let Just e3 = lastChild r--    do let Just cmt = firstChild e2-       let cmt'     = setNode (Comment "Not my friend any more") cmt-       let Just e2' = parent cmt'-       assertBool "setNode" $ current e2' ==-            Element "employee" [("name", "bob")] [-                Comment "Not my friend any more",-                Element "address" [] [-                    TextNode "123 My Road"-                    ],-                Element "temp" [] []-                ]--    do let e1' = modifyNode (setAttribute "name" "bryan") e1-       let n   = current e1'-       assertBool "modifyNode" $ getAttribute "name" n == Just "bryan"--    do let myModifyM = return . setAttribute "name" "chelsea"-       e3' <- modifyNodeM myModifyM e3-       let n   = current e3'-       assertBool "modifyNode" $ getAttribute "name" n == Just "chelsea"---cursorInsertion :: Assertion-cursorInsertion = do-    let r            = fromNode cursorTestTree-    let Just alice   = firstChild r-    let Just bob     = getChild 1 r-    let Just camille = lastChild r--    let fred = Element "employee" [("name", "fred")] []--    -- Stock insertLeft-    do let ins    = insertLeft fred bob-       assertBool "insertLeft leaves cursor" $-            getAttribute "name" (current ins) == Just "bob"--       let Just a = findLeft isFirst ins-       assertBool "insertLeft 1" $-            getAttribute "name" (current a) == Just "alice"--       let Just b = right a-       assertBool "insertLeft 2" $-            getAttribute "name" (current b) == Just "fred"--       let Just c = right b-       assertBool "insertLeft 3" $-            getAttribute "name" (current c) == Just "bob"--       let Just d = right c-       assertBool "insertLeft 4" $-            getAttribute "name" (current d) == Just "camille"--    -- insertLeft on first child-    do let ins    = insertLeft fred alice-       assertBool "insertLeft firstChild" $-            getAttribute "name" (current ins) == Just "alice"--       let Just a = findLeft isFirst ins-       assertBool "insertLeft firstChild 1" $-            getAttribute "name" (current a) == Just "fred"--    -- Stock insertRight-    do let ins    = insertRight fred alice-       assertBool "insertRight leaves cursor" $-            getAttribute "name" (current ins) == Just "alice"--       let Just a = findRight isLast ins-       assertBool "insertRight 1" $-            getAttribute "name" (current a) == Just "camille"--       let Just b = left a-       assertBool "insertRight 2" $-            getAttribute "name" (current b) == Just "bob"--       let Just c = left b-       assertBool "insertRight 3" $-            getAttribute "name" (current c) == Just "fred"--       let Just d = left c-       assertBool "insertRight 4" $-            getAttribute "name" (current d) == Just "alice"--    -- insertRight on last child-    do let ins    = insertRight fred camille-       assertBool "insertRight lastChild" $-            getAttribute "name" (current ins) == Just "camille"--       let Just a = findRight isLast ins-       assertBool "insertRight lastChild 1" $-            getAttribute "name" (current a) == Just "fred"--    let mary = Element "employee" [("name", "mary")] []-    let new  = [fred, mary]--    -- insertManyLeft-    do let ins = insertManyLeft new camille-       assertBool "insertManyLeft leaves cursor" $-            getAttribute "name" (current ins) == Just "camille"--       let Just a = left ins-       assertBool "insertManyLeft 1" $-            getAttribute "name" (current a) == Just "mary"--       let Just b = left a-       assertBool "insertManyLeft 2" $-            getAttribute "name" (current b) == Just "fred"--       let Just c = left b-       assertBool "insertManyLeft 3" $-            getAttribute "name" (current c) == Just "bob"--    -- insertManyRight-    do let ins = insertManyRight new alice-       assertBool "insertManyRight leaves cursor" $-            getAttribute "name" (current ins) == Just "alice"--       let Just a = right ins-       assertBool "insertManyRight 1" $-            getAttribute "name" (current a) == Just "fred"--       let Just b = right a-       assertBool "insertManyRight 2" $-            getAttribute "name" (current b) == Just "mary"--       let Just c = right b-       assertBool "insertManyRight 3" $-            getAttribute "name" (current c) == Just "bob"--    -- insertFirstChild and insertLastChild-    do let Just ins1 = insertFirstChild fred r-       let Just ins2 = insertLastChild mary ins1--       let Just a = firstChild ins2-       assertBool "insert children 1" $-            getAttribute "name" (current a) == Just "fred"--       let Just b = right a-       assertBool "insert children 2" $-            getAttribute "name" (current b) == Just "alice"--       let Just c = right b-       assertBool "insert children 3" $-            getAttribute "name" (current c) == Just "bob"--       let Just d = right c-       assertBool "insert children 4" $-            getAttribute "name" (current d) == Just "camille"--       let Just e = right d-       assertBool "insert children 5" $-            getAttribute "name" (current e) == Just "mary"-       assertBool "insert children 6" $ isLast e--    -- non-element insertFirstChild and insertLastChild-    do let Just cmt = firstChild bob-       assertBool "non-elem insertFirstChild" $-            insertFirstChild fred cmt == Nothing-       assertBool "non-elem insertLastChild" $-            insertLastChild fred cmt == Nothing-       assertBool "non-elem insertManyFirstChild" $-            insertManyFirstChild new cmt == Nothing-       assertBool "non-elem insertManyLastChild" $-            insertManyLastChild new cmt == Nothing--    -- insertManyFirstChild-    do let Just ins = insertManyFirstChild new r--       let Just a = firstChild ins-       assertBool "insertManyFirstChild 1" $-            getAttribute "name" (current a) == Just "fred"--       let Just b = right a-       assertBool "insertManyFirstChild 2" $-            getAttribute "name" (current b) == Just "mary"--       let Just c = right b-       assertBool "insertManyFirstChild 3" $-            getAttribute "name" (current c) == Just "alice"--       let Just d = right c-       assertBool "insertManyFirstChild 4" $-            getAttribute "name" (current d) == Just "bob"--       let Just e = right d-       assertBool "insertManyFirstChild 5" $-            getAttribute "name" (current e) == Just "camille"-       assertBool "insertManyFirstChild 6" $ isLast e---    -- insertManyLastChild-    do let Just ins = insertManyLastChild new r--       let Just a = firstChild ins-       assertBool "insertManyFirstChild 1" $-            getAttribute "name" (current a) == Just "alice"--       let Just b = right a-       assertBool "insertManyFirstChild 2" $-            getAttribute "name" (current b) == Just "bob"--       let Just c = right b-       assertBool "insertManyFirstChild 3" $-            getAttribute "name" (current c) == Just "camille"--       let Just d = right c-       assertBool "insertManyFirstChild 4" $-            getAttribute "name" (current d) == Just "fred"--       let Just e = right d-       assertBool "insertManyFirstChild 5" $-            getAttribute "name" (current e) == Just "mary"-       assertBool "insertManyFirstChild 6" $ isLast e--    -- insertGoLeft from middle-    do let ins    = insertGoLeft fred bob-       let Just a = right ins-       assertBool "insertGoLeft 1" $-            getAttribute "name" (current ins) == Just "fred"-       assertBool "insertGoLeft 2" $-            getAttribute "name" (current a)   == Just "bob"--    -- insertGoLeft from end-    do let ins    = insertGoLeft fred alice-       let Just a = right ins-       assertBool "insertGoLeft 3" $-            getAttribute "name" (current ins) == Just "fred"-       assertBool "insertGoLeft 4" $-            getAttribute "name" (current a)   == Just "alice"--    -- insertGoRight from middle-    do let ins    = insertGoRight fred bob-       let Just a = left ins-       assertBool "insertGoRight 1" $-            getAttribute "name" (current ins) == Just "fred"-       assertBool "insertGoRight 2" $-            getAttribute "name" (current a)   == Just "bob"--    -- insertGoRight from end-    do let ins    = insertGoRight fred camille-       let Just a = left ins-       assertBool "insertGoRight 3" $-            getAttribute "name" (current ins) == Just "fred"-       assertBool "insertGoRight 4" $-            getAttribute "name" (current a)   == Just "camille"---cursorDeletion :: Assertion-cursorDeletion = do-    let r = fromNode cursorTestTree-    let Just alice   = firstChild r-    let Just bob     = getChild 1 r-    let Just camille = lastChild r--    -- removeLeft success-    do let Just (n,del) = removeLeft bob-       let [b,c] = siblings del-       assertBool "removeLeft node1" $ getAttribute "name" n == Just "alice"-       assertBool "removeLeft node2" $ getAttribute "name" b == Just "bob"-       assertBool "removeLeft node3" $ getAttribute "name" c == Just "camille"--    -- removeLeft failure-    do assertBool "removeLeft failure" $ isNothing (removeLeft alice)--    -- removeRight success-    do let Just (n,del) = removeRight bob-       let [a,b] = siblings del-       assertBool "removeLeft node1" $ getAttribute "name" a == Just "alice"-       assertBool "removeLeft node2" $ getAttribute "name" b == Just "bob"-       assertBool "removeLeft node3" $ getAttribute "name" n == Just "camille"--    -- removeRight failure-    do assertBool "removeLeft failure" $ isNothing (removeRight camille)--    -- removeGoLeft success-    do let Just del = removeGoLeft bob-       let Just c   = right del-       assertBool "removeGoLeft 1" $-            getAttribute "name" (current del) == Just "alice"-       assertBool "removeGoLeft 2" $-            getAttribute "name" (current c) == Just "camille"--    -- removeGoLeft failure-    do assertBool "removeGoLeft failure" $ isNothing (removeGoLeft alice)--    -- removeGoRight success-    do let Just del = removeGoRight bob-       let Just a   = left del-       assertBool "removeGoRight 1" $-            getAttribute "name" (current del) == Just "camille"-       assertBool "removeGoRight 2" $-            getAttribute "name" (current a) == Just "alice"--    -- removeGoLeft failure-    do assertBool "removeGoRight failure" $ isNothing (removeGoRight camille)--    -- removeGoUp success-    do let Just del = removeGoUp bob-       let [a,c]    = childNodes (current del)-       assertBool "removeGoUp 1" $ getAttribute "name" a == Just "alice"-       assertBool "removeGoUp 2" $ getAttribute "name" c == Just "camille"--    -- removeGoUp failure-    do assertBool "removeGoUp failure" $ isNothing (removeGoUp r)

@@ -1,274 +0,0 @@-{-# LANGUAGE OverloadedStrings         #-}--module Text.XmlHtml.DocumentTests (documentTests) where--import           Data.Text ()                  -- for string instance-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.HUnit hiding (Node, Test)-import           Text.XmlHtml-import           Text.XmlHtml.TestCommon------------------------------------------------------------------------------------ Tests of manipulating the Node tree and Document -----------------------------------------------------------------------------------------------------------documentTests :: [Test]-documentTests = [-    -- Exercise the (/=) operators; (==) is done plenty of places.-    testIt   "compareExternalIDs     " $ compareExternalIDs,-    testIt   "compareInternalSubs    " $ compareInternalSubs,-    testIt   "compareDoctypes        " $ compareDoctypes,-    testIt   "compareNodes           " $ compareNodes,-    testIt   "compareDocuments       " $ compareDocuments,-    testIt   "compareEncodings       " $ compareEncodings,--    -- Silly tests just to exercise the Show instances on types.-    testCase "exerciseShows          " $ exerciseShows,--    -- Exercise the accessors for Document and Node-    testCase "docNodeAccessors       " $ docNodeAccessors,--    testIt   "isTextNodeYes          " $ isTextNode someTextNode,-    testIt   "isTextNodeNo           " $ not $ isTextNode someComment,-    testIt   "isTextNodeNo2          " $ not $ isTextNode someElement,-    testIt   "isCommentYes           " $ isComment someComment,-    testIt   "isCommentNo            " $ not $ isComment someTextNode,-    testIt   "isCommentNo2           " $ not $ isComment someElement,-    testIt   "isElementYes           " $ isElement someElement,-    testIt   "isElementNo            " $ not $ isElement someTextNode,-    testIt   "isElementNo2           " $ not $ isElement someComment,-    testIt   "tagNameElement         " $ tagName someElement == Just "baz",-    testIt   "tagNameText            " $ tagName someTextNode == Nothing,-    testIt   "tagNameComment         " $ tagName someComment == Nothing,-    testIt   "getAttributePresent    " $ getAttribute "fiz" someElement-                                            == Just "buzz",-    testIt   "getAttributeMissing    " $ getAttribute "baz" someElement-                                            == Nothing,-    testIt   "getAttributeWrongType  " $ getAttribute "fix" someTextNode-                                            == Nothing,-    testIt   "hasAttributePresent    " $ hasAttribute "fiz" someElement,-    testIt   "hasAttributeMissing    " $ not $ hasAttribute "baz" someElement,-    testIt   "hasAttributeWrongType  " $ not $ hasAttribute "fix" someTextNode,-    testIt   "setAttributeNew        " $ setAttributeNew,-    testIt   "setAttributeReplace    " $ setAttributeReplace,-    testIt   "setAttributeWrongType  " $ setAttributeWrongType,-    testIt   "nestedNodeText         " $ nestedNodeText,-    testIt   "childNodesElem         " $ childNodesElem,-    testIt   "childNodesOther        " $ childNodesOther,-    testIt   "childElemsTest         " $ childElemsTest,-    testIt   "childElemsTagTest      " $ childElemsTagTest,-    testIt   "childElemTagExists     " $ childElemTagExists,-    testIt   "childElemTagNotExists  " $ childElemTagNotExists,-    testIt   "childElemTagOther      " $ childElemTagOther,-    testIt   "descNodesElem          " $ descNodesElem,-    testIt   "descNodesOther         " $ descNodesOther,-    testIt   "descElemsTest          " $ descElemsTest,-    testIt   "descElemsTagTest       " $ descElemsTagTest,-    testIt   "descElemTagExists      " $ descElemTagExists,-    testIt   "descElemTagDFS         " $ descElemTagDFS,-    testIt   "descElemTagNotExists   " $ descElemTagNotExists,-    testIt   "descElemTagOther       " $ descElemTagOther-    ]---compareExternalIDs :: Bool-compareExternalIDs = Public "foo" "bar" /= System "bar"--compareInternalSubs :: Bool-compareInternalSubs = InternalText "" /= NoInternalSubset--compareDoctypes :: Bool-compareDoctypes = DocType "html" NoExternalID NoInternalSubset-               /= DocType "foo"  NoExternalID NoInternalSubset--compareNodes :: Bool-compareNodes = TextNode "" /= Comment ""--compareDocuments :: Bool-compareDocuments = XmlDocument UTF8 Nothing [] /= HtmlDocument UTF8 Nothing []--compareEncodings :: Bool-compareEncodings = UTF8 /= UTF16BE--exerciseShows :: Assertion-exerciseShows = do-    assertBool "1" $ length (showList [NoExternalID] "") > 0-    assertBool "2" $ length (showList [NoInternalSubset] "") > 0-    assertBool "3" $ length (showList [DocType "foo" NoExternalID NoInternalSubset] "") > 0-    assertBool "4" $ length (showList [TextNode ""] "") > 0-    assertBool "5" $ length (showList [XmlDocument UTF8 Nothing []] "") > 0-    assertBool "6" $ length (showList [UTF8] "") > 0--docNodeAccessors :: Assertion-docNodeAccessors = do-    let hdoc = HtmlDocument UTF8 Nothing []-    assertEqual "html enc"  (docEncoding hdoc) UTF8-    assertEqual "html type" (docType hdoc) Nothing-    assertEqual "html nodes" (docContent hdoc) []--    let xdoc = XmlDocument UTF8 Nothing []-    assertEqual "xml enc"  (docEncoding xdoc) UTF8-    assertEqual "xml type" (docType xdoc) Nothing-    assertEqual "xml nodes" (docContent xdoc) []--    let elm = Element  "foo" [] []-    let txt = TextNode ""-    let cmt = Comment  ""-    assertEqual "elm tag"   (elementTag      elm) "foo"-    assertEqual "elm attr"  (elementAttrs    elm) []-    assertEqual "elm child" (elementChildren elm) []-    assertBool  "txt tag"   $ isBottom (elementTag      txt)-    assertBool  "txt attr"  $ isBottom (elementAttrs    txt)-    assertBool  "txt child" $ isBottom (elementChildren txt)-    assertBool  "cmt tag"   $ isBottom (elementTag      cmt)-    assertBool  "cmt attr"  $ isBottom (elementAttrs    cmt)-    assertBool  "cmt child" $ isBottom (elementChildren cmt)---someTextNode :: Node-someTextNode = TextNode "foo"--someComment :: Node-someComment = Comment "bar"--someElement :: Node-someElement = Element "baz" [("fiz","buzz")] [TextNode "content"]--someTree :: Node-someTree = Element "department" [("code", "A17")] [-    Element "employee" [("name", "bob")] [-        Comment "My best friend",-        Element "address" [] [-            TextNode "123 My Road"-            ]-        ],-    Element "employee" [("name", "alice")] [-        Element "address" [] [-            TextNode "124 My Road"-            ],-        Element "phone" [] [-            TextNode "555-1234"-            ]-        ]-    ]--setAttributeNew :: Bool-setAttributeNew =-    let e = setAttribute "flo" "friz" someElement-    in  length (elementAttrs e) == 2-        && getAttribute "fiz" e == Just "buzz"-        && getAttribute "flo" e == Just "friz"--setAttributeReplace :: Bool-setAttributeReplace =-    let e = setAttribute "fiz" "bat" someElement-    in  length (elementAttrs e) == 1-        && getAttribute "fiz" e == Just "bat"--setAttributeWrongType :: Bool-setAttributeWrongType =-    setAttribute "fuss" "plus" someTextNode == someTextNode-    && setAttribute "fuss" "plus" someComment == someComment--nestedNodeText :: Bool-nestedNodeText = nodeText someTree == "123 My Road124 My Road555-1234"--childNodesElem :: Bool-childNodesElem = length (childNodes n) == 3-    where n = Element "foo" [] [ TextNode "bar",-                                 Comment  "baz",-                                 Element  "bat" [] [] ]--childNodesOther :: Bool-childNodesOther = childNodes (TextNode "foo") == []-               && childNodes (Comment "bar")  == []--childElemsTest :: Bool-childElemsTest = length (childElements n) == 1-    where n = Element "foo" [] [ TextNode "bar",-                                 Comment  "baz",-                                 Element  "bat" [] [] ]--childElemsTagTest :: Bool-childElemsTagTest = length (childElementsTag "good" n) == 2-    where n = Element "parent" [] [-                Element "good" [] [],-                TextNode "foo",-                Comment "bar",-                Element "bad" [] [],-                Element "good" [] [],-                Element "bad" [] []-              ]--childElemTagExists :: Bool-childElemTagExists = childElementTag "b" n == Just (Element "b" [] [])-    where n = Element "parent" [] [-                Element "a" [] [],-                Element "b" [] [],-                Element "c" [] []-              ]--childElemTagNotExists :: Bool-childElemTagNotExists = childElementTag "b" n == Nothing-    where n = Element "parent" [] [-                Element "a" [] [],-                Element "c" [] []-              ]--childElemTagOther :: Bool-childElemTagOther = childElementTag "b" n == Nothing-    where n = TextNode ""---descNodesElem :: Bool-descNodesElem = length (descendantNodes n) == 3-    where n = Element "foo" [] [ TextNode "bar",-                                 Element  "bat" [] [ Comment  "baz" ] ]--descNodesOther :: Bool-descNodesOther = descendantNodes (TextNode "foo") == []-              && descendantNodes (Comment "bar")  == []--descElemsTest :: Bool-descElemsTest = length (descendantElements n) == 1-    where n = Element "foo" [] [ TextNode "bar",-                                 Element  "bat" [] [ Comment  "baz" ] ]--descElemsTagTest :: Bool-descElemsTagTest = length (descendantElementsTag "good" n) == 2-    where n = Element "parent" [] [-                TextNode "foo",-                Element "good" [] [],-                Comment "bar",-                Element "parent" [] [ Element "good" [] [] ],-                Element "bad" [] []-              ]--descElemTagExists :: Bool-descElemTagExists = descendantElementTag "b" n == Just (Element "b" [] [])-    where n = Element "parent" [] [-                Element "a" [] [ Element "b" [] [] ],-                Element "c" [] []-              ]--descElemTagDFS :: Bool-descElemTagDFS = descendantElementTag "b" n == Just (Element "b" [] [])-    where n = Element "parent" [] [-                Element "a" [] [ Element "b" [] [] ],-                Element "b" [("wrong", "")] [],-                Element "c" [] []-              ]--descElemTagNotExists :: Bool-descElemTagNotExists = descendantElementTag "b" n == Nothing-    where n = Element "parent" [] [-                Element "a" [] [],-                Element "c" [] [ Element "d" [] [] ]-              ]--descElemTagOther :: Bool-descElemTagOther = descendantElementTag "b" n == Nothing-    where n = TextNode ""-

@@ -1,183 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Text.XmlHtml.OASISTest (testsOASIS) where--import           Blaze.ByteString.Builder-import           Control.Applicative-import           Control.Monad-import qualified Data.ByteString as B-import           Data.Maybe-import qualified Data.Text as T-import           System.Directory-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.HUnit hiding (Test, Node)-import           Text.XmlHtml----------------------------------------------------------------------------------- | Runs the OASIS XML conformance test suite.  The test cases sit in--- directories inside of @test/resources@.  This test reads them, parses them,--- and ensures that they behave as expected:------ * If there is a file in the same directory named /filename/@.correct@---   or /filename/@.incorrect@, the parsing is expected to either succeed---   or fail, as indicated.  Otherwise, the remaining cases apply.------ * For those tests marked @not-wf@, the test expects an error message.------ * For tests marked @valid@ or @invalid@ (there is no distinction since---   @xmlhtml@ is not a validating parser), the test expects a successful---   parse, but does not verify the parse result.------ For tests that should succeed as XML but not HTML, or vice versa, files--- can be named /filename/@.xml.correct@, and so on (all 4 combinations).--testsOASIS :: [Test]-testsOASIS = [-    testCase "xmlhtml/ibm-not-wf     " $ oasisP  "ibm/ibm_oasis_not-wf.xml",-    testCase "xmlhtml/ibm-invalid    " $ oasisP  "ibm/ibm_oasis_invalid.xml",-    testCase "xmlhtml/ibm-valid      " $ oasisP  "ibm/ibm_oasis_valid.xml",-    testCase "xmlhtml/oasis          " $ oasisP  "oasis/oasis.xml",-    testCase "xmlhtml/r-ibm-not-wf   " $ oasisR  "ibm/ibm_oasis_not-wf.xml",-    testCase "xmlhtml/r-ibm-invalid  " $ oasisR  "ibm/ibm_oasis_invalid.xml",-    testCase "xmlhtml/r-ibm-valid    " $ oasisR  "ibm/ibm_oasis_valid.xml",-    testCase "xmlhtml/r-oasis        " $ oasisR  "oasis/oasis.xml",-    testCase "xmlhtml/h-ibm-not-wf   " $ oasisHP "ibm/ibm_oasis_not-wf.xml",-    testCase "xmlhtml/h-ibm-invalid  " $ oasisHP "ibm/ibm_oasis_invalid.xml",-    testCase "xmlhtml/h-ibm-valid    " $ oasisHP "ibm/ibm_oasis_valid.xml",-    testCase "xmlhtml/h-oasis        " $ oasisHP "oasis/oasis.xml",-    testCase "xmlhtml/hr-ibm-not-wf  " $ oasisHR "ibm/ibm_oasis_not-wf.xml",-    testCase "xmlhtml/hr-ibm-invalid " $ oasisHR "ibm/ibm_oasis_invalid.xml",-    testCase "xmlhtml/hr-ibm-valid   " $ oasisHR "ibm/ibm_oasis_valid.xml",-    testCase "xmlhtml/hr-oasis       " $ oasisHR "oasis/oasis.xml"-    ]---oasisP :: String -> Assertion-oasisP name = do-    tests <- getOASIS ".xml" name-    forM_ tests $ \(fn, ty) -> case ty of-        True  -> oasisWF fn-        False -> oasisNotWF fn---oasisR :: String -> Assertion-oasisR name = do-    tests <- getOASIS ".xml" name-    forM_ tests $ \(fn, ty) -> case ty of-        True  -> oasisRerender fn-        False -> return ()---oasisHP :: String -> Assertion-oasisHP name = do-    tests <- getOASIS ".html" name-    forM_ tests $ \(fn, ty) -> case ty of-        True  -> hOasisWF fn-        False -> hOasisNotWF fn---oasisHR :: String -> Assertion-oasisHR name = do-    tests <- getOASIS ".html" name-    forM_ tests $ \(fn, ty) -> case ty of-        True  -> hOasisRerender fn-        False -> return ()---getOASIS :: String -> String -> IO [(String, Bool)]-getOASIS sub name = do-    testListSrc <- B.readFile ("resources/" ++ name)-    let Right (XmlDocument _ _ ns) = parseXML name testListSrc-    let Just c = listToMaybe (filter isElement ns)-    oasisTestCases sub name c---oasisTestCases :: String -> String -> Node -> IO [(String, Bool)]-oasisTestCases sub name n = do-    fmap concat $ forM (childElements n) $ \t -> case tagName t of-        Just "TESTCASES" -> oasisTestCases sub name t-        Just "TEST"      -> oasisTest sub name t-        _                -> error (show t)---oasisTest :: String -> String -> Node -> IO [(String, Bool)]-oasisTest sub name t = do-    let fn = file $ fromJust $ getAttribute "URI" t-    fe <- doesFileExist fn-    ce <- (||) <$> doesFileExist (fn ++ ".correct")-               <*> doesFileExist (fn ++ sub ++ ".correct")-    ie <- (||) <$> doesFileExist (fn ++ ".incorrect")-               <*> doesFileExist (fn ++ sub ++ ".incorrect")-    let ty = getAttribute "TYPE" t-    if fe then case () of-        () | ce                   -> return [(fn, True)]-           | ie                   -> return [(fn, False)]-           | ty == Just "not-wf"  -> return [(fn, False)]-           | ty == Just "invalid" -> return [(fn, True)]-           | ty == Just "valid"   -> return [(fn, True)]-           | otherwise            -> return [(fn, True)]-      else return []-  where-    file f        = "resources/" ++ toLastSlash name ++ T.unpack f-    toLastSlash s = snd (go s)-        where go []     = (False, [])-              go (c:cs) = let (found, ccs) = go cs-                          in  if found then (True, c:ccs)-                              else if c == '/' then (True, "/")-                              else (False, c:cs)---oasisNotWF :: String -> Assertion-oasisNotWF name = do-    src <- B.readFile name-    assertBool ("not-wf parse " ++ name) $ isLeft (parseXML name src)-  where-    isLeft (Left _) = True-    isLeft _        = False---oasisWF :: String -> Assertion-oasisWF name = do-    src <- B.readFile name-    assertBool ("wf parse " ++ name) $ isRight (parseXML name src)-  where-    isRight (Right _) = True-    isRight _         = False---oasisRerender :: String -> Assertion-oasisRerender name = do-    src         <- B.readFile name-    let Right d  = parseXML "" src-    let src2     = toByteString (render d)-    let Right d2 = parseXML "" src2-    assertEqual ("rerender " ++ name) d d2---hOasisNotWF :: String -> Assertion-hOasisNotWF name = do-    src <- B.readFile name-    assertBool ("not-wf parse " ++ name) $ isLeft (parseHTML name src)-  where-    isLeft (Left _) = True-    isLeft _        = False---hOasisWF :: String -> Assertion-hOasisWF name = do-    src <- B.readFile name-    assertBool ("wf parse " ++ name) $ isRight (parseHTML name src)-  where-    isRight (Right _) = True-    isRight _         = False---hOasisRerender :: String -> Assertion-hOasisRerender name = do-    src         <- B.readFile name-    let Right d  = parseHTML "" src-    let src2     = toByteString (render d)-    let Right d2 = parseHTML "" src2-    assertEqual ("rerender " ++ name) d d2-

@@ -1,38 +0,0 @@-{-# LANGUAGE ScopedTypeVariables       #-}--module Text.XmlHtml.TestCommon where--import           Control.Exception as E-import           System.IO.Unsafe-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.HUnit hiding (Test, Node)----------------------------------------------------------------------------------- | Tests a simple Bool property.-testIt :: TestName -> Bool -> Test-testIt name b = testCase name $ assertBool name b----------------------------------------------------------------------------------- Code adapted from ChasingBottoms.------ Adding an actual dependency isn't possible because Cabal refuses to build--- the package due to version conflicts.------ isBottom is impossible to write, but very useful!  So we defy the--- impossible, and write it anyway.-isBottom :: a -> Bool-isBottom a = unsafePerformIO $-    (E.evaluate a >> return False) `E.catches` [-        E.Handler $ \ (_ :: PatternMatchFail) -> return True,-        E.Handler $ \ (_ :: ErrorCall)        -> return True,-        E.Handler $ \ (_ :: NoMethodError)    -> return True,-        E.Handler $ \ (_ :: RecConError)      -> return True,-        E.Handler $ \ (_ :: RecUpdError)      -> return True,-        E.Handler $ \ (_ :: RecSelError)      -> return True-        ]---------------------------------------------------------------------------------isLeft :: Either a b -> Bool-isLeft = either (const True) (const False)-

@@ -1,963 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings         #-}--module Text.XmlHtml.Tests (tests) where--import           Blaze.ByteString.Builder-import           Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B-import           Data.Monoid-import           Data.String-import           Data.Text ()                  -- for string instance-import qualified Data.Text.Encoding as T-import           Test.Framework-import           Test.Framework.Providers.HUnit-import           Test.HUnit hiding (Test, Node)-import           Text.Blaze-import           Text.Blaze.Html-import qualified Text.Blaze.Html5 as H-import qualified Text.Blaze.Html5.Attributes as A-import qualified Text.Blaze.Internal as H-import           Text.Blaze.Renderer.XmlHtml-import           Text.XmlHtml-import           Text.XmlHtml.CursorTests-import           Text.XmlHtml.DocumentTests-import           Text.XmlHtml.TestCommon-import           Text.XmlHtml.OASISTest------------------------------------------------------------------------------------ The master list of tests to run. ---------------------------------------------------------------------------------------------------------------------------tests :: [Test]-tests = xmlParsingTests-     ++ htmlXMLParsingTests-     ++ htmlParsingQuirkTests-     ++ xmlRenderingTests-     ++ htmlXMLRenderingTests-     ++ htmlRenderingQuirkTests-     ++ documentTests-     ++ cursorTests-     ++ blazeRenderTests-     ++ testsOASIS------------------------------------------------------------------------------------ XML Parsing Tests ------------------------------------------------------------------------------------------------------------------------------------------xmlParsingTests :: [Test]-xmlParsingTests = [-    testCase "byteOrderMark          " byteOrderMark,-    testIt   "emptyDocument          " emptyDocument,-    testIt   "publicDocType          " publicDocType,-    testIt   "systemDocType          " systemDocType,-    testIt   "emptyDocType           " emptyDocType,-    testCase "dtdInternalScan        " dtdInternalScan,-    testIt   "textOnly               " textOnly,-    testIt   "textWithRefs           " textWithRefs,-    testIt   "untermRef              " untermRef,-    testIt   "textWithCDATA          " textWithCDATA,-    testIt   "cdataOnly              " cdataOnly,-    testIt   "commentOnly            " commentOnly,-    testIt   "emptyElement           " emptyElement,-    testIt   "emptyElement2          " emptyElement2,-    testIt   "elemWithText           " elemWithText,-    testIt   "xmlDeclXML             " xmlDeclXML,-    testIt   "procInst               " procInst,-    testIt   "badDoctype1            " badDoctype1,-    testIt   "badDoctype2            " badDoctype2,-    testIt   "badDoctype3            " badDoctype3,-    testIt   "badDoctype4            " badDoctype4,-    testIt   "badDoctype5            " badDoctype5,-    testCase "tagNames               " tagNames-    ]--byteOrderMark :: Assertion-byteOrderMark = do-    assertEqual "BOM UTF16BE" (Right $ XmlDocument UTF16BE Nothing [])-        (parseXML "" $ T.encodeUtf16BE "\xFEFF")-    assertEqual "BOM UTF16LE" (Right $ XmlDocument UTF16LE Nothing [])-        (parseXML "" $ T.encodeUtf16LE "\xFEFF")-    assertEqual "BOM UTF8" (Right $ XmlDocument UTF8 Nothing [])-        (parseXML "" $ T.encodeUtf8 "\xFEFF")-    assertEqual "BOM None" (Right $ XmlDocument UTF8 Nothing [])-        (parseXML "" $ T.encodeUtf8 "")--emptyDocument :: Bool-emptyDocument = parseXML "" ""-    == Right (XmlDocument UTF8 Nothing [])--publicDocType :: Bool-publicDocType = parseXML "" "<!DOCTYPE tag PUBLIC \"foo\" \"bar\">"-    == Right (XmlDocument UTF8 (Just (DocType "tag" (Public "foo" "bar") NoInternalSubset)) [])--systemDocType :: Bool-systemDocType = parseXML "" "<!DOCTYPE tag SYSTEM \"foo\">"-    == Right (XmlDocument UTF8 (Just (DocType "tag" (System "foo") NoInternalSubset)) [])--emptyDocType :: Bool-emptyDocType  = parseXML "" "<!DOCTYPE tag >"-    == Right (XmlDocument UTF8 (Just (DocType "tag" NoExternalID NoInternalSubset)) [])--dtdInternalScan :: Assertion-dtdInternalScan = do-    assertEqual "empty" (parseXML "" "<!DOCTYPE a []>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[]" ))) []))-    assertBool "bad brackets" (isLeft $ parseXML "" "<!DOCTYPE a ()>")-    assertEqual "quoted" (parseXML "" "<!DOCTYPE a [\"]\"]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[\"]\"]" ))) []))-    assertBool "bad quote" (isLeft $ parseXML "" "<!DOCTYPE a [\"]>")-    assertEqual "nested brackets" (parseXML "" "<!DOCTYPE a [[[]]]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[[[]]]" ))) []))-    assertEqual "part comment 1" (parseXML "" "<!DOCTYPE a [<]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<]" ))) []))-    assertEqual "part comment 2" (parseXML "" "<!DOCTYPE a [[<]]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[[<]]" ))) []))-    assertEqual "part comment 3" (parseXML "" "<!DOCTYPE a [<[]]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<[]]" ))) []))-    assertEqual "part comment 4" (parseXML "" "<!DOCTYPE a [<!]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<!]" ))) []))-    assertEqual "part comment 5" (parseXML "" "<!DOCTYPE a [[<!]]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[[<!]]" ))) []))-    assertEqual "part comment 6" (parseXML "" "<!DOCTYPE a [<!-]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<!-]" ))) []))-    assertEqual "comment" (parseXML "" "<!DOCTYPE a [<!--foo-->]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<!--foo-->]" ))) []))-    assertEqual "docint 1" (parseXML "" "<!DOCTYPE a [<''<\"\"<!''<!\"\">]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<''<\"\"<!''<!\"\">]" ))) []))-    assertEqual "docint2" (parseXML "" "<!DOCTYPE a [<![<!-[<!-]<!-''<!-\"\"]]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<![<!-[<!-]<!-''<!-\"\"]]" ))) []))-    assertEqual "docint3" (parseXML "" "<!DOCTYPE a [<!- ]>")-        (Right (XmlDocument UTF8 (Just (DocType "a" NoExternalID (InternalText-            "[<!- ]" ))) []))-    assertBool "bad comment" (isLeft $ parseXML "" "<!DOCTYPE a [<!-- -- -->]>")--textOnly :: Bool-textOnly      = parseXML "" "sldhfsklj''a's s"-    == Right (XmlDocument UTF8 Nothing [TextNode "sldhfsklj''a's s"])--textWithRefs :: Bool-textWithRefs  = parseXML "" "This is Bob&apos;s sled"-    == Right (XmlDocument UTF8 Nothing [TextNode "This is Bob's sled"])--untermRef :: Bool-untermRef     = isLeft (parseXML "" "&#X6a")--textWithCDATA :: Bool-textWithCDATA = parseXML "" "Testing <![CDATA[with <some> c]data]]>"-    == Right (XmlDocument UTF8 Nothing [TextNode "Testing with <some> c]data"])--cdataOnly :: Bool-cdataOnly     = parseXML "" "<![CDATA[ Testing <![CDATA[ test ]]>"-    == Right (XmlDocument UTF8 Nothing [TextNode " Testing <![CDATA[ test "])--commentOnly :: Bool-commentOnly   = parseXML "" "<!-- this <is> a \"comment -->"-    == Right (XmlDocument UTF8 Nothing [Comment " this <is> a \"comment "])--emptyElement :: Bool-emptyElement  = parseXML "" "<myElement/>"-    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] []])--emptyElement2 :: Bool-emptyElement2  = parseXML "" "<myElement />"-    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] []])--elemWithText :: Bool-elemWithText  = parseXML "" "<myElement>text</myElement>"-    == Right (XmlDocument UTF8 Nothing [Element "myElement" [] [TextNode "text"]])--xmlDeclXML :: Bool-xmlDeclXML    = parseXML "" "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"-    == Right (XmlDocument UTF8 Nothing [])--procInst :: Bool-procInst      = parseXML "" "<?myPI This''is <not> parsed!?>"-    == Right (XmlDocument UTF8 Nothing [])--badDoctype1 :: Bool-badDoctype1    = isLeft $ parseXML "" "<!DOCTYPE>"--badDoctype2 :: Bool-badDoctype2    = isLeft $ parseXML "" "<!DOCTYPE html BAD>"--badDoctype3 :: Bool-badDoctype3    = isLeft $ parseXML "" "<!DOCTYPE html SYSTEM>"--badDoctype4 :: Bool-badDoctype4    = isLeft $ parseXML "" "<!DOCTYPE html PUBLIC \"foo\">"--badDoctype5 :: Bool-badDoctype5    = isLeft $ parseXML "" ("<!DOCTYPE html SYSTEM \"foo\" "-                                       `B.append` "PUBLIC \"bar\" \"baz\">")--tagNames :: Assertion-tagNames = do-    assertBool "tag name 0"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<foo />")-    assertBool "tag name 1"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xc0\&foo />")-    assertBool "tag name 2"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xd8\&foo />")-    assertBool "tag name 3"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xf8\&foo />")-    assertBool "tag name 4"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x370\&foo />")-    assertBool "tag name 5"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x37f\&foo />")-    assertBool "tag name 6"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x200c\&foo />")-    assertBool "tag name 7"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x2070\&foo />")-    assertBool "tag name 8"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x2c00\&foo />")-    assertBool "tag name 9"  $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x3001\&foo />")-    assertBool "tag name 10" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xf900\&foo />")-    assertBool "tag name 11" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xfdf0\&foo />")-    assertBool "tag name 12" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<\x10000\&foo />")-    assertBool "tag name 13" $ id  $-        isLeft $ parseXML "" (T.encodeUtf8 "<\xd7\&foo />")-    assertBool "tag name 14" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<f-oo />")-    assertBool "tag name 15" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<f.oo />")-    assertBool "tag name 16" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<f\xb7\&oo />")-    assertBool "tag name 17" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<f3oo />")-    assertBool "tag name 18" $ not $-        isLeft $ parseXML "" (T.encodeUtf8 "<f\x203f\&oo />")-    assertBool "tag name 19" $ id  $-        isLeft $ parseXML "" (T.encodeUtf8 "<f\x2041\&oo />")------------------------------------------------------------------------------------ HTML Repetitions of XML Parsing Tests ----------------------------------------------------------------------------------------------------------------------htmlXMLParsingTests :: [Test]-htmlXMLParsingTests = [-    testIt "emptyDocumentHTML      " emptyDocumentHTML,-    testIt "publicDocTypeHTML      " publicDocTypeHTML,-    testIt "systemDocTypeHTML      " systemDocTypeHTML,-    testIt "emptyDocTypeHTML       " emptyDocTypeHTML,-    testIt "textOnlyHTML           " textOnlyHTML,-    testIt "textWithRefsHTML       " textWithRefsHTML,-    testIt "textWithCDataHTML      " textWithCDataHTML,-    testIt "cdataOnlyHTML          " cdataOnlyHTML,-    testIt "commentOnlyHTML        " commentOnlyHTML,-    testIt "emptyElementHTML       " emptyElementHTML,-    testIt "emptyElement2HTML      " emptyElement2HTML,-    testIt "elemWithTextHTML       " elemWithTextHTML,-    testIt "xmlDeclHTML            " xmlDeclHTML,-    testIt "procInstHTML           " procInstHTML,-    testIt "badDoctype1HTML        " badDoctype1HTML,-    testIt "badDoctype2HTML        " badDoctype2HTML,-    testIt "badDoctype3HTML        " badDoctype3HTML,-    testIt "badDoctype4HTML        " badDoctype4HTML,-    testIt "badDoctype5HTML        " badDoctype5HTML-    ]--emptyDocumentHTML :: Bool-emptyDocumentHTML = parseHTML "" ""-    == Right (HtmlDocument UTF8 Nothing [])--publicDocTypeHTML :: Bool-publicDocTypeHTML = parseHTML "" "<!DOCTYPE tag PUBLIC \"foo\" \"bar\">"-    == Right (HtmlDocument UTF8 (Just (DocType "tag" (Public "foo" "bar") NoInternalSubset)) [])--systemDocTypeHTML :: Bool-systemDocTypeHTML = parseHTML "" "<!DOCTYPE tag SYSTEM \"foo\">"-    == Right (HtmlDocument UTF8 (Just (DocType "tag" (System "foo") NoInternalSubset)) [])--emptyDocTypeHTML :: Bool-emptyDocTypeHTML  = parseHTML "" "<!DOCTYPE tag >"-    == Right (HtmlDocument UTF8 (Just (DocType "tag" NoExternalID NoInternalSubset)) [])--textOnlyHTML :: Bool-textOnlyHTML      = parseHTML "" "sldhfsklj''a's s"-    == Right (HtmlDocument UTF8 Nothing [TextNode "sldhfsklj''a's s"])--textWithRefsHTML :: Bool-textWithRefsHTML  = parseHTML "" "This is Bob&apos;s sled"-    == Right (HtmlDocument UTF8 Nothing [TextNode "This is Bob's sled"])--textWithCDataHTML :: Bool-textWithCDataHTML = parseHTML "" "Testing <![CDATA[with <some> c]data]]>"-    == Right (HtmlDocument UTF8 Nothing [TextNode "Testing with <some> c]data"])--cdataOnlyHTML :: Bool-cdataOnlyHTML     = parseHTML "" "<![CDATA[ Testing <![CDATA[ test ]]>"-    == Right (HtmlDocument UTF8 Nothing [TextNode " Testing <![CDATA[ test "])--commentOnlyHTML :: Bool-commentOnlyHTML   = parseHTML "" "<!-- this <is> a \"comment -->"-    == Right (HtmlDocument UTF8 Nothing [Comment " this <is> a \"comment "])--emptyElementHTML :: Bool-emptyElementHTML  = parseHTML "" "<myElement/>"-    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] []])--emptyElement2HTML :: Bool-emptyElement2HTML = parseHTML "" "<myElement />"-    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] []])--elemWithTextHTML :: Bool-elemWithTextHTML  = parseHTML "" "<myElement>text</myElement>"-    == Right (HtmlDocument UTF8 Nothing [Element "myElement" [] [TextNode "text"]])--xmlDeclHTML :: Bool-xmlDeclHTML       = parseHTML "" "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"-    == Right (HtmlDocument UTF8 Nothing [])--procInstHTML :: Bool-procInstHTML      = parseHTML "" "<?myPI This''is <not> parsed!?>"-    == Right (HtmlDocument UTF8 Nothing [])--badDoctype1HTML :: Bool-badDoctype1HTML    = isLeft $ parseHTML "" "<!DOCTYPE>"--badDoctype2HTML :: Bool-badDoctype2HTML    = isLeft $ parseHTML "" "<!DOCTYPE html BAD>"--badDoctype3HTML :: Bool-badDoctype3HTML    = isLeft $ parseHTML "" "<!DOCTYPE html SYSTEM>"--badDoctype4HTML :: Bool-badDoctype4HTML    = isLeft $ parseHTML "" "<!DOCTYPE html PUBLIC \"foo\">"--badDoctype5HTML :: Bool-badDoctype5HTML    = isLeft $ parseHTML "" ("<!DOCTYPE html SYSTEM \"foo\" "-                                       `B.append` "PUBLIC \"bar\" \"baz\">")------------------------------------------------------------------------------------ HTML Quirks Parsing Tests ----------------------------------------------------------------------------------------------------------------------------------htmlParsingQuirkTests :: [Test]-htmlParsingQuirkTests = [-    testIt   "voidElem               " voidElem,-    testIt   "caseInsDoctype1        " caseInsDoctype1,-    testIt   "caseInsDoctype2        " caseInsDoctype2,-    testIt   "voidEmptyElem          " voidEmptyElem,-    testIt   "rawTextElem            " rawTextElem,-    testIt   "endTagCase             " endTagCase,-    testIt   "hexEntityCap           " hexEntityCap,-    testIt   "laxAttrName            " laxAttrName,-    testCase "badAttrName            " badAttrName,-    testIt   "emptyAttr              " emptyAttr,-    testIt   "emptyAttr2             " emptyAttr2,-    testIt   "unquotedAttr           " unquotedAttr,-    testIt   "laxAttrVal             " laxAttrVal,-    testIt   "ampersandInText        " ampersandInText,-    testIt   "omitOptionalEnds       " omitOptionalEnds,-    testIt   "omitEndHEAD            " omitEndHEAD,-    testIt   "omitEndLI              " omitEndLI,-    testIt   "omitEndDT              " omitEndDT,-    testIt   "omitEndDD              " omitEndDD,-    testIt   "omitEndP               " omitEndP,-    testIt   "omitEndRT              " omitEndRT,-    testIt   "omitEndRP              " omitEndRP,-    testIt   "omitEndOPTGRP          " omitEndOPTGRP,-    testIt   "omitEndOPTION          " omitEndOPTION,-    testIt   "omitEndCOLGRP          " omitEndCOLGRP,-    testIt   "omitEndTHEAD           " omitEndTHEAD,-    testIt   "omitEndTBODY           " omitEndTBODY,-    testIt   "omitEndTFOOT           " omitEndTFOOT,-    testIt   "omitEndTR              " omitEndTR,-    testIt   "omitEndTD              " omitEndTD,-    testIt   "omitEndTH              " omitEndTH,-    testIt   "testNewRefs            " testNewRefs,-    testIt   "errorImplicitClose     " errorImplicitClose,-    testIt   "weirdScriptThing       " weirdScriptThing-    ]--caseInsDoctype1 :: Bool-caseInsDoctype1 = parseHTML "" "<!dOcTyPe html SyStEm 'foo'>"-    == Right (HtmlDocument UTF8 (Just (DocType "html" (System "foo") NoInternalSubset)) [])--caseInsDoctype2 :: Bool-caseInsDoctype2 = parseHTML "" "<!dOcTyPe html PuBlIc 'foo' 'bar'>"-    == Right (HtmlDocument UTF8 (Just (DocType "html" (Public "foo" "bar") NoInternalSubset)) [])--voidElem :: Bool-voidElem      = parseHTML "" "<img>"-    == Right (HtmlDocument UTF8 Nothing [Element "img" [] []])--voidEmptyElem :: Bool-voidEmptyElem = parseHTML "" "<img/>"-    == Right (HtmlDocument UTF8 Nothing [Element "img" [] []])--rawTextElem :: Bool-rawTextElem   = parseHTML "" "<script type=\"text/javascript\">This<is'\"a]]>test&amp;</script>"-    == Right (HtmlDocument UTF8 Nothing [Element "script" [("type", "text/javascript")] [-                    TextNode "This<is'\"a]]>test&amp;"]-                    ])--endTagCase :: Bool-endTagCase    = parseHTML "" "<testing></TeStInG>"-    == Right (HtmlDocument UTF8 Nothing [Element "testing" [] []])--hexEntityCap :: Bool-hexEntityCap  = parseHTML "" "&#X6a;"-    == Right (HtmlDocument UTF8 Nothing [TextNode "\x6a"])--laxAttrName :: Bool-laxAttrName   = parseHTML "" "<test val<fun=\"test\"></test>"-    == Right (HtmlDocument UTF8 Nothing [Element "test" [("val<fun", "test")] []])--badAttrName :: Assertion-badAttrName = do-    assertBool "attr name 0"  $ not $-        isLeft $ parseHTML "" (T.encodeUtf8 "<foo attr/>")-    assertBool "attr name 1"  $-        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x0002\&ttr/>")-    assertBool "attr name 2"  $-        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x000F\&ttr/>")-    assertBool "attr name 3"  $-        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \x007F\&ttr/>")-    assertBool "attr name 4"  $-        isLeft $ parseHTML "" (T.encodeUtf8 "<foo \xFDD0\&ttr/>")--emptyAttr :: Bool-emptyAttr     = parseHTML "" "<test attr></test>"-    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "")] []])--emptyAttr2 :: Bool-emptyAttr2     = parseHTML "" "<div itemscope itemtype=\"type\"></div>"-    == Right (HtmlDocument UTF8 Nothing [Element "div" [("itemscope", ""), ("itemtype", "type")] []])--unquotedAttr :: Bool-unquotedAttr  = parseHTML "" "<test attr=you&amp;me></test>"-    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "you&me")] []])--laxAttrVal :: Bool-laxAttrVal    = parseHTML "" "<test attr=\"a &amp; d < b & c\"/>"-    == Right (HtmlDocument UTF8 Nothing [Element "test" [("attr", "a & d < b & c")] []])--ampersandInText :: Bool-ampersandInText   = parseHTML "" "&#X6a"-    == Right (HtmlDocument UTF8 Nothing [TextNode "&#X6a"])--omitOptionalEnds :: Bool-omitOptionalEnds   = parseHTML "" "<html><body><p></html>"-    == Right (HtmlDocument UTF8 Nothing [Element "html" [] [-                Element "body" [] [ Element "p" [] []]]])--omitEndHEAD :: Bool-omitEndHEAD   = parseHTML "" "<head><body>"-    == Right (HtmlDocument UTF8 Nothing [Element "head" [] [], Element "body" [] []])--omitEndLI :: Bool-omitEndLI     = parseHTML "" "<li><li>"-    == Right (HtmlDocument UTF8 Nothing [Element "li" [] [], Element "li" [] []])--omitEndDT :: Bool-omitEndDT     = parseHTML "" "<dt><dd>"-    == Right (HtmlDocument UTF8 Nothing [Element "dt" [] [], Element "dd" [] []])--omitEndDD :: Bool-omitEndDD     = parseHTML "" "<dd><dt>"-    == Right (HtmlDocument UTF8 Nothing [Element "dd" [] [], Element "dt" [] []])--omitEndP :: Bool-omitEndP      = parseHTML "" "<p><h1></h1>"-    == Right (HtmlDocument UTF8 Nothing [Element "p" [] [], Element "h1" [] []])--omitEndRT :: Bool-omitEndRT     = parseHTML "" "<rt><rp>"-    == Right (HtmlDocument UTF8 Nothing [Element "rt" [] [], Element "rp" [] []])--omitEndRP :: Bool-omitEndRP     = parseHTML "" "<rp><rt>"-    == Right (HtmlDocument UTF8 Nothing [Element "rp" [] [], Element "rt" [] []])--omitEndOPTGRP :: Bool-omitEndOPTGRP = parseHTML "" "<optgroup><optgroup>"-    == Right (HtmlDocument UTF8 Nothing [Element "optgroup" [] [], Element "optgroup" [] []])--omitEndOPTION :: Bool-omitEndOPTION = parseHTML "" "<option><option>"-    == Right (HtmlDocument UTF8 Nothing [Element "option" [] [], Element "option" [] []])--omitEndCOLGRP :: Bool-omitEndCOLGRP = parseHTML "" "<colgroup><tbody>"-    == Right (HtmlDocument UTF8 Nothing [Element "colgroup" [] [], Element "tbody" [] []])--omitEndTHEAD :: Bool-omitEndTHEAD  = parseHTML "" "<thead><tbody>"-    == Right (HtmlDocument UTF8 Nothing [Element "thead" [] [], Element "tbody" [] []])--omitEndTBODY :: Bool-omitEndTBODY  = parseHTML "" "<tbody><thead>"-    == Right (HtmlDocument UTF8 Nothing [Element "tbody" [] [], Element "thead" [] []])--omitEndTFOOT :: Bool-omitEndTFOOT  = parseHTML "" "<tfoot><tbody>"-    == Right (HtmlDocument UTF8 Nothing [Element "tfoot" [] [], Element "tbody" [] []])--omitEndTR :: Bool-omitEndTR     = parseHTML "" "<tr><tr>"-    == Right (HtmlDocument UTF8 Nothing [Element "tr" [] [], Element "tr" [] []])--omitEndTD :: Bool-omitEndTD     = parseHTML "" "<td><td>"-    == Right (HtmlDocument UTF8 Nothing [Element "td" [] [], Element "td" [] []])--omitEndTH :: Bool-omitEndTH     = parseHTML "" "<th><td>"-    == Right (HtmlDocument UTF8 Nothing [Element "th" [] [], Element "td" [] []])--testNewRefs :: Bool-testNewRefs   = parseHTML "" "&CenterDot;&doublebarwedge;&fjlig;"-    == Right (HtmlDocument UTF8 Nothing [TextNode "\x000B7\x02306\&fj"])--errorImplicitClose :: Bool-errorImplicitClose = isLeft $ parseHTML "" "<p><pre>foo</pre></p>"--weirdScriptThing :: Bool-weirdScriptThing = parseHTML "" "<div><script type=\"text/javascript\">selector.append('<option>'+name+'</option>');</script></div>"-    == Right (HtmlDocument UTF8 Nothing [-        Element "div" [] [-            Element "script" [("type", "text/javascript")] [-                TextNode "selector.append('<option>'+name+'</option>');"-                ]-            ]-        ])----------------------------------------------------------------------------------- XML Rendering Tests ----------------------------------------------------------------------------------------------------------------------------------------xmlRenderingTests :: [Test]-xmlRenderingTests = [-    testIt "renderByteOrderMark    " renderByteOrderMark,-    testIt "renderByteOrderMarkLE  " renderByteOrderMarkLE,-    testIt "singleQuoteInSysID     " singleQuoteInSysID,-    testIt "doubleQuoteInSysID     " doubleQuoteInSysID,-    testIt "bothQuotesInSysID      " bothQuotesInSysID,-    testIt "doubleQuoteInPubID     " doubleQuoteInPubID,-    testIt "doubleDashInComment    " doubleDashInComment,-    testIt "trailingDashInComment  " trailingDashInComment,-    testIt "renderEmptyText        " renderEmptyText,-    testIt "singleQuoteInAttr      " singleQuoteInAttr,-    testIt "doubleQuoteInAttr      " doubleQuoteInAttr,-    testIt "bothQuotesInAttr       " bothQuotesInAttr-    ]--renderByteOrderMark :: Bool-renderByteOrderMark =-    toByteString (render (XmlDocument UTF16BE Nothing []))-    == T.encodeUtf16BE "\xFEFF<?xml version=\"1.0\" encoding=\"UTF-16\"?>\n"--renderByteOrderMarkLE :: Bool-renderByteOrderMarkLE =-    toByteString (render (XmlDocument UTF16LE Nothing []))-    == T.encodeUtf16LE "\xFEFF<?xml version=\"1.0\" encoding=\"UTF-16\"?>\n"---- (Appears at the beginning of all XML output)-utf8Decl :: ByteString-utf8Decl = T.encodeUtf8 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"--singleQuoteInSysID :: Bool-singleQuoteInSysID =-    toByteString (render (XmlDocument UTF8-        (Just (DocType "html" (System "test\'ing") NoInternalSubset))-        []))-    == utf8Decl `B.append` "<!DOCTYPE html SYSTEM \"test\'ing\">\n"--doubleQuoteInSysID :: Bool-doubleQuoteInSysID =-    toByteString (render (XmlDocument UTF8-        (Just (DocType "html" (System "test\"ing") NoInternalSubset))-        []))-    == utf8Decl `B.append` "<!DOCTYPE html SYSTEM \'test\"ing\'>\n"--bothQuotesInSysID :: Bool-bothQuotesInSysID = isBottom $-    toByteString (render (XmlDocument UTF8-        (Just (DocType "html" (System "test\"\'ing") NoInternalSubset))-        []))--doubleQuoteInPubID :: Bool-doubleQuoteInPubID = isBottom $-    toByteString (render (XmlDocument UTF8-        (Just (DocType "html" (Public "test\"ing" "foo") NoInternalSubset))-        []))--doubleDashInComment :: Bool-doubleDashInComment = isBottom $-    toByteString (render (XmlDocument UTF8 Nothing [-        Comment "test--ing"-        ]))--trailingDashInComment :: Bool-trailingDashInComment = isBottom $-    toByteString (render (XmlDocument UTF8 Nothing [-        Comment "testing-"-        ]))--renderEmptyText :: Bool-renderEmptyText =-    toByteString (render (XmlDocument UTF8 Nothing [-        TextNode ""-        ]))-    == utf8Decl--singleQuoteInAttr :: Bool-singleQuoteInAttr =-    toByteString (render (XmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\'ing")] []-        ]))-    == utf8Decl `B.append` "<foo bar=\"test\'ing\"/>"--doubleQuoteInAttr :: Bool-doubleQuoteInAttr =-    toByteString (render (XmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\"ing")] []-        ]))-    == utf8Decl `B.append` "<foo bar=\'test\"ing\'/>"--bothQuotesInAttr :: Bool-bothQuotesInAttr =-    toByteString (render (XmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\'\"ing")] []-        ]))-    == utf8Decl `B.append` "<foo bar=\"test\'&quot;ing\"/>"------------------------------------------------------------------------------------ HTML Repeats of XML Rendering Tests ------------------------------------------------------------------------------------------------------------------------htmlXMLRenderingTests :: [Test]-htmlXMLRenderingTests = [-    testIt "hRenderByteOrderMark   " hRenderByteOrderMark,-    testIt "hSingleQuoteInSysID    " hSingleQuoteInSysID,-    testIt "hDoubleQuoteInSysID    " hDoubleQuoteInSysID,-    testIt "hBothQuotesInSysID     " hBothQuotesInSysID,-    testIt "hDoubleQuoteInPubID    " hDoubleQuoteInPubID,-    testIt "hDoubleDashInComment   " hDoubleDashInComment,-    testIt "hTrailingDashInComment " hTrailingDashInComment,-    testIt "hRenderEmptyText       " hRenderEmptyText,-    testIt "hSingleQuoteInAttr     " hSingleQuoteInAttr,-    testIt "hDoubleQuoteInAttr     " hDoubleQuoteInAttr,-    testIt "hBothQuotesInAttr      " hBothQuotesInAttr-    ]--hRenderByteOrderMark :: Bool-hRenderByteOrderMark =-    toByteString (render (HtmlDocument UTF16BE Nothing []))-    == "\xFE\xFF"--hSingleQuoteInSysID :: Bool-hSingleQuoteInSysID =-    toByteString (render (HtmlDocument UTF8-        (Just (DocType "html" (System "test\'ing") NoInternalSubset))-        []))-    == "<!DOCTYPE html SYSTEM \"test\'ing\">\n"--hDoubleQuoteInSysID :: Bool-hDoubleQuoteInSysID =-    toByteString (render (HtmlDocument UTF8-        (Just (DocType "html" (System "test\"ing") NoInternalSubset))-        []))-    == "<!DOCTYPE html SYSTEM \'test\"ing\'>\n"--hBothQuotesInSysID :: Bool-hBothQuotesInSysID = isBottom $-    toByteString (render (HtmlDocument UTF8-        (Just (DocType "html" (System "test\"\'ing") NoInternalSubset))-        []))--hDoubleQuoteInPubID :: Bool-hDoubleQuoteInPubID = isBottom $-    toByteString (render (HtmlDocument UTF8-        (Just (DocType "html" (Public "test\"ing" "foo") NoInternalSubset))-        []))--hDoubleDashInComment :: Bool-hDoubleDashInComment = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Comment "test--ing"-        ]))--hTrailingDashInComment :: Bool-hTrailingDashInComment = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Comment "testing-"-        ]))--hRenderEmptyText :: Bool-hRenderEmptyText =-    toByteString (render (HtmlDocument UTF8 Nothing [-        TextNode ""-        ]))-    == ""--hSingleQuoteInAttr :: Bool-hSingleQuoteInAttr =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\'ing")] []-        ]))-    == "<foo bar=\"test\'ing\"></foo>"--hDoubleQuoteInAttr :: Bool-hDoubleQuoteInAttr =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\"ing")] []-        ]))-    == "<foo bar=\'test\"ing\'></foo>"--hBothQuotesInAttr :: Bool-hBothQuotesInAttr =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "foo" [("bar", "test\'\"ing")] []-        ]))-    == "<foo bar=\"test\'&quot;ing\"></foo>"------------------------------------------------------------------------------------ HTML Quirks Rendering Tests --------------------------------------------------------------------------------------------------------------------------------htmlRenderingQuirkTests :: [Test]-htmlRenderingQuirkTests = [-    testIt "renderHTMLVoid         " renderHTMLVoid,-    testIt "renderHTMLVoid2        " renderHTMLVoid2,-    testIt "renderHTMLRaw          " renderHTMLRaw,-    testIt "renderHTMLRawMult      " renderHTMLRawMult,-    testIt "renderHTMLRaw2         " renderHTMLRaw2,-    testIt "renderHTMLRaw3         " renderHTMLRaw3,-    testIt "renderHTMLRaw4         " renderHTMLRaw4,-    testIt "renderHTMLAmpAttr1     " renderHTMLAmpAttr1,-    testIt "renderHTMLAmpAttr2     " renderHTMLAmpAttr2,-    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-renderHTMLVoid =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "img" [("src", "foo")] []-        ]))-    == "<img src=\'foo\' />"--renderHTMLVoid2 :: Bool-renderHTMLVoid2 = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "img" [] [TextNode "foo"]-        ]))--renderHTMLRaw :: Bool-renderHTMLRaw =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "script" [("type", "text/javascript")] [-            TextNode "<testing>/&+</foo>"-            ]-        ]))-    == "<script type=\'text/javascript\'><testing>/&+</foo></script>"--renderHTMLRawMult :: Bool-renderHTMLRawMult =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "script" [("type", "text/javascript")] [-            TextNode "foo",-            TextNode "bar"-            ]-        ]))-    == "<script type=\'text/javascript\'>foobar</script>"--renderHTMLRaw2 :: Bool-renderHTMLRaw2 = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "script" [("type", "text/javascript")] [-            TextNode "</script>"-            ]-        ]))--renderHTMLRaw3 :: Bool-renderHTMLRaw3 = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "script" [("type", "text/javascript")] [-            Comment "foo"-            ]-        ]))--renderHTMLRaw4 :: Bool-renderHTMLRaw4 = isBottom $-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "script" [("type", "text/javascript")] [-            TextNode "</scri",-            TextNode "pt>"-            ]-        ]))--renderHTMLAmpAttr1 :: Bool-renderHTMLAmpAttr1 =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "body" [("foo", "a & b")] [] ]))-    == "<body foo=\'a & b\'></body>"--renderHTMLAmpAttr2 :: Bool-renderHTMLAmpAttr2 =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "body" [("foo", "a &amp; b")] [] ]))-    == "<body foo=\'a &amp;amp; b\'></body>"--renderHTMLAmpAttr3 :: Bool-renderHTMLAmpAttr3 =-    toByteString (render (HtmlDocument UTF8 Nothing [-        Element "body" [("foo", "a &#x65; b")] [] ]))-    == "<body foo=\'a &amp;#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>"-            ]-        ]))------------------------------------------------------------------------------------ Tests of rendering from the blaze-html package -------------------------------------------------------------------------------------------------------------blazeRenderTests :: [Test]-blazeRenderTests = [-    testIt   "blazeTestString        " blazeTestString,-    testIt   "blazeTestText          " blazeTestText,-    testIt   "blazeTestBS            " blazeTestBS,-    testIt   "blazeTestPre           " blazeTestPre,-    testIt   "blazeTestExternal      " blazeTestExternal,-    testIt   "blazeTestCustom        " blazeTestCustom,-    testIt   "blazeTestMulti         " blazeTestMulti,-    testIt   "blazeTestEmpty         " blazeTestEmpty-    ]--blazeTestIsString :: (IsString t1, IsString t) =>-     (t -> AttributeValue) -> (t1 -> Html) -> Bool-blazeTestIsString valFunc tagFunc = renderHtml html == result-  where-    html = H.div ! A.class_ (valFunc "foo") $ tagFunc "hello world"-    result = HtmlDocument UTF8 Nothing [Element "div" [("class", "foo")] [TextNode "hello world"]]--blazeTestString :: Bool-blazeTestString = blazeTestIsString H.stringValue H.string--blazeTestText :: Bool-blazeTestText = blazeTestIsString H.textValue H.text--blazeTestBS :: Bool-blazeTestBS = blazeTestIsString H.unsafeByteStringValue H.unsafeByteString--blazeTestPre :: Bool-blazeTestPre = blazeTestIsString H.preEscapedStringValue H.preEscapedString--blazeTestExternal :: Bool-blazeTestExternal = renderHtml html == result-  where-    html = do-        H.script $ H.string "alert('hello world');"-    result = HtmlDocument UTF8 Nothing [Element "script" [] [TextNode "alert('hello world');"]]--blazeTestCustom :: Bool-blazeTestCustom = renderHtml html == result-  where-    html = do-        H.select ! H.customAttribute "dojoType" (mappend "select " "this") $ "foo"-    result = HtmlDocument UTF8 Nothing [Element "select" [("dojoType", "select this")] [TextNode "foo"]]--blazeTestMulti :: Bool-blazeTestMulti = renderHtml (selectCustom `mappend` html) == result-  where-    html = do-        H.link ! A.rel "stylesheet"-    result = HtmlDocument UTF8 Nothing-        [ Element "select" [("dojoType", "select")] [TextNode "foo ", TextNode "bar"]-        , Element "link" [("rel", "stylesheet")] []-        ]--blazeTestEmpty :: Bool-blazeTestEmpty = renderHtmlNodes mempty == []--selectCustom :: Html-selectCustom = H.select ! H.customAttribute "dojoType" "select" $ (mappend "foo " "bar")---

@@ -1,28 +0,0 @@-name:           xmlhtml-testsuite-version:        0.1.3-build-type:     Simple-cabal-version:  >= 1.6--Executable testsuite-  hs-source-dirs:  ../src suite-  main-is:         TestSuite.hs--  build-depends:-    HUnit                      == 1.2.*,-    directory                  >= 1.0      && <1.3,-    QuickCheck                 >= 2.3.0.2,-    base                       == 4.*,-    blaze-builder              >= 0.2      && <0.4,-    blaze-html                 >= 0.5      && <0.8,-    blaze-markup               >= 0.5      && <0.7,-    bytestring                 >= 0.9      && <0.11,-    containers                 >= 0.3      && <0.6,-    parsec                     >= 3.1.2    && <3.2,-    test-framework             >= 0.8.0.3  && <0.9,-    test-framework-hunit       >= 0.3      && <0.4,-    test-framework-quickcheck2 >= 0.3      && <0.4,-    text                       >= 0.11     && <1.2,-    unordered-containers       >= 0.1.4    && <0.3--  ghc-options: -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded-               -fno-warn-unused-do-bind

@@ -1,5 +1,5 @@ Name:                xmlhtml-Version:             0.2.3.4+Version:             0.2.3.5 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 so that@@ -24,9 +24,11 @@ License-file:        LICENSE Author:              Chris Smith <cdsmith@gmail.com> Maintainer:          Chris Smith <cdsmith@gmail.com>-Category:            Text+homepage:            https://github.com/snapframework/xmlhtml+Category:            Text, XML Build-type:          Simple-Cabal-version:       >=1.6+Cabal-version:       >=1.8.0.4+Tested-With:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1  Extra-source-files:              .ghci,@@ -34,15 +36,13 @@              extra/hscolour.css,              extra/logo.gif,              haddock.sh,-             README,-             test/runTestsAndCoverage.sh,-             test/xmlhtml-testsuite.cabal,-             test/suite/TestSuite.hs-             test/suite/Text/XmlHtml/CursorTests.hs,-             test/suite/Text/XmlHtml/DocumentTests.hs,-             test/suite/Text/XmlHtml/OASISTest.hs,-             test/suite/Text/XmlHtml/TestCommon.hs,-             test/suite/Text/XmlHtml/Tests.hs,+             README.md,+             test/src/TestSuite.hs+             test/src/Text/XmlHtml/CursorTests.hs,+             test/src/Text/XmlHtml/DocumentTests.hs,+             test/src/Text/XmlHtml/OASISTest.hs,+             test/src/Text/XmlHtml/TestCommon.hs,+             test/src/Text/XmlHtml/Tests.hs,              test/resources/ibm/ibm_oasis_invalid.xml,              test/resources/ibm/ibm_oasis_not-wf.xml,              test/resources/ibm/ibm_oasis_readme.txt,@@ -820,9 +820,9 @@                        Text.XmlHtml.HTML.Render    Build-depends:       base                 >= 4     && < 5,-                       blaze-builder        >= 0.2   && < 0.4,-                       blaze-html           >= 0.5   && < 0.8,-                       blaze-markup         >= 0.5   && < 0.7,+                       blaze-builder        >= 0.2   && < 0.5,+                       blaze-html           >= 0.5   && < 0.9,+                       blaze-markup         >= 0.5   && < 0.8,                        bytestring           >= 0.9   && < 0.11,                        containers           >= 0.3   && < 0.6,                        parsec               >= 3.1.2 && < 3.2,@@ -838,5 +838,29 @@     ScopedTypeVariables,     ExistentialQuantification -  Ghc-options:         -Wall -fwarn-tabs -fno-warn-orphans-  ghc-prof-options:    -prof -auto-all+  ghc-options:         -Wall -fwarn-tabs -fno-warn-orphans++Test-suite testsuite+  hs-source-dirs: src test/src+  type: exitcode-stdio-1.0+  main-is: TestSuite.hs++  build-depends:+    HUnit                      >= 1.2      && <1.4,+    QuickCheck                 >= 2.3.0.2,+    base,+    blaze-builder,+    blaze-html,+    blaze-markup,+    bytestring,+    containers,+    directory                  >= 1.0      && <1.3,+    parsec,+    test-framework             >= 0.8.0.3  && <0.9,+    test-framework-hunit       >= 0.3      && <0.4,+    test-framework-quickcheck2 >= 0.3      && <0.4,+    text,+    unordered-containers++  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded+               -fno-warn-unused-do-bind