summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/UTmp.hs5
-rw-r--r--examples/dhtd.hs26
-rw-r--r--src/Crypto/Tox.hs12
-rw-r--r--src/Data/Torrent.hs2
-rw-r--r--src/Network/BitTorrent/DHT/ContactInfo.hs6
-rw-r--r--stack.ghc-8.4.yaml14
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
17import Data.BitSyntax 17import Data.BitSyntax
18import Data.Functor.Identity 18import Data.Functor.Identity
19import Data.Maybe 19import Data.Maybe
20import Data.String
20import System.Posix.Process 21import System.Posix.Process
21import System.Posix.Signals 22import System.Posix.Signals
22import System.Posix.Types 23import System.Posix.Types
@@ -34,8 +35,8 @@ import qualified Data.Text.Encoding as Text
34import SockAddr () 35import SockAddr ()
35 36
36 37
37utmp_file :: String 38utmp_file :: IsString s => s
38utmp_file = Paths.utmp -- "/var/run/utmp" 39utmp_file = fromString $ Paths.utmp -- "/var/run/utmp"
39 40
40utmp_bs :: IO C.ByteString 41utmp_bs :: IO C.ByteString
41utmp_bs = S.readFile utmp_file 42utmp_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
485 "gc" -> do hPutClient h "Performing garbage collection..." 485 "gc" -> do hPutClient h "Performing garbage collection..."
486 performMajorGC 486 performMajorGC
487 "" -> do 487 "" -> do
488#if MIN_VERSION_base(4,11,1)
489 is_enabled <- getRTSStatsEnabled
490#else
488 is_enabled <- getGCStatsEnabled 491 is_enabled <- getGCStatsEnabled
492#endif
489 if is_enabled 493 if is_enabled
490 then do 494 then do
495#if MIN_VERSION_base(4,11,1)
496 RTSStats{..} <- getRTSStats
497 let r = [ ("bytesAllocated", show allocated_bytes)
498 , ("numGcs", show gcs)
499 , ("maxBytesUsed", show max_live_bytes)
500 --, ("numByteUsageSamples", show numByteUsageSamples)
501 , ("cumulativeBytesUsed", show cumulative_live_bytes)
502 , ("bytesCopied", show copied_bytes)
503 , ("currentBytesUsed", show allocated_bytes)
504 --, ("currentBytesSlop", show currentBytesSlop)
505 , ("maxBytesSlop", show max_slop_bytes)
506 -- , ("peakMegabytesAllocated", show peakMegabytesAllocated)
507 , ("mutatorCpuNanoseconds", show mutator_cpu_ns)
508 , ("mutatorWallNanoseconds", show mutator_elapsed_ns)
509 , ("gcCpuSeconds", show gc_cpu_ns)
510 , ("gcWallSeconds", show gc_elapsed_ns)
511 , ("cpuSeconds", show cpu_ns)
512 , ("wallSeconds", show elapsed_ns)
513 , ("parTotBytesCopied", show par_copied_bytes)
514 , ("parMaxBytesCopied", show cumulative_par_max_copied_bytes)
515#else
491 GCStats{..} <- getGCStats 516 GCStats{..} <- getGCStats
492 let r = [ ("bytesAllocated", show bytesAllocated) 517 let r = [ ("bytesAllocated", show bytesAllocated)
493 , ("numGcs", show numGcs) 518 , ("numGcs", show numGcs)
@@ -507,6 +532,7 @@ clientSession s@Session{..} sock cnum h = do
507 , ("wallSeconds", show wallSeconds) 532 , ("wallSeconds", show wallSeconds)
508 , ("parTotBytesCopied", show parTotBytesCopied) 533 , ("parTotBytesCopied", show parTotBytesCopied)
509 , ("parMaxBytesCopied", show parMaxBytesCopied) 534 , ("parMaxBytesCopied", show parMaxBytesCopied)
535#endif
510 ] 536 ]
511 hPutClient h $ showReport r 537 hPutClient h $ showReport r
512 else hPutClient h "Run with +RTS -T to obtain live memory-usage information." 538 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)
83#endif 83#endif
84import Data.Ord 84import Data.Ord
85import Data.Serialize as S 85import Data.Serialize as S
86import Data.Semigroup
86import Data.Word 87import Data.Word
87import Foreign.Marshal.Alloc 88import Foreign.Marshal.Alloc
88import Foreign.Ptr 89import Foreign.Ptr
@@ -159,11 +160,14 @@ instance Contravariant Size where
159 ConstSize n -> ConstSize n 160 ConstSize n -> ConstSize n
160 VarSize g -> VarSize (\x -> g (f x)) 161 VarSize g -> VarSize (\x -> g (f x))
161 162
163instance Semigroup (Size a) where
164 ConstSize x <> ConstSize y = ConstSize (x + y)
165 VarSize f <> ConstSize y = VarSize $ \x -> f x + y
166 ConstSize x <> VarSize g = VarSize $ \y -> x + g y
167 VarSize f <> VarSize g = VarSize $ \x -> f x + g x
168
162instance Monoid (Size a) where 169instance Monoid (Size a) where
163 ConstSize x `mappend` ConstSize y = ConstSize (x + y) 170 mappend = (<>)
164 VarSize f `mappend` ConstSize y = VarSize $ \x -> f x + y
165 ConstSize x `mappend` VarSize g = VarSize $ \y -> x + g y
166 VarSize f `mappend` VarSize g = VarSize $ \x -> f x + g x
167 mempty = ConstSize 0 171 mempty = ConstSize 0
168 172
169 173
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
147 , renderURN 147 , renderURN
148 ) where 148 ) where
149 149
150import Prelude 150import Prelude hiding ((<>))
151import Control.Applicative 151import Control.Applicative
152import Control.DeepSeq 152import Control.DeepSeq
153import Control.Exception 153import 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
15import Data.Maybe 15import Data.Maybe
16import Data.HashMap.Strict as HM 16import Data.HashMap.Strict as HM
17import Data.Serialize 17import Data.Serialize
18import Data.Semigroup
18import Data.Wrapper.PSQ as PSQ 19import Data.Wrapper.PSQ as PSQ
19import Data.Time.Clock.POSIX 20import Data.Time.Clock.POSIX
20import Data.ByteString (ByteString) 21import Data.ByteString (ByteString)
@@ -190,6 +191,11 @@ instance Default (PeerStore) where
190 def = PeerStore HM.empty 191 def = PeerStore HM.empty
191 {-# INLINE def #-} 192 {-# INLINE def #-}
192 193
194instance Semigroup PeerStore where
195 PeerStore a <> PeerStore b =
196 PeerStore (HM.unionWith swarmInsert a b)
197 {-# INLINE (<>) #-}
198
193-- | Monoid under union operation. 199-- | Monoid under union operation.
194instance Monoid PeerStore where 200instance Monoid PeerStore where
195 mempty = def 201 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 @@
1resolver: nightly-2018-06-22
2allow-newer: true
3packages:
4- '.'
5- '../sensible-directory'
6- '../bencoding'
7- '../base32-bytestring'
8flags: {}
9extra-package-dbs: []
10extra-deps:
11- cryptonite-0.23
12- reference-0.1
13- git: https://github.com/afcady/hs-avahi.git
14 commit: 5ec3bef32d40652b987b256eea8f85e7e8f2e5bb