3 import Control.Applicative ((<*))
4 import Data.ByteString.Char8 (ByteString, pack, unpack)
5 import Data.Functor ((<$>))
6 import Data.Map.Strict (Map, fromList, keys, (!))
7 import Text.ParserCombinators.Parsec
8 import qualified Text.Parsec.ByteString as ParsecBS
10 data BVal = Bint Integer
14 deriving (Ord, Eq, Show)
16 type InfoDict = Map BVal BVal
19 -- >>> import Data.Either
23 -- >>> parse bencStr "Bstr" (pack "4:spam")
25 -- >>> parse bencStr "Bstr" (pack "0:")
27 -- >>> parse bencStr "Bstr" (pack "0:hello")
30 bencStr :: ParsecBS.Parser ByteString
31 bencStr = do _ <- spaces
32 ds <- many1 digit <* char ':'
33 s <- count (read ds) anyChar
38 -- >>> parse bencInt "Bint" (pack "i42e")
40 -- >>> parse bencInt "Bint" (pack "i123e")
42 -- >>> parse bencInt "Bint" (pack "i1e")
44 -- >>> parse bencInt "Bint" (pack "i0e")
46 -- >>> parse bencInt "Bint" (pack "i-1e")
48 -- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
50 -- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
52 -- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
54 bencInt :: ParsecBS.Parser Integer
55 bencInt = do _ <- spaces
56 ds <- between (char 'i') (char 'e') numbers
58 where numbers = do d' <- char '-' <|> digit
61 parseNumber '0' [] = return "0"
62 parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
63 parseNumber '-' [] = unexpected "sign without any digits"
64 parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
65 parseNumber d'' ds'' = return (d'':ds'')
69 -- >>> parse bencList "Blist" (pack "le")
71 -- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
72 -- Right ["spam","eggs"]
73 -- >>> parse bencList "Blist" (pack "l4:spami42ee")
75 -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
76 -- Right ["spam","eggs",[42]]
77 bencList :: ParsecBS.Parser [BVal]
78 bencList = do _ <- spaces
79 between (char 'l') (char 'e') (many bencVal)
83 -- >>> parse bencDict "Bdict" (pack "de")
84 -- Right (fromList [])
85 -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
86 -- Right (fromList [("cow","moo"),("spam","eggs")])
87 -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
88 -- Right (fromList [("spam",["a","b"])])
89 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
90 -- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")])
91 bencDict :: ParsecBS.Parser (Map BVal BVal)
92 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
93 where kvpair = do k <- bencStr
97 bencVal :: ParsecBS.Parser BVal
98 bencVal = Bstr <$> bencStr <|>
100 Blist <$> bencList <|>
103 decode :: ByteString -> Either ParseError BVal
104 decode = parse bencVal "BVal"
106 -- given an input dict or int or string, encode
107 -- it into a bencoded bytestring.
108 -- | encode bencoded-values
110 -- >>> encode (Bstr (pack ""))
112 -- >>> encode (Bstr (pack "spam"))
114 -- >>> encode (Bint 0)
116 -- >>> encode (Bint 42)
118 -- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
120 -- >>> encode (Blist [])
122 -- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")]))
124 encode :: BVal -> String
125 encode (Bstr bs) = let s = unpack bs
126 in show (length s) ++ ":" ++ s
127 encode (Bint i) = "i" ++ show i ++ "e"
128 encode (Blist xs) = "l" ++ encodeList xs ++ "e"
129 where encodeList = foldr ((++) . encode) ""
130 encode (Bdict d) = "d" ++ encodeDict d ++ "e"
131 where encodeDict m = concat [encode k ++ encode (m ! k) | k <- keys m]