Forward port to GHC 8.10.1-alpha2 (83edba07e4)

5 files changed, 50 insertions, 18 deletions

diff --git a/dht/src/Codec/AsciiKey256.hs b/dht/src/Codec/AsciiKey256.hs
index ee17b7c1..1738a368 100644
--- a/dht/src/Codec/AsciiKey256.hs
+++ b/dht/src/Codec/AsciiKey256.hs
@@ -3,6 +3,7 @@ module Codec.AsciiKey256 where
 
 import Control.Applicative
 import Control.Monad
+import Control.Monad.Fail                     as MF
 import Data.Bits
 import qualified Data.ByteArray               as BA
          ;import Data.ByteArray               as BA (ByteArrayAccess)
@@ -112,7 +113,7 @@ readsPrecKey256 publicKey str
         | otherwise = []
 
 
-parseKey256 :: (Monad m, Alternative m) => String -> m ByteString
+parseKey256 :: (MonadFail m, Alternative m) => String -> m ByteString
 parseKey256 nidstr = do
         let nidbs  = C8.pack nidstr
             (bs,_) = Base16.decode nidbs
@@ -121,7 +122,7 @@ parseKey256 nidstr = do
                         43 -> parseToken32 nidstr
                         _  -> Left "Wrong size of key."
         idbs <- (guard (B.length bs == 32) >> return bs)
-                <|> either fail return enid
+                <|> either MF.fail return enid
         return idbs
 
 readP_key256 :: RP.ReadP ByteString
@@ -131,7 +132,7 @@ readP_key256 = do
         , fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit))
         , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit))
         ]
-      let failure = fail "Bad key."
+      let failure = MF.fail "Bad key."
       case is64 of
         32 -> case parse32Token32 hexhash of
                   Right bs -> return bs
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index 55e81069..d6f747d9 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -38,7 +38,11 @@ import Data.Function
 import Data.Functor.Contravariant
 import Data.Functor.Identity
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index e604f5e5..fc69fedd 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -40,7 +40,11 @@ import Data.Digest.CRC32C
 import Data.Function                          (fix)
 import Data.Hashable
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
diff --git a/dht/src/Network/Tox/Avahi.hs b/dht/src/Network/Tox/Avahi.hs
index 635ba656..2ca6515c 100644
--- a/dht/src/Network/Tox/Avahi.hs
+++ b/dht/src/Network/Tox/Avahi.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns    #-}
 module Network.Tox.Avahi
@@ -10,11 +11,17 @@ module Network.Tox.Avahi
 import Control.Applicative
 import Data.Foldable
 import Network.Address
-import Network.Avahi
 import Network.BSD         (getHostName)
 import Network.Tox.NodeId
 import Text.Read
 
+#if defined(VERSION_avahi)
+import Network.Avahi
+#else
+data Service = Service
+#endif
+
+
 toxServiceName :: String
 toxServiceName = "_tox_dht._udp"
 
@@ -26,7 +33,9 @@ a <.> b = a ++ "." ++ b
 
 toxService :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> Service
 toxService hostname (fromIntegral -> port) dhtkey toxid =
-  Service {
+  Service
+#if defined(VERSION_avahi)
+  {
     serviceProtocol = PROTO_UNSPEC,
     serviceName     = "Tox DHT @ " ++ hostname,
     serviceType     = toxServiceName,
@@ -36,10 +45,15 @@ toxService hostname (fromIntegral -> port) dhtkey toxid =
     servicePort     = port,
     serviceText     = maybe (show dhtkey) (show . ((,) dhtkey)) toxid
   }
+#endif
 
 announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
+#if defined(VERSION_avahi)
 announceToxServiceWithHostname  = (boobs.boobs) announce toxService
   where boobs = ((.).(.))
+#else
+announceToxServiceWithHostname _ _ _ _ = return ()
+#endif
 
 announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
 announceToxService a b c = do
@@ -48,6 +62,7 @@ announceToxService a b c = do
 
 queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO ()
 queryToxService cb =
+#if defined(VERSION_avahi)
   browse $
   BrowseQuery
   { lookupProtocol    = PROTO_UNSPEC
@@ -63,3 +78,6 @@ queryToxService cb =
           addr = readMaybe =<< serviceAddress
           p    = fromIntegral servicePort
       forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p) (snd <$> both)
+#else
+  return ()
+#endif
diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs
index d05e3697..667e7d71 100644
--- a/dht/src/Network/Tox/NodeId.hs
+++ b/dht/src/Network/Tox/NodeId.hs
@@ -47,6 +47,7 @@ module Network.Tox.NodeId
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
+import Control.Monad.Fail as MF
 #ifdef CRYPTONITE_BACKPORT
 import Crypto.Error.Types                     (CryptoFailable (..),
                                                throwCryptoError)
@@ -70,7 +71,11 @@ import Data.Char
 import Data.Data
 import Data.Hashable
 #if MIN_VERSION_iproute(1,7,4)
-import Data.IP hiding (fromSockAddr)
+import Data.IP hiding ( fromSockAddr
+#if MIN_VERSION_iproute(1,7,8)
+                      , toSockAddr
+#endif
+                      )
 #else
 import Data.IP
 #endif
@@ -258,7 +263,7 @@ getIP 0x02 = IPv4 <$> S.get
 getIP 0x0a = IPv6 <$> S.get
 getIP 0x82 = IPv4 <$> S.get -- TODO: TCP TOX_TCP_INET
 getIP 0x8a = IPv6 <$> S.get -- TODO: TCP TOX_TCP_INET6
-getIP x    = fail ("unsupported address family ("++show x++")")
+getIP x    = MF.fail ("unsupported address family ("++show x++")")
 
 instance Sized NodeInfo where
     size = VarSize $ \(NodeInfo nid ip port) ->
@@ -306,7 +311,7 @@ instance Read NodeInfo where
                       return (nid,addrstr)
     (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
     (ip,port) <- case RP.readP_to_S (ip_w_port i) addrstr of
-                    [] -> fail "Bad address."
+                    [] -> MF.fail "Bad address."
                     ((ip,port),_):_ -> return (ip,port)
     return $ NodeInfo nid ip port
 
@@ -406,7 +411,7 @@ getIP 0x02 = IPv4 <$> S.get
 getIP 0x0a = IPv6 <$> S.get
 getIP 0x82 = IPv4 <$> S.get -- TODO: TCP
 getIP 0x8a = IPv6 <$> S.get -- TODO: TCP
-getIP x    = fail ("unsupported address family ("++show x++")")
+getIP x    = MF.fail ("unsupported address family ("++show x++")")
 
 instance S.Serialize NodeInfo where
     get = do
@@ -445,7 +450,7 @@ instance Read NodeInfo where
                       addrstr <- parseAddr
                       nid <- case Base16.decode $ C8.pack hexhash of
                               (bs,_) | B.length bs==32 -> return (PubKey bs)
-                              _                        -> fail "Bad node id."
+                              _                        -> MF.fail "Bad node id."
                       return (nid,addrstr)
     (nid,addrstr) <- ( nodeidAt RP.+++ ( (zeroID,) <$> parseAddr) )
     let raddr = do
@@ -457,7 +462,7 @@ instance Read NodeInfo where
             return (ip, port)
 
     (ip,port) <- case RP.readP_to_S raddr addrstr of
-                    [] -> fail "Bad address."
+                    [] -> MF.fail "Bad address."
                     ((ip,port),_):_ -> return (ip,port)
     return $ NodeInfo nid ip port
 
@@ -518,15 +523,15 @@ instance Read NoSpam where
         ('0':'x':ws,rs) | (length ws == 12) -> base16decode rs (NoSpam <$> get <*> (Just <$> get)) ws
         _                                   -> []
 
-base64decode :: Monad m => t1 -> Get t -> String -> m (t, t1)
+base64decode :: MonadFail m => t1 -> Get t -> String -> m (t, t1)
 base64decode rs getter s =
-    either fail (\a -> return (a,rs))
+    either MF.fail (\a -> return (a,rs))
         $ runGet getter
            =<< Base64.decode (C8.pack $ map (nmtoken64 False) s)
 
-base16decode :: Monad m => t1 -> Get t -> String -> m (t, t1)
+base16decode :: MonadFail m => t1 -> Get t -> String -> m (t, t1)
 base16decode rs getter s =
-    either fail (\a -> return (a,rs))
+    either MF.fail (\a -> return (a,rs))
         $ runGet getter
         $ fst
         $ Base16.decode (C8.pack s)
@@ -559,7 +564,7 @@ instance Show NoSpamId where
     show (NoSpamId nspam pub) = '$' : nospam64 nspam ++ "@" ++ show (key2id pub) ++ ".tox"
 
 instance Read NoSpamId where
-    readsPrec d s = either fail id $ do
+    readsPrec d s = either MF.fail id $ do
         (jid,xs) <- Right $ break isSpace s
         nsid <- parseNoSpamId $ Text.pack jid
         return [(nsid,xs)]