{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} import Test.HUnit hiding (Test) import Test.Hspec import Yesod.Core import Yesod.Test import Yesod.Test.CssQuery import Yesod.Test.TransversingCSS import Text.XML import Data.Text (Text) import Data.Monoid ((<>)) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD parseQuery_ = either error id . parseQuery findBySelector_ x = either error id . findBySelector x parseHtml_ = HD.parseLBS main :: IO () main = hspec $ do describe "CSS selector parsing" $ do it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]] it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]] it "comma" $ parseQuery_ "strong.bar, #foo" @?= [[DeepChildren [ByTagName "strong", ByClass "bar"]], [DeepChildren [ById "foo"]]] describe "find by selector" $ do it "XHTML" $ let html = "foo

Hello World

" query = "body > p" in findBySelector_ html query @?= ["

Hello World

"] it "HTML" $ let html = "foo

Hello World

" query = "body > p" in findBySelector_ html query @?= ["

Hello World

"] describe "HTML parsing" $ do it "XHTML" $ let html = "foo

Hello World

" doc = Document (Prologue [] Nothing []) root [] root = Element "html" Map.empty [ NodeElement $ Element "head" Map.empty [ NodeElement $ Element "title" Map.empty [NodeContent "foo"] ] , NodeElement $ Element "body" Map.empty [ NodeElement $ Element "p" Map.empty [NodeContent "Hello World"] ] ] in parseHtml_ html @?= doc it "HTML" $ let html = "foo

Hello World

" doc = Document (Prologue [] Nothing []) root [] root = Element "html" Map.empty [ NodeElement $ Element "head" Map.empty [ NodeElement $ Element "title" Map.empty [NodeContent "foo"] ] , NodeElement $ Element "body" Map.empty [ NodeElement $ Element "br" Map.empty [] , NodeElement $ Element "p" Map.empty [NodeContent "Hello World"] ] ] in parseHtml_ html @?= doc let app = liteApp $ dispatchTo $ do mfoo <- lookupGetParam "foo" case mfoo of Nothing -> return "Hello world!" Just foo -> return $ "foo=" <> foo describe "basic usage" $ yesodSpec app $ do ydescribe "tests1" $ do yit "tests1a" $ do get ("/" :: Text) statusIs 200 bodyEquals "Hello world!" yit "tests1b" $ do get ("/foo" :: Text) statusIs 404 ydescribe "tests2" $ do yit "type-safe URLs" $ do get $ LiteAppRoute [] statusIs 200 yit "type-safe URLs with query-string" $ do get (LiteAppRoute [], [("foo", "bar")]) statusIs 200 bodyEquals "foo=bar" yit "tests2b" $ return ()