diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/BEncode.hs | 41 |
1 files changed, 35 insertions, 6 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 357f63f..c844858 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -16,6 +16,7 @@ module Data.BEncode | |||
16 | 16 | ||
17 | -- * Serialization | 17 | -- * Serialization |
18 | , encode, decode | 18 | , encode, decode |
19 | , encoded, decoded | ||
19 | 20 | ||
20 | -- * Extra | 21 | -- * Extra |
21 | , builder, parser, decodingError, printPretty | 22 | , builder, parser, decodingError, printPretty |
@@ -26,6 +27,7 @@ module Data.BEncode | |||
26 | 27 | ||
27 | 28 | ||
28 | import Control.Applicative | 29 | import Control.Applicative |
30 | import Control.Monad | ||
29 | import Data.Int | 31 | import Data.Int |
30 | import Data.Maybe (mapMaybe) | 32 | import Data.Maybe (mapMaybe) |
31 | import Data.Monoid ((<>)) | 33 | import Data.Monoid ((<>)) |
@@ -66,6 +68,8 @@ type Result = Either String | |||
66 | class BEncodable a where | 68 | class BEncodable a where |
67 | toBEncode :: a -> BEncode | 69 | toBEncode :: a -> BEncode |
68 | fromBEncode :: BEncode -> Result a | 70 | fromBEncode :: BEncode -> Result a |
71 | |||
72 | |||
69 | -- isEncodable :: BEncode -> Bool | 73 | -- isEncodable :: BEncode -> Bool |
70 | -- bencoding :: Iso a | 74 | -- bencoding :: Iso a |
71 | -- bencoding = Iso (Right . toBencode) fromBEncode | 75 | -- bencoding = Iso (Right . toBencode) fromBEncode |
@@ -129,7 +133,7 @@ instance BEncodable Text where | |||
129 | 133 | ||
130 | 134 | ||
131 | {- | 135 | {- |
132 | instance BEncodable String where | 136 | instance BEncodable Stringwhere |
133 | toBEncode = BString . BC.pack | 137 | toBEncode = BString . BC.pack |
134 | {-# INLINE toBEncode #-} | 138 | {-# INLINE toBEncode #-} |
135 | 139 | ||
@@ -174,17 +178,22 @@ key --> val = Required key (toBEncode val) | |||
174 | key -->? mval = Optional key (toBEncode <$> mval) | 178 | key -->? mval = Optional key (toBEncode <$> mval) |
175 | {-# INLINE (-->?) #-} | 179 | {-# INLINE (-->?) #-} |
176 | 180 | ||
177 | fromAssocs :: [Assoc] -> BEncode | 181 | mkAssocs :: [Assoc] -> [(ByteString, BEncode)] |
178 | fromAssocs = BDict . M.fromList . mapMaybe unpackAssoc | 182 | mkAssocs = mapMaybe unpackAssoc |
179 | where | 183 | where |
180 | unpackAssoc (Required n v) = Just (n, v) | 184 | unpackAssoc (Required n v) = Just (n, v) |
181 | unpackAssoc (Optional n (Just v)) = Just (n, v) | 185 | unpackAssoc (Optional n (Just v)) = Just (n, v) |
182 | unpackAssoc (Optional _ Nothing) = Nothing | 186 | unpackAssoc (Optional _ Nothing) = Nothing |
183 | 187 | ||
188 | fromAssocs :: [Assoc] -> BEncode | ||
189 | fromAssocs = BDict . M.fromList . mkAssocs | ||
190 | {-# INLINE fromAssocs #-} | ||
191 | |||
184 | -- | A faster version of 'fromAssocs'. | 192 | -- | A faster version of 'fromAssocs'. |
185 | -- Should be used only when keys are sorted by ascending. | 193 | -- Should be used only when keys are sorted by ascending. |
186 | fromAscAssocs :: [Assoc] -> BEncode | 194 | fromAscAssocs :: [Assoc] -> BEncode |
187 | fromAscAssocs = error "fromAscAssocs" | 195 | fromAscAssocs = BDict . M.fromList . mkAssocs |
196 | {-# INLINE fromAscAssocs #-} | ||
188 | 197 | ||
189 | ------------------------------------ Extraction -------------------------------- | 198 | ------------------------------------ Extraction -------------------------------- |
190 | reqKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result a | 199 | reqKey :: BEncodable a => Map ByteString BEncode -> ByteString -> Result a |
@@ -227,12 +236,19 @@ isDict (BList _) = True | |||
227 | isDict _ = False | 236 | isDict _ = False |
228 | {-# INLINE isDict #-} | 237 | {-# INLINE isDict #-} |
229 | 238 | ||
239 | --------------------------------------- Encoding ------------------------------- | ||
230 | encode :: BEncode -> Lazy.ByteString | 240 | encode :: BEncode -> Lazy.ByteString |
231 | encode = B.toLazyByteString . builder | 241 | encode = B.toLazyByteString . builder |
232 | 242 | ||
233 | decode :: ByteString -> Either String BEncode | 243 | decode :: ByteString -> Result BEncode |
234 | decode = P.parseOnly parser | 244 | decode = P.parseOnly parser |
235 | 245 | ||
246 | decoded :: BEncodable a => ByteString -> Result a | ||
247 | decoded = decode >=> fromBEncode | ||
248 | |||
249 | encoded :: BEncodable a => a -> Lazy.ByteString | ||
250 | encoded = encode . toBEncode | ||
251 | |||
236 | 252 | ||
237 | builder :: BEncode -> B.Builder | 253 | builder :: BEncode -> B.Builder |
238 | builder = go | 254 | builder = go |
@@ -255,7 +271,7 @@ builder = go | |||
255 | B.byteString s | 271 | B.byteString s |
256 | {-# INLINE buildString #-} | 272 | {-# INLINE buildString #-} |
257 | 273 | ||
258 | 274 | -- | todo zepto | |
259 | parser :: Parser BEncode | 275 | parser :: Parser BEncode |
260 | parser = valueP | 276 | parser = valueP |
261 | where | 277 | where |
@@ -288,6 +304,19 @@ parser = valueP | |||
288 | {-# INLINE integerP #-} | 304 | {-# INLINE integerP #-} |
289 | 305 | ||
290 | 306 | ||
307 | -- | Extract raw field from the dict. | ||
308 | -- Useful for info hash extraction. | ||
309 | --rawLookup :: ByteString -> Result ByteString | ||
310 | --rawLookup key = P.parseOnly (P.char 'd' >> go) | ||
311 | -- where | ||
312 | -- - go = do | ||
313 | -- s <- stringP | ||
314 | -- if s == key | ||
315 | -- then ( | ||
316 | -- else parser >> go | ||
317 | |||
318 | |||
319 | -------------------------------- pretty printing ------------------------------- | ||
291 | printPretty :: BEncode -> IO () | 320 | printPretty :: BEncode -> IO () |
292 | printPretty = print . pretty | 321 | printPretty = print . pretty |
293 | 322 | ||