DONOTUSE quickcheck tests do not terminate

[functorrent.git] / src / FuncTorrent / Bencode.hs

diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs
index f359465c0d4edf684a4432249ea9eb86d023cd33..fd521dcb58a774bbcc384db8da9b7c1b431e4589 100644 (file)
--- a/src/FuncTorrent/Bencode.hs
+++ b/src/FuncTorrent/Bencode.hs
@@ -33,6 +33,7 @@ import Prelude hiding (length, concat)
 
 import Data.ByteString (ByteString, length, concat)
 import Data.ByteString.Char8 (unpack, pack)
+import Data.Char (isLetter, isNumber, isPrint, isAscii)
 import Data.Map.Strict (Map, fromList, toList)
 import Text.ParserCombinators.Parsec
 import qualified Text.Parsec.ByteString as ParsecBS
@@ -44,6 +45,11 @@ data BVal = Bint Integer
           | Bdict (Map String BVal)
             deriving (Ord, Eq, Show)
 
+genNonEmptyString :: Gen String
+genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") &&
+                                                 (all isAscii s) &&
+                                                 (all isLetter s)))
+
 instance Arbitrary ByteString where
   arbitrary = pack <$> arbitrary
 
@@ -56,7 +62,7 @@ instance Arbitrary BVal where
                 bval n = oneof [ Bint <$> arbitrary
                                , Bstr <$> arbitrary
                                , Blist <$> vectorOf n (bval (n `div` 4))
-                               , do keys <- vectorOf n arbitrary
+                               , do keys <- vectorOf n genNonEmptyString
                                     vals <- vectorOf n (bval (n `div` 4))
                                     return $ Bdict $ fromList $ zip keys vals ]
 
@@ -152,9 +158,14 @@ bencList = between (char 'l') (char 'e') (many bencVal)
 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
 bencDict :: ParsecBS.Parser (Map String BVal)
 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
-  where kvpair = do k <- bencStr
+  where kvpair = do k <- bdictKey
                     v <- bencVal
-                    return (unpack k, v)
+                    return (k, v)
+        bdictKey = do
+          ds <- many1 digit <* char ':'
+          s <- count (read ds) alphaNum
+          return s
+
 
 bencVal :: ParsecBS.Parser BVal
 bencVal = Bstr <$> bencStr <|>
@@ -195,4 +206,4 @@ encode (Bdict d) = concat ["d", concat kvlist, "e"]
     where
       kvlist :: [ByteString]
       kvlist = [encPair kv | kv <- toList d]
-      encPair (k, v) = concat [encode . Bstr . pack $ k, encode v]
+      encPair (k, v) = concat [encode (Bstr (pack k)), encode v]