summaryrefslogtreecommitdiff
path: root/src/Data/BEncode.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/BEncode.hs')
-rw-r--r--src/Data/BEncode.hs27
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--
107data BEncode = BInteger Int64 107data 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
124instance BEncodable BEncode where 124instance 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
131instance BEncodable Int where 132instance 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
389parser :: Parser BEncode 391parser :: Parser BEncode
390parser = valueP 392parser = 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 -------------------------------