Hello community, here is the log from the commit of package ghc-distributive for openSUSE:Factory checked in at 2017-03-18 20:50:21 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-distributive (Old) and /work/SRC/openSUSE:Factory/.ghc-distributive.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-distributive" Sat Mar 18 20:50:21 2017 rev:4 rq:477446 version:0.5.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-distributive/ghc-distributive.changes 2016-07-21 08:08:04.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-distributive.new/ghc-distributive.changes 2017-03-18 20:50:22.607355383 +0100 @@ -1,0 +2,10 @@ +Sun Feb 5 19:32:22 UTC 2017 - [email protected] + +- Update to version 0.5.2 revision 2 with cabal2obs. + +------------------------------------------------------------------- +Mon Jan 9 06:33:58 UTC 2017 - [email protected] + +- Update to version 0.5.1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- distributive-0.5.0.2.tar.gz New: ---- distributive-0.5.2.tar.gz distributive.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-distributive.spec ++++++ --- /var/tmp/diff_new_pack.OQtOor/_old 2017-03-18 20:50:23.255263596 +0100 +++ /var/tmp/diff_new_pack.OQtOor/_new 2017-03-18 20:50:23.255263596 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-distributive # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,27 +19,27 @@ %global pkg_name distributive %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.0.2 +Version: 0.5.2 Release: 0 Summary: Distributive functors -- Dual to Traversable License: BSD-2-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-base-orphans-devel +BuildRequires: ghc-cabal-doctest-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-tagged-devel BuildRequires: ghc-transformers-compat-devel BuildRequires: ghc-transformers-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} -BuildRequires: ghc-directory-devel BuildRequires: ghc-doctest-devel -BuildRequires: ghc-filepath-devel +BuildRequires: ghc-generic-deriving-devel +BuildRequires: ghc-hspec-devel %endif -# End cabal-rpm deps %description Distributive functors -- Dual to Traversable. @@ -57,21 +57,16 @@ %prep %setup -q -n %{pkg_name}-%{version} - +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ distributive-0.5.0.2.tar.gz -> distributive-0.5.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/.travis.yml new/distributive-0.5.2/.travis.yml --- old/distributive-0.5.0.2/.travis.yml 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/.travis.yml 2017-02-01 04:29:28.000000000 +0100 @@ -14,6 +14,14 @@ matrix: include: + - env: CABALVER=1.18 GHCVER=7.0.4 BUILD=cabal + compiler: ": #GHC 7.0.4" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.0.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + + - env: CABALVER=1.18 GHCVER=7.2.2 BUILD=cabal + compiler: ": #GHC 7.2.2" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.2.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.4.2 BUILD=cabal compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} @@ -32,20 +40,28 @@ # - env: BUILD=stack STACK_YAML=stack-7.8.yaml # os: osx - - env: CABALVER=1.22 GHCVER=7.10.1 BUILD=cabal - compiler: ": #GHC 7.10.1" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - - - env: CABALVER=1.22 GHCVER=7.10.2 BUILD=cabal - compiler: ": #GHC 7.10.2" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.3 BUILD=cabal + compiler: ": #GHC 7.10.3" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + + - env: CABALVER=1.24 GHCVER=8.0.2 BUILD=cabal + compiler: ": #GHC 8.0.2" + addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} + + - env: CABALVER=1.24 GHCVER=head BUILD=cabal CABALFLAGS=--allow-newer + compiler: ": #GHC head" + addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_OPTIONS=--skip-ghc-check - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} +# - env: BUILD=stack STACK_OPTIONS=--skip-ghc-check +# addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - - env: BUILD=stack - os: osx +# - env: BUILD=stack +# os: osx + allow_failures: + - env: CABALVER=1.18 GHCVER=7.0.4 BUILD=cabal + - env: CABALVER=1.18 GHCVER=7.2.2 BUILD=cabal + - env: CABALVER=1.24 GHCVER=head BUILD=cabal CABALFLAGS=--allow-newer before_install: - unset CC @@ -75,7 +91,7 @@ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi; travis_retry cabal update; - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt; + cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v $CABALFLAGS> installplan.txt; sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt; if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; @@ -86,8 +102,8 @@ echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install --only-dependencies --enable-tests --enable-benchmarks; - if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi; + cabal install --only-dependencies --enable-tests --enable-benchmarks $CABALFLAGS; + if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi; fi; if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; @@ -106,12 +122,13 @@ stack) scripts/travis_long stack --no-terminal $STACK_OPTIONS build -j2;; cabal) - cabal configure --enable-tests -v2; + cabal configure --enable-tests -v2 $CABALFLAGS; cabal build; - cabal test; + cabal test --show-details=always; cabal bench || true; cabal sdist || true; - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ");; + SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz; + if [ -f $SRC_TGZ ]; then (cd dist && cabal install --force-reinstalls "$SRC_TGZ"); fi; esac notifications: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/CHANGELOG.markdown new/distributive-0.5.2/CHANGELOG.markdown --- old/distributive-0.5.0.2/CHANGELOG.markdown 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/CHANGELOG.markdown 2017-02-01 04:29:28.000000000 +0100 @@ -1,3 +1,20 @@ +0.5.2 +----- +* Revamp `Setup.hs` to use `cabal-doctest`. This makes `distributive` build + with `Cabal-1.25`, and makes the `doctest`s work with `cabal new-build` and + sandboxes. +* Fix bugs in `Data.Distributive.Generic` that cause generic `Distributive` + instances not to work properly for datatypes with recursive types +* Add `genericCollect` to `Data.Distributive.Generic`, and switch the underlying + machinery in that module to work on a `collect`-like method instead of a + `distribute`-like one +* Add a test suite for regression-testing `Data.Distributive.Generic` + +0.5.1 +----- +* Add `Distributive` instances for datatypes from `Data.Semigroup` and `GHC.Generics` +* Add `MINIMAL` pragma for `Distributive` + 0.5.0.2 ------- * A more elegant fix for builds on GHC 7.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/Setup.lhs new/distributive-0.5.2/Setup.lhs --- old/distributive-0.5.0.2/Setup.lhs 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/Setup.lhs 2017-02-01 04:29:28.000000000 +0100 @@ -1,48 +1,182 @@ -#!/usr/bin/runhaskell \begin{code} -{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where +#ifndef MIN_VERSION_cabal_doctest +#define MIN_VERSION_cabal_doctest(x,y,z) 0 +#endif + + +#if MIN_VERSION_cabal_doctest(1,0,0) +import Distribution.Extra.Doctest ( defaultMainWithDoctests ) +#else + +-- Otherwise we provide a shim + +#ifndef MIN_VERSION_Cabal +#define MIN_VERSION_Cabal(x,y,z) 0 +#endif +#ifndef MIN_VERSION_directory +#define MIN_VERSION_directory(x,y,z) 0 +#endif +#if MIN_VERSION_Cabal(1,24,0) +#define InstalledPackageId UnitId +#endif + +import Control.Monad ( when ) import Data.List ( nub ) -import Data.Version ( showVersion ) -import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) +import Data.String ( fromString ) +import Distribution.Package ( InstalledPackageId ) +import Distribution.Package ( PackageId, Package (..), packageVersion ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) -import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) -import Distribution.Verbosity ( Verbosity ) +import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) +import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) +import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) +import Distribution.Text ( display , simpleParse ) import System.FilePath ( (</>) ) -main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - } +#if MIN_VERSION_Cabal(1,25,0) +import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) +#endif + +#if MIN_VERSION_directory(1,2,2) +import System.Directory (makeAbsolute) +#else +import System.Directory (getCurrentDirectory) +import System.FilePath (isAbsolute) + +makeAbsolute :: FilePath -> IO FilePath +makeAbsolute p | isAbsolute p = return p + | otherwise = do + cwd <- getCurrentDirectory + return $ cwd </> p +#endif + +generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule testsuiteName flags pkg lbi = do + let verbosity = fromFlag (buildVerbosity flags) + let distPref = fromFlag (buildDistPref flags) + + -- Package DBs + let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ] + let dbFlags = "-hide-all-packages" : packageDbArgs dbStack + + withLibLBI pkg lbi $ \lib libcfg -> do + let libBI = libBuildInfo lib + + -- modules + let modules = exposedModules lib ++ otherModules libBI + -- it seems that doctest is happy to take in module names, not actual files! + let module_sources = modules + + -- We need the directory with library's cabal_macros.h! +#if MIN_VERSION_Cabal(1,25,0) + let libAutogenDir = autogenComponentModulesDir lbi libcfg +#else + let libAutogenDir = autogenModulesDir lbi +#endif -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule verbosity pkg lbi = do - let dir = autogenModulesDir lbi - createDirectoryIfMissingVerbose verbosity True dir - withLibLBI pkg lbi $ \_ libcfg -> do - withTestLBI pkg lbi $ \suite suitecfg -> do - rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines - [ "module Build_" ++ testName suite ++ " where" + -- Lib sources and includes + iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI + includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI + + -- CPP includes, i.e. include cabal_macros.h + let cppFlags = map ("-optP"++) $ + [ "-include", libAutogenDir ++ "/cabal_macros.h" ] + ++ cppOptions libBI + + withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do + + -- get and create autogen dir +#if MIN_VERSION_Cabal(1,25,0) + let testAutogenDir = autogenComponentModulesDir lbi suitecfg +#else + let testAutogenDir = autogenModulesDir lbi +#endif + createDirectoryIfMissingVerbose verbosity True testAutogenDir + + -- write autogen'd file + rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines + [ "module Build_doctests where" , "" - , "autogen_dir :: String" - , "autogen_dir = " ++ show dir + -- -package-id etc. flags + , "pkgs :: [String]" + , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) , "" - , "deps :: [String]" - , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) + , "flags :: [String]" + , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) + , "" + , "module_sources :: [String]" + , "module_sources = " ++ show (map display module_sources) ] where - formatdeps = map (formatone . snd) - formatone p = case packageName p of - PackageName n -> n ++ "-" ++ showVersion (packageVersion p) + -- we do this check in Setup, as then doctests don't need to depend on Cabal + isOldCompiler = maybe False id $ do + a <- simpleParse $ showCompilerId $ compiler lbi + b <- simpleParse "7.5" + return $ packageVersion (a :: PackageId) < b + + formatDeps = map formatOne + formatOne (installedPkgId, pkgId) + -- The problem is how different cabal executables handle package databases + -- when doctests depend on the library + | packageId pkg == pkgId = "-package=" ++ display pkgId + | otherwise = "-package-id=" ++ display installedPkgId + + -- From Distribution.Simple.Program.GHC + packageDbArgs :: [PackageDB] -> [String] + packageDbArgs | isOldCompiler = packageDbArgsConf + | otherwise = packageDbArgsDb + + -- GHC <7.6 uses '-package-conf' instead of '-package-db'. + packageDbArgsConf :: [PackageDB] -> [String] + packageDbArgsConf dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs + (GlobalPackageDB:dbs) -> ("-no-user-package-conf") + : concatMap specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] + specific _ = ierror + ierror = error $ "internal error: unexpected package db stack: " + ++ show dbstack + + -- GHC >= 7.6 uses the '-package-db' flag. See + -- https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> "-no-user-package-db" + : concatMap single dbs + dbs -> "-clear-package-db" + : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys +defaultMainWithDoctests :: String -> IO () +defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule testSuiteName flags pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +#endif + +main :: IO () +main = defaultMainWithDoctests "doctests" + \end{code} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/distributive.cabal new/distributive-0.5.2/distributive.cabal --- old/distributive-0.5.0.2/distributive.cabal 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/distributive.cabal 2017-02-01 04:29:28.000000000 +0100 @@ -1,6 +1,6 @@ name: distributive category: Data Structures -version: 0.5.0.2 +version: 0.5.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -25,6 +25,19 @@ type: git location: git://github.com/ekmett/distributive.git +custom-setup + setup-depends: + base >= 4 && <5, + cabal-doctest >= 1 && <1.1 + +flag semigroups + manual: True + default: True + description: + You can disable the use of the `semigroups` package using `-f-semigroups`. + . + Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. + flag tagged manual: True default: True @@ -53,6 +66,14 @@ if impl(ghc>=7.2 && < 7.6) build-depends: ghc-prim + if impl(ghc < 8.0) + if flag(semigroups) + build-depends: semigroups >= 0.11 && < 1 + + if impl(ghc < 7.8) + hs-source-dirs: src-compat + other-modules: Data.Coerce + ghc-options: -Wall -- Verify the results of the examples @@ -61,8 +82,21 @@ main-is: doctests.hs build-depends: base >= 4, - directory >= 1.0, - doctest >= 0.9.1, - filepath >= 1.2 + doctest >= 0.11.1 && <0.12 ghc-options: -Wall -threaded hs-source-dirs: tests + +test-suite spec + type: exitcode-stdio-1.0 + hs-source-dirs: tests + + build-depends: + base >= 4 && < 5, + distributive, + generic-deriving >= 1.11 && < 2, + hspec >= 2 && < 3 + + main-is: Spec.hs + other-modules: GenericsSpec + + ghc-options: -Wall -threaded -rtsopts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/src/Data/Distributive/Generic.hs new/distributive-0.5.2/src/Data/Distributive/Generic.hs --- old/distributive-0.5.0.2/src/Data/Distributive/Generic.hs 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/src/Data/Distributive/Generic.hs 2017-02-01 04:29:28.000000000 +0100 @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Distributive @@ -14,49 +18,73 @@ ---------------------------------------------------------------------------- module Data.Distributive.Generic ( GDistributive(..) + , genericCollect , genericDistribute ) where +import Data.Distributive import GHC.Generics +import Data.Coerce --- | 'distribute' derived from a 'Generic1' type +-- | 'collect' derived from a 'Generic1' type -- -- This can be used to easily produce a 'Distributive' instance for a -- type with a 'Generic1' instance, -- -- > data V2 a = V2 a a deriving (Show, Functor, Generic1) --- > instance Distributive V2' where distribute = genericDistribute +-- > instance Distributive V2' where collect = genericCollect +genericCollect :: (Functor f, Generic1 g, GDistributive (Rep1 g)) + => (a -> g b) -> f a -> g (f b) +genericCollect f = to1 . gcollect (from1 . f) + +-- | 'distribute' derived from a 'Generic1' type +-- +-- It's often more efficient to use 'genericCollect' instead. genericDistribute :: (Functor f, Generic1 g, GDistributive (Rep1 g)) => f (g a) -> g (f a) genericDistribute = to1 . gdistribute . fmap from1 + -- Can't distribute over, -- * sums (:+:) -- * K1 +-- * V1 class GDistributive g where - gdistribute :: Functor f => f (g a) -> g (f a) + gcollect :: Functor f => (a -> g b) -> f a -> g (f b) + +gdistribute :: (GDistributive g, Functor f) => f (g b) -> g (f b) +gdistribute = gcollect id +{-# INLINE gdistribute #-} instance GDistributive U1 where - gdistribute _ = U1 - {-# INLINE gdistribute #-} + gcollect _ _ = U1 + {-# INLINE gcollect #-} instance (GDistributive a, GDistributive b) => GDistributive (a :*: b) where - gdistribute f = gdistribute (fmap fstP f) :*: gdistribute (fmap sndP f) where + -- It might be tempting to fuse `gcollect fstP (fmap f x)` into + -- `gcollect (fstP . f) x`, but this would lead to a loss of sharing. + gcollect f x = gcollect fstP x' :*: gcollect sndP x' where + x' = fmap f x fstP (l :*: _) = l sndP (_ :*: r) = r - {-# INLINE gdistribute #-} + {-# INLINE gcollect #-} -instance (Functor a, GDistributive a, GDistributive b) => GDistributive (a :.: b) where - gdistribute = Comp1 . fmap gdistribute . gdistribute . fmap unComp1 - {-# INLINE gdistribute #-} +instance (Distributive a, GDistributive b) => GDistributive (a :.: b) where + gcollect f = Comp1 . fmap gdistribute . collect (coerce f) + {-# INLINE gcollect #-} instance GDistributive Par1 where - gdistribute = Par1 . fmap unPar1 - {-# INLINE gdistribute #-} - -instance GDistributive f => GDistributive (Rec1 f) where - gdistribute = Rec1 . gdistribute . fmap unRec1 - {-# INLINE gdistribute #-} + gcollect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b) + {-# INLINE gcollect #-} + +instance Distributive f => GDistributive (Rec1 f) where + gcollect = coerce (collect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> Rec1 f b) -> g a -> Rec1 f (g b) + {-# INLINE gcollect #-} instance GDistributive f => GDistributive (M1 i c f) where - gdistribute = M1 . gdistribute . fmap unM1 - {-# INLINE gdistribute #-} + gcollect = coerce (gcollect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> M1 i c f b) -> g a -> M1 i c f (g b) + {-# INLINE gcollect #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/src/Data/Distributive.hs new/distributive-0.5.2/src/Data/Distributive.hs --- old/distributive-0.5.0.2/src/Data/Distributive.hs 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/src/Data/Distributive.hs 2017-02-01 04:29:28.000000000 +0100 @@ -1,5 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Distributive @@ -15,16 +21,18 @@ ( Distributive(..) , cotraverse , comapM + , fmapCollect ) where import Control.Applicative import Control.Applicative.Backwards import Control.Monad (liftM) -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 +#if __GLASGOW_HASKELL__ < 707 import Control.Monad.Instances () #endif import Control.Monad.Trans.Identity import Control.Monad.Trans.Reader +import Data.Coerce import Data.Functor.Compose import Data.Functor.Identity import Data.Functor.Product @@ -35,12 +43,18 @@ #if MIN_VERSION_base(4,4,0) import Data.Complex #endif -#if (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707) || defined(MIN_VERSION_tagged) +#if __GLASGOW_HASKELL__ >= 707 || defined(MIN_VERSION_tagged) import Data.Proxy #endif +#if __GLASGOW_HASKELL__ >= 800 || defined(MIN_VERSION_semigroups) +import qualified Data.Semigroup as Semigroup +#endif #ifdef MIN_VERSION_tagged import Data.Tagged #endif +#if __GLASGOW_HASKELL__ >= 702 +import GHC.Generics (U1(..), (:*:)(..), (:.:)(..), Par1(..), Rec1(..), M1(..)) +#endif #ifdef HLINT {-# ANN module "hlint: ignore Use section" #-} @@ -53,9 +67,7 @@ -- some Coapplicative class. Categorically every 'Distributive' -- functor is actually a right adjoint, and so it must be 'Representable' -- endofunctor and preserve all limits. This is a fancy way of saying it --- isomorphic to `(->) x` for some x. --- --- Minimal complete definition: 'distribute' or 'collect' +-- isomorphic to @(->) x@ for some x. -- -- To be distributable a container will need to have a way to consistently -- zip a potentially infinite number of copies of itself. This effectively @@ -64,90 +76,162 @@ -- and no extra information to try to merge together. -- class Functor g => Distributive g where +#if __GLASGOW_HASKELL__ >= 707 + {-# MINIMAL distribute | collect #-} +#endif -- | The dual of 'Data.Traversable.sequenceA' -- -- >>> distribute [(+1),(+2)] 1 -- [2,3] -- - -- @'distribute' = 'collect' 'id'@ + -- @ + -- 'distribute' = 'collect' 'id' + -- 'distribute' . 'distribute' = 'id' + -- @ distribute :: Functor f => f (g a) -> g (f a) distribute = collect id -- | - -- @'collect' f = 'distribute' . 'fmap' f@ + -- @ + -- 'collect' f = 'distribute' . 'fmap' f + -- 'fmap' f = 'runIdentity' . 'collect' ('Identity' . f) + -- 'fmap' 'distribute' . 'collect' f = 'getCompose' . 'collect' ('Compose' . f) + -- @ + collect :: Functor f => (a -> g b) -> f a -> g (f b) collect f = distribute . fmap f -- | The dual of 'Data.Traversable.sequence' -- - -- @'distributeM' = 'fmap' 'unwrapMonad' . 'distribute' . 'WrapMonad'@ + -- @ + -- 'distributeM' = 'fmap' 'unwrapMonad' . 'distribute' . 'WrapMonad' + -- @ distributeM :: Monad m => m (g a) -> g (m a) distributeM = fmap unwrapMonad . distribute . WrapMonad -- | - -- @'collectM' = 'distributeM' . 'liftM' f@ + -- @ + -- 'collectM' = 'distributeM' . 'liftM' f + -- @ collectM :: Monad m => (a -> g b) -> m a -> g (m b) collectM f = distributeM . liftM f -- | The dual of 'Data.Traversable.traverse' -- --- @'cotraverse' f = 'fmap' f . 'distribute'@ -cotraverse :: (Functor f, Distributive g) => (f a -> b) -> f (g a) -> g b +-- @ +-- 'cotraverse' f = 'fmap' f . 'distribute' +-- @ +cotraverse :: (Distributive g, Functor f) => (f a -> b) -> f (g a) -> g b cotraverse f = fmap f . distribute -- | The dual of 'Data.Traversable.mapM' -- --- @'comapM' f = 'fmap' f . 'distributeM'@ -comapM :: (Monad m, Distributive g) => (m a -> b) -> m (g a) -> g b +-- @ +-- 'comapM' f = 'fmap' f . 'distributeM' +-- @ +comapM :: (Distributive g, Monad m) => (m a -> b) -> m (g a) -> g b comapM f = fmap f . distributeM instance Distributive Identity where - collect f = Identity . fmap (runIdentity . f) + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall a b f . Functor f => (a -> Identity b) -> f a -> Identity (f b) distribute = Identity . fmap runIdentity +#if __GLASGOW_HASKELL__ >= 707 || defined(MIN_VERSION_tagged) instance Distributive Proxy where collect _ _ = Proxy distribute _ = Proxy +#endif +#if defined(MIN_VERSION_tagged) instance Distributive (Tagged t) where - collect f = Tagged . fmap (unTagged . f) + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall a b f . Functor f => (a -> Tagged t b) -> f a -> Tagged t (f b) distribute = Tagged . fmap unTagged +#endif instance Distributive ((->)e) where distribute a e = fmap ($e) a + collect f q e = fmap (flip f e) q instance Distributive g => Distributive (ReaderT e g) where distribute a = ReaderT $ \e -> collect (flip runReaderT e) a + collect f x = ReaderT $ \e -> collect (\a -> runReaderT (f a) e) x instance Distributive g => Distributive (IdentityT g) where - collect f = IdentityT . collect (runIdentityT . f) + collect = coerce (collect :: (a -> g b) -> f a -> g (f b)) + :: forall a b f . Functor f => (a -> IdentityT g b) -> f a -> IdentityT g (f b) instance (Distributive f, Distributive g) => Distributive (Compose f g) where distribute = Compose . fmap distribute . collect getCompose + collect f = Compose . fmap distribute . collect (coerce f) instance (Distributive f, Distributive g) => Distributive (Product f g) where + -- It might be tempting to write a 'collect' implementation that + -- composes the passed function with fstP and sndP. This could be bad, + -- because it would lead to the passed function being evaluated twice + -- for each element of the underlying functor. distribute wp = Pair (collect fstP wp) (collect sndP wp) where fstP (Pair a _) = a sndP (Pair _ b) = b + instance Distributive f => Distributive (Backwards f) where distribute = Backwards . collect forwards + collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> Backwards f b) -> g a -> Backwards f (g b) instance Distributive f => Distributive (Reverse f) where distribute = Reverse . collect getReverse + collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> Reverse f b) -> g a -> Reverse f (g b) instance Distributive Monoid.Dual where - collect f = Monoid.Dual . fmap (Monoid.getDual . f) + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Monoid.Dual b) -> f a -> Monoid.Dual (f b) distribute = Monoid.Dual . fmap Monoid.getDual instance Distributive Monoid.Product where - collect f = Monoid.Product . fmap (Monoid.getProduct . f) + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Monoid.Product b) -> f a -> Monoid.Product (f b) distribute = Monoid.Product . fmap Monoid.getProduct instance Distributive Monoid.Sum where - collect f = Monoid.Sum . fmap (Monoid.getSum . f) + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Monoid.Sum b) -> f a -> Monoid.Sum (f b) distribute = Monoid.Sum . fmap Monoid.getSum +#if __GLASGOW_HASKELL__ >= 800 || defined(MIN_VERSION_semigroups) +instance Distributive Semigroup.Min where + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Semigroup.Min b) -> f a -> Semigroup.Min (f b) + distribute = Semigroup.Min . fmap Semigroup.getMin + +instance Distributive Semigroup.Max where + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Semigroup.Max b) -> f a -> Semigroup.Max (f b) + distribute = Semigroup.Max . fmap Semigroup.getMax + +instance Distributive Semigroup.First where + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Semigroup.First b) -> f a -> Semigroup.First (f b) + distribute = Semigroup.First . fmap Semigroup.getFirst + +instance Distributive Semigroup.Last where + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f + => (a -> Semigroup.Last b) -> f a -> Semigroup.Last (f b) + distribute = Semigroup.Last . fmap Semigroup.getLast +#endif + #if MIN_VERSION_base(4,4,0) instance Distributive Complex where distribute wc = fmap realP wc :+ fmap imagP wc where @@ -156,3 +240,43 @@ realP (r :+ _) = r imagP (_ :+ i) = i #endif + +-- | 'fmapCollect' is a viable default definition for 'fmap' given +-- a 'Distributive' instance defined in terms of 'collect'. +fmapCollect :: forall f a b . Distributive f => (a -> b) -> f a -> f b +fmapCollect = coerce (collect :: (a -> Identity b) -> f a -> Identity (f b)) + +#if __GLASGOW_HASKELL__ >= 702 +instance Distributive U1 where + distribute _ = U1 + +instance (Distributive a, Distributive b) => Distributive (a :*: b) where + -- It might be tempting to write a 'collect' implementation that + -- composes the passed function with fstP and sndP. This could be bad, + -- because it would lead to the passed function being evaluated twice + -- for each element of the underlying functor. + distribute f = collect fstP f :*: collect sndP f where + fstP (l :*: _) = l + sndP (_ :*: r) = r + +instance (Distributive a, Distributive b) => Distributive (a :.: b) where + distribute = Comp1 . fmap distribute . collect unComp1 + collect f = Comp1 . fmap distribute . collect (coerce f) + +instance Distributive Par1 where + distribute = Par1 . fmap unPar1 + collect = coerce (fmap :: (a -> b) -> f a -> f b) + :: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b) + +instance Distributive f => Distributive (Rec1 f) where + distribute = Rec1 . collect unRec1 + collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> Rec1 f b) -> g a -> Rec1 f (g b) + +instance Distributive f => Distributive (M1 i c f) where + distribute = M1 . collect unM1 + collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) + :: forall g a b . Functor g + => (a -> M1 i c f b) -> g a -> M1 i c f (g b) +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/src-compat/Data/Coerce.hs new/distributive-0.5.2/src-compat/Data/Coerce.hs --- old/distributive-0.5.0.2/src-compat/Data/Coerce.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/distributive-0.5.2/src-compat/Data/Coerce.hs 2017-02-01 04:29:28.000000000 +0100 @@ -0,0 +1,8 @@ +-- This is a shim for GHC before 7.8. Cabal ignores it +-- for GHC 7.8 and later. +module Data.Coerce (coerce) where + +import Unsafe.Coerce (unsafeCoerce) + +coerce :: a -> b +coerce = unsafeCoerce diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/tests/GenericsSpec.hs new/distributive-0.5.2/tests/GenericsSpec.hs --- old/distributive-0.5.0.2/tests/GenericsSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/distributive-0.5.2/tests/GenericsSpec.hs 2017-02-01 04:29:28.000000000 +0100 @@ -0,0 +1,91 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : GenericSpec +-- Copyright : (C) 2011-2016 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett <[email protected]> +-- Stability : provisional +-- +-- Tests for generically derived 'Distributive' instances. +---------------------------------------------------------------------------- +module GenericsSpec (main, spec) where + +import Test.Hspec + +#if __GLASGOW_HASKELL__ >= 702 +import Data.Distributive (Distributive(..)) +import Data.Distributive.Generic (genericCollect, genericDistribute) + +# if __GLASGOW_HASKELL__ >= 706 +import Generics.Deriving.Base hiding (Rep) +# else +import qualified Generics.Deriving.TH as Generics (deriveAll1) +# endif +#endif + +main :: IO () +main = hspec spec + +spec :: Spec +#if __GLASGOW_HASKELL__ < 702 +spec = return () +#else +spec = do + describe "Id" $ + it "distribute idExample = idExample" $ + distribute idExample `shouldBe` idExample + describe "Stream" $ + it "runId (shead (stail (distribute streamExample))) = 1" $ + runId (shead (stail (distribute streamExample))) `shouldBe` 1 + describe "PolyRec" $ + it "runId (plast (runId (pinit (distribute polyRecExample)))) = 1" $ + runId (plast (runId (pinit (distribute polyRecExample)))) `shouldBe` 1 + +newtype Id a = Id { runId :: a } + deriving (Eq, Functor, Show) +instance Distributive Id where + collect = genericCollect + distribute = genericDistribute + +idExample :: Id (Id Int) +idExample = Id (Id 42) + +data Stream a = (:>) { shead :: a, stail :: Stream a } + deriving Functor +instance Distributive Stream where + collect = genericCollect + distribute = genericDistribute + +streamExample :: Id (Stream Int) +streamExample = Id $ let s = 0 :> fmap (+1) s in s + +data PolyRec a = PolyRec { pinit :: Id (PolyRec a), plast :: a } + deriving Functor +instance Distributive PolyRec where + collect = genericCollect + distribute = genericDistribute + +polyRecExample :: Id (PolyRec Int) +polyRecExample = Id $ let p = PolyRec (Id $ fmap (+1) p) 0 in p + +# if __GLASGOW_HASKELL__ >= 706 +deriving instance Generic1 Id +deriving instance Generic1 Stream +deriving instance Generic1 PolyRec +# else +$(Generics.deriveAll1 ''Id) +$(Generics.deriveAll1 ''Stream) +$(Generics.deriveAll1 ''PolyRec) +# endif +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/tests/Spec.hs new/distributive-0.5.2/tests/Spec.hs --- old/distributive-0.5.0.2/tests/Spec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/distributive-0.5.2/tests/Spec.hs 2017-02-01 04:29:28.000000000 +0100 @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/distributive-0.5.0.2/tests/doctests.hs new/distributive-0.5.2/tests/doctests.hs --- old/distributive-0.5.0.2/tests/doctests.hs 2016-01-17 01:07:48.000000000 +0100 +++ new/distributive-0.5.2/tests/doctests.hs 2017-02-01 04:29:28.000000000 +0100 @@ -1,33 +1,25 @@ -{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Main (doctests) +-- Copyright : (C) 2012-14 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett <[email protected]> +-- Stability : provisional +-- Portability : portable +-- +-- This module provides doctests for a project based on the actual versions +-- of the packages it was built with. It requires a corresponding Setup.lhs +-- to be added to the project +----------------------------------------------------------------------------- module Main where -import Build_doctests (autogen_dir, deps) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -#endif -import Control.Monad -import Data.List -import System.Directory -import System.FilePath +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) import Test.DocTest main :: IO () -main = getSources >>= \sources -> doctest $ - "-isrc" - : ("-i" ++ autogen_dir) - : "-optP-include" - : ("-optP" ++ autogen_dir ++ "/cabal_macros.h") - : "-hide-all-packages" - : map ("-package="++) deps ++ sources - -getSources :: IO [FilePath] -getSources = filter (isSuffixOf ".hs") <$> go "src" +main = do + traverse_ putStrLn args + doctest args where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c + args = flags ++ pkgs ++ module_sources ++++++ distributive.cabal ++++++ name: distributive category: Data Structures version: 0.5.2 x-revision: 2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett <[email protected]> stability: provisional homepage: http://github.com/ekmett/distributive/ bug-reports: http://github.com/ekmett/distributive/issues copyright: Copyright (C) 2011-2016 Edward A. Kmett synopsis: Distributive functors -- Dual to Traversable description: Distributive functors -- Dual to Traversable build-type: Custom extra-source-files: .travis.yml .vim.custom config travis-cabal-apt-install CHANGELOG.markdown README.markdown source-repository head type: git location: git://github.com/ekmett/distributive.git custom-setup setup-depends: base >= 4 && <5, cabal-doctest >= 1 && <1.1, Cabal flag semigroups manual: True default: True description: You can disable the use of the `semigroups` package using `-f-semigroups`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. flag tagged manual: True default: True description: You can disable the use of the `tagged` package using `-f-tagged`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. library build-depends: base >= 4 && < 5, base-orphans >= 0.5 && < 1, transformers >= 0.2 && < 0.6, transformers-compat >= 0.3 && < 1 hs-source-dirs: src exposed-modules: Data.Distributive if impl(ghc>=7.2) exposed-modules: Data.Distributive.Generic if flag(tagged) build-depends: tagged >= 0.7 && < 1 if impl(ghc>=7.2 && < 7.6) build-depends: ghc-prim if impl(ghc < 8.0) if flag(semigroups) build-depends: semigroups >= 0.11 && < 1 if impl(ghc < 7.8) hs-source-dirs: src-compat other-modules: Data.Coerce ghc-options: -Wall -- Verify the results of the examples test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs build-depends: base >= 4, doctest >= 0.11.1 && <0.12 ghc-options: -Wall -threaded hs-source-dirs: tests test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: tests build-depends: base >= 4 && < 5, distributive, generic-deriving >= 1.11 && < 2, hspec >= 2 && < 3 main-is: Spec.hs other-modules: GenericsSpec ghc-options: -Wall -threaded -rtsopts
