diff options
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r-- | src/Data/BEncode.hs | 85 |
1 files changed, 55 insertions, 30 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 2f1125e..22adbb4 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -1,4 +1,6 @@ | |||
1 | -- TODO: make int's instances platform independent so we can make library portable. | 1 | -- TODO: make int's instances platform independent so we can make |
2 | -- library portable. | ||
3 | |||
2 | -- | | 4 | -- | |
3 | -- Copyright : (c) Sam T. 2013 | 5 | -- Copyright : (c) Sam T. 2013 |
4 | -- License : MIT | 6 | -- License : MIT |
@@ -6,8 +8,9 @@ | |||
6 | -- Stability : stable | 8 | -- Stability : stable |
7 | -- Portability : non-portable | 9 | -- Portability : non-portable |
8 | -- | 10 | -- |
9 | -- This module provides convinient and fast way to serialize, deserealize | 11 | -- This module provides convinient and fast way to serialize, |
10 | -- and construct/destructure Bencoded values with optional fields. | 12 | -- deserealize and construct/destructure Bencoded values with |
13 | -- optional fields. | ||
11 | -- | 14 | -- |
12 | -- It supports four different types of values: | 15 | -- It supports four different types of values: |
13 | -- | 16 | -- |
@@ -19,9 +22,10 @@ | |||
19 | -- | 22 | -- |
20 | -- * dictionaries — represented as 'Map'; | 23 | -- * dictionaries — represented as 'Map'; |
21 | -- | 24 | -- |
22 | -- To serialize any other types we need to make conversion. | 25 | -- To serialize any other types we need to make conversion. To |
23 | -- To make conversion more convenient there is type class for it: 'BEncodable'. | 26 | -- make conversion more convenient there is type class for it: |
24 | -- Any textual strings are considered as UTF8 encoded 'Text'. | 27 | -- 'BEncodable'. Any textual strings are considered as UTF8 encoded |
28 | -- 'Text'. | ||
25 | -- | 29 | -- |
26 | -- The complete Augmented BNF syntax for bencoding format is: | 30 | -- The complete Augmented BNF syntax for bencoding format is: |
27 | -- | 31 | -- |
@@ -42,30 +46,47 @@ | |||
42 | -- This module is considered to be imported qualified. | 46 | -- This module is considered to be imported qualified. |
43 | -- | 47 | -- |
44 | {-# LANGUAGE FlexibleInstances #-} | 48 | {-# LANGUAGE FlexibleInstances #-} |
45 | {-# LANGUAGE Trustworthy #-} | 49 | {-# LANGUAGE Trustworthy #-} |
46 | module Data.BEncode | 50 | module Data.BEncode |
47 | ( -- * Datatype | 51 | ( -- * Datatype |
48 | BEncode(..) | 52 | BEncode(..) |
53 | , Dict | ||
49 | 54 | ||
50 | -- * Construction && Destructuring | 55 | -- * Construction && Destructuring |
51 | , BEncodable (..), dictAssoc, Result | 56 | , BEncodable (..) |
57 | , dictAssoc | ||
58 | , Result | ||
52 | 59 | ||
53 | -- ** Dictionaries | 60 | -- ** Dictionaries |
54 | -- *** Building | 61 | -- *** Building |
55 | , (-->), (-->?), fromAssocs, fromAscAssocs | 62 | , (-->) |
63 | , (-->?) | ||
64 | , fromAssocs | ||
65 | , fromAscAssocs | ||
56 | 66 | ||
57 | -- *** Extraction | 67 | -- *** Extraction |
58 | , reqKey, optKey, (>--), (>--?) | 68 | , reqKey |
69 | , optKey | ||
70 | , (>--) | ||
71 | , (>--?) | ||
59 | 72 | ||
60 | -- * Serialization | 73 | -- * Serialization |
61 | , encode, decode | 74 | , encode |
62 | , encoded, decoded | 75 | , decode |
76 | , encoded | ||
77 | , decoded | ||
63 | 78 | ||
64 | -- * Predicates | 79 | -- * Predicates |
65 | , isInteger, isString, isList, isDict | 80 | , isInteger |
81 | , isString | ||
82 | , isList | ||
83 | , isDict | ||
66 | 84 | ||
67 | -- * Extra | 85 | -- * Extra |
68 | , builder, parser, decodingError, printPretty | 86 | , builder |
87 | , parser | ||
88 | , decodingError | ||
89 | , printPretty | ||
69 | ) where | 90 | ) where |
70 | 91 | ||
71 | 92 | ||
@@ -100,11 +121,11 @@ import qualified Text.ParserCombinators.ReadP as ReadP | |||
100 | 121 | ||
101 | type Dict = Map ByteString BEncode | 122 | type Dict = Map ByteString BEncode |
102 | 123 | ||
103 | -- | 'BEncode' is straightforward ADT for b-encoded values. | 124 | -- | 'BEncode' is straightforward ADT for b-encoded values. Please |
104 | -- Please note that since dictionaries are sorted, in most cases we can | 125 | -- note that since dictionaries are sorted, in most cases we can |
105 | -- compare BEncoded values without serialization and vice versa. | 126 | -- compare BEncoded values without serialization and vice versa. |
106 | -- Lists is not required to be sorted through. | 127 | -- Lists is not required to be sorted through. Also note that |
107 | -- Also note that 'BEncode' have JSON-like instance for 'Pretty'. | 128 | -- 'BEncode' have JSON-like instance for 'Pretty'. |
108 | -- | 129 | -- |
109 | data BEncode = BInteger {-# UNPACK #-} !Int64 | 130 | data BEncode = BInteger {-# UNPACK #-} !Int64 |
110 | | BString !ByteString | 131 | | BString !ByteString |
@@ -310,8 +331,8 @@ fromAssocs :: [Assoc] -> BEncode | |||
310 | fromAssocs = BDict . M.fromList . mkAssocs | 331 | fromAssocs = BDict . M.fromList . mkAssocs |
311 | {-# INLINE fromAssocs #-} | 332 | {-# INLINE fromAssocs #-} |
312 | 333 | ||
313 | -- | A faster version of 'fromAssocs'. | 334 | -- | A faster version of 'fromAssocs'. Should be used only when keys |
314 | -- Should be used only when keys are sorted by ascending. | 335 | -- are sorted by ascending. |
315 | fromAscAssocs :: [Assoc] -> BEncode | 336 | fromAscAssocs :: [Assoc] -> BEncode |
316 | fromAscAssocs = BDict . M.fromList . mkAssocs | 337 | fromAscAssocs = BDict . M.fromList . mkAssocs |
317 | {-# INLINE fromAscAssocs #-} | 338 | {-# INLINE fromAscAssocs #-} |
@@ -320,22 +341,24 @@ fromAscAssocs = BDict . M.fromList . mkAssocs | |||
320 | Extraction | 341 | Extraction |
321 | --------------------------------------------------------------------} | 342 | --------------------------------------------------------------------} |
322 | 343 | ||
323 | reqKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result a | 344 | reqKey :: BEncodable a => Dict -> ByteString -> Result a |
324 | reqKey d key | 345 | reqKey d key |
325 | | Just b <- M.lookup key d = fromBEncode b | 346 | | Just b <- M.lookup key d = fromBEncode b |
326 | | otherwise = Left ("required field `" ++ BC.unpack key ++ "' not found") | 347 | | otherwise = Left msg |
348 | where | ||
349 | msg = "required field `" ++ BC.unpack key ++ "' not found" | ||
327 | 350 | ||
328 | optKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result (Maybe a) | 351 | optKey :: BEncodable a => Dict -> ByteString -> Result (Maybe a) |
329 | optKey d key | 352 | optKey d key |
330 | | Just b <- M.lookup key d | 353 | | Just b <- M.lookup key d |
331 | , Right r <- fromBEncode b = return (Just r) | 354 | , Right r <- fromBEncode b = return (Just r) |
332 | | otherwise = return Nothing | 355 | | otherwise = return Nothing |
333 | 356 | ||
334 | (>--) :: BEncodable a => Map ByteString BEncode -> ByteString -> Result a | 357 | (>--) :: BEncodable a => Dict -> ByteString -> Result a |
335 | (>--) = reqKey | 358 | (>--) = reqKey |
336 | {-# INLINE (>--) #-} | 359 | {-# INLINE (>--) #-} |
337 | 360 | ||
338 | (>--?) :: BEncodable a => Map ByteString BEncode -> ByteString -> Result (Maybe a) | 361 | (>--?) :: BEncodable a => Dict -> ByteString -> Result (Maybe a) |
339 | (>--?) = optKey | 362 | (>--?) = optKey |
340 | {-# INLINE (>--?) #-} | 363 | {-# INLINE (>--?) #-} |
341 | 364 | ||
@@ -420,7 +443,8 @@ parser = valueP | |||
420 | 'l' -> P.anyChar *> ((BList <$> listBody) <* P.anyChar) | 443 | 'l' -> P.anyChar *> ((BList <$> listBody) <* P.anyChar) |
421 | 'd' -> do | 444 | 'd' -> do |
422 | P.anyChar | 445 | P.anyChar |
423 | (BDict . M.fromDistinctAscList <$> many ((,) <$> stringP <*> valueP)) | 446 | (BDict . M.fromDistinctAscList <$> |
447 | many ((,) <$> stringP <*> valueP)) | ||
424 | <* P.anyChar | 448 | <* P.anyChar |
425 | t -> fail ("bencode unknown tag: " ++ [t]) | 449 | t -> fail ("bencode unknown tag: " ++ [t]) |
426 | 450 | ||
@@ -458,10 +482,11 @@ ppBS :: ByteString -> Doc | |||
458 | ppBS = text . map w2c . B.unpack | 482 | ppBS = text . map w2c . B.unpack |
459 | 483 | ||
460 | ppBEncode :: BEncode -> Doc | 484 | ppBEncode :: BEncode -> Doc |
461 | ppBEncode (BInteger i) = int (fromIntegral i) | 485 | ppBEncode (BInteger i) = int $ fromIntegral i |
462 | ppBEncode (BString s) = ppBS s | 486 | ppBEncode (BString s) = ppBS s |
463 | ppBEncode (BList l) = brackets $ hsep (punctuate comma (map ppBEncode l)) | 487 | ppBEncode (BList l) = brackets $ hsep $ punctuate comma $ map ppBEncode l |
464 | ppBEncode (BDict d) = braces $ vcat (punctuate comma (map ppKV (M.toAscList d))) | 488 | ppBEncode (BDict d) |
489 | = braces $ vcat $ punctuate comma $ map ppKV $ M.toAscList d | ||
465 | where | 490 | where |
466 | ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v | 491 | ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v |
467 | 492 | ||