{-# 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 = "<p div=\"tester\"></p>"  -- Element "p" [("div","tester")] []
        tmpl2 = "<p div=\"tes'er\"></p>"
        tmpl3 = "<p div='tes\"er'></p>"
        rndr  =
            fmap (B.toLazyByteString . renderWithOptions
            (defaultRenderOptions { roAttributeSurround = SurroundDoubleQuote}))
            . parseHTML "test"
    assertEqual "plain attr" (rndr tmpl1) (Right "<p div=\"tester\"></p>")
    assertEqual "plain attr" (rndr tmpl2) (Right "<p div=\"tes'er\"></p>")
    assertEqual "plain attr" (rndr tmpl3) (Right "<p div='tes\"er'></p>")
