Forward port to nightly-2018-06-22.

3 files changed, 15 insertions, 5 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index d1992967..a1741a1f 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -83,6 +83,7 @@ import GHC.Exts (Constraint)
 #endif
 import Data.Ord
 import Data.Serialize as S
+import Data.Semigroup
 import Data.Word
 import Foreign.Marshal.Alloc
 import Foreign.Ptr
@@ -159,11 +160,14 @@ instance Contravariant Size where
       ConstSize n -> ConstSize n
       VarSize g   -> VarSize (\x -> g (f x))
 
+instance Semigroup (Size a) where
+    ConstSize x <> ConstSize y = ConstSize (x + y)
+    VarSize f   <> ConstSize y = VarSize $ \x -> f x + y
+    ConstSize x <> VarSize g   = VarSize $ \y -> x + g y
+    VarSize f   <> VarSize g   = VarSize $ \x -> f x + g x
+
 instance Monoid (Size a) where
-    ConstSize x `mappend` ConstSize y = ConstSize (x + y)
-    VarSize f   `mappend` ConstSize y = VarSize $ \x -> f x + y
-    ConstSize x `mappend` VarSize g   = VarSize $ \y -> x + g y
-    VarSize f   `mappend` VarSize g   = VarSize $ \x -> f x + g x
+    mappend = (<>)
     mempty = ConstSize 0
 
 
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 4af583ed..dbe248eb 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -147,7 +147,7 @@ module Data.Torrent
        , renderURN
        ) where
 
-import Prelude
+import Prelude hiding ((<>))
 import Control.Applicative
 import Control.DeepSeq
 import Control.Exception
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index dfc93ed7..ed38caf7 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -15,6 +15,7 @@ import Data.List as L
 import Data.Maybe
 import Data.HashMap.Strict as HM
 import Data.Serialize
+import Data.Semigroup
 import Data.Wrapper.PSQ as PSQ
 import Data.Time.Clock.POSIX
 import Data.ByteString (ByteString)
@@ -190,6 +191,11 @@ instance Default (PeerStore) where
   def = PeerStore HM.empty
   {-# INLINE def #-}
 
+instance Semigroup PeerStore where
+  PeerStore a <> PeerStore b =
+    PeerStore (HM.unionWith swarmInsert a b)
+  {-# INLINE (<>) #-}
+
 -- | Monoid under union operation.
 instance Monoid PeerStore where
   mempty  = def