diff options
-rw-r--r-- | Presence/UTmp.hs | 5 | ||||
-rw-r--r-- | examples/dhtd.hs | 26 | ||||
-rw-r--r-- | src/Crypto/Tox.hs | 12 | ||||
-rw-r--r-- | src/Data/Torrent.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/ContactInfo.hs | 6 | ||||
-rw-r--r-- | stack.ghc-8.4.yaml | 14 |
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 | |||
17 | import Data.BitSyntax | 17 | import Data.BitSyntax |
18 | import Data.Functor.Identity | 18 | import Data.Functor.Identity |
19 | import Data.Maybe | 19 | import Data.Maybe |
20 | import Data.String | ||
20 | import System.Posix.Process | 21 | import System.Posix.Process |
21 | import System.Posix.Signals | 22 | import System.Posix.Signals |
22 | import System.Posix.Types | 23 | import System.Posix.Types |
@@ -34,8 +35,8 @@ import qualified Data.Text.Encoding as Text | |||
34 | import SockAddr () | 35 | import SockAddr () |
35 | 36 | ||
36 | 37 | ||
37 | utmp_file :: String | 38 | utmp_file :: IsString s => s |
38 | utmp_file = Paths.utmp -- "/var/run/utmp" | 39 | utmp_file = fromString $ Paths.utmp -- "/var/run/utmp" |
39 | 40 | ||
40 | utmp_bs :: IO C.ByteString | 41 | utmp_bs :: IO C.ByteString |
41 | utmp_bs = S.readFile utmp_file | 42 | 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 | |||
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 |
84 | import Data.Ord | 84 | import Data.Ord |
85 | import Data.Serialize as S | 85 | import Data.Serialize as S |
86 | import Data.Semigroup | ||
86 | import Data.Word | 87 | import Data.Word |
87 | import Foreign.Marshal.Alloc | 88 | import Foreign.Marshal.Alloc |
88 | import Foreign.Ptr | 89 | import 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 | ||
163 | instance 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 | |||
162 | instance Monoid (Size a) where | 169 | instance 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 | ||
150 | import Prelude | 150 | import Prelude hiding ((<>)) |
151 | import Control.Applicative | 151 | import Control.Applicative |
152 | import Control.DeepSeq | 152 | import Control.DeepSeq |
153 | import Control.Exception | 153 | 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 | |||
15 | import Data.Maybe | 15 | import Data.Maybe |
16 | import Data.HashMap.Strict as HM | 16 | import Data.HashMap.Strict as HM |
17 | import Data.Serialize | 17 | import Data.Serialize |
18 | import Data.Semigroup | ||
18 | import Data.Wrapper.PSQ as PSQ | 19 | import Data.Wrapper.PSQ as PSQ |
19 | import Data.Time.Clock.POSIX | 20 | import Data.Time.Clock.POSIX |
20 | import Data.ByteString (ByteString) | 21 | import 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 | ||
194 | instance 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. |
194 | instance Monoid PeerStore where | 200 | instance 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 @@ | |||
1 | resolver: nightly-2018-06-22 | ||
2 | allow-newer: true | ||
3 | packages: | ||
4 | - '.' | ||
5 | - '../sensible-directory' | ||
6 | - '../bencoding' | ||
7 | - '../base32-bytestring' | ||
8 | flags: {} | ||
9 | extra-package-dbs: [] | ||
10 | extra-deps: | ||
11 | - cryptonite-0.23 | ||
12 | - reference-0.1 | ||
13 | - git: https://github.com/afcady/hs-avahi.git | ||
14 | commit: 5ec3bef32d40652b987b256eea8f85e7e8f2e5bb | ||