{-# LANGUAGE DeriveDataTypeable #-}

{-# LANGUAGE OverloadedStrings  #-}

import           Control.Exception            (Exception, toException)

import           Control.Monad.IO.Class       (liftIO)

import qualified Data.ByteString.Char8        as S

import qualified Data.ByteString.Lazy.Char8   as L

import           Data.Typeable                (Typeable)

import           Data.XML.Types

import           Test.Hspec

import           Test.HUnit                   hiding (Test)

import qualified Text.XML                     as Res

import qualified Text.XML.Cursor              as Cu

import           Text.XML.Stream.Parse        (def)

import qualified Text.XML.Stream.Parse        as P

import qualified Text.XML.Unresolved          as D

import           Control.Applicative          ((<$>))

import           Control.Monad

import           Control.Monad.Trans.Class    (lift)

import qualified Data.Set                     as Set

import           Data.Text                    (Text)

import qualified Data.Text                    as T

import           Text.XML.Cursor              (($.//), ($/), ($//), ($|),

                                               (&.//), (&/), (&//))

import           Control.Monad.Trans.Resource (runResourceT)

import qualified Control.Monad.Trans.Resource as C

import           Data.Conduit                 ((=$=))

import qualified Data.Conduit                 as C

import qualified Data.Conduit.List            as CL

import qualified Data.Map                     as Map

import           Text.Blaze                   (toMarkup)

import           Text.Blaze.Renderer.String   (renderMarkup)

main :: IO ()

main = hspec $ do

    describe "XML parsing and rendering" $ do

        it "is idempotent to parse and render a document" documentParseRender

        it "has valid parser combinators" combinators

        context "has working choose function" testChoose

        it "has working many function" testMany

        it "has working many' function" testMany'

        it "has working manyYield function" testManyYield

        it "has working takeContent function" testTakeContent

        it "has working takeTree function" testTakeTree

        it "has working takeAnyTreeContent function" testTakeAnyTreeContent

        it "has working orE" testOrE

        it "is idempotent to parse and pretty render a document" documentParsePrettyRender

        it "ignores the BOM" parseIgnoreBOM

        it "strips duplicated attributes" stripDuplicateAttributes

        it "displays comments" testRenderComments

        it "conduit parser" testConduitParser

        it "can omit the XML declaration" omitXMLDeclaration

        context "correctly parses hexadecimal entities" hexEntityParsing

    describe "XML Cursors" $ do

        it "has correct parent" cursorParent

        it "has correct ancestor" cursorAncestor

        it "has correct orSelf" cursorOrSelf

        it "has correct preceding" cursorPreceding

        it "has correct following" cursorFollowing

        it "has correct precedingSibling" cursorPrecedingSib

        it "has correct followingSibling" cursorFollowingSib

        it "has correct descendant" cursorDescendant

        it "has correct check" cursorCheck

        it "has correct check with lists" cursorPredicate

        it "has correct checkNode" cursorCheckNode

        it "has correct checkElement" cursorCheckElement

        it "has correct checkName" cursorCheckName

        it "has correct anyElement" cursorAnyElement

        it "has correct element" cursorElement

        it "has correct laxElement" cursorLaxElement

        it "has correct content" cursorContent

        it "has correct attribute" cursorAttribute

        it "has correct laxAttribute" cursorLaxAttribute

        it "has correct &* and $* operators" cursorDeep

        it "has correct force" cursorForce

        it "has correct forceM" cursorForceM

        it "has correct hasAttribute" cursorHasAttribute

        it "has correct attributeIs" cursorAttributeIs

    describe "resolved" $ do

        it "identifies unresolved entities" resolvedIdentifies

        it "decodeHtmlEntities" testHtmlEntities

        it "works for resolvable entities" resolvedAllGood

        it "merges adjacent content nodes" resolvedMergeContent

        it "understands inline entity declarations" resolvedInline

    describe "pretty" $ do

        it "works" casePretty

    describe "top level namespaces" $ do

        it "works" caseTopLevelNamespace

        it "works with prefix" caseTopLevelNamespacePrefix

        it "handles conflicts" caseTLNConflict

    describe "blaze-html instances" $ do

        it "works" caseBlazeHtml

    describe "attribute reordering" $ do

        it "works" caseAttrReorder

    describe "ordering attributes explicitly" $ do

        it "works" caseOrderAttrs

    it "parsing CDATA" caseParseCdata

    it "retains namespaces when asked" caseRetainNamespaces

    it "handles iso-8859-1" caseIso8859_1

    it "renders CDATA when asked" caseRenderCDATA

    it "escapes CDATA closing tag in CDATA" caseEscapesCDATA

documentParseRender :: IO ()

documentParseRender =

    mapM_ go docs

  where

    go x = x @=? D.parseLBS_ def (D.renderLBS def x)

    docs =

        [ Document (Prologue [] Nothing [])

                   (Element "foo" [] [])

                   []

        , D.parseLBS_ def

            "\n<foo/>"

        , D.parseLBS_ def

            "\n<foo><nested>&ignore;</nested></foo>"

        , D.parseLBS_ def

            "<foo>]]></foo>"

        , D.parseLBS_ def

            "<foo bar='baz&bin'/>"

        , D.parseLBS_ def

            "<foo></foo>"

        , D.parseLBS_ def

            "<foo></foo>"

        ]

documentParsePrettyRender :: IO ()

documentParsePrettyRender =

    L.unpack (D.renderLBS def { D.rsPretty = True } (D.parseLBS_ def doc)) @?= L.unpack doc

  where

    doc = L.unlines

        [ ""

        , "<foo>"

        , "    "

        , "    text"

        , "    "

        , "</foo>"

        ]

combinators :: Assertion

combinators = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tag' "hello" (P.requireAttr "world") $ \world -> do

        liftIO $ world @?= "true"

        P.force "need child1" $ P.tagNoAttr "{mynamespace}child1" $ return ()

        P.force "need child2" $ P.tagNoAttr "child2" $ return ()

        P.force "need child3" $ P.tagNoAttr "child3" $ do

            x <- P.contentMaybe

            liftIO $ x @?= Just "combine <all> &content"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello world='true'>"

        , ""

        , "<child1 xmlns='mynamespace'/>"

        , ""

        , "<child2>   </child2>"

        , "<child3>combine <all> </child3>\n"

        , "</hello>"

        ]

testChoose :: Spec

testChoose = do

    it "can choose between elements"

        testChooseEitherElem

    it "can choose between elements and text, returning text"

        testChooseElemOrTextIsText

    it "can choose between elements and text, returning elements"

        testChooseElemOrTextIsElem

    it "can choose between text and elements, returning text"

        testChooseTextOrElemIsText

    it "can choose between text and elements, returning elements"

        testChooseTextOrElemIsElem

    it "can choose between text and elements, when the text is encoded"

        testChooseElemOrTextIsEncoded

    it "can choose between text and elements, when the text is encoded, NBSP"

        testChooseElemOrTextIsEncodedNBSP

    it "can choose between elements and text, when the text is whitespace"

        testChooseElemOrTextIsWhiteSpace

    it "can choose between text and elements, when the text is whitespace"

        testChooseTextOrElemIsWhiteSpace

    it "can choose between text and elements, when the whitespace is both literal and encoded"

        testChooseElemOrTextIsChunkedText

    it "can choose between text and elements, when the text is chunked the other way"

        testChooseElemOrTextIsChunkedText2

testChooseElemOrTextIsText :: Assertion

testChooseElemOrTextIsText = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just " something "

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , " something "

        , "</hello>"

        ]

testChooseElemOrTextIsEncoded :: Assertion

testChooseElemOrTextIsEncoded = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "\x20something\x20"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , " something "

        , "</hello>"

        ]

testChooseElemOrTextIsEncodedNBSP :: Assertion

testChooseElemOrTextIsEncodedNBSP = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "\160something\160"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , " something "

        , "</hello>"

        ]

testChooseElemOrTextIsWhiteSpace :: Assertion

testChooseElemOrTextIsWhiteSpace = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "\x20\x20\x20"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>   </hello>"

        ]

testChooseTextOrElemIsWhiteSpace :: Assertion

testChooseTextOrElemIsWhiteSpace = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.contentMaybe

            , P.tagNoAttr "failure" $ return "boom"

            ]

        liftIO $ x @?= Just "\x20\x20\x20"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>   </hello>"

        ]

testChooseElemOrTextIsChunkedText :: Assertion

testChooseElemOrTextIsChunkedText = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "\x20\x20\x20"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>   </hello>"

        ]

testChooseElemOrTextIsChunkedText2 :: Assertion

testChooseElemOrTextIsChunkedText2 = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return "boom"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "\x20\x20\x20"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>   </hello>"

        ]

testChooseElemOrTextIsElem :: Assertion

testChooseElemOrTextIsElem = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "success" $ return "success"

            , P.contentMaybe

            ]

        liftIO $ x @?= Just "success"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "</hello>"

        ]

testChooseTextOrElemIsText :: Assertion

testChooseTextOrElemIsText = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.contentMaybe

            , P.tagNoAttr "failure" $ return "boom"

            ]

        liftIO $ x @?= Just " something "

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , " something "

        , "</hello>"

        ]

testChooseTextOrElemIsElem :: Assertion

testChooseTextOrElemIsElem = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.contentMaybe

            , P.tagNoAttr "success" $ return "success"

            ]

        liftIO $ x @?= Just "success"

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "</hello>"

        ]

testChooseEitherElem :: Assertion

testChooseEitherElem = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.choose

            [ P.tagNoAttr "failure" $ return 1

            , P.tagNoAttr "success" $ return 2

            ]

        liftIO $ x @?= Just (2 :: Int)

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "</hello>"

        ]

testManyYield :: Assertion

testManyYield = do

    -- Basically the same as testMany, but consume the streamed result

    result <- runResourceT $

        P.parseLBS def input C.$$ helloParser

        =$= CL.consume

    length result @?= 5

  where

    helloParser = void $ P.tagNoAttr "hello" $ P.manyYield successParser

    successParser = P.tagNoAttr "success" $ return ()

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "</hello>"

        ]

testTakeContent :: Assertion

testTakeContent = do

    result <- runResourceT $ P.parseLBS def input C.$$ rootParser

    result @?= Just

      [ EventContent (ContentText "Hello world !")

      ]

  where

    rootParser = P.tagNoAttr "root" $ void (P.takeContent >> P.takeContent) =$= CL.consume

    input = L.concat

        [ ""

        , "\n"

        , "<root>"

        , "Hello world !"

        , "</root>"

        ]

testTakeTree :: Assertion

testTakeTree = do

    result <- runResourceT $ P.parseLBS def input C.$$ rootParser

    result @?=

      [ EventBeginDocument

      , EventBeginDoctype "foo" Nothing

      , EventEndDoctype

      , EventBeginElement "a" []

      , EventBeginElement "em" []

      , EventContent (ContentText "Hello world !")

      , EventEndElement "em"

      , EventEndElement "a"

      ]

  where

    rootParser = void (P.takeTree "a" P.ignoreAttrs) =$= CL.consume

    input = L.concat

        [ ""

        , "\n"

        , ""

        , "Hello world !"

        , ""

        , ""

        , ""

        ]

testTakeAnyTreeContent :: Assertion

testTakeAnyTreeContent = do

    result <- runResourceT $ P.parseLBS def input C.$$ rootParser

    result @?= Just

      [ EventBeginElement "b" []

      , EventContent (ContentText "Hello ")

      , EventBeginElement "em" []

      , EventContent (ContentText "world")

      , EventEndElement "em"

      , EventContent (ContentText " !")

      , EventEndElement "b"

      ]

  where

    rootParser = P.tagNoAttr "root" $ (P.takeAnyTreeContent >> void P.ignoreAnyTreeContent) =$= CL.consume

    input = L.concat

        [ ""

        , "\n"

        , "<root>"

        , "Hello world ! Welcome !"

        , "</root>"

        ]

testMany :: Assertion

testMany = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.many $ P.tagNoAttr "success" $ return ()

        liftIO $ length x @?= 5

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "</hello>"

        ]

testMany' :: Assertion

testMany' = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.many' $ P.tagNoAttr "success" $ return ()

        liftIO $ length x @?= 5

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "<success/>"

        , "<success/>"

        , "<foobar/>"

        , "<success/>"

        , "<foo><bar attr=\"1\">some content</bar></foo>"

        , "<success/>"

        , "</hello>"

        ]

testOrE :: IO ()

testOrE = runResourceT $ P.parseLBS def input C.$$ do

    P.force "need hello" $ P.tagNoAttr "hello" $ do

        x <- P.tagNoAttr "failure" (return 1) `P.orE`

             P.tagNoAttr "success" (return 2)

        y <- P.tag' "success" (P.requireAttr "failure") (const $ return 1) `P.orE`

             P.tag' "success" (P.requireAttr "success") (const $ return 2)

        liftIO $ x @?= Just (2 :: Int)

        liftIO $ y @?= Just (2 :: Int)

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<success/>"

        , "<success success=\"0\"/>"

        , "</hello>"

        ]

testConduitParser :: Assertion

testConduitParser = runResourceT $ do

    x <- P.parseLBS def input

        C.$$ (P.force "need hello" $ P.tagNoAttr "hello" f)

        =$= CL.consume

    liftIO $ x @?= [1, 1, 1]

  where

    input = L.concat

        [ ""

        , "\n"

        , "<hello>"

        , "<item/>"

        , "<item/>"

        , "<item/>"

        , "</hello>"

        ]

    f :: C.MonadThrow m => C.Conduit Event m Int

    f = do

        ma <- P.tagNoAttr "item" (return 1)

        maybe (return ()) (\a -> C.yield a >> f) ma

omitXMLDeclaration :: Assertion

omitXMLDeclaration = Res.renderLBS settings input @?= spec

  where

    settings = def { Res.rsXMLDeclaration = False }

    input = Res.Document (Prologue [] Nothing [])

              (Res.Element "foo" Map.empty [Res.NodeContent "bar"])

              []

    spec = "<foo>bar</foo>"

hexEntityParsing :: Spec

hexEntityParsing = do

  it "rejects leading 0x" $

    go "<foo>&#x0xff;</foo>" @?= Nothing

  it "rejects leading 0X" $

    go "<foo>&#x0Xff;</foo>" @?= Nothing

  it "accepts lowercase hex digits" $

    go "<foo>ÿ</foo>" @?= Just spec

  it "accepts uppercase hex digits" $

    go "<foo>ÿ</foo>" @?= Just spec

  --Note: this must be rejected, because, according to the XML spec, a

  --legal EntityRef's entity matches Name, which can't start with a

  --hash.

  it "rejects trailing junk" $

    go "<foo>&#xffhello;</foo>" @?= Nothing

  --Some of these next tests are XML 1.0 specific (i.e., they would

  --differ for XML 1.1), but approximately no-one uses XML 1.1.

  it "rejects illegal character #x0" $

    go "<foo>�</foo>" @?= Nothing

  it "rejects illegal character #xFFFE" $

    go "<foo>￾</foo>" @?= Nothing

  it "rejects illegal character #xFFFF" $

    go "<foo>￿</foo>" @?= Nothing

  it "rejects illegal character #xD900" $

    go "<foo>�</foo>" @?= Nothing

  it "rejects illegal character #xC" $

    go "<foo></foo>" @?= Nothing

  it "rejects illegal character #x1F" $

    go "<foo></foo>" @?= Nothing

  it "accepts astral plane character" $

    go "<foo>􀛿</foo>" @?= Just astralSpec

  where

    spec = Document (Prologue [] Nothing [])

                    (Element "foo" [] [NodeContent (ContentText "\xff")])

                    []

    astralSpec = Document (Prologue [] Nothing [])

                    (Element "foo" [] [NodeContent (ContentText "\x1006ff")])

                    []

    go = either (const Nothing) Just . D.parseLBS def

name :: [Cu.Cursor] -> [Text]

name [] = []

name (c:cs) = ($ name cs) $ case Cu.node c of

                              Res.NodeElement e -> ((Res.nameLocalName $ Res.elementName e) :)

                              _ -> id

cursor :: Cu.Cursor

cursor =

    Cu.fromDocument $ Res.parseLBS_ def input

  where

    input = L.concat

        [ "<foo attr=\"x\">"

        ,    "<bar1/>"

        ,    "<bar2>"

        ,       "<baz1/>"

        ,       "<baz2 attr=\"y\"/>"

        ,       "<baz3>a</baz3>"

        ,    "</bar2>"

        ,    "<bar3>"

        ,       "<bin1/>"

        ,       "b"

        ,       "<bin2/>"

        ,       "<bin3/>"

        ,    "</bar3>"

        ,    "<Bar1 xmlns=\"http://example.com\" Attr=\"q\"/>"

        , "</foo>"

        ]

bar2, baz2, bar3, bin2 :: Cu.Cursor

bar2 = Cu.child cursor !! 1

baz2 = Cu.child bar2 !! 1

bar3 = Cu.child cursor !! 2

bin2 = Cu.child bar3 !! 1

cursorParent, cursorAncestor, cursorOrSelf, cursorPreceding, cursorFollowing,

    cursorPrecedingSib, cursorFollowingSib, cursorDescendant, cursorCheck,

    cursorPredicate, cursorCheckNode, cursorCheckElement, cursorCheckName,

    cursorAnyElement, cursorElement, cursorLaxElement, cursorContent,

    cursorAttribute, cursorLaxAttribute, cursorHasAttribute,

    cursorAttributeIs, cursorDeep, cursorForce, cursorForceM,

    resolvedIdentifies, resolvedAllGood, resolvedMergeContent,

    testHtmlEntities

    :: Assertion

cursorParent = name (Cu.parent bar2) @?= ["foo"]

cursorAncestor = name (Cu.ancestor baz2) @?= ["bar2", "foo"]

cursorOrSelf = name (Cu.orSelf Cu.ancestor baz2) @?= ["baz2", "bar2", "foo"]

cursorPreceding = do

  name (Cu.preceding baz2) @?= ["baz1", "bar1"]

  name (Cu.preceding bin2) @?= ["bin1", "baz3", "baz2", "baz1", "bar2", "bar1"]

cursorFollowing = do

  name (Cu.following baz2) @?= ["baz3", "bar3", "bin1", "bin2", "bin3", "Bar1"]

  name (Cu.following bar2) @?= ["bar3", "bin1", "bin2", "bin3", "Bar1"]

cursorPrecedingSib = name (Cu.precedingSibling baz2) @?= ["baz1"]

cursorFollowingSib = name (Cu.followingSibling baz2) @?= ["baz3"]

cursorDescendant = (name $ Cu.descendant cursor) @?= T.words "bar1 bar2 baz1 baz2 baz3 bar3 bin1 bin2 bin3 Bar1"

cursorCheck = null (cursor $.// Cu.check (const False)) @?= True

cursorPredicate = (name $ cursor $.// Cu.check Cu.descendant) @?= T.words "foo bar2 baz3 bar3"

cursorCheckNode = (name $ cursor $// Cu.checkNode f) @?= T.words "bar1 bar2 bar3"

    where f (Res.NodeElement e) = "bar" `T.isPrefixOf` Res.nameLocalName (Res.elementName e)

          f _               = False

cursorCheckElement = (name $ cursor $// Cu.checkElement f) @?= T.words "bar1 bar2 bar3"

    where f e = "bar" `T.isPrefixOf` Res.nameLocalName (Res.elementName e)

cursorCheckName = (name $ cursor $// Cu.checkName f) @?= T.words "bar1 bar2 bar3"

    where f n = "bar" `T.isPrefixOf` nameLocalName n

cursorAnyElement = (name $ cursor $// Cu.anyElement) @?= T.words "bar1 bar2 baz1 baz2 baz3 bar3 bin1 bin2 bin3 Bar1"

cursorElement = (name $ cursor $// Cu.element "bar1") @?= ["bar1"]

cursorLaxElement = (name $ cursor $// Cu.laxElement "bar1") @?= ["bar1", "Bar1"]

cursorContent = do

  Cu.content cursor @?= []

  (cursor $.// Cu.content) @?= ["a", "b"]

cursorAttribute = Cu.attribute "attr" cursor @?= ["x"]

cursorLaxAttribute = (cursor $.// Cu.laxAttribute "Attr") @?= ["x", "y", "q"]

cursorHasAttribute = (length $ cursor $.// Cu.hasAttribute "attr") @?= 2

cursorAttributeIs = (length $ cursor $.// Cu.attributeIs "attr" "y") @?= 1

cursorDeep = do

  (Cu.element "foo" &/ Cu.element "bar2" &// Cu.attribute "attr") cursor @?= ["y"]

  (return &.// Cu.attribute "attr") cursor @?= ["x", "y"]

  (cursor $.// Cu.attribute "attr") @?= ["x", "y"]

  (cursor $/ Cu.element "bar2" &// Cu.attribute "attr") @?= ["y"]

  (cursor $/ Cu.element "bar2" &/ Cu.element "baz2" >=> Cu.attribute "attr") @?= ["y"]

  null (cursor $| Cu.element "foo") @?= False

cursorForce = do

  Cu.force DummyEx [] @?= (Nothing :: Maybe Integer)

  Cu.force DummyEx [1] @?= Just (1 :: Int)

  Cu.force DummyEx [1,2] @?= Just (1 :: Int)

cursorForceM = do

  Cu.forceM DummyEx [] @?= (Nothing :: Maybe Integer)

  Cu.forceM DummyEx [Just 1, Nothing] @?= Just (1 :: Int)

  Cu.forceM DummyEx [Nothing, Just (1 :: Int)] @?= Nothing

data DummyEx = DummyEx

    deriving (Show, Typeable)

instance Exception DummyEx

showEq :: (Show a, Show b) => Either a b -> Either a b -> Assertion

showEq x y = show x @=? show y

resolvedIdentifies =

    Left (toException $ Res.UnresolvedEntityException $ Set.fromList ["foo", "bar", "baz"]) `showEq`

    Res.parseLBS def

    "<root attr='&bar;'>&foo; --- &baz; &foo;</root>"

testHtmlEntities =

    Res.parseLBS_ def

        { P.psDecodeEntities = P.decodeHtmlEntities

        } xml1 @=? Res.parseLBS_ def xml2

  where

    xml1 = "<root> </root>"

    xml2 = "<root> </root>"

resolvedAllGood =

    D.parseLBS_ def xml @=?

    Res.toXMLDocument (Res.parseLBS_ def xml)

  where

    xml = "<foo><bar/><baz/></foo>"

resolvedMergeContent =

    Res.documentRoot (Res.parseLBS_ def xml) @=?

    Res.Element "foo" Map.empty [Res.NodeContent "bar&baz"]

  where

    xml = "<foo>bar&baz</foo>"

parseIgnoreBOM :: Assertion

parseIgnoreBOM = do

    either (const $ Left (1 :: Int)) Right (Res.parseText Res.def "\xfeef<foo/>") @?=

        either (const $ Left (2 :: Int)) Right (Res.parseText Res.def "<foo/>")

stripDuplicateAttributes :: Assertion

stripDuplicateAttributes = do

    "<foo bar=\"baz\"/>" @=?

        D.renderLBS def (Document (Prologue [] Nothing []) (Element "foo" [("bar", [ContentText "baz"]), ("bar", [ContentText "bin"])] []) [])

    "<foo x:bar=\"baz\" xmlns:x=\"namespace\"/>" @=?

        D.renderLBS def (Document (Prologue [] Nothing []) (Element "foo"

            [ ("x:bar", [ContentText "baz"])

            , (Name "bar" (Just "namespace") (Just "x"), [ContentText "bin"])

            ] []) [])

testRenderComments :: Assertion

testRenderComments =do

    "<foo></foo>"

        @=? D.renderLBS def (Document (Prologue [] Nothing [])

            (Element "foo" [] [NodeComment "comment"]) [])

resolvedInline :: Assertion

resolvedInline = do

    Res.Document _ root _ <- return $ Res.parseLBS_ Res.def "]><foo>&bar;</foo>"

    root @?= Res.Element "foo" Map.empty [Res.NodeContent "baz"]

    Res.Document _ root2 _ <- return $ Res.parseLBS_ Res.def "]><foo bar='&bar;'/>"

    root2 @?= Res.Element "foo" (Map.singleton "bar" "baz") []

casePretty :: Assertion

casePretty = do

    let pretty = S.unlines

            [ ""

            , ""

            , "<foo bar=\"bar\" baz=\"baz\">"

            , "    

            , "      bar=\"bar\""

            , "      baz=\"baz\""

            , "      bin=\"bin\">"

            , "        Hello World"

            , "    </foo>"

            , "    <foo/>"

            , "    "

            , "    "

            , "    <bar>"

            , "        bar content"

            , "    </bar>"

            , "</foo>"

            ]

        doctype = Res.Doctype "foo" Nothing

        doc = Res.Document (Res.Prologue [] (Just doctype) []) root []

        root = Res.Element "foo" (Map.fromList [("bar", "bar"), ("baz", "baz")])

                [ Res.NodeElement $ Res.Element "foo" (Map.fromList [("bar", "bar"), ("baz", "baz"), ("bin", "bin")])

                    [ Res.NodeContent "  Hello World\n\n"

                    , Res.NodeContent "  "

                    ]

                , Res.NodeElement $ Res.Element "foo" Map.empty []

                , Res.NodeInstruction $ Res.Instruction "foo" "bar"

                , Res.NodeComment "foo bar\n\r\nbaz    \tbin "

                , Res.NodeElement $ Res.Element "bar" Map.empty [Res.NodeContent "bar content"]

                ]

    pretty @=? S.concat (L.toChunks $ Res.renderLBS def { D.rsPretty = True } doc)

caseTopLevelNamespace :: Assertion

caseTopLevelNamespace = do

    let lbs = S.concat

            [ ""

            , "<foo xmlns:bar=\"baz\">"

            , "<subfoo bar:bin=\"\"/>"

            , "</foo>"

            ]

        rs = def { D.rsNamespaces = [("bar", "baz")] }

        doc = Res.Document (Res.Prologue [] Nothing [])

                (Res.Element "foo" Map.empty

                    [ Res.NodeElement

                        $ Res.Element "subfoo" (Map.singleton "{baz}bin" "") []

                    ])

                []

    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)

caseTopLevelNamespacePrefix :: Assertion

caseTopLevelNamespacePrefix = do

    let lbs = S.concat

            [ ""

            , "<foo xmlns:bar=\"baz\">"

            , "<subfoo bar:bin=\"\"/>"

            , "</foo>"

            ]

        rs = def { D.rsNamespaces = [("bar", "baz")] }

        doc = Res.Document (Res.Prologue [] Nothing [])

                (Res.Element "foo" Map.empty

                    [ Res.NodeElement

                        $ Res.Element "subfoo" (Map.fromList [(Name "bin" (Just "baz") (Just "bar"), "")]) []

                    ])

                []

    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)

caseTLNConflict :: Assertion

caseTLNConflict = do

    let lbs = S.concat

            [ ""

            , "<foo xmlns:bar=\"something\" bar:x=\"y\">"

            , "<subfoo xmlns:bar_=\"baz\" bar_:bin=\"\"/>"

            , "</foo>"

            ]

        rs = def { D.rsNamespaces = [("bar", "baz")] }

        doc = Res.Document (Res.Prologue [] Nothing [])

                (Res.Element "foo" (Map.fromList [(Name "x" (Just "something") (Just "bar"), "y")])

                    [ Res.NodeElement

                        $ Res.Element "subfoo" (Map.fromList [(Name "bin" (Just "baz") (Just "bar"), "")]) []

                    ])

                []

    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)

caseBlazeHtml :: Assertion

caseBlazeHtml =

    expected @=? str

  where

    str = renderMarkup $ toMarkup $ Res.Document (Res.Prologue [] Nothing []) root []

    root :: Res.Element

    root = Res.Element "html" Map.empty

        [ Res.NodeElement $ Res.Element "head" Map.empty

            [ Res.NodeElement $ Res.Element "title" Map.empty [Res.NodeContent "Test"]

            , Res.NodeElement $ Res.Element "script" Map.empty

                [Res.NodeContent "if (5 < 6 || 8 > 9) alert('Hello World!');"]

            , Res.NodeElement $ Res.Element "{http://www.snoyman.com/xml2html}ie-cond" (Map.singleton "cond" "lt IE 7")

                [Res.NodeElement $ Res.Element "link" (Map.singleton "href" "ie6.css") []]

            , Res.NodeElement $ Res.Element "style" Map.empty

                [Res.NodeContent "body > h1 { color: red }"]

            ]

        , Res.NodeElement $ Res.Element "body" Map.empty

            [ Res.NodeElement $ Res.Element "h1" Map.empty [Res.NodeContent "Hello World!"]

            ]

        ]

    expected :: String

    expected = concat

        [ "\n"

        , "<html><head><title>Test</title><script>if (5 < 6 || 8 > 9) alert('Hello World!');</script>"

        , ""

        , "<style>body > h1 { color: red }</style>"

        , "</head>"

        , "<body>
Hello World!
</body></html>"

        ]

caseAttrReorder :: Assertion

caseAttrReorder = do

    let lbs = S.concat

            [ ""

            , "<foo c=\"c\" b=\"b\" a=\"a\">"

            , "<bar a=\"a\" b=\"b\" c=\"c\"/>"

            , "</foo>"

            ]

        rs = def { Res.rsAttrOrder = \name m ->

                        case name of

                            "foo" -> reverse $ Map.toAscList m

                            _     -> Map.toAscList m

                 }

        attrs = Map.fromList [("a", "a"), ("b", "b"), ("c", "c")]

        doc = Res.Document (Res.Prologue [] Nothing [])

                (Res.Element "foo" attrs

                    [ Res.NodeElement

                        $ Res.Element "bar" attrs []

                    ])

                []

    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)

caseOrderAttrs :: Assertion

caseOrderAttrs = do

    let lbs = S.concat

            [ ""

            , "<foo c=\"c\" b=\"b\" a=\"a\">"

            , "<bar a=\"a\" b=\"b\" c=\"c\"/>"

            , "</foo>"