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