Backported to older bytestring.

4 files changed, 66 insertions, 24 deletions

diff --git a/bencoding.cabal b/bencoding.cabal
index c6fa2af..eddcd53 100644
--- a/bencoding.cabal
+++ b/bencoding.cabal
@@ -19,6 +19,10 @@ description:
 extra-source-files:    README.md
                      , ChangeLog
 
+flag builder
+  description: Use older bytestring package and bytestring-builder.
+  default: False
+
 source-repository head
   type:                git
   location:            git://github.com/cobit/bencoding.git
@@ -41,15 +45,16 @@ library
   build-depends:       base       == 4.*
                      , ghc-prim
                      , integer-gmp
-                     , deepseq    == 1.3.*
-
+                     , deepseq    >= 1.3
                      , mtl
-
                      , attoparsec >= 0.10
-                     , bytestring >= 0.10
                      , text       >= 0.11
                      , pretty
   ghc-options:         -Wall -O2 -fno-warn-unused-do-bind
+  if flag(builder)
+    build-depends: bytestring >= 0.9, bytestring-builder
+  else
+    build-depends: bytestring >= 0.10
 
 
 test-suite properties
@@ -61,12 +66,15 @@ test-suite properties
                      , ghc-prim
 
                      , containers >= 0.4
-                     , bytestring >= 0.10
                      , attoparsec >= 0.10
 
                      , bencoding
                      , hspec
                      , QuickCheck
+  if flag(builder)
+    build-depends: bytestring >= 0.9, bytestring-builder
+  else
+    build-depends: bytestring >= 0.10
 
   ghc-options:         -Wall -fno-warn-orphans
 
@@ -81,7 +89,7 @@ benchmark bench-comparison
                      , deepseq
 
                      , attoparsec >= 0.10
-                     , bytestring >= 0.10
+                     , bytestring >= 0.9
 
                      , criterion
 
diff --git a/src/Data/BEncode/Internal.hs b/src/Data/BEncode/Internal.hs
index e5ba89c..1532fe6 100644
--- a/src/Data/BEncode/Internal.hs
+++ b/src/Data/BEncode/Internal.hs
@@ -9,6 +9,7 @@
 --   don't need to import this module, use 'Data.BEncode' instead.
 --
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP #-}
 module Data.BEncode.Internal
        ( -- * Parsing
          parser
@@ -26,12 +27,20 @@ import qualified Data.Attoparsec.ByteString.Char8 as P
 import           Data.ByteString as B
 import           Data.ByteString.Internal as B (c2w, w2c)
 import qualified Data.ByteString.Lazy as Lazy
+#if MIN_VERSION_bytestring(0,10,0)
 import qualified Data.ByteString.Lazy.Builder as B
 import qualified Data.ByteString.Lazy.Builder.ASCII as B
+#else
+import qualified Data.ByteString.Builder as B
+-- import qualified Data.ByteString.Builder.ASCII as B
+-- import qualified Data.ByteString.Builder.Internal as B
+#endif
 import Data.Foldable
 import Data.List as L
 import Data.Monoid
 import Text.PrettyPrint hiding ((<>))
+import Data.Char
+import Data.Maybe
 
 import Data.BEncode.Types
 import Data.BEncode.BDict as BD
@@ -74,6 +83,9 @@ builder = go
 build :: BValue -> Lazy.ByteString
 build = B.toLazyByteString . builder
 
+
+sample = "lld10:xOo@-ovQ\b}i8eeded12:]\ENQ89gJp\DC1Y\t!]17:\SOHRQ8\DLE\ESC\NULiUSRo\t.M<gei18eldede8:VX^ejm\SO_d12:.J*\DLEIc\SIV\ESCun\SOHdeede8:tg!\"lU\SOH\DEL1:Pe16:X\EMk\ESCGaek)\DC4'\t+\ESChhei-7e16:<OJ\v9\".i;\DC4[=]_D9de16:$-giCtwedm!\CAN\aA\DC3{dee"
+
 {--------------------------------------------------------------------
 -- Deserialization
 --------------------------------------------------------------------}
@@ -81,45 +93,56 @@ build = B.toLazyByteString . builder
 -- TODO try to replace peekChar with something else
 -- | BEncode format parser according to specification.
 parser :: Parser BValue
-parser = valueP
+parser = valueP Nothing
   where
-    valueP = do
-      mc <- P.peekChar
+    valueP prior = do
+      mc <- maybe (optional P.anyChar) (return . Just) prior
       case mc of
         Nothing -> fail "end of input"
         Just c  ->
             case c of
               -- if we have digit it always should be string length
-              di | di <= '9' -> BString <$> stringP
-              'i' -> P.anyChar *> ((BInteger <$> integerP)  <* P.anyChar)
-              'l' -> P.anyChar *> ((BList    <$> listBodyP) <* P.anyChar)
-              'd' -> P.anyChar *>  (BDict    <$> dictBodyP) <* P.anyChar
+              di | '0' <= di && di <= '9' -> BString <$> stringP c
+              'i' -> ((BInteger <$> integerP)  <* P.char 'e') --  P.anyChar)
+              'l' -> ((BList    <$> listBodyP) ) -- <* P.anyChar)
+              'd' ->  (BDict    <$> dictBodyP) -- <* P.anyChar
               t   -> fail ("bencode unknown tag: " ++ [t])
 
     dictBodyP :: Parser BDict
-    dictBodyP = Cons <$> stringP <*> valueP <*> dictBodyP
-            <|> pure Nil
+    dictBodyP =
+            (P.char 'e' *> pure Nil)
+            <|> do c <- P.satisfy isDigit -- P.anyChar
+                   Cons <$> stringP c <*> valueP Nothing <*> dictBodyP
 
     listBodyP = do
-      c <- P.peekChar
+      c <- optional P.anyChar
       case c of
         Just 'e' -> return []
-        _        -> (:) <$> valueP <*> listBodyP
-
-    stringP :: Parser ByteString
-    stringP = do
-      n <- P.decimal :: Parser Int
+        _        -> (:) <$> valueP c <*> listBodyP
+
+    leadingDigit c zeros n0
+        | n0==(-10) = d * 10^(fromIntegral (B.length zeros))
+        | n0/=0     = d * 10^(fromIntegral (B.length zeros) + truncate (1+logBase 10 (fromIntegral n0))) + n0
+        | otherwise = d * 10
+      where d = fromIntegral $ ord c - 48
+
+    stringP :: Char -> Parser ByteString
+    stringP c = do
+      zeros <- P.takeWhile (=='0')
+      n0 <- (P.decimal <|> pure (-10)) :: Parser Int
+      let n = leadingDigit c zeros n0
       P.char ':'
       P.take n
     {-# INLINE stringP #-}
 
     integerP :: Parser Integer
     integerP = do
-      c <- P.peekChar
+      c <- optional P.anyChar
       case c of
         Just '-' -> do
-          P.anyChar
           negate <$> P.decimal
+        Just c'  ->  do zeros <- P.takeWhile (=='0')
+                        leadingDigit c' zeros <$> (P.decimal <|> pure (-10))
         _        ->  P.decimal
     {-# INLINE integerP #-}
 
diff --git a/src/Data/BEncode/Types.hs b/src/Data/BEncode/Types.hs
index 15f570f..c1e1f01 100644
--- a/src/Data/BEncode/Types.hs
+++ b/src/Data/BEncode/Types.hs
@@ -7,6 +7,7 @@
 --
 --   Types for working with bencode data.
 --
+{-# LANGUAGE CPP #-}
 module Data.BEncode.Types
        ( -- * Types
          BInteger
@@ -51,6 +52,11 @@ data BValue
   | BDict     BDict    -- ^ bencode key-value dictionary.
     deriving (Show, Read, Eq, Ord)
 
+#if !MIN_VERSION_bytestring(0,10,0)
+instance NFData ByteString where
+    rnf s = seq s ()
+#endif
+
 instance NFData BValue where
     rnf (BInteger i) = rnf i
     rnf (BString  s) = rnf s
diff --git a/tests/properties.hs b/tests/properties.hs
index 876b954..478dd8c 100644
--- a/tests/properties.hs
+++ b/tests/properties.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS  -fno-warn-unused-binds #-}
 module Main (main) where
 
@@ -55,8 +56,12 @@ instance Arbitrary FileInfo where
 
 data T a = T
 
+#if !MIN_VERSION_bytestring(0,10,0)
+toStrict bs = BS.concat $ BL.toChunks bs
+#endif
+
 prop_bencodable :: Eq a => BEncode a => T a -> a -> Bool
-prop_bencodable _ x = decode (BL.toStrict (encode x)) == Right x
+prop_bencodable _ x = decode (toStrict (encode x)) == Right x
 
 main :: IO ()
 main = hspec $ do