You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
57 lines
2.3 KiB
57 lines
2.3 KiB
{-# LANGUAGE NoMonomorphismRestriction #-} |
|
{-# LANGUAGE OverloadedStrings #-} |
|
{-# LANGUAGE TemplateHaskell #-} |
|
|
|
module Tests.Parsers where |
|
|
|
import Control.Applicative ((<$>)) |
|
import Network.Xmpp.Internal |
|
import Test.Hspec |
|
import Test.Tasty.QuickCheck |
|
import Test.Tasty |
|
import Test.Tasty.TH |
|
import Test.Tasty.HUnit |
|
|
|
import Tests.Arbitrary () |
|
|
|
case_JidFromText :: Assertion |
|
case_JidFromText = hspec . describe "jidFromText" $ do |
|
it "parses a full JID" $ jidFromText "foo@bar.com/quux" |
|
`shouldBe` Just (Jid (Just "foo") |
|
"bar.com" |
|
(Just "quux")) |
|
it "parses a bare JID" $ jidFromText "foo@bar.com" |
|
`shouldBe` Just (Jid (Just "foo") |
|
"bar.com" |
|
Nothing) |
|
it "parses a domain" $ jidFromText "bar.com" |
|
`shouldBe` Just (Jid Nothing |
|
"bar.com" |
|
Nothing) |
|
it "parses domain with resource" $ jidFromText "bar.com/quux" |
|
`shouldBe` Just (Jid Nothing |
|
"bar.com" |
|
(Just "quux")) |
|
it "rejects multiple '@'" $ shouldReject "foo@bar@baz" |
|
it "rejects multiple '/'" $ shouldReject "foo/bar/baz" |
|
it "rejects multiple '/' after '@'" $ shouldReject "quux@foo/bar/baz" |
|
it "rejects '@' after '/'" $ shouldReject "foo/bar@baz" |
|
it "rejects empty local part" $ shouldReject "@bar/baz" |
|
it "rejects empty resource part" $ shouldReject "foo@bar/" |
|
it "rejects empty domain part" $ shouldReject "foo@/baz" |
|
where shouldReject jid = jidFromText jid `shouldBe` Nothing |
|
|
|
prop_jidFromText_rightInverse :: Jid -> Bool |
|
prop_jidFromText_rightInverse j = let jidText = jidToText j in |
|
(jidToText <$> jidFromText jidText) == Just jidText |
|
|
|
prop_jidFromText_leftInverse :: Jid -> Bool |
|
prop_jidFromText_leftInverse jid = (jidFromText $ jidToText jid) == Just jid |
|
|
|
|
|
case_LangTagParser :: Assertion |
|
case_LangTagParser = hspec . describe "langTagFromText" $ |
|
it "has some properties" $ pendingWith "Check requirements" |
|
|
|
parserTests :: TestTree |
|
parserTests = $testGroupGenerator
|
|
|