diff options
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r-- | src/Data/BEncode.hs | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 5acab09..5097fe8 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -104,8 +104,8 @@ type Dict = Map ByteString BEncode | |||
104 | -- Lists is not required to be sorted through. | 104 | -- Lists is not required to be sorted through. |
105 | -- Also note that 'BEncode' have JSON-like instance for 'Pretty'. | 105 | -- Also note that 'BEncode' have JSON-like instance for 'Pretty'. |
106 | -- | 106 | -- |
107 | data BEncode = BInteger Int64 | 107 | data BEncode = BInteger {-# UNPACK #-} !Int64 |
108 | | BString ByteString | 108 | | BString !ByteString |
109 | | BList [BEncode] | 109 | | BList [BEncode] |
110 | | BDict Dict | 110 | | BDict Dict |
111 | deriving (Show, Read, Eq, Ord) | 111 | deriving (Show, Read, Eq, Ord) |
@@ -122,6 +122,7 @@ decodingError s = Left ("fromBEncode: unable to decode " ++ s) | |||
122 | {-# INLINE decodingError #-} | 122 | {-# INLINE decodingError #-} |
123 | 123 | ||
124 | instance BEncodable BEncode where | 124 | instance BEncodable BEncode where |
125 | {-# SPECIALIZE instance BEncodable BEncode #-} | ||
125 | toBEncode = id | 126 | toBEncode = id |
126 | {-# INLINE toBEncode #-} | 127 | {-# INLINE toBEncode #-} |
127 | 128 | ||
@@ -129,6 +130,7 @@ instance BEncodable BEncode where | |||
129 | {-# INLINE fromBEncode #-} | 130 | {-# INLINE fromBEncode #-} |
130 | 131 | ||
131 | instance BEncodable Int where | 132 | instance BEncodable Int where |
133 | {-# SPECIALIZE instance BEncodable Int #-} | ||
132 | toBEncode = BInteger . fromIntegral | 134 | toBEncode = BInteger . fromIntegral |
133 | {-# INLINE toBEncode #-} | 135 | {-# INLINE toBEncode #-} |
134 | 136 | ||
@@ -385,7 +387,7 @@ builder = go | |||
385 | B.byteString s | 387 | B.byteString s |
386 | {-# INLINE buildString #-} | 388 | {-# INLINE buildString #-} |
387 | 389 | ||
388 | -- | todo zepto | 390 | -- | TODO try to replace peekChar with something else |
389 | parser :: Parser BEncode | 391 | parser :: Parser BEncode |
390 | parser = valueP | 392 | parser = valueP |
391 | where | 393 | where |
@@ -397,14 +399,20 @@ parser = valueP | |||
397 | case c of | 399 | case c of |
398 | -- if we have digit it always should be string length | 400 | -- if we have digit it always should be string length |
399 | di | di <= '9' -> BString <$> stringP | 401 | di | di <= '9' -> BString <$> stringP |
400 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) | 402 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) |
401 | 'l' -> P.anyChar *> ((BList <$> many valueP) <* P.anyChar) | 403 | 'l' -> P.anyChar *> ((BList <$> listBody) <* P.anyChar) |
402 | 'd' -> do | 404 | 'd' -> do |
403 | P.anyChar | 405 | P.anyChar |
404 | (BDict . M.fromDistinctAscList <$> many ((,) <$> stringP <*> valueP)) | 406 | (BDict . M.fromDistinctAscList <$> many ((,) <$> stringP <*> valueP)) |
405 | <* P.anyChar | 407 | <* P.anyChar |
406 | t -> fail ("bencode unknown tag: " ++ [t]) | 408 | t -> fail ("bencode unknown tag: " ++ [t]) |
407 | 409 | ||
410 | listBody = do | ||
411 | c <- P.peekChar | ||
412 | case c of | ||
413 | Just 'e' -> return [] | ||
414 | _ -> (:) <$> valueP <*> listBody | ||
415 | |||
408 | stringP :: Parser ByteString | 416 | stringP :: Parser ByteString |
409 | stringP = do | 417 | stringP = do |
410 | n <- P.decimal :: Parser Int | 418 | n <- P.decimal :: Parser Int |
@@ -413,8 +421,13 @@ parser = valueP | |||
413 | {-# INLINE stringP #-} | 421 | {-# INLINE stringP #-} |
414 | 422 | ||
415 | integerP :: Parser Int64 | 423 | integerP :: Parser Int64 |
416 | integerP = negate <$> (P.char8 '-' *> P.decimal) | 424 | integerP = do |
417 | <|> P.decimal | 425 | c <- P.peekChar |
426 | case c of | ||
427 | Just '-' -> do | ||
428 | P.anyChar | ||
429 | negate <$> P.decimal | ||
430 | _ -> P.decimal | ||
418 | {-# INLINE integerP #-} | 431 | {-# INLINE integerP #-} |
419 | 432 | ||
420 | -------------------------------- pretty printing ------------------------------- | 433 | -------------------------------- pretty printing ------------------------------- |