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.

90 lines
3.9 KiB

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Picklers where
import Tests.Arbitrary ()
import Data.XML.Pickle
import Network.Xmpp.Marshal
import Network.Xmpp.Types
import Test.Tasty
import Test.Tasty.TH
import Test.Tasty.QuickCheck
import Data.Text (Text)
import Data.XML.Types
-- | Test Pickler self-inverse: Check that unpickling after pickling gives the
-- original value
tpsi :: Eq a => PU t a -> a -> Bool
tpsi p = \x -> case unpickle p (pickle p x) of
Left _ -> False
Right x' -> x == x'
testPickler :: PU t a -> a -> IO ()
testPickler p x = case unpickle p (pickle p x) of
Left e -> putStrLn $ ppUnpickleError e
Right _ -> putStrLn "OK."
prop_xpStreamStanza_invertibe :: Either StreamErrorInfo Stanza -> Bool
prop_xpStreamStanza_invertibe = tpsi xpStreamStanza
prop_xpStanza_invertibe :: Stanza -> Bool
prop_xpStanza_invertibe = tpsi xpStanza
prop_xpMessage_invertibe :: Message -> Bool
prop_xpMessage_invertibe = tpsi xpMessage
prop_xpPresence_invertibe = tpsi xpPresence
prop_xpPresence_invertibe :: Presence -> Bool
prop_xpIQRequest_invertibe = tpsi xpIQRequest
prop_xpIQRequest_invertibe :: IQRequest -> Bool
prop_xpIQResult_invertibe = tpsi xpIQResult
prop_xpIQResult_invertibe :: IQResult -> Bool
prop_xpErrorCondition_invertibe = tpsi xpStanzaErrorCondition
prop_xpErrorCondition_invertibe :: StanzaErrorCondition -> Bool
prop_xpStanzaError_invertibe = tpsi xpStanzaError
prop_xpStanzaError_invertibe :: StanzaError -> Bool
prop_xpMessageError_invertibe = tpsi xpMessageError
prop_xpMessageError_invertibe :: MessageError -> Bool
prop_xpPresenceError_invertibe = tpsi xpPresenceError
prop_xpPresenceError_invertibe :: PresenceError -> Bool
prop_xpIQError_invertibe = tpsi xpIQError
prop_xpIQError_invertibe :: IQError -> Bool
prop_xpStreamError_invertibe = tpsi xpStreamError
prop_xpStreamError_invertibe :: StreamErrorInfo -> Bool
prop_xpLangTag_invertibe = tpsi xpLangTag
prop_xpLangTag_invertibe :: Maybe LangTag -> Bool
prop_xpLang_invertibe = tpsi xpLang
prop_xpLang_invertibe :: LangTag -> Bool
prop_xpStream_invertibe = tpsi xpStream
prop_xpStream_invertibe :: ( Text
, Maybe Jid
, Maybe Jid
, Maybe Text
, Maybe LangTag )
-> Bool
prop_xpJid_invertibe = tpsi xpJid
prop_xpJid_invertibe :: Jid -> Bool
prop_xpIQRequestType_invertibe = tpsi xpIQRequestType
prop_xpIQRequestType_invertibe :: IQRequestType -> Bool
prop_xpMessageType_invertibe = tpsi xpMessageType
prop_xpMessageType_invertibe :: MessageType -> Bool
prop_xpPresenceType_invertibe = tpsi xpPresenceType
prop_xpPresenceType_invertibe :: PresenceType -> Bool
prop_xpStanzaErrorType_invertibe = tpsi xpStanzaErrorType
prop_xpStanzaErrorType_invertibe :: StanzaErrorType -> Bool
prop_xpStanzaErrorCondition_invertibe = tpsi xpStanzaErrorCondition
prop_xpStanzaErrorCondition_invertibe :: StanzaErrorCondition -> Bool
prop_xpStreamErrorCondition_invertibe = tpsi xpStreamErrorCondition
prop_xpStreamErrorCondition_invertibe :: StreamErrorCondition -> Bool
-- prop_xpStreamFeatures_invertibe = testPicklerInvertible xpStreamFeatures
picklerTests :: TestTree
picklerTests = $testGroupGenerator
bad = StreamErrorInfo { errorCondition = StreamInvalidFrom
, errorText = Just (Nothing,"")
, errorXml = Just (
Element { elementName =
Name { nameLocalName = "\65044"
, nameNamespace = Just "\14139"
, namePrefix = Just "\651"}
, elementAttributes = []
, elementNodes = []})}