{-# LANGUAGE OverloadedStrings #-}
module Text.XmlHtml.DocumentTests (documentTests) where
import qualified Data.ByteString.Builder as B
import Data.Text () -- for string instance
import Test.Hspec
import Test.HUnit hiding (Node, Test)
import Text.XmlHtml
import Text.XmlHtml.TestCommon
------------------------------------------------------------------------------
-- Tests of manipulating the Node tree and Document --------------------------
------------------------------------------------------------------------------
documentTests :: Spec
documentTests = do
-- 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.
it "exerciseShows " $ exerciseShows
-- Exercise the accessors for Document and Node
it "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
-- Exercise render options
it "renderDoubleQuoteAttrs " $ useDoubleQuoteAttrs
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 ""
useDoubleQuoteAttrs :: Assertion
useDoubleQuoteAttrs = do
let tmpl1 = "" -- Element "p" [("div","tester")] []
tmpl2 = ""
tmpl3 = ""
rndr =
fmap (B.toLazyByteString . renderWithOptions
(defaultRenderOptions { roAttributeSurround = SurroundDoubleQuote}))
. parseHTML "test"
assertEqual "plain attr" (rndr tmpl1) (Right "")
assertEqual "plain attr" (rndr tmpl2) (Right "")
assertEqual "plain attr" (rndr tmpl3) (Right "")