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