xmlhtml-0.1.0.1: test/suite/Text/XmlHtml/DocumentTests.hs
{-# 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 ""