blob: 7b0d46a09fe165a89bf08d14ca10dd32f325cbd9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{-# LANGUAGE CPP #-}
module Data.BEncode.Pretty where -- (showBEncode) where
import Data.BEncode.Types
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Text (Text)
import qualified Data.Text as T
#ifdef BENCODE_AESON
import Data.BEncode.BDict hiding (map)
import Data.Aeson.Types hiding (parse)
import Data.Aeson.Encode.Pretty
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector
import Data.Foldable as Foldable
import Data.Text.Encoding
import Text.Printf
#endif
#ifdef BENCODE_AESON
unhex :: Text -> BS.ByteString
unhex t = BS.pack $ map unhex1 [0 .. BS.length nibs `div` 2]
where
nibs = encodeUtf8 t
unhex1 i = unnib (BS.index nibs (i * 2)) * 0x10
+ unnib (BS.index nibs (i * 2 + 1))
unnib a | a <= 0x39 = a - 0x30
| otherwise = a - (0x41 - 10)
hex :: BS.ByteString -> Text
hex bs = T.concat $ map (T.pack . printf "%02X") $ BS.unpack bs
quote_chr :: Char
quote_chr = ' '
quote :: Text -> Text
quote t = quote_chr `T.cons` t `T.snoc` quote_chr
instance ToJSON BValue where
toJSON (BInteger x) = Number $ fromIntegral x
toJSON (BString s) = String $ either (const $ hex s) quote $ decodeUtf8' s
toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs
toJSON (BDict d) = toJSON d
instance ToJSON a => ToJSON (BDictMap a) where
toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d
where
convert (k,v) = (decodeUtf8 k,toJSON v)
instance FromJSON BValue where
parseJSON (Number x) = pure $ BInteger (truncate x)
parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0
parseJSON (String s)
| T.head s==quote_chr = pure $ BString $ encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
| otherwise = pure $ BString $ unhex s
parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v)
parseJSON (Object d) = BDict <$> parseJSON (Object d)
parseJSON (Null) = pure $ BDict Nil
instance FromJSON v => FromJSON (BDictMap v) where
parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
where
convert (k,v) = (,) (encodeUtf8 k) <$> parseJSON v
parseJSON _ = fail "Not a BDict"
#endif
showBEncode :: BValue -> BL.ByteString
#ifdef BENCODE_AESON
showBEncode b = encodePretty $ toJSON b
#else
showBEncode b = BL8.pack (show b)
#endif
|
