August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-tasty-dejafu for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty-dejafu for openSUSE:Factory checked in at 2017-08-31 21:00:14 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty-dejafu (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty-dejafu.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty-dejafu" Thu Aug 31 21:00:14 2017 rev:3 rq:513509 version:0.6.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty-dejafu/ghc-tasty-dejafu.changes 2017-04-18 13:51:00.393305099 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty-dejafu.new/ghc-tasty-dejafu.changes 2017-08-31 21:00:15.543419287 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:02 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.0.0. + +------------------------------------------------------------------- Old: ---- tasty-dejafu-0.3.0.2.tar.gz New: ---- tasty-dejafu-0.6.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty-dejafu.spec ++++++ --- /var/tmp/diff_new_pack.ImStsy/_old 2017-08-31 21:00:16.487286671 +0200 +++ /var/tmp/diff_new_pack.ImStsy/_new 2017-08-31 21:00:16.487286671 +0200 @@ -18,7 +18,7 @@ %global pkg_name tasty-dejafu Name: ghc-%{pkg_name} -Version: 0.3.0.2 +Version: 0.6.0.0 Release: 0 Summary: Deja Fu support for the Tasty test framework License: MIT @@ -27,6 +27,7 @@ Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-dejafu-devel +BuildRequires: ghc-random-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-tagged-devel BuildRequires: ghc-tasty-devel @@ -38,8 +39,6 @@ tasty>. This lets you easily incorporate concurrency testing into your existing test suites. -See the <https://github.com/barrucadu/dejafu README> for more details. - %package devel Summary: Haskell %{pkg_name} library development files Group: Development/Libraries/Other @@ -72,5 +71,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc CHANGELOG.markdown README.markdown %changelog ++++++ tasty-dejafu-0.3.0.2.tar.gz -> tasty-dejafu-0.6.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-dejafu-0.3.0.2/CHANGELOG.markdown new/tasty-dejafu-0.6.0.0/CHANGELOG.markdown --- old/tasty-dejafu-0.3.0.2/CHANGELOG.markdown 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-dejafu-0.6.0.0/CHANGELOG.markdown 2017-06-07 18:08:42.000000000 +0200 @@ -0,0 +1,163 @@ +Release Notes +============= + +All notable changes to this project will be documented in this file. + +This project is versioned according to the [Package Versioning Policy](https://pvp.haskell.org), the +*de facto* standard Haskell versioning scheme. + + +0.6.0.0 [2017-04-08] (git tag: [tasty-dejafu-0.6.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.6.0.0 + +### Test.Tasty.DejaFu + +- The refinement property testing functionality of dejafu is exposed in the new `testProperty` + function, and re-exported values. +- Due to changes in dejafu, the `Way` type is now abstract and exposes smart constructor functions: + - `systematically`, corresponding to the old `Systematically`. + - `randomly`, corresponding to the old `Randomly`. + - `uniformly`, a new uniform random (as opposed to weighted random) scheduler. + - `swarmy`, corresponding to the old `Randomly` and specifying how many executions to use the + same weights for. +- The `defaultWay`, `defaultMemType`, and `defaultBounds` values are all now re-exported. + +### Miscellaneous + +- Only dejafu 0.7 is supported. + +[tasty-dejafu-0.6.0.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.6.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.5.0.0 [2017-04-08] (git tag: [tasty-dejafu-0.5.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.5.0.0 + +### Test.Tasty.DejaFu + +- Due to changes in dejafu, the `Way` type no longer takes a parameter; it is now a GADT. + +### Miscellaneous + +- There is now a changelog. +- Every definition and instance now has a Haddock "@since" annotation. +- Only dejafu 0.6 is supported. + +[tasty-dejafu-0.5.0.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.5.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.4.0.0 [2017-02-21] (git tag: [tasty-dejafu-0.4.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.4.0.0 + +### Test.Tasty.DejaFu + +- All the functions which did take a `Bounds` now take a `Way` instead and support random scheduling + as well. +- The `Way` type from dejafu is now re-exported. +- The `IsOption` instance (and so corresponding command-line argument) for `Bounds` is gone. +- A new `IsOption` instance for `Way` (and so corresponding command-line argument): + - "systematically": systematic testing with the default bounds. + - "randomly": 100 executions with a fixed random seed. + +### Miscellaneous + +- The minimum supported version of dejafu has been increased to 0.5 (from 0.2) + +[tasty-dejafu-0.4.0.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.4.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.2 [2016-09-10] (git tag: [tasty-dejafu-0.3.0.2][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.3.0.2 + +### Miscellaneous + +- Now supports concurrency 1.0.0.0 and dejafu 0.4.0.0 + +[tasty-dejafu-0.3.0.2]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.3.0.2 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.1 [2016-05-26] (git tag: [tasty-dejafu-0.3.0.1][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.3.0.1 + +### Miscellaneous + +- Now supports GHC 8. + +[tasty-dejafu-0.3.0.1]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.3.0.1 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.0 [2016-04-28] (git tag: [tasty-dejafu-0.3.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.3.0.0 + +### Test.Tasty.DejaFu + +- New `IsTest` instances for `ConcST t (Maybe String)` and `ConcIO (Maybe String)`, with a `Just + String` result being a test failure with an error message. +- The `Bounds` type from dejafu is now re-exported. +- New `IsOption` instances for `Bounds` and `MemType`. +- New command-line parameter to set the `MemType` parameter: + - "sc": sequential consistency. + - "tso": total store order. + - "pso": partial store order. + +### Miscellaneous + +- Now supports dejafu 0.2 (again). + +[tasty-dejafu-0.3.0.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.3.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.1.1.0 [2016-04-03] (git tag: [tasty-dejafu-0.1.1.0][]) +------- + +**This version was never pushed to hackage, whoops!** + +**This version was misnumbered! It should have been 0.2.1.0!** + +### Miscellaneous + +- Now supports dejafu 0.3, but drops support for dejafu 0.2. + +[tasty-dejafu-0.1.1.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.1.1.0 + + +--------------------------------------------------------------------------------------------------- + + +0.2.0.0 [2015-12-01] (git tag: [0.2.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.2.0.0 + +Initial release. Go read the API docs. + +[0.2.0.0]: https://github.com/barrucadu/dejafu/releases/tag/0.2.0.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-dejafu-0.3.0.2/README.markdown new/tasty-dejafu-0.6.0.0/README.markdown --- old/tasty-dejafu-0.3.0.2/README.markdown 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-dejafu-0.6.0.0/README.markdown 2016-05-26 17:52:10.000000000 +0200 @@ -0,0 +1,21 @@ +tasty-dejafu +============ + +Integration between the [dejafu][] library for concurrency testing and +[tasty][]. This lets you easily incorporate concurrency testing into +your existing test suites. + +The documentation of the latest developmental version is +[available online][docs]. + +Contributing +------------ + +Bug reports, pull requests, and comments are very welcome! + +Feel free to contact me on GitHub, through IRC (#haskell on freenode), +or email (mike(a)barrucadu.co.uk) + +[docs]: https://docs.barrucadu.co.uk/tasty-dejafu +[dejafu]: https://hackage.haskell.org/package/dejafu +[tasty]: https://hackage.haskell.org/package/tasty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-dejafu-0.3.0.2/Setup.hs new/tasty-dejafu-0.6.0.0/Setup.hs --- old/tasty-dejafu-0.3.0.2/Setup.hs 2016-04-13 01:32:08.000000000 +0200 +++ new/tasty-dejafu-0.6.0.0/Setup.hs 2017-04-08 06:43:07.000000000 +0200 @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-dejafu-0.3.0.2/Test/Tasty/DejaFu.hs new/tasty-dejafu-0.6.0.0/Test/Tasty/DejaFu.hs --- old/tasty-dejafu-0.3.0.2/Test/Tasty/DejaFu.hs 2016-08-28 15:57:25.000000000 +0200 +++ new/tasty-dejafu-0.6.0.0/Test/Tasty/DejaFu.hs 2017-06-07 18:08:50.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} @@ -16,7 +17,7 @@ -- License : MIT -- Maintainer : Michael Walker <mike(a)barrucadu.co.uk> -- Stability : stable --- Portability : CPP, FlexibleInstances, GADTs, ImpredicativeTypes, RankNTypes, TypeSynonymInstances +-- Portability : CPP, FlexibleContexts, FlexibleInstances, GADTs, ImpredicativeTypes, RankNTypes, TypeSynonymInstances -- -- This module allows using Deja Fu predicates with Tasty to test the -- behaviour of concurrent systems. @@ -37,90 +38,102 @@ , testDejafu , testDejafus - , testAuto' - , testDejafu' - , testDejafus' + , testAutoWay + , testDejafuWay + , testDejafusWay -- ** @IO@ , testAutoIO , testDejafuIO , testDejafusIO - , testAutoIO' - , testDejafuIO' - , testDejafusIO' - - -- * Re-exports + , testAutoWayIO + , testDejafuWayIO + , testDejafusWayIO + + -- ** Re-exports + , Way + , defaultWay + , systematically + , randomly + , uniformly + , swarmy , Bounds(..) + , defaultBounds , MemType(..) + , defaultMemType + + -- * Refinement property testing + , testProperty + + -- ** Re-exports + , R.Sig(..) + , R.RefinementProperty + , R.Testable(..) + , R.Listable(..) + , R.expectFailure + , R.refines, (R.=>=) + , R.strictlyRefines, (R.->-) + , R.equivalentTo, (R.===) ) where -import Control.Monad.ST (runST) -import Data.Char (toUpper) -import Data.List (intercalate, intersperse) -import Data.Proxy (Proxy(..)) -import Data.Tagged (Tagged(..)) -import Data.Typeable (Typeable) -import Test.DejaFu -import qualified Test.DejaFu.SCT as SCT -import Test.Tasty (TestName, TestTree, testGroup) -import Test.Tasty.Options (OptionDescription(..), IsOption(..), lookupOption) -import Test.Tasty.Providers (IsTest(..), singleTest, testPassed, testFailed) - -#if MIN_VERSION_dejafu(0,4,0) -import qualified Test.DejaFu.Conc as Conc -#else -import qualified Test.DejaFu.Deterministic as Conc -#endif +import Control.Monad.ST (runST) +import Data.Char (toUpper) +import qualified Data.Foldable as F +import Data.List (intercalate, intersperse) +import Data.Proxy (Proxy(..)) +import Data.Tagged (Tagged(..)) +import Data.Typeable (Typeable) +import System.Random (mkStdGen) +import Test.DejaFu hiding (Testable(..)) +import qualified Test.DejaFu.Conc as Conc +import qualified Test.DejaFu.Refinement as R +import qualified Test.DejaFu.SCT as SCT +import Test.Tasty (TestName, TestTree, testGroup) +import Test.Tasty.Options (IsOption(..), OptionDescription(..), + lookupOption) +import Test.Tasty.Providers (IsTest(..), singleTest, testFailed, + testPassed) -- Can't put the necessary forall in the @IsTest ConcST t@ -- instance :( -import Unsafe.Coerce (unsafeCoerce) +import Unsafe.Coerce (unsafeCoerce) -#if MIN_VERSION_dejafu(0,3,0) -type Trc = Conc.Trace Conc.ThreadId Conc.ThreadAction Conc.Lookahead -#else -type Trc = Conc.Trace -#endif +runSCTst :: Way -> MemType -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Conc.Trace)] +runSCTst way memtype conc = runST (SCT.runSCT way memtype conc) -sctBoundST :: MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Trc)] -sctBoundIO :: MemType -> Bounds -> Conc.ConcIO a -> IO [(Either Failure a, Trc)] - -#if MIN_VERSION_dejafu(0,4,0) -sctBoundST memtype cb conc = runST (SCT.sctBound memtype cb conc) -sctBoundIO = SCT.sctBound -#else -sctBoundST = SCT.sctBound -sctBoundIO = SCT.sctBoundIO -#endif +runSCTio :: Way -> MemType -> Conc.ConcIO a -> IO [(Either Failure a, Conc.Trace)] +runSCTio = SCT.runSCT -------------------------------------------------------------------------------- --- Unit testing +-- Tasty-style unit testing +-- | @since 0.3.0.0 instance Typeable t => IsTest (Conc.ConcST t (Maybe String)) where testOptions = Tagged concOptions run options conc callback = do let memtype = lookupOption options :: MemType - let bounds = lookupOption options :: Bounds - let sctBound' :: Conc.ConcST t (Maybe String) -> [(Either Failure (Maybe String), Trc)] - sctBound' = unsafeCoerce $ sctBoundST memtype bounds - let traces = sctBound' conc + let way = lookupOption options :: Way + let runSCTst' :: Conc.ConcST t (Maybe String) -> [(Either Failure (Maybe String), Conc.Trace)] + runSCTst' = unsafeCoerce $ runSCTst way memtype + let traces = runSCTst' conc run options (ConcTest traces assertableP) callback +-- | @since 0.3.0.0 instance IsTest (Conc.ConcIO (Maybe String)) where testOptions = Tagged concOptions run options conc callback = do let memtype = lookupOption options - let bounds = lookupOption options - let traces = sctBoundIO memtype bounds conc + let way = lookupOption options + let traces = runSCTio way memtype conc run options (ConcIOTest traces assertableP) callback concOptions :: [OptionDescription] concOptions = - [ Option (Proxy :: Proxy Bounds) - , Option (Proxy :: Proxy MemType) + [ Option (Proxy :: Proxy MemType) + , Option (Proxy :: Proxy Way) ] assertableP :: Predicate (Maybe String) @@ -128,54 +141,72 @@ Right (Just _) -> False _ -> True -instance IsOption Bounds where - defaultValue = defaultBounds - parseValue = const Nothing - optionName = Tagged "schedule-bounds" - optionHelp = Tagged "The schedule bounds to use. This cannot be set on the command line." - +-- | @since 0.3.0.0 instance IsOption MemType where defaultValue = defaultMemType - parseValue str = shortName (map toUpper str) where + parseValue = shortName . map toUpper where shortName "SC" = Just SequentialConsistency shortName "TSO" = Just TotalStoreOrder shortName "PSO" = Just PartialStoreOrder shortName _ = Nothing optionName = Tagged "memory-model" - optionHelp = Tagged "The memory model to use. This should be one of \"SC\", \"TSO\", or \"PSO\"." + optionHelp = Tagged "The memory model to use. This should be one of \"sc\", \"tso\", or \"pso\"." + +-- | @since 0.5.0.0 +instance IsOption Way where + defaultValue = defaultWay + parseValue = shortName . map toUpper where + shortName "SYSTEMATICALLY" = Just (systematically defaultBounds) + shortName "RANDOMLY" = Just (randomly (mkStdGen 42) 100) + shortName _ = Nothing + optionName = Tagged "way" + optionHelp = Tagged "The execution method to use. This should be one of \"systematically\" or \"randomly\"." + -------------------------------------------------------------------------------- --- Property testing +-- DejaFu-style unit testing -- | Automatically test a computation. In particular, look for -- deadlocks, uncaught exceptions, and multiple return values. --- +-- -- This uses the 'Conc' monad for testing, which is an instance of -- 'MonadConc'. If you need to test something which also uses -- 'MonadIO', use 'testAutoIO'. +-- +-- @since 0.2.0.0 testAuto :: (Eq a, Show a) => (forall t. Conc.ConcST t a) -- ^ The computation to test -> TestTree -testAuto = testAuto' defaultMemType +testAuto = testAutoWay defaultWay defaultMemType -- | Variant of 'testAuto' which tests a computation under a given --- memory model. -testAuto' :: (Eq a, Show a) - => MemType +-- execution way and memory model. +-- +-- @since 0.5.0.0 +testAutoWay :: (Eq a, Show a) + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> TestTree -testAuto' memtype conc = testDejafus' memtype defaultBounds conc autocheckCases +testAutoWay way memtype conc = testDejafusWay way memtype conc autocheckCases -- | Variant of 'testAuto' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testAutoIO :: (Eq a, Show a) => Conc.ConcIO a -> TestTree -testAutoIO = testAutoIO' defaultMemType +testAutoIO = testAutoWayIO defaultWay defaultMemType --- | Variant of 'testAuto'' for computations which do 'IO'. -testAutoIO' :: (Eq a, Show a) => MemType -> Conc.ConcIO a -> TestTree -testAutoIO' memtype concio = testDejafusIO' memtype defaultBounds concio autocheckCases +-- | Variant of 'testAutoWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testAutoWayIO :: (Eq a, Show a) + => Way -> MemType -> Conc.ConcIO a -> TestTree +testAutoWayIO way memtype concio = + testDejafusWayIO way memtype concio autocheckCases -- | Predicates for the various autocheck functions. autocheckCases :: Eq a => [(TestName, Predicate a)] @@ -186,6 +217,8 @@ ] -- | Check that a predicate holds. +-- +-- @since 0.2.0.0 testDejafu :: Show a => (forall t. Conc.ConcST t a) -- ^ The computation to test @@ -194,15 +227,17 @@ -> Predicate a -- ^ The predicate to check -> TestTree -testDejafu = testDejafu' defaultMemType defaultBounds +testDejafu = testDejafuWay defaultWay defaultMemType --- | Variant of 'testDejafu' which takes a memory model and --- pre-emption bound. -testDejafu' :: Show a - => MemType +-- | Variant of 'testDejafu' which takes a way to execute the program +-- and a memory model. +-- +-- @since 0.5.0.0 +testDejafuWay :: Show a + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. - -> Bounds - -- ^ The schedule bounds. -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> TestName @@ -210,89 +245,143 @@ -> Predicate a -- ^ The predicate to check -> TestTree -testDejafu' memtype cb conc name p = testDejafus' memtype cb conc [(name, p)] +testDejafuWay way memtype conc name p = + testDejafusWay way memtype conc [(name, p)] -- | Variant of 'testDejafu' which takes a collection of predicates to -- test. This will share work between the predicates, rather than -- running the concurrent computation many times for each predicate. +-- +-- @since 0.2.0.0 testDejafus :: Show a => (forall t. Conc.ConcST t a) -- ^ The computation to test -> [(TestName, Predicate a)] -- ^ The list of predicates (with names) to check -> TestTree -testDejafus = testDejafus' defaultMemType defaultBounds +testDejafus = testDejafusWay defaultWay defaultMemType --- | Variant of 'testDejafus' which takes a memory model and pre-emption --- bound. -testDejafus' :: Show a - => MemType +-- | Variant of 'testDejafus' which takes a way to execute the program +-- and a memory model. +-- +-- @since 0.5.0.0 +testDejafusWay :: Show a + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. - -> Bounds - -- ^ The schedule bounds. -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> [(TestName, Predicate a)] -- ^ The list of predicates (with names) to check -> TestTree -testDejafus' = testst +testDejafusWay = testst -- | Variant of 'testDejafu' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testDejafuIO :: Show a => Conc.ConcIO a -> TestName -> Predicate a -> TestTree -testDejafuIO = testDejafuIO' defaultMemType defaultBounds +testDejafuIO = testDejafuWayIO defaultWay defaultMemType --- | Variant of 'testDejafu'' for computations which do 'IO'. -testDejafuIO' :: Show a => MemType -> Bounds -> Conc.ConcIO a -> TestName -> Predicate a -> TestTree -testDejafuIO' memtype cb concio name p = testDejafusIO' memtype cb concio [(name, p)] +-- | Variant of 'testDejafuWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testDejafuWayIO :: Show a + => Way -> MemType -> Conc.ConcIO a -> TestName -> Predicate a -> TestTree +testDejafuWayIO way memtype concio name p = + testDejafusWayIO way memtype concio [(name, p)] -- | Variant of 'testDejafus' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testDejafusIO :: Show a => Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree -testDejafusIO = testDejafusIO' defaultMemType defaultBounds +testDejafusIO = testDejafusWayIO defaultWay defaultMemType + +-- | Variant of 'dejafusWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testDejafusWayIO :: Show a + => Way -> MemType -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree +testDejafusWayIO = testio + + +------------------------------------------------------------------------------- +-- Refinement property testing + +-- | Check a refinement property with a variety of seed values and +-- variable assignments. +-- +-- @since 0.6.0.0 +testProperty :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => TestName + -- ^ The name of the test. + -> p + -- ^ The property to check. + -> TestTree +testProperty = testprop --- | Variant of 'dejafus'' for computations which do 'IO'. -testDejafusIO' :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree -testDejafusIO' = testio -------------------------------------------------------------------------------- -- Tasty integration data ConcTest where - ConcTest :: Show a => [(Either Failure a, Trc)] -> Predicate a -> ConcTest + ConcTest :: Show a => [(Either Failure a, Conc.Trace)] -> Predicate a -> ConcTest deriving Typeable data ConcIOTest where - ConcIOTest :: Show a => IO [(Either Failure a, Trc)] -> Predicate a -> ConcIOTest + ConcIOTest :: Show a => IO [(Either Failure a, Conc.Trace)] -> Predicate a -> ConcIOTest + deriving Typeable + +data PropTest where + PropTest :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) => p -> PropTest deriving Typeable instance IsTest ConcTest where - testOptions = return [] + testOptions = pure [] run _ (ConcTest traces p) _ = let err = showErr $ p traces - in return $ if null err then testPassed "" else testFailed err + in pure (if null err then testPassed "" else testFailed err) instance IsTest ConcIOTest where - testOptions = return [] + testOptions = pure [] run _ (ConcIOTest iotraces p) _ = do traces <- iotraces let err = showErr $ p traces - return $ if null err then testPassed "" else testFailed err + pure (if null err then testPassed "" else testFailed err) + +instance IsTest PropTest where + testOptions = pure [] + + run _ (PropTest p) _ = do + ce <- R.check' p + pure $ case ce of + Just c -> testFailed . init $ unlines + [ "*** Failure: " ++ + (if null (R.failingArgs c) then "" else unwords (R.failingArgs c) ++ " ") ++ + "(seed " ++ show (R.failingSeed c) ++ ")" + , " left: " ++ show (F.toList $ R.leftResults c) + , " right: " ++ show (F.toList $ R.rightResults c) + ] + Nothing -> testPassed "" -- | Produce a Tasty 'TestTree' from a Deja Fu test. -testst :: Show a => MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(TestName, Predicate a)] -> TestTree -testst memtype cb conc tests = case map toTest tests of +testst :: Show a + => Way -> MemType -> (forall t. Conc.ConcST t a) -> [(TestName, Predicate a)] -> TestTree +testst way memtype conc tests = case map toTest tests of [t] -> t ts -> testGroup "Deja Fu Tests" ts where toTest (name, p) = singleTest name $ ConcTest traces p - traces = sctBoundST memtype cb conc + traces = runSCTst way memtype conc -- | Produce a Tasty 'Test' from an IO-using Deja Fu test. -testio :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree -testio memtype cb concio tests = case map toTest tests of +testio :: Show a + => Way -> MemType -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree +testio way memtype concio tests = case map toTest tests of [t] -> t ts -> testGroup "Deja Fu Tests" ts @@ -301,7 +390,12 @@ -- As with HUnit, constructing a test is side-effect free, so -- sharing of traces can't happen here. - traces = sctBoundIO memtype cb concio + traces = runSCTio way memtype concio + +-- | Produce a Tasty 'TestTree' from a Deja Fu refinement property test. +testprop :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => TestName -> p -> TestTree +testprop name = singleTest name . PropTest -- | Convert a test result into an error message on failure (empty -- string on success). diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-dejafu-0.3.0.2/tasty-dejafu.cabal new/tasty-dejafu-0.6.0.0/tasty-dejafu.cabal --- old/tasty-dejafu-0.3.0.2/tasty-dejafu.cabal 2016-08-28 15:57:25.000000000 +0200 +++ new/tasty-dejafu-0.6.0.0/tasty-dejafu.cabal 2017-06-07 18:08:05.000000000 +0200 @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: tasty-dejafu -version: 0.3.0.2 +version: 0.6.0.0 synopsis: Deja Fu support for the Tasty test framework. description: @@ -11,9 +11,6 @@ <https://hackage.haskell.org/package/tasty tasty>. This lets you easily incorporate concurrency testing into your existing test suites. - . - See the <https://github.com/barrucadu/dejafu README> for more - details. homepage: https://github.com/barrucadu/dejafu license: MIT @@ -23,7 +20,7 @@ -- copyright: category: Testing build-type: Simple --- extra-source-files: +extra-source-files: README.markdown CHANGELOG.markdown cabal-version: >=1.10 source-repository head @@ -33,14 +30,15 @@ source-repository this type: git location: https://github.com/barrucadu/dejafu.git - tag: tasty-dejafu-0.3.0.1 + tag: tasty-dejafu-0.6.0.0 library exposed-modules: Test.Tasty.DejaFu -- other-modules: -- other-extensions: build-depends: base >=4.8 && <5 - , dejafu >=0.2 && <0.5 + , dejafu >=0.7 && <0.8 + , random >=1.0 && <1.2 , tagged >=0.8 && <0.9 , tasty >=0.10 && <0.12 -- hs-source-dirs:

1 0

commit ghc-tasty-auto for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty-auto for openSUSE:Factory checked in at 2017-08-31 21:00:11 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty-auto (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty-auto.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty-auto" Thu Aug 31 21:00:11 2017 rev:2 rq:513508 version:0.2.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty-auto/ghc-tasty-auto.changes 2017-04-12 18:09:20.568272409 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty-auto.new/ghc-tasty-auto.changes 2017-08-31 21:00:12.675822192 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:53 UTC 2017 - psimons(a)suse.com + +- Update to version 0.2.0.0. + +------------------------------------------------------------------- Old: ---- tasty-auto-0.1.0.2.tar.gz New: ---- tasty-auto-0.2.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty-auto.spec ++++++ --- /var/tmp/diff_new_pack.TYQCOg/_old 2017-08-31 21:00:13.903649679 +0200 +++ /var/tmp/diff_new_pack.TYQCOg/_new 2017-08-31 21:00:13.907649117 +0200 @@ -19,7 +19,7 @@ %global pkg_name tasty-auto %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.0.2 +Version: 0.2.0.0 Release: 0 Summary: Auto discovery for Tasty with support for ingredients and test tree generation License: MIT ++++++ tasty-auto-0.1.0.2.tar.gz -> tasty-auto-0.2.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-auto-0.1.0.2/README.md new/tasty-auto-0.2.0.0/README.md --- old/tasty-auto-0.1.0.2/README.md 2017-02-12 01:07:44.000000000 +0100 +++ new/tasty-auto-0.2.0.0/README.md 2017-03-04 21:07:55.000000000 +0100 @@ -93,13 +93,20 @@ pure $ map (\s -> testCase s $ pure ()) inputs ``` -## Support for additional ingredients +## Configuration options You can add tasty ingredients with the `-optF` option: ``` haskell -- test/test.hs -{-# OPTIONS_GHC -F -pgmF tasty-auto -optF Test.Tasty.Runners.Html.htmlRunner -optF Test.Tasty.Runners.AntXML.antXMLRunner #-} +{-# OPTIONS_GHC -F -pgmF tasty-auto -optF --ingredient=Test.Tasty.Runners.Html.htmlRunner -optF --ingredient=Test.Tasty.Runners.AntXML.antXMLRunner #-} +``` + +It is possible to configure the name of the generated module, if you want to import the module somewhere. + +``` haskell +-- test/AutoTests.hs +{-# OPTIONS_GHC -F -pgmF tasty-auto -optF --module=AutoTests #-} ``` ## Generated code @@ -109,9 +116,10 @@ ``` haskell {-# LINE 1 "test/test.hs" #-} {-# LANGUAGE FlexibleInstances #-} -module Main where +module Main (main, ingredients, tests) where import Prelude import qualified Test.Tasty as T +import qualified Test.Tasty.Ingredients as T import qualified Test.Tasty.HUnit as HU import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.SmallCheck as SC @@ -131,8 +139,8 @@ instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a instance TestGroup (IO T.TestTree) where testGroup _ a = a instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a -main :: IO () -main = do +tests :: IO T.TestTree +tests = do t0 <- testCase "List comparison with different length" CaseTest.case_List_comparison_with_different_length t1 <- pure $ SC.testProperty "sort reverse" SCPropTest.scprop_sort_reverse t2 <- testGroup "Addition" TreeTest.test_Addition @@ -142,5 +150,9 @@ t6 <- pure $ QC.testProperty "Addition is commutative" PropTest.prop_Addition_is_commutative t7 <- HS.testSpec "Prelude" TestSpec.spec_Prelude t8 <- pure $ QC.testProperty "Addition is associative" SubMod.PropTest.prop_Addition_is_associative - T.defaultMain $ T.testGroup "test/test.hs" [t0,t1,t2,t3,t4,t5,t6,t7,t8] + pure $ T.testGroup "test/test.hs" [t0,t1,t2,t3,t4,t5,t6,t7,t8] +ingredients :: [T.Ingredient] +ingredients = T.defaultIngredients +main :: IO () +main = tests >>= T.defaultMainWithIngredients ingredients ``` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-auto-0.1.0.2/src/Test/Tasty/Auto.hs new/tasty-auto-0.2.0.0/src/Test/Tasty/Auto.hs --- old/tasty-auto-0.1.0.2/src/Test/Tasty/Auto.hs 2017-02-12 01:05:33.000000000 +0100 +++ new/tasty-auto-0.2.0.0/src/Test/Tasty/Auto.hs 2017-03-04 21:06:44.000000000 +0100 @@ -1,7 +1,7 @@ module Test.Tasty.Auto (findTests, showTestDriver) where import Data.Function (on) -import Data.List (find, isPrefixOf, isSuffixOf, nub, intersperse, groupBy, sortOn) +import Data.List (find, isPrefixOf, isSuffixOf, nub, intersperse, groupBy, sortOn, dropWhileEnd) import Data.Maybe (fromJust) import System.Directory (getDirectoryContents, doesDirectoryExist) import Data.Traversable (for) @@ -79,29 +79,33 @@ foldEndo = appEndo . fold . fmap Endo ingredientImport :: String -> String -ingredientImport = reverse . tail . dropWhile (/= '.') . reverse +ingredientImport = init . dropWhileEnd (/= '.') -mainFunction :: [String] -> ShowS -mainFunction [] = str " T.defaultMain" -mainFunction ingredients = str " T.defaultMainWithIngredients (" - . foldEndo (map (\i -> str i . (':':)) ingredients) . str "T.defaultIngredients)" +ingredients :: [String] -> ShowS +ingredients is = foldEndo (map (\i -> str i . (':':)) is) . str "T.defaultIngredients" -showTestDriver :: [String] -> FilePath -> [Test] -> ShowS -showTestDriver ingredients src ts = let gs = getGenerators ts; vars = map (str . ('t':) . show) [(0::Int)..] in +showTestDriver :: String -> [String] -> FilePath -> [Test] -> ShowS +showTestDriver modname is src ts = + let gs = getGenerators ts; vars = map (str . ('t':) . show) [(0::Int)..] in str "{-# LINE 1 " . shows src . str " #-}\n\ \{-# LANGUAGE FlexibleInstances #-}\n\ - \module Main where\n\ + \module " . str modname . str " (main, ingredients, tests) where\n\ \import Prelude\n\ - \import qualified Test.Tasty as T\n" + \import qualified Test.Tasty as T\n\ + \import qualified Test.Tasty.Ingredients as T\n" . foldEndo (map genImport gs) - . showImports (map ingredientImport ingredients ++ map testModule ts) + . showImports (map ingredientImport is ++ map testModule ts) . foldEndo (map genClass gs) - . str "main :: IO ()\n\ - \main = do\n" + . str "tests :: IO T.TestTree\n\ + \tests = do\n" . foldEndo (zipWith showSetup ts vars) - . mainFunction ingredients . str " $ T.testGroup " . shows src . str " [" + . str " pure $ T.testGroup " . shows src . str " [" . foldEndo (intersperse (',':) $ zipWith (curry snd) ts vars) . str "]\n" + . str "ingredients :: [T.Ingredient]\n\ + \ingredients = " . ingredients is . str "\n\ + \main :: IO ()\n\ + \main = tests >>= T.defaultMainWithIngredients ingredients\n" filesBySuffix :: FilePath -> [String] -> IO [FilePath] filesBySuffix dir suffixes = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-auto-0.1.0.2/tasty-auto.cabal new/tasty-auto-0.2.0.0/tasty-auto.cabal --- old/tasty-auto-0.1.0.2/tasty-auto.cabal 2017-02-12 01:18:56.000000000 +0100 +++ new/tasty-auto-0.2.0.0/tasty-auto.cabal 2017-03-04 21:10:34.000000000 +0100 @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: tasty-auto -version: 0.1.0.2 +version: 0.2.0.0 synopsis: Auto discovery for Tasty with support for ingredients and test tree generation description: Auto discovery for Tasty with support for ingredients and test tree generation category: Testing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-auto-0.1.0.2/tasty-auto.hs new/tasty-auto-0.2.0.0/tasty-auto.hs --- old/tasty-auto-0.1.0.2/tasty-auto.hs 2017-02-12 01:09:05.000000000 +0100 +++ new/tasty-auto-0.2.0.0/tasty-auto.hs 2017-03-04 20:59:53.000000000 +0100 @@ -1,15 +1,29 @@ -import System.Exit (exitFailure) +import Control.Monad (when) +import Data.List (foldl') +import System.Console.GetOpt (getOpt, usageInfo, ArgDescr(..), ArgOrder(..), OptDescr(..)) import System.Environment (getArgs) +import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) import Test.Tasty.Auto +options :: [OptDescr ((String, [String], Bool) -> (String, [String], Bool))] +options = + [ Option [] ["module"] (ReqArg (\x (_, b, c) -> (x, b, c)) "MODULE") "Qualified module name" + , Option [] ["ingredient"] (ReqArg (\x (a, b, c) -> (a, b ++ [x], c)) "INGREDIENT") "Qualified ingredient name" + , Option [] ["debug"] (NoArg (\ (a, b, _) -> (a, b, True))) "Debug output" + ] + main :: IO () main = do args <- getArgs case args of - src : _ : dst : ingredients -> do - tests <- findTests src - writeFile dst $ showTestDriver ingredients src tests "" + src : _ : dst : optargs + | (opts, [], []) <- getOpt Permute options optargs -> do + tests <- findTests src + let output = showTestDriver modname ingredients src tests "" + (modname, ingredients, debug) = foldl' (flip id) ("Main", [], False) opts + when debug $ hPutStrLn stderr output + writeFile dst output _ -> do - hPutStrLn stderr "tasty-auto: Expected source and destination arguments" + hPutStrLn stderr $ usageInfo "Usage: tasty-auto src _ dst [OPTION...]" options exitFailure diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-auto-0.1.0.2/test/test.hs new/tasty-auto-0.2.0.0/test/test.hs --- old/tasty-auto-0.1.0.2/test/test.hs 2017-01-24 02:56:13.000000000 +0100 +++ new/tasty-auto-0.2.0.0/test/test.hs 2017-03-04 21:04:01.000000000 +0100 @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF tasty-auto #-} +{-# OPTIONS_GHC -F -pgmF tasty-auto -optF --debug #-}

1 0

commit ghc-tasty-ant-xml for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty-ant-xml for openSUSE:Factory checked in at 2017-08-31 21:00:08 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty-ant-xml (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty-ant-xml.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty-ant-xml" Thu Aug 31 21:00:08 2017 rev:5 rq:513507 version:1.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty-ant-xml/ghc-tasty-ant-xml.changes 2017-04-11 09:43:48.312590949 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty-ant-xml.new/ghc-tasty-ant-xml.changes 2017-08-31 21:00:09.872216105 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:10 UTC 2017 - psimons(a)suse.com + +- Update to version 1.1.0. + +------------------------------------------------------------------- Old: ---- tasty-ant-xml-1.0.5.tar.gz New: ---- tasty-ant-xml-1.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty-ant-xml.spec ++++++ --- /var/tmp/diff_new_pack.vdw6v6/_old 2017-08-31 21:00:11.304014934 +0200 +++ /var/tmp/diff_new_pack.vdw6v6/_new 2017-08-31 21:00:11.312013811 +0200 @@ -18,7 +18,7 @@ %global pkg_name tasty-ant-xml Name: ghc-%{pkg_name} -Version: 1.0.5 +Version: 1.1.0 Release: 0 Summary: Render tasty output to XML for Jenkins License: BSD-3-Clause ++++++ tasty-ant-xml-1.0.5.tar.gz -> tasty-ant-xml-1.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-ant-xml-1.0.5/Changelog.md new/tasty-ant-xml-1.1.0/Changelog.md --- old/tasty-ant-xml-1.0.5/Changelog.md 2017-02-27 16:31:23.000000000 +0100 +++ new/tasty-ant-xml-1.1.0/Changelog.md 2017-03-17 20:11:56.000000000 +0100 @@ -1,3 +1,27 @@ +# 1.1.0 + +## Breaking Changes + +* The XML generated is now slightly different in order to satisfy Jenkins. In + particular: + + * The `classname` attribute now joins the test path with `.` (like a Java + class name). + * `testsuite` nodes have a `tests` attribute, which is the amount of tests + executed. + + For more discussion see https://github.com/ocharles/tasty-ant-xml/pull/20 and + https://github.com/ocharles/tasty-ant-xml/commit/a01df06b59122c3086fc9f4285… + + Thanks to @liskin and @haishengwu-okta for this work. + +## Other Changes + +* Increase the lower bound of `directory` to >= 1.2.3.0. Earlier versions may + throw exceptions on some of the actions we are using. Thanks to @liskin for + pointing this out. + + # 1.0.5 ## Other Changes diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-ant-xml-1.0.5/Test/Tasty/Runners/AntXML.hs new/tasty-ant-xml-1.1.0/Test/Tasty/Runners/AntXML.hs --- old/tasty-ant-xml-1.0.5/Test/Tasty/Runners/AntXML.hs 2017-02-27 16:31:23.000000000 +0100 +++ new/tasty-ant-xml-1.1.0/Test/Tasty/Runners/AntXML.hs 2017-03-17 20:11:56.000000000 +0100 @@ -13,6 +13,7 @@ import Control.Applicative import Control.Arrow (first) import Control.Monad.IO.Class (liftIO) +import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..), Endo(..), Sum(..)) import Data.Proxy (Proxy(..)) @@ -95,7 +96,7 @@ let testCaseAttributes time = map (uncurry XML.Attr . first XML.unqual) [ ("name", testName) , ("time", showTime time) - , ("classname", unwords groupNames) + , ("classname", intercalate "." (reverse groupNames)) ] mkSummary contents = @@ -130,11 +131,14 @@ Const summary <$ State.modify (+ 1) runGroup groupName children = Tasty.Traversal $ Functor.Compose $ do - Const soFar <- Reader.withReaderT (++ [groupName]) $ Functor.getCompose $ Tasty.getTraversal children + Const soFar <- Reader.local (groupName :) $ Functor.getCompose $ Tasty.getTraversal children let grouped = appEndo (xmlRenderer soFar) $ - XML.node (XML.unqual "testsuite") $ - XML.Attr (XML.unqual "name") groupName + XML.node (XML.unqual "testsuite") + [ XML.Attr (XML.unqual "name") groupName + , XML.Attr (XML.unqual "tests") + (show . getSum . (summaryFailures `mappend` summaryErrors `mappend` summarySuccesses) $ soFar) + ] pure $ Const soFar { xmlRenderer = Endo (`appendChild` grouped) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-ant-xml-1.0.5/tasty-ant-xml.cabal new/tasty-ant-xml-1.1.0/tasty-ant-xml.cabal --- old/tasty-ant-xml-1.0.5/tasty-ant-xml.cabal 2017-02-27 16:31:23.000000000 +0100 +++ new/tasty-ant-xml-1.1.0/tasty-ant-xml.cabal 2017-03-17 20:11:56.000000000 +0100 @@ -1,5 +1,5 @@ name: tasty-ant-xml -version: 1.0.5 +version: 1.1.0 synopsis: Render tasty output to XML for Jenkins description: A tasty ingredient to output test results in XML, using the Ant schema. This XML can be consumed by the Jenkins continuous integration framework. homepage: http://github.com/ocharles/tasty-ant-xml @@ -25,7 +25,7 @@ tagged >= 0.7, tasty >= 0.10 && < 0.12, transformers >= 0.3.0.0, - directory >= 1.0.0, + directory >= 1.2.3.0, filepath >= 1.0.0, xml >= 1.3.13 default-language: Haskell98

1 0

commit ghc-tasty for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty for openSUSE:Factory checked in at 2017-08-31 21:00:05 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty" Thu Aug 31 21:00:05 2017 rev:9 rq:513506 version:0.11.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty/ghc-tasty.changes 2017-07-27 11:12:20.632626708 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty.new/ghc-tasty.changes 2017-08-31 21:00:06.948626877 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:45 UTC 2017 - psimons(a)suse.com + +- Update to version 0.11.2.3. + +------------------------------------------------------------------- Old: ---- tasty-0.11.2.2.tar.gz New: ---- tasty-0.11.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty.spec ++++++ --- /var/tmp/diff_new_pack.i8aBAQ/_old 2017-08-31 21:00:09.008337483 +0200 +++ /var/tmp/diff_new_pack.i8aBAQ/_new 2017-08-31 21:00:09.036333549 +0200 @@ -18,7 +18,7 @@ %global pkg_name tasty Name: ghc-%{pkg_name} -Version: 0.11.2.2 +Version: 0.11.2.3 Release: 0 Summary: Modern and extensible testing framework License: MIT ++++++ tasty-0.11.2.2.tar.gz -> tasty-0.11.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-0.11.2.2/CHANGELOG.md new/tasty-0.11.2.3/CHANGELOG.md --- old/tasty-0.11.2.2/CHANGELOG.md 2017-07-06 11:10:26.000000000 +0200 +++ new/tasty-0.11.2.3/CHANGELOG.md 2017-07-18 17:08:48.000000000 +0200 @@ -1,6 +1,11 @@ Changes ======= +Version 0.11.2.3 +---------------- + +Make filtering tests (`-p`) work faster + Version 0.11.2.2 ---------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-0.11.2.2/Test/Tasty/Patterns.hs new/tasty-0.11.2.3/Test/Tasty/Patterns.hs --- old/tasty-0.11.2.2/Test/Tasty/Patterns.hs 2017-07-06 11:05:04.000000000 +0200 +++ new/tasty-0.11.2.3/Test/Tasty/Patterns.hs 2017-07-18 08:32:55.000000000 +0200 @@ -115,20 +115,27 @@ -- | Test a path (which is the sequence of group titles, possibly followed -- by the test title) against a pattern testPatternMatches :: TestPattern -> [String] -> Bool -testPatternMatches NoPattern _ = True -testPatternMatches test_pattern path = not_maybe $ any (=~ tokens_regex) things_to_match +testPatternMatches test_pattern = + -- It is important that GHC assigns arity 1 to this function, + -- so that compilation of the regex is shared among the invocations. + -- See #175. + case test_pattern of + NoPattern -> const True + TestPattern {} -> \path -> + let + path_to_consider | tp_categories_only test_pattern = dropLast 1 path + | otherwise = path + things_to_match = case tp_match_mode test_pattern of + -- See if the tokens match any single path component + TestMatchMode -> path_to_consider + -- See if the tokens match any prefix of the path + PathMatchMode -> map pathToString $ inits path_to_consider + in not_maybe . any (match tokens_regex) $ things_to_match where not_maybe | tp_negated test_pattern = not | otherwise = id - path_to_consider | tp_categories_only test_pattern = dropLast 1 path - | otherwise = path - tokens_regex = buildTokenRegex (tp_tokens test_pattern) - - things_to_match = case tp_match_mode test_pattern of - -- See if the tokens match any single path component - TestMatchMode -> path_to_consider - -- See if the tokens match any prefix of the path - PathMatchMode -> map pathToString $ inits path_to_consider + tokens_regex :: Regex + tokens_regex = makeRegex $ buildTokenRegex (tp_tokens test_pattern) buildTokenRegex :: [Token] -> String diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-0.11.2.2/tasty.cabal new/tasty-0.11.2.3/tasty.cabal --- old/tasty-0.11.2.2/tasty.cabal 2017-07-06 11:07:11.000000000 +0200 +++ new/tasty-0.11.2.3/tasty.cabal 2017-07-18 17:08:39.000000000 +0200 @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: tasty -version: 0.11.2.2 +version: 0.11.2.3 synopsis: Modern and extensible testing framework description: Tasty is a modern testing framework for Haskell. It lets you combine your unit tests, golden

1 0

commit ghc-syb for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-syb for openSUSE:Factory checked in at 2017-08-31 21:00:03 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-syb (Old) and /work/SRC/openSUSE:Factory/.ghc-syb.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-syb" Thu Aug 31 21:00:03 2017 rev:13 rq:513505 version:0.7 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-syb/ghc-syb.changes 2017-06-22 10:39:09.908009496 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-syb.new/ghc-syb.changes 2017-08-31 21:00:04.560962350 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:37 UTC 2017 - psimons(a)suse.com + +- Update to version 0.7. + +------------------------------------------------------------------- Old: ---- syb-0.6.tar.gz syb.cabal New: ---- syb-0.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-syb.spec ++++++ --- /var/tmp/diff_new_pack.zSARBj/_old 2017-08-31 21:00:05.444838163 +0200 +++ /var/tmp/diff_new_pack.zSARBj/_new 2017-08-31 21:00:05.456836478 +0200 @@ -19,14 +19,13 @@ %global pkg_name syb %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.6 +Version: 0.7 Release: 0 Summary: Scrap Your Boilerplate License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -56,7 +55,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ syb-0.6.tar.gz -> syb-0.7.tar.gz ++++++ ++++ 3394 lines of diff (skipped)

1 0

commit ghc-superbuffer for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-superbuffer for openSUSE:Factory checked in at 2017-08-31 21:00:00 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-superbuffer (Old) and /work/SRC/openSUSE:Factory/.ghc-superbuffer.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-superbuffer" Thu Aug 31 21:00:00 2017 rev:2 rq:513504 version:0.3.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-superbuffer/ghc-superbuffer.changes 2017-04-12 18:09:15.432998526 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-superbuffer.new/ghc-superbuffer.changes 2017-08-31 21:00:03.065172512 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:36 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.1.1. + +------------------------------------------------------------------- Old: ---- superbuffer-0.2.0.1.tar.gz New: ---- superbuffer-0.3.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-superbuffer.spec ++++++ --- /var/tmp/diff_new_pack.hV0dz6/_old 2017-08-31 21:00:04.013039335 +0200 +++ /var/tmp/diff_new_pack.hV0dz6/_new 2017-08-31 21:00:04.077030344 +0200 @@ -19,7 +19,7 @@ %global pkg_name superbuffer %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.0.1 +Version: 0.3.1.1 Release: 0 Summary: Efficiently build a bytestring from smaller chunks License: BSD-3-Clause ++++++ superbuffer-0.2.0.1.tar.gz -> superbuffer-0.3.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/LICENSE new/superbuffer-0.3.1.1/LICENSE --- old/superbuffer-0.2.0.1/LICENSE 2016-11-30 20:40:56.000000000 +0100 +++ new/superbuffer-0.3.1.1/LICENSE 2017-03-27 22:46:12.000000000 +0200 @@ -1,4 +1,4 @@ -Copyright Alexander Thiemann (c) 2016 +Copyright Alexander Thiemann (c) 2016 - 2017 All rights reserved. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/README.md new/superbuffer-0.3.1.1/README.md --- old/superbuffer-0.2.0.1/README.md 2016-12-03 15:51:11.000000000 +0100 +++ new/superbuffer-0.3.1.1/README.md 2016-12-11 16:26:32.000000000 +0100 @@ -29,372 +29,4 @@ ## Benchmarks -``` -benchmarking main/small/superbuffer (init=128 bytes) -time 20.22 ms (19.77 ms .. 20.76 ms) - 0.997 R² (0.994 R² .. 0.999 R²) -mean 20.15 ms (19.91 ms .. 20.40 ms) -std dev 575.0 μs (436.3 μs .. 739.6 μs) - -benchmarking main/small/superbuffer (init=4000 bytes) -time 20.08 ms (19.56 ms .. 20.79 ms) - 0.996 R² (0.993 R² .. 0.999 R²) -mean 20.17 ms (19.85 ms .. 20.66 ms) -std dev 905.1 μs (625.2 μs .. 1.335 ms) -variance introduced by outliers: 14% (moderately inflated) - -benchmarking main/small/superbuffer (init=8000 bytes) -time 23.72 ms (23.21 ms .. 24.34 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 23.92 ms (23.55 ms .. 24.52 ms) -std dev 1.001 ms (673.0 μs .. 1.587 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/small/superbuffer (init=16000 bytes) -time 24.15 ms (23.79 ms .. 24.58 ms) - 0.999 R² (0.998 R² .. 0.999 R²) -mean 23.98 ms (23.69 ms .. 24.55 ms) -std dev 863.6 μs (487.1 μs .. 1.517 ms) - -benchmarking main/small/superbuffer (init=20000000 bytes) -time 11.48 ms (6.634 ms .. 14.10 ms) - 0.645 R² (0.346 R² .. 0.854 R²) -mean 23.80 ms (20.34 ms .. 27.33 ms) -std dev 8.484 ms (7.385 ms .. 9.868 ms) -variance introduced by outliers: 95% (severely inflated) - -benchmarking main/small/superbuffer (init=128 bytes, threadsafe, 2 concurrent writes) -time 23.15 ms (22.24 ms .. 24.28 ms) - 0.993 R² (0.987 R² .. 0.997 R²) -mean 24.41 ms (23.96 ms .. 24.85 ms) -std dev 1.012 ms (809.8 μs .. 1.434 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/small/superbuffer (init=4000 bytes, threadsafe, 2 concurrent writes) -time 24.99 ms (23.79 ms .. 26.02 ms) - 0.994 R² (0.990 R² .. 0.997 R²) -mean 24.02 ms (23.60 ms .. 24.48 ms) -std dev 1.004 ms (831.7 μs .. 1.228 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/small/superbuffer (init=8000 bytes, threadsafe, 2 concurrent writes) -time 25.30 ms (24.78 ms .. 26.00 ms) - 0.998 R² (0.996 R² .. 0.999 R²) -mean 25.37 ms (24.98 ms .. 26.10 ms) -std dev 1.148 ms (621.8 μs .. 1.891 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/small/superbuffer (init=16000 bytes, threadsafe, 2 concurrent writes) -time 25.45 ms (24.73 ms .. 26.36 ms) - 0.996 R² (0.992 R² .. 0.998 R²) -mean 24.24 ms (23.80 ms .. 24.72 ms) -std dev 1.020 ms (825.0 μs .. 1.335 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/small/superbuffer (init=20000000 bytes, threadsafe, 2 concurrent writes) -time 31.89 ms (30.17 ms .. 34.05 ms) - 0.987 R² (0.979 R² .. 0.994 R²) -mean 30.33 ms (29.35 ms .. 31.28 ms) -std dev 2.038 ms (1.752 ms .. 2.381 ms) -variance introduced by outliers: 22% (moderately inflated) - -benchmarking main/small/buffer-builder (init=128 bytes, trim=yes) -time 27.32 ms (26.65 ms .. 28.22 ms) - 0.996 R² (0.991 R² .. 0.999 R²) -mean 27.12 ms (26.62 ms .. 27.58 ms) -std dev 1.045 ms (758.8 μs .. 1.413 ms) -variance introduced by outliers: 10% (moderately inflated) - -benchmarking main/small/buffer-builder (init=4000 bytes, trim=yes) -time 27.72 ms (26.43 ms .. 28.85 ms) - 0.994 R² (0.990 R² .. 0.998 R²) -mean 26.85 ms (26.33 ms .. 27.48 ms) -std dev 1.254 ms (953.7 μs .. 1.868 ms) -variance introduced by outliers: 16% (moderately inflated) - -benchmarking main/small/buffer-builder (init=8000 bytes, trim=yes) -time 26.93 ms (26.03 ms .. 27.75 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 26.03 ms (24.99 ms .. 26.46 ms) -std dev 1.420 ms (578.2 μs .. 2.534 ms) -variance introduced by outliers: 21% (moderately inflated) - -benchmarking main/small/buffer-builder (init=16000 bytes, trim=yes) -time 27.18 ms (26.63 ms .. 27.72 ms) - 0.998 R² (0.996 R² .. 0.999 R²) -mean 26.58 ms (26.05 ms .. 26.91 ms) -std dev 907.8 μs (570.8 μs .. 1.417 ms) -variance introduced by outliers: 10% (moderately inflated) - -benchmarking main/small/buffer-builder (init=20000000 bytes, trim=yes) -time 39.64 ms (37.58 ms .. 41.77 ms) - 0.993 R² (0.988 R² .. 0.997 R²) -mean 36.84 ms (33.85 ms .. 38.83 ms) -std dev 4.888 ms (1.424 ms .. 6.918 ms) -variance introduced by outliers: 52% (severely inflated) - -benchmarking main/small/bytestring builder -time 25.99 ms (25.26 ms .. 26.86 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 26.82 ms (26.10 ms .. 28.67 ms) -std dev 2.472 ms (847.5 μs .. 4.346 ms) -variance introduced by outliers: 40% (moderately inflated) - -benchmarking main/small/bytestring fromChunks -time 24.71 ms (23.97 ms .. 25.61 ms) - 0.996 R² (0.994 R² .. 0.999 R²) -mean 25.10 ms (24.78 ms .. 25.46 ms) -std dev 762.7 μs (615.2 μs .. 972.1 μs) - -benchmarking main/small/bytestring concat -time 24.33 ms (23.59 ms .. 25.07 ms) - 0.997 R² (0.996 R² .. 0.999 R²) -mean 24.82 ms (24.37 ms .. 26.35 ms) -std dev 1.561 ms (507.3 μs .. 3.049 ms) -variance introduced by outliers: 25% (moderately inflated) - -benchmarking main/med/superbuffer (init=128 bytes) -time 20.24 ms (19.67 ms .. 20.82 ms) - 0.996 R² (0.993 R² .. 0.998 R²) -mean 21.88 ms (21.34 ms .. 22.69 ms) -std dev 1.544 ms (1.054 ms .. 2.186 ms) -variance introduced by outliers: 32% (moderately inflated) - -benchmarking main/med/superbuffer (init=40000 bytes) -time 20.93 ms (20.47 ms .. 21.46 ms) - 0.997 R² (0.994 R² .. 0.999 R²) -mean 21.22 ms (20.87 ms .. 21.75 ms) -std dev 985.4 μs (696.1 μs .. 1.269 ms) -variance introduced by outliers: 18% (moderately inflated) - -benchmarking main/med/superbuffer (init=80000 bytes) -time 21.63 ms (21.14 ms .. 22.09 ms) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 21.44 ms (21.26 ms .. 21.61 ms) -std dev 401.8 μs (319.6 μs .. 550.9 μs) - -benchmarking main/med/superbuffer (init=160000 bytes) -time 21.92 ms (21.58 ms .. 22.35 ms) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 22.14 ms (21.80 ms .. 23.03 ms) -std dev 1.207 ms (476.2 μs .. 2.235 ms) -variance introduced by outliers: 19% (moderately inflated) - -benchmarking main/med/superbuffer (init=20000000 bytes) -time 36.50 ms (35.29 ms .. 37.98 ms) - 0.995 R² (0.989 R² .. 0.998 R²) -mean 35.84 ms (34.96 ms .. 36.70 ms) -std dev 1.785 ms (1.412 ms .. 2.334 ms) -variance introduced by outliers: 17% (moderately inflated) - -benchmarking main/med/superbuffer (init=128 bytes, threadsafe, 2 concurrent writes) -time 21.15 ms (18.68 ms .. 23.97 ms) - 0.950 R² (0.908 R² .. 0.980 R²) -mean 24.94 ms (23.67 ms .. 26.24 ms) -std dev 2.822 ms (2.391 ms .. 3.339 ms) -variance introduced by outliers: 51% (severely inflated) - -benchmarking main/med/superbuffer (init=40000 bytes, threadsafe, 2 concurrent writes) -time 21.79 ms (21.24 ms .. 22.38 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 21.96 ms (21.66 ms .. 22.56 ms) -std dev 946.4 μs (527.5 μs .. 1.690 ms) -variance introduced by outliers: 14% (moderately inflated) - -benchmarking main/med/superbuffer (init=80000 bytes, threadsafe, 2 concurrent writes) -time 20.33 ms (19.97 ms .. 20.79 ms) - 0.998 R² (0.996 R² .. 0.999 R²) -mean 21.51 ms (21.06 ms .. 22.95 ms) -std dev 1.825 ms (481.4 μs .. 3.324 ms) -variance introduced by outliers: 37% (moderately inflated) - -benchmarking main/med/superbuffer (init=160000 bytes, threadsafe, 2 concurrent writes) -time 20.96 ms (20.72 ms .. 21.25 ms) - 0.999 R² (0.998 R² .. 1.000 R²) -mean 20.67 ms (20.48 ms .. 20.86 ms) -std dev 427.3 μs (339.9 μs .. 590.7 μs) - -benchmarking main/med/superbuffer (init=20000000 bytes, threadsafe, 2 concurrent writes) -time 15.53 ms (14.71 ms .. 16.32 ms) - 0.990 R² (0.984 R² .. 0.996 R²) -mean 17.04 ms (16.20 ms .. 19.15 ms) -std dev 3.153 ms (803.4 μs .. 5.600 ms) -variance introduced by outliers: 78% (severely inflated) - -benchmarking main/med/buffer-builder (init=128 bytes, trim=yes) -time 27.03 ms (26.42 ms .. 27.71 ms) - 0.997 R² (0.994 R² .. 0.999 R²) -mean 27.12 ms (26.81 ms .. 27.50 ms) -std dev 764.3 μs (640.0 μs .. 905.9 μs) - -benchmarking main/med/buffer-builder (init=40000 bytes, trim=yes) -time 24.45 ms (23.87 ms .. 25.04 ms) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 25.75 ms (25.17 ms .. 27.17 ms) -std dev 1.860 ms (737.2 μs .. 3.305 ms) -variance introduced by outliers: 30% (moderately inflated) - -benchmarking main/med/buffer-builder (init=80000 bytes, trim=yes) -time 25.41 ms (24.69 ms .. 25.96 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 25.03 ms (24.65 ms .. 25.52 ms) -std dev 953.1 μs (712.1 μs .. 1.322 ms) - -benchmarking main/med/buffer-builder (init=160000 bytes, trim=yes) -time 20.74 ms (19.45 ms .. 22.54 ms) - 0.987 R² (0.976 R² .. 0.998 R²) -mean 21.97 ms (21.18 ms .. 23.30 ms) -std dev 2.232 ms (1.143 ms .. 3.201 ms) -variance introduced by outliers: 43% (moderately inflated) - -benchmarking main/med/buffer-builder (init=20000000 bytes, trim=yes) -time 42.12 ms (40.02 ms .. 45.54 ms) - 0.986 R² (0.972 R² .. 0.996 R²) -mean 34.61 ms (30.88 ms .. 37.15 ms) -std dev 6.081 ms (4.260 ms .. 7.559 ms) -variance introduced by outliers: 67% (severely inflated) - -benchmarking main/med/bytestring builder -time 21.46 ms (21.04 ms .. 21.91 ms) - 0.998 R² (0.996 R² .. 0.999 R²) -mean 22.20 ms (21.92 ms .. 22.56 ms) -std dev 769.1 μs (561.8 μs .. 1.135 ms) - -benchmarking main/med/bytestring fromChunks -time 21.76 ms (21.32 ms .. 22.18 ms) - 0.998 R² (0.996 R² .. 0.999 R²) -mean 21.70 ms (21.44 ms .. 22.49 ms) -std dev 915.7 μs (377.2 μs .. 1.650 ms) -variance introduced by outliers: 14% (moderately inflated) - -benchmarking main/med/bytestring concat -time 21.71 ms (20.96 ms .. 22.47 ms) - 0.996 R² (0.993 R² .. 0.998 R²) -mean 21.85 ms (21.52 ms .. 22.36 ms) -std dev 922.0 μs (638.6 μs .. 1.303 ms) -variance introduced by outliers: 14% (moderately inflated) - -benchmarking main/large/superbuffer (init=128 bytes) -time 20.19 ms (19.47 ms .. 20.74 ms) - 0.996 R² (0.992 R² .. 0.998 R²) -mean 22.49 ms (21.65 ms .. 23.82 ms) -std dev 2.533 ms (1.626 ms .. 3.812 ms) -variance introduced by outliers: 51% (severely inflated) - -benchmarking main/large/superbuffer (init=400000 bytes) -time 21.03 ms (20.42 ms .. 21.69 ms) - 0.997 R² (0.995 R² .. 0.999 R²) -mean 21.17 ms (20.81 ms .. 21.85 ms) -std dev 1.095 ms (623.6 μs .. 1.826 ms) -variance introduced by outliers: 18% (moderately inflated) - -benchmarking main/large/superbuffer (init=800000 bytes) -time 28.01 ms (27.01 ms .. 29.08 ms) - 0.992 R² (0.981 R² .. 0.998 R²) -mean 27.51 ms (26.32 ms .. 28.46 ms) -std dev 2.271 ms (1.609 ms .. 3.314 ms) -variance introduced by outliers: 32% (moderately inflated) - -benchmarking main/large/superbuffer (init=1600000 bytes) -time 22.41 ms (21.10 ms .. 23.55 ms) - 0.991 R² (0.985 R² .. 0.997 R²) -mean 24.47 ms (23.70 ms .. 25.88 ms) -std dev 2.373 ms (1.559 ms .. 3.479 ms) -variance introduced by outliers: 43% (moderately inflated) - -benchmarking main/large/superbuffer (init=20000000 bytes) -time 16.26 ms (15.84 ms .. 16.73 ms) - 0.996 R² (0.993 R² .. 0.998 R²) -mean 16.36 ms (16.15 ms .. 16.71 ms) -std dev 645.5 μs (444.5 μs .. 1.039 ms) -variance introduced by outliers: 12% (moderately inflated) - -benchmarking main/large/superbuffer (init=128 bytes, threadsafe, 2 concurrent writes) -time 21.83 ms (21.42 ms .. 22.27 ms) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 22.34 ms (22.00 ms .. 23.16 ms) -std dev 1.137 ms (507.0 μs .. 2.059 ms) -variance introduced by outliers: 19% (moderately inflated) - -benchmarking main/large/superbuffer (init=400000 bytes, threadsafe, 2 concurrent writes) -time 20.75 ms (20.19 ms .. 21.11 ms) - 0.998 R² (0.995 R² .. 0.999 R²) -mean 22.37 ms (21.79 ms .. 23.07 ms) -std dev 1.423 ms (971.3 μs .. 1.764 ms) -variance introduced by outliers: 24% (moderately inflated) - -benchmarking main/large/superbuffer (init=800000 bytes, threadsafe, 2 concurrent writes) -time 26.87 ms (26.39 ms .. 27.40 ms) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 27.69 ms (27.16 ms .. 28.82 ms) -std dev 1.668 ms (796.8 μs .. 3.007 ms) -variance introduced by outliers: 21% (moderately inflated) - -benchmarking main/large/superbuffer (init=1600000 bytes, threadsafe, 2 concurrent writes) -time 21.94 ms (21.20 ms .. 22.83 ms) - 0.993 R² (0.986 R² .. 0.997 R²) -mean 22.67 ms (22.10 ms .. 23.47 ms) -std dev 1.557 ms (927.2 μs .. 2.176 ms) -variance introduced by outliers: 29% (moderately inflated) - -benchmarking main/large/superbuffer (init=20000000 bytes, threadsafe, 2 concurrent writes) -time 15.28 ms (14.51 ms .. 16.07 ms) - 0.985 R² (0.969 R² .. 0.994 R²) -mean 18.44 ms (17.30 ms .. 20.47 ms) -std dev 3.914 ms (2.383 ms .. 5.301 ms) -variance introduced by outliers: 82% (severely inflated) - -benchmarking main/large/buffer-builder (init=128 bytes, trim=yes) -time 27.25 ms (26.22 ms .. 28.09 ms) - 0.995 R² (0.991 R² .. 0.998 R²) -mean 29.72 ms (28.85 ms .. 30.97 ms) -std dev 2.197 ms (1.692 ms .. 2.863 ms) -variance introduced by outliers: 27% (moderately inflated) - -benchmarking main/large/buffer-builder (init=400000 bytes, trim=yes) -time 24.62 ms (23.86 ms .. 25.37 ms) - 0.995 R² (0.990 R² .. 0.998 R²) -mean 24.56 ms (24.11 ms .. 25.03 ms) -std dev 1.013 ms (806.5 μs .. 1.291 ms) -variance introduced by outliers: 15% (moderately inflated) - -benchmarking main/large/buffer-builder (init=800000 bytes, trim=yes) -time 24.85 ms (24.37 ms .. 25.24 ms) - 0.999 R² (0.998 R² .. 1.000 R²) -mean 24.37 ms (24.10 ms .. 24.59 ms) -std dev 550.3 μs (407.5 μs .. 728.3 μs) - -benchmarking main/large/buffer-builder (init=1600000 bytes, trim=yes) -time 24.18 ms (21.67 ms .. 25.98 ms) - 0.978 R² (0.963 R² .. 0.993 R²) -mean 22.34 ms (21.77 ms .. 23.09 ms) -std dev 1.560 ms (1.157 ms .. 2.056 ms) -variance introduced by outliers: 29% (moderately inflated) - -benchmarking main/large/buffer-builder (init=20000000 bytes, trim=yes) -time 40.55 ms (38.93 ms .. 42.77 ms) - 0.985 R² (0.965 R² .. 0.995 R²) -mean 33.52 ms (30.49 ms .. 36.43 ms) -std dev 5.750 ms (4.777 ms .. 6.724 ms) -variance introduced by outliers: 67% (severely inflated) - -benchmarking main/large/bytestring builder -time 20.71 ms (19.41 ms .. 21.67 ms) - 0.987 R² (0.975 R² .. 0.994 R²) -mean 23.80 ms (22.91 ms .. 24.66 ms) -std dev 2.027 ms (1.762 ms .. 2.468 ms) -variance introduced by outliers: 38% (moderately inflated) - -benchmarking main/large/bytestring fromChunks -time 21.18 ms (20.72 ms .. 21.62 ms) - 0.998 R² (0.995 R² .. 0.999 R²) -mean 21.64 ms (21.28 ms .. 22.18 ms) -std dev 1.000 ms (589.7 μs .. 1.621 ms) -variance introduced by outliers: 18% (moderately inflated) - -benchmarking main/large/bytestring concat -time 21.59 ms (20.97 ms .. 22.39 ms) - 0.997 R² (0.993 R² .. 0.999 R²) -mean 21.80 ms (21.57 ms .. 22.11 ms) -std dev 600.9 μs (451.9 μs .. 767.7 μs) -``` +See: [Benchmarks for 0.3.0.0](https://agrafix.github.io/superbuffer/benchmarks-0.3.0.0.html) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/bench/Bench.hs new/superbuffer-0.3.1.1/bench/Bench.hs --- old/superbuffer-0.2.0.1/bench/Bench.hs 2016-12-02 10:12:37.000000000 +0100 +++ new/superbuffer-0.3.1.1/bench/Bench.hs 2016-12-11 15:52:26.000000000 +0100 @@ -5,6 +5,7 @@ import Criterion import Criterion.Main import Data.ByteString.SuperBuffer +import qualified Data.ByteString.SuperBuffer.Pure as P import Data.Int import qualified Data.BufferBuilder as BB import qualified Data.ByteString as BS @@ -26,6 +27,8 @@ bgroup name $ mkSizedGroup steps chunkSize bufName buildBuf ++ mkSizedGroup steps chunkSize bufNameT buildBufT + ++ mkSizedGroup steps chunkSize bufNameP buildBufP + ++ mkSizedGroup steps chunkSize bufNamePT buildBufPT ++ mkSizedGroup steps chunkSize bufBBName buildBufBB ++ [ bench "bytestring builder" $ nfIO $ BS.reverse <$> buildBufBuilder steps chunkSize @@ -36,6 +39,8 @@ bufBBName is = "buffer-builder (init=" ++ show is ++ " bytes, trim=yes)" bufName is = "superbuffer (init=" ++ show is ++ " bytes)" bufNameT is = "superbuffer (init=" ++ show is ++ " bytes, threadsafe, 2 concurrent writes)" + bufNameP is = "superbuffer (pure haskell, init=" ++ show is ++ " bytes)" + bufNamePT is = "superbuffer (pure haskell, init=" ++ show is ++ " bytes, threadsafe, 2 concurrent writes)" mkSizedGroup :: Int -> Int -> (Int64 -> String) -> (Int64 -> Int -> Int -> IO BS.ByteString) -> [Benchmark] @@ -74,6 +79,23 @@ where halfSteps :: Double halfSteps = fromIntegral steps / 2.0 + +buildBufP :: Int64 -> Int -> Int -> IO BS.ByteString +buildBufP bufSize steps chunkSize = + P.withBuffer (fromIntegral bufSize) $ \buf -> + forM_ [0..steps] $ \step -> + P.appendBuffer buf (mkChunk step chunkSize) + +buildBufPT :: Int64 -> Int -> Int -> IO BS.ByteString +buildBufPT bufSize steps chunkSize = + P.withBuffer (fromIntegral bufSize) $ \buf -> + forM_ [0..(ceiling halfSteps)] $ \step -> + concurrently_ + (P.appendBufferT buf (mkChunk step chunkSize)) + (P.appendBufferT buf (mkChunk step chunkSize)) + where + halfSteps :: Double + halfSteps = fromIntegral steps / 2.0 buildBufBB :: Int64 -> Int -> Int -> IO BS.ByteString buildBufBB bufSize steps chunkSize = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/cbits/superbuffer.c new/superbuffer-0.3.1.1/cbits/superbuffer.c --- old/superbuffer-0.2.0.1/cbits/superbuffer.c 2016-12-03 16:28:11.000000000 +0100 +++ new/superbuffer-0.3.1.1/cbits/superbuffer.c 2017-03-27 22:40:27.000000000 +0200 @@ -56,3 +56,8 @@ { free(buf); } + +size_t size_sbuf(struct sbuf *buf) +{ + return buf->currentSize; +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/package.yaml new/superbuffer-0.3.1.1/package.yaml --- old/superbuffer-0.2.0.1/package.yaml 2016-12-03 15:32:04.000000000 +0100 +++ new/superbuffer-0.3.1.1/package.yaml 2017-05-26 19:12:04.000000000 +0200 @@ -1,12 +1,12 @@ name: superbuffer -version: 0.2.0.1 +version: 0.3.1.1 synopsis: Efficiently build a bytestring from smaller chunks description: Efficiently (both fast and memory efficient) build a bytestring from smaller chunks homepage: https://github.com/agrafix/superbuffer#readme license: BSD3 author: Alexander Thiemann maintainer: mail(a)athiemann.net -copyright: 2016 Alexander Thiemann <mail(a)athiemann.net> +copyright: 2016 - 2017 Alexander Thiemann <mail(a)athiemann.net> category: Web extra-source-files: - README.md @@ -22,7 +22,8 @@ library: source-dirs: src exposed-modules: - Data.ByteString.SuperBuffer + - Data.ByteString.SuperBuffer + - Data.ByteString.SuperBuffer.Pure c-sources: cbits/superbuffer.c tests: @@ -42,7 +43,7 @@ main: Bench.hs source-dirs: bench dependencies: - - criterion < 1.2 + - criterion < 1.3 - superbuffer - buffer-builder - async diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/src/Data/ByteString/SuperBuffer/Pure.hs new/superbuffer-0.3.1.1/src/Data/ByteString/SuperBuffer/Pure.hs --- old/superbuffer-0.2.0.1/src/Data/ByteString/SuperBuffer/Pure.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/superbuffer-0.3.1.1/src/Data/ByteString/SuperBuffer/Pure.hs 2017-03-27 22:43:06.000000000 +0200 @@ -0,0 +1,100 @@ +module Data.ByteString.SuperBuffer.Pure + ( SuperBuffer, withBuffer, appendBuffer, appendBufferT, size ) +where + +import Control.Concurrent.MVar +import Control.Exception +import Data.Bits +import Data.IORef +import Data.Word +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Ptr +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS + +-- | The buffer data structure. +data SuperBuffer + = SuperBuffer + { sb_buffer :: {-# UNPACK #-}!(IORef (Ptr Word8)) + , sb_currentSize :: {-# UNPACK #-}!(IORef Int) + , sb_maxSize :: {-# UNPACK #-}!(IORef Int) + , sb_lock :: {-# UNPACK #-}!(MVar ()) + } + +-- | Allocate a new buffer with a given initial size. The perfect starting point +-- depends on the expected total size and the average size for a single chunk +-- written with 'appendBuffer'. You can always start with 1024 and optimize from +-- there with benchmarks. Please note that the SuperBuffer will no longer be +-- valid after this function terminates, so do NOT pass it to some other +-- thread without waiting for it to finish in the action. +withBuffer :: Int -> (SuperBuffer -> IO ()) -> IO BS.ByteString +withBuffer sz action = + do ptr <- mallocBytes sz + ptrRef <- newIORef ptr + go ptrRef `onException` freeOnException ptrRef + where + freeOnException ref = + do ptr <- readIORef ref + free ptr + go ptrRef = + do sizeRef <- newIORef 0 + maxSizeRef <- newIORef sz + lock <- newEmptyMVar + let sb = SuperBuffer ptrRef sizeRef maxSizeRef lock + action sb + readBuffer sb +{-# INLINE withBuffer #-} + +-- | Write a bytestring to the buffer and grow the buffer if needed. Note that only +-- one thread at any given time may call this function. Use 'appendBufferT' when +-- accessing 'SuperBuffer' from multiple threads. +appendBuffer :: SuperBuffer -> BS.ByteString -> IO () +appendBuffer sb bs + | BS.null bs = pure () + | otherwise = + BS.unsafeUseAsCStringLen bs $ \(cstr, len) -> + do currentSize <- readIORef (sb_currentSize sb) + maxSize <- readIORef (sb_maxSize sb) + let nextSize = currentSize + len + writePtr <- + if nextSize > maxSize + then do let maxSize' = nextSize + unsafeShiftR nextSize 1 + writeIORef (sb_maxSize sb) maxSize' + buff <- readIORef (sb_buffer sb) + buff' <- reallocBytes buff maxSize' + writeIORef (sb_buffer sb) buff' + pure buff' + else readIORef (sb_buffer sb) + let copyTarget = writePtr `plusPtr` currentSize + copyBytes copyTarget cstr len + writeIORef (sb_currentSize sb) (currentSize + len) +{-# INLINE appendBuffer #-} + +-- | Write a bytestring to the buffer and grow the buffer if needed. This function +-- can be used accross different threads, but is slower than 'appendBuffer'. +appendBufferT :: SuperBuffer -> BS.ByteString -> IO () +appendBufferT sb bs = + bracket_ (putMVar (sb_lock sb) ()) (takeMVar (sb_lock sb)) $ + appendBuffer sb bs +{-# INLINE appendBufferT #-} + +-- | Read the final buffer contents. This must only be called once +readBuffer :: SuperBuffer -> IO BS.ByteString +readBuffer sb = + do (buff, currentSize, maxSize) <- + (,,) + <$> readIORef (sb_buffer sb) + <*> readIORef (sb_currentSize sb) + <*> readIORef (sb_maxSize sb) + finalPtr <- + if currentSize < maxSize + then reallocBytes buff currentSize + else pure buff + BS.unsafePackCStringFinalizer finalPtr currentSize (free finalPtr) +{-# INLINE readBuffer #-} + +-- | Get current (filled) size of the buffer +size :: SuperBuffer -> IO Int +size sb = readIORef $ sb_currentSize sb +{-# INLINE size #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/src/Data/ByteString/SuperBuffer.hs new/superbuffer-0.3.1.1/src/Data/ByteString/SuperBuffer.hs --- old/superbuffer-0.2.0.1/src/Data/ByteString/SuperBuffer.hs 2016-12-03 16:28:11.000000000 +0100 +++ new/superbuffer-0.3.1.1/src/Data/ByteString/SuperBuffer.hs 2017-03-27 22:44:22.000000000 +0200 @@ -2,7 +2,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.ByteString.SuperBuffer - ( SuperBuffer, withBuffer, appendBuffer, appendBufferT + ( SuperBuffer, withBuffer, appendBuffer, appendBufferT, size ) where @@ -27,8 +27,8 @@ -- valid after this function terminates, so do NOT pass it to some other -- thread without waiting for it to finish in the action. withBuffer :: Int64 -> (SuperBuffer -> IO ()) -> IO BS.ByteString -withBuffer size action = - bracket (newBuffer size) destroyBuffer $ \buf -> +withBuffer sz action = + bracket (newBuffer sz) destroyBuffer $ \buf -> do ok <- try (action buf) case ok of Left (exception :: SomeException) -> @@ -39,7 +39,7 @@ {-# INLINE withBuffer #-} newBuffer :: Int64 -> IO SuperBuffer -newBuffer size = SuperBuffer <$> ((,) <$> new_sbuf (fromIntegral size) <*> newEmptyMVar) +newBuffer sz = SuperBuffer <$> ((,) <$> new_sbuf (fromIntegral sz) <*> newEmptyMVar) {-# INLINE newBuffer #-} @@ -72,16 +72,22 @@ -- be called once readBuffer :: SuperBuffer -> IO BS.ByteString readBuffer (SuperBuffer (ptr, _)) = - do (cstr, size) <- readLocal - BS.unsafePackCStringFinalizer (coerce cstr) (fromIntegral size) (free cstr) + do (cstr, sz) <- readLocal + BS.unsafePackCStringFinalizer (coerce cstr) (fromIntegral sz) (free cstr) where readLocal = alloca $ \sizePtr -> do cstr <- read_sbuf ptr sizePtr - size <- peek sizePtr - pure (cstr, size) + sz <- peek sizePtr + pure (cstr, sz) {-# INLINE readBuffer #-} +-- | Get current (filled) size of the buffer +size :: SuperBuffer -> IO Int +size (SuperBuffer (ptr, _)) = + fromIntegral <$> size_sbuf ptr +{-# INLINE size #-} + data SBuf type SuperBufferP = Ptr SBuf @@ -90,3 +96,4 @@ foreign import ccall unsafe "read_sbuf" read_sbuf :: SuperBufferP -> Ptr CSize -> IO CString foreign import ccall unsafe "destroy_sbuf" destroy_sbuf :: SuperBufferP -> IO () foreign import ccall unsafe "destroyContents_sbuf" destroyContents_sbuf :: SuperBufferP -> IO () +foreign import ccall unsafe "size_sbuf" size_sbuf :: SuperBufferP -> IO CSize diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/superbuffer.cabal new/superbuffer-0.3.1.1/superbuffer.cabal --- old/superbuffer-0.2.0.1/superbuffer.cabal 2016-12-03 15:43:34.000000000 +0100 +++ new/superbuffer-0.3.1.1/superbuffer.cabal 2017-05-26 19:12:13.000000000 +0200 @@ -1,16 +1,16 @@ --- This file has been generated from package.yaml by hpack version 0.14.0. +-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack name: superbuffer -version: 0.2.0.1 +version: 0.3.1.1 synopsis: Efficiently build a bytestring from smaller chunks description: Efficiently (both fast and memory efficient) build a bytestring from smaller chunks category: Web homepage: https://github.com/agrafix/superbuffer#readme author: Alexander Thiemann maintainer: mail(a)athiemann.net -copyright: 2016 Alexander Thiemann <mail(a)athiemann.net> +copyright: 2016 - 2017 Alexander Thiemann <mail(a)athiemann.net> license: BSD3 license-file: LICENSE build-type: Simple @@ -32,6 +32,7 @@ , bytestring < 0.11 exposed-modules: Data.ByteString.SuperBuffer + Data.ByteString.SuperBuffer.Pure other-modules: Paths_superbuffer default-language: Haskell2010 @@ -61,7 +62,7 @@ build-depends: base >= 4.8 && < 5 , bytestring < 0.11 - , criterion < 1.2 + , criterion < 1.3 , superbuffer , buffer-builder , async diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/superbuffer-0.2.0.1/test/Test.hs new/superbuffer-0.3.1.1/test/Test.hs --- old/superbuffer-0.2.0.1/test/Test.hs 2016-12-02 10:02:58.000000000 +0100 +++ new/superbuffer-0.3.1.1/test/Test.hs 2017-03-27 22:45:34.000000000 +0200 @@ -7,6 +7,7 @@ import Data.ByteString.SuperBuffer import Data.Int import qualified Data.ByteString as BS +import qualified Data.ByteString.SuperBuffer.Pure as P import Test.Framework import Test.QuickCheck.Monadic @@ -14,6 +15,14 @@ main :: IO () main = htfMain htf_thisModulesTests +test_size :: IO () +test_size = + void $ + withBuffer 8 $ \buf -> + do appendBuffer buf "hello" + sz <- size buf + assertEqual sz 5 + test_basic :: IO () test_basic = do bs <- fillBuf @@ -77,3 +86,61 @@ chunkAction = withBuffer bufSize $ \buf -> forM_ chunks $ appendBuffer buf + +test_sizePure :: IO () +test_sizePure = + void $ + P.withBuffer 8 $ \buf -> + do P.appendBuffer buf "hello" + sz <- P.size buf + assertEqual sz 5 + +test_basicPure :: IO () +test_basicPure = + do bs <- fillBuf + assertEqual bs expected + where + expected = + "hello world! Welcome to S U P E R B U F F E R" + fillBuf = + P.withBuffer 8 $ \buf -> + do P.appendBuffer buf "hello" + P.appendBuffer buf " world" + P.appendBuffer buf "!" + P.appendBuffer buf " Welcome" + P.appendBuffer buf " to" + P.appendBuffer buf " S U P E R B U F F E R" + +test_nullContainedPure :: IO () +test_nullContainedPure = + do bs <- fillBuf + assertEqual bs expected + where + expected = + "hello\0world" + fillBuf = + P.withBuffer 8 $ \buf -> + do P.appendBuffer buf "hello" + P.appendBuffer buf "\0world" + +test_threadedPure :: IO () +test_threadedPure = + do bs <- fillBuf + assertEqual bs expected + where + expected = + "hello world! Welcome to S U P E R B U F F E R" + fillBuf = + P.withBuffer 8 $ \buf -> + forConcurrently_ ["hello", " world", "!", " Welcome", " to", " S U P E R B U F F E R"] $ + P.appendBufferT buf + +prop_appendingWorksPure :: BufferChunks -> Property +prop_appendingWorksPure (BufferChunks (bufSize, chunks)) = + monadicIO $ + do out <- run chunkAction + assert $ out == BS.concat chunks + where + chunkAction = + P.withBuffer (fromIntegral bufSize) $ \buf -> + forM_ chunks $ P.appendBuffer buf

1 0

commit ghc-stratosphere for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-stratosphere for openSUSE:Factory checked in at 2017-08-31 20:59:57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-stratosphere (Old) and /work/SRC/openSUSE:Factory/.ghc-stratosphere.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-stratosphere" Thu Aug 31 20:59:57 2017 rev:4 rq:513503 version:0.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-stratosphere/ghc-stratosphere.changes 2017-07-27 11:12:15.237388824 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-stratosphere.new/ghc-stratosphere.changes 2017-08-31 20:59:59.977606323 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:17 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.0. + +------------------------------------------------------------------- Old: ---- stratosphere-0.4.4.tar.gz New: ---- stratosphere-0.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-stratosphere.spec ++++++ --- /var/tmp/diff_new_pack.UEVT1U/_old 2017-08-31 21:00:01.141442801 +0200 +++ /var/tmp/diff_new_pack.UEVT1U/_new 2017-08-31 21:00:01.149441678 +0200 @@ -19,7 +19,7 @@ %global pkg_name stratosphere %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.4 +Version: 0.6.0 Release: 0 Summary: EDSL for AWS CloudFormation License: MIT ++++++ stratosphere-0.4.4.tar.gz -> stratosphere-0.6.0.tar.gz ++++++ ++++ 30745 lines of diff (skipped)

1 0

commit ghc-store-core for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-store-core for openSUSE:Factory checked in at 2017-08-31 20:59:54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-store-core (Old) and /work/SRC/openSUSE:Factory/.ghc-store-core.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-store-core" Thu Aug 31 20:59:54 2017 rev:3 rq:513502 version:0.4.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-store-core/ghc-store-core.changes 2017-05-10 20:49:01.655461889 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-store-core.new/ghc-store-core.changes 2017-08-31 20:59:55.182280079 +0200 @@ -1,0 +2,5 @@ +Wed Jul 26 16:56:09 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.1. + +------------------------------------------------------------------- Old: ---- store-core-0.3.tar.gz New: ---- store-core-0.4.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-store-core.spec ++++++ --- /var/tmp/diff_new_pack.MCmqLC/_old 2017-08-31 20:59:55.942173312 +0200 +++ /var/tmp/diff_new_pack.MCmqLC/_new 2017-08-31 20:59:55.946172750 +0200 @@ -18,7 +18,7 @@ %global pkg_name store-core Name: ghc-%{pkg_name} -Version: 0.3 +Version: 0.4.1 Release: 0 Summary: Fast and lightweight binary serialization License: MIT ++++++ store-core-0.3.tar.gz -> store-core-0.4.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-core-0.3/ChangeLog.md new/store-core-0.4.1/ChangeLog.md --- old/store-core-0.3/ChangeLog.md 2016-10-24 05:13:37.000000000 +0200 +++ new/store-core-0.4.1/ChangeLog.md 2017-05-06 04:54:38.000000000 +0200 @@ -1,5 +1,15 @@ # ChangeLog +## 0.4.1 + +* Less aggressive inlining, resulting in faster compilation / simplifier + not running out of ticks + +## 0.4 + +* Changes result of Peek function to be strict. + (See [#98](https://github.com/fpco/store/pull/98)) + ## 0.3 * Adds support for alignment sensitive architectures, by using temporary buffers diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-core-0.3/src/Data/Store/Core.hs new/store-core-0.4.1/src/Data/Store/Core.hs --- old/store-core-0.3/src/Data/Store/Core.hs 2016-10-16 03:35:26.000000000 +0200 +++ new/store-core-0.4.1/src/Data/Store/Core.hs 2017-05-06 05:07:24.000000000 +0200 @@ -13,7 +13,7 @@ module Data.Store.Core ( -- * Core Types Poke(..), PokeException(..), pokeException - , Peek(..), PeekException(..), peekException, tooManyBytes + , Peek(..), PeekResult(..), PeekException(..), peekException, tooManyBytes , PokeState, pokeStatePtr , PeekState, peekStateEndPtr , Offset @@ -174,26 +174,29 @@ -- together to get more complicated deserializers. This machinery keeps -- track of the current 'Ptr' and end-of-buffer 'Ptr'. newtype Peek a = Peek - { runPeek :: PeekState -> Ptr Word8 -> IO (Ptr Word8, a) + { runPeek :: PeekState -> Ptr Word8 -> IO (PeekResult a) -- ^ Run the 'Peek' action, with a 'Ptr' to the end of the buffer -- where data is poked, and a 'Ptr' to the current position. The -- result is the 'Ptr', along with a return value. -- -- May throw a 'PeekException' if the memory contains invalid -- values. - } - deriving Functor + } deriving (Functor) + +-- | A result of a 'Peek' action containing the current 'Ptr' and a return value. +data PeekResult a = PeekResult {-# UNPACK #-} !(Ptr Word8) !a + deriving (Functor) instance Applicative Peek where - pure x = Peek (\_ ptr -> return (ptr, x)) + pure x = Peek (\_ ptr -> return $ PeekResult ptr x) {-# INLINE pure #-} Peek f <*> Peek g = Peek $ \end ptr1 -> do - (ptr2, f') <- f end ptr1 - (ptr3, g') <- g end ptr2 - return (ptr3, f' g') + PeekResult ptr2 f' <- f end ptr1 + PeekResult ptr3 g' <- g end ptr2 + return $ PeekResult ptr3 (f' g') {-# INLINE (<*>) #-} Peek f *> Peek g = Peek $ \end ptr1 -> do - (ptr2, _) <- f end ptr1 + PeekResult ptr2 _ <- f end ptr1 g end ptr2 {-# INLINE (*>) #-} @@ -203,7 +206,7 @@ (>>) = (*>) {-# INLINE (>>) #-} Peek x >>= f = Peek $ \end ptr1 -> do - (ptr2, x') <- x end ptr1 + PeekResult ptr2 x' <- x end ptr1 runPeek (f x') end ptr2 {-# INLINE (>>=) #-} fail = peekException . T.pack @@ -219,11 +222,11 @@ type PrimState Peek = RealWorld primitive action = Peek $ \_ ptr -> do x <- primitive (unsafeCoerce# action) - return (ptr, x) + return $ PeekResult ptr x {-# INLINE primitive #-} instance MonadIO Peek where - liftIO f = Peek $ \_ ptr -> (ptr, ) <$> f + liftIO f = Peek $ \_ ptr -> PeekResult ptr <$> f {-# INLINE liftIO #-} -- | Holds a 'peekStatePtr', which is passed in to each 'Peek' action. @@ -310,7 +313,6 @@ } (o, ()) <- runPoke f ps 0 checkOffset o l -{-# INLINE unsafeEncodeWith #-} #if ALIGNED_MEMORY alignBufferSize :: Int @@ -336,21 +338,18 @@ -- consume all input. decodeWith :: Peek a -> ByteString -> Either PeekException a decodeWith mypeek = unsafePerformIO . try . decodeIOWith mypeek -{-# INLINE decodeWith #-} -- | Decodes a value from a 'ByteString', potentially throwing -- exceptions, and taking a 'Peek' to run. It is an exception to not -- consume all input. decodeExWith :: Peek a -> ByteString -> a decodeExWith f = unsafePerformIO . decodeIOWith f -{-# INLINE decodeExWith #-} -- | Similar to 'decodeExWith', but it allows there to be more of the -- buffer remaining. The 'Offset' of the buffer contents immediately -- after the decoded value is returned. decodeExPortionWith :: Peek a -> ByteString -> (Offset, a) decodeExPortionWith f = unsafePerformIO . decodeIOPortionWith f -{-# INLINE decodeExPortionWith #-} -- | Decodes a value from a 'ByteString', potentially throwing -- exceptions, and taking a 'Peek' to run. It is an exception to not @@ -360,7 +359,6 @@ withForeignPtr x $ \ptr0 -> let ptr = ptr0 `plusPtr` s in decodeIOWithFromPtr mypeek ptr len -{-# INLINE decodeIOWith #-} -- | Similar to 'decodeExPortionWith', but runs in the 'IO' monad. decodeIOPortionWith :: Peek a -> ByteString -> IO (Offset, a) @@ -368,7 +366,6 @@ withForeignPtr x $ \ptr0 -> let ptr = ptr0 `plusPtr` s in decodeIOPortionWithFromPtr mypeek ptr len -{-# INLINE decodeIOPortionWith #-} -- | Like 'decodeIOWith', but using 'Ptr' and length instead of a -- 'ByteString'. @@ -378,14 +375,13 @@ if len /= offset then throwIO $ PeekException (len - offset) "Didn't consume all input." else return x -{-# INLINE decodeIOWithFromPtr #-} -- | Like 'decodeIOPortionWith', but using 'Ptr' and length instead of a 'ByteString'. decodeIOPortionWithFromPtr :: Peek a -> Ptr Word8 -> Int -> IO (Offset, a) decodeIOPortionWithFromPtr mypeek ptr len = let end = ptr `plusPtr` len remaining = end `minusPtr` ptr - in do (ptr2, x') <- + in do PeekResult ptr2 x' <- #if ALIGNED_MEMORY allocaBytesAligned alignBufferSize 8 $ \aptr -> do runPeek mypeek (PeekState end aptr) ptr @@ -396,7 +392,6 @@ if len > remaining -- Do not perform the check on the new pointer, since it could have overflowed then throwIO $ PeekException (end `minusPtr` ptr2) "Overshot end of buffer" else return (ptr2 `minusPtr` ptr, x') -{-# INLINE decodeIOPortionWithFromPtr #-} ------------------------------------------------------------------------ -- Utilities for defining 'Store' instances based on 'Storable' @@ -464,7 +459,7 @@ #else x <- Storable.peek (castPtr ptr) #endif - return (ptr', x) + return $ PeekResult ptr' x {-# INLINE peekStorableTy #-} ------------------------------------------------------------------------ @@ -483,7 +478,6 @@ len let !newOffset = targetOffset + len return (newOffset, ()) -{-# INLINE pokeFromForeignPtr #-} -- | Allocate a plain ForeignPtr (no finalizers), of the specified -- length and fill it with bytes from the input. @@ -499,8 +493,7 @@ fp <- BS.mallocByteString len withForeignPtr fp $ \targetPtr -> BS.memcpy targetPtr (castPtr sourcePtr) len - return (ptr2, castForeignPtr fp) -{-# INLINE peekToPlainForeignPtr #-} + return $ PeekResult ptr2 (castForeignPtr fp) -- | Copy a section of memory, based on a 'Ptr', to the output. Note -- that this operation is unsafe, because the offset and length @@ -514,7 +507,6 @@ len let !newOffset = targetOffset + len return (newOffset, ()) -{-# INLINE pokeFromPtr #-} -- TODO: have a safer variant with the check? @@ -528,7 +520,6 @@ copyByteArrayToAddr sourceArr sourceOffset target len let !newOffset = targetOffset + len return (newOffset, ()) -{-# INLINE pokeFromByteArray #-} -- | Allocate a ByteArray of the specified length and fill it with bytes -- from the input. @@ -544,8 +535,7 @@ marr <- newByteArray len copyAddrToByteArray sourcePtr marr 0 len x <- unsafeFreezeByteArray marr - return (ptr2, x) -{-# INLINE peekToByteArray #-} + return $ PeekResult ptr2 x -- | Wrapper around @copyByteArrayToAddr#@ primop. copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-core-0.3/store-core.cabal new/store-core-0.4.1/store-core.cabal --- old/store-core-0.3/store-core.cabal 2016-10-24 05:51:09.000000000 +0200 +++ new/store-core-0.4.1/store-core.cabal 2017-05-06 04:57:04.000000000 +0200 @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.14.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: store-core -version: 0.3 +version: 0.4.1 synopsis: Fast and lightweight binary serialization category: Serialization, Data homepage: https://github.com/fpco/store#readme

1 0

commit ghc-store for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-store for openSUSE:Factory checked in at 2017-08-31 20:59:52 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-store (Old) and /work/SRC/openSUSE:Factory/.ghc-store.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-store" Thu Aug 31 20:59:52 2017 rev:2 rq:513501 version:0.4.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-store/ghc-store.changes 2017-05-10 20:51:04.318153140 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-store.new/ghc-store.changes 2017-08-31 20:59:53.438525082 +0200 @@ -1,0 +2,5 @@ +Wed Jul 26 16:56:09 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.3.1. + +------------------------------------------------------------------- Old: ---- store-0.3.1.tar.gz New: ---- store-0.4.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-store.spec ++++++ --- /var/tmp/diff_new_pack.AkTH4d/_old 2017-08-31 20:59:54.550368864 +0200 +++ /var/tmp/diff_new_pack.AkTH4d/_new 2017-08-31 20:59:54.558367740 +0200 @@ -19,7 +19,7 @@ %global pkg_name store %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.1 +Version: 0.4.3.1 Release: 0 Summary: Fast binary serialization License: MIT ++++++ store-0.3.1.tar.gz -> store-0.4.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/ChangeLog.md new/store-0.4.3.1/ChangeLog.md --- old/store-0.3.1/ChangeLog.md 2017-02-16 07:28:28.000000000 +0100 +++ new/store-0.4.3.1/ChangeLog.md 2017-05-09 02:43:17.000000000 +0200 @@ -1,5 +1,44 @@ # ChangeLog +## 0.4.3.1 + +* Fixed compilation on GHC 7.8 + +## 0.4.3 + +* Less aggressive inlining, resulting in faster compilation / simplifier + not running out of ticks + +## 0.4.2 + +* Fixed testsuite + +## 0.4.1 + +* Breaking change in the encoding of Map / Set / IntMap / IntSet, + to use ascending key order. Attempting to decode data written by + prior versions of store (and vice versa) will almost always fail + with a decent error message. If you're unlucky enough to have a + collision in the data with a random Word32 magic number, then the + error may not be so clear, or in extremely rare cases, + successfully decode, yielding incorrect results. See + [#97](https://github.com/fpco/store/issues/97) and + [#101](https://github.com/fpco/store/pull/101). + + +* Performance improvement of the 'Peek' monad, by introducing more + strictness. This required a change to the internal API. + +* API and behavior of 'Data.Store.Version' changed. Previously, it + would check the version tag after decoding the contents. It now + also stores a magic Word32 tag at the beginning, so that it fails + more gracefully when decoding input that lacks encoded version + info. + +## 0.4.0 + +Deprecated in favor of 0.4.1 + ## 0.3.1 * Fix to derivation of primitive vectors, only relevant when built with diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/bench/Bench.hs new/store-0.4.3.1/bench/Bench.hs --- old/store-0.3.1/bench/Bench.hs 2016-06-13 11:34:39.000000000 +0200 +++ new/store-0.4.3.1/bench/Bench.hs 2017-02-28 06:37:20.000000000 +0100 @@ -13,6 +13,10 @@ import Criterion.Main import qualified Data.ByteString as BS import Data.Int +import qualified Data.IntMap.Strict as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import Data.Store import Data.Typeable import qualified Data.Vector as V @@ -71,6 +75,16 @@ _ -> error "This does not compute." ) <$> V.enumFromTo 1 (100 :: Int) nestedTuples = (\i -> ((i,i+1),(i+2,i+3))) <$> V.enumFromTo (1::Int) 100 + + ints = [1..100] :: [Int] + pairs = map (\x -> (x, x)) ints + strings = show <$> ints + intsSet = Set.fromDistinctAscList ints + intSet = IntSet.fromDistinctAscList ints + intsMap = Map.fromDistinctAscList pairs + intMap = IntMap.fromDistinctAscList pairs + stringsSet = Set.fromList strings + stringsMap = Map.fromList (zip strings ints) #endif defaultMain [ bgroup "encode" @@ -80,6 +94,12 @@ , benchEncode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32])) , benchEncode' "1kb normal" (V.fromList ([1..256] :: [Int32])) , benchEncode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32])) + , benchEncode intsSet + , benchEncode intSet + , benchEncode intsMap + , benchEncode intMap + , benchEncode stringsSet + , benchEncode stringsMap #endif , benchEncode smallprods , benchEncode smallmanualprods @@ -95,6 +115,12 @@ , benchDecode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32])) , benchDecode' "1kb normal" (V.fromList ([1..256] :: [Int32])) , benchDecode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32])) + , benchDecode intsSet + , benchDecode intSet + , benchDecode intsMap + , benchDecode intMap + , benchDecode stringsSet + , benchDecode stringsMap #endif , benchDecode smallprods , benchDecode smallmanualprods diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/Impl.hs new/store-0.4.3.1/src/Data/Store/Impl.hs --- old/store-0.3.1/src/Data/Store/Impl.hs 2017-02-14 20:28:40.000000000 +0100 +++ new/store-0.4.3.1/src/Data/Store/Impl.hs 2017-05-06 04:41:28.000000000 +0200 @@ -90,26 +90,22 @@ -- this package) combined with auomatic definition of instances. encode :: Store a => a -> BS.ByteString encode x = unsafeEncodeWith (poke x) (getSize x) -{-# INLINE encode #-} -- | Decodes a value from a 'BS.ByteString'. Returns an exception if -- there's an error while decoding, or if decoding undershoots / -- overshoots the end of the buffer. decode :: Store a => BS.ByteString -> Either PeekException a decode = unsafePerformIO . try . decodeIO -{-# INLINE decode #-} -- | Decodes a value from a 'BS.ByteString', potentially throwing -- exceptions. It is an exception to not consume all input. decodeEx :: Store a => BS.ByteString -> a decodeEx = unsafePerformIO . decodeIO -{-# INLINE decodeEx #-} -- | Decodes a value from a 'BS.ByteString', potentially throwing -- exceptions. It is an exception to not consume all input. decodeIO :: Store a => BS.ByteString -> IO a decodeIO = decodeIOWith peek -{-# INLINE decodeIO #-} ------------------------------------------------------------------------ -- Size diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/Internal.hs new/store-0.4.3.1/src/Data/Store/Internal.hs --- old/store-0.3.1/src/Data/Store/Internal.hs 2017-02-14 20:29:04.000000000 +0100 +++ new/store-0.4.3.1/src/Data/Store/Internal.hs 2017-05-06 04:50:14.000000000 +0200 @@ -46,6 +46,8 @@ , sizeSet, pokeSet, peekSet -- ** Store instances in terms of IsMap , sizeMap, pokeMap, peekMap + -- *** Utilities for ordered maps + , sizeOrdMap, pokeOrdMap, peekOrdMapWith -- ** Store instances in terms of IArray , sizeArray, pokeArray, peekArray -- ** Store instances in terms of Generic @@ -54,6 +56,7 @@ , GStorePeek, genericPeek -- ** Peek utilities , skip, isolate + , peekMagic -- ** Static Size type -- -- This portion of the library is still work-in-progress. @@ -81,9 +84,12 @@ import Data.HashSet (HashSet) import Data.Hashable (Hashable) import Data.IntMap (IntMap) +import qualified Data.IntMap.Strict as IntMap import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import qualified Data.List.NonEmpty as NE import Data.Map (Map) +import qualified Data.Map.Strict as Map import Data.MonoTraversable import Data.Monoid import Data.Orphans () @@ -92,6 +98,7 @@ import Data.Sequence (Seq) import Data.Sequences (IsSequence, Index, replicateM) import Data.Set (Set) +import qualified Data.Set as Set import Data.Store.Impl import Data.Store.Core import Data.Store.TH.Internal @@ -216,11 +223,7 @@ :: (Store (ContainerKey t), Store (MapValue t), IsMap t) => t -> Poke () -pokeMap t = do - poke (olength t) - ofoldl' (\acc (k, x) -> poke k >> poke x >> acc) - (return ()) - (mapToList t) +pokeMap = pokeSequence . mapToList {-# INLINE pokeMap #-} -- | Implement 'peek' for an 'IsMap' of where both 'ContainerKey' and @@ -231,6 +234,61 @@ peekMap = mapFromList <$> peek {-# INLINE peekMap #-} +------------------------------------------------------------------------ +-- Utilities for defining 'Store' instances for ordered containers like +-- 'IntMap' and 'Map' + +-- | Marker for maps that are encoded in ascending order instead of the +-- descending order mistakenly implemented in 'peekMap' in store versions +-- < 0.4. +-- +-- See https://github.com/fpco/store/issues/97. +markMapPokedInAscendingOrder :: Word32 +markMapPokedInAscendingOrder = 1217678090 + +-- | Ensure the presence of a given magic value. +-- +-- Throws a 'PeekException' if the value isn't present. +peekMagic + :: (Eq a, Show a, Store a) + => String -> a -> Peek () +peekMagic markedThing x = do + x' <- peek + when (x' /= x) $ + fail ("Expected marker for " ++ markedThing ++ ": " ++ show x ++ " but got: " ++ show x') +{-# INLINE peekMagic #-} + +-- | Like 'sizeMap' but should only be used for ordered containers where +-- 'Data.Containers.mapToList' returns an ascending list. +sizeOrdMap + :: forall t. + (Store (ContainerKey t), Store (MapValue t), IsMap t) + => Size t +sizeOrdMap = + combineSizeWith (const markMapPokedInAscendingOrder) id size sizeMap +{-# INLINE sizeOrdMap #-} + +-- | Like 'pokeMap' but should only be used for ordered containers where +-- 'Data.Containers.mapToList' returns an ascending list. +pokeOrdMap + :: (Store (ContainerKey t), Store (MapValue t), IsMap t) + => t -> Poke () +pokeOrdMap x = poke markMapPokedInAscendingOrder >> pokeMap x +{-# INLINE pokeOrdMap #-} + +-- | Decode the results of 'pokeOrdMap' using a given function to construct +-- the map. +peekOrdMapWith + :: (Store (ContainerKey t), Store (MapValue t)) + => ([(ContainerKey t, MapValue t)] -> t) + -- ^ A function to construct the map from an ascending list such as + -- 'Map.fromDistinctAscList'. + -> Peek t +peekOrdMapWith f = do + peekMagic "ascending Map / IntMap" markMapPokedInAscendingOrder + f <$> peek +{-# INLINE peekOrdMapWith #-} + {- ------------------------------------------------------------------------ -- Utilities for defining list-like 'Store' instances in terms of Foldable @@ -279,7 +337,7 @@ remaining = peekStateEndPtr ps `minusPtr` ptr when (len > remaining) $ -- Do not perform the check on the new pointer, since it could have overflowed tooManyBytes len remaining "skip" - return (ptr2, ()) + return $ PeekResult ptr2 () -- | Isolate the input to n bytes, skipping n bytes forward. Fails if @m@ -- advances the offset beyond the isolated region. @@ -291,10 +349,10 @@ remaining = end `minusPtr` ptr when (len > remaining) $ -- Do not perform the check on the new pointer, since it could have overflowed tooManyBytes len remaining "isolate" - (ptr', x) <- runPeek m ps ptr + PeekResult ptr' x <- runPeek m ps ptr when (ptr' > end) $ throwIO $ PeekException (ptr' `minusPtr` end) "Overshot end of isolated bytes" - return (ptr2, x) + return $ PeekResult ptr2 x ------------------------------------------------------------------------ -- Instances for types based on flat representations @@ -303,9 +361,6 @@ size = sizeSequence poke = pokeSequence peek = V.unsafeFreeze =<< peekMutableSequence MV.new MV.write - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Storable a => Store (SV.Vector a) where size = VarSize $ \x -> @@ -319,9 +374,6 @@ len <- peek fp <- peekToPlainForeignPtr "Data.Storable.Vector.Vector" (sizeOf (undefined :: a) * len) liftIO $ SV.unsafeFreeze (MSV.MVector len fp) - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store BS.ByteString where size = VarSize $ \x -> @@ -335,9 +387,6 @@ len <- peek fp <- peekToPlainForeignPtr "Data.ByteString.ByteString" len return (BS.PS fp 0 len) - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store SBS.ShortByteString where size = VarSize $ \x -> @@ -351,9 +400,6 @@ len <- peek ByteArray array <- peekToByteArray "Data.ByteString.Short.ShortByteString" len return (SBS.SBS array) - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store LBS.ByteString where -- FIXME: faster conversion? Is this ever going to be a problem? @@ -366,9 +412,6 @@ -- FIXME: more efficient implementation that avoids the double copy poke = poke . LBS.toStrict peek = fmap LBS.fromStrict peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store T.Text where size = VarSize $ \x -> @@ -382,9 +425,6 @@ w16Len <- peek ByteArray array <- peekToByteArray "Data.Text.Text" (2 * w16Len) return (T.Text (TA.Array array) 0 w16Len) - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} ------------------------------------------------------------------------ -- Known size instances @@ -421,9 +461,6 @@ let len = fromInteger (natVal (Proxy :: Proxy n)) fp <- peekToPlainForeignPtr ("StaticSize " ++ show len ++ " Data.ByteString.ByteString") len return (StaticSize (BS.PS fp 0 len)) - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} -- NOTE: this could be a 'Lift' instance, but we can't use type holes in -- TH. Alternatively we'd need a (TypeRep -> Type) function and Typeable @@ -446,9 +483,6 @@ size = sizeSequence poke = pokeSequence peek = peekSequence - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store a => Store (NE.NonEmpty a) @@ -456,75 +490,62 @@ size = sizeSequence poke = pokeSequence peek = peekSequence - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance (Store a, Ord a) => Store (Set a) where - size = sizeSet + size = + VarSize $ \t -> + sizeOf (undefined :: Int) + + case size of + ConstSize n -> n * Set.size t + VarSize f -> Set.foldl' (\acc a -> acc + f a) 0 t poke = pokeSet - peek = peekSet - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} + peek = Set.fromDistinctAscList <$> peek instance Store IntSet where size = sizeSet poke = pokeSet - peek = peekSet - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} + peek = IntSet.fromDistinctAscList <$> peek instance Store a => Store (IntMap a) where - size = sizeMap - poke = pokeMap - peek = peekMap - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} + size = sizeOrdMap + poke = pokeOrdMap + peek = peekOrdMapWith IntMap.fromDistinctAscList instance (Ord k, Store k, Store a) => Store (Map k a) where - size = sizeMap - poke = pokeMap - peek = peekMap - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} + size = + VarSize $ \t -> + sizeOf markMapPokedInAscendingOrder + sizeOf (undefined :: Int) + + case (size, size) of + (ConstSize nk, ConstSize na) -> (nk + na) * Map.size t + (szk, sza) -> + Map.foldlWithKey' + (\acc k a -> acc + getSizeWith szk k + getSizeWith sza a) + 0 + t + poke = pokeOrdMap + peek = peekOrdMapWith Map.fromDistinctAscList instance (Eq k, Hashable k, Store k, Store a) => Store (HashMap k a) where size = sizeMap poke = pokeMap peek = peekMap - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance (Eq a, Hashable a, Store a) => Store (HashSet a) where size = sizeSet poke = pokeSet peek = peekSet - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance (A.Ix i, Store i, Store e) => Store (A.Array i e) where -- TODO: Speed up poke and peek size = sizeArray poke = pokeArray peek = peekArray - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance (A.Ix i, A.IArray A.UArray e, Store i, Store e) => Store (A.UArray i e) where -- TODO: Speed up poke and peek size = sizeArray poke = pokeArray peek = peekArray - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} sizeArray :: (A.Ix i, A.IArray a e, Store i, Store e) => Size (a i e) sizeArray = VarSize $ \arr -> @@ -624,9 +645,6 @@ size = contramap (\(MkFixed x) -> x) (size :: Size Integer) poke (MkFixed x) = poke x peek = MkFixed <$> peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} -- instance Store a => Store (Tree a) where @@ -645,33 +663,21 @@ size = combineSize (\(x :% _) -> x) (\(_ :% y) -> y) poke (x :% y) = poke (x, y) peek = uncurry (:%) <$> peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store Time.Day where size = contramap Time.toModifiedJulianDay (size :: Size Integer) poke = poke . Time.toModifiedJulianDay peek = Time.ModifiedJulianDay <$> peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store Time.DiffTime where size = contramap (realToFrac :: Time.DiffTime -> Pico) (size :: Size Pico) poke = (poke :: Pico -> Poke ()) . realToFrac peek = Time.picosecondsToDiffTime <$> peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store Time.UTCTime where size = combineSize Time.utctDay Time.utctDayTime poke (Time.UTCTime day time) = poke (day, time) peek = uncurry Time.UTCTime <$> peek - {-# INLINE size #-} - {-# INLINE peek #-} - {-# INLINE poke #-} instance Store () instance Store a => Store (Dual a) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/Streaming.hs new/store-0.4.3.1/src/Data/Store/Streaming.hs --- old/store-0.3.1/src/Data/Store/Streaming.hs 2017-01-06 04:12:07.000000000 +0100 +++ new/store-0.4.3.1/src/Data/Store/Streaming.hs 2017-05-06 04:41:19.000000000 +0200 @@ -80,15 +80,13 @@ poke messageMagic poke bodyLength poke x -{-# INLINE encodeMessage #-} -- | The result of peeking at the next message can either be a -- successfully deserialised object, or a request for more input. type PeekMessage i m a = FT ((->) i) m a -needMoreInput :: Monad m => PeekMessage i m i +needMoreInput :: PeekMessage i m i needMoreInput = wrap return -{-# INLINE needMoreInput #-} -- | Given some sort of input, fills the 'ByteBuffer' with it. -- @@ -100,7 +98,6 @@ -- up the encoded message. decodeFromPtr :: (MonadIO m, Store a) => Ptr Word8 -> Int -> m a decodeFromPtr ptr n = liftIO $ decodeIOWithFromPtr peek ptr n -{-# INLINE decodeFromPtr #-} peekSized :: (MonadIO m, Store a) => FillByteBuffer i m -> ByteBuffer -> Int -> PeekMessage i m a peekSized fill bb n = go @@ -113,7 +110,6 @@ lift (fill bb needed inp) go Right ptr -> decodeFromPtr ptr n -{-# INLINE peekSized #-} -- | Read and check the magic number from a 'ByteBuffer' peekMessageMagic :: MonadIO m => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m () @@ -122,12 +118,10 @@ mm | mm == messageMagic -> return () mm -> liftIO . throwIO $ PeekException 0 . T.pack $ "Wrong message magic, " ++ show mm -{-# INLINE peekMessageMagic #-} -- | Decode a 'SizeTag' from a 'ByteBuffer'. peekMessageSizeTag :: MonadIO m => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m SizeTag peekMessageSizeTag fill bb = peekSized fill bb sizeTagLength -{-# INLINE peekMessageSizeTag #-} -- | Decode some object from a 'ByteBuffer', by first reading its -- header, and then the actual data. @@ -136,7 +130,6 @@ fmap Message $ do peekMessageMagic fill bb peekMessageSizeTag fill bb >>= peekSized fill bb -{-# INLINE peekMessage #-} -- | Decode a 'Message' from a 'ByteBuffer' and an action that can get -- additional inputs to refill the buffer when necessary. @@ -165,18 +158,15 @@ return Nothing where maybeDecode m = runMaybeT (iterTM (\consumeInp -> consumeInp =<< MaybeT getInp) m) -{-# INLINE decodeMessage #-} -- | Decode some 'Message' from a 'ByteBuffer', by first reading its -- header, and then the actual 'Message'. peekMessageBS :: (MonadIO m, Store a) => ByteBuffer -> PeekMessage ByteString m (Message a) peekMessageBS = peekMessage (\bb _ bs -> BB.copyByteString bb bs) -{-# INLINE peekMessageBS #-} decodeMessageBS :: (MonadIO m, Store a) => ByteBuffer -> m (Maybe ByteString) -> m (Maybe (Message a)) decodeMessageBS = decodeMessage (\bb _ bs -> BB.copyByteString bb bs) -{-# INLINE decodeMessageBS #-} #ifndef mingw32_HOST_OS @@ -193,7 +183,6 @@ peekMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> PeekMessage ReadMoreData m (Message a) peekMessageFd bb fd = peekMessage (\bb_ needed ReadMoreData -> do _ <- BB.fillFromFd bb_ fd needed; return ()) bb -{-# INLINE peekMessageFd #-} -- | Decodes all the message using 'registerFd' to find out when a 'Socket' is -- ready for reading. @@ -207,17 +196,15 @@ case mbMsg of Just msg -> return msg Nothing -> liftIO (fail "decodeMessageFd: impossible: got Nothing") -{-# INLINE decodeMessageFd #-} #endif -- | Conduit for encoding 'Message's to 'ByteString's. conduitEncode :: (Monad m, Store a) => C.Conduit (Message a) m ByteString conduitEncode = C.map encodeMessage -{-# INLINE conduitEncode #-} -- | Conduit for decoding 'Message's from 'ByteString's. -conduitDecode :: (MonadIO m, MonadResource m, Store a) +conduitDecode :: (MonadResource m, Store a) => Maybe Int -- ^ Initial length of the 'ByteBuffer' used for -- buffering the incoming 'ByteString's. If 'Nothing', @@ -234,4 +221,3 @@ case mmessage of Nothing -> return () Just message -> C.yield message >> go buffer -{-# INLINE conduitDecode #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/TH/Internal.hs new/store-0.4.3.1/src/Data/Store/TH/Internal.hs --- old/store-0.3.1/src/Data/Store/TH/Internal.hs 2017-01-31 03:07:00.000000000 +0100 +++ new/store-0.4.3.1/src/Data/Store/TH/Internal.hs 2017-05-09 02:42:26.000000000 +0200 @@ -16,6 +16,7 @@ , deriveManyStorePrimVector , deriveManyStoreUnboxVector , deriveStore + , makeStore -- * Misc utilties used in Store test , getAllInstanceTypes1 , isMonoType @@ -46,7 +47,7 @@ import Safe (headMay) import TH.Derive (Deriver(..)) import TH.ReifySimple -import TH.Utilities (expectTyCon1, dequalify, plainInstanceD) +import TH.Utilities (expectTyCon1, dequalify, plainInstanceD, appsT) instance Deriver (Store a) where runDeriver _ preds ty = do @@ -54,6 +55,18 @@ dt <- reifyDataTypeSubstituted argTy (:[]) <$> deriveStore preds argTy (dtCons dt) +-- | Given the name of a type, generate a Store instance for it, +-- assuming that all type variables also need to be Store instances. +-- +-- Note that when used with datatypes that require type variables, the +-- ScopedTypeVariables extension is required. +makeStore :: Name -> Q [Dec] +makeStore name = do + dt <- reifyDataType name + let preds = map (storePred . VarT) (dtTvs dt) + argTy = appsT (ConT name) (map VarT (dtTvs dt)) + (:[]) <$> deriveStore preds argTy (dtCons dt) + deriveStore :: Cxt -> Type -> [DataCon] -> Q Dec deriveStore preds headTy cons0 = makeStoreInstance preds headTy @@ -244,16 +257,10 @@ deriveTupleStoreInstance :: Int -> Dec deriveTupleStoreInstance n = - deriveGenericInstance (map storeCxt tvs) + deriveGenericInstance (map storePred tvs) (foldl1 AppT (TupleT n : tvs)) where tvs = take n (map (VarT . mkName . (:[])) ['a'..'z']) - storeCxt ty = -#if MIN_VERSION_template_haskell(2,10,0) - AppT (ConT ''Store) ty -#else - ClassP ''Store [ty] -#endif deriveGenericInstance :: Cxt -> Type -> Dec deriveGenericInstance cs ty = plainInstanceD cs (AppT (ConT ''Store) ty) [] @@ -337,12 +344,6 @@ concatMap (map snd . dcFields) cons -} let extraPreds = map (storePred . AppT (ConT ''UV.Vector)) $ listify isVarT ty - storePred = -#if MIN_VERSION_template_haskell(2,10,0) - AppT (ConT ''Store) -#else - ClassP ''Store . (:[]) -#endif deriveStore (nub (preds ++ extraPreds)) ty cons _ -> fail "impossible case in deriveManyStoreUnboxVector" @@ -382,11 +383,8 @@ cs (AppT (ConT ''Store) ty) [ ValD (VarP 'size) (NormalB sizeExpr) [] - , PragmaD (InlineP 'size Inline FunLike AllPhases) , ValD (VarP 'peek) (NormalB peekExpr) [] - , PragmaD (InlineP 'peek Inline FunLike AllPhases) , ValD (VarP 'poke) (NormalB pokeExpr) [] - , PragmaD (InlineP 'poke Inline FunLike AllPhases) ] -- TODO: either generate random types that satisfy instances with @@ -427,3 +425,11 @@ getTyHead (ForallT _ _ x) = getTyHead x getTyHead (AppT l _) = getTyHead l getTyHead x = x + +storePred :: Type -> Pred +storePred ty = +#if MIN_VERSION_template_haskell(2,10,0) + AppT (ConT ''Store) ty +#else + ClassP ''Store [ty] +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/TH.hs new/store-0.4.3.1/src/Data/Store/TH.hs --- old/store-0.3.1/src/Data/Store/TH.hs 2016-10-07 01:21:44.000000000 +0200 +++ new/store-0.4.3.1/src/Data/Store/TH.hs 2017-05-09 01:45:00.000000000 +0200 @@ -2,18 +2,27 @@ -- | This module exports TH utilities intended to be useful to users. -- --- However, the visible exports do not show the main things that will be --- useful, which is using TH to generate 'Store' instances, via --- "TH.Derive". It's used like this: +-- 'makeStore' can be used to generate a 'Store' instance for types, +-- when all the type variables also require 'Store' instances. If some +-- do not, then instead use "TH.Derive" like this: -- -- @ --- data Foo = Foo Int | Bar Int +-- {-# LANGUAGE TemplateHaskell #-} +-- {-# LANGUAGE ScopedTypeVariables #-} +-- +-- import TH.Derive +-- import Data.Store +-- +-- data Foo a = Foo a | Bar Int -- -- $($(derive [d| --- instance Deriving (Store Foo) +-- instance Store a => Deriving (Store (Foo a)) -- |])) -- @ -- +-- Note that when used with datatypes that require type variables, the +-- ScopedTypeVariables extension is required. +-- -- One advantage of using this Template Haskell definition of Store -- instances is that in some cases they can be faster than the instances -- defined via Generics. Specifically, sum types which can yield @@ -21,9 +30,9 @@ -- The instances generated via generics always use 'VarSize' for sum -- types. module Data.Store.TH - ( + ( makeStore -- * Testing Store instances - smallcheckManyStore + , smallcheckManyStore , checkRoundtrip , assertRoundtrip ) where @@ -37,6 +46,7 @@ import Test.Hspec import Test.Hspec.SmallCheck (property) import Test.SmallCheck +import Data.Store.TH.Internal (makeStore) ------------------------------------------------------------------------ -- Testing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/Data/Store/Version.hs new/store-0.4.3.1/src/Data/Store/Version.hs --- old/store-0.3.1/src/Data/Store/Version.hs 2016-08-05 03:21:03.000000000 +0200 +++ new/store-0.4.3.1/src/Data/Store/Version.hs 2017-03-04 07:37:56.000000000 +0100 @@ -23,16 +23,13 @@ -- will be minimized when directly feasible. module Data.Store.Version ( StoreVersion(..) - , WithVersion(..) , VersionConfig(..) , hashedVersionConfig , namedVersionConfig - , wrapVersion - , checkVersion - , VersionCheckException(..) + , encodeWithVersionQ + , decodeWithVersionQ ) where -import Control.Exception import Control.Monad import Control.Monad.Trans.State import qualified Crypto.Hash.SHA1 as SHA1 @@ -48,6 +45,7 @@ import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.IO as T import Data.Typeable.Internal (TypeRep(..)) +import Data.Word (Word32) import GHC.Generics (Generic) import Language.Haskell.TH import System.Directory @@ -59,11 +57,6 @@ newtype StoreVersion = StoreVersion { unStoreVersion :: BS.ByteString } deriving (Eq, Show, Ord, Data, Typeable, Generic, Store) -data WithVersion a = WithVersion a StoreVersion - deriving (Eq, Show, Ord, Data, Typeable, Generic) - -instance Store a => Store (WithVersion a) - -- | Configuration for the version checking of a particular type. data VersionConfig a = VersionConfig { vcExpectedHash :: Maybe String @@ -92,13 +85,13 @@ , vcRenames = M.empty } -wrapVersion :: Data a => VersionConfig a -> Q Exp -wrapVersion = impl Wrap +encodeWithVersionQ :: Data a => VersionConfig a -> Q Exp +encodeWithVersionQ = impl Encode -checkVersion :: Data a => VersionConfig a -> Q Exp -checkVersion = impl Check +decodeWithVersionQ :: Data a => VersionConfig a -> Q Exp +decodeWithVersionQ = impl Decode -data WhichFunc = Wrap | Check +data WhichFunc = Encode | Decode impl :: forall a. Data a => WhichFunc -> VersionConfig a -> Q Exp impl wf vc = do @@ -131,15 +124,16 @@ ", but " ++ show expectedHash ++ " is specified.\n" ++ "The data used to construct the hash has been written to " ++ show newPath ++ extraMsg ++ "\n" + let atype = typeRepToType (typeRep proxy) case wf of - Wrap -> [e| (\x -> (x :: $(typeRepToType (typeRep proxy))) `WithVersion` $(version)) |] - Check -> [e| (\(WithVersion x gotVersion) -> - if gotVersion /= $(version) - then Left (VersionCheckException - { expectedVersion = $(version) - , receivedVersion = gotVersion - }) - else Right x) |] + Encode -> [e| \x -> ( getSize markEncodedVersion + getSize $(version) + getSize x + , poke markEncodedVersion >> poke $(version) >> poke (x :: $(atype))) |] + Decode -> [e| do + peekMagic "version tag" markEncodedVersion + gotVersion <- peek + if gotVersion /= $(version) + then fail (displayVersionError $(version) gotVersion) + else peek :: Peek $(atype) |] {- txtWithComments <- runIO $ T.readFile path @@ -286,26 +280,11 @@ tyConOf :: Typeable a => Proxy a -> TyCon tyConOf = typeRepTyCon . typeRep -data VersionCheckException = VersionCheckException - { expectedVersion :: StoreVersion - , receivedVersion :: StoreVersion - } deriving -#if MIN_VERSION_base(4,8,0) - (Typeable, Show) - -instance Exception VersionCheckException where - displayException = displayVCE -#else - (Typeable) - -instance Show VersionCheckException where - show = displayVCE - -instance Exception VersionCheckException -#endif - -displayVCE :: VersionCheckException -> String -displayVCE VersionCheckException{..} = +displayVersionError :: StoreVersion -> StoreVersion -> String +displayVersionError expectedVersion receivedVersion = "Mismatch detected by Data.Store.Version - expected " ++ T.unpack (decodeUtf8With lenientDecode (unStoreVersion expectedVersion)) ++ " but got " ++ T.unpack (decodeUtf8With lenientDecode (unStoreVersion receivedVersion)) + +markEncodedVersion :: Word32 +markEncodedVersion = 3908297288 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/src/System/IO/ByteBuffer.hs new/store-0.4.3.1/src/System/IO/ByteBuffer.hs --- old/store-0.3.1/src/System/IO/ByteBuffer.hs 2016-11-16 22:01:15.000000000 +0100 +++ new/store-0.4.3.1/src/System/IO/ByteBuffer.hs 2017-05-06 04:42:18.000000000 +0200 @@ -142,7 +142,6 @@ writeIORef bb (Left $ ByteBufferException loc (show e)) Left _ -> return () throwIO e -{-# INLINE bbHandler #-} -- | Try to use the 'BBRef' of a 'ByteBuffer', or throw a 'ByteBufferException' if it's invalid. useBBRef :: (BBRef -> IO a) -> ByteBuffer -> IO a @@ -185,7 +184,6 @@ , contained = 0 , consumed = 0 } -{-# INLINE new #-} -- | Free a byte buffer. free :: MonadIO m => ByteBuffer -> m () @@ -195,7 +193,6 @@ writeIORef bb $ Left (ByteBufferException "free" "ByteBuffer has explicitly been freed and is no longer valid.") Left _ -> return () -- the ByteBuffer is either invalid or has already been freed. -{-# INLINE free #-} -- | Perform some action with a bytebuffer, with automatic allocation -- and deallocation. @@ -224,7 +221,6 @@ , consumed = 0 , ptr = ptr bbref } -{-# INLINE resetBBRef #-} -- | Make sure the buffer is at least @minSize@ bytes long. -- @@ -246,7 +242,6 @@ , consumed = consumed bbref , ptr = ptr' } -{-# INLINE enlargeBBRef #-} -- | Copy the contents of a 'ByteString' to a 'ByteBuffer'. -- @@ -277,7 +272,6 @@ , contained = contained bbref'' + bsSize , consumed = consumed bbref'' , ptr = ptr bbref''} -{-# INLINE copyByteString #-} #ifndef mingw32_HOST_OS @@ -295,7 +289,6 @@ (bbref', readBytes) <- fillBBRefFromFd sock bbref maxBytes writeIORef bb $ Right bbref' return readBytes -{-# INLINE fillFromFd #-} {- Note: I'd like to use these two definitions: @@ -352,7 +345,6 @@ else do let bbref' = bbref{ contained = contained + bytes } go (readBytes + bytes) bbref' -{-# INLINE fillBBRefFromFd #-} foreign import ccall unsafe "recv" -- c_recv returns -1 in the case of errors. @@ -386,7 +378,6 @@ else do writeIORef bb $ Right bbref { consumed = consumed bbref + n } return $ Right (ptr bbref `plusPtr` consumed bbref) -{-# INLINE unsafeConsume #-} -- | As `unsafeConsume`, but instead of returning a `Ptr` into the -- contents of the `ByteBuffer`, it returns a `ByteString` containing @@ -404,7 +395,6 @@ bs <- liftIO $ createBS ptr n return (Right bs) Left missing -> return (Left missing) -{-# INLINE consume #-} {-@ createBS :: p:(Ptr Word8) -> {v:Nat | v <= plen p} -> IO ByteString @-} createBS :: Ptr Word8 -> Int -> IO ByteString @@ -412,7 +402,6 @@ fp <- mallocForeignPtrBytes n withForeignPtr fp (\p -> copyBytes p ptr n) return (BS.PS fp 0 n) -{-# INLINE createBS #-} -- below are liquid haskell qualifiers, and specifications for external functions. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/store.cabal new/store-0.4.3.1/store.cabal --- old/store-0.3.1/store.cabal 2017-02-16 07:29:02.000000000 +0100 +++ new/store-0.4.3.1/store.cabal 2017-05-09 02:44:12.000000000 +0200 @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: store -version: 0.3.1 +version: 0.4.3.1 synopsis: Fast binary serialization category: Serialization, Data homepage: https://github.com/fpco/store#readme @@ -37,7 +37,7 @@ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 build-depends: base >=4.7 && <5 - , store-core >=0.3 && <0.4 + , store-core >=0.4 && <0.5 , th-utilities >=0.2 , primitive >=0.6 , th-reify-many >=0.1.6 @@ -102,7 +102,7 @@ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 - , store-core >=0.3 && <0.4 + , store-core >=0.4 && <0.5 , th-utilities >=0.2 , primitive >=0.6 , th-reify-many >=0.1.6 @@ -160,7 +160,7 @@ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T -O2 build-depends: base >=4.7 && <5 - , store-core >=0.3 && <0.4 + , store-core >=0.4 && <0.5 , th-utilities >=0.2 , primitive >=0.6 , th-reify-many >=0.1.6 @@ -218,7 +218,7 @@ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N1 -with-rtsopts=-s -with-rtsopts=-qg build-depends: base >=4.7 && <5 - , store-core >=0.3 && <0.4 + , store-core >=0.4 && <0.5 , th-utilities >=0.2 , primitive >=0.6 , th-reify-many >=0.1.6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/test/Allocations.hs new/store-0.4.3.1/test/Allocations.hs --- old/store-0.3.1/test/Allocations.hs 2016-10-27 00:36:13.000000000 +0200 +++ new/store-0.4.3.1/test/Allocations.hs 2017-02-28 06:37:20.000000000 +0100 @@ -7,8 +7,11 @@ module Main where import Control.DeepSeq -import Data.List +import qualified Data.IntMap.Strict as IntMap +import qualified Data.IntSet as IntSet import qualified Data.Serialize as Cereal +import qualified Data.Set as Set +import qualified Data.Map.Strict as Map import qualified Data.Store as Store import qualified Data.Vector as Boxed import qualified Data.Vector.Serialize () @@ -19,26 +22,39 @@ -- | Main entry point. main :: IO () main = - mainWith encoding + mainWith weighing --- | Weigh encoding with Store vs Cereal. -encoding :: Weigh () -encoding = +-- | Weigh weighing with Store vs Cereal. +weighing :: Weigh () +weighing = do fortype "[Int]" (\n -> replicate n 0 :: [Int]) fortype "Boxed Vector Int" (\n -> Boxed.replicate n 0 :: Boxed.Vector Int) fortype "Storable Vector Int" (\n -> Storable.replicate n 0 :: Storable.Vector Int) + fortype "Set Int" (Set.fromDistinctAscList . ints) + fortype "IntSet" (IntSet.fromDistinctAscList . ints) + fortype "Map Int Int" (Map.fromDistinctAscList . intpairs) + fortype "IntMap Int" (IntMap.fromDistinctAscList . intpairs) where fortype label make = scale (\(n,nstr) -> do let title :: String -> String title for = printf "%12s %-20s %s" nstr (label :: String) for + encodeDecode en de = + (return . (`asTypeOf` make n) . de . force . en . make) n action (title "Allocate") (return (make n)) action (title "Encode: Store") (return (Store.encode (force (make n)))) action (title "Encode: Cereal") - (return (Cereal.encode (force (make n))))) - scale func = - mapM_ func + (return (Cereal.encode (force (make n)))) + action (title "Encode/Decode: Store") + (encodeDecode Store.encode Store.decodeEx) + action (title "Encode/Decode: Cereal") + (encodeDecode Cereal.encode (fromRight . Cereal.decode))) + scale f = + mapM_ f (map (\x -> (x,commas x)) [1000000,2000000,10000000]) + ints n = [1..n] :: [Int] + intpairs = map (\x -> (x, x)) . ints + fromRight = either (error "Left") id diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/store-0.3.1/test/Data/StoreSpec.hs new/store-0.4.3.1/test/Data/StoreSpec.hs --- old/store-0.3.1/test/Data/StoreSpec.hs 2016-11-16 22:52:41.000000000 +0100 +++ new/store-0.4.3.1/test/Data/StoreSpec.hs 2017-03-04 08:07:44.000000000 +0100 @@ -307,7 +307,7 @@ , [t| X |] ]) describe "Manually listed polymorphic store instances" - $(smallcheckManyStore verbose 2 + $(smallcheckManyStore verbose 4 [ [t| SV.Vector Int8 |] , [t| V.Vector Int8 |] , [t| SerialRatio Int8 |] @@ -396,6 +396,12 @@ assertRoundtrip verbose (250 :: Word8, 40918 :: Word16, 120471416 :: Word32) assertRoundtrip verbose (250 :: Word8, 10.1 :: Float, 8697.65 :: Double) (return () :: IO ()) + it "Expects the right marker when deserializing ordered maps (#97)" $ do + let m = mapFromList [(1, ()), (2, ()), (3, ())] :: HashMap Int () + bs = encode m + (decodeEx bs :: HashMap Int ()) `shouldBe` m + evaluate (decodeEx bs :: Map Int ()) `shouldThrow` isUnexpectedMarkerException + evaluate (decodeEx bs :: IntMap ()) `shouldThrow` isUnexpectedMarkerException isPokeException :: Test.Hspec.Selector PokeException isPokeException = const True @@ -405,3 +411,7 @@ isTooManyBytesException :: Test.Hspec.Selector PeekException isTooManyBytesException (PeekException _ t) = "Attempted to read too many bytes" `T.isPrefixOf` t + +isUnexpectedMarkerException :: Test.Hspec.Selector PeekException +isUnexpectedMarkerException (PeekException _ t) = + "Expected marker for ascending Map / IntMap: " `T.isPrefixOf` t

1 0

commit ghc-sql-words for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-sql-words for openSUSE:Factory checked in at 2017-08-31 20:59:49 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-sql-words (Old) and /work/SRC/openSUSE:Factory/.ghc-sql-words.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-sql-words" Thu Aug 31 20:59:49 2017 rev:3 rq:513500 version:0.1.5.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-sql-words/ghc-sql-words.changes 2017-06-22 10:39:06.336513021 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-sql-words.new/ghc-sql-words.changes 2017-08-31 20:59:51.098853811 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:29 UTC 2017 - psimons(a)suse.com + +- Update to version 0.1.5.1. + +------------------------------------------------------------------- Old: ---- sql-words-0.1.5.0.tar.gz New: ---- sql-words-0.1.5.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-sql-words.spec ++++++ --- /var/tmp/diff_new_pack.lhDpk4/_old 2017-08-31 20:59:51.874744796 +0200 +++ /var/tmp/diff_new_pack.lhDpk4/_new 2017-08-31 20:59:51.882743673 +0200 @@ -19,7 +19,7 @@ %global pkg_name sql-words %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.5.0 +Version: 0.1.5.1 Release: 0 Summary: SQL keywords data constructors into OverloadedString License: BSD-3-Clause ++++++ sql-words-0.1.5.0.tar.gz -> sql-words-0.1.5.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/sql-words-0.1.5.0/sql-words.cabal new/sql-words-0.1.5.1/sql-words.cabal --- old/sql-words-0.1.5.0/sql-words.cabal 2017-05-29 09:51:14.000000000 +0200 +++ new/sql-words-0.1.5.1/sql-words.cabal 2017-07-17 03:01:56.000000000 +0200 @@ -1,5 +1,5 @@ name: sql-words -version: 0.1.5.0 +version: 0.1.5.1 synopsis: SQL keywords data constructors into OverloadedString description: This package contiains SQL keywords constructors defined as OverloadedString literals and helper functions to concate these. @@ -12,7 +12,8 @@ category: Database build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 8.0.1, GHC == 8.0.2 +tested-with: GHC == 8.2.1 + , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3

1 0