Hello community, here is the log from the commit of package ghc-profunctors for openSUSE:Factory checked in at 2015-08-27 08:55:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-profunctors (Old) and /work/SRC/openSUSE:Factory/.ghc-profunctors.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-profunctors" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-profunctors/ghc-profunctors.changes 2015-05-27 12:45:14.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-profunctors.new/ghc-profunctors.changes 2015-08-27 08:55:32.000000000 +0200 @@ -1,0 +2,16 @@ +Thu Aug 6 19:30:53 UTC 2015 - [email protected] + +- update to 5.1.1 +* Add proper support for GHC 7.0+. +* instance Costrong (Cokleisli f). +* instance Cochoice (Star f). +* Changed the instance for Cochoice (Costar f). +* MINIMAL pragma for Costrong and Cochoice. +* More Costrong and Cochoice instances. +* 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. + +------------------------------------------------------------------- Old: ---- profunctors-4.4.1.tar.gz New: ---- profunctors-5.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-profunctors.spec ++++++ --- /var/tmp/diff_new_pack.Ecwxvt/_old 2015-08-27 08:55:33.000000000 +0200 +++ /var/tmp/diff_new_pack.Ecwxvt/_new 2015-08-27 08:55:33.000000000 +0200 @@ -17,8 +17,8 @@ %global pkg_name profunctors -Name: ghc-%{pkg_name} -Version: 4.4.1 +Name: ghc-profunctors +Version: 5.1.1 Release: 0 Summary: Profunctors Group: System/Libraries @@ -33,13 +33,12 @@ # Begin cabal-rpm deps: BuildRequires: ghc-comonad-devel BuildRequires: ghc-distributive-devel -BuildRequires: ghc-semigroupoids-devel BuildRequires: ghc-tagged-devel BuildRequires: ghc-transformers-devel # End cabal-rpm deps %description -Profunctors. +The profunctors package. %package devel ++++++ profunctors-4.4.1.tar.gz -> profunctors-5.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/.travis.yml new/profunctors-5.1.1/.travis.yml --- old/profunctors-4.4.1/.travis.yml 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/.travis.yml 2015-05-20 13:53:11.000000000 +0200 @@ -2,8 +2,9 @@ # See also https://github.com/hvr/multi-ghc-travis for more information env: - # we have to use CABALVER=1.16 for GHC<7.6 as well, as there's - # no package for earlier cabal versions in the PPA + - GHCVER=7.0.1 CABALVER=1.16 + - GHCVER=7.0.4 CABALVER=1.16 + - GHCVER=7.2.2 CABALVER=1.16 - GHCVER=7.4.2 CABALVER=1.16 - GHCVER=7.6.3 CABALVER=1.16 - GHCVER=7.8.4 CABALVER=1.18 @@ -12,6 +13,9 @@ matrix: allow_failures: + - env: GHCVER=7.0.1 CABALVER=1.16 + - env: GHCVER=7.0.4 CABALVER=1.16 + - env: GHCVER=7.2.2 CABALVER=1.16 - env: GHCVER=head CABALVER=1.22 # Note: the distinction between `before_install` and `install` is not diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/CHANGELOG.markdown new/profunctors-5.1.1/CHANGELOG.markdown --- old/profunctors-4.4.1/CHANGELOG.markdown 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/CHANGELOG.markdown 2015-05-20 13:53:11.000000000 +0200 @@ -1,3 +1,29 @@ +5.1.1 +----- +* Add proper support for GHC 7.0+. + +5.1 +--- +* `instance Costrong (Cokleisli f)`. +* `instance Cochoice (Star f)`. +* Changed the instance for `Cochoice (Costar f)`. + +5.0.1 +----- +* MINIMAL pragma for `Costrong` and `Cochoice`. +* More `Costrong` and `Cochoice` instances. + +5.0.0.1 +------- +* Documentation fix + +5 +- +* `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. +* Rather greatly widened the range of GHC versions we can support. + 4.4.1 ------- * Using `SafeHaskell`, GHC 7.8+ `Data.Profunctor.Unsafe` now infers as `Trustworthy` and diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/HLint.hs new/profunctors-5.1.1/HLint.hs --- old/profunctors-4.4.1/HLint.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/profunctors-5.1.1/HLint.hs 2015-05-20 13:53:11.000000000 +0200 @@ -0,0 +1 @@ +ignore "use const" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/profunctors.cabal new/profunctors-5.1.1/profunctors.cabal --- old/profunctors-4.4.1/profunctors.cabal 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/profunctors.cabal 2015-05-20 13:53:11.000000000 +0200 @@ -1,6 +1,6 @@ name: profunctors category: Control, Categories -version: 4.4.1 +version: 5.1.1 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -9,9 +9,10 @@ stability: experimental homepage: http://github.com/ekmett/profunctors/ bug-reports: http://github.com/ekmett/profunctors/issues -copyright: Copyright (C) 2011-2014 Edward A. Kmett +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 build-type: Simple extra-source-files: .ghci @@ -20,6 +21,7 @@ .vim.custom README.markdown CHANGELOG.markdown + HLint.hs source-repository head type: git @@ -30,7 +32,6 @@ base >= 4 && < 5, comonad >= 4 && < 5, distributive >= 0.4.4 && < 1, - semigroupoids >= 4 && < 5, tagged >= 0.4.4 && < 1, transformers >= 0.2 && < 0.5 @@ -41,11 +42,11 @@ Data.Profunctor.Closed Data.Profunctor.Codensity Data.Profunctor.Composition - Data.Profunctor.Collage Data.Profunctor.Monad Data.Profunctor.Monoid Data.Profunctor.Ran Data.Profunctor.Rep + Data.Profunctor.Sieve Data.Profunctor.Tambara Data.Profunctor.Trace Data.Profunctor.Unsafe diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Closed.hs new/profunctors-5.1.1/src/Data/Profunctor/Closed.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Closed.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Closed.hs 2015-05-20 13:53:11.000000000 +0200 @@ -44,14 +44,14 @@ instance Closed (->) where closed = (.) -instance Functor f => Closed (DownStar f) where - closed (DownStar fab) = DownStar $ \fxa x -> fab (fmap ($x) fxa) +instance Functor f => Closed (Costar f) where + closed (Costar fab) = Costar $ \fxa x -> fab (fmap ($x) fxa) instance Functor f => Closed (Cokleisli f) where closed (Cokleisli fab) = Cokleisli $ \fxa x -> fab (fmap ($x) fxa) -instance Distributive f => Closed (UpStar f) where - closed (UpStar afb) = UpStar $ \xa -> distribute $ \x -> afb (xa x) +instance Distributive f => Closed (Star f) where + closed (Star afb) = Star $ \xa -> distribute $ \x -> afb (xa x) instance (Distributive f, Monad f) => Closed (Kleisli f) where closed (Kleisli afb) = Kleisli $ \xa -> distribute $ \x -> afb (xa x) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Collage.hs new/profunctors-5.1.1/src/Data/Profunctor/Collage.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Collage.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Collage.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,46 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Profunctor.Collage --- Copyright : (C) 2011-2012 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett <[email protected]> --- Stability : provisional --- Portability : MPTCs --- ----------------------------------------------------------------------------- -module Data.Profunctor.Collage - ( Collage(..) - ) where - -import Data.Semigroupoid -import Data.Semigroupoid.Ob -import Data.Semigroupoid.Coproduct (L, R) -import Data.Profunctor - --- | The cograph of a 'Profunctor'. -data Collage k b a where - L :: (b -> b') -> Collage k (L b) (L b') - R :: (a -> a') -> Collage k (R a) (R a') - C :: k b a -> Collage k (L b) (R a) - -instance Profunctor k => Semigroupoid (Collage k) where - L f `o` L g = L (f . g) - R f `o` R g = R (f . g) - R f `o` C g = C (rmap f g) - C f `o` L g = C (lmap g f) - -instance Profunctor k => Ob (Collage k) (L a) where - semiid = L semiid - -instance Profunctor k => Ob (Collage k) (R a) where - semiid = R semiid diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Composition.hs new/profunctors-5.1.1/src/Data/Profunctor/Composition.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Composition.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Composition.hs 2015-05-20 13:53:11.000000000 +0200 @@ -4,6 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-} #endif @@ -28,8 +29,8 @@ , idr , assoc -- * Generalized Composition - , upstars, kleislis - , downstars, cokleislis + , stars, kleislis + , costars, cokleislis -- * Right Kan Lift , Rift(..) , decomposeRift @@ -45,6 +46,7 @@ import Data.Profunctor.Closed import Data.Profunctor.Monad import Data.Profunctor.Rep +import Data.Profunctor.Sieve import Data.Profunctor.Unsafe import Prelude hiding ((.),id) @@ -89,21 +91,25 @@ fmap k (Procompose f g) = Procompose (rmap k f) g {-# INLINE fmap #-} +instance (Sieve p f, Sieve q g) => Sieve (Procompose p q) (Compose g f) where + sieve (Procompose g f) d = Compose $ sieve g <$> sieve f d + {-# INLINE sieve #-} + -- | The composition of two 'Representable' 'Profunctor's is 'Representable' by -- the composition of their representations. instance (Representable p, Representable q) => Representable (Procompose p q) where type Rep (Procompose p q) = Compose (Rep q) (Rep p) tabulate f = Procompose (tabulate id) (tabulate (getCompose . f)) {-# INLINE tabulate #-} - rep (Procompose g f) d = Compose $ rep g <$> rep f d - {-# INLINE rep #-} + +instance (Cosieve p f, Cosieve q g) => Cosieve (Procompose p q) (Compose f g) where + cosieve (Procompose g f) (Compose d) = cosieve g $ cosieve f <$> d + {-# INLINE cosieve #-} instance (Corepresentable p, Corepresentable q) => Corepresentable (Procompose p q) where type Corep (Procompose p q) = Compose (Corep p) (Corep q) cotabulate f = Procompose (cotabulate (f . Compose)) (cotabulate id) {-# INLINE cotabulate #-} - corep (Procompose g f) (Compose d) = corep g $ corep f <$> d - {-# INLINE corep #-} instance (Strong p, Strong q) => Strong (Procompose p q) where first' (Procompose x y) = Procompose (first' x) (first' y) @@ -121,6 +127,10 @@ closed (Procompose x y) = Procompose (closed x) (closed y) {-# INLINE closed #-} +instance (Corepresentable p, Corepresentable q) => Costrong (Procompose p q) where + unfirst = unfirstCorep + unsecond = unsecondCorep + -- * Lax identity -- | @(->)@ functions as a lax identity for 'Profunctor' composition. @@ -164,32 +174,32 @@ -- This is the first, which shows that @exists b. (a -> f b, b -> g c)@ is -- isomorphic to @a -> f (g c)@. -- --- @'upstars' :: 'Functor' f => Iso' ('Procompose' ('UpStar' f) ('UpStar' g) d c) ('UpStar' ('Compose' f g) d c)@ -upstars :: Functor g - => Iso (Procompose (UpStar f ) (UpStar g ) d c ) - (Procompose (UpStar f') (UpStar g') d' c') - (UpStar (Compose g f ) d c ) - (UpStar (Compose g' f') d' c') -upstars = dimap hither (fmap yon) where - hither (Procompose (UpStar xgc) (UpStar dfx)) = UpStar (Compose . fmap xgc . dfx) - yon (UpStar dfgc) = Procompose (UpStar id) (UpStar (getCompose . dfgc)) +-- @'stars' :: 'Functor' f => Iso' ('Procompose' ('Star' f) ('Star' g) d c) ('Star' ('Compose' f g) d c)@ +stars :: Functor g + => Iso (Procompose (Star f ) (Star g ) d c ) + (Procompose (Star f') (Star g') d' c') + (Star (Compose g f ) d c ) + (Star (Compose g' f') d' c') +stars = dimap hither (fmap yon) where + hither (Procompose (Star xgc) (Star dfx)) = Star (Compose . fmap xgc . dfx) + yon (Star dfgc) = Procompose (Star id) (Star (getCompose . dfgc)) -- | 'Profunctor' composition generalizes 'Functor' composition in two ways. -- -- This is the second, which shows that @exists b. (f a -> b, g b -> c)@ is -- isomorphic to @g (f a) -> c@. -- --- @'downstars' :: 'Functor' f => Iso' ('Procompose' ('DownStar' f) ('DownStar' g) d c) ('DownStar' ('Compose' g f) d c)@ -downstars :: Functor f - => Iso (Procompose (DownStar f ) (DownStar g ) d c ) - (Procompose (DownStar f') (DownStar g') d' c') - (DownStar (Compose f g ) d c ) - (DownStar (Compose f' g') d' c') -downstars = dimap hither (fmap yon) where - hither (Procompose (DownStar gxc) (DownStar fdx)) = DownStar (gxc . fmap fdx . getCompose) - yon (DownStar dgfc) = Procompose (DownStar (dgfc . Compose)) (DownStar id) +-- @'costars' :: 'Functor' f => Iso' ('Procompose' ('Costar' f) ('Costar' g) d c) ('Costar' ('Compose' g f) d c)@ +costars :: Functor f + => Iso (Procompose (Costar f ) (Costar g ) d c ) + (Procompose (Costar f') (Costar g') d' c') + (Costar (Compose f g ) d c ) + (Costar (Compose f' g') d' c') +costars = dimap hither (fmap yon) where + hither (Procompose (Costar gxc) (Costar fdx)) = Costar (gxc . fmap fdx . getCompose) + yon (Costar dgfc) = Procompose (Costar (dgfc . Compose)) (Costar id) --- | This is a variant on 'upstars' that uses 'Kleisli' instead of 'UpStar'. +-- | This is a variant on 'stars' that uses 'Kleisli' instead of 'Star'. -- -- @'kleislis' :: 'Monad' f => Iso' ('Procompose' ('Kleisli' f) ('Kleisli' g) d c) ('Kleisli' ('Compose' f g) d c)@ kleislis :: Monad g @@ -201,8 +211,8 @@ hither (Procompose (Kleisli xgc) (Kleisli dfx)) = Kleisli (Compose . liftM xgc . dfx) yon (Kleisli dfgc) = Procompose (Kleisli id) (Kleisli (getCompose . dfgc)) --- | This is a variant on 'downstars' that uses 'Cokleisli' instead --- of 'DownStar'. +-- | This is a variant on 'costars' that uses 'Cokleisli' instead +-- of 'Costar'. -- -- @'cokleislis' :: 'Functor' f => Iso' ('Procompose' ('Cokleisli' f) ('Cokleisli' g) d c) ('Cokleisli' ('Compose' g f) d c)@ cokleislis :: Functor f diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Rep.hs new/profunctors-5.1.1/src/Data/Profunctor/Rep.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Rep.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Rep.hs 2015-05-20 13:53:11.000000000 +0200 @@ -21,10 +21,13 @@ module Data.Profunctor.Rep ( -- * Representable Profunctors - Representable(..), tabulated + Representable(..) + , tabulated , firstRep, secondRep -- * Corepresentable Profunctors - , Corepresentable(..), cotabulated + , Corepresentable(..) + , cotabulated + , unfirstCorep, unsecondCorep ) where import Control.Applicative @@ -32,6 +35,7 @@ import Control.Comonad import Data.Functor.Identity import Data.Profunctor +import Data.Profunctor.Sieve import Data.Proxy import Data.Tagged @@ -39,100 +43,92 @@ -- | A 'Profunctor' @p@ is 'Representable' if there exists a 'Functor' @f@ such that -- @p d c@ is isomorphic to @d -> f c@. -class (Functor (Rep p), Strong p) => Representable p where +class (Sieve p (Rep p), Strong p) => Representable p where type Rep p :: * -> * tabulate :: (d -> Rep p c) -> p d c - rep :: p d c -> d -> Rep p c -- | Default definition for 'first'' given that p is 'Representable'. firstRep :: Representable p => p a b -> p (a, c) (b, c) -firstRep p = tabulate $ \(a,c) -> (\b -> (b, c)) <$> rep p a +firstRep p = tabulate $ \(a,c) -> (\b -> (b, c)) <$> sieve p a -- | Default definition for 'second'' given that p is 'Representable'. secondRep :: Representable p => p a b -> p (c, a) (c, b) -secondRep p = tabulate $ \(c,a) -> (,) c <$> rep p a +secondRep p = tabulate $ \(c,a) -> (,) c <$> sieve p a instance Representable (->) where type Rep (->) = Identity tabulate f = runIdentity . f {-# INLINE tabulate #-} - rep f = Identity . f - {-# INLINE rep #-} instance (Monad m, Functor m) => Representable (Kleisli m) where type Rep (Kleisli m) = m tabulate = Kleisli {-# INLINE tabulate #-} - rep = runKleisli - {-# INLINE rep #-} -instance Functor f => Representable (UpStar f) where - type Rep (UpStar f) = f - tabulate = UpStar +instance Functor f => Representable (Star f) where + type Rep (Star f) = f + tabulate = Star {-# INLINE tabulate #-} - rep = runUpStar - {-# INLINE rep #-} - + instance Representable (Forget r) where type Rep (Forget r) = Const r tabulate = Forget . (getConst .) {-# INLINE tabulate #-} - rep = (Const .) . runForget - {-# INLINE rep #-} type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) --- | 'tabulate' and 'rep' form two halves of an isomorphism. +-- | 'tabulate' and 'sieve' form two halves of an isomorphism. -- -- This can be used with the combinators from the @lens@ package. -- -- @'tabulated' :: 'Representable' p => 'Iso'' (d -> 'Rep' p c) (p d c)@ tabulated :: (Representable p, Representable q) => Iso (d -> Rep p c) (d' -> Rep q c') (p d c) (q d' c') -tabulated = dimap tabulate (fmap rep) +tabulated = dimap tabulate (fmap sieve) {-# INLINE tabulated #-} -- * Corepresentable Profunctors -- | A 'Profunctor' @p@ is 'Corepresentable' if there exists a 'Functor' @f@ such that -- @p d c@ is isomorphic to @f d -> c@. -class (Functor (Corep p), Profunctor p) => Corepresentable p where +class (Cosieve p (Corep p), Costrong p) => Corepresentable p where type Corep p :: * -> * cotabulate :: (Corep p d -> c) -> p d c - corep :: p d c -> Corep p d -> c + +-- | Default definition for 'unfirst' given that p is 'Corepresentable'. +unfirstCorep :: Corepresentable p => p (a, d) (b, d) -> p a b +unfirstCorep p = cotabulate f + where f fa = b where (b, d) = cosieve p ((\a -> (a, d)) <$> fa) + +-- | Default definition for 'unsecond' given that p is 'Corepresentable'. +unsecondCorep :: Corepresentable p => p (d, a) (d, b) -> p a b +unsecondCorep p = cotabulate f + where f fa = b where (d, b) = cosieve p ((,) d <$> fa) instance Corepresentable (->) where type Corep (->) = Identity cotabulate f = f . Identity {-# INLINE cotabulate #-} - corep f (Identity d) = f d - {-# INLINE corep #-} instance Functor w => Corepresentable (Cokleisli w) where type Corep (Cokleisli w) = w cotabulate = Cokleisli {-# INLINE cotabulate #-} - corep = runCokleisli - {-# INLINE corep #-} instance Corepresentable Tagged where type Corep Tagged = Proxy cotabulate f = Tagged (f Proxy) {-# INLINE cotabulate #-} - corep (Tagged a) _ = a - {-# INLINE corep #-} -instance Functor f => Corepresentable (DownStar f) where - type Corep (DownStar f) = f - cotabulate = DownStar +instance Functor f => Corepresentable (Costar f) where + type Corep (Costar f) = f + cotabulate = Costar {-# INLINE cotabulate #-} - corep = runDownStar - {-# INLINE corep #-} --- | 'cotabulate' and 'corep' form two halves of an isomorphism. +-- | 'cotabulate' and 'cosieve' form two halves of an isomorphism. -- -- This can be used with the combinators from the @lens@ package. -- -- @'cotabulated' :: 'Corep' f p => 'Iso'' (f d -> c) (p d c)@ cotabulated :: (Corepresentable p, Corepresentable q) => Iso (Corep p d -> c) (Corep q d' -> c') (p d c) (q d' c') -cotabulated = dimap cotabulate (fmap corep) +cotabulated = dimap cotabulate (fmap cosieve) {-# INLINE cotabulated #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Sieve.hs new/profunctors-5.1.1/src/Data/Profunctor/Sieve.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Sieve.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Sieve.hs 2015-05-20 13:53:11.000000000 +0200 @@ -0,0 +1,79 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Copyright : (C) 2015 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett <[email protected]> +-- Stability : provisional +-- Portability : MPTCs, fundeps +-- +---------------------------------------------------------------------------- +module Data.Profunctor.Sieve + ( Sieve(..) + , Cosieve(..) + ) where + +import Control.Applicative +import Control.Arrow +import Control.Comonad +import Data.Functor.Identity +import Data.Profunctor +import Data.Proxy +import Data.Tagged + +-- | A 'Profunctor' @p@ is a 'Sieve' __on__ @f@ if it is a subprofunctor of @'Star' f@. +-- +-- That is to say it is a subset of @Hom(-,f=)@ closed under 'lmap' and 'rmap'. +-- +-- Alternately, you can view it as a sieve __in__ the comma category @Hask/f@. +class (Profunctor p, Functor f) => Sieve p f | p -> f where + sieve :: p a b -> a -> f b + +instance Sieve (->) Identity where + sieve f = Identity . f + {-# INLINE sieve #-} + +instance (Monad m, Functor m) => Sieve (Kleisli m) m where + sieve = runKleisli + {-# INLINE sieve #-} + +instance Functor f => Sieve (Star f) f where + sieve = runStar + {-# INLINE sieve #-} + +instance Sieve (Forget r) (Const r) where + sieve = (Const .) . runForget + {-# INLINE sieve #-} + +-- | A 'Profunctor' @p@ is a 'Cosieve' __on__ @f@ if it is a subprofunctor of @'Costar' f@. +-- +-- That is to say it is a subset of @Hom(f-,=)@ closed under 'lmap' and 'rmap'. +-- +-- Alternately, you can view it as a cosieve __in__ the comma category @f/Hask@. +class (Profunctor p, Functor f) => Cosieve p f | p -> f where + cosieve :: p a b -> f a -> b + +instance Cosieve (->) Identity where + cosieve f (Identity d) = f d + {-# INLINE cosieve #-} + +instance Functor w => Cosieve (Cokleisli w) w where + cosieve = runCokleisli + {-# INLINE cosieve #-} + +instance Cosieve Tagged Proxy where + cosieve (Tagged a) _ = a + {-# INLINE cosieve #-} + +instance Functor f => Cosieve (Costar f) f where + cosieve = runCostar + {-# INLINE cosieve #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Tambara.hs new/profunctors-5.1.1/src/Data/Profunctor/Tambara.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Tambara.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Tambara.hs 2015-05-20 13:53:11.000000000 +0200 @@ -51,7 +51,10 @@ instance ProfunctorComonad Tambara where proextract (Tambara p) = dimap (\a -> (a,())) fst p produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p) where + hither :: ((a, b), c) -> (a, (b, c)) hither ~(~(x,y),z) = (x,(y,z)) + + yon :: (a, (b, c)) -> ((a, b), c) yon ~(x,~(y,z)) = ((x,y),z) instance Profunctor p => Strong (Tambara p) where @@ -60,8 +63,11 @@ instance Choice p => Choice (Tambara p) where left' (Tambara f) = Tambara $ dimap hither yon $ left' f where + hither :: (Either a b, c) -> Either (a, c) (b, c) hither (Left y, s) = Left (y, s) hither (Right z, s) = Right (z, s) + + yon :: Either (a, c) (b, c) -> (Either a b, c) yon (Left (y, s)) = (Left y, s) yon (Right (z, s)) = (Right z, s) @@ -72,12 +78,16 @@ instance Arrow p => Arrow (Tambara p) where arr f = Tambara $ arr $ first f first (Tambara f) = Tambara (arr go . first f . arr go) where + go :: ((a, b), c) -> ((a, c), b) go ~(~(x,y),z) = ((x,z),y) instance ArrowChoice p => ArrowChoice (Tambara p) where left (Tambara f) = Tambara (arr yon . left f . arr hither) where + hither :: (Either a b, c) -> Either (a, c) (b, c) hither (Left y, s) = Left (y, s) hither (Right z, s) = Right (z, s) + + yon :: Either (a, c) (b, c) -> (Either a b, c) yon (Left (y, s)) = (Left y, s) yon (Right (z, s)) = (Right z, s) @@ -86,6 +96,7 @@ instance ArrowLoop p => ArrowLoop (Tambara p) where loop (Tambara f) = Tambara (loop (arr go . f . arr go)) where + go :: ((a, b), c) -> ((a, c), b) go ~(~(x,y),z) = ((x,z),y) instance ArrowZero p => ArrowZero (Tambara p) where @@ -148,9 +159,9 @@ projoin (Pastro l (Pastro m n o) p) = Pastro lm n op where op a = case p a of (b, f) -> case o b of - (c, g) -> (c, (f, g)) + (c, g) -> (c, (f, g)) lm (d, (f, g)) = l (m (d, g), f) - + instance ProfunctorAdjunction Pastro Tambara where counit (Pastro g (Tambara p) f) = dimap f g p unit p = Tambara (Pastro id p id) @@ -168,9 +179,12 @@ instance ProfunctorComonad Cotambara where proextract (Cotambara p) = dimap Left (\(Left a) -> a) p produplicate (Cotambara p) = Cotambara (Cotambara $ dimap hither yon p) where + hither :: Either (Either a b) c -> Either a (Either b c) hither (Left (Left x)) = Left x hither (Left (Right y)) = Right (Left y) hither (Right z) = Right (Right z) + + yon :: Either a (Either b c) -> Either (Either a b) c yon (Left x) = Left (Left x) yon (Right (Left y)) = Left (Right y) yon (Right (Right z)) = Right z diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor/Unsafe.hs new/profunctors-5.1.1/src/Data/Profunctor/Unsafe.hs --- old/profunctors-4.4.1/src/Data/Profunctor/Unsafe.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor/Unsafe.hs 2015-05-20 13:53:11.000000000 +0200 @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE Trustworthy #-} -#elif __GLASGOW_HASKELL__ >= 702 +#elif __GLASGOW_HASKELL >= 704 {-# LANGUAGE Unsafe #-} #endif {-# LANGUAGE ScopedTypeVariables #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/profunctors-4.4.1/src/Data/Profunctor.hs new/profunctors-5.1.1/src/Data/Profunctor.hs --- old/profunctors-4.4.1/src/Data/Profunctor.hs 2015-03-08 09:53:57.000000000 +0100 +++ new/profunctors-5.1.1/src/Data/Profunctor.hs 2015-05-20 13:53:11.000000000 +0200 @@ -33,8 +33,8 @@ , Costrong(..) , Cochoice(..) -- ** Common Profunctors - , UpStar(..) - , DownStar(..) + , Star(..) + , Costar(..) , WrappedArrow(..) , Forget(..) #ifndef HLINT @@ -48,6 +48,7 @@ import Control.Comonad import Control.Monad (liftM, MonadPlus(..)) import Control.Monad.Fix +import Data.Distributive import Data.Foldable import Data.Monoid import Data.Tagged @@ -66,18 +67,18 @@ type p :-> q = forall a b. p a b -> q a b ------------------------------------------------------------------------------ --- UpStar +-- Star ------------------------------------------------------------------------------ -- | Lift a 'Functor' into a 'Profunctor' (forwards). -newtype UpStar f d c = UpStar { runUpStar :: d -> f c } +newtype Star f d c = Star { runStar :: d -> f c } -instance Functor f => Profunctor (UpStar f) where - dimap ab cd (UpStar bfc) = UpStar (fmap cd . bfc . ab) +instance Functor f => Profunctor (Star f) where + dimap ab cd (Star bfc) = Star (fmap cd . bfc . ab) {-# INLINE dimap #-} - lmap k (UpStar f) = UpStar (f . k) + lmap k (Star f) = Star (f . k) {-# INLINE lmap #-} - rmap k (UpStar f) = UpStar (fmap k . f) + rmap k (Star f) = Star (fmap k . f) {-# INLINE rmap #-} -- We cannot safely overload ( #. ) because we didn't write the 'Functor'. #if __GLASGOW_HASKELL__ >= 708 @@ -87,43 +88,46 @@ #endif {-# INLINE ( .# ) #-} -instance Functor f => Functor (UpStar f a) where +instance Functor f => Functor (Star f a) where fmap = rmap {-# INLINE fmap #-} -instance Applicative f => Applicative (UpStar f a) where - pure a = UpStar $ \_ -> pure a - UpStar ff <*> UpStar fx = UpStar $ \a -> ff a <*> fx a - UpStar ff *> UpStar fx = UpStar $ \a -> ff a *> fx a - UpStar ff <* UpStar fx = UpStar $ \a -> ff a <* fx a - -instance Alternative f => Alternative (UpStar f a) where - empty = UpStar $ \_ -> empty - UpStar f <|> UpStar g = UpStar $ \a -> f a <|> g a - -instance Monad f => Monad (UpStar f a) where - return a = UpStar $ \_ -> return a - UpStar m >>= f = UpStar $ \ e -> do +instance Applicative f => Applicative (Star f a) where + pure a = Star $ \_ -> pure a + Star ff <*> Star fx = Star $ \a -> ff a <*> fx a + Star ff *> Star fx = Star $ \a -> ff a *> fx a + Star ff <* Star fx = Star $ \a -> ff a <* fx a + +instance Alternative f => Alternative (Star f a) where + empty = Star $ \_ -> empty + Star f <|> Star g = Star $ \a -> f a <|> g a + +instance Monad f => Monad (Star f a) where + return a = Star $ \_ -> return a + Star m >>= f = Star $ \ e -> do a <- m e - runUpStar (f a) e + runStar (f a) e -instance MonadPlus f => MonadPlus (UpStar f a) where - mzero = UpStar $ \_ -> mzero - UpStar f `mplus` UpStar g = UpStar $ \a -> f a `mplus` g a +instance MonadPlus f => MonadPlus (Star f a) where + mzero = Star $ \_ -> mzero + Star f `mplus` Star g = Star $ \a -> f a `mplus` g a + +instance Distributive f => Distributive (Star f a) where + distribute fs = Star $ \a -> collect (($ a) .# runStar) fs ------------------------------------------------------------------------------ --- DownStar +-- Costar ------------------------------------------------------------------------------ -- | Lift a 'Functor' into a 'Profunctor' (backwards). -newtype DownStar f d c = DownStar { runDownStar :: f d -> c } +newtype Costar f d c = Costar { runCostar :: f d -> c } -instance Functor f => Profunctor (DownStar f) where - dimap ab cd (DownStar fbc) = DownStar (cd . fbc . fmap ab) +instance Functor f => Profunctor (Costar f) where + dimap ab cd (Costar fbc) = Costar (cd . fbc . fmap ab) {-# INLINE dimap #-} - lmap k (DownStar f) = DownStar (f . fmap k) + lmap k (Costar f) = Costar (f . fmap k) {-# INLINE lmap #-} - rmap k (DownStar f) = DownStar (k . f) + rmap k (Costar f) = Costar (k . f) {-# INLINE rmap #-} #if __GLASGOW_HASKELL__ >= 708 ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b @@ -133,21 +137,24 @@ {-# INLINE ( #. ) #-} -- We cannot overload ( .# ) because we didn't write the 'Functor'. -instance Functor (DownStar f a) where - fmap k (DownStar f) = DownStar (k . f) +instance Distributive (Costar f d) where + distribute fs = Costar $ \gd -> fmap (($ gd) .# runCostar) fs + +instance Functor (Costar f a) where + fmap k (Costar f) = Costar (k . f) {-# INLINE fmap #-} - a <$ _ = DownStar $ \_ -> a + a <$ _ = Costar $ \_ -> a {-# INLINE (<$) #-} -instance Applicative (DownStar f a) where - pure a = DownStar $ \_ -> a - DownStar ff <*> DownStar fx = DownStar $ \a -> ff a (fx a) +instance Applicative (Costar f a) where + pure a = Costar $ \_ -> a + Costar ff <*> Costar fx = Costar $ \a -> ff a (fx a) _ *> m = m m <* _ = m -instance Monad (DownStar f a) where - return a = DownStar $ \_ -> a - DownStar m >>= f = DownStar $ \ x -> runDownStar (f (m x)) x +instance Monad (Costar f a) where + return a = Costar $ \_ -> a + Costar m >>= f = Costar $ \ x -> runCostar (f (m x)) x ------------------------------------------------------------------------------ -- Wrapped Profunctors @@ -233,9 +240,9 @@ -- Strong ------------------------------------------------------------------------------ --- | Generalizing 'UpStar' of a strong 'Functor' +-- | Generalizing 'Star' of a strong 'Functor' -- --- /Note:/ Every 'Functor' in Haskell is strong with respect to (,). +-- /Note:/ Every 'Functor' in Haskell is strong with respect to @(,)@. -- -- This describes profunctor strength with respect to the product structure -- of Hask. @@ -268,13 +275,13 @@ return (c, b) {-# INLINE second' #-} -instance Functor m => Strong (UpStar m) where - first' (UpStar f) = UpStar $ \ ~(a, c) -> (\b' -> (b', c)) <$> f a +instance Functor m => Strong (Star m) where + first' (Star f) = Star $ \ ~(a, c) -> (\b' -> (b', c)) <$> f a {-# INLINE first' #-} - second' (UpStar f) = UpStar $ \ ~(c, a) -> (,) c <$> f a + second' (Star f) = Star $ \ ~(c, a) -> (,) c <$> f a {-# INLINE second' #-} --- | Every Arrow is a Strong Monad in Prof +-- | 'Arrow' is 'Strong' 'Category' instance Arrow p => Strong (WrappedArrow p) where first' (WrapArrow k) = WrapArrow (first k) {-# INLINE first' #-} @@ -291,10 +298,10 @@ -- Choice ------------------------------------------------------------------------------ --- | The generalization of 'DownStar' of 'Functor' that is strong with respect +-- | The generalization of 'Costar' of 'Functor' that is strong with respect -- to 'Either'. -- --- Note: This is also a notion of strength, except with regards to another monoidal +-- 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 left' :: p a b -> p (Either a c) (Either b c) @@ -320,10 +327,10 @@ right' = right {-# INLINE right' #-} -instance Applicative f => Choice (UpStar f) where - left' (UpStar f) = UpStar $ either (fmap Left . f) (fmap Right . pure) +instance Applicative f => Choice (Star f) where + left' (Star f) = Star $ either (fmap Left . f) (pure . Right) {-# INLINE left' #-} - right' (UpStar f) = UpStar $ either (fmap Left . pure) (fmap Right . f) + right' (Star f) = Star $ either (pure . Left) (fmap Right . f) {-# INLINE right' #-} -- | 'extract' approximates 'costrength' @@ -334,10 +341,10 @@ {-# INLINE right' #-} -- NB: This instance is highly questionable -instance Traversable w => Choice (DownStar w) where - left' (DownStar wab) = DownStar (either Right Left . fmap wab . traverse (either Right Left)) +instance Traversable w => Choice (Costar w) where + left' (Costar wab) = Costar (either Right Left . fmap wab . traverse (either Right Left)) {-# INLINE left' #-} - right' (DownStar wab) = DownStar (fmap wab . sequence) + right' (Costar wab) = Costar (fmap wab . sequence) {-# INLINE right' #-} instance Choice Tagged where @@ -363,8 +370,6 @@ -------------------------------------------------------------------------------- -- | Analogous to 'ArrowLoop', 'loop' = 'unfirst' --- --- unfirst . unfirst = class Profunctor p => Costrong p where unfirst :: p (a, d) (b, d) -> p a b unfirst = unsecond . dimap swap swap @@ -372,10 +377,20 @@ unsecond :: p (d, a) (d, b) -> p a b unsecond = unfirst . dimap swap swap +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 + {-# MINIMAL unfirst | unsecond #-} +#endif + instance Costrong (->) where unfirst f a = b where (b, d) = f (a, d) unsecond f a = b where (d, b) = f (d, a) +instance Functor f => Costrong (Costar f) where + unfirst (Costar f) = Costar f' + where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa) + unsecond (Costar f) = Costar f' + where f' fa = b where (d, b) = f ((,) d <$> fa) + instance Costrong Tagged where unfirst (Tagged bd) = Tagged (fst bd) unsecond (Tagged db) = Tagged (snd db) @@ -387,6 +402,10 @@ unfirst (Kleisli f) = Kleisli (liftM fst . mfix . f') where f' x y = f (x, snd y) +instance Functor f => Costrong (Cokleisli f) where + unfirst (Cokleisli f) = Cokleisli f' + where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa) + -------------------------------------------------------------------------------- -- * Costrength for Either -------------------------------------------------------------------------------- @@ -397,3 +416,20 @@ unright :: p (Either d a) (Either d b) -> p a b unright = unleft . dimap (either Right Left) (either Right Left) + +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 + {-# MINIMAL unleft | unright #-} +#endif + +instance Cochoice (->) where + unleft f = go . Left where go = either id (go . Right) . f + unright f = go . Right where go = either (go . Left) id . f + +instance Applicative f => Cochoice (Costar f) where + unleft (Costar f) = Costar (go . fmap Left) + where go = either id (go . pure . Right) . f + +-- NB: Another instance that's highly questionable +instance Traversable f => Cochoice (Star f) where + unright (Star f) = Star (go . Right) + where go = either (go . Left) id . sequence . f
