Move Const to own module in Data.Functor.Const and enable PolyKinds

`Const` from `Control.Applicative` can trivially be made
kind-polymorphic in its second argument. There has been a Trac issue
about this for nearly a year now. It doesn't look like anybody objects
to it, so I figured I might as well make a patch.

Trac Issues: #10039, #10865, #11135

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

Reviewers: ekmett, hvr, bgamari

Subscribers: RyanGlScott, thomie

4 files changed, 73 insertions, 29 deletions

diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 6770234926..0892808dd9 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -56,38 +55,13 @@ import Data.Eq
 import Data.Ord
 import Data.Foldable (Foldable(..))
 import Data.Functor ((<$>))
+import Data.Functor.Const (Const(..))
 
 import GHC.Base
 import GHC.Generics
 import GHC.List (repeat, zipWith)
-import GHC.Read (Read(readsPrec), readParen, lex)
-import GHC.Show (Show(showsPrec), showParen, showString)
-
-newtype Const a b = Const { getConst :: a }
-                  deriving (Generic, Generic1, Monoid, Eq, Ord)
-
-instance Read a => Read (Const a b) where
-    readsPrec d = readParen (d > 10)
-        $ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s]
-
-instance Show a => Show (Const a b) where
-    showsPrec d (Const x) = showParen (d > 10) $
-                            showString "Const " . showsPrec 11 x
-
-instance Foldable (Const m) where
-    foldMap _ _ = mempty
-
-instance Functor (Const m) where
-    fmap _ (Const v) = Const v
-
-instance Monoid m => Applicative (Const m) where
-    pure _ = Const mempty
-    (<*>) = coerce (mappend :: m -> m -> m)
--- This is pretty much the same as
--- Const f <*> Const v = Const (f `mappend` v)
--- but guarantees that mappend for Const a b will have the same arity
--- as the one for a; it won't create a closure to raise the arity
--- to 2.
+import GHC.Read (Read)
+import GHC.Show (Show)
 
 newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
                          deriving (Generic, Generic1, Monad)
diff --git a/libraries/base/Data/Functor/Const.hs b/libraries/base/Data/Functor/Const.hs
new file mode 100644
index 0000000000..21e6f850b5
--- /dev/null
+++ b/libraries/base/Data/Functor/Const.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Const
+-- Copyright   :  Conor McBride and Ross Paterson 2005
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+
+-- The 'Const' functor.
+--
+-- @since 4.9.0.0
+
+module Data.Functor.Const (Const(..)) where
+
+import Data.Foldable (Foldable(foldMap))
+
+import GHC.Base
+import GHC.Generics (Generic, Generic1)
+import GHC.Read (Read(readsPrec), readParen, lex)
+import GHC.Show (Show(showsPrec), showParen, showString)
+
+-- | The 'Const' functor.
+newtype Const a b = Const { getConst :: a }
+                  deriving (Generic, Generic1, Monoid, Eq, Ord)
+
+-- | This instance would be equivalent to the derived instances of the
+-- 'Const' newtype if the 'runConst' field were removed
+instance Read a => Read (Const a b) where
+    readsPrec d = readParen (d > 10)
+        $ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s]
+
+-- | This instance would be equivalent to the derived instances of the
+-- 'Const' newtype if the 'runConst' field were removed
+instance Show a => Show (Const a b) where
+    showsPrec d (Const x) = showParen (d > 10) $
+                            showString "Const " . showsPrec 11 x
+
+instance Foldable (Const m) where
+    foldMap _ _ = mempty
+
+instance Functor (Const m) where
+    fmap _ (Const v) = Const v
+
+instance Monoid m => Applicative (Const m) where
+    pure _ = Const mempty
+    (<*>) = coerce (mappend :: m -> m -> m)
+-- This is pretty much the same as
+-- Const f <*> Const v = Const (f `mappend` v)
+-- but guarantees that mappend for Const a b will have the same arity
+-- as the one for a; it won't create a closure to raise the arity
+-- to 2.
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index cc85e9bdf2..cd77e55ee6 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -146,6 +146,7 @@ Library
         Data.Functor
         Data.Functor.Classes
         Data.Functor.Compose
+        Data.Functor.Const
         Data.Functor.Identity
         Data.Functor.Product
         Data.Functor.Sum
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 82def76397..33a51143a8 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -104,6 +104,15 @@
   * The `IsString` instance for `[Char]` has been modified to eliminate
     ambiguity arising from overloaded strings and functions like `(++)`.
 
+  * Move `Const` from `Control.Applicative` to its own module in
+   `Data.Functor.Const`. (#11135)
+
+  * Enable `PolyKinds` in the `Data.Functor.Const` module to give `Const`
+    the kind `* -> k -> *`. (#10039)
+
+  * Re-export `Const` from `Control.Applicative` for backwards compatibility.
+
+
 ## 4.8.2.0  *Oct 2015*
 
   * Bundled with GHC 7.10.3