add jid quasi quoter (jidQ)

pontarius-xmpp.cabal

@@ -56,6 +56,7 @@ Library
                  , 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
@@ -91,6 +92,7 @@ Library
                  , 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

source/Network/Xmpp.hs

@@ -45,6 +45,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
+  , jidQ
   , isBare
   , isFull
   , jidFromText

source/Network/Xmpp/Types.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -43,6 +44,7 @@ module Network.Xmpp.Types
     , StreamConfiguration(..)
     , langTag
     , Jid(..)
+    , jidQ
     , isBare
     , isFull
     , jidFromText
@@ -76,6 +78,8 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Typeable(Typeable)
 import           Data.XML.Types
+import           Language.Haskell.TH.Quote
+import           Language.Haskell.TH
 import           Network
 import           Network.DNS
 import           Network.TLS hiding (Version)
@@ -960,6 +964,22 @@ instance Read Jid where
         [(parseJid (read s' :: String), r)] -- May fail with "Prelude.read: no parse"
                                             -- or the `parseJid' error message (see below)
 
+jidQ :: QuasiQuoter
+jidQ = QuasiQuoter { quoteExp = \s -> case jidFromText (Text.pack s) of
+                         Nothing -> fail $ "Could not parse JID " ++ s
+                         Just j -> [| Jid $(mbTextE $ localpart_ j)
+                                          $(textE   $ domainpart_ j)
+                                          $(mbTextE $ resourcepart_ j)
+                                    |]
+                  , quotePat = fail "Jid patterns aren't implemented"
+                  , quoteType = fail "jid QQ can't be used in type context"
+                  , quoteDec  = fail "jid QQ can't be used in declaration context"
+                  }
+  where
+    textE t = [| Text.pack $(stringE $ Text.unpack t) |]
+    mbTextE Nothing = [| Nothing |]
+    mbTextE (Just s) = [| Just $(textE s) |]
+
 -- | Parses a JID string.
 --
 -- Note: This function is only meant to be used to reverse @Jid@ Show