diff options
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r-- | src/Data/BEncode.hs | 89 |
1 files changed, 65 insertions, 24 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index fceb88b..aa34ab6 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -1,13 +1,12 @@ | |||
1 | -- | This module is intented to be imported qualified. | 1 | -- | This module is intented to be imported qualified. |
2 | {-# LANGUAGE FlexibleInstances #-} | ||
2 | module Data.BEncode | 3 | module Data.BEncode |
3 | ( -- ^ Datatype | 4 | ( -- ^ Datatype |
4 | BEncode(..) | 5 | BEncode(..) |
5 | 6 | ||
6 | -- ^ Construction | 7 | -- ^ Construction && Destructuring |
7 | , string, integer, list, dict | 8 | , BEncodable (..), dictAssoc |
8 | , int, charstring, dictAssoc | ||
9 | 9 | ||
10 | -- ^ Destructuring | ||
11 | -- ^ Serialization | 10 | -- ^ Serialization |
12 | , encode, decode | 11 | , encode, decode |
13 | 12 | ||
@@ -21,7 +20,8 @@ module Data.BEncode | |||
21 | 20 | ||
22 | import Control.Applicative | 21 | import Control.Applicative |
23 | import Data.Int | 22 | import Data.Int |
24 | import Data.Foldable | 23 | import Data.Foldable (foldMap) |
24 | import Data.Traversable (traverse) | ||
25 | import Data.Monoid ((<>)) | 25 | import Data.Monoid ((<>)) |
26 | import Data.Map (Map) | 26 | import Data.Map (Map) |
27 | import qualified Data.Map as M | 27 | import qualified Data.Map as M |
@@ -50,33 +50,74 @@ data BEncode = BInteger Int64 | |||
50 | | BDict Dict | 50 | | BDict Dict |
51 | deriving (Show, Read, Eq, Ord) | 51 | deriving (Show, Read, Eq, Ord) |
52 | 52 | ||
53 | integer :: Integer -> BEncode | 53 | class BEncodable a where |
54 | integer = BInteger . fromIntegral | 54 | toBEncode :: a -> BEncode |
55 | {-# INLINE integer #-} | 55 | fromBEncode :: BEncode -> Maybe a |
56 | -- isEncodable :: BEncode -> Bool | ||
56 | 57 | ||
57 | string :: ByteString -> BEncode | 58 | instance BEncodable BEncode where |
58 | string = BString | 59 | toBEncode = id |
59 | {-# INLINE string #-} | 60 | {-# INLINE toBEncode #-} |
60 | 61 | ||
61 | list :: [BEncode] -> BEncode | 62 | fromBEncode = Just |
62 | list = BList | 63 | {-# INLINE fromBEncode #-} |
63 | {-# INLINE list #-} | ||
64 | 64 | ||
65 | dict :: Dict -> BEncode | 65 | instance BEncodable Int where |
66 | dict = BDict | 66 | toBEncode = BInteger . fromIntegral |
67 | {-# INLINE dict #-} | 67 | {-# INLINE toBEncode #-} |
68 | 68 | ||
69 | fromBEncode (BInteger i) = Just (fromIntegral i) | ||
70 | fromBEncode _ = Nothing | ||
71 | {-# INLINE fromBEncode #-} | ||
69 | 72 | ||
70 | int :: Int -> BEncode | 73 | instance BEncodable Integer where |
71 | int = integer . fromIntegral | 74 | toBEncode = BInteger . fromIntegral |
72 | {-# INLINE int #-} | 75 | {-# INLINE toBEncode #-} |
73 | 76 | ||
74 | charstring :: String -> BEncode | 77 | fromBEncode (BInteger i) = Just (fromIntegral i) |
75 | charstring = string . B.pack . map (toEnum . fromEnum) | 78 | fromBEncode _ = Nothing |
76 | {-# INLINE charstring #-} | 79 | {-# INLINE fromBEncode #-} |
80 | |||
81 | instance BEncodable ByteString where | ||
82 | toBEncode = BString | ||
83 | {-# INLINE toBEncode #-} | ||
84 | |||
85 | fromBEncode (BString s) = Just s | ||
86 | fromBEncode _ = Nothing | ||
87 | {-# INLINE fromBEncode #-} | ||
88 | |||
89 | {- | ||
90 | instance BEncodable String where | ||
91 | toBEncode = BString . BC.pack | ||
92 | {-# INLINE toBEncode #-} | ||
93 | |||
94 | fromBEncode (BString s) = Just (BC.unpack s) | ||
95 | fromBEncode _ = Nothing | ||
96 | {-# INLINE fromBEncode #-} | ||
97 | -} | ||
98 | |||
99 | instance BEncodable a => BEncodable [a] where | ||
100 | {-# SPECIALIZE instance BEncodable [BEncode] #-} | ||
101 | |||
102 | toBEncode = BList . map toBEncode | ||
103 | {-# INLINE toBEncode #-} | ||
104 | |||
105 | fromBEncode (BList xs) = mapM fromBEncode xs | ||
106 | fromBEncode _ = Nothing | ||
107 | {-# INLINE fromBEncode #-} | ||
108 | |||
109 | instance BEncodable a => BEncodable (Map ByteString a) where | ||
110 | {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-} | ||
111 | |||
112 | toBEncode = BDict . M.map toBEncode | ||
113 | {-# INLINE toBEncode #-} | ||
114 | |||
115 | fromBEncode (BDict d) = traverse fromBEncode d | ||
116 | fromBEncode _ = Nothing | ||
117 | {-# INLINE fromBEncode #-} | ||
77 | 118 | ||
78 | dictAssoc :: [(ByteString, BEncode)] -> BEncode | 119 | dictAssoc :: [(ByteString, BEncode)] -> BEncode |
79 | dictAssoc = dict . M.fromList | 120 | dictAssoc = BDict . M.fromList |
80 | {-# INLINE dictAssoc #-} | 121 | {-# INLINE dictAssoc #-} |
81 | 122 | ||
82 | 123 | ||