More robust unicode handling.

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 = ' '
 quote :: Text -> Text
 quote t = quote_chr `T.cons` t `T.snoc` quote_chr
 
+encodeByteString :: BS.ByteString -> Text
+encodeByteString s = either (const $ hex s) quote $ decodeUtf8' s
+
+decodeByteString :: Text -> BS.ByteString
+decodeByteString s
+        | T.head s==quote_chr = encodeUtf8 (T.takeWhile (/=quote_chr) $ T.drop 1 s)
+        | otherwise           = unhex s
 
 instance ToJSON BValue where
     toJSON (BInteger x) = Number $ fromIntegral x
-    toJSON (BString s) = String $ either (const $ hex s) quote $ decodeUtf8' s
+    toJSON (BString s) = String $ encodeByteString 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)
+        convert (k,v) = (encodeByteString 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 (String s) = pure $ BString $ decodeByteString s
     parseJSON (Array v)  = BList <$> traverse parseJSON (Foldable.toList v)
     parseJSON (Object d) = BDict <$> parseJSON (Object d)
     parseJSON (Null)     = pure $ BDict Nil
@@ -63,7 +68,7 @@ instance FromJSON BValue where
 instance FromJSON v => FromJSON (BDictMap v) where
     parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
         where
-            convert (k,v) = (,) (encodeUtf8 k) <$> parseJSON v
+            convert (k,v) = (,) (decodeByteString k) <$> parseJSON v
     parseJSON _ = fail "Not a BDict"
 #endif