From a4359d2c67811e71368524d17aeb3809dae657da Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Wed, 18 Jan 2017 20:13:45 -0500
Subject: Backported to older bytestring.

---
 src/Data/BEncode/Internal.hs | 57 +++++++++++++++++++++++++++++++-------------
 src/Data/BEncode/Types.hs    |  6 +++++
 2 files changed, 46 insertions(+), 17 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3