diff options
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/Torrent/Progress.hs | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs index c42af248..18a9cd7d 100644 --- a/src/Data/Torrent/Progress.hs +++ b/src/Data/Torrent/Progress.hs | |||
@@ -34,13 +34,14 @@ module Data.Torrent.Progress | |||
34 | ) where | 34 | ) where |
35 | 35 | ||
36 | import Control.Applicative | 36 | import Control.Applicative |
37 | import Control.Lens | 37 | import Control.Lens hiding ((%=)) |
38 | import Data.Aeson.TH | 38 | import Data.Aeson.TH |
39 | import Data.Default | 39 | import Data.Default |
40 | import Data.List as L | 40 | import Data.List as L |
41 | import Data.Monoid | 41 | import Data.Monoid |
42 | import Data.Serialize as S | 42 | import Data.Serialize as S |
43 | import Data.Ratio | 43 | import Data.Ratio |
44 | import Data.URLEncoded | ||
44 | import Data.Word | 45 | import Data.Word |
45 | 46 | ||
46 | 47 | ||
@@ -58,6 +59,7 @@ data Progress = Progress | |||
58 | $(makeLenses ''Progress) | 59 | $(makeLenses ''Progress) |
59 | $(deriveJSON L.tail ''Progress) | 60 | $(deriveJSON L.tail ''Progress) |
60 | 61 | ||
62 | -- | UDP tracker compatible encoding. | ||
61 | instance Serialize Progress where | 63 | instance Serialize Progress where |
62 | put Progress {..} = do | 64 | put Progress {..} = do |
63 | putWord64be $ fromIntegral _downloaded | 65 | putWord64be $ fromIntegral _downloaded |
@@ -73,6 +75,7 @@ instance Default Progress where | |||
73 | def = Progress 0 0 0 | 75 | def = Progress 0 0 0 |
74 | {-# INLINE def #-} | 76 | {-# INLINE def #-} |
75 | 77 | ||
78 | -- | Can be used to aggregate total progress. | ||
76 | instance Monoid Progress where | 79 | instance Monoid Progress where |
77 | mempty = def | 80 | mempty = def |
78 | {-# INLINE mempty #-} | 81 | {-# INLINE mempty #-} |
@@ -84,6 +87,19 @@ instance Monoid Progress where | |||
84 | } | 87 | } |
85 | {-# INLINE mappend #-} | 88 | {-# INLINE mappend #-} |
86 | 89 | ||
90 | instance URLShow Word64 where | ||
91 | urlShow = show | ||
92 | {-# INLINE urlShow #-} | ||
93 | |||
94 | -- | HTTP Tracker protocol compatible encoding. | ||
95 | instance URLEncode Progress where | ||
96 | urlEncode Progress {..} = mconcat | ||
97 | [ s "uploaded" %= _uploaded | ||
98 | , s "left" %= _left | ||
99 | , s "downloaded" %= _downloaded | ||
100 | ] | ||
101 | where s :: String -> String; s = id; {-# INLINE s #-} | ||
102 | |||
87 | -- | Initial progress is used when there are no session before. | 103 | -- | Initial progress is used when there are no session before. |
88 | -- | 104 | -- |
89 | -- Please note that tracker might penalize client some way if the do | 105 | -- Please note that tracker might penalize client some way if the do |