diff options
Diffstat (limited to 'src/Data/Torrent')
-rw-r--r-- | src/Data/Torrent/Block.hs | 27 | ||||
-rw-r--r-- | src/Data/Torrent/Client.hs | 20 | ||||
-rw-r--r-- | src/Data/Torrent/InfoHash.hs | 13 | ||||
-rw-r--r-- | src/Data/Torrent/Layout.hs | 17 | ||||
-rw-r--r-- | src/Data/Torrent/Magnet.hs | 5 | ||||
-rw-r--r-- | src/Data/Torrent/Piece.hs | 17 | ||||
-rw-r--r-- | src/Data/Torrent/Progress.hs | 8 | ||||
-rw-r--r-- | src/Data/Torrent/Tree.hs | 2 |
8 files changed, 53 insertions, 56 deletions
diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs index cb50302c..987de653 100644 --- a/src/Data/Torrent/Block.hs +++ b/src/Data/Torrent/Block.hs | |||
@@ -9,6 +9,7 @@ | |||
9 | -- | 9 | -- |
10 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 10 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
11 | {-# LANGUAGE TemplateHaskell #-} | 11 | {-# LANGUAGE TemplateHaskell #-} |
12 | {-# LANGUAGE FlexibleInstances #-} | ||
12 | module Data.Torrent.Block | 13 | module Data.Torrent.Block |
13 | ( -- * Piece attributes | 14 | ( -- * Piece attributes |
14 | PieceIx | 15 | PieceIx |
@@ -22,31 +23,26 @@ module Data.Torrent.Block | |||
22 | 23 | ||
23 | -- * Block index | 24 | -- * Block index |
24 | , BlockIx(..) | 25 | , BlockIx(..) |
25 | , ppBlockIx | ||
26 | , blockIxRange | 26 | , blockIxRange |
27 | 27 | ||
28 | -- * Block data | 28 | -- * Block data |
29 | , Block(..) | 29 | , Block(..) |
30 | , ppBlock | ||
31 | , blockIx | 30 | , blockIx |
32 | , blockSize | 31 | , blockSize |
33 | , blockRange | 32 | , blockRange |
34 | ) where | 33 | ) where |
35 | 34 | ||
36 | import Control.Applicative | 35 | import Control.Applicative |
37 | |||
38 | import Data.Aeson.TH | 36 | import Data.Aeson.TH |
39 | import qualified Data.ByteString.Lazy as Lazy | 37 | import qualified Data.ByteString.Lazy as Lazy |
40 | import Data.Char | 38 | import Data.Char |
41 | import Data.List as L | 39 | import Data.List as L |
42 | |||
43 | import Data.Binary as B | 40 | import Data.Binary as B |
44 | import Data.Binary.Get as B | 41 | import Data.Binary.Get as B |
45 | import Data.Binary.Put as B | 42 | import Data.Binary.Put as B |
46 | import Data.Serialize as S | 43 | import Data.Serialize as S |
47 | |||
48 | import Text.PrettyPrint | 44 | import Text.PrettyPrint |
49 | 45 | import Text.PrettyPrint.Class | |
50 | 46 | ||
51 | {----------------------------------------------------------------------- | 47 | {----------------------------------------------------------------------- |
52 | -- Piece attributes | 48 | -- Piece attributes |
@@ -147,12 +143,11 @@ instance Binary BlockIx where | |||
147 | putIntB ixOffset | 143 | putIntB ixOffset |
148 | putIntB ixLength | 144 | putIntB ixLength |
149 | 145 | ||
150 | -- | Format block index in human readable form. | 146 | instance Pretty BlockIx where |
151 | ppBlockIx :: BlockIx -> Doc | 147 | pretty BlockIx {..} = |
152 | ppBlockIx BlockIx {..} = | 148 | "piece = " <> int ixPiece <> "," <+> |
153 | "piece = " <> int ixPiece <> "," <+> | 149 | "offset = " <> int ixOffset <> "," <+> |
154 | "offset = " <> int ixOffset <> "," <+> | 150 | "length = " <> int ixLength |
155 | "length = " <> int ixLength | ||
156 | 151 | ||
157 | -- | Get location of payload bytes in the torrent content. | 152 | -- | Get location of payload bytes in the torrent content. |
158 | blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a) | 153 | blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a) |
@@ -178,10 +173,10 @@ data Block payload = Block { | |||
178 | , blkData :: !payload | 173 | , blkData :: !payload |
179 | } deriving (Show, Eq) | 174 | } deriving (Show, Eq) |
180 | 175 | ||
181 | -- | Format block in human readable form. Payload is ommitted. | 176 | -- | Payload is ommitted. |
182 | ppBlock :: Block Lazy.ByteString -> Doc | 177 | instance Pretty (Block Lazy.ByteString) where |
183 | ppBlock = ppBlockIx . blockIx | 178 | pretty = pretty . blockIx |
184 | {-# INLINE ppBlock #-} | 179 | {-# INLINE pretty #-} |
185 | 180 | ||
186 | -- | Get size of block /payload/ in bytes. | 181 | -- | Get size of block /payload/ in bytes. |
187 | blockSize :: Block Lazy.ByteString -> BlockSize | 182 | blockSize :: Block Lazy.ByteString -> BlockSize |
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs index f38f7a5c..0fd6722b 100644 --- a/src/Data/Torrent/Client.hs +++ b/src/Data/Torrent/Client.hs | |||
@@ -22,10 +22,7 @@ | |||
22 | -- | 22 | -- |
23 | module Data.Torrent.Client | 23 | module Data.Torrent.Client |
24 | ( ClientImpl (..) | 24 | ( ClientImpl (..) |
25 | , ppClientImpl | ||
26 | , ppVersion | ||
27 | , ClientInfo (..) | 25 | , ClientInfo (..) |
28 | , ppClientInfo | ||
29 | , libClientInfo | 26 | , libClientInfo |
30 | ) where | 27 | ) where |
31 | 28 | ||
@@ -41,6 +38,7 @@ import Data.String | |||
41 | import Data.Text as T | 38 | import Data.Text as T |
42 | import Data.Version | 39 | import Data.Version |
43 | import Text.PrettyPrint hiding ((<>)) | 40 | import Text.PrettyPrint hiding ((<>)) |
41 | import Text.PrettyPrint.Class | ||
44 | import Text.Read (readMaybe) | 42 | import Text.Read (readMaybe) |
45 | import Paths_bittorrent (version) | 43 | import Paths_bittorrent (version) |
46 | 44 | ||
@@ -125,9 +123,8 @@ instance IsString ClientImpl where | |||
125 | alist = L.map mk [minBound..maxBound] | 123 | alist = L.map mk [minBound..maxBound] |
126 | mk x = (L.tail $ show x, x) | 124 | mk x = (L.tail $ show x, x) |
127 | 125 | ||
128 | -- | Format client implementation info in human-readable form. | 126 | instance Pretty ClientImpl where |
129 | ppClientImpl :: ClientImpl -> Doc | 127 | pretty = text . L.tail . show |
130 | ppClientImpl = text . L.tail . show | ||
131 | 128 | ||
132 | -- | Just the '0' version. | 129 | -- | Just the '0' version. |
133 | instance Default Version where | 130 | instance Default Version where |
@@ -141,9 +138,8 @@ instance IsString Version where | |||
141 | where | 138 | where |
142 | chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) | 139 | chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) |
143 | 140 | ||
144 | -- | Format client implementation version in human-readable form. | 141 | instance Pretty Version where |
145 | ppVersion :: Version -> Doc | 142 | pretty = text . showVersion |
146 | ppVersion = text . showVersion | ||
147 | 143 | ||
148 | -- | The all sensible infomation that can be obtained from a peer | 144 | -- | The all sensible infomation that can be obtained from a peer |
149 | -- identifier or torrent /createdBy/ field. | 145 | -- identifier or torrent /createdBy/ field. |
@@ -164,10 +160,8 @@ instance IsString ClientInfo where | |||
164 | where | 160 | where |
165 | (impl, _ver) = L.span ((/=) '-') str | 161 | (impl, _ver) = L.span ((/=) '-') str |
166 | 162 | ||
167 | -- | Format client info in human-readable form. | 163 | instance Pretty ClientInfo where |
168 | ppClientInfo :: ClientInfo -> Doc | 164 | pretty ClientInfo {..} = pretty ciImpl <+> "version" <+> pretty ciVersion |
169 | ppClientInfo ClientInfo {..} = | ||
170 | ppClientImpl ciImpl <+> "version" <+> ppVersion ciVersion | ||
171 | 165 | ||
172 | -- | Client info of this (the bittorrent library) package. Normally, | 166 | -- | Client info of this (the bittorrent library) package. Normally, |
173 | -- applications should introduce its own idenitifiers, otherwise they | 167 | -- applications should introduce its own idenitifiers, otherwise they |
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs index 2e3946eb..e15fdbb3 100644 --- a/src/Data/Torrent/InfoHash.hs +++ b/src/Data/Torrent/InfoHash.hs | |||
@@ -19,11 +19,9 @@ module Data.Torrent.InfoHash | |||
19 | -- * Rendering | 19 | -- * Rendering |
20 | , longHex | 20 | , longHex |
21 | , shortHex | 21 | , shortHex |
22 | , ppInfoHash | ||
23 | 22 | ||
24 | , addHashToURI | 23 | , addHashToURI |
25 | 24 | ||
26 | |||
27 | , Data.Torrent.InfoHash.hash | 25 | , Data.Torrent.InfoHash.hash |
28 | , Data.Torrent.InfoHash.hashlazy | 26 | , Data.Torrent.InfoHash.hashlazy |
29 | ) where | 27 | ) where |
@@ -52,6 +50,7 @@ import Network.URI | |||
52 | import Numeric | 50 | import Numeric |
53 | import Text.ParserCombinators.ReadP as P | 51 | import Text.ParserCombinators.ReadP as P |
54 | import Text.PrettyPrint | 52 | import Text.PrettyPrint |
53 | import Text.PrettyPrint.Class | ||
55 | 54 | ||
56 | 55 | ||
57 | -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. | 56 | -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. |
@@ -60,7 +59,7 @@ newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString } | |||
60 | 59 | ||
61 | -- | for hex encoded strings | 60 | -- | for hex encoded strings |
62 | instance Show InfoHash where | 61 | instance Show InfoHash where |
63 | show = render . ppInfoHash | 62 | show = render . pretty |
64 | 63 | ||
65 | -- | for hex encoded strings | 64 | -- | for hex encoded strings |
66 | instance Read InfoHash where | 65 | instance Read InfoHash where |
@@ -106,6 +105,10 @@ instance FromJSON InfoHash where | |||
106 | instance URLShow InfoHash where | 105 | instance URLShow InfoHash where |
107 | urlShow = show | 106 | urlShow = show |
108 | 107 | ||
108 | -- | base16 encoded. | ||
109 | instance Pretty InfoHash where | ||
110 | pretty = text . BC.unpack . ppHex . getInfoHash | ||
111 | |||
109 | -- | Tries both base16 and base32 while decoding info hash. | 112 | -- | Tries both base16 and base32 while decoding info hash. |
110 | textToInfoHash :: Text -> Maybe InfoHash | 113 | textToInfoHash :: Text -> Maybe InfoHash |
111 | textToInfoHash text | 114 | textToInfoHash text |
@@ -127,10 +130,6 @@ longHex = T.decodeUtf8 . Base16.encode . getInfoHash | |||
127 | shortHex :: InfoHash -> Text | 130 | shortHex :: InfoHash -> Text |
128 | shortHex = T.take 7 . longHex | 131 | shortHex = T.take 7 . longHex |
129 | 132 | ||
130 | -- | Pretty print info hash in hexadecimal format. | ||
131 | ppInfoHash :: InfoHash -> Doc | ||
132 | ppInfoHash = text . BC.unpack . ppHex . getInfoHash | ||
133 | |||
134 | ppHex :: BS.ByteString -> BS.ByteString | 133 | ppHex :: BS.ByteString -> BS.ByteString |
135 | ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed | 134 | ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed |
136 | 135 | ||
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs index 84085a92..70908c4e 100644 --- a/src/Data/Torrent/Layout.hs +++ b/src/Data/Torrent/Layout.hs | |||
@@ -24,7 +24,6 @@ module Data.Torrent.Layout | |||
24 | 24 | ||
25 | -- * Single file info | 25 | -- * Single file info |
26 | , FileInfo (..) | 26 | , FileInfo (..) |
27 | , ppFileInfo | ||
28 | 27 | ||
29 | -- ** Lens | 28 | -- ** Lens |
30 | , fileLength | 29 | , fileLength |
@@ -33,7 +32,6 @@ module Data.Torrent.Layout | |||
33 | 32 | ||
34 | -- * File layout | 33 | -- * File layout |
35 | , LayoutInfo (..) | 34 | , LayoutInfo (..) |
36 | , ppLayoutInfo | ||
37 | , joinFilePath | 35 | , joinFilePath |
38 | 36 | ||
39 | -- ** Lens | 37 | -- ** Lens |
@@ -78,6 +76,7 @@ import Data.Text as T | |||
78 | import Data.Text.Encoding as T | 76 | import Data.Text.Encoding as T |
79 | import Data.Typeable | 77 | import Data.Typeable |
80 | import Text.PrettyPrint as PP | 78 | import Text.PrettyPrint as PP |
79 | import Text.PrettyPrint.Class | ||
81 | import System.FilePath | 80 | import System.FilePath |
82 | import System.Posix.Types | 81 | import System.Posix.Types |
83 | 82 | ||
@@ -175,13 +174,12 @@ instance BEncode (FileInfo ByteString) where | |||
175 | fromBEncode = fromDict getFileInfoSingle | 174 | fromBEncode = fromDict getFileInfoSingle |
176 | {-# INLINE fromBEncode #-} | 175 | {-# INLINE fromBEncode #-} |
177 | 176 | ||
178 | -- | Format 'FileInfo' in human-readable form. | 177 | instance Pretty (FileInfo BS.ByteString) where |
179 | ppFileInfo :: FileInfo ByteString -> Doc | 178 | pretty FileInfo {..} = |
180 | ppFileInfo FileInfo {..} = | ||
181 | "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) | 179 | "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) |
182 | $$ "Size: " <> text (show fiLength) | 180 | $$ "Size: " <> text (show fiLength) |
183 | $$ maybe PP.empty ppMD5 fiMD5Sum | 181 | $$ maybe PP.empty ppMD5 fiMD5Sum |
184 | where | 182 | where |
185 | ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5)) | 183 | ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5)) |
186 | 184 | ||
187 | -- | Join file path. | 185 | -- | Join file path. |
@@ -242,10 +240,9 @@ instance BEncode LayoutInfo where | |||
242 | toBEncode = toDict . (`putLayoutInfo` endDict) | 240 | toBEncode = toDict . (`putLayoutInfo` endDict) |
243 | fromBEncode = fromDict getLayoutInfo | 241 | fromBEncode = fromDict getLayoutInfo |
244 | 242 | ||
245 | -- | Format 'LayoutInfo' in human readable form. | 243 | instance Pretty LayoutInfo where |
246 | ppLayoutInfo :: LayoutInfo -> Doc | 244 | pretty SingleFile {..} = pretty liFile |
247 | ppLayoutInfo SingleFile {..} = ppFileInfo liFile | 245 | pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles |
248 | ppLayoutInfo MultiFile {..} = vcat $ L.map (ppFileInfo . joinFilePath) liFiles | ||
249 | 246 | ||
250 | -- | Test if this is single file torrent. | 247 | -- | Test if this is single file torrent. |
251 | isSingleFile :: LayoutInfo -> Bool | 248 | isSingleFile :: LayoutInfo -> Bool |
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs index 01f28a76..791537b1 100644 --- a/src/Data/Torrent/Magnet.hs +++ b/src/Data/Torrent/Magnet.hs | |||
@@ -43,6 +43,8 @@ import Data.Text as T | |||
43 | import Data.Text.Encoding as T | 43 | import Data.Text.Encoding as T |
44 | import Network.URI | 44 | import Network.URI |
45 | import Text.Read | 45 | import Text.Read |
46 | import Text.PrettyPrint as PP | ||
47 | import Text.PrettyPrint.Class | ||
46 | 48 | ||
47 | import Data.Torrent | 49 | import Data.Torrent |
48 | import Data.Torrent.InfoHash | 50 | import Data.Torrent.InfoHash |
@@ -148,6 +150,9 @@ instance URLEncode Magnet where | |||
148 | urlEncode = toQuery | 150 | urlEncode = toQuery |
149 | {-# INLINE urlEncode #-} | 151 | {-# INLINE urlEncode #-} |
150 | 152 | ||
153 | instance Pretty Magnet where | ||
154 | pretty = PP.text . renderMagnet | ||
155 | |||
151 | -- | Set exact topic only, other params are empty. | 156 | -- | Set exact topic only, other params are empty. |
152 | nullMagnet :: InfoHash -> Magnet | 157 | nullMagnet :: InfoHash -> Magnet |
153 | nullMagnet u = Magnet | 158 | nullMagnet u = Magnet |
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs index c8727a65..6cff53d6 100644 --- a/src/Data/Torrent/Piece.hs +++ b/src/Data/Torrent/Piece.hs | |||
@@ -21,13 +21,11 @@ module Data.Torrent.Piece | |||
21 | 21 | ||
22 | -- * Piece data | 22 | -- * Piece data |
23 | , Piece (..) | 23 | , Piece (..) |
24 | , ppPiece | ||
25 | , pieceSize | 24 | , pieceSize |
26 | , isPiece | 25 | , isPiece |
27 | 26 | ||
28 | -- * Piece control | 27 | -- * Piece control |
29 | , PieceInfo (..) | 28 | , PieceInfo (..) |
30 | , ppPieceInfo | ||
31 | , pieceCount | 29 | , pieceCount |
32 | 30 | ||
33 | -- * Lens | 31 | -- * Lens |
@@ -61,6 +59,7 @@ import Data.List as L | |||
61 | import Data.Text.Encoding as T | 59 | import Data.Text.Encoding as T |
62 | import Data.Typeable | 60 | import Data.Typeable |
63 | import Text.PrettyPrint | 61 | import Text.PrettyPrint |
62 | import Text.PrettyPrint.Class | ||
64 | 63 | ||
65 | import Data.Torrent.Block | 64 | import Data.Torrent.Block |
66 | 65 | ||
@@ -121,10 +120,9 @@ $(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece) | |||
121 | 120 | ||
122 | instance NFData (Piece a) | 121 | instance NFData (Piece a) |
123 | 122 | ||
124 | -- | Format piece in human readable form. Payload bytes are omitted. | 123 | -- | Payload bytes are omitted. |
125 | ppPiece :: Piece a -> Doc | 124 | instance Pretty (Piece a) where |
126 | ppPiece Piece {..} | 125 | pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) |
127 | = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) | ||
128 | 126 | ||
129 | -- | Get size of piece in bytes. | 127 | -- | Get size of piece in bytes. |
130 | pieceSize :: Piece BL.ByteString -> PieceSize | 128 | pieceSize :: Piece BL.ByteString -> PieceSize |
@@ -192,10 +190,9 @@ instance BEncode PieceInfo where | |||
192 | toBEncode = toDict . (`putPieceInfo` endDict) | 190 | toBEncode = toDict . (`putPieceInfo` endDict) |
193 | fromBEncode = fromDict getPieceInfo | 191 | fromBEncode = fromDict getPieceInfo |
194 | 192 | ||
195 | -- | Format piece info in human readable form. Hashes are omitted. | 193 | -- | Hashes are omitted. |
196 | ppPieceInfo :: PieceInfo -> Doc | 194 | instance Pretty PieceInfo where |
197 | ppPieceInfo PieceInfo {..} = | 195 | pretty PieceInfo {..} = "Piece size: " <> int piPieceLength |
198 | "Piece size: " <> int piPieceLength | ||
199 | 196 | ||
200 | hashsize :: Int | 197 | hashsize :: Int |
201 | hashsize = 20 | 198 | hashsize = 20 |
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs index 18a9cd7d..d0aa75c6 100644 --- a/src/Data/Torrent/Progress.hs +++ b/src/Data/Torrent/Progress.hs | |||
@@ -43,6 +43,8 @@ import Data.Serialize as S | |||
43 | import Data.Ratio | 43 | import Data.Ratio |
44 | import Data.URLEncoded | 44 | import Data.URLEncoded |
45 | import Data.Word | 45 | import Data.Word |
46 | import Text.PrettyPrint as PP | ||
47 | import Text.PrettyPrint.Class | ||
46 | 48 | ||
47 | 49 | ||
48 | -- | Progress data is considered as dynamic within one client | 50 | -- | Progress data is considered as dynamic within one client |
@@ -100,6 +102,12 @@ instance URLEncode Progress where | |||
100 | ] | 102 | ] |
101 | where s :: String -> String; s = id; {-# INLINE s #-} | 103 | where s :: String -> String; s = id; {-# INLINE s #-} |
102 | 104 | ||
105 | instance Pretty Progress where | ||
106 | pretty Progress {..} = | ||
107 | "/\\" <+> PP.text (show _uploaded) $$ | ||
108 | "\\/" <+> PP.text (show _downloaded) $$ | ||
109 | "left" <+> PP.text (show _left) | ||
110 | |||
103 | -- | Initial progress is used when there are no session before. | 111 | -- | Initial progress is used when there are no session before. |
104 | -- | 112 | -- |
105 | -- Please note that tracker might penalize client some way if the do | 113 | -- Please note that tracker might penalize client some way if the do |
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs index cf71c2ec..102f4dff 100644 --- a/src/Data/Torrent/Tree.hs +++ b/src/Data/Torrent/Tree.hs | |||
@@ -55,6 +55,8 @@ build MultiFile {..} = Dir $ M.singleton liDirName files | |||
55 | --decompress :: DirTree () -> [FileInfo ()] | 55 | --decompress :: DirTree () -> [FileInfo ()] |
56 | --decompress = undefined | 56 | --decompress = undefined |
57 | 57 | ||
58 | -- TODO pretty print | ||
59 | |||
58 | -- | Lookup file by path. | 60 | -- | Lookup file by path. |
59 | lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a) | 61 | lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a) |
60 | lookup [] t = Just t | 62 | lookup [] t = Just t |