Move Data.Functor.Contravariant from the contravariant package to base.

Move Data.Functor.Contravariant from the contravariant package to base.
Since base is the bottom of the dependency hierarchy, several instances
have been removed. They will need to be added to the following packages:
transformers, StateVar, and possibly tagged. There may not actually have
been any types from tagged that previous had instanced provided by this
module though, since it may have only been used for Data.Proxy. Additionally,
all CPP has been removed. Derived Typeable instances have been removed
(since Typeable is now automatically derived for everything). The language
extension Safe is still used, although it is unclear to ATM whether or not
it is necessary.

This resolves trac issue #14767.

Test Plan: validate

Reviewers: RyanGlScott, ekmett, hvr, bgamari

Reviewed By: RyanGlScott

Subscribers: rwbarton, thomie, ekmett, carter, RyanGlScott

GHC Trac Issues: #14767

Differential Revision: https://phabricator.haskell.org/D4399

4 files changed, 304 insertions, 1 deletions

diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst
index 80beb6c74a..70c3b0c10d 100644
--- a/docs/users_guide/8.6.1-notes.rst
+++ b/docs/users_guide/8.6.1-notes.rst
@@ -60,7 +60,12 @@ Template Haskell
 ``base`` library
 ~~~~~~~~~~~~~~~~
 
-``($!)`` is now representation-polymorphic like ``($)``.
+- ``($!)`` is now representation-polymorphic like ``($)``.
+
+- The module ``Data.Functor.Contravariant`` has been moved from the
+  ``contravariant`` package into base. All the other modules in
+  ``contravariant`` (``Data.Functor.Contravariant.Divisible``, etc.)
+  have not been moved to ``base``, and they still reside in ``contravariant``.
 
 
 Build system
diff --git a/libraries/base/Data/Functor/Contravariant.hs b/libraries/base/Data/Functor/Contravariant.hs
new file mode 100644
index 0000000000..0bfad271bb
--- /dev/null
+++ b/libraries/base/Data/Functor/Contravariant.hs
@@ -0,0 +1,295 @@
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Contravariant
+-- Copyright   :  (C) 2007-2015 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- 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.
+--
+-- @since 4.12.0.0
+----------------------------------------------------------------------------
+
+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.Category
+import Data.Function (on)
+
+import Data.Functor.Product
+import Data.Functor.Sum
+import Data.Functor.Compose
+
+import Data.Monoid (Alt(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Proxy
+import GHC.Generics
+
+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 (>$)
+
+-- | This is an infix alias for 'contramap'.
+(>$<) :: Contravariant f => (a -> b) -> f b -> f a
+(>$<) = contramap
+
+-- | This is an infix version of 'contramap' with the arguments flipped.
+(>$$<) :: Contravariant f => f b -> (a -> b) -> f a
+(>$$<) = flip contramap
+
+deriving instance Contravariant f => Contravariant (Alt f)
+deriving instance Contravariant f => Contravariant (Rec1 f)
+deriving instance Contravariant f => Contravariant (M1 i c f)
+
+instance Contravariant V1 where
+  contramap _ x = case x of
+
+instance Contravariant U1 where
+  contramap _ _ = U1
+
+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)
+
+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)
+
+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 (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)
+
+instance Contravariant Proxy where
+  contramap _ _ = Proxy
+
+newtype Predicate a = Predicate { getPredicate :: a -> Bool }
+
+-- | 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
+
+instance Semigroup (Predicate a) where
+  Predicate p <> Predicate q = Predicate $ \a -> p a && q a
+
+instance Monoid (Predicate a) where
+  mempty = Predicate $ const True
+
+-- | 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 }
+
+deriving instance Semigroup (Comparison a)
+deriving instance Monoid (Comparison a)
+
+-- | 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
+
+-- | 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 }
+
+-- | 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
+
+instance Semigroup (Equivalence a) where
+  Equivalence p <> Equivalence q = Equivalence $ \a b -> p a b && q a b
+
+instance Monoid (Equivalence a) where
+  mempty = Equivalence (\_ _ -> True)
+
+-- | 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 }
+
+deriving instance Semigroup a => Semigroup (Op a b)
+deriving instance Monoid a => Monoid (Op a b)
+
+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)
+
+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)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index dc529a8686..c7075b3280 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -148,6 +148,7 @@ Library
         Data.Function
         Data.Functor
         Data.Functor.Classes
+        Data.Functor.Contravariant
         Data.Functor.Compose
         Data.Functor.Const
         Data.Functor.Identity
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 53a515d383..fdac6f283e 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -1,6 +1,8 @@
 # Changelog for [`base` package](http://hackage.haskell.org/package/base)
 
 ## 4.12.0.0 *TBA*
+  * Move the module `Data.Functor.Contravariant` from the
+    `contravariant` package to `base`.
 
   * `($!)` is now representation-polymorphic like `($)`.