Hello community,
here is the log from the commit of package ghc-contravariant for
openSUSE:Factory checked in at 2018-07-24 17:16:25
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-contravariant (Old)
and /work/SRC/openSUSE:Factory/.ghc-contravariant.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-contravariant"
Tue Jul 24 17:16:25 2018 rev:8 rq:623747 version:1.5
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-contravariant/ghc-contravariant.changes
2018-05-30 12:25:16.538388053 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-contravariant.new/ghc-contravariant.changes
2018-07-24 17:16:33.186850190 +0200
@@ -1,0 +2,15 @@
+Wed Jul 18 14:26:19 UTC 2018 - psim...@suse.com
+
+- Cosmetic: replace tabs with blanks, strip trailing white space,
+ and update copyright headers with spec-cleaner.
+
+-------------------------------------------------------------------
+Fri Jul 13 14:32:00 UTC 2018 - psim...@suse.com
+
+- Update contravariant to version 1.5.
+ 1.5 [2018.07.01]
+ ----------------
+ * Support building with GHC 8.6, where `Data.Functor.Contravariant` has been
+ moved into `base`.
+
+-------------------------------------------------------------------
@@ -49 +63,0 @@
-
Old:
----
contravariant-1.4.1.tar.gz
contravariant.cabal
New:
----
contravariant-1.5.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-contravariant.spec ++++++
--- /var/tmp/diff_new_pack.OVbZ4w/_old 2018-07-24 17:16:34.042851296 +0200
+++ /var/tmp/diff_new_pack.OVbZ4w/_new 2018-07-24 17:16:34.042851296 +0200
@@ -18,18 +18,16 @@
%global pkg_name contravariant
Name: ghc-%{pkg_name}
-Version: 1.4.1
+Version: 1.5
Release: 0
Summary: Contravariant functors
License: BSD-3-Clause
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
BuildRequires: ghc-StateVar-devel
BuildRequires: ghc-rpm-macros
-BuildRequires: ghc-transformers-compat-devel
BuildRequires: ghc-transformers-devel
%description
@@ -48,7 +46,6 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ contravariant-1.4.1.tar.gz -> contravariant-1.5.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/contravariant-1.4.1/.travis.yml
new/contravariant-1.5/.travis.yml
--- old/contravariant-1.4.1/.travis.yml 2018-01-18 20:29:34.000000000 +0100
+++ new/contravariant-1.5/.travis.yml 2018-07-02 01:07:28.000000000 +0200
@@ -1,6 +1,6 @@
# 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'
+# runghc make_travis_yml_2.hs '-o' '.travis.yml' '--ghc-head'
'--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench'
'--no-unconstrained' 'cabal.project'
#
# For more information, see https://github.com/hvr/multi-ghc-travis
#
@@ -42,42 +42,45 @@
matrix:
include:
- - compiler: "ghc-7.0.4"
+ - compiler: "ghc-8.6.1"
+ env: GHCHEAD=true
+ addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-8.6.1],
sources: [hvr-ghc]}}
+ - compiler: "ghc-8.4.3"
# 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"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-8.4.3],
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-7.2.2],
sources: [hvr-ghc]}}
- - compiler: "ghc-7.4.2"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-8.2.2],
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-7.4.2],
sources: [hvr-ghc]}}
- - compiler: "ghc-7.6.3"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-8.0.2],
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.6.3],
sources: [hvr-ghc]}}
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.10.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"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.8.4],
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.10.3],
sources: [hvr-ghc]}}
- - compiler: "ghc-8.0.2"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.6.3],
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-8.0.2],
sources: [hvr-ghc]}}
- - compiler: "ghc-8.2.2"
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.4.2],
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-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]}}
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.2.2],
sources: [hvr-ghc]}}
+ - compiler: "ghc-7.0.4"
+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
+ addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-7.0.4],
sources: [hvr-ghc]}}
- compiler: "ghc-head"
env: GHCHEAD=true
addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-head],
sources: [hvr-ghc]}}
allow_failures:
+ - compiler: "ghc-head"
- compiler: "ghc-7.0.4"
- compiler: "ghc-7.2.2"
- - compiler: "ghc-8.4.1"
- - compiler: "ghc-head"
+ - compiler: "ghc-8.6.1"
before_install:
- HC=${CC}
@@ -95,7 +98,8 @@
- BENCH=${BENCH---enable-benchmarks}
- TEST=${TEST---enable-tests}
- HADDOCK=${HADDOCK-true}
- - INSTALLED=${INSTALLED-true}
+ - UNCONSTRAINED=${UNCONSTRAINED-true}
+ - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}
- GHCHEAD=${GHCHEAD-false}
- travis_retry cabal update -v
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
@@ -103,7 +107,8 @@
# 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
+ sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config
+ for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed
's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /"
${HOME}/.cabal/config; done
echo 'repository head.hackage'
>> ${HOME}/.cabal/config
echo ' url: http://head.hackage.haskell.org/'
>> ${HOME}/.cabal/config
@@ -113,17 +118,22 @@
echo '
8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >>
${HOME}/.cabal/config
echo ' key-threshold: 3'
>> ${HOME}/.cabal.config
+ grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
+
cabal new-update head.hackage -v
fi
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
- "printf 'packages: \".\"\\n' > cabal.project"
- - cat cabal.project
+ - touch cabal.project.local
+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list
--simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/
installed/' >> cabal.project.local; done; fi"
+ - cat cabal.project || true
+ - cat cabal.project.local || true
- 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
+ - 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;
@@ -135,8 +145,10 @@
- cd ${DISTDIR} || false
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
- "printf 'packages: contravariant-*/*.cabal\\n' > cabal.project"
- - cat cabal.project
-
+ - touch cabal.project.local
+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list
--simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/
installed/' >> cabal.project.local; done; fi"
+ - cat cabal.project || true
+ - cat cabal.project.local || true
# build & run tests, build benchmarks
- cabal new-build -w ${HC} ${TEST} ${BENCH} all
@@ -151,5 +163,5 @@
# hlint
- (cd contravariant-* && hlint src --cpp-define=HLINT)
-# REGENDATA
["-o",".travis.yml","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"]
+# REGENDATA
["-o",".travis.yml","--ghc-head","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-unconstrained","cabal.project"]
# EOF
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/contravariant-1.4.1/CHANGELOG.markdown
new/contravariant-1.5/CHANGELOG.markdown
--- old/contravariant-1.4.1/CHANGELOG.markdown 2018-01-18 20:29:34.000000000
+0100
+++ new/contravariant-1.5/CHANGELOG.markdown 2018-07-02 01:07:28.000000000
+0200
@@ -1,3 +1,8 @@
+1.5 [2018.07.01]
+----------------
+* Support building with GHC 8.6, where `Data.Functor.Contravariant` has been
+ moved into `base`.
+
1.4.1 [2018.01.18]
------------------
* Add `Semigroup` and `Monoid` instances for `Predicate`.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/contravariant-1.4.1/contravariant.cabal
new/contravariant-1.5/contravariant.cabal
--- old/contravariant-1.4.1/contravariant.cabal 2018-01-18 20:29:34.000000000
+0100
+++ new/contravariant-1.5/contravariant.cabal 2018-07-02 01:07:28.000000000
+0200
@@ -1,6 +1,6 @@
name: contravariant
category: Control, Data
-version: 1.4.1
+version: 1.5
license: BSD3
cabal-version: >= 1.6
license-file: LICENSE
@@ -21,7 +21,8 @@
, GHC == 7.10.3
, GHC == 8.0.2
, GHC == 8.2.2
- , GHC == 8.4.1
+ , GHC == 8.4.3
+ , GHC == 8.6.1
extra-source-files:
.travis.yml
CHANGELOG.markdown
@@ -65,8 +66,10 @@
hs-source-dirs: src
build-depends:
base < 5,
- transformers >= 0.2 && < 0.6,
- transformers-compat >= 0.3 && < 1
+ transformers >= 0.2 && < 0.6
+
+ if !impl(ghc > 7.10)
+ build-depends: transformers-compat >= 0.3 && < 1
if !impl(ghc >= 7.9)
build-depends: void >= 0.6 && < 1
@@ -78,7 +81,7 @@
build-depends: semigroups >= 0.15.2 && < 1
if flag(StateVar)
- build-depends: StateVar >= 1.1 && < 1.2
+ build-depends: StateVar >= 1.1.1 && < 1.2
if impl(ghc >= 7.2 && < 7.6)
build-depends: ghc-prim
@@ -87,10 +90,13 @@
cpp-options: -DSAFE
exposed-modules:
- Data.Functor.Contravariant
Data.Functor.Contravariant.Compose
Data.Functor.Contravariant.Divisible
+ if impl(ghc < 8.5)
+ hs-source-dirs: old-src
+ exposed-modules: Data.Functor.Contravariant
+
if impl(ghc >= 7.4)
exposed-modules: Data.Functor.Contravariant.Generic
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/contravariant-1.4.1/old-src/Data/Functor/Contravariant.hs
new/contravariant-1.5/old-src/Data/Functor/Contravariant.hs
--- old/contravariant-1.4.1/old-src/Data/Functor/Contravariant.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/contravariant-1.5/old-src/Data/Functor/Contravariant.hs 2018-07-02
01:07:28.000000000 +0200
@@ -0,0 +1,458 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
+
+#ifdef __GLASGOW_HASKELL__
+#define LANGUAGE_DeriveDataTypeable
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+
+#ifndef MIN_VERSION_tagged
+#define MIN_VERSION_tagged(x,y,z) 1
+#endif
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
+#if __GLASGOW_HASKELL__ >= 704
+#if MIN_VERSION_transformers(0,3,0) && MIN_VERSION_tagged(0,6,1)
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+#endif
+
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Functor.Contravariant
+-- Copyright : (C) 2007-2015 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : Edward Kmett <ekm...@gmail.com>
+-- Stability : provisional
+-- Portability : portable
+--
+-- 'Contravariant' functors, sometimes referred to colloquially as @Cofunctor@,
+-- even though the dual of a 'Functor' is just a 'Functor'. As with 'Functor'
+-- the definition of 'Contravariant' for a given ADT is unambiguous.
+----------------------------------------------------------------------------
+
+module Data.Functor.Contravariant (
+ -- * Contravariant Functors
+ Contravariant(..)
+ , phantom
+
+ -- * Operators
+ , (>$<), (>$$<), ($<)
+
+ -- * Predicates
+ , Predicate(..)
+
+ -- * Comparisons
+ , Comparison(..)
+ , defaultComparison
+
+ -- * Equivalence Relations
+ , Equivalence(..)
+ , defaultEquivalence
+ , comparisonEquivalence
+
+ -- * Dual arrows
+ , Op(..)
+ ) where
+
+import Control.Applicative
+import Control.Applicative.Backwards
+
+import Control.Category
+
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.List
+import Control.Monad.Trans.Maybe
+import qualified Control.Monad.Trans.RWS.Lazy as Lazy
+import qualified Control.Monad.Trans.RWS.Strict as Strict
+import Control.Monad.Trans.Reader
+import qualified Control.Monad.Trans.State.Lazy as Lazy
+import qualified Control.Monad.Trans.State.Strict as Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Strict
+
+import Data.Function (on)
+
+import Data.Functor.Product
+import Data.Functor.Sum
+import Data.Functor.Constant
+import Data.Functor.Compose
+import Data.Functor.Reverse
+
+#if MIN_VERSION_base(4,8,0)
+import Data.Monoid (Alt(..))
+#else
+import Data.Monoid (Monoid(..))
+#endif
+
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+import Data.Semigroup (Semigroup(..))
+#endif
+
+#ifdef LANGUAGE_DeriveDataTypeable
+import Data.Typeable
+#endif
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 &&
defined(VERSION_tagged)
+import Data.Proxy
+#endif
+
+#ifdef MIN_VERSION_StateVar
+import Data.StateVar
+#endif
+
+#if __GLASGOW_HASKELL__ >= 702
+#define GHC_GENERICS
+import GHC.Generics
+#endif
+
+import Prelude hiding ((.),id)
+
+-- | The class of contravariant functors.
+--
+-- Whereas in Haskell, one can think of a 'Functor' as containing or producing
+-- values, a contravariant functor is a functor that can be thought of as
+-- /consuming/ values.
+--
+-- As an example, consider the type of predicate functions @a -> Bool@. One
+-- such predicate might be @negative x = x < 0@, which
+-- classifies integers as to whether they are negative. However, given this
+-- predicate, we can re-use it in other situations, providing we have a way to
+-- map values /to/ integers. For instance, we can use the @negative@ predicate
+-- on a person's bank balance to work out if they are currently overdrawn:
+--
+-- @
+-- newtype Predicate a = Predicate { getPredicate :: a -> Bool }
+--
+-- instance Contravariant Predicate where
+-- contramap f (Predicate p) = Predicate (p . f)
+-- | `- First, map the input...
+-- `----- then apply the predicate.
+--
+-- overdrawn :: Predicate Person
+-- overdrawn = contramap personBankBalance negative
+-- @
+--
+-- Any instance should be subject to the following laws:
+--
+-- > contramap id = id
+-- > contramap f . contramap g = contramap (g . f)
+--
+-- Note, that the second law follows from the free theorem of the type of
+-- 'contramap' and the first law, so you need only check that the former
+-- condition holds.
+
+class Contravariant f where
+ contramap :: (a -> b) -> f b -> f a
+
+ -- | Replace all locations in the output with the same value.
+ -- The default definition is @'contramap' . 'const'@, but this may be
+ -- overridden with a more efficient version.
+ (>$) :: b -> f b -> f a
+ (>$) = contramap . const
+
+-- | If 'f' is both 'Functor' and 'Contravariant' then by the time you factor
in the laws
+-- of each of those classes, it can't actually use its argument in any
meaningful capacity.
+--
+-- This method is surprisingly useful. Where both instances exist and are
lawful we have
+-- the following laws:
+--
+-- @
+-- 'fmap' f ≡ 'phantom'
+-- 'contramap' f ≡ 'phantom'
+-- @
+phantom :: (Functor f, Contravariant f) => f a -> f b
+phantom x = () <$ x $< ()
+
+infixl 4 >$, $<, >$<, >$$<
+
+-- | This is '>$' with its arguments flipped.
+($<) :: Contravariant f => f b -> b -> f a
+($<) = flip (>$)
+{-# INLINE ($<) #-}
+
+-- | This is an infix alias for 'contramap'.
+(>$<) :: Contravariant f => (a -> b) -> f b -> f a
+(>$<) = contramap
+{-# INLINE (>$<) #-}
+
+-- | This is an infix version of 'contramap' with the arguments flipped.
+(>$$<) :: Contravariant f => f b -> (a -> b) -> f a
+(>$$<) = flip contramap
+{-# INLINE (>$$<) #-}
+
+#if MIN_VERSION_base(4,8,0)
+instance Contravariant f => Contravariant (Alt f) where
+ contramap f = Alt . contramap f . getAlt
+#endif
+
+#ifdef GHC_GENERICS
+instance Contravariant V1 where
+ contramap _ x = x `seq` undefined
+
+instance Contravariant U1 where
+ contramap _ _ = U1
+
+instance Contravariant f => Contravariant (Rec1 f) where
+ contramap f (Rec1 fp)= Rec1 (contramap f fp)
+
+instance Contravariant f => Contravariant (M1 i c f) where
+ contramap f (M1 fp) = M1 (contramap f fp)
+
+instance Contravariant (K1 i c) where
+ contramap _ (K1 c) = K1 c
+
+instance (Contravariant f, Contravariant g) => Contravariant (f :*: g) where
+ contramap f (xs :*: ys) = contramap f xs :*: contramap f ys
+
+instance (Functor f, Contravariant g) => Contravariant (f :.: g) where
+ contramap f (Comp1 fg) = Comp1 (fmap (contramap f) fg)
+ {-# INLINE contramap #-}
+
+instance (Contravariant f, Contravariant g) => Contravariant (f :+: g) where
+ contramap f (L1 xs) = L1 (contramap f xs)
+ contramap f (R1 ys) = R1 (contramap f ys)
+#endif
+
+instance Contravariant m => Contravariant (ErrorT e m) where
+ contramap f = ErrorT . contramap (fmap f) . runErrorT
+
+instance Contravariant m => Contravariant (ExceptT e m) where
+ contramap f = ExceptT . contramap (fmap f) . runExceptT
+
+instance Contravariant f => Contravariant (IdentityT f) where
+ contramap f = IdentityT . contramap f . runIdentityT
+
+instance Contravariant m => Contravariant (ListT m) where
+ contramap f = ListT . contramap (fmap f) . runListT
+
+instance Contravariant m => Contravariant (MaybeT m) where
+ contramap f = MaybeT . contramap (fmap f) . runMaybeT
+
+instance Contravariant m => Contravariant (Lazy.RWST r w s m) where
+ contramap f m = Lazy.RWST $ \r s ->
+ contramap (\ ~(a, s', w) -> (f a, s', w)) $ Lazy.runRWST m r s
+
+instance Contravariant m => Contravariant (Strict.RWST r w s m) where
+ contramap f m = Strict.RWST $ \r s ->
+ contramap (\ (a, s', w) -> (f a, s', w)) $ Strict.runRWST m r s
+
+instance Contravariant m => Contravariant (ReaderT r m) where
+ contramap f = ReaderT . fmap (contramap f) . runReaderT
+
+instance Contravariant m => Contravariant (Lazy.StateT s m) where
+ contramap f m = Lazy.StateT $ \s ->
+ contramap (\ ~(a, s') -> (f a, s')) $ Lazy.runStateT m s
+
+instance Contravariant m => Contravariant (Strict.StateT s m) where
+ contramap f m = Strict.StateT $ \s ->
+ contramap (\ (a, s') -> (f a, s')) $ Strict.runStateT m s
+
+instance Contravariant m => Contravariant (Lazy.WriterT w m) where
+ contramap f = Lazy.mapWriterT $ contramap $ \ ~(a, w) -> (f a, w)
+
+instance Contravariant m => Contravariant (Strict.WriterT w m) where
+ contramap f = Strict.mapWriterT $ contramap $ \ (a, w) -> (f a, w)
+
+instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where
+ contramap f (InL xs) = InL (contramap f xs)
+ contramap f (InR ys) = InR (contramap f ys)
+
+instance (Contravariant f, Contravariant g) => Contravariant (Product f g)
where
+ contramap f (Pair a b) = Pair (contramap f a) (contramap f b)
+
+instance Contravariant (Constant a) where
+ contramap _ (Constant a) = Constant a
+
+instance Contravariant (Const a) where
+ contramap _ (Const a) = Const a
+
+instance (Functor f, Contravariant g) => Contravariant (Compose f g) where
+ contramap f (Compose fga) = Compose (fmap (contramap f) fga)
+ {-# INLINE contramap #-}
+
+instance Contravariant f => Contravariant (Backwards f) where
+ contramap f = Backwards . contramap f . forwards
+ {-# INLINE contramap #-}
+
+instance Contravariant f => Contravariant (Reverse f) where
+ contramap f = Reverse . contramap f . getReverse
+ {-# INLINE contramap #-}
+
+#ifdef MIN_VERSION_StateVar
+instance Contravariant SettableStateVar where
+ contramap f (SettableStateVar k) = SettableStateVar (k . f)
+ {-# INLINE contramap #-}
+#endif
+
+#if (__GLASGOW_HASKELL__ >= 707) || defined(VERSION_tagged)
+instance Contravariant Proxy where
+ contramap _ _ = Proxy
+#endif
+
+newtype Predicate a = Predicate { getPredicate :: a -> Bool }
+#ifdef LANGUAGE_DeriveDataTypeable
+ deriving Typeable
+#endif
+
+-- | A 'Predicate' is a 'Contravariant' 'Functor', because 'contramap' can
+-- apply its function argument to the input of the predicate.
+instance Contravariant Predicate where
+ contramap f g = Predicate $ getPredicate g . f
+
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+instance Semigroup (Predicate a) where
+ Predicate p <> Predicate q = Predicate $ \a -> p a && q a
+#endif
+
+instance Monoid (Predicate a) where
+ mempty = Predicate $ const True
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+ mappend = (<>)
+#else
+ mappend (Predicate p) (Predicate q) = Predicate $ \a -> p a && q a
+#endif
+
+-- | Defines a total ordering on a type as per 'compare'.
+--
+-- This condition is not checked by the types. You must ensure that the
supplied
+-- values are valid total orderings yourself.
+newtype Comparison a = Comparison { getComparison :: a -> a -> Ordering }
+#ifdef LANGUAGE_DeriveDataTypeable
+ deriving Typeable
+#endif
+
+-- | A 'Comparison' is a 'Contravariant' 'Functor', because 'contramap' can
+-- apply its function argument to each input of the comparison function.
+instance Contravariant Comparison where
+ contramap f g = Comparison $ on (getComparison g) f
+
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+instance Semigroup (Comparison a) where
+ Comparison p <> Comparison q = Comparison $ mappend p q
+#endif
+
+instance Monoid (Comparison a) where
+ mempty = Comparison (\_ _ -> EQ)
+ mappend (Comparison p) (Comparison q) = Comparison $ mappend p q
+
+-- | Compare using 'compare'.
+defaultComparison :: Ord a => Comparison a
+defaultComparison = Comparison compare
+
+-- | This data type represents an equivalence relation.
+--
+-- Equivalence relations are expected to satisfy three laws:
+--
+-- __Reflexivity__:
+--
+-- @
+-- 'getEquivalence' f a a = True
+-- @
+--
+-- __Symmetry__:
+--
+-- @
+-- 'getEquivalence' f a b = 'getEquivalence' f b a
+-- @
+--
+-- __Transitivity__:
+--
+-- If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'
then so is @'getEquivalence' f a c@
+--
+-- The types alone do not enforce these laws, so you'll have to check them
yourself.
+newtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool }
+#ifdef LANGUAGE_DeriveDataTypeable
+ deriving Typeable
+#endif
+
+-- | Equivalence relations are 'Contravariant', because you can
+-- apply the contramapped function to each input to the equivalence
+-- relation.
+instance Contravariant Equivalence where
+ contramap f g = Equivalence $ on (getEquivalence g) f
+
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+instance Semigroup (Equivalence a) where
+ Equivalence p <> Equivalence q = Equivalence $ \a b -> p a b && q a b
+#endif
+
+instance Monoid (Equivalence a) where
+ mempty = Equivalence (\_ _ -> True)
+ mappend (Equivalence p) (Equivalence q) = Equivalence $ \a b -> p a b && q a
b
+
+-- | Check for equivalence with '=='.
+--
+-- Note: The instances for 'Double' and 'Float' violate reflexivity for @NaN@.
+defaultEquivalence :: Eq a => Equivalence a
+defaultEquivalence = Equivalence (==)
+
+comparisonEquivalence :: Comparison a -> Equivalence a
+comparisonEquivalence (Comparison p) = Equivalence $ \a b -> p a b == EQ
+
+-- | Dual function arrows.
+newtype Op a b = Op { getOp :: b -> a }
+#ifdef LANGUAGE_DeriveDataTypeable
+ deriving Typeable
+#endif
+
+instance Category Op where
+ id = Op id
+ Op f . Op g = Op (g . f)
+
+instance Contravariant (Op a) where
+ contramap f g = Op (getOp g . f)
+
+#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
+instance Semigroup a => Semigroup (Op a b) where
+ Op p <> Op q = Op $ \a -> p a <> q a
+#endif
+
+instance Monoid a => Monoid (Op a b) where
+ mempty = Op (const mempty)
+ mappend (Op p) (Op q) = Op $ \a -> mappend (p a) (q a)
+
+#if MIN_VERSION_base(4,5,0)
+instance Num a => Num (Op a b) where
+ Op f + Op g = Op $ \a -> f a + g a
+ Op f * Op g = Op $ \a -> f a * g a
+ Op f - Op g = Op $ \a -> f a - g a
+ abs (Op f) = Op $ abs . f
+ signum (Op f) = Op $ signum . f
+ fromInteger = Op . const . fromInteger
+
+instance Fractional a => Fractional (Op a b) where
+ Op f / Op g = Op $ \a -> f a / g a
+ recip (Op f) = Op $ recip . f
+ fromRational = Op . const . fromRational
+
+instance Floating a => Floating (Op a b) where
+ pi = Op $ const pi
+ exp (Op f) = Op $ exp . f
+ sqrt (Op f) = Op $ sqrt . f
+ log (Op f) = Op $ log . f
+ sin (Op f) = Op $ sin . f
+ tan (Op f) = Op $ tan . f
+ cos (Op f) = Op $ cos . f
+ asin (Op f) = Op $ asin . f
+ atan (Op f) = Op $ atan . f
+ acos (Op f) = Op $ acos . f
+ sinh (Op f) = Op $ sinh . f
+ tanh (Op f) = Op $ tanh . f
+ cosh (Op f) = Op $ cosh . f
+ asinh (Op f) = Op $ asinh . f
+ atanh (Op f) = Op $ atanh . f
+ acosh (Op f) = Op $ acosh . f
+ Op f ** Op g = Op $ \a -> f a ** g a
+ logBase (Op f) (Op g) = Op $ \a -> logBase (f a) (g a)
+#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/contravariant-1.4.1/src/Data/Functor/Contravariant/Divisible.hs
new/contravariant-1.5/src/Data/Functor/Contravariant/Divisible.hs
--- old/contravariant-1.4.1/src/Data/Functor/Contravariant/Divisible.hs
2018-01-18 20:29:34.000000000 +0100
+++ new/contravariant-1.5/src/Data/Functor/Contravariant/Divisible.hs
2018-07-02 01:07:28.000000000 +0200
@@ -115,7 +115,7 @@
-- data StringAndInt = StringAndInt String Int
--
-- stringAndInt :: Serializer StringAndInt
--- stringAndInt = Serializer $ \(StringAndInt s i) ->
+-- stringAndInt = Serializer $ \\(StringAndInt s i) ->
-- let sBytes = runSerializer string s
-- iBytes = runSerializer int i
-- in sBytes <> iBytes
@@ -133,7 +133,7 @@
-- instance Divisible Serializer where
-- conquer = Serializer (const mempty)
--
--- divide toBC bSerializer cSerializer = Serializer $ \a ->
+-- divide toBC bSerializer cSerializer = Serializer $ \\a ->
-- case toBC a of
-- (b, c) ->
-- let bBytes = runSerializer bSerializer b
@@ -142,7 +142,7 @@
--
-- stringAndInt :: Serializer StringAndInt
-- stringAndInt =
--- divide (\(StringAndInt s i) -> (s, i)) string int
+-- divide (\\(StringAndInt s i) -> (s, i)) string int
-- @
--
class Contravariant f => Divisible f where
@@ -360,7 +360,7 @@
--
-- @
-- identifier :: Serializer Identifier
--- identifier = Serializer $ \identifier ->
+-- identifier = Serializer $ \\identifier ->
-- case identifier of
-- StringId s -> runSerializer string s
-- IntId i -> runSerializer int i
@@ -371,8 +371,8 @@
--
-- @
-- instance Decidable Serializer where
--- lose f = Serializer $ \a -> absurd (f a)
--- choose split l r = Serializer $ \a ->
+-- lose f = Serializer $ \\a -> absurd (f a)
+-- choose split l r = Serializer $ \\a ->
-- either (runSerializer l) (runSerializer r) (split a)
-- @
--
@@ -589,7 +589,7 @@
-- 'divide' f m 'conquer' = 'contramap' ('fst' . f) m
-- 'divide' f 'conquer' m = 'contramap' ('snd' . f) m
-- 'divide' f ('divide' g m n) o = 'divide' f' m ('divide' 'id' n o) where
--- f' a = case f a of (bc,d) -> case g bc of (b,c) -> (a,(b,c))
+-- f' a = let (bc, d) = f a; (b, c) = g bc in (b, (c, d))
-- @
-- $conquer
@@ -611,8 +611,8 @@
-- @
-- 'choose' 'Left' m ('lose' f) = m
-- 'choose' 'Right' ('lose' f) m = m
--- 'choose' f ('choose' g m n) o = 'divide' f' m ('divide' 'id' n o) where
--- f' bcd = 'either' ('either' 'id' ('Right' . 'Left') . g) ('Right' .
'Right') . f
+-- 'choose' f ('choose' g m n) o = 'choose' f' m ('choose' 'id' n o) where
+-- f' = 'either' ('either' 'id' 'Left' . g) ('Right' . 'Right') . f
-- @
--
-- In addition, we expect the same kind of distributive law as is satisfied by
the usual
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/contravariant-1.4.1/src/Data/Functor/Contravariant.hs
new/contravariant-1.5/src/Data/Functor/Contravariant.hs
--- old/contravariant-1.4.1/src/Data/Functor/Contravariant.hs 2018-01-18
20:29:34.000000000 +0100
+++ new/contravariant-1.5/src/Data/Functor/Contravariant.hs 1970-01-01
01:00:00.000000000 +0100
@@ -1,458 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TypeOperators #-}
-
-#ifdef __GLASGOW_HASKELL__
-#define LANGUAGE_DeriveDataTypeable
-{-# LANGUAGE DeriveDataTypeable #-}
-#endif
-
-#ifndef MIN_VERSION_tagged
-#define MIN_VERSION_tagged(x,y,z) 1
-#endif
-
-#ifndef MIN_VERSION_base
-#define MIN_VERSION_base(x,y,z) 1
-#endif
-
-#if __GLASGOW_HASKELL__ >= 704
-#if MIN_VERSION_transformers(0,3,0) && MIN_VERSION_tagged(0,6,1)
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
-#endif
-
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-
------------------------------------------------------------------------------
--- |
--- Module : Data.Functor.Contravariant
--- Copyright : (C) 2007-2015 Edward Kmett
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : Edward Kmett <ekm...@gmail.com>
--- Stability : provisional
--- Portability : portable
---
--- 'Contravariant' functors, sometimes referred to colloquially as @Cofunctor@,
--- even though the dual of a 'Functor' is just a 'Functor'. As with 'Functor'
--- the definition of 'Contravariant' for a given ADT is unambiguous.
-----------------------------------------------------------------------------
-
-module Data.Functor.Contravariant (
- -- * Contravariant Functors
- Contravariant(..)
- , phantom
-
- -- * Operators
- , (>$<), (>$$<), ($<)
-
- -- * Predicates
- , Predicate(..)
-
- -- * Comparisons
- , Comparison(..)
- , defaultComparison
-
- -- * Equivalence Relations
- , Equivalence(..)
- , defaultEquivalence
- , comparisonEquivalence
-
- -- * Dual arrows
- , Op(..)
- ) where
-
-import Control.Applicative
-import Control.Applicative.Backwards
-
-import Control.Category
-
-import Control.Monad.Trans.Error
-import Control.Monad.Trans.Except
-import Control.Monad.Trans.Identity
-import Control.Monad.Trans.List
-import Control.Monad.Trans.Maybe
-import qualified Control.Monad.Trans.RWS.Lazy as Lazy
-import qualified Control.Monad.Trans.RWS.Strict as Strict
-import Control.Monad.Trans.Reader
-import qualified Control.Monad.Trans.State.Lazy as Lazy
-import qualified Control.Monad.Trans.State.Strict as Strict
-import qualified Control.Monad.Trans.Writer.Lazy as Lazy
-import qualified Control.Monad.Trans.Writer.Strict as Strict
-
-import Data.Function (on)
-
-import Data.Functor.Product
-import Data.Functor.Sum
-import Data.Functor.Constant
-import Data.Functor.Compose
-import Data.Functor.Reverse
-
-#if MIN_VERSION_base(4,8,0)
-import Data.Monoid (Alt(..))
-#else
-import Data.Monoid (Monoid(..))
-#endif
-
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
-import Data.Semigroup (Semigroup(..))
-#endif
-
-#ifdef LANGUAGE_DeriveDataTypeable
-import Data.Typeable
-#endif
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 &&
defined(VERSION_tagged)
-import Data.Proxy
-#endif
-
-#ifdef MIN_VERSION_StateVar
-import Data.StateVar
-#endif
-
-#if __GLASGOW_HASKELL__ >= 702
-#define GHC_GENERICS
-import GHC.Generics
-#endif
-
-import Prelude hiding ((.),id)
-
--- | The class of contravariant functors.
---
--- Whereas in Haskell, one can think of a 'Functor' as containing or producing
--- values, a contravariant functor is a functor that can be thought of as
--- /consuming/ values.
---
--- As an example, consider the type of predicate functions @a -> Bool@. One
--- such predicate might be @negative x = x < 0@, which
--- classifies integers as to whether they are negative. However, given this
--- predicate, we can re-use it in other situations, providing we have a way to
--- map values /to/ integers. For instance, we can use the @negative@ predicate
--- on a person's bank balance to work out if they are currently overdrawn:
---
--- @
--- newtype Predicate a = Predicate { getPredicate :: a -> Bool }
---
--- instance Contravariant Predicate where
--- contramap f (Predicate p) = Predicate (p . f)
--- | `- First, map the input...
--- `----- then apply the predicate.
---
--- overdrawn :: Predicate Person
--- overdrawn = contramap personBankBalance negative
--- @
---
--- Any instance should be subject to the following laws:
---
--- > contramap id = id
--- > contramap f . contramap g = contramap (g . f)
---
--- Note, that the second law follows from the free theorem of the type of
--- 'contramap' and the first law, so you need only check that the former
--- condition holds.
-
-class Contravariant f where
- contramap :: (a -> b) -> f b -> f a
-
- -- | Replace all locations in the output with the same value.
- -- The default definition is @'contramap' . 'const'@, but this may be
- -- overridden with a more efficient version.
- (>$) :: b -> f b -> f a
- (>$) = contramap . const
-
--- | If 'f' is both 'Functor' and 'Contravariant' then by the time you factor
in the laws
--- of each of those classes, it can't actually use its argument in any
meaningful capacity.
---
--- This method is surprisingly useful. Where both instances exist and are
lawful we have
--- the following laws:
---
--- @
--- 'fmap' f ≡ 'phantom'
--- 'contramap' f ≡ 'phantom'
--- @
-phantom :: (Functor f, Contravariant f) => f a -> f b
-phantom x = () <$ x $< ()
-
-infixl 4 >$, $<, >$<, >$$<
-
--- | This is '>$' with its arguments flipped.
-($<) :: Contravariant f => f b -> b -> f a
-($<) = flip (>$)
-{-# INLINE ($<) #-}
-
--- | This is an infix alias for 'contramap'
-(>$<) :: Contravariant f => (a -> b) -> f b -> f a
-(>$<) = contramap
-{-# INLINE (>$<) #-}
-
--- | This is an infix version of 'contramap' with the arguments flipped.
-(>$$<) :: Contravariant f => f b -> (a -> b) -> f a
-(>$$<) = flip contramap
-{-# INLINE (>$$<) #-}
-
-#if MIN_VERSION_base(4,8,0)
-instance Contravariant f => Contravariant (Alt f) where
- contramap f = Alt . contramap f . getAlt
-#endif
-
-#ifdef GHC_GENERICS
-instance Contravariant V1 where
- contramap _ x = x `seq` undefined
-
-instance Contravariant U1 where
- contramap _ U1 = U1
-
-instance Contravariant f => Contravariant (Rec1 f) where
- contramap f (Rec1 fp)= Rec1 (contramap f fp)
-
-instance Contravariant f => Contravariant (M1 i c f) where
- contramap f (M1 fp) = M1 (contramap f fp)
-
-instance Contravariant (K1 i c) where
- contramap _ (K1 c) = K1 c
-
-instance (Contravariant f, Contravariant g) => Contravariant (f :*: g) where
- contramap f (xs :*: ys) = contramap f xs :*: contramap f ys
-
-instance (Functor f, Contravariant g) => Contravariant (f :.: g) where
- contramap f (Comp1 fg) = Comp1 (fmap (contramap f) fg)
- {-# INLINE contramap #-}
-
-instance (Contravariant f, Contravariant g) => Contravariant (f :+: g) where
- contramap f (L1 xs) = L1 (contramap f xs)
- contramap f (R1 ys) = R1 (contramap f ys)
-#endif
-
-instance Contravariant m => Contravariant (ErrorT e m) where
- contramap f = ErrorT . contramap (fmap f) . runErrorT
-
-instance Contravariant m => Contravariant (ExceptT e m) where
- contramap f = ExceptT . contramap (fmap f) . runExceptT
-
-instance Contravariant f => Contravariant (IdentityT f) where
- contramap f = IdentityT . contramap f . runIdentityT
-
-instance Contravariant m => Contravariant (ListT m) where
- contramap f = ListT . contramap (fmap f) . runListT
-
-instance Contravariant m => Contravariant (MaybeT m) where
- contramap f = MaybeT . contramap (fmap f) . runMaybeT
-
-instance Contravariant m => Contravariant (Lazy.RWST r w s m) where
- contramap f m = Lazy.RWST $ \r s ->
- contramap (\ ~(a, s', w) -> (f a, s', w)) $ Lazy.runRWST m r s
-
-instance Contravariant m => Contravariant (Strict.RWST r w s m) where
- contramap f m = Strict.RWST $ \r s ->
- contramap (\ (a, s', w) -> (f a, s', w)) $ Strict.runRWST m r s
-
-instance Contravariant m => Contravariant (ReaderT r m) where
- contramap f = ReaderT . fmap (contramap f) . runReaderT
-
-instance Contravariant m => Contravariant (Lazy.StateT s m) where
- contramap f m = Lazy.StateT $ \s ->
- contramap (\ ~(a, s') -> (f a, s')) $ Lazy.runStateT m s
-
-instance Contravariant m => Contravariant (Strict.StateT s m) where
- contramap f m = Strict.StateT $ \s ->
- contramap (\ (a, s') -> (f a, s')) $ Strict.runStateT m s
-
-instance Contravariant m => Contravariant (Lazy.WriterT w m) where
- contramap f = Lazy.mapWriterT $ contramap $ \ ~(a, w) -> (f a, w)
-
-instance Contravariant m => Contravariant (Strict.WriterT w m) where
- contramap f = Strict.mapWriterT $ contramap $ \ (a, w) -> (f a, w)
-
-instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where
- contramap f (InL xs) = InL (contramap f xs)
- contramap f (InR ys) = InR (contramap f ys)
-
-instance (Contravariant f, Contravariant g) => Contravariant (Product f g)
where
- contramap f (Pair a b) = Pair (contramap f a) (contramap f b)
-
-instance Contravariant (Constant a) where
- contramap _ (Constant a) = Constant a
-
-instance Contravariant (Const a) where
- contramap _ (Const a) = Const a
-
-instance (Functor f, Contravariant g) => Contravariant (Compose f g) where
- contramap f (Compose fga) = Compose (fmap (contramap f) fga)
- {-# INLINE contramap #-}
-
-instance Contravariant f => Contravariant (Backwards f) where
- contramap f = Backwards . contramap f . forwards
- {-# INLINE contramap #-}
-
-instance Contravariant f => Contravariant (Reverse f) where
- contramap f = Reverse . contramap f . getReverse
- {-# INLINE contramap #-}
-
-#ifdef MIN_VERSION_StateVar
-instance Contravariant SettableStateVar where
- contramap f (SettableStateVar k) = SettableStateVar (k . f)
- {-# INLINE contramap #-}
-#endif
-
-#if (__GLASGOW_HASKELL__ >= 707) || defined(VERSION_tagged)
-instance Contravariant Proxy where
- contramap _ Proxy = Proxy
-#endif
-
-newtype Predicate a = Predicate { getPredicate :: a -> Bool }
-#ifdef LANGUAGE_DeriveDataTypeable
- deriving Typeable
-#endif
-
--- | A 'Predicate' is a 'Contravariant' 'Functor', because 'contramap' can
--- apply its function argument to the input of the predicate.
-instance Contravariant Predicate where
- contramap f g = Predicate $ getPredicate g . f
-
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
-instance Semigroup (Predicate a) where
- Predicate p <> Predicate q = Predicate $ \a -> p a && q a
-#endif
-
-instance Monoid (Predicate a) where
- mempty = Predicate $ const True
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
- mappend = (<>)
-#else
- mappend (Predicate p) (Predicate q) = Predicate $ \a -> p a && q a
-#endif
-
--- | Defines a total ordering on a type as per 'compare'
---
--- This condition is not checked by the types. You must ensure that the
supplied
--- values are valid total orderings yourself.
-newtype Comparison a = Comparison { getComparison :: a -> a -> Ordering }
-#ifdef LANGUAGE_DeriveDataTypeable
- deriving Typeable
-#endif
-
--- | A 'Comparison' is a 'Contravariant' 'Functor', because 'contramap' can
--- apply its function argument to each input of the comparison function.
-instance Contravariant Comparison where
- contramap f g = Comparison $ on (getComparison g) f
-
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
-instance Semigroup (Comparison a) where
- Comparison p <> Comparison q = Comparison $ mappend p q
-#endif
-
-instance Monoid (Comparison a) where
- mempty = Comparison (\_ _ -> EQ)
- mappend (Comparison p) (Comparison q) = Comparison $ mappend p q
-
--- | Compare using 'compare'
-defaultComparison :: Ord a => Comparison a
-defaultComparison = Comparison compare
-
--- | This data type represents an equivalence relation.
---
--- Equivalence relations are expected to satisfy three laws:
---
--- __Reflexivity__:
---
--- @
--- 'getEquivalence' f a a = True
--- @
---
--- __Symmetry__:
---
--- @
--- 'getEquivalence' f a b = 'getEquivalence' f b a
--- @
---
--- __Transitivity__:
---
--- If @'getEquivalence' f a b@ and @'getEquivalence' f b c@ are both 'True'
then so is @'getEquivalence' f a c@
---
--- The types alone do not enforce these laws, so you'll have to check them
yourself.
-newtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool }
-#ifdef LANGUAGE_DeriveDataTypeable
- deriving Typeable
-#endif
-
--- | Equivalence relations are 'Contravariant', because you can
--- apply the contramapped function to each input to the equivalence
--- relation.
-instance Contravariant Equivalence where
- contramap f g = Equivalence $ on (getEquivalence g) f
-
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
-instance Semigroup (Equivalence a) where
- Equivalence p <> Equivalence q = Equivalence $ \a b -> p a b && q a b
-#endif
-
-instance Monoid (Equivalence a) where
- mempty = Equivalence (\_ _ -> True)
- mappend (Equivalence p) (Equivalence q) = Equivalence $ \a b -> p a b && q a
b
-
--- | Check for equivalence with '=='
---
--- Note: The instances for 'Double' and 'Float' violate reflexivity for @NaN@.
-defaultEquivalence :: Eq a => Equivalence a
-defaultEquivalence = Equivalence (==)
-
-comparisonEquivalence :: Comparison a -> Equivalence a
-comparisonEquivalence (Comparison p) = Equivalence $ \a b -> p a b == EQ
-
--- | Dual function arrows.
-newtype Op a b = Op { getOp :: b -> a }
-#ifdef LANGUAGE_DeriveDataTypeable
- deriving Typeable
-#endif
-
-instance Category Op where
- id = Op id
- Op f . Op g = Op (g . f)
-
-instance Contravariant (Op a) where
- contramap f g = Op (getOp g . f)
-
-#if defined(MIN_VERSION_semigroups) || __GLASGOW_HASKELL__ >= 711
-instance Semigroup a => Semigroup (Op a b) where
- Op p <> Op q = Op $ \a -> p a <> q a
-#endif
-
-instance Monoid a => Monoid (Op a b) where
- mempty = Op (const mempty)
- mappend (Op p) (Op q) = Op $ \a -> mappend (p a) (q a)
-
-#if MIN_VERSION_base(4,5,0)
-instance Num a => Num (Op a b) where
- Op f + Op g = Op $ \a -> f a + g a
- Op f * Op g = Op $ \a -> f a * g a
- Op f - Op g = Op $ \a -> f a - g a
- abs (Op f) = Op $ abs . f
- signum (Op f) = Op $ signum . f
- fromInteger = Op . const . fromInteger
-
-instance Fractional a => Fractional (Op a b) where
- Op f / Op g = Op $ \a -> f a / g a
- recip (Op f) = Op $ recip . f
- fromRational = Op . const . fromRational
-
-instance Floating a => Floating (Op a b) where
- pi = Op $ const pi
- exp (Op f) = Op $ exp . f
- sqrt (Op f) = Op $ sqrt . f
- log (Op f) = Op $ log . f
- sin (Op f) = Op $ sin . f
- tan (Op f) = Op $ tan . f
- cos (Op f) = Op $ cos . f
- asin (Op f) = Op $ asin . f
- atan (Op f) = Op $ atan . f
- acos (Op f) = Op $ acos . f
- sinh (Op f) = Op $ sinh . f
- tanh (Op f) = Op $ tanh . f
- cosh (Op f) = Op $ cosh . f
- asinh (Op f) = Op $ asinh . f
- atanh (Op f) = Op $ atanh . f
- acosh (Op f) = Op $ acosh . f
- Op f ** Op g = Op $ \a -> f a ** g a
- logBase (Op f) (Op g) = Op $ \a -> logBase (f a) (g a)
-#endif
