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