summaryrefslogtreecommitdiff
path: root/src/Data/BEncode/Pretty.hs
blob: 8beb101b811b5be0f2380f5e3ac3a476c88def73 (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
76
77
78
79
80
81
{-# 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 Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.ByteString.Base16 as Base16
#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
#endif

{-
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
-}

#ifdef BENCODE_AESON

quote_chr :: Char
quote_chr = ' '

quote :: Text -> Text
quote t = quote_chr `T.cons` t `T.snoc` quote_chr

encodeByteString :: BS.ByteString -> Text
encodeByteString s = either (const . decodeUtf8 $ Base16.encode 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           = fst (Base16.decode (encodeUtf8 s))

instance ToJSON BValue where
    toJSON (BInteger x) = Number $ fromIntegral x
    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) = (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) = 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

instance FromJSON v => FromJSON (BDictMap v) where
    parseJSON (Object d) = fromAscList <$> traverse convert (HashMap.toList d)
        where
            convert (k,v) = (,) (decodeByteString 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