Optimise `Identity` instances with `coerce`

This also overrides all optional `Foldable` methods
(which would otherwise be default-implemented in terms of `foldMap`)
with supposedly optimally minimal implementations.

While at it, this also removes the redundant `{-# LANGUAGE CPP #-}`.

Reviewed By: austin, dfeuer

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

1 files changed, 34 insertions, 13 deletions

diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs
index 4058df8824..de7f19a210 100644
--- a/libraries/base/Data/Functor/Identity.hs
+++ b/libraries/base/Data/Functor/Identity.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Functor.Identity
@@ -31,13 +32,14 @@ module Data.Functor.Identity (
   ) where
 
 import Control.Monad.Fix
-import Data.Functor
+import Data.Coerce
+import Data.Foldable
 
 -- | Identity functor and monad. (a non-strict monad)
 --
 -- /Since: 4.8.0.0/
 newtype Identity a = Identity { runIdentity :: a }
-    deriving (Eq, Ord)
+    deriving (Eq, Ord, Traversable)
 
 -- | This instance would be equivalent to the derived instances of the
 -- 'Identity' newtype if the 'runIdentity' field were removed
@@ -54,22 +56,41 @@ instance (Show a) => Show (Identity a) where
 -- ---------------------------------------------------------------------------
 -- Identity instances for Functor and Monad
 
-instance Functor Identity where
-    fmap f m = Identity (f (runIdentity m))
-
 instance Foldable Identity where
-    foldMap f (Identity x) = f x
+    foldMap                = coerce
+
+    elem                   = (. runIdentity) #. (==)
+    foldl                  = coerce
+    foldl'                 = coerce
+    foldl1 _               = runIdentity
+    foldr f z (Identity x) = f x z
+    foldr'                 = foldr
+    foldr1 _               = runIdentity
+    length _               = 1
+    maximum                = runIdentity
+    minimum                = runIdentity
+    null _                 = False
+    product                = runIdentity
+    sum                    = runIdentity
+    toList (Identity x)    = [x]
 
-instance Traversable Identity where
-    traverse f (Identity x) = Identity <$> f x
+instance Functor Identity where
+    fmap     = coerce
 
 instance Applicative Identity where
-    pure a = Identity a
-    Identity f <*> Identity x = Identity (f x)
+    pure     = Identity
+    (<*>)    = coerce
 
 instance Monad Identity where
-    return a = Identity a
+    return   = Identity
     m >>= k  = k (runIdentity m)
 
 instance MonadFix Identity where
-    mfix f = Identity (fix (runIdentity . f))
+    mfix f   = Identity (fix (runIdentity . f))
+
+
+-- | Internal (non-exported) 'Coercible' helper for 'elem'
+--
+-- See Note [Function coercion] in "Data.Foldable" for more details.
+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
+(#.) _f = coerce