summaryrefslogtreecommitdiff
path: root/src/Data/BEncode.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r--src/Data/BEncode.hs85
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 #-}
46module Data.BEncode 50module 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
101type Dict = Map ByteString BEncode 122type 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--
109data BEncode = BInteger {-# UNPACK #-} !Int64 130data BEncode = BInteger {-# UNPACK #-} !Int64
110 | BString !ByteString 131 | BString !ByteString
@@ -310,8 +331,8 @@ fromAssocs :: [Assoc] -> BEncode
310fromAssocs = BDict . M.fromList . mkAssocs 331fromAssocs = 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.
315fromAscAssocs :: [Assoc] -> BEncode 336fromAscAssocs :: [Assoc] -> BEncode
316fromAscAssocs = BDict . M.fromList . mkAssocs 337fromAscAssocs = 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
323reqKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result a 344reqKey :: BEncodable a => Dict -> ByteString -> Result a
324reqKey d key 345reqKey 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
328optKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result (Maybe a) 351optKey :: BEncodable a => Dict -> ByteString -> Result (Maybe a)
329optKey d key 352optKey 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
458ppBS = text . map w2c . B.unpack 482ppBS = text . map w2c . B.unpack
459 483
460ppBEncode :: BEncode -> Doc 484ppBEncode :: BEncode -> Doc
461ppBEncode (BInteger i) = int (fromIntegral i) 485ppBEncode (BInteger i) = int $ fromIntegral i
462ppBEncode (BString s) = ppBS s 486ppBEncode (BString s) = ppBS s
463ppBEncode (BList l) = brackets $ hsep (punctuate comma (map ppBEncode l)) 487ppBEncode (BList l) = brackets $ hsep $ punctuate comma $ map ppBEncode l
464ppBEncode (BDict d) = braces $ vcat (punctuate comma (map ppKV (M.toAscList d))) 488ppBEncode (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