Work with lts-17.14

Setup.hs

@@ -1,45 +1,2 @@
--- pilfered from lens package
-{-# OPTIONS_GHC -Wall #-}
-module Main (main) where
-
-import Distribution.Package ( PackageName, Package, PackageId, InstalledPackageId, packageVersion, packageName, unPackageName )
-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles, ordNub )
-import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
-import Distribution.Text ( display )
-import Distribution.Types.MungedPackageId ( MungedPackageId(mungedName, mungedVersion) )
-import Distribution.Types.MungedPackageName ( MungedPackageName, unMungedPackageName )
-import Distribution.Types.UnqualComponentName ( unUnqualComponentName )
-import Distribution.Verbosity ( Verbosity, normal )
-import Distribution.Version ( showVersion )
-import System.FilePath ( (</>) )
-
-main :: IO ()
-main = defaultMainWithHooks simpleUserHooks
-  { buildHook = \pkg lbi hooks flags -> do
-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
-     buildHook simpleUserHooks pkg lbi hooks flags
-  }
-
-generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-generateBuildModule verbosity pkg lbi = do
-  let dir = autogenModulesDir lbi
-  createDirectoryIfMissingVerbose verbosity True dir
-  withLibLBI pkg lbi $ \_ libcfg -> do
-    withTestLBI pkg lbi $ \suite suitecfg -> do
-      let testSuiteName = unUnqualComponentName (testName suite)
-      rewriteFile (dir </> "Build_" ++ testSuiteName ++ ".hs") $ unlines
-        [ "module Build_" ++ testSuiteName ++ " where"
-        , "deps :: [String]"
-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
-        ]
-  where
-    formatdeps = map (formatone . snd)
-    formatone p =
-      unMungedPackageName (mungedName p) ++ "-" ++ showVersion (mungedVersion p)
-
-testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, MungedPackageId)]
-testDeps xs ys = ordNub $ componentPackageDeps xs ++ componentPackageDeps ys
+import           Distribution.Simple
+main = defaultMain

pontarius-xmpp.cabal

@@ -55,7 +55,7 @@ Library
                , exceptions           >=0.6
                , hslogger             >=1.1.0
                , iproute              >=1.2.4
-               , lens-family
+               , lens-family          < 2.0.0
                , lifted-base          >=0.1.0.1
                , mtl                  >=2.0.0.0
                , network              >=2.3.1.0

source/Network/Xmpp/Concurrent.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections     #-}
 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Xmpp.Concurrent
@@ -18,19 +18,19 @@ module Network.Xmpp.Concurrent
   , simpleAuth
   ) where
 
-import           Control.Applicative ((<$>))
-import           Control.Arrow (second)
-import           Control.Concurrent (threadDelay)
+import           Control.Applicative                   ((<$>))
+import           Control.Arrow                         (second)
+import           Control.Concurrent                    (threadDelay)
 import           Control.Concurrent.STM
-import qualified Control.Exception as Ex
+import qualified Control.Exception                     as Ex
 import           Control.Monad
 import           Control.Monad.Except
-import qualified Data.List as List
-import qualified Data.Map as Map
+import qualified Data.List                             as List
+import qualified Data.Map                              as Map
 import           Data.Maybe
-import           Data.Text as Text
+import           Data.Text                             as Text
 import           Data.XML.Types
-import           Network
+import           Network.Socket
 import           Network.Xmpp.Concurrent.Basic
 import           Network.Xmpp.Concurrent.IQ
 import           Network.Xmpp.Concurrent.Message
@@ -38,17 +38,17 @@ import           Network.Xmpp.Concurrent.Monad
 import           Network.Xmpp.Concurrent.Presence
 import           Network.Xmpp.Concurrent.Threads
 import           Network.Xmpp.Concurrent.Types
-import           Network.Xmpp.IM.Roster
-import           Network.Xmpp.IM.Roster.Types
 import           Network.Xmpp.IM.PresenceTracker
 import           Network.Xmpp.IM.PresenceTracker.Types
+import           Network.Xmpp.IM.Roster
+import           Network.Xmpp.IM.Roster.Types
 import           Network.Xmpp.Sasl
 import           Network.Xmpp.Sasl.Types
 import           Network.Xmpp.Stream
 import           Network.Xmpp.Tls
 import           Network.Xmpp.Types
 import           System.Log.Logger
-import           System.Random (randomRIO)
+import           System.Random                         (randomRIO)
 
 import           Control.Monad.State.Strict
 
@@ -73,7 +73,7 @@ toChan :: TChan (Annotated Stanza) -> StanzaHandler
 toChan stanzaC _ sta as = do
     case sta of
      XmppStanza s -> atomically $ writeTChan stanzaC (s, as)
-     _ -> return ()
+     _            -> return ()
     return [(sta, [])]
 
 handleIQ :: TVar IQHandlers
@@ -180,7 +180,7 @@ newSession stream config realm mbSasl = runExceptT $ do
                     mbRos <- liftIO $ initialRoster config
                     return $ case mbRos of
                               Nothing -> Roster Nothing Map.empty
-                              Just r -> r
+                              Just r  -> r
     rosRef <- liftIO $ newTVarIO ros
     peers <- liftIO . newTVarIO $ Peers Map.empty
     rew <- lift $ newTVarIO 60
@@ -243,7 +243,7 @@ connectStream :: HostName
 connectStream realm config mbSasl = do
     Ex.bracketOnError (openStream realm (sessionStreamConfiguration config))
                       (\s -> case s of
-                                  Left _ -> return ()
+                                  Left _       -> return ()
                                   Right stream -> closeStreams stream)
 
         (\stream' -> case stream' of
@@ -366,7 +366,7 @@ reconnect' sess = go 0
         res <- doRetry sess
         case res of
             Nothing -> return i
-            Just _e  -> go (i+1)
+            Just _e -> go (i+1)
 
 doRetry :: Session -> IO (Maybe XmppFailure)
 doRetry sess@Session{reconnectWait = rw} = do

source/Network/Xmpp/Concurrent/Types.hs

@@ -1,23 +1,23 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable        #-}
 
 module Network.Xmpp.Concurrent.Types where
 
 import           Control.Concurrent
 import           Control.Concurrent.STM
-import qualified Control.Exception.Lifted as Ex
+import qualified Control.Exception.Lifted              as Ex
 import           Control.Monad.Except
-import qualified Data.ByteString as BS
+import qualified Data.ByteString                       as BS
 import           Data.Default
-import qualified Data.Map as Map
-import           Data.Text (Text)
-import qualified Data.Text as Text
+import qualified Data.Map                              as Map
+import           Data.Text                             (Text)
+import qualified Data.Text                             as Text
 import           Data.Typeable
-import           Data.XML.Types (Element)
-import           Network
-import           Network.Xmpp.IM.Roster.Types
+import           Data.XML.Types                        (Element)
+import           Network.Socket                        (HostName, PortNumber)
 import           Network.Xmpp.IM.PresenceTracker.Types
+import           Network.Xmpp.IM.Roster.Types
 import           Network.Xmpp.Sasl.Types
 import           Network.Xmpp.Types
 
@@ -144,26 +144,26 @@ type WriteSemaphore = TMVar (BS.ByteString -> IO (Either XmppFailure ()))
 -- | The Session object represents a single session with an XMPP server. You can
 -- use 'session' to establish a session
 data Session = Session
-    { stanzaCh :: TChan (Stanza, [Annotation]) -- All stanzas
-    , iqHandlers :: TVar IQHandlers
+    { stanzaCh         :: TChan (Stanza, [Annotation]) -- All stanzas
+    , iqHandlers       :: TVar IQHandlers
       -- Writing lock, so that only one thread could write to the stream at any
       -- given time.
       -- Fields below are from Context.
-    , writeSemaphore :: WriteSemaphore
-    , readerThread :: ThreadId
-    , idGenerator :: IO Text
+    , writeSemaphore   :: WriteSemaphore
+    , readerThread     :: ThreadId
+    , idGenerator      :: IO Text
       -- | Lock (used by withStream) to make sure that a maximum of one
       -- Stream action is executed at any given time.
-    , streamRef :: TMVar Stream
-    , eventHandlers :: TMVar EventHandlers
-    , stopThreads :: IO ()
-    , rosterRef :: TVar Roster
-    , presenceRef :: TVar Peers
-    , conf :: SessionConfiguration
-    , sendStanza' :: Stanza -> IO (Either XmppFailure ())
-    , sRealm :: HostName
+    , streamRef        :: TMVar Stream
+    , eventHandlers    :: TMVar EventHandlers
+    , stopThreads      :: IO ()
+    , rosterRef        :: TVar Roster
+    , presenceRef      :: TVar Peers
+    , conf             :: SessionConfiguration
+    , sendStanza'      :: Stanza -> IO (Either XmppFailure ())
+    , sRealm           :: HostName
     , sSaslCredentials :: Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
-    , reconnectWait :: TVar Int
+    , reconnectWait    :: TVar Int
     }
 
 -- | IQHandlers holds the registered channels for incoming IQ requests and

source/Network/Xmpp/IM/PresenceTracker.hs

@@ -5,17 +5,17 @@ import           Control.Applicative
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Monad
-import qualified Data.Foldable as Foldable
-import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
+import qualified Data.Foldable                         as Foldable
+import           Data.Map.Strict                       (Map)
+import qualified Data.Map.Strict                       as Map
 import           Data.Maybe
 import           Lens.Family2
 import           Lens.Family2.Stock
 import           Network.Xmpp.Concurrent.Types
 import           Network.Xmpp.IM.Presence
-import           Network.Xmpp.Lens hiding (Lens, Traversal)
+import           Network.Xmpp.Lens                     hiding (Lens, Traversal)
 import           Network.Xmpp.Types
-import           Prelude hiding (mapM)
+import           Prelude                               hiding (mapM)
 
 import           Network.Xmpp.IM.PresenceTracker.Types
 
@@ -26,26 +26,26 @@ _PeerAvailable :: Prism PeerStatus (Maybe IMPresence)
 _PeerAvailable = prism' PeerAvailable fromPeerAvailable
   where
     fromPeerAvailable (PeerAvailable pa) = Just pa
-    fromPeerAvailable _  = Nothing
+    fromPeerAvailable _                  = Nothing
 
 _PeerUnavailable :: Prism PeerStatus ()
 _PeerUnavailable = prism' (const PeerUnavailable) fromPeerUnavailable
   where
     fromPeerUnavailable PeerUnavailable = Just ()
-    fromPeerUnavailable _ = Nothing
+    fromPeerUnavailable _               = Nothing
 
 _PeerStatus :: Iso (Maybe (Maybe IMPresence)) PeerStatus
 _PeerStatus = mkIso toPeerStatus fromPeerStatus
   where
-    toPeerStatus (Nothing) = PeerUnavailable
+    toPeerStatus (Nothing)  = PeerUnavailable
     toPeerStatus (Just imp) = PeerAvailable imp
-    fromPeerStatus PeerUnavailable = Nothing
+    fromPeerStatus PeerUnavailable     = Nothing
     fromPeerStatus (PeerAvailable imp) = Just imp
 
 maybeMap :: Iso (Maybe (Map a b)) (Map a b)
 maybeMap = mkIso maybeToMap mapToMaybe
   where
-    maybeToMap Nothing = Map.empty
+    maybeToMap Nothing  = Map.empty
     maybeToMap (Just m) = m
     mapToMaybe m | Map.null m = Nothing
                  | otherwise = Just m

source/Network/Xmpp/Stream.hs

@@ -1,74 +1,73 @@
 {-# OPTIONS_HADDOCK hide #-}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TupleSections             #-}
 
 module Network.Xmpp.Stream where
 
-import           Control.Applicative ((<$>))
-import           Control.Concurrent (forkIO, threadDelay)
+import           Control.Applicative        ((<$>))
+import           Control.Concurrent         (forkIO, threadDelay)
 import           Control.Concurrent.STM
-import qualified Control.Exception as Ex
-import qualified Control.Exception.Lifted as ExL
+import qualified Control.Exception          as Ex
+import qualified Control.Exception.Lifted   as ExL
 import           Control.Monad
 import           Control.Monad.Except
 import           Control.Monad.State.Strict
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BSC8
-import           Data.Char (isSpace)
-import           Data.Conduit hiding (connect)
-import qualified Data.Conduit.Internal as DCI
-import qualified Data.Conduit.List as CL
+import           Data.ByteString            (ByteString)
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Char8      as BSC8
+import           Data.Char                  (isSpace)
+import           Data.Conduit               hiding (connect)
+import qualified Data.Conduit.Internal      as DCI
+import qualified Data.Conduit.List          as CL
 import           Data.IP
 import           Data.List
 import           Data.Maybe
 import           Data.Ord
-import           Data.Text (Text)
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
-import qualified Data.Text.Encoding.Error as Text
-import           Data.Void (Void)
-import           Data.Word (Word16)
+import           Data.Text                  (Text)
+import qualified Data.Text                  as Text
+import qualified Data.Text.Encoding         as Text
+import qualified Data.Text.Encoding.Error   as Text
+import           Data.Void                  (Void)
+import           Data.Word                  (Word16)
 import           Data.XML.Pickle
 import           Data.XML.Types
-import qualified GHC.IO.Exception as GIE
-import           Network
-import           Network.DNS hiding (encode, lookup)
-import qualified Network.Socket as S
-import           Network.Socket (AddrInfo)
+import qualified GHC.IO.Exception           as GIE
+import           Network.DNS                hiding (encode, lookup)
+import           Network.Socket             (AddrInfo, HostName, PortNumber)
+import qualified Network.Socket             as S
 import           Network.Xmpp.Marshal
 import           Network.Xmpp.Types
 import           System.IO
 -- import           System.IO.Error (tryIOError) <- Only available in base >=4.4
+import           Lens.Family2               (over)
 import           System.Log.Logger
-import           System.Random (randomRIO)
-import           Text.XML.Stream.Parse as XP
-import           Lens.Family2 (over)
+import           System.Random              (randomRIO)
+import           Text.XML.Stream.Parse      as XP
 
+import qualified Network.Xmpp.Lens          as L
 import           Network.Xmpp.Utilities
-import qualified Network.Xmpp.Lens as L
 
 -- "readMaybe" definition, as readMaybe is not introduced in the `base' package
 -- until version 4.6.
 readMaybe_ :: (Read a) => String -> Maybe a
 readMaybe_ string = case reads string of
                         [(a, "")] -> Just a
-                        _ -> Nothing
+                        _         -> Nothing
 
 -- import Text.XML.Stream.Elements
 
 mbl :: Maybe [a] -> [a]
 mbl (Just l) = l
-mbl Nothing = []
+mbl Nothing  = []
 
 lmb :: [t] -> Maybe [t]
 lmb [] = Nothing
-lmb x = Just x
+lmb x  = Just x
 
 -- Unpickles and returns a stream element.
 streamUnpickleElem :: PU [Node] a
@@ -90,9 +89,9 @@ throwOutJunk :: Monad m => ConduitM Event a m ()
 throwOutJunk = do
     next <- CL.peek
     case next of
-        Nothing -> return () -- This will only happen if the stream is closed.
+        Nothing                      -> return () -- This will only happen if the stream is closed.
         Just (EventBeginElement _ _) -> return ()
-        _ -> CL.drop 1 >> throwOutJunk
+        _                            -> CL.drop 1 >> throwOutJunk
 
 -- Returns an (empty) Element from a stream of XML events.
 openElementFromEvents :: StreamSink Element
@@ -117,12 +116,12 @@ startStream = runExceptT $ do
     -- state of the stream.
     let expectedTo = case ( streamConnectionState st
                           , toJid $ streamConfiguration st) of
-          (Plain    , (Just (j, True)))  -> Just j
-          (Plain    , _               )  -> Nothing
-          (Secured  , (Just (j, _   )))  -> Just j
-          (Secured  , Nothing         )  -> Nothing
-          (Closed   , _               )  -> Nothing
-          (Finished , _               )  -> Nothing
+          (Plain    , (Just (j, True))) -> Just j
+          (Plain    , _               ) -> Nothing
+          (Secured  , (Just (j, _   ))) -> Just j
+          (Secured  , Nothing         ) -> Nothing
+          (Closed   , _               ) -> Nothing
+          (Finished , _               ) -> Nothing
     case streamAddress st of
         Nothing -> do
             lift $ lift $ errorM "Pontarius.Xmpp" "Server sent no hostname."
@@ -216,7 +215,7 @@ startStream = runExceptT $ do
                                    StreamBadFormat Nothing
                                    ""
     safeRead x = case reads $ Text.unpack x of
-        [] -> Nothing
+        []        -> Nothing
         ((y,_):_) -> Just y
 
 flattenAttrs :: [(Name, [Content])] -> [(Name, Text.Text)]
@@ -227,7 +226,7 @@ flattenAttrs attrs = Prelude.map (\(name, cont) ->
                          attrs
   where
     uncontentify (ContentText t) = t
-    uncontentify _ = ""
+    uncontentify _               = ""
 
 -- Sets a new Event source using the raw source (of bytes)
 -- and calls xmppStartStream.
@@ -249,7 +248,7 @@ sourceStreamHandleRaw s = forever . read $ streamReceive s
     read rd = do
         bs' <- liftIO (rd 4096)
         bs <- case bs' of
-            Left e -> throwError e
+            Left e  -> throwError e
             Right r -> return r
         yield bs
 
@@ -300,8 +299,8 @@ bufferSrc src = do
                                     return $ Right b
                       )
             case dt of
-                Left e -> throwError e
-                Right Nothing -> return ()
+                Left e         -> throwError e
+                Right Nothing  -> return ()
                 Right (Just d) -> yield d >> go
     return go
   where
@@ -335,7 +334,7 @@ streamS _expectedTo = do -- TODO: check expectedTo
         el <- openElementFromEvents -- May throw `XmppOtherFailure' if an
                                     -- element is not received
         case unpickleElem xpStream el of
-            Left _ -> return $ Left el
+            Left _  -> return $ Left el
             Right r -> return $ Right r
     xmppStreamFeatures :: StreamSink StreamFeatures
     xmppStreamFeatures = do
@@ -431,7 +430,7 @@ nsHack e@(Element{elementName = n})
   where
     mapNSHack :: Node -> Node
     mapNSHack (NodeElement el) = NodeElement $ nsHack el
-    mapNSHack nd = nd
+    mapNSHack nd               = nd
 
 -- | Encode and send stanza
 pushStanza :: Stanza -> Stream -> IO (Either XmppFailure ())
@@ -494,8 +493,8 @@ pullStanza :: Stream -> IO (Either XmppFailure Stanza)
 pullStanza = withStream' $ do
     res <- pullUnpickle xpStreamStanza
     case res of
-        Left e -> return $ Left e
-        Right (Left e) -> return $ Left $ StreamErrorFailure e
+        Left e          -> return $ Left e
+        Right (Left e)  -> return $ Left $ StreamErrorFailure e
         Right (Right r) -> return $ Right r
 
 -- | Pulls a stanza, nonza or stream error from the stream.
@@ -503,8 +502,8 @@ pullXmppElement :: Stream -> IO (Either XmppFailure XmppElement)
 pullXmppElement = withStream' $ do
     res <- pullUnpickle xpStreamElement
     case res of
-        Left e -> return $ Left e
-        Right (Left e) -> return $ Left $ StreamErrorFailure e
+        Left e          -> return $ Left e
+        Right (Left e)  -> return $ Left $ StreamErrorFailure e
         Right (Right r) -> return $ Right r
 
 -- Performs the given IO operation, catches any errors and re-throws everything
@@ -515,7 +514,7 @@ catchPush p = ExL.catch
     (\e -> case GIE.ioe_type e of
          GIE.ResourceVanished -> return . Left $ XmppIOException e
          GIE.IllegalOperation -> return . Left $ XmppIOException e
-         _ -> ExL.throwIO e
+         _                    -> ExL.throwIO e
     )
 
 zeroHandle :: StreamHandle
@@ -594,7 +593,7 @@ createStream realm config = do
         return d
     tlsIdentL = L.tlsParamsL . L.clientServerIdentificationL
     updateHost host ("", _) = (host, "")
-    updateHost _ hst = hst
+    updateHost _ hst        = hst
     maybeSetTlsHost host = over tlsIdentL (updateHost host)
 
 -- Connects using the specified method. Returns the Handle acquired, if any.
@@ -655,12 +654,11 @@ connectSrv config host = do
                 throwError XmppIllegalTcpDetails
   where for = flip fmap
 
-showPort :: PortID -> String
 #if MIN_VERSION_network(2, 4, 1)
 showPort = show
 #else
 showPort (PortNumber x) = "PortNumber " ++ show x
-showPort (Service x) = "Service " ++ show x
+showPort (Service x)    = "Service " ++ show x
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 showPort (UnixSocket x) = "UnixSocket " ++ show x
 #endif
@@ -720,7 +718,7 @@ resolvSrvsAndConnectTcp ((domain, port):remaining) = do
     result <- resolveAndConnectTcp domain port
     case result of
         Just handle -> return $ Just handle
-        Nothing -> resolvSrvsAndConnectTcp remaining
+        Nothing     -> resolvSrvsAndConnectTcp remaining
 
 
 -- The DNS functions may make error calls. This function catches any such
@@ -759,7 +757,7 @@ srvLookup realm resolvSeed = ExceptT $ do
                 return Nothing
     case result of
         Right result' -> return $ Right result'
-        Left e -> return $ Left $ XmppIOException e
+        Left e        -> return $ Left $ XmppIOException e
   where
     -- This function orders the SRV result in accordance with RFC
     -- 2782. It sorts the SRV results in order of priority, and then
@@ -870,7 +868,7 @@ elements = do
         go front = do
             x <- f
             case x of
-                Left l -> return $ (l, front [])
+                Left l  -> return $ (l, front [])
                 Right r -> go (front . (:) r)
     goE n as = do
         (y, ns) <- many' goN
@@ -897,7 +895,7 @@ elements = do
 
     compressContents :: [Content] -> [Content]
     compressContents cs = [ContentText $ Text.concat (map unwrap cs)]
-        where unwrap (ContentText t) = t
+        where unwrap (ContentText t)   = t
               unwrap (ContentEntity t) = t
 
     (><) f g (x, y) = (f x, g y)

source/Network/Xmpp/Types.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK hide #-}
+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
 
 module Network.Xmpp.Types
     ( NonemptyText(..)
@@ -108,9 +109,9 @@ import           Language.Haskell.TH
 import           Language.Haskell.TH.Quote
 import qualified Language.Haskell.TH.Syntax as TH
 #endif
-import           Network
 import           Network.DNS
-import           Network.TLS hiding (Version, HostName)
+import           Network.Socket (HostName, PortNumber)
+import           Network.TLS hiding (HostName, Version)
 import           Network.TLS.Extra
 import qualified Text.StringPrep as SP
 import qualified Text.StringPrep.Profiles as SP
@@ -945,9 +946,9 @@ jid = QuasiQuoter { quoteExp = \s -> do
                           case jidFromText t of
                               Nothing -> fail $ "Could not parse JID " ++ s
                               Just j -> TH.lift 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"
+                  , 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"
                   }
 
 -- | Synonym for 'jid'
@@ -1000,12 +1001,9 @@ langTagQ = QuasiQuoter {quoteExp = \s -> case langTagFromText $ Text.pack  s of
                                                       map textE (subtags lt))
                                         |]
 
-                       , quotePat = fail $ "LanguageTag patterns aren't"
-                                         ++ " implemented"
-                       , quoteType = fail $ "LanguageTag QQ can't be used"
-                                           ++ " in type context"
-                       , quoteDec  = fail $ "LanguageTag QQ can't be used"
-                                           ++ " in declaration context"
+                       , quotePat = \_ -> fail "LanguageTag patterns aren't implemented"
+                       , quoteType = \_ -> fail "LanguageTag QQ can't be used in type context"
+                       , quoteDec = \_ -> fail "LanguageTag QQ can't be used in declaration context"
 
                        }
   where

stack.yaml

@@ -1,18 +1,14 @@
-resolver: lts-10.4
+resolver: lts-17.14
 
 packages:
 - examples/echoclient/
 - '.'
 
 extra-deps:
-- ranges-0.2.4
 - stringprep-1.0.0
-- text-1.2.2.1
-- xml-picklers-0.3.6
-- conduit-1.3.0
-- conduit-extra-1.3.0
-- xml-conduit-1.8.0
-- resourcet-1.2.0
+- lens-family-1.2.3
+- lens-family-core-1.2.3
+
 
 flags: {}