diff options
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r-- | src/Data/BEncode.hs | 92 |
1 files changed, 55 insertions, 37 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 1601fd1..267d4b2 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -339,55 +339,72 @@ instance GBEncodable f e | |||
339 | #endif | 339 | #endif |
340 | 340 | ||
341 | {-------------------------------------------------------------------- | 341 | {-------------------------------------------------------------------- |
342 | Basic instances | 342 | -- Native instances |
343 | --------------------------------------------------------------------} | 343 | --------------------------------------------------------------------} |
344 | 344 | ||
345 | instance BEncodable BEncode where | 345 | instance BEncodable BEncode where |
346 | {-# SPECIALIZE instance BEncodable BEncode #-} | ||
347 | toBEncode = id | 346 | toBEncode = id |
348 | {-# INLINE toBEncode #-} | 347 | {-# INLINE toBEncode #-} |
349 | 348 | ||
350 | fromBEncode = Right | 349 | fromBEncode = pure |
351 | {-# INLINE fromBEncode #-} | 350 | {-# INLINE fromBEncode #-} |
352 | 351 | ||
353 | instance BEncodable Int where | 352 | instance BEncodable BInteger where |
354 | {-# SPECIALIZE instance BEncodable Int #-} | 353 | toBEncode = BInteger |
355 | toBEncode = BInteger . fromIntegral | ||
356 | {-# INLINE toBEncode #-} | 354 | {-# INLINE toBEncode #-} |
357 | 355 | ||
358 | fromBEncode (BInteger i) = Right (fromIntegral i) | 356 | fromBEncode (BInteger i) = pure i |
359 | fromBEncode _ = decodingError "integer" | 357 | fromBEncode _ = decodingError "BInteger" |
360 | {-# INLINE fromBEncode #-} | 358 | {-# INLINE fromBEncode #-} |
361 | 359 | ||
362 | instance BEncodable Bool where | 360 | instance BEncodable BString where |
363 | toBEncode = toBEncode . fromEnum | 361 | toBEncode = BString |
364 | {-# INLINE toBEncode #-} | 362 | {-# INLINE toBEncode #-} |
365 | 363 | ||
366 | fromBEncode b = do | 364 | fromBEncode (BString s) = pure s |
367 | i <- fromBEncode b | 365 | fromBEncode _ = decodingError "BString" |
368 | case i :: Int of | ||
369 | 0 -> return False | ||
370 | 1 -> return True | ||
371 | _ -> decodingError "bool" | ||
372 | {-# INLINE fromBEncode #-} | 366 | {-# INLINE fromBEncode #-} |
373 | 367 | ||
368 | instance BEncodable BList where | ||
369 | toBEncode = BList | ||
370 | {-# INLINE toBEncode #-} | ||
374 | 371 | ||
375 | instance BEncodable Integer where | 372 | fromBEncode (BList xs) = pure xs |
376 | toBEncode = BInteger . fromIntegral | 373 | fromBEncode _ = decodingError "BList" |
374 | {-# INLINE fromBEncode #-} | ||
375 | |||
376 | instance BEncodable BDict where | ||
377 | toBEncode = BDict | ||
377 | {-# INLINE toBEncode #-} | 378 | {-# INLINE toBEncode #-} |
378 | 379 | ||
379 | fromBEncode b = fromIntegral <$> (fromBEncode b :: Result Int) | 380 | fromBEncode (BDict d) = pure d |
381 | fromBEncode _ = decodingError "BDict" | ||
380 | {-# INLINE fromBEncode #-} | 382 | {-# INLINE fromBEncode #-} |
381 | 383 | ||
384 | {-------------------------------------------------------------------- | ||
385 | -- Derived instances | ||
386 | --------------------------------------------------------------------} | ||
382 | 387 | ||
383 | instance BEncodable ByteString where | 388 | instance BEncodable Int where |
384 | toBEncode = BString | 389 | {-# SPECIALIZE instance BEncodable Int #-} |
390 | toBEncode = BInteger . fromIntegral | ||
385 | {-# INLINE toBEncode #-} | 391 | {-# INLINE toBEncode #-} |
386 | 392 | ||
387 | fromBEncode (BString s) = Right s | 393 | fromBEncode (BInteger i) = Right (fromIntegral i) |
388 | fromBEncode _ = decodingError "string" | 394 | fromBEncode _ = decodingError "Int" |
389 | {-# INLINE fromBEncode #-} | 395 | {-# INLINE fromBEncode #-} |
390 | 396 | ||
397 | instance BEncodable Bool where | ||
398 | toBEncode = toBEncode . fromEnum | ||
399 | {-# INLINE toBEncode #-} | ||
400 | |||
401 | fromBEncode b = do | ||
402 | i <- fromBEncode b | ||
403 | case i :: Int of | ||
404 | 0 -> return False | ||
405 | 1 -> return True | ||
406 | _ -> decodingError "Bool" | ||
407 | {-# INLINE fromBEncode #-} | ||
391 | 408 | ||
392 | instance BEncodable Text where | 409 | instance BEncodable Text where |
393 | toBEncode = toBEncode . T.encodeUtf8 | 410 | toBEncode = toBEncode . T.encodeUtf8 |
@@ -398,7 +415,6 @@ instance BEncodable Text where | |||
398 | 415 | ||
399 | instance BEncodable a => BEncodable [a] where | 416 | instance BEncodable a => BEncodable [a] where |
400 | {-# SPECIALIZE instance BEncodable [BEncode] #-} | 417 | {-# SPECIALIZE instance BEncodable [BEncode] #-} |
401 | |||
402 | toBEncode = BList . map toBEncode | 418 | toBEncode = BList . map toBEncode |
403 | {-# INLINE toBEncode #-} | 419 | {-# INLINE toBEncode #-} |
404 | 420 | ||
@@ -406,10 +422,8 @@ instance BEncodable a => BEncodable [a] where | |||
406 | fromBEncode _ = decodingError "list" | 422 | fromBEncode _ = decodingError "list" |
407 | {-# INLINE fromBEncode #-} | 423 | {-# INLINE fromBEncode #-} |
408 | 424 | ||
409 | |||
410 | instance BEncodable a => BEncodable (Map ByteString a) where | 425 | instance BEncodable a => BEncodable (Map ByteString a) where |
411 | {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-} | 426 | {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-} |
412 | |||
413 | toBEncode = BDict . M.map toBEncode | 427 | toBEncode = BDict . M.map toBEncode |
414 | {-# INLINE toBEncode #-} | 428 | {-# INLINE toBEncode #-} |
415 | 429 | ||
@@ -426,6 +440,21 @@ instance (Eq a, BEncodable a) => BEncodable (Set a) where | |||
426 | fromBEncode _ = decodingError "Data.Set" | 440 | fromBEncode _ = decodingError "Data.Set" |
427 | {-# INLINE fromBEncode #-} | 441 | {-# INLINE fromBEncode #-} |
428 | 442 | ||
443 | instance BEncodable Version where | ||
444 | {-# SPECIALIZE instance BEncodable Version #-} | ||
445 | {-# INLINE toBEncode #-} | ||
446 | toBEncode = toBEncode . BC.pack . showVersion | ||
447 | |||
448 | fromBEncode (BString bs) | ||
449 | | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs) | ||
450 | = return v | ||
451 | fromBEncode _ = decodingError "Data.Version" | ||
452 | {-# INLINE fromBEncode #-} | ||
453 | |||
454 | {-------------------------------------------------------------------- | ||
455 | -- Tuple instances | ||
456 | --------------------------------------------------------------------} | ||
457 | |||
429 | instance BEncodable () where | 458 | instance BEncodable () where |
430 | {-# SPECIALIZE instance BEncodable () #-} | 459 | {-# SPECIALIZE instance BEncodable () #-} |
431 | toBEncode () = BList [] | 460 | toBEncode () = BList [] |
@@ -488,17 +517,6 @@ instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d, BEncodable e) | |||
488 | fromBEncode _ = decodingError "Unable to decode a tuple5" | 517 | fromBEncode _ = decodingError "Unable to decode a tuple5" |
489 | {-# INLINE fromBEncode #-} | 518 | {-# INLINE fromBEncode #-} |
490 | 519 | ||
491 | instance BEncodable Version where | ||
492 | {-# SPECIALIZE instance BEncodable Version #-} | ||
493 | {-# INLINE toBEncode #-} | ||
494 | toBEncode = toBEncode . BC.pack . showVersion | ||
495 | |||
496 | fromBEncode (BString bs) | ||
497 | | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs) | ||
498 | = return v | ||
499 | fromBEncode _ = decodingError "Data.Version" | ||
500 | {-# INLINE fromBEncode #-} | ||
501 | |||
502 | {-------------------------------------------------------------------- | 520 | {-------------------------------------------------------------------- |
503 | Building dictionaries | 521 | Building dictionaries |
504 | --------------------------------------------------------------------} | 522 | --------------------------------------------------------------------} |