diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2018-09-18 Sergey Vinokurov + + * 0.4.4.0: Fix build for GHC 8.0-8.4. Derive Generic instances. Add Semigroup instance. + 2013-12-19 Sam Truzjan * 0.4.3.0: Add lookAhead and match functions. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ ### Description This package implements fast seamless encoding/decoding to/from -bencode format for many native datatypes. To achive +bencode format for many native datatypes. To achieve [more performance][cmp] we use [bytestring builders][bytestring-builder] and hand optimized [attoparsec][attoparsec] parser so this library is considered as @@ -40,7 +40,7 @@ [![Build Status][travis-img]][travis-log] -### Maintainer +### Maintainer Feel free to report bugs and suggestions via [issue tracker][issues] or the mail. @@ -53,8 +53,8 @@ [attoparsec]: http://hackage.haskell.org/package/attoparsec-0.10.4.0 [bytestring-builder]: http://hackage.haskell.org/packages/archive/bytestring/0.10.2.0/doc/html/Data-ByteString-Builder.html -[travis-img]: https://travis-ci.org/cobit/bencoding.png -[travis-log]: https://travis-ci.org/cobit/bencoding +[travis-img]: https://travis-ci.org/sergv/bencoding.svg?branch=master +[travis-log]: https://travis-ci.org/sergv/bencoding [hackage]: http://hackage.haskell.org/package/bencoding -[issues]: https://github.com/cobit/bencoding/issues +[issues]: https://github.com/sergv/bencoding/issues diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,9 +1,18 @@ -{-# LANGUAGE PackageImports #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RecordWildCards #-} + +#if __GLASGOW_HASKELL__ < 800 +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +#else +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Main (main) where import Control.DeepSeq @@ -180,7 +189,8 @@ , let Right !be = C.parse torrentFile id' x = let t = either error id (fromBEncode x) in toBEncode (t :: Torrent) - !_ = let Right t = C.decode torrentFile + !_unused@True = + let Right t = C.decode torrentFile in if C.decode (BL.toStrict (C.encode t)) /= Right (t :: Torrent) then error "invalid instance: BEncode Torrent" diff --git a/bencoding.cabal b/bencoding.cabal --- a/bencoding.cabal +++ b/bencoding.cabal @@ -1,18 +1,18 @@ name: bencoding -version: 0.4.3.0 +version: 0.4.4.0 license: BSD3 license-file: LICENSE author: Sam Truzjan -maintainer: Sam Truzjan -copyright: (c) 2013, Sam Truzjan +maintainer: Sergey Vinokurov +copyright: (c) 2013-2018, Sam Truzjan + (c) 2018 Sergey Vinokurov category: Data build-type: Simple stability: Experimental cabal-version: >= 1.10 -tested-with: GHC == 7.4.1 - , GHC == 7.6.3 -homepage: https://github.com/cobit/bencoding -bug-reports: https://github.com/cobit/bencoding/issues +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3 +homepage: https://github.com/sergv/bencoding +bug-reports: https://github.com/sergv/bencoding/issues synopsis: A library for encoding and decoding of BEncode data. description: A library for fast and easy encoding and decoding of BEncode data. @@ -22,34 +22,62 @@ source-repository head type: git - location: git://github.com/cobit/bencoding.git + location: https://github.com/sergv/bencoding.git branch: master source-repository this type: git - location: git://github.com/cobit/bencoding.git + location: https://github.com/sergv/bencoding.git branch: master - tag: v0.4.3.0 + tag: v0.4.4.0 +flag dev + description: + Enable development options + default: + False + manual: + True + library default-language: Haskell2010 - default-extensions: PatternGuards hs-source-dirs: src exposed-modules: Data.BEncode , Data.BEncode.BDict , Data.BEncode.Internal , Data.BEncode.Types - build-depends: base == 4.* + build-depends: base >= 4.4 && < 5 , ghc-prim - , deepseq == 1.3.* + , integer-gmp + , deepseq >= 1.3 + , mtl , attoparsec >= 0.10 - , bytestring >= 0.10.0.2 + , bytestring >= 0.10 , text >= 0.11 , pretty - ghc-options: -Wall -O2 -fno-warn-unused-do-bind + ghc-options: -Wall -O2 + if !impl(ghc >= 8.0.0) + build-depends: semigroups >= 0.9 && < 0.19 + if flag(dev) + ghc-options: + -fwarn-name-shadowing + -Werror + if impl(ghc >= 8.0) + ghc-options: + -Wcompat + -Whi-shadowing + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-exported-signatures + if impl(ghc >= 8.2) + ghc-options: + -Wcpp-undef + -Wmissing-home-modules + -Wunbanged-strict-patterns test-suite properties type: exitcode-stdio-1.0 @@ -60,16 +88,34 @@ , ghc-prim , containers >= 0.4 - , bytestring >= 0.10.0.2 + , bytestring >= 0.10 , attoparsec >= 0.10 , bencoding , hspec , QuickCheck - ghc-options: -Wall -fno-warn-orphans + ghc-options: -Wall + if flag(dev) + ghc-options: + -fwarn-name-shadowing + -Werror + if impl(ghc >= 8.0) + ghc-options: + -Wcompat + -Whi-shadowing + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-exported-signatures + if impl(ghc >= 8.2) + ghc-options: + -Wcpp-undef + -Wmissing-home-modules + -Wunbanged-strict-patterns + benchmark bench-comparison type: exitcode-stdio-1.0 default-language: Haskell2010 @@ -80,11 +126,29 @@ , deepseq , attoparsec >= 0.10 - , bytestring >= 0.10.0.2 + , bytestring >= 0.10 , criterion , bencoding , bencode >= 0.5 , AttoBencode >= 0.2 - ghc-options: -O2 -Wall -fno-warn-orphans + ghc-options: -O2 -Wall + + if flag(dev) + ghc-options: + -fwarn-name-shadowing + -Werror + if impl(ghc >= 8.0) + ghc-options: + -Wcompat + -Whi-shadowing + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-exported-signatures + if impl(ghc >= 8.2) + ghc-options: + -Wcpp-undef + -Wmissing-home-modules + -Wunbanged-strict-patterns diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs @@ -96,11 +96,15 @@ import Control.Applicative import Control.Monad import Control.Monad.State +#if MIN_VERSION_mtl(2, 2, 0) +import Control.Monad.Except +#else import Control.Monad.Error +#endif import Data.Int import Data.List as L -import Data.Monoid -import Data.Word (Word8, Word16, Word32, Word64, Word) +import Data.Semigroup ((<>)) +import Data.Word (Word8, Word16, Word32, Word64) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as Lazy @@ -110,6 +114,11 @@ import Data.Version import qualified Text.ParserCombinators.ReadP as ReadP +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid (Monoid (mempty)) +import Data.Word (Word) +#endif + #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics #endif @@ -251,7 +260,7 @@ selRename :: String -> String selRename = dropWhile ('_'==) -gfromM1S :: forall c. Selector c +gfromM1S :: forall c f i p. Selector c => GBEncodable f BValue => BDict -> Result (M1 i c f p) gfromM1S dict diff --git a/src/Data/BEncode/BDict.hs b/src/Data/BEncode/BDict.hs --- a/src/Data/BEncode/BDict.hs +++ b/src/Data/BEncode/BDict.hs @@ -9,6 +9,10 @@ -- which both faster and more suitable for bencode dictionaries than -- just [(k,v)]. -- + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} + module Data.BEncode.BDict ( BKey , BDictMap (..) @@ -25,8 +29,12 @@ -- * Combine , Data.BEncode.BDict.union - -- * Traversal + -- * Maps , Data.BEncode.BDict.map + , Data.BEncode.BDict.mapWithKey + + -- * Folds + , Data.BEncode.BDict.foldMapWithKey , Data.BEncode.BDict.bifoldMap -- * Conversion @@ -36,9 +44,12 @@ import Control.DeepSeq import Data.ByteString as BS +#if __GLASGOW_HASKELL__ < 710 import Data.Foldable -import Data.Monoid - +import Data.Monoid (Monoid (mappend, mempty)) +#endif +import Data.Semigroup (Semigroup ((<>))) +import GHC.Generics (Generic) type BKey = ByteString @@ -53,7 +64,7 @@ data BDictMap a = Cons !BKey a !(BDictMap a) | Nil - deriving (Show, Read, Eq, Ord) + deriving (Show, Read, Eq, Ord, Generic) instance NFData a => NFData (BDictMap a) where rnf Nil = () @@ -70,9 +81,12 @@ go (Cons _ v xs) = f v `mappend` go xs {-# INLINE foldMap #-} +instance Semigroup (BDictMap a) where + (<>) = Data.BEncode.BDict.union + instance Monoid (BDictMap a) where mempty = Data.BEncode.BDict.empty - mappend = Data.BEncode.BDict.union + mappend = (<>) -- | /O(1)/. The empty dicionary. empty :: BDictMap a @@ -127,14 +141,30 @@ go (Cons k v xs) = Cons k (f v) (go xs) {-# INLINE map #-} +-- | /O(n)./ Map a function over all keys\/value pairs in the dictionary. +mapWithKey :: (BKey -> a -> b) -> BDictMap a -> BDictMap b +mapWithKey f = go + where + go Nil = Nil + go (Cons k v xs) = Cons k (f k v) (go xs) +{-# INLINE mapWithKey #-} + -- | /O(n)/. Map each key\/value pair to a monoid and fold resulting -- sequnce using 'mappend'. -- -bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m -bifoldMap f = go +foldMapWithKey :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m +foldMapWithKey f = go where go Nil = mempty go (Cons k v xs) = f k v `mappend` go xs +{-# INLINE foldMapWithKey #-} + +{-# DEPRECATED bifoldMap "Use foldMapWithKey instead" #-} +-- | /O(n)/. Map each key\/value pair to a monoid and fold resulting +-- sequnce using 'mappend'. +-- +bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m +bifoldMap = foldMapWithKey {-# INLINE bifoldMap #-} -- | /O(n)/. Build a dictionary from a list of key\/value pairs where diff --git a/src/Data/BEncode/Internal.hs b/src/Data/BEncode/Internal.hs --- a/src/Data/BEncode/Internal.hs +++ b/src/Data/BEncode/Internal.hs @@ -8,6 +8,8 @@ -- This module provides bencode values serialization. Normally, you -- don't need to import this module, use 'Data.BEncode' instead. -- +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} module Data.BEncode.Internal ( -- * Parsing parser @@ -23,42 +25,50 @@ import Data.Attoparsec.ByteString.Char8 (Parser) 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 import qualified Data.ByteString.Lazy.Builder as B -import qualified Data.ByteString.Lazy.Builder.ASCII as B -import Data.ByteString.Internal as B (c2w, w2c) -import Data.Foldable import Data.List as L -import Data.Monoid import Text.PrettyPrint hiding ((<>)) +#if __GLASGOW_HASKELL__ < 710 +import Data.Foldable +import Data.Monoid (Monoid (mappend)) +#endif + import Data.BEncode.Types import Data.BEncode.BDict as BD +import GHC.Types +import GHC.Integer.GMP.Internals {-------------------------------------------------------------------- -- Serialization --------------------------------------------------------------------} +integerDecimal :: Integer -> B.Builder +integerDecimal (S# i#) = B.intDec (I# i#) +integerDecimal i = B.string7 (show i) -- TODO more efficient + -- | BEncode format encoder according to specification. builder :: BValue -> B.Builder builder = go where - go (BInteger i) = B.word8 (c2w 'i') <> - B.integerDec i <> + go (BInteger i) = B.word8 (c2w 'i') `mappend` + integerDecimal i `mappend` B.word8 (c2w 'e') go (BString s) = buildString s - go (BList l) = B.word8 (c2w 'l') <> - foldMap go l <> + go (BList l) = B.word8 (c2w 'l') `mappend` + foldMap go l `mappend` B.word8 (c2w 'e') - go (BDict d) = B.word8 (c2w 'd') <> - bifoldMap mkKV d <> + go (BDict d) = B.word8 (c2w 'd') `mappend` + foldMapWithKey mkKV d `mappend` B.word8 (c2w 'e') where - mkKV k v = buildString k <> go v + mkKV k v = buildString k `mappend` go v - buildString s = B.intDec (B.length s) <> - B.word8 (c2w ':') <> + buildString s = B.intDec (B.length s) `mappend` + B.word8 (c2w ':') `mappend` B.byteString s {-# INLINE buildString #-} @@ -102,7 +112,7 @@ stringP :: Parser ByteString stringP = do n <- P.decimal :: Parser Int - P.char ':' + _ <- P.char ':' P.take n {-# INLINE stringP #-} @@ -111,7 +121,7 @@ c <- P.peekChar case c of Just '-' -> do - P.anyChar + _ <- P.anyChar negate <$> P.decimal _ -> P.decimal {-# INLINE integerP #-} diff --git a/src/Data/BEncode/Types.hs b/src/Data/BEncode/Types.hs --- a/src/Data/BEncode/Types.hs +++ b/src/Data/BEncode/Types.hs @@ -6,7 +6,9 @@ -- Portability : portable -- -- Types for working with bencode data. --- + +{-# LANGUAGE DeriveGeneric #-} + module Data.BEncode.Types ( -- * Types BInteger @@ -24,6 +26,7 @@ import Control.DeepSeq import Data.ByteString +import GHC.Generics (Generic) import Data.BEncode.BDict @@ -49,7 +52,7 @@ | BString !BString -- ^ bencode strings; | BList BList -- ^ list of bencode values; | BDict BDict -- ^ bencode key-value dictionary. - deriving (Show, Read, Eq, Ord) + deriving (Show, Read, Eq, Ord, Generic) instance NFData BValue where rnf (BInteger i) = rnf i diff --git a/tests/properties.hs b/tests/properties.hs --- a/tests/properties.hs +++ b/tests/properties.hs @@ -1,11 +1,10 @@ {-# LANGUAGE DeriveGeneric #-} -{-# OPTIONS -fno-warn-unused-binds #-} +{-# OPTIONS -fno-warn-orphans #-} module Main (main) where -import Control.Applicative +import Control.Applicative as A import Data.ByteString as BS import Data.ByteString.Lazy as BL -import Data.List as L import GHC.Generics import Test.QuickCheck import Test.Hspec @@ -13,23 +12,30 @@ import Data.BEncode import qualified Data.BEncode.BDict as BE +smaller :: Gen a -> Gen a +smaller = scale (* factor) + where + factor = 9 `div` 10 instance Arbitrary BS.ByteString where arbitrary = BS.pack <$> arbitrary + shrink = fmap BS.pack . shrink . BS.unpack instance Arbitrary a => Arbitrary (BE.BDictMap a) where arbitrary = frequency - [ (90, pure BE.Nil) + [ (90, A.pure BE.Nil) , (10, BE.Cons <$> arbitrary <*> arbitrary <*> arbitrary) ] + shrink = genericShrink instance Arbitrary BValue where arbitrary = frequency [ (30, BInteger <$> arbitrary) , (30, BString <$> arbitrary) - , (20, BList <$> (arbitrary `suchThat` ((10 >) . L.length))) - , (20, BDict <$> arbitrary) + , (20, BList <$> smaller arbitrary) + , (20, BDict <$> smaller arbitrary) ] + shrink = genericShrink data List a = Cons a (List a) | Nil deriving (Show, Eq, Generic) @@ -41,17 +47,19 @@ [ (90, pure Nil) , (10, Cons <$> arbitrary <*> arbitrary) ] + shrink = genericShrink data FileInfo = FileInfo - { fiLength :: !Integer - , fiPath :: [BS.ByteString] - , fiMD5Sum :: BS.ByteString + { _fiLength :: !Integer + , _fiPath :: [BS.ByteString] + , _fiMD5Sum :: BS.ByteString } deriving (Show, Eq, Generic) instance BEncode FileInfo instance Arbitrary FileInfo where arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary + shrink = genericShrink data T a = T