From a4359d2c67811e71368524d17aeb3809dae657da Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 18 Jan 2017 20:13:45 -0500 Subject: Backported to older bytestring. --- bencoding.cabal | 20 +++++++++++----- src/Data/BEncode/Internal.hs | 57 +++++++++++++++++++++++++++++++------------- src/Data/BEncode/Types.hs | 6 +++++ tests/properties.hs | 7 +++++- 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 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 -- cgit v1.2.3