Hello community, here is the log from the commit of package ghc-profunctors for openSUSE:Factory checked in at 2018-05-30 12:11:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-profunctors (Old) and /work/SRC/openSUSE:Factory/.ghc-profunctors.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-profunctors" Wed May 30 12:11:51 2018 rev:7 rq:607861 version:5.2.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-profunctors/ghc-profunctors.changes 2017-05-06 18:28:54.325543430 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-profunctors.new/ghc-profunctors.changes 2018-05-30 12:26:52.267179627 +0200 @@ -1,0 +2,15 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update profunctors to version 5.2.2 revision 1. + * Add `Semigroup` instances for `Closure` and `Tambara` + * Allow `base-orphans-0.6`. + * Add `Traversing` instance for `Forget` + * Add `Traversing` and `Mapping` instances for `Procompose` + * Add `Category` instance for `Star` + * Add `mapCayley` to `Data.Profunctor.Cayley` + * Add `pastro` and `unpastro` to `Data.Profunctor.Strong`. + * Add `dimapWandering`, `lmapWandering`, and `rmapWandering` to `Data.Profunctor.Traversing` + * Add documentation stating the laws for various profunctors. + * Introduce the `Data.Profunctor.Yoneda` module. + +------------------------------------------------------------------- Old: ---- profunctors-5.2.tar.gz New: ---- profunctors-5.2.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-profunctors.spec ++++++ --- /var/tmp/diff_new_pack.jXbarI/_old 2018-05-30 12:26:52.987154925 +0200 +++ /var/tmp/diff_new_pack.jXbarI/_new 2018-05-30 12:26:52.995154650 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-profunctors # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 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 @@ -18,12 +18,12 @@ %global pkg_name profunctors Name: ghc-%{pkg_name} -Version: 5.2 +Version: 5.2.2 Release: 0 Summary: Profunctors License: BSD-3-Clause -Group: Development/Languages/Other -Url: https://hackage.haskell.org/package/%{pkg_name} +Group: Development/Libraries/Haskell +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/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel @@ -33,16 +33,16 @@ BuildRequires: ghc-contravariant-devel BuildRequires: ghc-distributive-devel BuildRequires: ghc-rpm-macros +BuildRequires: ghc-semigroups-devel BuildRequires: ghc-tagged-devel BuildRequires: ghc-transformers-devel -BuildRoot: %{_tmppath}/%{name}-%{version}-build %description Profunctors. %package devel Summary: Haskell %{pkg_name} library development files -Group: Development/Libraries/Other +Group: Development/Libraries/Haskell Requires: %{name} = %{version}-%{release} Requires: ghc-compiler = %{ghc_version} Requires(post): ghc-compiler = %{ghc_version} @@ -68,11 +68,9 @@ %ghc_pkg_recache %files -f %{name}.files -%defattr(-,root,root,-) -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files -%defattr(-,root,root,-) %doc CHANGELOG.markdown README.markdown %changelog ++++++ profunctors-5.2.tar.gz -> profunctors-5.2.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/.gitignore new/profunctors-5.2.2/.gitignore --- old/profunctors-5.2/.gitignore 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/.gitignore 2018-01-18 21:05:00.000000000 +0100 @@ -1,4 +1,5 @@ dist/ +dist-newstyle/ .hsenv/ docs wiki @@ -12,3 +13,22 @@ *.hi *~ *# +:w +.stack-work/ +cabal-dev +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/.travis.yml new/profunctors-5.2.2/.travis.yml --- old/profunctors-5.2/.travis.yml 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/.travis.yml 2018-01-18 21:05:00.000000000 +0100 @@ -1,61 +1,155 @@ -# NB: don't set `language: haskell` here +# This Travis job script has been generated by a script via +# +# runghc make_travis_yml_2.hs '-o' '.travis.yml' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-installed' 'cabal.project' +# +# For more information, see https://github.com/hvr/multi-ghc-travis +# +language: c +sudo: false -# See also https://github.com/hvr/multi-ghc-travis for more information -env: - - GHCVER=7.4.2 CABALVER=1.16 - - GHCVER=7.6.3 CABALVER=1.16 - - GHCVER=7.8.4 CABALVER=1.18 - - GHCVER=7.10.1 CABALVER=1.22 - - GHCVER=8.0.1 CABALVER=1.24 - - GHCVER=head CABALVER=1.24 +git: + submodules: false # whether to recursively clone submodules + +notifications: + irc: + channels: + - "irc.freenode.org#haskell-lens" + skip_join: true + template: + - "\x0313profunctors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" + +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + + - rm -rfv $HOME/.cabal/packages/head.hackage + +addons: + apt: + packages: &apt_packages + - ghc-ppa-tools + - hlint matrix: + include: + - compiler: "ghc-7.0.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}} + - compiler: "ghc-7.2.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.2.2], sources: [hvr-ghc]}} + - compiler: "ghc-7.4.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}} + - compiler: "ghc-7.6.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.6.3], sources: [hvr-ghc]}} + - compiler: "ghc-7.8.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.8.4], sources: [hvr-ghc]}} + - compiler: "ghc-7.10.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.0.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}} + - compiler: "ghc-8.4.1" + env: GHCHEAD=true + addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}} + - compiler: "ghc-head" + env: GHCHEAD=true + addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-head], sources: [hvr-ghc]}} + allow_failures: - - env: GHCVER=head CABALVER=1.24 + - compiler: "ghc-7.0.4" + - compiler: "ghc-7.2.2" + - compiler: "ghc-8.4.1" + - compiler: "ghc-head" -# Note: the distinction between `before_install` and `install` is not -# important. before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - - cabal --version + - HC=${CC} + - HCPKG=${HC/ghc/ghc-pkg} + - unset CC + - ROOTDIR=$(pwd) + - mkdir -p $HOME/.local/bin + - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - echo $HCNUMVER install: - - travis_retry cabal update - - cabal install --only-dependencies - - travis_retry sudo apt-get -q -y install hlint || cabal install hlint - -# Here starts the actual work to be performed for the package under -# test; any command which exits with a non-zero exit code causes the -# build to fail. + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - HADDOCK=${HADDOCK-true} + - INSTALLED=${INSTALLED-true} + - GHCHEAD=${GHCHEAD-false} + - travis_retry cabal update -v + - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" + - rm -fv cabal.project cabal.project.local + # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage + - | + if $GHCHEAD; then + sed -i.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config + + echo 'repository head.hackage' >> ${HOME}/.cabal/config + echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config + echo ' secure: True' >> ${HOME}/.cabal/config + echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config + echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config + echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config + echo ' key-threshold: 3' >> ${HOME}/.cabal.config + + cabal new-update head.hackage -v + fi + - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' + - "printf 'packages: \".\"\\n' > cabal.project" + - cat cabal.project + - if [ -f "./configure.ac" ]; then + (cd "." && autoreconf -i); + fi + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all + - rm -rf "."/.ghc.environment.* "."/dist + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. script: - # -v2 provides useful information for debugging - - cabal configure -v2 + # test that source-distributions can be generated + - (cd "." && cabal sdist) + - mv "."/dist/profunctors-*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} || false + - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - "printf 'packages: profunctors-*/*.cabal\\n' > cabal.project" + - cat cabal.project + + + # build & run tests, build benchmarks + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + + # cabal check + - (cd profunctors-* && cabal check) + + # haddock + - rm -rf ./dist-newstyle + - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi - # this builds all libraries and executables - # (including tests/benchmarks) - - cabal build - - # tests that a source-distribution can be generated - - cabal sdist - - hlint src --cpp-define HLINT - - # check that the generated source-distribution can be built & installed - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install --force-reinstalls "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi + # hlint + - (cd profunctors-* && hlint src --cpp-define=HLINT) -notifications: - irc: - channels: - - "irc.freenode.org#haskell-lens" - skip_join: true - template: - - "\x0313profunctors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" +# REGENDATA ["-o",".travis.yml","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"] +# EOF diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/CHANGELOG.markdown new/profunctors-5.2.2/CHANGELOG.markdown --- old/profunctors-5.2/CHANGELOG.markdown 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/CHANGELOG.markdown 2018-01-18 21:05:00.000000000 +0100 @@ -1,3 +1,19 @@ +5.2.2 [2018.01.18] +------------------ +* Add `Semigroup` instances for `Closure` and `Tambara` + +5.2.1 +----- +* Allow `base-orphans-0.6`. +* Add `Traversing` instance for `Forget` +* Add `Traversing` and `Mapping` instances for `Procompose` +* Add `Category` instance for `Star` +* Add `mapCayley` to `Data.Profunctor.Cayley` +* Add `pastro` and `unpastro` to `Data.Profunctor.Strong`. +* Add `dimapWandering`, `lmapWandering`, and `rmapWandering` to `Data.Profunctor.Traversing` +* Add documentation stating the laws for various profunctors. +* Introduce the `Data.Profunctor.Yoneda` module. + 5.2 --- * Renamed `Cotambara` to `TambaraChoice` and `Pastro` to `PastroChoice`. @@ -31,7 +47,7 @@ - * `UpStar` and `DownStar` have become `Star` and `Costar`. `Star` is analogous to `Kleisli`, `Costar` is analogous to `Cokleisli`. * Split representability into sieves and representability. -* Moved `Data.Profunctor.Collage` to `semigroupoids` 5, and removed the `semigroupoids` dependency. +* Moved `Data.Profunctor.Collage` to `semigroupoids` 5, and removed the `semigroupoids` dependency. * Rather greatly widened the range of GHC versions we can support. 4.4.1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/profunctors.cabal new/profunctors-5.2.2/profunctors.cabal --- old/profunctors-5.2/profunctors.cabal 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/profunctors.cabal 2018-01-18 21:05:00.000000000 +0100 @@ -1,6 +1,6 @@ name: profunctors category: Control, Categories -version: 5.2 +version: 5.2.2 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -11,8 +11,8 @@ bug-reports: http://github.com/ekmett/profunctors/issues copyright: Copyright (C) 2011-2015 Edward A. Kmett synopsis: Profunctors -description: Profunctors -tested-with: GHC==7.0.1, GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 +description: Profunctors. +tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 build-type: Simple extra-source-files: .ghci @@ -30,11 +30,12 @@ library build-depends: base >= 4 && < 5, - base-orphans >= 0.4 && < 0.6, + base-orphans >= 0.4 && < 0.7, bifunctors >= 5.2 && < 6, comonad >= 4 && < 6, contravariant >= 1 && < 2, distributive >= 0.4.4 && < 1, + semigroups >= 0.11 && < 0.19, tagged >= 0.4.4 && < 1, transformers >= 0.2 && < 0.6 @@ -54,6 +55,7 @@ Data.Profunctor.Traversing Data.Profunctor.Types Data.Profunctor.Unsafe + Data.Profunctor.Yoneda ghc-options: -Wall -O2 hs-source-dirs: src diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Adjunction.hs new/profunctors-5.2.2/src/Data/Profunctor/Adjunction.hs --- old/profunctors-5.2/src/Data/Profunctor/Adjunction.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Adjunction.hs 2018-01-18 21:05:00.000000000 +0100 @@ -17,6 +17,12 @@ import Data.Profunctor.Types import Data.Profunctor.Monad +-- | Laws: +-- +-- @ +-- 'unit' '.' 'counit' ≡ 'id' +-- 'counit' '.' 'unit' ≡ 'id' +-- @ class (ProfunctorFunctor f, ProfunctorFunctor u) => ProfunctorAdjunction f u | f -> u, u -> f where unit :: Profunctor p => p :-> u (f p) counit :: Profunctor p => f (u p) :-> p diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Cayley.hs new/profunctors-5.2.2/src/Data/Profunctor/Cayley.hs --- old/profunctors-5.2/src/Data/Profunctor/Cayley.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Cayley.hs 2018-01-18 21:05:00.000000000 +0100 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-} #endif @@ -81,5 +82,42 @@ instance (Applicative f, ArrowPlus p) => ArrowPlus (Cayley f p) where Cayley f <+> Cayley g = Cayley (liftA2 (<+>) f g) +mapCayley :: (forall a. f a -> g a) -> Cayley f p x y -> Cayley g p x y +mapCayley f (Cayley g) = Cayley (f g) + -- instance Adjunction f g => ProfunctorAdjunction (Cayley f) (Cayley g) where +{- +newtype Uncayley p a = Uncayley (p () a) + +instance Profunctor p => Functor (Uncayley p) where + fmap f (Uncayley p) = Uncayley (rmap f p) + +smash :: Strong p => Cayley (Uncayley p) (->) a b -> p a b +smash (Cayley (Uncayley pab)) = dimap ((,)()) (uncurry id) (first' pab) + +unsmash :: Closed p => p a b -> Cayley (Uncayley p) (->) a b +unsmash = Cayley . Uncayley . curry' . lmap snd + +type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) + +-- pastro and street's strong tambara module +class (Strong p, Closed p) => Stronger p + +-- only a true iso for Stronger p and q, no? +_Smash :: (Strong p, Closed q) => Iso + (Cayley (Uncayley p) (->) a b) + (Cayley (Uncayley q) (->) c d) + (p a b) + (q c d) +_Smash = dimap hither (fmap yon) where + hither (Cayley (Uncayley pab)) = dimap ((,)()) (uncurry id) (first' pab) + yon = Cayley . Uncayley . curry' . lmap snd + +fsmash :: (forall x y. p x y -> q x y) -> Cayley (Uncayley p) (->) a b -> Cayley (Uncayley q) (->) a b +fsmash f (Cayley (Uncayley puab)) = Cayley (Uncayley (f puab)) + +-- | proposition 4.3 from pastro and street is that fsmash and funsmash form an equivalence of categories +funsmash :: (Closed p, Strong q) => (forall x y. Cayley (Uncayley p) (->) x y -> Cayley (Uncayley q) (->) x y) -> p a b -> q a b +funsmash k = smash . k . unsmash +-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Choice.hs new/profunctors-5.2.2/src/Data/Profunctor/Choice.hs --- old/profunctors-5.2/src/Data/Profunctor/Choice.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Choice.hs 2018-01-18 21:05:00.000000000 +0100 @@ -61,9 +61,45 @@ -- Note: This is also a notion of strength, except with regards to another monoidal -- structure that we can choose to equip Hask with: the cocartesian coproduct. class Profunctor p => Choice p where + -- | Laws: + -- + -- @ + -- 'left'' ≡ 'dimap' swapE swapE '.' 'right'' where + -- swapE :: 'Either' a b -> 'Either' b a + -- swapE = 'either' 'Right' 'Left' + -- 'rmap' 'Left' ≡ 'lmap' 'Left' '.' 'left'' + -- 'lmap' ('right' f) '.' 'left'' ≡ 'rmap' ('right' f) '.' 'left'' + -- 'left'' '.' 'left'' ≡ 'dimap' assocE unassocE '.' 'left'' where + -- assocE :: 'Either' ('Either' a b) c -> 'Either' a ('Either' b c) + -- assocE ('Left' ('Left' a)) = 'Left' a + -- assocE ('Left' ('Right' b)) = 'Right' ('Left' b) + -- assocE ('Right' c) = 'Right' ('Right' c) + -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c + -- unassocE ('Left' a) = 'Left' ('Left' a) + -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b) + -- unassocE ('Right' ('Right' c)) = 'Right' c) + -- @ left' :: p a b -> p (Either a c) (Either b c) left' = dimap (either Right Left) (either Right Left) . right' + -- | Laws: + -- + -- @ + -- 'right'' ≡ 'dimap' swapE swapE '.' 'left'' where + -- swapE :: 'Either' a b -> 'Either' b a + -- swapE = 'either' 'Right' 'Left' + -- 'rmap' 'Right' ≡ 'lmap' 'Right' '.' 'right'' + -- 'lmap' ('left' f) '.' 'right'' ≡ 'rmap' ('left' f) '.' 'right'' + -- 'right'' '.' 'right'' ≡ 'dimap' unassocE assocE '.' 'right'' where + -- assocE :: 'Either' ('Either' a b) c -> 'Either' a ('Either' b c) + -- assocE ('Left' ('Left' a)) = 'Left' a + -- assocE ('Left' ('Right' b)) = 'Right' ('Left' b) + -- assocE ('Right' c) = 'Right' ('Right' c) + -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c + -- unassocE ('Left' a) = 'Left' ('Left' a) + -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b) + -- unassocE ('Right' ('Right' c)) = 'Right' c) + -- @ right' :: p a b -> p (Either c a) (Either c b) right' = dimap (either Right Left) (either Right Left) . left' @@ -258,9 +294,45 @@ -------------------------------------------------------------------------------- class Profunctor p => Cochoice p where + -- | Laws: + -- + -- @ + -- 'unleft' ≡ 'unright' '.' 'dimap' swapE swapE where + -- swapE :: 'Either' a b -> 'Either' b a + -- swapE = 'either' 'Right' 'Left' + -- 'rmap' ('either' 'id' 'absurd') ≡ 'unleft' '.' 'lmap' ('either' 'id' 'absurd') + -- 'unfirst' '.' 'rmap' ('second' f) ≡ 'unfirst' '.' 'lmap' ('second' f) + -- 'unleft' '.' 'unleft' ≡ 'unleft' '.' 'dimap' assocE unassocE where + -- assocE :: 'Either' ('Either' a b) c -> 'Either' a ('Either' b c) + -- assocE ('Left' ('Left' a)) = 'Left' a + -- assocE ('Left' ('Right' b)) = 'Right' ('Left' b) + -- assocE ('Right' c) = 'Right' ('Right' c) + -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c + -- unassocE ('Left' a) = 'Left' ('Left' a) + -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b) + -- unassocE ('Right' ('Right' c)) = 'Right' c) + -- @ unleft :: p (Either a d) (Either b d) -> p a b unleft = unright . dimap (either Right Left) (either Right Left) + -- | Laws: + -- + -- @ + -- 'unright' ≡ 'unleft' '.' 'dimap' swapE swapE where + -- swapE :: 'Either' a b -> 'Either' b a + -- swapE = 'either' 'Right' 'Left' + -- 'rmap' ('either' 'absurd' 'id') ≡ 'unright' '.' 'lmap' ('either' 'absurd' 'id') + -- 'unsecond' '.' 'rmap' ('first' f) ≡ 'unsecond' '.' 'lmap' ('first' f) + -- 'unright' '.' 'unright' ≡ 'unright' '.' 'dimap' unassocE assocE where + -- assocE :: 'Either' ('Either' a b) c -> 'Either' a ('Either' b c) + -- assocE ('Left' ('Left' a)) = 'Left' a + -- assocE ('Left' ('Right' b)) = 'Right' ('Left' b) + -- assocE ('Right' c) = 'Right' ('Right' c) + -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c + -- unassocE ('Left' a) = 'Left' ('Left' a) + -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b) + -- unassocE ('Right' ('Right' c)) = 'Right' c) + -- @ unright :: p (Either d a) (Either d b) -> p a b unright = unleft . dimap (either Right Left) (either Right Left) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Closed.hs new/profunctors-5.2.2/src/Data/Profunctor/Closed.hs --- old/profunctors-5.2/src/Data/Profunctor/Closed.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Closed.hs 2018-01-18 21:05:00.000000000 +0100 @@ -34,12 +34,12 @@ import Data.Bifunctor.Product (Product(..)) import Data.Bifunctor.Tannen (Tannen(..)) import Data.Distributive -import Data.Monoid hiding (Product) import Data.Profunctor.Adjunction import Data.Profunctor.Monad import Data.Profunctor.Strong import Data.Profunctor.Types import Data.Profunctor.Unsafe +import Data.Semigroup hiding (Product) import Data.Tagged import Data.Tuple import Prelude hiding ((.),id) @@ -52,6 +52,13 @@ -- -- A closed profunctor allows the closed structure to pass through. class Profunctor p => Closed p where + -- | Laws: + -- + -- @ + -- 'lmap' ('.' f) '.' 'closed' ≡ 'rmap' ('.' f) '.' 'closed' + -- 'closed' '.' 'closed' ≡ 'dimap' 'uncurry' 'curry' '.' 'closed' + -- 'dimap' 'const' ('$'()) '.' 'closed' ≡ 'id' + -- @ closed :: p a b -> p (x -> a) (x -> b) instance Closed Tagged where @@ -148,9 +155,14 @@ empty = zeroArrow f <|> g = f <+> g -instance (Profunctor p, Arrow p, Monoid b) => Monoid (Closure p a b) where +instance (Profunctor p, Arrow p, Semigroup b) => Semigroup (Closure p a b) where + (<>) = liftA2 (<>) + +instance (Profunctor p, Arrow p, Semigroup b, Monoid b) => Monoid (Closure p a b) where mempty = pure mempty - mappend = liftA2 mappend +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif -- | -- @ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Composition.hs new/profunctors-5.2.2/src/Data/Profunctor/Composition.hs --- old/profunctors-5.2/src/Data/Profunctor/Composition.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Composition.hs 2018-01-18 21:05:00.000000000 +0100 @@ -49,6 +49,7 @@ import Data.Profunctor.Monad import Data.Profunctor.Rep import Data.Profunctor.Sieve +import Data.Profunctor.Traversing import Data.Profunctor.Unsafe import Prelude hiding ((.),id) @@ -129,9 +130,19 @@ closed (Procompose x y) = Procompose (closed x) (closed y) {-# INLINE closed #-} +instance (Traversing p, Traversing q) => Traversing (Procompose p q) where + traverse' (Procompose p q) = Procompose (traverse' p) (traverse' q) + {-# INLINE traverse' #-} + +instance (Mapping p, Mapping q) => Mapping (Procompose p q) where + map' (Procompose p q) = Procompose (map' p) (map' q) + {-# INLINE map' #-} + instance (Corepresentable p, Corepresentable q) => Costrong (Procompose p q) where unfirst = unfirstCorep + {-# INLINE unfirst #-} unsecond = unsecondCorep + {-# INLINE unsecond #-} -- * Lax identity diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Mapping.hs new/profunctors-5.2.2/src/Data/Profunctor/Mapping.hs --- old/profunctors-5.2/src/Data/Profunctor/Mapping.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Mapping.hs 2018-01-18 21:05:00.000000000 +0100 @@ -26,6 +26,13 @@ #endif class (Traversing p, Closed p) => Mapping p where + -- | Laws: + -- + -- @ + -- 'map'' '.' 'rmap' f ≡ 'rmap' ('fmap' f) '.' 'map'' + -- 'map'' '.' 'map'' ≡ 'dimap' 'Data.Functor.Compose.Compose' 'Data.Functor.Compose.getCompose' '.' 'map'' + -- 'dimap' 'Data.Functor.Identity.Identity' 'Data.Functor.Identity.runIdentity' '.' 'map'' ≡ 'id' + -- @ map' :: Functor f => p a b -> p (f a) (f b) instance Mapping (->) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Monad.hs new/profunctors-5.2.2/src/Data/Profunctor/Monad.hs --- old/profunctors-5.2/src/Data/Profunctor/Monad.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Monad.hs 2018-01-18 21:05:00.000000000 +0100 @@ -20,6 +20,12 @@ import Data.Profunctor.Types class ProfunctorFunctor t where + -- | Laws: + -- + -- @ + -- 'promap' f '.' 'promap' g ≡ 'promap' (f '.' g) + -- 'promap' 'id' ≡ 'id' + -- @ promap :: Profunctor p => (p :-> q) -> t p :-> t q instance Functor f => ProfunctorFunctor (Tannen f) where @@ -32,6 +38,14 @@ promap _ (L2 p) = L2 p promap f (R2 q) = R2 (f q) +-- | Laws: +-- +-- @ +-- 'promap' f '.' 'proreturn' ≡ 'proreturn' '.' f +-- 'projoin' '.' 'proreturn' ≡ 'id' +-- 'projoin' '.' 'promap' 'proreturn' ≡ 'id' +-- 'projoin' '.' 'projoin' ≡ 'projoin' '.' 'promap' 'projoin' +-- @ class ProfunctorFunctor t => ProfunctorMonad t where proreturn :: Profunctor p => p :-> t p projoin :: Profunctor p => t (t p) :-> t p @@ -49,6 +63,14 @@ projoin (L2 p) = L2 p projoin (R2 m) = m +-- | Laws: +-- +-- @ +-- 'proextract' '.' 'promap' f ≡ f '.' 'proextract' +-- 'proextract' '.' 'produplicate' ≡ 'id' +-- 'promap' 'proextract' '.' 'produplicate' ≡ 'id' +-- 'produplicate' '.' 'produplicate' ≡ 'promap' 'produplicate' '.' 'produplicate' +-- @ class ProfunctorFunctor t => ProfunctorComonad t where proextract :: Profunctor p => t p :-> p produplicate :: Profunctor p => t p :-> t (t p) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Rep.hs new/profunctors-5.2.2/src/Data/Profunctor/Rep.hs --- old/profunctors-5.2/src/Data/Profunctor/Rep.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Rep.hs 2018-01-18 21:05:00.000000000 +0100 @@ -60,6 +60,12 @@ -- @p d c@ is isomorphic to @d -> f c@. class (Sieve p (Rep p), Strong p) => Representable p where type Rep p :: * -> * + -- | Laws: + -- + -- @ + -- 'tabulate' '.' 'sieve' ≡ 'id' + -- 'sieve' '.' 'tabulate' ≡ 'id' + -- @ tabulate :: (d -> Rep p c) -> p d c -- | Default definition for 'first'' given that p is 'Representable'. @@ -115,6 +121,12 @@ -- @p d c@ is isomorphic to @f d -> c@. class (Cosieve p (Corep p), Costrong p) => Corepresentable p where type Corep p :: * -> * + -- | Laws: + -- + -- @ + -- 'cotabulate' '.' 'cosieve' ≡ 'id' + -- 'cosieve' '.' 'cotabulate' ≡ 'id' + -- @ cotabulate :: (Corep p d -> c) -> p d c -- | Default definition for 'unfirst' given that @p@ is 'Corepresentable'. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Strong.hs new/profunctors-5.2.2/src/Data/Profunctor/Strong.hs --- old/profunctors-5.2/src/Data/Profunctor/Strong.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Strong.hs 2018-01-18 21:05:00.000000000 +0100 @@ -26,6 +26,7 @@ , Tambara(..) , tambara, untambara , Pastro(..) + , pastro, unpastro -- * Costrength , Costrong(..) , Cotambara(..) @@ -43,11 +44,11 @@ import Data.Bifunctor.Product (Product(..)) import Data.Bifunctor.Tannen (Tannen(..)) import Data.Functor.Contravariant (Contravariant(..)) -import Data.Monoid hiding (Product) import Data.Profunctor.Adjunction import Data.Profunctor.Monad import Data.Profunctor.Types import Data.Profunctor.Unsafe +import Data.Semigroup hiding (Product) import Data.Tagged import Data.Tuple import Prelude hiding (id,(.)) @@ -64,14 +65,35 @@ -- of Hask. -- -- <http://www-kb.is.s.u-tokyo.ac.jp/~asada/papers/arrStrMnd.pdf> +-- class Profunctor p => Strong p where + -- | Laws: + -- + -- @ + -- 'first'' ≡ 'dimap' 'swap' 'swap' '.' 'second'' + -- 'lmap' 'fst' ≡ 'rmap' 'fst' '.' 'first'' + -- 'lmap' ('second' f) '.' 'first'' ≡ 'rmap' ('second' f) '.' 'first' + -- 'first'' '.' 'first'' ≡ 'dimap' assoc unassoc '.' 'first'' where + -- assoc ((a,b),c) = (a,(b,c)) + -- unassoc (a,(b,c)) = ((a,b),c) + -- @ first' :: p a b -> p (a, c) (b, c) first' = dimap swap swap . second' + -- | Laws: + -- + -- @ + -- 'second'' ≡ 'dimap' 'swap' 'swap' '.' 'first'' + -- 'lmap' 'snd' ≡ 'rmap' 'snd' '.' 'second'' + -- 'lmap' ('first' f) '.' 'second'' ≡ 'rmap' ('first' f) '.' 'second'' + -- 'second'' '.' 'second'' ≡ 'dimap' unassoc assoc '.' 'second'' where + -- assoc ((a,b),c) = (a,(b,c)) + -- unassoc (a,(b,c)) = ((a,b),c) + -- @ second' :: p a b -> p (c, a) (c, b) second' = dimap swap swap . first' -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL first' | second' #-} #endif @@ -83,6 +105,7 @@ first' ab ~(a, c) = (ab a, c) {-# INLINE first' #-} second' ab ~(c, a) = (c, ab a) + {-# INLINE second' #-} instance Monad m => Strong (Kleisli m) where first' (Kleisli f) = Kleisli $ \ ~(a, c) -> do @@ -203,22 +226,27 @@ empty = zeroArrow f <|> g = f <+> g +instance ArrowPlus p => Semigroup (Tambara p a b) where + f <> g = f <+> g + instance ArrowPlus p => Monoid (Tambara p a b) where mempty = zeroArrow - mappend f g = f <+> g +#if !(MIN_VERSION_base(4,11,0)) + mappend = (<>) +#endif -- | -- @ --- 'tambara' '.' 'untambara' ≡ 'id' --- 'untambara' '.' 'tambara' ≡ 'id' +-- 'tambara' ('untambara' f) ≡ f +-- 'untambara' ('tambara' f) ≡ f -- @ tambara :: Strong p => (p :-> q) -> p :-> Tambara q tambara f p = Tambara $ f $ first' p -- | -- @ --- 'tambara' '.' 'untambara' ≡ 'id' --- 'untambara' '.' 'tambara' ≡ 'id' +-- 'tambara' ('untambara' f) ≡ f +-- 'untambara' ('tambara' f) ≡ f -- @ untambara :: Profunctor q => (p :-> Tambara q) -> p :-> q untambara f p = dimap (\a -> (a,())) fst $ runTambara $ f p @@ -269,15 +297,51 @@ (x,z) -> (x,(c,z)) l' (y,(c,z)) = (c,l (y,z)) +-- | +-- @ +-- 'pastro' ('unpastro' f) ≡ f +-- 'unpastro' ('pastro' f) ≡ f +-- @ +pastro :: Strong q => (p :-> q) -> Pastro p :-> q +pastro f (Pastro r g l) = dimap l r (first' (f g)) + +-- | +-- @ +-- 'pastro' ('unpastro' f) ≡ f +-- 'unpastro' ('pastro' f) ≡ f +-- @ +unpastro :: (Pastro p :-> q) -> p :-> q +unpastro f p = f (Pastro fst p (\a -> (a, ()))) + -------------------------------------------------------------------------------- -- * Costrength for (,) -------------------------------------------------------------------------------- -- | Analogous to 'ArrowLoop', 'loop' = 'unfirst' class Profunctor p => Costrong p where + -- | Laws: + -- + -- @ + -- 'unfirst' ≡ 'unsecond' '.' 'dimap' 'swap' 'swap' + -- 'lmap' (,()) ≡ 'unfirst' '.' 'rmap' (,()) + -- 'unfirst' '.' 'lmap' ('second' f) ≡ 'unfirst' '.' 'rmap' ('second' f) + -- 'unfirst' '.' 'unfirst' = 'unfirst' '.' 'dimap' assoc unassoc where + -- assoc ((a,b),c) = (a,(b,c)) + -- unassoc (a,(b,c)) = ((a,b),c) + -- @ unfirst :: p (a, d) (b, d) -> p a b unfirst = unsecond . dimap swap swap + -- | Laws: + -- + -- @ + -- 'unsecond' ≡ 'unfirst' '.' 'dimap' 'swap' 'swap' + -- 'lmap' ((),) ≡ 'unsecond' '.' 'rmap' ((),) + -- 'unsecond' '.' 'lmap' ('first' f) ≡ 'unsecond' '.' 'rmap' ('first' f) + -- 'unsecond' '.' 'unsecond' = 'unsecond' '.' 'dimap' unassoc assoc where + -- assoc ((a,b),c) = (a,(b,c)) + -- unassoc (a,(b,c)) = ((a,b),c) + -- @ unsecond :: p (d, a) (d, b) -> p a b unsecond = unfirst . dimap swap swap diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Traversing.hs new/profunctors-5.2.2/src/Data/Profunctor/Traversing.hs --- old/profunctors-5.2/src/Data/Profunctor/Traversing.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Traversing.hs 2018-01-18 21:05:00.000000000 +0100 @@ -6,6 +6,10 @@ ( Traversing(..) , CofreeTraversing(..) , FreeTraversing(..) + -- * Profunctor in terms of Traversing + , dimapWandering + , lmapWandering + , rmapWandering -- * Strong in terms of Traversing , firstTraversing , secondTraversing @@ -28,6 +32,7 @@ import Data.Tuple (swap) #if __GLASGOW_HASKELL__ < 710 +import Data.Monoid (Monoid) import Data.Foldable import Prelude hiding (mapM) #endif @@ -41,6 +46,21 @@ swapE :: Either a b -> Either b a swapE = either Right Left +-- | A definition of 'dimap' for 'Traversing' instances that define +-- an explicit 'wander'. +dimapWandering :: Traversing p => (a' -> a) -> (b -> b') -> p a b -> p a' b' +dimapWandering f g = wander (\afb a' -> g <$> afb (f a')) + +-- | 'lmapWandering' may be a more efficient implementation +-- of 'lmap' than the default produced from 'dimapWandering'. +lmapWandering :: Traversing p => (a -> b) -> p b c -> p a c +lmapWandering f = wander (\afb a' -> afb (f a')) + +-- | 'rmapWandering' is the same as the default produced from +-- 'dimapWandering'. +rmapWandering :: Traversing p => (b -> c) -> p a b -> p a c +rmapWandering g = wander (\afb a' -> g <$> afb a') + leftTraversing :: Traversing p => p a b -> p (Either a c) (Either b c) leftTraversing = dimap swapE swapE . traverse' @@ -83,13 +103,22 @@ -- | Note: Definitions in terms of 'wander' are much more efficient! class (Choice p, Strong p) => Traversing p where + -- | Laws: + -- + -- @ + -- 'traverse'' ≡ 'wander' 'traverse' + -- 'traverse'' '.' 'rmap' f ≡ 'rmap' ('fmap' f) '.' 'traverse'' + -- 'traverse'' '.' 'traverse'' ≡ 'dimap' 'Compose' 'getCompose' '.' 'traverse'' + -- 'dimap' 'Identity' 'runIdentity' '.' 'traverse'' ≡ 'id' + -- @ traverse' :: Traversable f => p a b -> p (f a) (f b) traverse' = wander traverse + -- | This combinator is mutually defined in terms of 'traverse'' wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t wander f pab = dimap (\s -> Baz $ \afb -> f afb s) sold (traverse' pab) -#if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL wander | traverse' #-} #endif @@ -97,6 +126,10 @@ traverse' = fmap wander f ab = runIdentity #. f (Identity #. ab) +instance Monoid m => Traversing (Forget m) where + traverse' (Forget h) = Forget (foldMap h) + wander f (Forget h) = Forget (getConst . f (Const . h)) + instance Monad m => Traversing (Kleisli m) where traverse' (Kleisli m) = Kleisli (mapM m) wander f (Kleisli amb) = Kleisli $ unwrapMonad #. f (WrapMonad #. amb) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Types.hs new/profunctors-5.2.2/src/Data/Profunctor/Types.hs --- old/profunctors-5.2/src/Data/Profunctor/Types.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Types.hs 2018-01-18 21:05:00.000000000 +0100 @@ -3,7 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708 +#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif @@ -107,6 +107,10 @@ instance Distributive f => Distributive (Star f a) where distribute fs = Star $ \a -> collect (($ a) .# runStar) fs +instance Monad f => Category (Star f) where + id = Star return + Star f . Star g = Star $ \a -> g a >>= f + ------------------------------------------------------------------------------ -- Costar ------------------------------------------------------------------------------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Unsafe.hs new/profunctors-5.2.2/src/Data/Profunctor/Unsafe.hs --- old/profunctors-5.2/src/Data/Profunctor/Unsafe.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Unsafe.hs 2018-01-18 21:05:00.000000000 +0100 @@ -56,8 +56,10 @@ import Unsafe.Coerce #endif +#ifdef HLINT {-# ANN module "Hlint: ignore Redundant lambda" #-} {-# ANN module "Hlint: ignore Collapse lambdas" #-} +#endif infixr 9 #. infixl 8 .# diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor/Yoneda.hs new/profunctors-5.2.2/src/Data/Profunctor/Yoneda.hs --- old/profunctors-5.2/src/Data/Profunctor/Yoneda.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor/Yoneda.hs 2018-01-18 21:05:00.000000000 +0100 @@ -0,0 +1,251 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Copyright : (C) 2017 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett <[email protected]> +-- Stability : provisional +-- Portability : Rank2Types, TFs +-- +---------------------------------------------------------------------------- +module Data.Profunctor.Yoneda + ( Yoneda(..), extractYoneda, duplicateYoneda + , Coyoneda(..), returnCoyoneda, joinCoyoneda + ) where + +import Control.Category +import Data.Profunctor +import Data.Profunctor.Monad +import Data.Profunctor.Traversing +import Data.Profunctor.Unsafe +import Prelude hiding (id,(.)) + +#if __GLASGOW_HASKELL__ >= 708 +import Data.Coerce +#else +import Unsafe.Coerce +#endif + +-------------------------------------------------------------------------------- +-- * Yoneda +-------------------------------------------------------------------------------- + +-- | This is the cofree profunctor given a data constructor of kind @* -> * -> *@ +newtype Yoneda p a b = Yoneda { runYoneda :: forall x y. (x -> a) -> (b -> y) -> p x y } + +-- Yoneda is a comonad on |*| -> Nat(|*|,*), we don't need the profunctor constraint to extract or duplicate +-- | +-- @ +-- 'projoin' '.' 'extractYoneda' ≡ 'id' +-- 'extractYoneda' '.' 'projoin' ≡ 'id' +-- 'projoin' ≡ 'extractYoneda' +-- @ +extractYoneda :: Yoneda p a b -> p a b +extractYoneda p = runYoneda p id id + +-- | +-- @ +-- 'projoin' '.' 'duplicateYoneda' ≡ 'id' +-- 'duplicateYoneda' '.' 'projoin' ≡ 'id' +-- 'duplicateYoneda' = 'proreturn' +-- @ +duplicateYoneda :: Yoneda p a b -> Yoneda (Yoneda p) a b +duplicateYoneda p = Yoneda $ \l r -> dimap l r p + +instance Profunctor (Yoneda p) where + dimap l r p = Yoneda $ \l' r' -> runYoneda p (l . l') (r' . r) + {-# INLINE dimap #-} + lmap l p = Yoneda $ \l' r -> runYoneda p (l . l') r + {-# INLINE lmap #-} + rmap r p = Yoneda $ \l r' -> runYoneda p l (r' . r) + {-# INLINE rmap #-} +#if __GLASGOW_HASKELL__ >= 708 + ( .# ) p _ = coerce p + {-# INLINE ( .# ) #-} + ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b + {-# INLINE ( #. ) #-} +#else + ( .# ) p _ = unsafeCoerce p + {-# INLINE ( .# ) #-} + ( #. ) _ = unsafeCoerce + {-# INLINE ( #. ) #-} +#endif + +instance Functor (Yoneda p a) where + fmap f p = Yoneda $ \l r -> runYoneda p l (r . f) + {-# INLINE fmap #-} + +instance ProfunctorFunctor Yoneda where + promap f p = Yoneda $ \l r -> f (runYoneda p l r) + {-# INLINE promap #-} + +instance ProfunctorComonad Yoneda where + proextract p = runYoneda p id id + {-# INLINE proextract #-} + produplicate p = Yoneda $ \l r -> dimap l r p + {-# INLINE produplicate #-} + +instance ProfunctorMonad Yoneda where + proreturn p = Yoneda $ \l r -> dimap l r p + {-# INLINE proreturn #-} + projoin p = runYoneda p id id + {-# INLINE projoin #-} + +instance (Category p, Profunctor p) => Category (Yoneda p) where + id = Yoneda $ \l r -> dimap l r id + {-# INLINE id #-} + p . q = Yoneda $ \ l r -> runYoneda p id r . runYoneda q l id + {-# INLINE (.) #-} + +instance Strong p => Strong (Yoneda p) where + first' = proreturn . first' . extractYoneda + {-# INLINE first' #-} + second' = proreturn . second' . extractYoneda + {-# INLINE second' #-} + +instance Choice p => Choice (Yoneda p) where + left' = proreturn . left' . extractYoneda + {-# INLINE left' #-} + right' = proreturn . right' . extractYoneda + {-# INLINE right' #-} + +instance Costrong p => Costrong (Yoneda p) where + unfirst = proreturn . unfirst . extractYoneda + {-# INLINE unfirst #-} + unsecond = proreturn . unsecond . extractYoneda + {-# INLINE unsecond #-} + +instance Cochoice p => Cochoice (Yoneda p) where + unleft = proreturn . unleft . extractYoneda + {-# INLINE unleft #-} + unright = proreturn . unright . extractYoneda + {-# INLINE unright #-} + +instance Closed p => Closed (Yoneda p) where + closed = proreturn . closed . extractYoneda + {-# INLINE closed #-} + +instance Mapping p => Mapping (Yoneda p) where + map' = proreturn . map' . extractYoneda + {-# INLINE map' #-} + +instance Traversing p => Traversing (Yoneda p) where + traverse' = proreturn . traverse' . extractYoneda + {-# INLINE traverse' #-} + wander f = proreturn . wander f . extractYoneda + {-# INLINE wander #-} + +-------------------------------------------------------------------------------- +-- * Coyoneda +-------------------------------------------------------------------------------- + +data Coyoneda p a b where + Coyoneda :: (a -> x) -> (y -> b) -> p x y -> Coyoneda p a b + +-- Coyoneda is a Monad on |*| -> Nat(|*|,*), we don't need the profunctor constraint to extract or duplicate + +-- | +-- @ +-- 'returnCoyoneda' '.' 'proextract' ≡ 'id' +-- 'proextract' '.' 'returnCoyoneda' ≡ 'id' +-- 'produplicate' ≡ 'returnCoyoneda' +-- @ +returnCoyoneda :: p a b -> Coyoneda p a b +returnCoyoneda = Coyoneda id id + +-- | +-- @ +-- 'joinCoyoneda' '.' 'produplicate' ≡ 'id' +-- 'produplicate' '.' 'joinCoyoneda' ≡ 'id' +-- 'joinCoyoneda' ≡ 'proextract' +-- @ +joinCoyoneda :: Coyoneda (Coyoneda p) a b -> Coyoneda p a b +joinCoyoneda (Coyoneda l r p) = dimap l r p + +instance Profunctor (Coyoneda p) where + dimap l r (Coyoneda l' r' p) = Coyoneda (l' . l) (r . r') p + {-# INLINE dimap #-} + lmap l (Coyoneda l' r p) = Coyoneda (l' . l) r p + {-# INLINE lmap #-} + rmap r (Coyoneda l r' p) = Coyoneda l (r . r') p + {-# INLINE rmap #-} +#if __GLASGOW_HASKELL__ >= 708 + ( .# ) p _ = coerce p + {-# INLINE ( .# ) #-} + ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b + {-# INLINE ( #. ) #-} +#else + ( .# ) p _ = unsafeCoerce p + {-# INLINE ( .# ) #-} + ( #. ) _ = unsafeCoerce + {-# INLINE ( #. ) #-} +#endif + +instance ProfunctorFunctor Coyoneda where + promap f (Coyoneda l r p) = Coyoneda l r (f p) + {-# INLINE promap #-} + +instance ProfunctorComonad Coyoneda where + proextract (Coyoneda l r p) = dimap l r p + {-# INLINE proextract #-} + produplicate = Coyoneda id id + {-# INLINE produplicate #-} + +instance ProfunctorMonad Coyoneda where + proreturn = returnCoyoneda + {-# INLINE proreturn #-} + projoin = joinCoyoneda + {-# INLINE projoin #-} + +instance (Category p, Profunctor p) => Category (Coyoneda p) where + id = Coyoneda id id id + {-# INLINE id #-} + Coyoneda lp rp p . Coyoneda lq rq q = Coyoneda lq rp (p . rmap (lp . rq) q) + {-# INLINE (.) #-} + +instance Strong p => Strong (Coyoneda p) where + first' = returnCoyoneda . first' . proextract + {-# INLINE first' #-} + second' = returnCoyoneda . second' . proextract + {-# INLINE second' #-} + +instance Choice p => Choice (Coyoneda p) where + left' = returnCoyoneda . left' . proextract + {-# INLINE left' #-} + right' = returnCoyoneda . right' . proextract + {-# INLINE right' #-} + +instance Costrong p => Costrong (Coyoneda p) where + unfirst = returnCoyoneda . unfirst . proextract + {-# INLINE unfirst #-} + unsecond = returnCoyoneda . unsecond . proextract + {-# INLINE unsecond #-} + +instance Cochoice p => Cochoice (Coyoneda p) where + unleft = returnCoyoneda . unleft . proextract + {-# INLINE unleft #-} + unright = returnCoyoneda . unright . proextract + {-# INLINE unright #-} + +instance Closed p => Closed (Coyoneda p) where + closed = returnCoyoneda . closed . proextract + {-# INLINE closed #-} + +instance Mapping p => Mapping (Coyoneda p) where + map' = returnCoyoneda . map' . proextract + {-# INLINE map' #-} + +instance Traversing p => Traversing (Coyoneda p) where + traverse' = returnCoyoneda . traverse' . proextract + {-# INLINE traverse' #-} + wander f = returnCoyoneda . wander f . proextract + {-# INLINE wander #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-5.2/src/Data/Profunctor.hs new/profunctors-5.2.2/src/Data/Profunctor.hs --- old/profunctors-5.2/src/Data/Profunctor.hs 2016-01-17 00:03:50.000000000 +0100 +++ new/profunctors-5.2.2/src/Data/Profunctor.hs 2018-01-18 21:05:00.000000000 +0100 @@ -2,7 +2,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- ++++++ profunctors.cabal ++++++ --- /var/tmp/diff_new_pack.jXbarI/_old 2018-05-30 12:26:53.103150944 +0200 +++ /var/tmp/diff_new_pack.jXbarI/_new 2018-05-30 12:26:53.107150807 +0200 @@ -1,6 +1,6 @@ name: profunctors category: Control, Categories -version: 5.2 +version: 5.2.2 x-revision: 1 license: BSD3 cabal-version: >= 1.10 @@ -12,8 +12,8 @@ bug-reports: http://github.com/ekmett/profunctors/issues copyright: Copyright (C) 2011-2015 Edward A. Kmett synopsis: Profunctors -description: Profunctors -tested-with: GHC==7.0.1, GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 +description: Profunctors. +tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 build-type: Simple extra-source-files: .ghci @@ -31,11 +31,12 @@ library build-depends: base >= 4 && < 5, - base-orphans >= 0.4 && < 0.7, + base-orphans >= 0.4 && < 0.8, bifunctors >= 5.2 && < 6, comonad >= 4 && < 6, contravariant >= 1 && < 2, distributive >= 0.4.4 && < 1, + semigroups >= 0.11 && < 0.19, tagged >= 0.4.4 && < 1, transformers >= 0.2 && < 0.6 @@ -55,6 +56,7 @@ Data.Profunctor.Traversing Data.Profunctor.Types Data.Profunctor.Unsafe + Data.Profunctor.Yoneda ghc-options: -Wall -O2 hs-source-dirs: src
