From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Wed, 4 Feb 2015 09:32:16 +0000 (+0530)
Subject: much better handling of bencode integers
X-Git-Url: https://git.rkrishnan.org/?a=commitdiff_plain;h=6486894bfc71ea04b77cf4912d169763b64ca629;p=functorrent.git

much better handling of bencode integers
---

diff --git a/src/Bencode.hs b/src/Bencode.hs
index adc6d1a..1fb2a31 100644
--- a/src/Bencode.hs
+++ b/src/Bencode.hs
@@ -17,6 +17,9 @@ data BVal =
   | Bdict (M.Map BVal BVal)
   deriving (Ord, Eq)
 
+-- $setup
+-- >>> import Data.Either
+
 -- | parse strings
 --
 -- >>> parse bencStr "Bstr" (BC.pack "4:spam")
@@ -36,21 +39,33 @@ bencStr = do _ <- spaces
 --
 -- >>> parse bencInt "Bint" (BC.pack "i42e")
 -- Right 42
+-- >>> parse bencInt "Bint" (BC.pack "i123e")
+-- Right 123
 -- >>> parse bencInt "Bint" (BC.pack "i1e")
 -- Right 1
 -- >>> parse bencInt "Bint" (BC.pack "i0e")
 -- Right 0
 -- >>> parse bencInt "Bint" (BC.pack "i-1e")
 -- Right (-1)
+-- >>> isLeft $ parse bencInt "Bint" (BC.pack "i01e")
+-- True
+-- >>> isLeft $ parse bencInt "Bint" (BC.pack "i00e")
+-- True
+-- >>> isLeft $ parse bencInt "Bint" (BC.pack "i002e")
+-- True
 bencInt :: ParsecBS.Parser Integer
 bencInt = do _ <- spaces
              ds <- between (char 'i') (char 'e') numbers
              return (read ds)
                where numbers = do d' <- (char '-' <|> digit)
                                   ds' <- many digit
-                                  if d' == '0' && ds' /= []
-                                    then unexpected "numbers cannot be left-padded with zeros"
-                                    else return (d' : ds')
+                                  parseNumber d' ds'
+                     parseNumber '0' []  = return ['0']
+                     parseNumber '-' []  = unexpected "sign without any digits"
+                     parseNumber '0' ds'' = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber '-' (d'':ds'') | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber '-' ds'' = return ('-':ds'')
+                     parseNumber d'' ds'' = return (d'':ds'')
 
 bencParser :: ParsecBS.Parser BVal
 bencParser = Bstr <$> bencStr <|>