Forward port to nightly-2018-06-22.

6 files changed, 58 insertions, 7 deletions

diff --git a/Presence/UTmp.hs b/Presence/UTmp.hs
index aa2a7733..fcfe529a 100644
--- a/Presence/UTmp.hs
+++ b/Presence/UTmp.hs
@@ -17,6 +17,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import Data.BitSyntax
 import Data.Functor.Identity
 import Data.Maybe
+import Data.String
 import System.Posix.Process
 import System.Posix.Signals
 import System.Posix.Types
@@ -34,8 +35,8 @@ import qualified Data.Text.Encoding as Text
 import SockAddr ()
 
 
-utmp_file :: String
-utmp_file = Paths.utmp -- "/var/run/utmp"
+utmp_file :: IsString s => s
+utmp_file = fromString $ Paths.utmp -- "/var/run/utmp"
 
 utmp_bs :: IO C.ByteString
 utmp_bs = S.readFile utmp_file
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6ef4539f..628a58bd 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -485,9 +485,34 @@ clientSession s@Session{..} sock cnum h = do
                         "gc" -> do hPutClient h "Performing garbage collection..."
                                    performMajorGC
                         "" -> do
+#if MIN_VERSION_base(4,11,1)
+                            is_enabled <- getRTSStatsEnabled
+#else
                             is_enabled <- getGCStatsEnabled
+#endif
                             if is_enabled
                              then do
+#if MIN_VERSION_base(4,11,1)
+                                RTSStats{..} <- getRTSStats
+                                let r = [ ("bytesAllocated", show allocated_bytes)
+                                        , ("numGcs", show gcs)
+                                        , ("maxBytesUsed", show max_live_bytes)
+                                        --, ("numByteUsageSamples", show numByteUsageSamples)
+                                        , ("cumulativeBytesUsed", show cumulative_live_bytes)
+                                        , ("bytesCopied", show copied_bytes)
+                                        , ("currentBytesUsed", show allocated_bytes)
+                                        --, ("currentBytesSlop", show currentBytesSlop)
+                                        , ("maxBytesSlop", show max_slop_bytes)
+                                        -- , ("peakMegabytesAllocated", show peakMegabytesAllocated)
+                                        , ("mutatorCpuNanoseconds", show mutator_cpu_ns)
+                                        , ("mutatorWallNanoseconds", show mutator_elapsed_ns)
+                                        , ("gcCpuSeconds", show gc_cpu_ns)
+                                        , ("gcWallSeconds", show gc_elapsed_ns)
+                                        , ("cpuSeconds", show cpu_ns)
+                                        , ("wallSeconds", show elapsed_ns)
+                                        , ("parTotBytesCopied", show par_copied_bytes)
+                                        , ("parMaxBytesCopied", show cumulative_par_max_copied_bytes)
+#else
                                 GCStats{..} <- getGCStats
                                 let r = [ ("bytesAllocated", show bytesAllocated)
                                         , ("numGcs", show numGcs)
@@ -507,6 +532,7 @@ clientSession s@Session{..} sock cnum h = do
                                         , ("wallSeconds", show wallSeconds)
                                         , ("parTotBytesCopied", show parTotBytesCopied)
                                         , ("parMaxBytesCopied", show parMaxBytesCopied)
+#endif
                                         ]
                                 hPutClient h $ showReport r
                             else hPutClient h "Run with +RTS -T to obtain live memory-usage information."
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
diff --git a/stack.ghc-8.4.yaml b/stack.ghc-8.4.yaml
new file mode 100644
index 00000000..195aa4da
--- /dev/null
+++ b/stack.ghc-8.4.yaml
@@ -0,0 +1,14 @@
+resolver: nightly-2018-06-22
+allow-newer: true
+packages:
+- '.'
+- '../sensible-directory'
+- '../bencoding'
+- '../base32-bytestring'
+flags: {}
+extra-package-dbs: []
+extra-deps:
+- cryptonite-0.23
+- reference-0.1
+- git: https://github.com/afcady/hs-avahi.git
+  commit: 5ec3bef32d40652b987b256eea8f85e7e8f2e5bb