diff --git a/Setup.hs b/Setup.hs index 4b0b010..4467109 100644 --- a/Setup.hs +++ b/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 diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 0495d7b..900217c 100644 --- a/pontarius-xmpp.cabal +++ b/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 diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 3e5eb01..4c4278c 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/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 diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index cf504bf..12bfdbe 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/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 diff --git a/source/Network/Xmpp/IM/PresenceTracker.hs b/source/Network/Xmpp/IM/PresenceTracker.hs index dbd807d..8a6ed8e 100644 --- a/source/Network/Xmpp/IM/PresenceTracker.hs +++ b/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 diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 3535ce7..c880365 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/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) diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index a13790e..dd8dcfd 100644 --- a/source/Network/Xmpp/Types.hs +++ b/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 diff --git a/stack.yaml b/stack.yaml index cf81e44..54285e1 100644 --- a/stack.yaml +++ b/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: {}