summaryrefslogtreecommitdiff
path: root/src/Data/BEncode/Pretty.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/BEncode/Pretty.hs')
-rw-r--r--src/Data/BEncode/Pretty.hs17
1 files changed, 11 insertions, 6 deletions
diff --git a/src/Data/BEncode/Pretty.hs b/src/Data/BEncode/Pretty.hs
index 7b0d46a0..63efc61c 100644
--- a/src/Data/BEncode/Pretty.hs
+++ b/src/Data/BEncode/Pretty.hs
@@ -38,24 +38,29 @@ quote_chr = ' '
38quote :: Text -> Text 38quote :: Text -> Text
39quote t = quote_chr `T.cons` t `T.snoc` quote_chr 39quote t = quote_chr `T.cons` t `T.snoc` quote_chr
40 40
41encodeByteString :: BS.ByteString -> Text
42encodeByteString s = either (const $ hex s) quote $ decodeUtf8' s
43
44decodeByteString :: Text -> BS.ByteString
45decodeByteString s
46 | T.head s==quote_chr = encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
47 | otherwise = unhex s
41 48
42instance ToJSON BValue where 49instance ToJSON BValue where
43 toJSON (BInteger x) = Number $ fromIntegral x 50 toJSON (BInteger x) = Number $ fromIntegral x
44 toJSON (BString s) = String $ either (const $ hex s) quote $ decodeUtf8' s 51 toJSON (BString s) = String $ encodeByteString s
45 toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs 52 toJSON (BList xs) = Array $ Vector.fromList $ map toJSON xs
46 toJSON (BDict d) = toJSON d 53 toJSON (BDict d) = toJSON d
47 54
48instance ToJSON a => ToJSON (BDictMap a) where 55instance ToJSON a => ToJSON (BDictMap a) where
49 toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d 56 toJSON d = Object $ HashMap.fromList $ map convert $ toAscList d
50 where 57 where
51 convert (k,v) = (decodeUtf8 k,toJSON v) 58 convert (k,v) = (encodeByteString k,toJSON v)
52 59
53instance FromJSON BValue where 60instance FromJSON BValue where
54 parseJSON (Number x) = pure $ BInteger (truncate x) 61 parseJSON (Number x) = pure $ BInteger (truncate x)
55 parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0 62 parseJSON (Bool x) = pure $ BInteger $ if x then 1 else 0
56 parseJSON (String s) 63 parseJSON (String s) = pure $ BString $ decodeByteString s
57 | T.head s==quote_chr = pure $ BString $ encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
58 | otherwise = pure $ BString $ unhex s
59 parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v) 64 parseJSON (Array v) = BList <$> traverse parseJSON (Foldable.toList v)
60 parseJSON (Object d) = BDict <$> parseJSON (Object d) 65 parseJSON (Object d) = BDict <$> parseJSON (Object d)
61 parseJSON (Null) = pure $ BDict Nil 66 parseJSON (Null) = pure $ BDict Nil
@@ -63,7 +68,7 @@ instance FromJSON BValue where
63instance FromJSON v => FromJSON (BDictMap v) where 68instance FromJSON v => FromJSON (BDictMap v) where
64 parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d) 69 parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
65 where 70 where
66 convert (k,v) = (,) (encodeUtf8 k) <$> parseJSON v 71 convert (k,v) = (,) (decodeByteString k) <$> parseJSON v
67 parseJSON _ = fail "Not a BDict" 72 parseJSON _ = fail "Not a BDict"
68#endif 73#endif
69 74