From 20d3d9cbf658055d2c644b639ec4e65c41ae0ee9 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Sun, 11 Aug 2013 16:04:54 +0200 Subject: [PATCH 1/2] add flag to control use of template haskell --- pontarius-xmpp.cabal | 156 +++++++++++------------------------ source/Network/Xmpp.hs | 2 +- source/Network/Xmpp/Types.hs | 10 +-- 3 files changed, 54 insertions(+), 114 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 08956ca..8d52647 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -25,121 +25,58 @@ Extra-Source-Files: README.md , examples/echoclient/README.md , examples/echoclient/Setup.hs +Flag with-th { + Description: Enable Template Haskell support + Default: True +} + Library hs-source-dirs: source Exposed: True - + -- The only different between the below two blocks is that the first one caps -- the range for the `bytestring' package, and that the second one includes -- `template-haskell' for GHC 7.6.1 and above. - If impl(ghc ==7.0.1) - { - Build-Depends: attoparsec >=0.10.0.3 - , base >4 && <5 - , base64-bytestring >=0.1.0.0 - , binary >=0.4.1 - , bytestring >=0.9.1.9 && <=0.9.2.1 - , conduit >=1.0.1 - , containers >=0.5.0.0 - , crypto-api >=0.9 - , crypto-random-api >=0.2 - , cryptohash >=0.6.1 - , cryptohash-cryptoapi >=0.1 - , data-default >=0.2 - , dns >=0.3.0 - , hslogger >=1.1.0 - , iproute >=1.2.4 - , lifted-base >=0.1.0.1 - , mtl >=2.0.0.0 - , network >=2.4.1.0 - , pureMD5 >=2.1.2.1 - , resourcet >=0.3.0 - , random >=1.0.0.0 - , split >=0.1.2.3 - , stm >=2.1.2.1 - , stringprep >=0.1.3 - , text >=0.11.1.5 - , tls >=1.1.0 - , tls-extra >=0.5.0 - , transformers >=0.2.2.0 - , void >=0.5.5 - , xml-types >=0.3.1 - , xml-conduit >=1.0 - , xml-picklers >=0.3.3 + + Build-Depends: attoparsec >=0.10.0.3 + , base >4 && <5 + , base64-bytestring >=0.1.0.0 + , binary >=0.4.1 + , conduit >=1.0.1 + , containers >=0.5.0.0 + , crypto-api >=0.9 + , crypto-random-api >=0.2 + , cryptohash >=0.6.1 + , cryptohash-cryptoapi >=0.1 + , data-default >=0.2 + , dns >=0.3.0 + , hslogger >=1.1.0 + , iproute >=1.2.4 + , lifted-base >=0.1.0.1 + , mtl >=2.0.0.0 + , network >=2.4.1.0 + , pureMD5 >=2.1.2.1 + , resourcet >=0.3.0 + , random >=1.0.0.0 + , split >=0.1.2.3 + , stm >=2.1.2.1 + , stringprep >=0.1.3 + , text >=0.11.1.5 + , tls >=1.1.0 + , tls-extra >=0.5.0 + , transformers >=0.2.2.0 + , void >=0.5.5 + , xml-types >=0.3.1 + , xml-conduit >=1.0 + , xml-picklers >=0.3.3 + + If impl(ghc ==7.0.1) { + Build-Depends: bytestring >=0.9.1.9 && <=0.9.2.1 + } Else { + Build-Depends: bytestring >=0.9.1.9 } - Else - { - If impl(ghc >=7.6.1) - { - Build-Depends: attoparsec >=0.10.0.3 - , base >4 && <5 - , base64-bytestring >=0.1.0.0 - , binary >=0.4.1 - , bytestring >=0.9.1.9 - , conduit >=1.0.1 - , containers >=0.5.0.0 - , crypto-api >=0.9 - , crypto-random-api >=0.2 - , cryptohash >=0.6.1 - , cryptohash-cryptoapi >=0.1 - , data-default >=0.2 - , dns >=0.3.0 - , hslogger >=1.1.0 - , iproute >=1.2.4 - , lifted-base >=0.1.0.1 - , mtl >=2.0.0.0 - , network >=2.4.1.0 - , pureMD5 >=2.1.2.1 - , resourcet >=0.3.0 - , random >=1.0.0.0 - , split >=0.1.2.3 - , stm >=2.1.2.1 - , stringprep >=0.1.3 - , template-haskell >=2.5 - , text >=0.11.1.5 - , tls >=1.1.0 - , tls-extra >=0.5.0 - , transformers >=0.2.2.0 - , void >=0.5.5 - , xml-types >=0.3.1 - , xml-conduit >=1.0 - , xml-picklers >=0.3.3 - } - Else - { - Build-Depends: attoparsec >=0.10.0.3 - , base >4 && <5 - , base64-bytestring >=0.1.0.0 - , binary >=0.4.1 - , bytestring >=0.9.1.9 - , conduit >=1.0.1 - , containers >=0.5.0.0 - , crypto-api >=0.9 - , crypto-random-api >=0.2 - , cryptohash >=0.6.1 - , cryptohash-cryptoapi >=0.1 - , data-default >=0.2 - , dns >=0.3.0 - , hslogger >=1.1.0 - , iproute >=1.2.4 - , lifted-base >=0.1.0.1 - , mtl >=2.0.0.0 - , network >=2.4.1.0 - , pureMD5 >=2.1.2.1 - , resourcet >=0.3.0 - , random >=1.0.0.0 - , split >=0.1.2.3 - , stm >=2.1.2.1 - , stringprep >=0.1.3 - , text >=0.11.1.5 - , tls >=1.1.0 - , tls-extra >=0.5.0 - , transformers >=0.2.2.0 - , void >=0.5.5 - , xml-types >=0.3.1 - , xml-conduit >=1.0 - , xml-picklers >=0.3.3 - } + If flag(with-th) && impl(ghc >=7.6.1) { + Build-Depends: template-haskell >=2.5 } Exposed-modules: Network.Xmpp , Network.Xmpp.IM @@ -170,6 +107,9 @@ Library , Network.Xmpp.Tls , Network.Xmpp.Types , Network.Xmpp.Utilities + + if flag(with-th) && impl(ghc >= 7.6.1) + CPP-Options: -DWITH_TEMPLATE_HASKELL GHC-Options: -Wall Source-Repository head diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 25712ef..5de4093 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -46,7 +46,7 @@ module Network.Xmpp -- for addressing entities in the network. It is somewhat similar to an e-mail -- address, but contains three parts instead of two. , Jid -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL , jidQ #endif , isBare diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index a4a5b7d..9036a7a 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} #endif @@ -51,7 +51,7 @@ module Network.Xmpp.Types , ConnectionDetails(..) , StreamConfiguration(..) , Jid(..) -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL , jidQ #endif , isBare @@ -86,7 +86,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Typeable(Typeable) import Data.XML.Types -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL import Language.Haskell.TH import Language.Haskell.TH.Quote #endif @@ -774,7 +774,7 @@ instance Read Jid where [(parseJid (read s' :: String), r)] -- May fail with "Prelude.read: no parse" -- or the `parseJid' error message (see below) -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL jidQ :: QuasiQuoter jidQ = QuasiQuoter { quoteExp = \s -> do when (head s == ' ') . fail $ "Leading whitespaces in JID" ++ show s @@ -818,7 +818,7 @@ parseLangTag s = case langTagFromText $ Text.pack s of Just l -> l Nothing -> error $ "Language tag value (" ++ s ++ ") did not validate" -#if __GLASGOW_HASKELL__ >= 706 +#if WITH_TEMPLATE_HASKELL langTagQ :: QuasiQuoter langTagQ = QuasiQuoter {quoteExp = \s -> case langTagFromText $ Text.pack s of Nothing -> fail $ "Not a valid language tag: " From f7230b1aa8286fffed7fa7663f14492470208d6f Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Sun, 11 Aug 2013 16:08:31 +0200 Subject: [PATCH 2/2] add missing cases in unpickle functions --- source/Network/Xmpp/Marshal.hs | 1 + source/Network/Xmpp/Sasl/Common.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs index c21c975..9d1d4e3 100644 --- a/source/Network/Xmpp/Marshal.hs +++ b/source/Network/Xmpp/Marshal.hs @@ -347,6 +347,7 @@ xpPresenceType = ("xpPresenceType", "") presenceTypeFromText "unsubscribe" = Just Unsubscribe presenceTypeFromText "unsubscribed" = Just Unsubscribed presenceTypeFromText "probe" = Just Probe + presenceTypeFromText _ = Nothing presenceTypeToText Available = "available" presenceTypeToText Unavailable = "unavailable" presenceTypeToText Subscribe = "subscribe" diff --git a/source/Network/Xmpp/Sasl/Common.hs b/source/Network/Xmpp/Sasl/Common.hs index 0687bd1..bf23b3b 100644 --- a/source/Network/Xmpp/Sasl/Common.hs +++ b/source/Network/Xmpp/Sasl/Common.hs @@ -113,6 +113,7 @@ xpSaslError = ("xpSaslError", "") saslErrorFromText "mechanism-too-weak" = Just SaslMechanismTooWeak saslErrorFromText "not-authorized" = Just SaslNotAuthorized saslErrorFromText "temporary-auth-failure" = Just SaslTemporaryAuthFailure + saslErrorFromText _ = Nothing -- Challenge element pickler. xpChallenge :: PU [Node] (Maybe Text.Text)