90 lines
3.7 KiB
Haskell
90 lines
3.7 KiB
Haskell
{-# 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 = "<html><head><title>foo</title></head><body><p>Hello World</p></body></html>"
|
|
query = "body > p"
|
|
in findBySelector_ html query @?= ["<p>Hello World</p>"]
|
|
it "HTML" $
|
|
let html = "<html><head><title>foo</title></head><body><br><p>Hello World</p></body></html>"
|
|
query = "body > p"
|
|
in findBySelector_ html query @?= ["<p>Hello World</p>"]
|
|
describe "HTML parsing" $ do
|
|
it "XHTML" $
|
|
let html = "<html><head><title>foo</title></head><body><p>Hello World</p></body></html>"
|
|
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 = "<html><head><title>foo</title></head><body><br><p>Hello World</p></body></html>"
|
|
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 ()
|